diff --git a/.dir-locals.el b/.dir-locals.el index 5bee88267c8..203343f0842 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -7,7 +7,8 @@ ;; See admin/notes/bugtracker. (log-edit-mode . ((log-edit-rewrite-fixes "[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1") - (log-edit-font-lock-gnu-style . t))) + (log-edit-font-lock-gnu-style . t) + (log-edit-setup-add-author . t))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) (bug-reference-url-format . "http://debbugs.gnu.org/%s") diff --git a/.gitignore b/.gitignore index 21702f7cd07..ad4324e8e22 100644 --- a/.gitignore +++ b/.gitignore @@ -10,8 +10,14 @@ lib/Makefile.in src/config.in autom4te.cache makefile +TAGS *~ /README.W32 /bin/ /site-lisp/ +/leim/ja-dic/ +etc/refcards/*.aux +etc/refcards/*.log +info/dir +info/*.info diff --git a/ChangeLog b/ChangeLog index 84d9987ccea..4cefaef325f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,1264 @@ +2014-02-18 Mirek Kaim (tiny change) + + * configure.ac [HAVE_W32]: Test for ImageMagick. (Bug#16754) + +2014-02-14 Paul Eggert + + * Makefile.in (install-arch-indep): Allow ' ' in destdir (Bug#16717). + This fixes a bug in the previous change. Also, use $(SHELL) + rather than sh, as that's more likely to be portable. + +2014-02-13 Paul Eggert + + * Makefile.in (install-arch-indep): Simplify (Bug#16717). + This should make it more reliable, and hopefully more portable to + non-GNU 'make' implementations such as HP-UX 'make'. + +2014-02-13 Juanma Barranquero + + * Makefile.in (install-nt): Also pass datadir. + +2014-02-05 Paul Eggert + + Merge from gnulib, incorporating: + 2014-01-23 pthread: work around winpthread header pollution on mingw + * lib/time.in.h: Update from gnulib. + +2014-01-23 Paul Eggert + + Merge from gnulib, incorporating: + 2014-01-22 qacl: check for fchmod + * m4/acl.m4: Update from gnulib. + +2014-01-22 Paul Eggert + + Fix miscellaneous update-game-score bugs. + * configure.ac (difftime): Remove. + +2014-01-20 Paul Eggert + + Merge from gnulib, incorporating: + 2014-01-20 stdalign: port to HP-UX compilers + 2014-01-16 strtoimax: port to platforms lacking 'long long' + 2014-01-16 update from texinfo + * lib/stdalign.in.h, lib/strtoimax.c: Update from gnulib. + +2014-01-12 Glenn Morris + + * README: Replace reference to etc/MAILINGLISTS. + +2014-01-11 Fabrice Popineau + + * configure.ac: Read $srcdir/nt/mingw-cfg.site when $MSYSTEM is + "MINGW64" as well. + +2014-01-11 Paul Eggert + + Merge from gnulib, incorporating: + 2014-01-07 update from texinfo + 2014-01-06 md5, sha1, sha256, sha512: support older autoconf + +2014-01-09 Eric S. Raymond + + * INSTALL, configure.ac, etc/CONTRIBUTE, nt/INSTALL: Remove + unnecessarily specific references to Bazaar that could better + simply be to the repository. + +2014-01-08 Eric S. Raymond + + * INSTALL.BZR: Rename to INSTALL.REPO. Remove refs to specific VCS. + * INSTALL, autogen.sh: Update for above change. + +2014-01-05 Paul Eggert + + Port to GNU/Linux with recent grsecurity/PaX patches (Bug#16343). + Problem and proposed patch reported by Ulrich Mueller; + this patch uses a somewhat-different approach. + * configure.ac (SETFATTR): New variable. + +2014-01-03 Paul Eggert + + Merge from gnulib, incorporating: + 2014-01-02 manywarnings: remove -Wmudflap + This ports better to GCC 4.9-to-be. + +2013-12-31 Fabrice Popineau + + * configure.ac (canonical, C_SWITCH_SYSTEM): Support a 64-bit + MinGW64 build on MS-Windows. + +2013-12-29 Jan Djärv + + * configure.ac (xcsdkdir): Only set if using xcrun. + +2013-12-29 Paul Eggert + + * configure.ac (LIBXML2_CFLAGS): Fix xcrun-related quoting problem. + Reported by YAMAMOTO Mitsuharu in: + http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00995.html + +2013-12-28 Jan Djärv + + * configure.ac: Fix CC detection for xcrun case. + +2013-12-28 Paul Eggert + + Fix problem with MAKE and xcrun configuration. + * configure.ac: Don't set MAKE unless 'make' doesn't work. + Set it only in the environment, not in the makefile. + Problem reported by Glenn Morris in: + http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00969.html + +2013-12-27 Paul Eggert + + Port xcrun configuration to GNU/Linux. + * configure.ac (xcsdkdir): Default to empty. + (XCRUN): Don't require Darwin for xcrun. Move xcrun checking to + just before AM_INIT_AUTOMAKE, to make the dependency between it + and automake clearer. + (CC): Don't use AC_PROG_CC twice; only the first use expands to the + shell code that is wanted, which breaks 'configure' on non-Darwin + platforms. Instead, fix CC by hand if it's not found. + +2013-12-27 Jan Djärv + + * configure.ac: Detect xcrun on OSX and use it for make, gcc and + libxml. + +2013-12-26 Paul Eggert + + Fix core dumps with gcc -fsanitize=address and GNU/Linux. + * configure.ac: Check whether addresses are sanitized. + (CANNOT_DUMP): Warn if addresses are sanitized and not CANNOT_DUMP. + (DOUG_LEA_MALLOC): Do not define if addresses are sanitized. + (SYSTEM_MALLOC): Define if addresses are sanitized. + +2013-12-24 Paul Eggert + + Automate the procedure for updating copyright year. + * build-aux/update-copyright: New file. + * make-dist: Distribute it. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-12-23 Andreas Schwab + + * configure.ac: Replace obsolete macro AC_CONFIG_HEADER by + AC_CONFIG_HEADERS. + +2013-12-19 Rüdiger Sonderfeld + + * .gitignore: Ignore refcard temporaries and info/*.info files. + +2013-12-17 Paul Eggert + + Merge from gnulib, incorporating: + 2013-12-17 gettimeofday: port recent C++ fix to Emacs + 2013-12-17 gettimeofday: fix C++ crosscompilation + 2013-12-17 qacl: port to Windows better + * lib/file-has-acl.c, lib/time.in.h, m4/gettimeofday.m4, m4/time_h.m4: + Update from gnulib. + * lib/gnulib.mk: Regenerate. + +2013-12-16 Paul Eggert + + * INSTALL: Clarify treatment of image libraries. + +2013-12-14 Paul Eggert + + Use bool for boolean, focusing on headers. + * configure.ac (PTY_OPEN, GC_MARK_SECONDARY_STACK): + Use bool for boolean. + +2013-12-14 Dani Moncayo + + * configure.ac (srcdir) [MINGW32]: If it is an absolute path, + force the format "/c/foo/bar" to simplify conversions to native + windows format. + +2013-12-13 Glenn Morris + + * INSTALL: No longer mention load-path and site-init/site-load. + +2013-12-12 Glenn Morris + + * Makefile.in (install-info): Handle missing info/dir. + (info_dir_deps): New variable. + (${srcdir}/info/dir): Depend on .texi files rather than .info files. + (check-info): Update topics. + * build-aux/make-info-dir: Use .texi files rather than .info files. + Update topics. + + * Makefile.in (install-info): Remove some useless subshells. + + Stop keeping info/dir in the repository. + * build-aux/dir_top: Move here from admin/. + * build-aux/make-info-dir: New script. + * Makefile.in (bootstrap-clean): Delete info/. + (info-dir, ${srcdir}/info/dir): New rules. + (info): Also make info-dir. + (check-info): Rename from check-info-dir. + Instead of info/dir entries, check @dircategory in info/*.info. + * make-dist: Use `info' rule rather than `info-real'. + No more info/COPYING (not even the right license for info/ files). + Distribute new build-aux files. + + * info/: Remove from repository. + +2013-12-11 Glenn Morris + + * info/dir: Add octave-mode. + +2013-12-11 Paul Eggert + + Remove the option of using libcrypto. + This scorches the earth and waits for spring; + see Ted Zlatanov and Stefan Monnier in + . + * configure.ac (with_openssl_default, HAVE_LIB_CRYPTO): Remove. + Do not say whether Emacs is configured to use a crypto library, + since it's no longer an option. + (gl_CRYPTO_CHECK): Define a dummy. + * lib/gl_openssl.h, m4/gl-openssl.m4: Remove. + +2013-12-10 Paul Eggert + + * configure.ac: Disable libcrypto by default. + + Merge from gnulib, incorporating: + 2013-12-07 md5, sha1, sha256, sha512: fix link error with partial lib + * m4/gl-openssl.m4: Update from gnulib. + +2013-12-08 Eli Zaretskii + + * configure.ac (HAVE_RSVG) [mingw32]: Don't link against librsvg + statically. + +2013-12-08 Paul Eggert + + * configure.ac: Simplify supression of GTK deprecation warning. + Move -DGDK_DISABLE_DEPRECATION_WARNINGS out of the command line + and into config.h, to shorten the command line when doing 'make'. + Don't AC_SUBST GTK_CFLAGS, as this is not needed. + + Use libcrypto's checksum implementations if available, for speed. + On commonly used platform libcrypto uses architecture-specific + assembly code, which is significantly faster than the C code we + were using. See Pádraig Brady's note in + . + Merge from gnulib, incorporating: + 2013-12-07 md5, sha1, sha256, sha512: add gl_SET_CRYPTO_CHECK_DEFAULT + 2013-12-07 md5, sha1, sha256, sha512: add 'auto', and set-default method + 2013-12-04 include_next: minimize code duplication + 2013-12-03 md5, sha1, sha256, sha512: support mandating use of openssl + 2013-12-02 md5, sha1, sha256, sha512: use openssl routines if available + * configure.ac (--without-all): Set with_openssl_default too. + Use gl_SET_CRYPTO_CHECK_DEFAULT to default to 'auto'. + (HAVE_LIB_CRYPTO): New var. + Say whether Emacs is configured to use a crypto library. + * lib/gl_openssl.h, m4/absolute-header.m4, m4/gl-openssl.m4: + New files, copied from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + * lib/md5.c, lib/md5.h, lib/sha1.c, lib/sha1.h: + * lib/sha256.c, lib/sha256.h, lib/sha512.c, lib/sha512.h: + * m4/include_next.m4, m4/md5.m4, m4/sha1.m4, m4/sha256.m4, m4/sha512.m4: + Update from gnulib. + +2013-12-01 Dmitry Gutov + + * .dir-locals.el (log-edit-move): Add the "Author: " header. + +2013-11-30 Dani Moncayo + + * build-aux/msys-to-w32 (w32pathlist): Do not translate paths + starting with %emacs_dir%. + +2013-11-30 Glenn Morris + + Stop keeping (most) generated cedet grammar files in the repository. + * configure.ac (SUBDIR_MAKEFILES, AC_CONFIG_FILES): + Add admin/grammars Makefile. + * Makefile.in (distclean, bootstrap-clean, maintainer-clean): + Also clean admin/grammars, if present. + +2013-11-29 Dani Moncayo + + * Makefile.in (epaths-force-w32): Fix 2013-11-20 typo. + +2013-11-29 Stefan Monnier + + * configure.ac (HAVE_MENUS): Remove. + +2013-11-28 Glenn Morris + + * configure.ac (PATH_SEP): Replace with pre-existing SEPCHAR. + +2013-11-28 Eli Zaretskii + + * GNUmakefile (Makefile): Don't use $(CFG). + (CFG): Don't compute. + + * configure.ac (PATH_SEP): Set and AC_SUBST. + +2013-11-27 Paul Eggert + + Merge from gnulib, incorporating: + 2013-11-13 getgroups: work around _DARWIN_C_SOURCE problem + * lib/getgroups.c: Update from gnulib. + +2013-11-27 Glenn Morris + + Move ja-dic, quail, leim-list.el from leim to lisp/leim. + * Makefile.in (abs_builddir, leimdir): Remove. + (buildlisppath, SUBDIR, COPYDIR, COPYDESTS): No more leim directory. + (epaths-force-w32): No longer set BLD. + (leim): Remove. + (install-arch-indep): No longer run or install leim. + (mostlyclean, clean): No longer run leim rule. + (bootstrap-clean): Change leim target. + (maintainer-clean): Add leim. + (check-declare): Remove leim. + * README: Update for leim changes. + * configure.ac (leimdir): Remove. + (standardlisppath): No more leimdir. + + * make-dist: Update for files from leim/ now being in lisp/leim/. + +2013-11-26 Glenn Morris + + Preload leim-list.el. + * Makefile.in (abs_builddir): New, set by configure. + (buildlisppath): Add leim/. + (epaths-force-w32): Set BLD. + +2013-11-21 Paul Eggert + + Fix some dependency problems that cause unnecessary recompiles. + * configure.ac (OLDXMENU_TARGET, OLDXMENU, OLDXMENU_DEPS): + Remove. + (LIBXMENU): Now is always either empty or a file name, + so that it can be used as a dependency. + +2013-11-20 Glenn Morris + + * make-dist: Distribute build-aux/msys-to-w32. + +2013-11-20 Dani Moncayo + + * build-aux/msys-to-w32: New file. + * Makefile.in (msys_to_w32, msys_lisppath_to_w32): Remove. + (msys_w32prefix_subst): Rename from msys_prefix_subst. + Operate on w32prefixpattern. + (epaths-force-w32): Use build-aux/msys-to-w32. + +2013-11-17 Paul Eggert + + * configure.ac (DEBUGGER_SEES_C_MACROS): Remove. + It apparently doesn't work for GCC 3, and I suppose it's more + trouble than it's worth to worry about this. + +2013-11-15 Paul Eggert + + * configure.ac (DEBUGGER_SEES_C_MACROS): New macro. + +2013-11-14 Paul Eggert + + Simplify, port and tune bool vector implementation. + * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): Remove. + +2013-11-13 Paul Eggert + + * Makefile.in (ACLOCAL_INPUTS): Add configure.ac. + +2013-11-12 Dani Moncayo + + * configure.ac [MINGW32]: Source nt/mingw-cfg.site. + * make-dist: Don't distribute nt/msysconfig.sh. + + * Makefile.in (epaths-force-w32): Simplify w32srcdir computation. + +2013-11-08 Paul Eggert + + Merge from gnulib, incorporating: + 2013-11-08 extern-inline: port better to OS X 10.9 + 2013-11-08 fpending: fix regression on DragonFly BSD + * lib/fpending.h, m4/extern-inline.m4, m4/fpending.m4: + Update from gnulib. + +2013-11-07 Paul Eggert + + Port to C11 aligned_alloc. + * configure.ac (GMALLOC_OBJ): Initialize to empty if !system_malloc + and doug_lea_malloc. + (aligned_alloc): Test for existence if !GMALLOC_OBJ and not darwin. + (posix_memalign): Test for existence only if !GMALLOC_OBJ and + not darwin and !aligned_alloc. + +2013-11-05 Glenn Morris + + * configure.ac (abs_srcdir) [MINGW32]: No point setting it here, + config.status computes it. + * Makefile.in (epaths-force-w32): Move srcdir tweak here. + + * autogen/: Remove directory. Move update_autogen to admin/. + * autogen.sh: Remove reference to copy_autogen. + * GNUmakefile (configure): + * Makefile.in (bootstrap): Do not try to run copy_autogen. + * config.bat: Use msdos/autogen rather than autogen. + +2013-11-05 Paul Eggert + + Simplify and port recent bool vector changes. + * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): + New symbols to configure. + +2013-11-04 Eli Zaretskii + + * configure.ac: Don't disallow builds in non-ASCII directories. + (Bug#15260) + +2013-11-04 Paul Eggert + + Port to stricter C99 platforms. + Merge from gnulib, incorporating: + 2013-11-03 intprops: port to Oracle Studio c99 + * lib/intprops.h: Update from gnulib. + +2013-11-02 Glenn Morris + + * Makefile.in (check): Depend on all. + +2013-10-31 Glenn Morris + + * configure.ac: Use [!...] rather than [^...], for ksh. (Bug#15769) + +2013-10-30 Glenn Morris + + * Makefile.in (distclean, bootstrap-clean, maintainer-clean): + Also clean admin/unidata, if present. + +2013-10-27 Glenn Morris + + * configure.ac: It seems installing in non-ASCII is not, in fact, ok. + +2013-10-25 Glenn Morris + + * configure.ac: It seems _installing_ in non-ASCII is ok, not building. + +2013-10-24 Glenn Morris + + * configure.ac: + * Makefile.in (install-arch-indep, install-etcdoc, install-info): + Avoid non-portable "`\" nesting. + + * configure.ac (CPPFLAGS) [mingw32]: Use abs_top_srcdir. + + * Makefile.in (abs_top_srcdir): New, set by configure. + +2013-10-23 Glenn Morris + + * configure.ac: Explicit error for non-ASCII directories. (Bug#15260) + + Progress towards allowing installation in directories with whitespace. + * Makefile.in (COPYDESTS, write_subdir, install-arch-dep) + (install-arch-indep, install-etcdoc, install-info, install-man) + (install-etc, uninstall, install-nt, uninstall-nt): + Quote entities that might contain whitespace. + * build-aux/update-subdirs: Handle whitespace in argument. + Check cd return value. + + Make building in directories with whitespace possible. (Bug#15675) + * configure.ac (srcdir): Don't make it absolute - abs_srcdir exists. + (src/.gdbinit): Use ac_abs_top_srcdir. + * Makefile.in (abs_srcdir): New, set by configure. + (buildlisppath, epaths-force-w32): Use abs_srcdir. + (install-arch-indep, install-etcdoc, install-info, install-man) + (install-etc): Quote entities that might contain whitespace. + +2013-10-23 Paul Eggert + + Merge from gnulib, incorporating: + 2013-10-14 acl: allow cross-compilation to Gentoo + 2013-10-18 extern-inline: make safe for -Wundef usage + 2013-09-30 fpending: use pure+const function attrs + * lib/fpending.h, m4/acl.m4, m4/extern-inline.m4: Update from gnulib. + +2013-10-13 Glenn Morris + + * configure.ac [alpha]: Explicit error in non-ELF case. (Bug#15601) + +2013-10-12 Paul Eggert + + Merge from gnulib, incorporating: + 2013-10-10 strtoumax: port to Solaris 8 + 2013-10-09 strtoimax, strtoumax: port to HP-UX 11.11 + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + * lib/inttypes.in.h, lib/strtoimax.c, m4/inttypes.m4, m4/strtoimax.m4: + * m4/strtoumax.m4: + Update from gnulib. + +2013-10-11 Stefan Monnier + + * configure.ac (LIBGNUTLS): Don't set LIBGNUTLS_* back to the empty + string when gnutls2 is installed but gnutls3 is not. + +2013-10-11 Teodor Zlatanov + + * configure.ac: Define HAVE_GNUTLS3 if GnuTLS v3 is found. + +2013-10-10 Barry Fishman (tiny change) + + * configure.ac: Update for giflib 5. (Bug#15531) + +2013-10-08 Eli Zaretskii + + * configure.ac (HAVE_MENUS): Define unconditionally. + +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + Do this by using the Gnulib modules for this. + This should generate faster code on non-GCC, non-MSC platforms, + and make the code a bit more portable, at least in theory. + * lib/count-one-bits.c, lib/count-one-bits.h: + * lib/count-trailing-zeros.c, lib/count-trailing-zeros.h: + * m4/count-one-bits.m4, m4/count-trailing-zeros.m4: + New files, copied from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-10-04 Paul Eggert + + Use hardware support for byteswapping on glibc x86 etc. + * lib/byteswap.in.h, m4/byteswap.m4: New files, copied from Gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-10-03 Paul Eggert + + Merge from gnulib, incorporating: + 2013-10-02 verify: new macro 'assume' + 2013-09-26 dup2, dup3: work around another cygwin crasher + 2013-09-26 getdtablesize: work around cygwin issue + +2013-09-25 Paul Eggert + + Merge from gnulib, incorporating: + 2013-09-24 manywarnings: enable nicer gcc warning messages + 2013-09-23 warnings: port --enable-gcc-warnings to Solaris Studio 12.3 + 2013-09-21 timespec: use the new TIMESPEC_RESOLUTION elsewhere + * configure.ac (WERROR_CFLAGS): Omit -fdiagnostics-show-option + and -funit-at-a-time, since manywarnings does that for us now. + +2013-09-23 Jan Djärv + + * configure.ac: With clang, check for and use -Wno-switch, + -Wno-tautological-constant-out-of-range-compare and -Wno-pointer-sign. + +2013-09-23 Daniel Colascione + + * configure.ac: Check for valgrind headers. + +2013-09-20 Xue Fuqiao + + * INSTALL: New homepage of libtiff. + +2013-09-20 Paul Eggert + + Work around performance bug on OS X 10.8 and earlier. + Perhaps Apple will fix this bug some day. + See the thread starting with Daniel Colascione's email in: + http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00343.html + * configure.ac (FORTIFY_SOUR): New verbatim section. + +2013-09-19 Paul Eggert + + Merge from gnulib, incorporating: + 2013-09-19 stdio: OS X port of putc_unlocked + extern inline + 2013-09-19 signal: OS X port of sigaddset etc. + extern inline + 2013-09-19 extern-inline: do not always suppress extern inline on OS X + 2013-09-17 getgroups: statement without effect + 2013-08-28 headers: check that _GL_INLINE_HEADER_BEGIN is defined + +2013-09-19 Eli Zaretskii + + * configure.ac [MINGW32]: Make sure the value of 'srcdir' + is in the full /d/foo/bar form. See the discussion in + http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00210.html, + and in particular + http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00252.html + and its followups, for the details. + +2013-09-17 Dmitry Antipov + + * configure.ac: Do not check for g_type_init because we + require glib >= 2.28 for GTK3, glib >= 2.10 for GTK2, + glib >= 2.26 for GSettings and glib >= 2.7.0 for GConf, so + suitable glib should provide g_type_init unconditionally. + +2013-09-15 Jan Djärv + + * configure.ac: Add check for OSX 10.5, required for macfont.o. + +2013-09-09 Glenn Morris + + * configure.ac (LDFLAGS_NOCOMBRELOC): New variable. + (LDFLAGS): Move nocombreloc option from here... + (LD_SWITCH_SYSTEM_TEMACS): ... to here. + +2013-09-08 Glenn Morris + + * configure.ac (--without-compress-install): + Rename from --without-compress-info. (Bug#9789) + (GZIP_INFO): Remove. + (GZIP_PROG): Allow --without-compress-install to disable it. + * Makefile.in (GZIP_INFO): Remove all references. + + * info/dir: Tweak emacs-gnutls entry. + +2013-09-07 Paul Eggert + + Port --without-x --enable-gcc-warnings to Fedora 19. + * configure.ac (WERROR_CFLAGS): Omit redundant use of + -Wmissing-field-initializers, -Wswitch, -Wtype-limits, + -Wunused-parameter. If there is no window system, also omit + -Wsuggest-attribute=const and -Wsuggest-attribute=noreturn; this + is needed for Fedora 19. + +2013-09-05 Dmitry Antipov + + Make --without-x compatible with --enable-gcc-warnings. + * configure.ac: If both --without-x and --enable-gcc-warnings are + specified, use -Wno-unused-variable, -Wno-unused-but-set-variable + and -Wno-unused-but-set-parameter. + +2013-09-04 Paul Eggert + + Makefile improvements. + * Makefile.in (lib): Depend on am--refresh, to avoid a race. + (src): Remove duplicate dependency on FRC. + Invoke just one submake, not two. Avoid the need for 'pwd'. + +2013-09-02 Jan Djärv + + * configure.ac: Add ns_check_file. + +2013-08-31 Glenn Morris + + * configure.ac (--with-sound): Rename ossaudio to bsd-ossaudio, + and voxware to oss. + +2013-08-31 Ulrich Müller + + * configure.ac: Allow for --with-sound=voxware that will enable + sound but otherwise disable ALSA. This will use the OSS device, + typically /dev/dsp, for sound output. (Bug#15067) + +2013-08-31 Glenn Morris + + * make-dist: Update for nt/INSTALL* changes. + +2013-08-28 Paul Eggert + + * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-28 Stefan Monnier + + * configure.ac (DOCMISC_W32): New var to replace DOCMISC_*_W32. + +2013-08-27 Paul Eggert + + Simplify EMACS_TIME-related code. + Merge from gnulib, incorporating: + 2013-08-27 timespec: new convenience constants and function + +2013-08-27 Dmitry Antipov + + * configure.ac (DOCMISC_DVI_W32, DOCMISC_HTML_W32, DOCMISC_INFO_W32) + (DOCMISC_PDF_W32, DOCMISC_PS_W32): No spaces! + +2013-08-27 Glenn Morris + + * configure.ac (emacs_broken_SIGIO): No longer set on gnu-kfreebsd. + + * configure.ac (DOCMISC_DVI_W32, DOCMISC_HTML_W32, DOCMISC_INFO_W32) + (DOCMISC_PDF_W32, DOCMISC_PS_W32): New output variables. + * Makefile.in (check-info-dir): Ignore efaq-w32. + + * Makefile.in (mostlyclean, clean, distclean, bootstrap-clean) + (maintainer-clean, check-declare): Remove pointless subshells. + Check cd return value. + +2013-08-26 Paul Eggert + + Minor merge from gnulib (mostly just for texinfo.tex). + +2013-08-22 Paul Eggert + + * configure.ac (EMACS_CONFIG_OPTIONS): Quote systematically (Bug#13274). + This improves on the patch already installed, by quoting options + that contain spaces and suchlike systematically, so that + EMACS_CONFIG_OPTIONS is no longer ambiguous when options contain + these characters. + +2013-08-21 Paul Eggert + + Port close-on-exec pty creation to FreeBSD 9.1-RELEASE (Bug#15129). + * configure.ac (PTY_OPEN): If posix_openpt with O_CLOEXEC fails + and reports EINVAL, try it again without O_CLOEXEC. This should + port PTY_OPEN to FreeBSD 9, which stupidly rejects O_CLOEXEC. + What were they thinking? + +2013-08-20 Paul Eggert + + * Makefile.in (distclean, bootstrap-clean, maintainer-clean): + Fix shell-operator precedence problem in previous change. + +2013-08-20 Glenn Morris + + * Makefile.in (distclean, bootstrap-clean, maintainer-clean): + Clean test/automated if present. + +2013-08-19 Paul Eggert + + Merge from gnulib, incorporating: + 2013-08-15 warnings: minor optimization + 2013-08-15 warnings: check -Wfoo rather than -Wno-foo + +2013-08-15 Ken Brown + + * configure.ac (G_SLICE_ALWAYS_MALLOC): Update comment. + +2013-08-15 Glenn Morris + + * make-dist: Do not distribute etc/refcards TeX intermediate files. + * Makefile.in (install-arch-indep): + Do not install etc/refcards TeX intermediate files. + +2013-08-14 Ulrich Müller + + * configure.ac (EMACS_CONFIGURATION): Escape backslashes. (Bug#15091) + +2013-08-12 Eli Zaretskii + + * configure.ac (HAVE_ZLIB): Don't use -lz on MinGW. + +2013-08-12 Paul Eggert + + Minor zlib configuration tweaks. + * configure.ac (HAVE_ZLIB): Don't assume zlib is linked if PNG is. + +2013-08-12 Eli Zaretskii + + * configure.ac (LIBZ): Comment on w32 peculiarities regarding LIBZ. + +2013-08-12 Paul Eggert + + Merge from gnulib, incorporating: + 2013-08-11 fpending: port to recent Cygwin change to stdio_ext.h + 2013-08-10 sys_time: port to OpenBSD + +2013-08-12 Glenn Morris + + * configure.ac (etcdocdir): Rename from docdir, to avoid confusion + with configure's standard --docdir argument. All uses updated. + * Makefile.in (etcdocdir): Rename from docdir. All uses updated. + (install-etcdoc): Rename from install-doc. All uses updated. + (uninstall): Run uninstall-doc. + (PSS): Add misc-ps. + (INSTALL_DVI, INSTALL_HTML, INSTALL_PDF, INSTALL_PS) + (INSTALL_DOC, UNINSTALL_DVI, UNINSTALL_HTML, UNINSTALL_PDF) + (UNINSTALL_PS, UNINSTALL_DOC): New variables. + ($(INSTALL_DOC), install-doc, install-dvi, install-html, install-pdf) + (install-ps, $(UNINSTALL_DOC), uninstall-doc, uninstall-dvi) + (uninstall-html, uninstall-pdf, uninstall-ps): New .PHONY rules. + +2013-08-11 Paul Eggert + + Add --with-zlib to 'configure'. + * configure.ac: Add --with-zlib option to 'configure', so that Emacs + can be built without zlib. Don't assume that -lz is needed on + non-PNG hosts. Mention zlib configuration status in 'configure' output. + +2013-08-11 Lars Magne Ingebrigtsen + + * configure.ac: Test for zlib. + +2013-08-10 Eli Zaretskii + + * configure.ac: Define and substitute UPDATE_MANIFEST. + +2013-08-04 Stephen Berman + + * info/dir: Add todo-mode. + +2013-08-04 Paul Eggert + + Fix some minor races in hosts lacking mkostemp (Bug#15015). + Gnulib's emulation of mkostemp doesn't have races that Emacs's does. + * configure.ac (mkostemp): Remove check for this function; + gnulib does the check now. + (mkstemp): Remove check for this no-longer-used function. + * lib/mkostemp.c, lib/secure_getenv.c, lib/tempname.c, lib/tempname.h: + * m4/mkostemp.m4, m4/secure_getenv.m4, m4/tempname.m4: + New files, copied from Gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-07-29 Michael Albinus + + * INSTALL (DETAILED BUILDING AND INSTALLATION): Add + --without-file-notification to --without-all. + +2013-07-29 Xue Fuqiao + + * INSTALL: Fix description. + +2013-07-27 Glenn Morris + + * configure.ac: Extend the --with-sound option to allow + specification of OSS or ALSA (see bug#14812#64). + +2013-07-25 Glenn Morris + + * info/dir: Add ido. + + * make-dist: Add a --tests option, to include test/. + +2013-07-24 Glenn Morris + + * configure.ac: Use self-descriptive tags for AC_CONFIG_COMMANDS. + +2013-07-23 Glenn Morris + + * configure.ac (etc, lisp): No need to create specially. + Configure already creates lisp, src/Makefile now creates etc. + +2013-07-23 Paul Eggert + + Port to GNU/Linux systems with tinfo but not ncurses. + * configure.ac (USE_NCURSES): New symbol. + +2013-07-20 Paul Eggert + + Fix array bounds violation when pty allocation fails. + * configure.ac (PTY_TTY_NAME_SPRINTF): Use PTY_NAME_SIZE, + not sizeof pty_name, since pty_name is now a pointer to the array. + +2013-07-13 Paul Eggert + + * configure.ac: Simplify --with-file-notification handling. + +2013-07-12 Glenn Morris + + * configure.ac: If with-file-notification=yes, if gfile not found, + go on to try inotify (not on MS Windows or Nextstep). + +2013-07-12 Paul Eggert + + Fix races with threads and file descriptors. + * configure.ac (PTY_TTY_NAME_SPRINTF): Use emacs_close, not close. + +2013-07-10 Paul Eggert + + * Makefile.in (removenullpaths): Remove adjacent null paths (Bug#14835). + +2013-07-09 Peter Rosin (tiny change> + + * configure.ac (HAVE_W32): Avoid nested functions (the second + argument of AC_LANG_PROGRAM is already expanded inside a + function). (Bug#14830) + +2013-07-09 Paul Eggert + + Port recent close-on-exec changes to Cygwin (Bug#14821). + * lib/binary-io.c, lib/binary-io.h: New files. + Merge from gnulib, incorporating: + 2013-07-09 accept4, dup3, pipe2: port to Cygwin + * lib/pipe2.c: Update from gnulib, as part of this merge. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + + Handle errno and exit status a bit more carefully. + * lib/ignore-value.h: Remove this gnulib-imported file. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-07-08 Magnus Henoch (tiny change) + + * configure.ac (HAVE_IMAGEMAGICK): Check on NS also (Bug#14798). + +2013-07-08 Paul Eggert + + Try to fix FreeBSD 9.1 porting problem (Bug#14812). + This incorporates the following merge from gnulib: + 2013-07-07 stdalign, verify: port to FreeBSD 9.1, to C11, and to C++11 + +2013-07-07 Paul Eggert + + Port to Ubuntu 10 (Bug#14803). + * configure.ac (accept4): New function to check for. + + Make file descriptors close-on-exec when possible (Bug#14803). + * configure.ac (mkostemp): New function to check for. + (PTY_OPEN): Pass O_CLOEXEC to posix_openpt. + * lib/fcntl.c, lib/getdtablesize.c, lib/pipe2.c, m4/fcntl.m4: + * m4/getdtablesize.m4, m4/pipe2.m4: New files, taken from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-07-03 Christoph Egger (tiny change) + + * configure.ac (emacs_broken_SIGIO): Set on gnu-kfreebsd to avoid hang. + http://bugs.debian.org/712974 + +2013-07-02 Paul Eggert + + Remove some unused macros from 'configure'. + * configure.ac (HAVE_SOUNDCARD_H, HAVE_LINUX_VERSION_H, HAVE_SPEED_T) + (HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY) + (HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION, HAVE_UTIMES) + (HAVE_LIBHESIOD, HAVE_LIBRESOLV, HAVE_LIBCOM_ERR, HAVE_LIBCRYPTO) + (HAVE_LIBK5CRYPTO, HAVE_LIBKRB5, HAVE_LIBDES425, HAVE_LIBDES) + (HAVE_LIBKRB4, HAVE_LIBKRB, HAVE_DES_H, HAVE_KERBEROSIV_DES_H) + (HAVE_DEV_PTMX, DEVICE_SEP, USG5): + Remove these macros, as they are not used. + (sys_siglist): Remove macro; src/sysdep.c now does this. + + * configure.ac (GTK_COMPILES): Check API a bit more carefully. + Also check that it links. Say whether it compiled and linked. + +2013-07-01 Paul Eggert + + Merge from gnulib, incorporating: + 2013-06-23 ignore-value: port to gcc -pedantic + 2013-06-21 extern-inline: port to gcc -std=c89 + +2013-06-30 Paul Eggert + + Do not use GTK 3 if it exists but cannot be compiled. + * configure.ac: Leave GTK_OBJ and term_header alone if GTK 3 + exists but cannot be compiled. + +2013-06-27 Juanma Barranquero + + * Makefile.in (install-arch-indep): Do not create directories passed + with --enable-locallisppath. + +2013-06-24 Glenn Morris + + * configure.ac: Include X11/X.h when testing for Xft.h. (Bug#14684) + +2013-06-22 Juanma Barranquero + + * .bzrignore: Add GNU idutils ID database file. + +2013-06-21 YAMAMOTO Mitsuharu + + * configure.ac (HAVE_LIBXML2): Try built-in libxml2 on OS X 10.8 + as a fallback. + +2013-06-20 Stefan Monnier + + * .bzrignore: Don't unignore cl-loaddefs.el. + +2013-06-20 Rüdiger Sonderfeld + + * configure.ac (log2): Check for this function. + +2013-06-19 Juanma Barranquero + + * .bzrignore: Add GNU GLOBAL files. + +2013-06-17 Paul Eggert + + Use functions, not macros, for XINT etc. (Bug#11935). + * configure.ac (WARN_CFLAGS): Remove -Wbad-function-cast, + as it generates bogus warnings about reasonable casts of calls. + +2013-06-16 Paul Eggert + + * configure.ac: Report ACL usage at the end (Bug#14612). + +2013-06-11 Paul Eggert + + --without-all should imply --with-file-notification=no. (Bug#14569) + * configure.ac (with_file_notification): Default to $with_features. + +2013-06-09 Paul Eggert + + Merge from gnulib, incorporating: + 2013-06-02 sig2str: port to C++ + 2013-05-29 c-ctype, regex, verify: port to gcc -std=c90 -pedantic + +2013-06-08 Jan Djärv + + * configure.ac (HAVE_GLIB): Only set XGSELOBJ if HAVE_NS = no. + (with_file_notification): Don't set to gfile if with_ns = yes. + +2013-06-07 Richard Copley (tiny change) + + * Makefile.in (msys_to_w32): Modify to support d:\foo file names. + (msys_lisppath_to_w32, msys_prefix_subst, msys_sed_sh_escape): + New variables. + (epaths-force-w32): Use them. (Bug#14513) + +2013-06-03 Michael Albinus + + * configure.ac (HAVE_GFILENOTIFY): Check for gio >= 2.24. + +2013-06-03 Eli Zaretskii + + * configure.ac (HAVE_GFILENOTIFY): Do not change $LIBS. + (GFILENOTIFY_CFLAGS, GFILENOTIFY_LIBS): Substitute. + +2013-06-03 Jan Djärv + + * configure.ac (HAVE_GLIB): Add GLib check. Set XGSELOBJ if GLib is + used. Remove xgselect.o from XOBJ. + +2013-06-03 Michael Albinus + + * configure.ac (file-notification): New option, replaces inotify option. + (HAVE_W32): Remove w32notify.o. + (with_file_notification): Add checks for glib and w32. Adapt check + for inotify. + (Summary): Add entry for file notification. + + * autogen/config.in: Add entries for HAVE_GFILENOTIFY, + HAVE_W32NOTIFY and USE_FILE_NOTIFY. + +2013-06-02 Juanma Barranquero + + * .bzrignore: Ignore dirs libexec/, share/ and var/. + +2013-05-29 Xue Fuqiao + + * INSTALL: Fix description. + +2013-05-27 YAMAMOTO Mitsuharu + + * configure.ac (HAVE_XRANDR): Check availability of + XRRGetScreenResources rather than that of XRRQueryExtension. + +2013-05-18 Eli Zaretskii + + * make-dist (files): Add nt/msysconfig.sh, nt/mingw-cfg.site, + nt/epaths.nt, and nt/INSTALL.MSYS. + +2013-05-18 Paul Eggert + + Port --enable-gcc-warnings to clang. + * configure.ac (nw): Remove obsolescent warnings. + These aren't needed for clang, or for gcc for that matter. + (emacs_cv_clang): New var, which tests for clang. + Omit warnings that clang is too picky about. + (GLIB_DISABLE_DEPRECATION_WARNINGS): Define this; + needed for Ubuntu 13.04 + clang + --enable-gcc-warnings. + + * make-dist (files): Add nt/Makefile.in, nt/gnulib.mk. + Otherwise, 'configure; make' fails on non-Windows builds. + +2013-05-16 Eli Zaretskii + + * lib/Makefile.am: If building for MS-Windows, include + nt/gnulib.mk instead of lib/gnulib.mk. + + * configure.ac: Adapt to MSYS build on MS-Windows. + + * Makefile.in (NTDIR): New variable, for the MSYS build on + MS-Windows. + (SUBDIR): Add $(NTDIR). + (.PHONY): Add epaths-force-w32. + (msys_to_w32): New variable. + (epaths-force-w32, install-nt, uninstall-nt): New targets. + (lib-src src): Add $(NTLIB) to prerequisites. + (lib lib-src lisp leim nt): Add 'nt'. + (config.status): Use $(CFG). + (.PHONY): Add install-$(NTDIR) and uninstall-$(NTDIR). + (install, install-arch-dep): Add install-$(NTDIR). + (uninstall): Depend on uninstall-$(NTDIR). + (mostlyclean, clean, distclean, bootstrap-clean): Add 'nt'. + + * GNUmakefile (CFG): New variable, uses mingw-cfg.site as + CONFIG_SITE for the MSYS build on MS-Windows. + (Makefile): Use $(CFG). + + * .bzrignore: Ignore *.res, *.tmp, and *.map. Remove + src/emacs.res. + +2013-05-16 Paul Eggert + + Merge from gnulib, incorporating: + 2013-05-15 manywarnings: update for GCC 4.8.0 + 2013-05-15 stdio: use __REDIRECT for fwrite, fwrite_unlocked + 2013-05-15 sig2str, stdio, warnings: port to clang + +2013-05-15 Stefan Monnier + + * Makefile.in (install-doc): DOC file is not version specific any more. + * .bzrignore: Don't ignore DOC-* any more. + +2013-05-13 Paul Eggert + + * configure.ac (LD_SWITCH_SYSTEM_TEMACS): OpenBSD needs -nopie. + Reported privately by Han Boetes . + +2013-05-08 Juanma Barranquero + + * lib/makefile.w32-in (ACL_H): New macro. + ($(BLD)/acl-errno-valid.$(O)): Update dependencies. + +2013-05-07 Paul Eggert + + Use Gnulib ACL implementation, for benefit of Solaris etc. (Bug#14295) + * configure.ac: Remove -with-acl option, since Gnulib does that for + us now. + (LIBACL_LIBS): Remove; no longer needed. + * lib/Makefile.am (CLEANFILES, SUFFIXES): New (empty) macros, + for the benefit of the new ACL implementation. + * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/acl-errno-valid.$(O). + ($(BLD)/acl-errno-valid.$(O)): New rule. + * lib/acl-errno-valid.c, lib/acl-internal.h, lib/acl.h: + * lib/acl_entries.c, lib/errno.in.h, lib/file-has-acl.c: + * lib/qcopy-acl.c, lib/qset-acl.c, m4/acl.m4, m4/errno_h.m4: + New files, taken from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2013-05-07 Jan Djärv + + * configure.ac (HAVE_XRANDR, HAVE_XINERAMA): Define if available. + (XRANDR_LIBS, XINERAMA_LIBS): New AC_SUBSTs. + +2013-05-06 Paul Eggert + + Merge from gnulib, incorporating: + 2013-04-30 utimens, utimensat: work around Solaris UTIME_OMIT bug + +2013-05-01 Paul Eggert + + * make-dist: Keep necessary restrictions on file access. + +2013-04-29 Paul Eggert + + Merge from gnulib, incorporating: + 2013-04-28 extern-inline: work around bug in Sun c99 + +2013-04-27 Paul Eggert + + Merge from gnulib, incorporating: + 2013-04-27 alignof, intprops, malloca: port better to IBM's C compiler + +2013-04-26 Paul Eggert + + Port better to AIX (Bug#14258). + * configure.ac (CFLAGS): Append -O if the user did not specify CFLAGS, + we did not already infer an optimization option, and -O works. + AIX xlc needs -O, otherwise garbage collection doesn't work. + +2013-04-22 Paul Eggert + + * make-dist: Do not distribute admin/unidata/Makefile. + It is generated by 'configure'. + + * build-aux/update-subdirs: Don't leave subdirs.el~ behind. + It messes up 'make distclean', and contains no useful information + because it's a copy of subdirs.el. + +2013-04-18 John Marino (tiny change) + + * configure.ac: Add DragonFly BSD, mostly same as FreeBSD. (Bug#14068) + +2013-04-18 Glenn Morris + + * configure.ac (AC_PROG_LN_S): Remove, too restrictive. + (LN_S_FILEONLY): New output variable. + * Makefile.in (LN_S): Remove. + (LN_S_FILEONLY): New, set by configure. + (install-arch-dep): Use LN_S_FILEONLY rather than LN_S. + +2013-04-12 Ken Brown + + * configure.ac (canonical): Adapt to 64-bit Cygwin, for which + `canonical' is `x86_64-unknown-cygwin'. + +2013-04-09 Ken Brown + + * configure.ac (W32_RES_LINK): Remove unneeded linker directive + `-Wl,-bpe-i386', which is confusing in the 64-bit case. + (Bug#12993) + +2013-04-07 Paul Eggert + + Fix --enable-profiling bug introduced by 2013-02-25 change (Bug#13783). + * configure.ac (LD_SWITCH_SYSTEM_TEMACS): Append -pg if profiling + and if not on GNU/Linux or FreeBSD. + * lib/Makefile.am (AM_CFLAGS): Add $(PROFILING_CFLAGS), so that + lib/*.o is profiled too. + +2013-03-30 Paul Eggert + + Merge from gnulib, incorporating: + 2013-03-29 stdalign: port to stricter ISO C11 + This helps to run 'configure' on MS-Windows; see Eli Zaretskii in + . + +2013-03-27 Paul Eggert + + * configure.ac (HAVE_XKBGETKEYBOARD): Remove. + Subsumed by HAVE_XKB. All uses changed. + +2013-03-25 Jan Djärv + + * configure.ac (HAVE_XKB): Define if Xkb is present. + +2013-03-24 Paul Eggert + + Merge from gnulib, incorporating: + 2013-03-21 sys_select, sys_time: port 2013-01-30 fix to Cygwin + +2013-03-18 Paul Eggert + + Fix bug when building Emacs with a GNU Make submake (Bug#13962). + * Makefile.in (QUIET_SUBMAKE): New macro. + (install-info, uninstall): Use it. + + Emacs crashes with ImageMagick 6.8.2-3 through 6.8.3-9 (Bug#13867). + * configure.ac (IMAGEMAGICK_MODULE): Reject 6.8.2. + We want to reject 6.8.2-3 through 6.8.3-9, but there seems to be + no way to do this in pkg-config, so make do with a reasonable + approximation. + + Automate the build of ja-dic.el (Bug#13984). + * .bzrignore: Add leim/ja-dic/. + +2013-03-13 Paul Eggert + + File synchronization fixes (Bug#13944). + * configure.ac (BSD_SYSTEM, BSD_SYSTEM_AHB): Remove; no longer needed. + (fsync): Remove check; now done by gnulib. + * lib/fdatasync.c, lib/fsync.c, m4/fdatasync.m4, m4/fsync.m4: + New files, from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + + Merge from gnulib, incorporating: + 2013-03-13 putenv: port to Solaris 10 + 2013-03-12 mktime: fix configure typo + 2013-03-11 regex: port to mingw's recent addition of undeclared alarm + 2013-03-11 putenv: avoid compilation warning on mingw + 2013-03-11 unistd: don't prevent Tru64 Unix from using gnulib strtod. + +2013-03-11 Glenn Morris + + * Merge in all changes up to version 24.3 release. + +2013-03-06 Paul Eggert + + * configure.ac (TERM_HEADER): Remove duplicate definition (Bug#13872). + It can mess up 'configure' runs. + +2013-03-05 Glenn Morris + + * Makefile.in (install-man): Ignore gzip exit status. + +2013-03-03 Glenn Morris + + * make-dist: Remove lzma (it's replaced by xz). + 2013-03-01 Paul Eggert Merge from gnulib, incorporating: @@ -18,11 +1279,6 @@ not always needed. (HAVE_DATA_START): New macro. -2013-02-18 Aidan Gauland - - * lisp/eshell/em-cmpl.el: Corrected "context-related help" - keybinding in commentary. - 2013-02-21 Paul Eggert Parallelize documentation builds. @@ -35,11 +1291,6 @@ (info-real): Depend on $(INFOS) rather than doing it sequentially. (dvi): Depend on $(DVIS) rather than doing it sequentially. -2013-02-18 Aidan Gauland - - * doc/misc/eshell.texi: Added documentation for Eshell insert - output redirection operator, >>>. - 2013-02-15 Paul Eggert Fix AIX port (Bug#13650). @@ -108,7 +1359,7 @@ 2013-01-23 Giorgos Keramidas (tiny change) - * .bzrignore: add lib-src/blessmail. + * .bzrignore: Add lib-src/blessmail. 2013-01-23 Paul Eggert @@ -226,7 +1477,7 @@ 2012-12-14 Paul Eggert - Fix permissions bugs with setgid directories etc. (Bug#13125) + Fix permissions bugs with setgid directories etc. (Bug#13125) * configure.ac (BSD4_2): Remove; no longer needed. 2012-12-13 Glenn Morris @@ -257,7 +1508,7 @@ 2012-12-10 Daniel Colascione - * .bzrignore: add src/emacs.res. + * .bzrignore: Add src/emacs.res. * configure.ac (W32_RES, W32_RES_LINK, WINDRES): Teach the cygw32 build how to compile Windows resource files; use these variables @@ -528,11 +1779,6 @@ Merge from gnulib, incorporating: 2012-09-22 sockets, sys_stat: remove AC_C_INLINE in MSVC-only cases -2012-09-19 Tassilo Horn - - * doc/emacs/misc.texi (DocView Slicing): Document new slice from - BoundingBox feature. - 2012-09-18 Jan Djärv * configure.ac (HAVE_GTK): Mention if we use GTK2 or GTK3. @@ -866,9 +2112,8 @@ All uses changed to waitpid and WEXITSTATUS. Avoid needless autoheader after autogen.sh. - * src/stamp-h.in: Remove from bzr repository; no longer needed there. - * .bzrignore: Add it. - * autogen.sh: Create it. + * .bzrignore: Add src/stamp-h.in. + * autogen.sh: Create src/stamp-h.in. 2012-08-01 Glenn Morris @@ -969,11 +2214,6 @@ * configure.ac (opsysfile): Set to empty on aix4-2, freebsd, gnu-linux, gnu-kfreebsd; and to usg5-4-common.h on sol2*, unixware. -2012-07-30 Paul Eggert - - Merge from gnulib, incorporating: - * doc/misc/texinfo.tex: Update to 2012-07-29.17 version. - 2012-07-29 Jan Djärv * Makefile.in (install-arch-indep): Handle space in locallisppath. @@ -1495,7 +2735,7 @@ New files. * build-aux/move-if-change, build-aux/snippet/_Noreturn.h: * build-aux/snippet/arg-nonnull.h, build-aux/snippet/c++defs.h: - * build-aux/snippet/warn-on-use.h, doc/misc/texinfo.tex: + * build-aux/snippet/warn-on-use.h: * lib/alloca.in.h, lib/allocator.h, lib/careadlinkat.c: * lib/careadlinkat.h, lib/dosname.h, lib/dup2.c, lib/filemode.c: * lib/filemode.h, lib/ftoastr.c, lib/ftoastr.h, lib/getloadavg.c: @@ -1594,7 +2834,7 @@ * Makefile.in (install-arch-indep, install-doc, install-info) (uninstall): Scrap superfluous subshells. -2012-05-19 Ulrich Mueller +2012-05-19 Ulrich Müller * Makefile.in (install-etc): Respect DESTDIR. (Bug#11518) @@ -1848,7 +3088,6 @@ (WARN_CFLAGS, GNULIB_WARN_CFLAGS): New variable. (PKG_CHECK_MODULES, C_SWITCH_X_SITE): Use -isystem rather than -I, when including system files with GCC. - * etc/NEWS: Mention --enable-gcc-warnings. * INSTALL (DETAILED BUILDING AND INSTALLATION): Likewise. * lib/Makefile.am (AM_CFLAGS): New macro. * m4/manywarnings.m4, m4/warnings.m4: New files, from gnulib. @@ -1916,7 +3155,7 @@ 2012-02-05 Christoph Scholtes - * make-dist (README.W32): Include file in source tarball. (Bug#9750) + * make-dist (README.W32): Include file in source tarball. (Bug#9750) * lib/makefile.w32-in (PRAGMA_SYSTEM_HEADER): Move to platform specific makefiles to support getopt_.h generation with MSVC. @@ -2121,7 +3360,7 @@ * Makefile.in (GNULIB_TOOL_FLAGS): Avoid msvc-inval, msvc-nothrow, pathmax, and raise, since these are needed only to address MSVC-related issues that Emacs doesn't have. - * doc/misc/texinfo.tex, lib/dup2.c, lib/gnulib.mk, lib/signal.in.h: + * lib/dup2.c, lib/gnulib.mk, lib/signal.in.h: * lib/sigprocmask.c, lib/stat.c, lib/stdio.in.h, lib/sys_stat.in.h: * lib/unistd.in.h, m4/dup2.m4, m4/getloadavg.m4, m4/gl-comp.m4: * m4/include_next.m4, m4/signal_h.m4, m4/signalblocking.m4: @@ -2790,7 +4029,7 @@ src/makefile.w32-in and adapt. Depend on stamp_BLD. (GNULIBOBJS): Add $(BLD)/filemode.$(O). -2011-02-20 Paul Eggert +2011-02-21 Paul Eggert Import filemode module from gnulib. * .bzrignore: Add lib/sys/. @@ -2799,7 +4038,6 @@ * 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: @@ -2836,8 +4074,6 @@ * 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 @@ -2857,7 +4093,6 @@ 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. @@ -2871,7 +4106,7 @@ * 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. + Regenerate. 2011-02-15 Paul Eggert @@ -3298,7 +4533,7 @@ * m4/gnulib-common.m4, m4/gnulib-comp.m4, m4/gnulib-tool.m4, missing: New files, generated automatically, with 'make sync-from-gnulib' followed by 'make'. - * configure, lisp/dired.el, src/config.in: Regenerate. + * configure: Regenerate. Automate syncing from gnulib. * INSTALL, README: Document new subdirectory 'lib'. @@ -3370,7 +4605,7 @@ * Makefile.in (install-arch-indep, info): Replace MAKEINFO = off with HAVE_MAKEINFO = no. -2010-12-29 Ulrich Mueller +2010-12-29 Ulrich Müller * configure.in: Make gameuser configurable (Bug#7717). @@ -4580,7 +5815,7 @@ * info/dir: Untabify. -2008-11-28 Ulrich Mueller +2008-11-28 Ulrich Müller * configure.in: Fix last change. @@ -4643,7 +5878,7 @@ * configure (*-sunos5*, *-solaris*): Use the new file sol2-10.h. Use sol2-6.h for Solaris 7-9. -2008-10-18 Ulrich Mueller +2008-10-18 Ulrich Müller * configure.in: Add support for GNU/Linux on SuperH. @@ -4727,7 +5962,7 @@ * configure.in (COCOA_EXPERIMENTAL_CTRL_G): Fix 2008-08-04 change. -2008-08-05 Ulrich Mueller +2008-08-05 Ulrich Müller * configure.in: Add checks for krb5_error.text and krb5_error.e_text struct members. @@ -5095,7 +6330,7 @@ * configure.in (--with-gcc): Remove. * INSTALL (DETAILED BUILDING AND INSTALLATION): Remove --with-gcc. -2008-02-05 Ulrich Mueller +2008-02-05 Ulrich Müller * INSTALL: Recommend giflib, not libungif. @@ -5117,7 +6352,7 @@ * configure.in: For libotf and m17n-flt checks, set shell vars HAVE_LIBOTF and HAVE_M17N_FLT instead of pkg_check_libotf and pkg_check_m17n_flt, respectively, for the sake of the summary output. - Reported by Ulrich Mueller. + Reported by Ulrich Müller. 2008-02-02 Eli Zaretskii @@ -5431,7 +6666,7 @@ * configure.in: Put quotes around nested macro calls. -2007-08-31 Ulrich Mueller (tiny change) +2007-08-31 Ulrich Müller (tiny change) * configure.in: Fix typo. * configure: Regenerate. @@ -12044,7 +13279,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2013 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/GNUmakefile b/GNUmakefile index b829e93b498..22c57f5cb5b 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -1,6 +1,6 @@ # Build Emacs from a fresh tarball or version-control checkout. -# Copyright (C) 2011-2013 Free Software Foundation, Inc. +# Copyright (C) 2011-2014 Free Software Foundation, Inc. # # This file is part of GNU Emacs. # @@ -32,7 +32,6 @@ # run "configure" by hand. But run autogen.sh first, if the source # was checked out directly from the repository. - # If a Makefile already exists, just use it. ifeq ($(wildcard Makefile),Makefile) @@ -63,8 +62,8 @@ default $(filter-out configure Makefile,$(MAKECMDGOALS)): Makefile configure: @echo >&2 'There seems to be no "configure" file in this directory.' - @echo >&2 'Running ./autogen.sh || autogen/copy_autogen ...' - ./autogen.sh || autogen/copy_autogen + @echo >&2 'Running ./autogen.sh ...' + ./autogen.sh @echo >&2 '"configure" file built.' Makefile: configure diff --git a/INSTALL b/INSTALL index ec19e49b260..ea0331da62f 100644 --- a/INSTALL +++ b/INSTALL @@ -1,14 +1,14 @@ GNU Emacs Installation Guide -Copyright (C) 1992, 1994, 1996-1997, 2000-2013 - Free Software Foundation, Inc. +Copyright (C) 1992, 1994, 1996-1997, 2000-2014 Free Software Foundation, +Inc. See the end of the file for license conditions. This file contains general information on building GNU Emacs. For more information specific to the MS-Windows, GNUstep/Mac OS X, and MS-DOS ports, also read the files nt/INSTALL, nextstep/INSTALL, and -msdos/INSTALL. For information about building from a Bazaar checkout -(rather than a release), also read the file INSTALL.BZR. +msdos/INSTALL. For information about building from a repository checkout +(rather than a release), also read the file INSTALL.REPO. BASIC INSTALLATION @@ -62,32 +62,24 @@ sections if you need to. name, where to find various headers and libraries, etc. Refer to the section DETAILED BUILDING AND INSTALLATION below. - If `configure' didn't find some (optional) image support libraries, - such as Xpm, jpeg, etc., and you want to use them, refer to the - subsection "Image support libraries" below. + If `configure' didn't find some image support libraries, such as + Xpm and jpeg, refer to "Image support libraries" below. If the details printed by `configure' don't make any sense to you, but there are no obvious errors, assume that `configure' did its job and proceed. - 4. If you need to run the `configure' script more than once (e.g., - with some non-default options), always clean the source - directories before running `configure' again: - - make distclean - ./configure - - 5. Invoke the `make' program: + 4. Invoke the `make' program: make - 6. If `make' succeeds, it will build an executable program `emacs' + 5. If `make' succeeds, it will build an executable program `emacs' in the `src' directory. You can try this program, to make sure it works: src/emacs -Q - 7. Assuming that the program `src/emacs' starts and displays its + 6. Assuming that the program `src/emacs' starts and displays its opening screen, you can install the program and its auxiliary files into their installation directories: @@ -101,6 +93,10 @@ sections if you need to. You can delete the entire build directory if you do not plan to build Emacs again, but it can be useful to keep for debugging. + If you want to build Emacs again with different configure options, + first clean the source directories: + + make distclean Note that the install automatically saves space by compressing (provided you have the `gzip' program) those installed Lisp source (.el) @@ -120,19 +116,7 @@ packages. Note that if there is a separate `dev' or `devel' package, for use at compilation time rather than run time, you will need that as well as the corresponding run time package; typically the dev package will contain header files and a library archive. Otherwise, -you can download and build libraries from sources. - -The sources of these libraries are available by anonymous CVS from -cvs.m17n.org. - - % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/m17n login - % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/m17n co m17n-db - % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/m17n co m17n-lib - % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/m17n co libotf - -For m17n-lib, if you have problems with making the whole package -because you lack some other packages on which m17n-lib depends, try to -configure it with the option "--without-gui". +you can download the libraries from . Note that Emacs cannot support complex scripts on a TTY, unless the terminal includes such a support. @@ -157,37 +141,40 @@ in the intlfonts/README file. * Image support libraries -Emacs needs optional libraries to be able to display images (with the -exception of PBM and XBM images whose support is built-in). +Emacs needs libraries to display images, with the exception of PBM and +XBM images whose support is built-in. On some systems, particularly on GNU/Linux, these libraries may -already be present or available as additional packages. Note that if +already be present or available as additional packages. If there is a separate `dev' or `devel' package, for use at compilation time rather than run time, you will need that as well as the corresponding run time package; typically the dev package will contain header files and a library archive. Otherwise, you can -download and build libraries from sources. None of them are vital for -running Emacs; however, note that Emacs will not be able to use -colored icons in the toolbar if XPM support is not compiled in. +download and build libraries from sources. Although none of them are +essential for running Emacs, some are important enough that +'configure' will report an error if they are absent from a system that +has X11 support, unless 'configure' is specifically told to omit them. -Here's the list of some of these optional libraries, and the URLs -where they can be found (in the unlikely event that your distribution -does not provide them): +Here's a list of some of these libraries, and the URLs where they +can be found (in the unlikely event that your distribution does not +provide them). By default, libraries marked with an X are required if +X11 is being used. - . libXaw3d http://directory.fsf.org/project/xaw3d/ - . libxpm for XPM: http://www.x.org/releases/current/src/lib/ - . libpng for PNG: http://www.libpng.org/ - . libz (for PNG): http://www.zlib.net/ - . libjpeg for JPEG: http://www.ijg.org/ - . libtiff for TIFF: http://www.libtiff.org/ - . libgif for GIF: http://sourceforge.net/projects/giflib/ + libXaw3d http://directory.fsf.org/project/xaw3d/ + X libxpm for XPM: http://www.x.org/releases/current/src/lib/ + X libpng for PNG: http://www.libpng.org/ + libz (for PNG): http://www.zlib.net/ + X libjpeg for JPEG: http://www.ijg.org/ + X libtiff for TIFF: http://www.remotesensing.org/libtiff/ + X libgif for GIF: http://sourceforge.net/projects/giflib/ -Emacs will configure itself to build with these libraries if the -`configure' script finds them on your system, unless you supply the -appropriate --without-LIB option. In some cases, older versions of -these libraries won't work because some routines are missing, and -configure should avoid such old versions. If that happens, use the ---without-LIB options to `configure', if you need to. +If you supply the appropriate --without-LIB option, 'configure' will +omit the corresponding library from Emacs, even if that makes for a +less-pleasant user interface. Otherwise, Emacs will configure itself +to build with these libraries if 'configure' finds them on your +system, and 'configure' will complain and exit if a library marked 'X' +is not found on a system that uses X11. Use --without-LIB if your +version of a library won't work because some routines are missing. * Extra fonts @@ -212,7 +199,7 @@ The names of the packages that you need varies according to the GNU/Linux distribution that you use, and the options that you want to configure Emacs with. On Debian-based systems, you can install all the packages needed to build the installed version of Emacs with a command -like `apt-get build-dep emacs23'. On Red Hat systems, the +like `apt-get build-dep emacs24'. On Red Hat systems, the corresponding command is `yum-builddep emacs'. @@ -267,14 +254,11 @@ accept a list of directories, separated with colons. To get more attractive menus, you can specify an X toolkit when you configure Emacs; use the option `--with-x-toolkit=TOOLKIT', where TOOLKIT is `gtk' (the default), `athena', or `motif' (`yes' and -`lucid' are synonyms for `athena'). On some systems, it does not work -to use a toolkit with shared libraries. A free implementation of -Motif, called LessTif, is available from . -Compiling with LessTif or Motif causes a standard File Selection -Dialog to pop up when you invoke file commands with the mouse. You -can get fancy 3D-style scroll bars, even without Gtk or LessTif/Motif, -if you have the Xaw3d library installed (see "Image support libraries" -above for Xaw3d availability). +`lucid' are synonyms for `athena'). Compiling with Motif causes a +standard File Selection Dialog to pop up when you invoke file commands +with the mouse. You can get fancy 3D-style scroll bars, even without +Gtk or Motif, if you have the Xaw3d library installed (see +"Image support libraries" above for Xaw3d availability). You can tell configure where to search for GTK by specifying `--with-pkg-config-prog=PATH' where PATH is the pathname to @@ -295,7 +279,7 @@ individual users--see the Rmail chapter of the Emacs manual. For image support you may have to download, build, and install the appropriate image support libraries for image types other than XBM and -PBM, see the list of URLs in "ADDITIONAL DISTRIBUTION FILES" above. +PBM, see the list of URLs in "Image support libraries" above. (Note that PNG support requires libz in addition to libpng.) To disable individual types of image support in Emacs for some reason, @@ -308,8 +292,7 @@ or more of these options: --without-gif for GIF image support --without-png for PNG image support -Use --without-toolkit-scroll-bars to disable LessTif/Motif or Xaw3d -scroll bars. +Use --without-toolkit-scroll-bars to disable Motif or Xaw3d scroll bars. Use --without-xim to inhibit the default use of X Input Methods. In this case, the X resource useXIM can be used to turn on use of XIM. @@ -326,14 +309,15 @@ equivalent to --without-sound --without-dbus --without-libotf --without-selinux --without-xft --without-gsettings --without-gnutls --without-rsvg --without-xml2 --without-gconf --without-imagemagick --without-m17n-flt --without-jpeg --without-tiff --without-gif ---without-png --without-gpm. Note that --without-all leaves X support -enabled, and using the GTK2 or GTK3 toolkit creates a lot of library -dependencies. So if you want to build a small executable with very basic -X support, use --without-all --with-x-toolkit=no. For the smallest possible -executable without X, use --without-all --without-x. If you want to build -with just a few features enabled, you can combine --without-all with ---with-FEATURE. For example, you can use --without-all --with-dbus -to build with DBus support and nothing more. +--without-png --without-gpm --without-file-notification. Note that +--without-all leaves X support enabled, and using the GTK2 or GTK3 +toolkit creates a lot of library dependencies. So if you want to +build a small executable with very basic X support, use --without-all +--with-x-toolkit=no. For the smallest possible executable without X, +use --without-all --without-x. If you want to build with just a few +features enabled, you can combine --without-all with --with-FEATURE. +For example, you can use --without-all --with-dbus to build with DBus +support and nothing more. Use --with-wide-int to implement Emacs values with the type 'long long', even on hosts where a narrower type would do. With this option, on a @@ -482,10 +466,6 @@ variable gets by default! Make sure you know what kind of value the variable should have. If you don't pay attention to what you are doing, you'll make a mistake. -If you set load-path to a different value in site-init.el or -site-load.el, Emacs will use *precisely* that value when it starts up -again. If you do this, you are on your own! - The `site-*.el' files are nonexistent in the distribution. You do not need to create them if you have nothing to put in them. @@ -656,7 +636,7 @@ Here is a complete list of the variables you may want to set. path variables - `bindir' and `libexecdir'. The above variables serve analogous purposes in the makefiles for all -GNU software; the following variable is specific to Emacs. +GNU software; the following variables are specific to Emacs. `archlibdir' indicates where Emacs installs and expects the executable files and other architecture-dependent data it uses while @@ -664,6 +644,10 @@ GNU software; the following variable is specific to Emacs. see), is `/usr/local/libexec/emacs/VERSION/CONFIGURATION-NAME' (where VERSION and CONFIGURATION-NAME are as described above). +`GZIP_PROG' is the name of the executable that compresses installed info, + manual, and .el files. It defaults to gzip. Setting it to + the empty string suppresses compression. + Remember that you must specify any variable values you need each time you run `make' in the top directory. If you run `make' once to build emacs, test it, and then run `make' again to install the files, you diff --git a/INSTALL.BZR b/INSTALL.REPO similarity index 85% rename from INSTALL.BZR rename to INSTALL.REPO index 4b6797ebc96..ecf5bc068fe 100644 --- a/INSTALL.BZR +++ b/INSTALL.REPO @@ -1,11 +1,11 @@ -Copyright (C) 2002-2013 Free Software Foundation, Inc. +Copyright (C) 2002-2014 Free Software Foundation, Inc. See the end of the file for license conditions. - Building and Installing Emacs from Bazaar + Building and Installing Emacs from the Repository -Building Emacs from Bazaar requires some tools that are not needed -when building from a release. You will need: +Building Emacs from the source-code repository requires some tools +that are not needed when building from a release. You will need: autoconf - at least the version specified near the start of configure.ac (in the AC_PREREQ command). @@ -34,14 +34,14 @@ doing the wrong thing if you update the build procedure, you can invoke "./configure -C" instead. Some of the files that are included in the Emacs tarball, such as -byte-compiled Lisp files, are not stored in Bazaar. Therefore, to -build from Bazaar you must run "make bootstrap" instead of just "make": +byte-compiled Lisp files, are not stored in the repository. Therefore, to +build from the repository you must run "make bootstrap" instead of +just "make": - $ bzr pull $ make bootstrap Normally, it is not necessary to use "make bootstrap" after every -update from Bazaar. "make" should work in 90% of the cases and be +update from the repository. "make" should work in 90% of the cases and be much quicker. $ make @@ -72,7 +72,7 @@ platform-specific configuration scripts (nt/configure.bat, config.bat, etc.) before "make bootstrap" or "make"; the rest of the procedure is applicable to those systems as well. -Because the Bazaar version of Emacs is a work in progress, it will +Because the repository version of Emacs is a work in progress, it will sometimes fail to build. Please wait a day or so (and check the archives of the emacs-buildstatus, emacs-devel, and bug-gnu-emacs mailing lists) before reporting such problems. In most cases, the diff --git a/Makefile.in b/Makefile.in index 42b900401f7..76a030407b9 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,8 +1,6 @@ -# DIST: This is the distribution Makefile for Emacs. configure can -# DIST: make most of the changes to this file you might want, so try -# DIST: that first. +### @configure_input@ -# Copyright (C) 1992-2013 Free Software Foundation, Inc. +# Copyright (C) 1992-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -50,6 +48,8 @@ # # make extraclean # Still more severe - delete backup and autosave files, too. +# Also generated files that do not normally change and can be slow +# to rebuild (eg leim/ja-dic). # # make bootstrap # Removes all the compiled files to force a new bootstrap from a @@ -58,7 +58,7 @@ # make docs # Make Emacs documentation files from their sources; requires makeinfo. -SHELL = /bin/sh +SHELL = @SHELL@ # This may not work with certain non-GNU make's. It only matters when # inheriting a CDPATH not starting with the current directory. @@ -67,6 +67,10 @@ CDPATH= # If Make doesn't predefine MAKE, set it here. @SET_MAKE@ +# Prevent submakes from outputting "Entering directory ..." and +# "Leaving directory..." diagnostics that would mess up 'make echo-info'. +QUIET_SUBMAKE = MAKELEVEL=0 + # ==================== Things `configure' Might Edit ==================== cache_file = @cache_file@ @@ -89,6 +93,9 @@ version=@version@ ### for, like `mips-dec-ultrix' or `sparc-sun-sunos'. configuration=@configuration@ +### The nt/ subdirectory gets built only for MinGW +NTDIR=@NTDIR@ + # ==================== Where To Install Things ==================== # Location to install Emacs.app under GNUstep / Mac OS X. @@ -158,6 +165,9 @@ bitmapdir=@bitmapdir@ # We use $(srcdir) explicitly in dependencies so as not to depend on VPATH. srcdir=@srcdir@ +abs_srcdir=@abs_srcdir@ +# MinGW CPPFLAGS may use this. +abs_top_srcdir=@abs_top_srcdir@ # Where the manpage source files are kept. mansrcdir=$(srcdir)/doc/man @@ -182,15 +192,13 @@ iconsrcdir=$(srcdir)/etc/images/icons # These variables hold the values Emacs will actually use. They are # based on the values of the standard Make variables above. -# Where to install the lisp, leim files distributed with -# Emacs. This includes the Emacs version, so that the -# lisp files for different versions of Emacs will install -# themselves in separate directories. +# Where to install the lisp files distributed with Emacs. +# This includes the Emacs version, so that the lisp files for different +# versions of Emacs will install themselves in separate directories. lispdir=@lispdir@ -leimdir=@leimdir@ # Directories Emacs should search for standard lisp files. -# The default is ${lispdir}:${leimdir}. +# The default is ${lispdir}. standardlisppath=@standardlisppath@ # Directories Emacs should search for lisp files specific to this @@ -205,13 +213,14 @@ locallisppath=@locallisppath@ # The default is ${locallisppath}:${standardlisppath}. lisppath=@lisppath@ -# Where Emacs will search for its lisp files while -# building. This is only used during the process of -# compiling Emacs, to help Emacs find its lisp files -# before they've been installed in their final location. +# Where Emacs will search for its lisp files while building. +# This is only used during the process of compiling Emacs, +# to help Emacs find its lisp files before they've been installed +# in their final location. # This should be a colon-separated list of directories. # Normally it points to the lisp/ directory in the sources. -buildlisppath=${srcdir}/lisp +# NB lread.c relies on lisp/ being first here. +buildlisppath=${abs_srcdir}/lisp # Where to install the other architecture-independent # data files distributed with Emacs (like the tutorial, @@ -228,8 +237,8 @@ etcdir=@etcdir@ # once. archlibdir=@archlibdir@ -# Where to put the docstring file. -docdir=@docdir@ +# Where to put the etc/DOC file. +etcdocdir=@etcdocdir@ # Where to install Emacs game score files. gamedir=@gamedir@ @@ -249,12 +258,11 @@ INSTALL_INFO = @INSTALL_INFO@ # By default, we uphold the dignity of our programs. INSTALL_STRIP = MKDIR_P = @MKDIR_P@ -LN_S = @LN_S@ +# Create a link to a file in the same directory as the target. +LN_S_FILEONLY = @LN_S_FILEONLY@ # We use gzip to compress installed .el files. GZIP_PROG = @GZIP_PROG@ -# If non-nil, gzip the installed Info and man pages. -GZIP_INFO = @GZIP_INFO@ # ============================= Targets ============================== @@ -267,25 +275,24 @@ EMACS = ${EMACS_NAME}${EXEEXT} EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT} # Subdirectories to make recursively. -SUBDIR = lib lib-src src lisp leim +SUBDIR = $(NTDIR) lib lib-src src lisp # The subdir makefiles created by config.status. SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@ SUBDIR_MAKEFILES = `echo $(SUBDIR_MAKEFILES_IN:.in=) | sed 's|$(srcdir)/||g'` -# Subdirectories to install, and where they'll go. -# lib-src's makefile knows how to install it, so we don't do that here. -# Directories that cannot simply be copied, eg info, -# are treated separately. -# quail appears twice because in out-of-tree builds, it exists twice. -COPYDIR = ${srcdir}/etc ${srcdir}/lisp ${srcdir}/leim/ja-dic ${srcdir}/leim/quail leim/quail -COPYDESTS = $(DESTDIR)${etcdir} $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}/ja-dic $(DESTDIR)${leimdir}/quail $(DESTDIR)${leimdir}/quail +# Subdirectories to install, and where they'll go. lib-src's and nt's +# makefiles know how to install them, so we don't do that here. +# Directories that cannot simply be copied, eg info, are treated +# separately. +COPYDIR = ${srcdir}/etc ${srcdir}/lisp +COPYDESTS = "$(DESTDIR)${etcdir}" "$(DESTDIR)${lispdir}" all: ${SUBDIR} -.PHONY: all ${SUBDIR} blessmail epaths-force FRC +.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 FRC -removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g' +removenullpaths=sed -e 's/^:*//' -e 's/:*$$//g' -e 's/::*/:/g' # Generate epaths.h from epaths.in. This target is invoked by `configure'. # See comments in configure.ac for why it is done this way, as opposed @@ -307,19 +314,52 @@ epaths-force: FRC -e 's;\(#.*PATH_BITMAPS\).*$$;\1 "${bitmapdir}";' \ -e 's;\(#.*PATH_X_DEFAULTS\).*$$;\1 "${x_default_search_path}";' \ -e 's;\(#.*PATH_GAME\).*$$;\1 "${gamedir}";' \ - -e 's;\(#.*PATH_DOC\).*$$;\1 "${docdir}";') && \ + -e 's;\(#.*PATH_DOC\).*$$;\1 "${etcdocdir}";') && \ ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h -lib-src src: lib +# Replace "${w32prefix}" with '%emacs_dir%' (which expands to install +# directory at runtime). +msys_w32prefix_subst=sed -e 's!\(^\|;\)'"$${w32prefixpattern}"'\([;/]\|$$\)!\1%emacs_dir%\2!g' -src: lib-src FRC +# Quote Sed special characters (except backslash and newline) with +# a double backslash. +msys_sed_sh_escape=sed -e 's/[];$$*.^[]/\\\\&/g' -# We need to build `emacs' in `src' to compile the *.elc files in `lisp' -# and `leim'. -lisp leim: src +# The w32 build needs a slightly different editing, and it uses +# nt/epaths.nt as the template. +# +# Use the value of ${locallisppath} supplied by `configure', +# to support the --enable-locallisppath argument. +# +# In this case, the paths written to 'src/epaths.h' must be in native +# MS-Windows format (e.g. 'c:/foo/bar'), because temacs is a MinGW +# program that doesn't support MSYS-style paths (e.g. '/c/foo/bar' or +# '/foo/bar'). +epaths-force-w32: FRC + @(w32srcdir=`${srcdir}/build-aux/msys-to-w32 "${srcdir}"`; \ + w32prefix=`${srcdir}/build-aux/msys-to-w32 "${prefix}" N`; \ + w32prefixpattern=`echo "$${w32prefix}" | ${msys_sed_sh_escape}` ; \ + w32locallisppath=`${srcdir}/build-aux/msys-to-w32 "${locallisppath}" N ":" "\\;" | ${msys_w32prefix_subst}` ; \ + sed < ${srcdir}/nt/epaths.nt > epaths.h.$$$$ \ + -e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "'"$${w32locallisppath}"'";' \ + -e '/^.*#/s/@VER@/${version}/g' \ + -e '/^.*#/s/@CFG@/${configuration}/g' \ + -e "/^.*#/s|@SRC@|$${w32srcdir}|g") && \ + ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h + +# If lib/Makefile would build files in '.', then build them before +# building 'lib', to avoid races with parallel makes. +lib: am--refresh + +lib-src src: $(NTDIR) lib + +src: lib-src + +# We need to build `emacs' in `src' to compile the *.elc files in `lisp'. +lisp: src # These targets should be "${SUBDIR} without `src'". -lib lib-src lisp leim: Makefile FRC +lib lib-src lisp nt: Makefile FRC cd $@ && $(MAKE) all $(MFLAGS) \ CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \ LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' @@ -333,19 +373,21 @@ lib lib-src lisp leim: Makefile 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. +# +# Note the use of single quotes in the value of vcswitness. +# This passes an unexpanded $srcdir to src's Makefile, which then +# expands it using its own value of srcdir (which points to the +# source directory of src/). src: Makefile FRC - boot=bootstrap-emacs$(EXEEXT); \ - if [ ! -x "src/$$boot" ]; then \ - cd $@; $(MAKE) all $(MFLAGS) \ - CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \ - LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="$$boot"; \ - fi; - if [ -r .bzr/checkout/dirstate ]; then \ - vcswitness="`pwd`/.bzr/checkout/dirstate"; \ - fi; \ - cd $@; $(MAKE) all $(MFLAGS) \ - CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \ - LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="" \ + dirstate='.bzr/checkout/dirstate'; \ + vcswitness='$$(srcdir)/../'$$dirstate; \ + [ -r "$(srcdir)/$$dirstate" ] || vcswitness=''; \ + cd $@ || exit; \ + boot=bootstrap-emacs$(EXEEXT); \ + [ ! -x "$$boot" ] || boot=''; \ + $(MAKE) all $(MFLAGS) \ + CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \ + LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="$$boot" \ VCSWITNESS="$$vcswitness" blessmail: Makefile src FRC @@ -373,9 +415,9 @@ $(MAKEFILE_NAME): config.status $(srcdir)/src/config.in \ config.status: ${srcdir}/configure ${srcdir}/lisp/version.el if [ -x ./config.status ]; then \ - ./config.status --recheck; \ + $(CFG) ./config.status --recheck; \ else \ - $(srcdir)/configure $(CONFIGURE_FLAGS); \ + $(CFG) $(srcdir)/configure $(CONFIGURE_FLAGS); \ fi AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4 @@ -383,7 +425,7 @@ AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4 $(srcdir)/configure: $(AUTOCONF_INPUTS) cd ${srcdir} && autoconf -ACLOCAL_INPUTS = $(srcdir)/m4/gnulib-comp.m4 +ACLOCAL_INPUTS = $(srcdir)/configure.ac $(srcdir)/m4/gnulib-comp.m4 $(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS) cd $(srcdir) && aclocal -I m4 @@ -411,14 +453,15 @@ $(srcdir)/src/stamp-h.in: $(AUTOCONF_INPUTS) # ==================== Installation ==================== -.PHONY: install install-arch-dep install-arch-indep install-doc install-info -.PHONY: install-man install-etc install-strip uninstall +.PHONY: install install-arch-dep install-arch-indep install-etcdoc install-info +.PHONY: install-man install-etc install-strip install-$(NTDIR) +.PHONY: uninstall uninstall-$(NTDIR) ## If we let lib-src do its own installation, that means we ## don't have to duplicate the list of utilities to install in ## this Makefile as well. -install: all install-arch-indep install-doc install-arch-dep blessmail +install: all install-arch-indep install-etcdoc install-arch-dep install-$(NTDIR) blessmail @true ## Ensure that $subdir contains a subdirs.el file. @@ -426,32 +469,32 @@ install: all install-arch-indep install-doc install-arch-dep blessmail ## world-readable. ## TODO it might be good to warn about non-standard permissions of ## pre-existing directories, but that does not seem easy. -write_subdir=if [ -f $${subdir}/subdirs.el ]; \ +write_subdir=if [ -f "$${subdir}/subdirs.el" ]; \ then true; \ else \ umask 022; \ - ${MKDIR_P} $${subdir}; \ + ${MKDIR_P} "$${subdir}"; \ (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \ echo " (normal-top-level-add-subdirs-to-load-path))") \ - > $${subdir}/subdirs.el; \ + > "$${subdir}/subdirs.el"; \ fi ### Install the executables that were compiled specifically for this machine. ### We do install-arch-indep first because the executable needs the ### Lisp files and DOC file to work properly. -install-arch-dep: src install-arch-indep install-doc - umask 022; ${MKDIR_P} $(DESTDIR)${bindir} +install-arch-dep: src install-arch-indep install-etcdoc install-$(NTDIR) + umask 022; ${MKDIR_P} "$(DESTDIR)${bindir}" cd lib-src && \ - $(MAKE) install $(MFLAGS) prefix=${prefix} \ - exec_prefix=${exec_prefix} bindir=${bindir} \ - libexecdir=${libexecdir} archlibdir=${archlibdir} \ + $(MAKE) install $(MFLAGS) prefix="${prefix}" \ + exec_prefix="${exec_prefix}" bindir="${bindir}" \ + libexecdir="${libexecdir}" archlibdir="${archlibdir}" \ INSTALL_STRIP=${INSTALL_STRIP} if test "${ns_self_contained}" = "no"; then \ - ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL) || exit 1 ; \ - chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL) || true; \ + ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} "$(DESTDIR)${bindir}/$(EMACSFULL)" || exit 1 ; \ + chmod 1755 "$(DESTDIR)${bindir}/$(EMACSFULL)" || true; \ if test "x${NO_BIN_LINK}" = x; then \ - rm -f $(DESTDIR)${bindir}/$(EMACS) ; \ - cd $(DESTDIR)${bindir} && $(LN_S) $(EMACSFULL) $(EMACS); \ + rm -f "$(DESTDIR)${bindir}/$(EMACS)" ; \ + cd "$(DESTDIR)${bindir}" && $(LN_S_FILEONLY) $(EMACSFULL) $(EMACS); \ fi; \ else \ subdir=${ns_appresdir}/site-lisp; \ @@ -459,6 +502,17 @@ install-arch-dep: src install-arch-indep install-doc rm -rf ${ns_appresdir}/share; \ fi +### Windows-specific install target for installing programs produced +### in nt/, and its Posix do-nothing shadow. +install-: +install-nt: + cd $(NTDIR) && \ + $(MAKE) install $(MFLAGS) prefix="${prefix}" \ + exec_prefix="${exec_prefix}" bindir="${bindir}" \ + libexecdir="${libexecdir}" archlibdir="${archlibdir}" \ + datadir="${datadir}" \ + INSTALL_STRIP=${INSTALL_STRIP} + ## In the share directory, we are deleting: ## applications (with emacs.desktop, also found in etc/) ## emacs (basically empty except for unneeded site-lisp directories) @@ -488,18 +542,22 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## We delete etc/DOC* because there may be irrelevant DOC files from ## other builds in the source directory. This is ok because we just ## deleted the entire installed etc/ directory and recreated it. -## install-doc installs the relevant DOC. +## install-etcdoc installs the relevant DOC. + +## Note that we install etc/refcards/*.ps if present. +## TODO we should compress these if GZIP_PROG is set. +## It would be simpler to have a separate install rule for etc/refcards +## (maybe move it to doc/refcards?). ## Note that the Makefiles in the etc directory are potentially useful ## in an installed Emacs, so should not be excluded. -## I'm not sure creating locallisppath here serves any useful purpose. -## If it has the default value, then the later write_subdir commands -## will ensure all these components exist. -## This will only do something if locallisppath has a non-standard value. -## Is it really Emacs's job to create those directories? -## Should we also be ensuring they contain subdirs.el files? -## It would be easy to do, just use write_subdir. +## We always create the _default_ locallisppath directories, and +## ensure that they contain a subdirs.el file (via write_subdir). +## This is true even if locallisppath has a non-default value. +## In case of non-default value, we used to create the specified directories, +## but not add subdirs.el to them. This was a strange halfway house. +## Nowadays we do not create non-default directories. ## Note that we use tar instead of plain old cp -R/-r because the latter ## is apparently not portable (even in 2012!). @@ -508,133 +566,130 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \ ## work correctly, and therefore no idea when tar can be replaced. ## See also these comments from 2004 about cp -r working fine: ## http://lists.gnu.org/archive/html/autoconf-patches/2004-11/msg00005.html -install-arch-indep: lisp leim install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} - umask 022 ; \ - locallisppath='${locallisppath}'; \ - IFS=:; \ - for d in $$locallisppath; do \ - ${MKDIR_P} "$(DESTDIR)$$d"; \ - done +install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA} -set ${COPYDESTS} ; \ unset CDPATH; \ $(set_installuser); \ for dir in ${COPYDIR} ; do \ [ -d $${dir} ] || exit 1 ; \ - dest=$$1 ; shift ; \ - [ -d $${dest} ] && \ - [ `cd $${dest} && /bin/pwd` = `cd $${dir} && /bin/pwd` ] && \ - continue ; \ - if [ "$${dir}" = "leim/quail" ]; then \ - [ `cd $${dir} && /bin/pwd` = `cd ${srcdir}/leim/quail && /bin/pwd` ] && \ - continue ; \ - else \ - rm -rf $${dest} ; \ - umask 022; ${MKDIR_P} $${dest} ; \ - fi ; \ + dest="$$1" ; shift ; \ + if [ -d "$${dest}" ]; then \ + exp_dest=`cd "$${dest}" && /bin/pwd`; \ + [ "$$exp_dest" = "`cd $${dir} && /bin/pwd`" ] && continue ; \ + else true; \ + fi; \ + rm -rf "$${dest}" ; \ + umask 022; ${MKDIR_P} "$${dest}" ; \ echo "Copying $${dir} to $${dest}..." ; \ (cd $${dir}; tar -chf - . ) \ - | (cd $${dest}; umask 022; \ + | (cd "$${dest}"; umask 022; \ tar -xvf - && cat > /dev/null) || exit 1; \ - [ "$${dir}" != "${srcdir}/etc" ] || rm -f $${dest}/DOC* ; \ - for subdir in `find $${dest} -type d -print` ; do \ - chmod a+rx $${subdir} ; \ - rm -f $${subdir}/.gitignore ; \ - rm -f $${subdir}/.arch-inventory ; \ - rm -f $${subdir}/.DS_Store ; \ - rm -f $${subdir}/\#* ; \ - rm -f $${subdir}/.\#* ; \ - rm -f $${subdir}/*~ ; \ - rm -f $${subdir}/*.orig ; \ - rm -f $${subdir}/ChangeLog* ; \ - [ "$${dir}" != "${srcdir}/etc" ] && \ - rm -f $${subdir}/[mM]akefile*[.-]in $${subdir}/[mM]akefile ; \ - done ; \ - find $${dest} -exec chown $${installuser} {} ';' ;\ + if [ "$${dir}" = "${srcdir}/etc" ]; then \ + rm -f "$${dest}/DOC"* ; \ + rm -f "$${dest}/refcards"/*.aux "$${dest}/refcards"/*.dvi; \ + rm -f "$${dest}/refcards"/*.log; \ + else true; \ + fi; \ + (cd "$${dest}" || exit 1; \ + for subdir in `find . -type d -print` ; do \ + chmod a+rx $${subdir} ; \ + rm -f $${subdir}/.gitignore ; \ + rm -f $${subdir}/.arch-inventory ; \ + rm -f $${subdir}/.DS_Store ; \ + rm -f $${subdir}/\#* ; \ + rm -f $${subdir}/.\#* ; \ + rm -f $${subdir}/*~ ; \ + rm -f $${subdir}/*.orig ; \ + rm -f $${subdir}/ChangeLog* ; \ + [ "$${dir}" != "${srcdir}/etc" ] && \ + rm -f $${subdir}/[mM]akefile*[.-]in $${subdir}/[mM]akefile ; \ + done ); \ + find "$${dest}" -exec chown $${installuser} {} ';' ;\ done - -rm -f $(DESTDIR)${leimdir}/leim-list.el - ${INSTALL_DATA} leim/leim-list.el $(DESTDIR)${leimdir}/leim-list.el - -rm -f $(DESTDIR)${lispdir}/subdirs.el - umask 022; $(srcdir)/build-aux/update-subdirs $(DESTDIR)${lispdir} - subdir=$(DESTDIR)${datadir}/emacs/${version}/site-lisp ; \ + -rm -f "$(DESTDIR)${lispdir}/subdirs.el" + umask 022; $(srcdir)/build-aux/update-subdirs "$(DESTDIR)${lispdir}" + subdir="$(DESTDIR)${datadir}/emacs/${version}/site-lisp" ; \ ${write_subdir} - subdir=$(DESTDIR)${datadir}/emacs/site-lisp ; \ + subdir="$(DESTDIR)${datadir}/emacs/site-lisp" ; \ ${write_subdir} || true - [ -z "${GZIP_PROG}" ] || \ - ( echo "Compressing *.el ..." ; \ - unset CDPATH; \ - thisdir=`/bin/pwd`; \ - for dir in $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}; do \ - cd $${thisdir} ; \ - cd $${dir} || exit 1 ; \ - for f in `find . -name "*.elc" -print`; do \ - ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \ - done ; \ - done ) - -chmod -R a+r $(DESTDIR)${datadir}/emacs/${version} ${COPYDESTS} + [ -z "${GZIP_PROG}" ] || { \ + echo "Compressing *.el ..." && \ + cd "$(DESTDIR)${lispdir}" && \ + find . -name '*.elc' -exec $(SHELL) -c \ + '${GZIP_PROG} -9n `expr "$$1" : "\\(.*\\)c"`' dummy '{}' ';'; \ + } + -chmod -R a+r "$(DESTDIR)${datadir}/emacs/${version}" ${COPYDESTS} ## The above chmods are needed because "umask 022; tar ..." is not ## guaranteed to do the right thing; eg if we are root and tar is ## preserving source permissions. -## We install only the relevant DOC file if possible -## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*. -## (Note "otherwise" is inaccurate since 2009-08-23.) - ## Note that install-arch-indep deletes and recreates the entire ## installed etc/ directory, so we need it to run before this does. -install-doc: src install-arch-indep +install-etcdoc: src install-arch-indep -unset CDPATH; \ - umask 022; ${MKDIR_P} $(DESTDIR)${docdir} ; \ - if [ `cd ./etc; /bin/pwd` != `cd $(DESTDIR)${docdir}; /bin/pwd` ]; \ + umask 022; ${MKDIR_P} "$(DESTDIR)${etcdocdir}" ; \ + exp_etcdocdir=`cd "$(DESTDIR)${etcdocdir}"; /bin/pwd`; \ + if [ "`cd ./etc; /bin/pwd`" != "$$exp_etcdocdir" ]; \ then \ - fullversion=`./src/emacs --version | sed -n '1 s/GNU Emacs *//p'`; \ - if [ -f "./etc/DOC-$${fullversion}" ]; \ - then \ - docfile="DOC-$${fullversion}"; \ - else \ - docfile="DOC"; \ - fi; \ - echo "Copying etc/$${docfile} to $(DESTDIR)${docdir} ..." ; \ - ${INSTALL_DATA} etc/$${docfile} $(DESTDIR)${docdir}/$${docfile}; \ + docfile="DOC"; \ + echo "Copying etc/$${docfile} to $(DESTDIR)${etcdocdir} ..." ; \ + ${INSTALL_DATA} etc/$${docfile} "$(DESTDIR)${etcdocdir}/$${docfile}"; \ $(set_installuser); \ - chown $${installuser} $(DESTDIR)${docdir}/$${docfile} || true ; \ + chown $${installuser} "$(DESTDIR)${etcdocdir}/$${docfile}" || true ; \ else true; fi +## FIXME: +## If info/dir is missing, but we have install-info, we should let +## that handle it. If info/dir is present and we do not have install-info, +## we should check for missing entries and add them by hand. +## +## FIXME: +## If HAVE_MAKEINFO = no and there are no info files, do not install info/dir. install-info: info - umask 022; ${MKDIR_P} $(DESTDIR)${infodir} + umask 022; ${MKDIR_P} "$(DESTDIR)${infodir}" -unset CDPATH; \ thisdir=`/bin/pwd`; \ - [ `cd ${srcdir}/info && /bin/pwd` = `cd $(DESTDIR)${infodir} && /bin/pwd` ] || \ - (cd $(DESTDIR)${infodir}; \ - [ -f dir ] || \ - (cd $${thisdir}; \ - ${INSTALL_DATA} ${srcdir}/info/dir $(DESTDIR)${infodir}/dir) ; \ - info_misc=`cd $${thisdir}/doc/misc; ${MAKE} -s echo-info`; \ + exp_infodir=`cd "$(DESTDIR)${infodir}" && /bin/pwd`; \ + if [ "`cd ${srcdir}/info && /bin/pwd`" = "$$exp_infodir" ]; then \ + true; \ + else \ + [ -f "$(DESTDIR)${infodir}/dir" ] || \ + [ ! -f ${srcdir}/info/dir ] || \ + ${INSTALL_DATA} ${srcdir}/info/dir "$(DESTDIR)${infodir}/dir"; \ + info_misc=`cd doc/misc && $(QUIET_SUBMAKE) $(MAKE) -s echo-info`; \ cd ${srcdir}/info ; \ for elt in ${INFO_NONMISC} $${info_misc}; do \ test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \ for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \ - (cd $${thisdir}; \ - ${INSTALL_DATA} ${srcdir}/info/$$f $(DESTDIR)${infodir}/$$f); \ - ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \ - rm -f $(DESTDIR)${infodir}/$$f.gz; \ - ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \ + (cd "$${thisdir}"; \ + ${INSTALL_DATA} ${srcdir}/info/$$f "$(DESTDIR)${infodir}/$$f"); \ + [ -n "${GZIP_PROG}" ] || continue ; \ + rm -f "$(DESTDIR)${infodir}/$$f.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)${infodir}/$$f"; \ done; \ - (cd $${thisdir}; \ - ${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \ - done) + (cd "$${thisdir}"; \ + ${INSTALL_INFO} --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \ + done; \ + fi +## "gzip || true" is because some gzips exit with non-zero status +## if compression would not reduce the file size. Eg, the gzip in +## OpenBSD 4.9 seems to do this (2013/03). In Emacs, this can +## only happen with the tiny ctags.1 manpage. We don't really care if +## ctags.1 is compressed or not. "gzip -f" is another option here, +## but not sure if portable. install-man: - umask 022; ${MKDIR_P} $(DESTDIR)${man1dir} + umask 022; ${MKDIR_P} "$(DESTDIR)${man1dir}" thisdir=`/bin/pwd`; \ cd ${mansrcdir}; \ for page in *.1; do \ dest=`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1; \ - (cd $${thisdir}; \ - ${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${dest}); \ - ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \ - rm -f $(DESTDIR)${man1dir}/$${dest}.gz; \ - ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${dest}; \ + (cd "$${thisdir}"; \ + ${INSTALL_DATA} ${mansrcdir}/$${page} "$(DESTDIR)${man1dir}/$${dest}"); \ + [ -n "${GZIP_PROG}" ] || continue ; \ + rm -f "$(DESTDIR)${man1dir}/$${dest}.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)${man1dir}/$${dest}" || true; \ done ## Install those items from etc/ that need to end up elsewhere. @@ -644,25 +699,25 @@ install-man: EMACS_ICON=emacs install-etc: - umask 022; ${MKDIR_P} $(DESTDIR)${desktopdir} + umask 022; ${MKDIR_P} "$(DESTDIR)${desktopdir}" tmp=etc/emacs.tmpdesktop; rm -f $${tmp}; \ emacs_name=`echo emacs | sed '$(TRANSFORM)'`; \ sed -e "/^Exec=emacs/ s/emacs/$${emacs_name}/" \ -e "/^Icon=emacs/ s/emacs/$${emacs_name}/" \ ${srcdir}/etc/emacs.desktop > $${tmp}; \ - ${INSTALL_DATA} $${tmp} $(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop; \ + ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \ rm -f $${tmp} thisdir=`/bin/pwd`; \ cd ${iconsrcdir} || exit 1; umask 022 ; \ for dir in */*/apps */*/mimetypes; do \ [ -d $${dir} ] || continue ; \ - ( cd $${thisdir}; ${MKDIR_P} $(DESTDIR)${icondir}/$${dir} ) ; \ + ( cd "$${thisdir}"; ${MKDIR_P} "$(DESTDIR)${icondir}/$${dir}" ) ; \ for icon in $${dir}/${EMACS_ICON}[.-]*; do \ [ -r $${icon} ] || continue ; \ ext=`echo "$${icon}" | sed -e 's|.*\.||'`; \ dest=`echo "$${icon}" | sed -e 's|.*/||' -e "s|\.$${ext}$$||" -e 's/$(EMACS_ICON)/emacs/' -e '$(TRANSFORM)'`.$${ext} ; \ - ( cd $${thisdir}; \ - ${INSTALL_DATA} ${iconsrcdir}/$${icon} $(DESTDIR)${icondir}/$${dir}/$${dest} ) \ + ( cd "$${thisdir}"; \ + ${INSTALL_DATA} ${iconsrcdir}/$${icon} "$(DESTDIR)${icondir}/$${dir}/$${dest}" ) \ || exit 1; \ done ; \ done @@ -675,55 +730,67 @@ install-strip: ### create (but not the noninstalled files such as `make all' would create). ### ### Don't delete the lisp and etc directories if they're in the source tree. -uninstall: +uninstall: uninstall-$(NTDIR) uninstall-doc cd lib-src && \ $(MAKE) $(MFLAGS) uninstall \ - prefix=${prefix} exec_prefix=${exec_prefix} \ - bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir} + prefix="${prefix}" exec_prefix="${exec_prefix}" \ + bindir="${bindir}" libexecdir="${libexecdir}" \ + archlibdir="${archlibdir}" + -unset CDPATH; \ - for dir in $(DESTDIR)${lispdir} $(DESTDIR)${etcdir} ; do \ - if [ -d $${dir} ]; then \ - case `cd $${dir} ; /bin/pwd` in \ - `cd ${srcdir} ; /bin/pwd`* ) ;; \ - * ) rm -rf $${dir} ;; \ + for dir in "$(DESTDIR)${lispdir}" "$(DESTDIR)${etcdir}" ; do \ + if [ -d "$${dir}" ]; then \ + case `cd "$${dir}" ; /bin/pwd` in \ + "`cd ${srcdir} ; /bin/pwd`"* ) ;; \ + * ) rm -rf "$${dir}" ;; \ esac ; \ - case $${dir} in \ - $(DESTDIR)${datadir}/emacs/${version}/* ) \ - rm -rf $(DESTDIR)${datadir}/emacs/${version} \ + case "$${dir}" in \ + "$(DESTDIR)${datadir}/emacs/${version}"/* ) \ + rm -rf "$(DESTDIR)${datadir}/emacs/${version}" \ ;; \ esac ; \ fi ; \ done - -rm -rf $(DESTDIR)${libexecdir}/emacs/${version} + -rm -rf "$(DESTDIR)${libexecdir}/emacs/${version}" thisdir=`/bin/pwd`; \ - (info_misc=`cd doc/misc; ${MAKE} -s echo-info`; \ - if cd $(DESTDIR)${infodir}; then \ + (info_misc=`cd doc/misc && $(QUIET_SUBMAKE) $(MAKE) -s echo-info`; \ + if cd "$(DESTDIR)${infodir}"; then \ for elt in ${INFO_NONMISC} $${info_misc}; do \ - (cd $${thisdir}; \ - $(INSTALL_INFO) --remove --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \ - if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \ + (cd "$${thisdir}"; \ + $(INSTALL_INFO) --remove --info-dir="$(DESTDIR)${infodir}" "$(DESTDIR)${infodir}/$$elt"); \ + if [ -n "${GZIP_PROG}" ]; then \ ext=.gz; else ext=; fi; \ rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \ done; \ fi) - (if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \ + (if [ -n "${GZIP_PROG}" ]; then \ ext=.gz; else ext=; fi; \ if cd ${mansrcdir}; then \ for page in *.1; do \ - rm -f $(DESTDIR)${man1dir}/`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1$$ext; done; \ + rm -f "$(DESTDIR)${man1dir}"/`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1$$ext; done; \ fi) - (cd $(DESTDIR)${bindir} && rm -f $(EMACSFULL) $(EMACS) || true) - (if cd $(DESTDIR)${icondir}; then \ + (cd "$(DESTDIR)${bindir}" && rm -f $(EMACSFULL) $(EMACS) || true) + (if cd "$(DESTDIR)${icondir}"; then \ rm -f hicolor/*x*/apps/${EMACS_NAME}.png \ hicolor/scalable/apps/${EMACS_NAME}.svg \ hicolor/scalable/mimetypes/`echo emacs-document | sed '$(TRANSFORM)'`.svg; \ fi) - -rm -f $(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop + -rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop" for file in snake-scores tetris-scores; do \ - file=$(DESTDIR)${gamedir}/$${file}; \ - [ -s $${file} ] || rm -f $$file; \ + file="$(DESTDIR)${gamedir}/$${file}"; \ + [ -s "$${file}" ] || rm -f "$$file"; \ done +### Windows-specific uninstall target for removing programs produced +### in nt/, and its Posix do-nothing shadow. +uninstall-: +uninstall-nt: + cd $(NTDIR) && \ + $(MAKE) $(MFLAGS) uninstall \ + prefix="${prefix}" exec_prefix="${exec_prefix}" \ + bindir="${bindir}" libexecdir="${libexecdir}" \ + archlibdir="${archlibdir}" + FRC: # ==================== Cleaning up and miscellanea ==================== @@ -736,16 +803,16 @@ FRC: ### target for GCC does not delete `libgcc.a', because recompiling it ### is rarely necessary and takes a lot of time. mostlyclean: FRC - (cd src; $(MAKE) $(MFLAGS) mostlyclean) - (cd oldXMenu; $(MAKE) $(MFLAGS) mostlyclean) - (cd lwlib; $(MAKE) $(MFLAGS) mostlyclean) - (cd lib; $(MAKE) $(MFLAGS) mostlyclean) - (cd lib-src; $(MAKE) $(MFLAGS) mostlyclean) - -(cd doc/emacs && $(MAKE) $(MFLAGS) mostlyclean) - -(cd doc/misc && $(MAKE) $(MFLAGS) mostlyclean) - -(cd doc/lispref && $(MAKE) $(MFLAGS) mostlyclean) - -(cd doc/lispintro && $(MAKE) $(MFLAGS) mostlyclean) - (cd leim; $(MAKE) $(MFLAGS) mostlyclean) + cd src && $(MAKE) $(MFLAGS) mostlyclean + cd oldXMenu && $(MAKE) $(MFLAGS) mostlyclean + cd lwlib && $(MAKE) $(MFLAGS) mostlyclean + cd lib && $(MAKE) $(MFLAGS) mostlyclean + cd lib-src && $(MAKE) $(MFLAGS) mostlyclean + cd nt && $(MAKE) $(MFLAGS) mostlyclean + -cd doc/emacs && $(MAKE) $(MFLAGS) mostlyclean + -cd doc/misc && $(MAKE) $(MFLAGS) mostlyclean + -cd doc/lispref && $(MAKE) $(MFLAGS) mostlyclean + -cd doc/lispintro && $(MAKE) $(MFLAGS) mostlyclean ### `clean' ### Delete all files from the current directory that are normally @@ -757,17 +824,17 @@ mostlyclean: FRC ### Delete `.dvi' files here if they are not part of the distribution. clean: FRC -rm -f etc/emacs.tmpdesktop - (cd src; $(MAKE) $(MFLAGS) clean) - (cd oldXMenu; $(MAKE) $(MFLAGS) clean) - (cd lwlib; $(MAKE) $(MFLAGS) clean) - (cd lib; $(MAKE) $(MFLAGS) clean) - (cd lib-src; $(MAKE) $(MFLAGS) clean) - -(cd doc/emacs && $(MAKE) $(MFLAGS) clean) - -(cd doc/misc && $(MAKE) $(MFLAGS) clean) - -(cd doc/lispref && $(MAKE) $(MFLAGS) clean) - -(cd doc/lispintro && $(MAKE) $(MFLAGS) clean) - (cd leim; $(MAKE) $(MFLAGS) clean) - (cd nextstep && $(MAKE) $(MFLAGS) clean) + cd src && $(MAKE) $(MFLAGS) clean + cd oldXMenu && $(MAKE) $(MFLAGS) clean + cd lwlib && $(MAKE) $(MFLAGS) clean + cd lib && $(MAKE) $(MFLAGS) clean + cd lib-src && $(MAKE) $(MFLAGS) clean + cd nt && $(MAKE) $(MFLAGS) clean + -cd doc/emacs && $(MAKE) $(MFLAGS) clean + -cd doc/misc && $(MAKE) $(MFLAGS) clean + -cd doc/lispref && $(MAKE) $(MFLAGS) clean + -cd doc/lispintro && $(MAKE) $(MFLAGS) clean + cd nextstep && $(MAKE) $(MFLAGS) clean ### `bootclean' ### Delete all files that need to be remade for a clean bootstrap. @@ -783,37 +850,46 @@ top_distclean=\ ${top_bootclean}; \ rm -f config.status config.log~ Makefile stamp-h1 ${SUBDIR_MAKEFILES} distclean: FRC - (cd src; $(MAKE) $(MFLAGS) distclean) - (cd oldXMenu; $(MAKE) $(MFLAGS) distclean) - (cd lwlib; $(MAKE) $(MFLAGS) distclean) - (cd lib; $(MAKE) $(MFLAGS) distclean) - (cd lib-src; $(MAKE) $(MFLAGS) distclean) - (cd doc/emacs && $(MAKE) $(MFLAGS) distclean) - (cd doc/misc && $(MAKE) $(MFLAGS) distclean) - (cd doc/lispref && $(MAKE) $(MFLAGS) distclean) - (cd doc/lispintro && $(MAKE) $(MFLAGS) distclean) - (cd leim; $(MAKE) $(MFLAGS) distclean) - (cd lisp; $(MAKE) $(MFLAGS) distclean) - (cd nextstep && $(MAKE) $(MFLAGS) distclean) + cd src && $(MAKE) $(MFLAGS) distclean + cd oldXMenu && $(MAKE) $(MFLAGS) distclean + cd lwlib && $(MAKE) $(MFLAGS) distclean + cd lib && $(MAKE) $(MFLAGS) distclean + cd lib-src && $(MAKE) $(MFLAGS) distclean + cd nt && $(MAKE) $(MFLAGS) distclean + cd doc/emacs && $(MAKE) $(MFLAGS) distclean + cd doc/misc && $(MAKE) $(MFLAGS) distclean + cd doc/lispref && $(MAKE) $(MFLAGS) distclean + cd doc/lispintro && $(MAKE) $(MFLAGS) distclean + cd leim && $(MAKE) $(MFLAGS) distclean + cd lisp && $(MAKE) $(MFLAGS) distclean + cd nextstep && $(MAKE) $(MFLAGS) distclean + for dir in test/automated admin/grammars admin/unidata; do \ + [ ! -d $$dir ] || (cd $$dir && $(MAKE) $(MFLAGS) distclean); \ + done ${top_distclean} ### `bootstrap-clean' ### Delete everything that can be reconstructed by `make' and that ### needs to be deleted in order to force a bootstrap from a clean state. bootstrap-clean: FRC - (cd src; $(MAKE) $(MFLAGS) bootstrap-clean) - (cd oldXMenu; $(MAKE) $(MFLAGS) maintainer-clean) - (cd lwlib; $(MAKE) $(MFLAGS) maintainer-clean) - (cd lib; $(MAKE) $(MFLAGS) maintainer-clean) - (cd lib-src; $(MAKE) $(MFLAGS) maintainer-clean) - -(cd doc/emacs && $(MAKE) $(MFLAGS) maintainer-clean) - -(cd doc/misc && $(MAKE) $(MFLAGS) maintainer-clean) - -(cd doc/lispref && $(MAKE) $(MFLAGS) maintainer-clean) - -(cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean) - (cd leim; $(MAKE) $(MFLAGS) maintainer-clean) - (cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean) - (cd nextstep && $(MAKE) $(MFLAGS) maintainer-clean) + cd src && $(MAKE) $(MFLAGS) bootstrap-clean + cd oldXMenu && $(MAKE) $(MFLAGS) maintainer-clean + cd lwlib && $(MAKE) $(MFLAGS) maintainer-clean + cd lib && $(MAKE) $(MFLAGS) maintainer-clean + cd lib-src && $(MAKE) $(MFLAGS) maintainer-clean + cd nt && $(MAKE) $(MFLAGS) maintainer-clean + -cd doc/emacs && $(MAKE) $(MFLAGS) maintainer-clean + -cd doc/misc && $(MAKE) $(MFLAGS) maintainer-clean + -cd doc/lispref && $(MAKE) $(MFLAGS) maintainer-clean + -cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean + cd leim && $(MAKE) $(MFLAGS) bootstrap-clean + cd lisp && $(MAKE) $(MFLAGS) bootstrap-clean + cd nextstep && $(MAKE) $(MFLAGS) maintainer-clean + for dir in test/automated admin/grammars admin/unidata; do \ + [ ! -d $$dir ] || (cd $$dir && $(MAKE) $(MFLAGS) bootstrap-clean); \ + done [ ! -f config.log ] || mv -f config.log config.log~ + rm -rf ${srcdir}/info ${top_bootclean} ### `maintainer-clean' @@ -831,8 +907,12 @@ top_maintainer_clean=\ ${top_distclean}; \ rm -fr autom4te.cache maintainer-clean: bootstrap-clean FRC - (cd src; $(MAKE) $(MFLAGS) maintainer-clean) - (cd lisp; $(MAKE) $(MFLAGS) maintainer-clean) + cd src && $(MAKE) $(MFLAGS) maintainer-clean + cd leim && $(MAKE) $(MFLAGS) maintainer-clean + cd lisp && $(MAKE) $(MFLAGS) maintainer-clean + for dir in test/automated admin/grammars admin/unidata; do \ + [ ! -d $$dir ] || (cd $$dir && $(MAKE) $(MFLAGS) maintainer-clean); \ + done ${top_maintainer_clean} ### This doesn't actually appear in the coding standards, but Karl @@ -851,7 +931,7 @@ extraclean: TAGS tags: lib lib-src src cd src; $(MAKE) $(MFLAGS) tags -check: +check: all @if test ! -d test/automated; then \ echo "You do not seem to have the test/ directory."; \ echo "Maybe you are using a release tarfile, rather than a repository checkout."; \ @@ -866,15 +946,16 @@ DVIS = lispref-dvi lispintro-dvi emacs-dvi misc-dvi HTMLS = lispref-html lispintro-html emacs-html misc-html INFOS = lispref-info lispintro-info emacs-info misc-info PDFS = lispref-pdf lispintro-pdf emacs-pdf misc-pdf -PSS = lispref-ps lispintro-ps emacs-ps # no misc-ps +PSS = lispref-ps lispintro-ps emacs-ps misc-ps DOCS = $(DVIS) $(HTMLS) $(INFOS) $(PDFS) $(PSS) $(DOCS): t=$@; IFS=-; set $$t; IFS=; cd doc/$$1 && $(MAKE) $(MFLAGS) $$2 .PHONY: $(DOCS) docs pdf ps -.PHONY: info dvi dist check html info-real force-info check-info-dir +.PHONY: info dvi dist check html info-real info-dir force-info check-info +## TODO add etc/refcards. docs: $(DOCS) dvi: $(DVIS) html: $(HTMLS) @@ -882,6 +963,77 @@ info-real: $(INFOS) pdf: $(PDFS) ps: $(PSS) +info-dir: ${srcdir}/info/dir + +## Not strictly necessary, but speeds things up a bit by stopping +## the info-dir rule from running when not needed. +## Hopefully doc/misc/*.texi is not too long for some systems? +info_dir_deps = ${srcdir}/build-aux/dir_top \ + ${srcdir}/doc/emacs/emacs.texi \ + ${srcdir}/doc/lispintro/emacs-lisp-intro.texi \ + ${srcdir}/doc/lispref/elisp.texi ${srcdir}/doc/misc/*.texi + +## It would be much simpler if info/dir was only created in the +## installation location by the install-info rule, but we also +## need one in the source directory for people running uninstalled. +## FIXME it would be faster to use the install-info program if we have it, +## but then we would need to depend on info-real, which would +## slow down parallelization. +${srcdir}/info/dir: ${info_dir_deps} + tempfile=info-dir.$$$$; \ + rm -f $${tempfile}; \ + thisdir=`pwd`; \ + (cd ${srcdir} && ./build-aux/make-info-dir $${thisdir}/$${tempfile}); \ + ${srcdir}/build-aux/move-if-change $${tempfile} ${srcdir}/info/dir + +INSTALL_DVI = install-emacs-dvi install-lispref-dvi \ + install-lispintro-dvi install-misc-dvi +INSTALL_HTML = install-emacs-html install-lispref-html \ + install-lispintro-html install-misc-html +INSTALL_PDF = install-emacs-pdf install-lispref-pdf \ + install-lispintro-pdf install-misc-pdf +INSTALL_PS = install-emacs-ps install-lispref-ps \ + install-lispintro-ps install-misc-ps +INSTALL_DOC = $(INSTALL_DVI) $(INSTALL_HTML) $(INSTALL_PDF) $(INSTALL_PS) + +## Install non .info forms of the documentation. +## TODO add etc/refcards. +$(INSTALL_DOC): + t=$@; IFS=-; set $$t; IFS=; cd doc/$$2 && $(MAKE) $(MFLAGS) $$1-$$3 + +.PHONY: $(INSTALL_DOC) install-doc +.PHONY: install-dvi install-html install-pdf install-ps + +install-doc: $(INSTALL_DOC) +install-dvi: $(INSTALL_DVI) +install-html: $(INSTALL_HTML) +install-pdf: $(INSTALL_PDF) +install-ps: $(INSTALL_PS) + + +UNINSTALL_DVI = uninstall-emacs-dvi uninstall-lispref-dvi \ + uninstall-lispintro-dvi uninstall-misc-dvi +UNINSTALL_HTML = uninstall-emacs-html uninstall-lispref-html \ + uninstall-lispintro-html uninstall-misc-html +UNINSTALL_PDF = uninstall-emacs-pdf uninstall-lispref-pdf \ + uninstall-lispintro-pdf uninstall-misc-pdf +UNINSTALL_PS = uninstall-emacs-ps uninstall-lispref-ps \ + uninstall-lispintro-ps uninstall-misc-ps +UNINSTALL_DOC = $(UNINSTALL_DVI) $(UNINSTALL_HTML) $(UNINSTALL_PDF) $(UNINSTALL_PS) + +$(UNINSTALL_DOC): + t=$@; IFS=-; set $$t; IFS=; cd doc/$$2 && $(MAKE) $(MFLAGS) $$1-$$3 + +.PHONY: $(UNINSTALL_DOC) uninstall-doc +.PHONY: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps + +uninstall-doc: $(UNINSTALL_DOC) +uninstall-dvi: $(UNINSTALL_DVI) +uninstall-html: $(UNINSTALL_HTML) +uninstall-pdf: $(UNINSTALL_PDF) +uninstall-ps: $(UNINSTALL_PS) + + force-info: # Note that man/Makefile knows how to put the info files in $(srcdir), # so we can do ok running make in the build dir. @@ -898,26 +1050,31 @@ info: force-info @if test "$(HAVE_MAKEINFO)" = "no"; then \ echo "Configured --without-makeinfo, not building manuals" ; \ else \ - $(MAKE) $(MFLAGS) info-real ; \ + $(MAKE) $(MFLAGS) info-real info-dir; \ fi -# The info/dir file must be updated by hand when new manuals are added. -check-info-dir: info +## build-aux/make-info-dir expects only certain dircategories. +check-info: info cd info ; \ - missing= ; \ + bad= ; \ for file in *; do \ test -f "$${file}" || continue ; \ case $${file} in \ *-[0-9]*|COPYING|dir) continue ;; \ esac ; \ - file=`echo $${file} | sed 's/\.info//'` ; \ - grep -q -F ": ($${file})." dir || missing="$${missing} $${file}" ; \ + cat=`sed -n 's/^INFO-DIR-SECTION //p' $${file}`; \ + case $${cat} in \ + "Texinfo documentation system" | "Emacs"| "Emacs lisp" | \ + "Emacs editing modes" | "Emacs network features" | \ + "Emacs misc features" | "Emacs lisp libraries" ) : ;; \ + *) bad="$${bad} $${file}" ;; \ + esac; \ done ; \ - if test -n "$${missing}"; then \ - echo "Missing info/dir entries: $${missing}" ; \ + if test -n "$${bad}"; then \ + echo "Unexpected dircategory in: $${bad}" ; \ exit 1 ; \ fi ; \ - echo "info/dir is OK" + echo "info files are OK" #### Bootstrapping. @@ -928,11 +1085,11 @@ check-info-dir: info # Bootstrapping does the following: # * Remove files to start from a bootstrap-clean slate. -# * Run autogen.sh, falling back on copy_autogen if autogen.sh fails. +# * Run autogen.sh. # * Rebuild Makefile, to update the build procedure itself. # * Do the actual build. bootstrap: bootstrap-clean FRC - cd $(srcdir) && { ./autogen.sh || autogen/copy_autogen; } + cd $(srcdir) && ./autogen.sh $(MAKE) $(MFLAGS) MAKEFILE_NAME=force-Makefile force-Makefile $(MAKE) $(MFLAGS) info all @@ -943,5 +1100,4 @@ check-declare: echo "You must build Emacs to use this command"; \ exit 1; \ fi - (cd leim; $(MAKE) $(MFLAGS) $@) - (cd lisp; $(MAKE) $(MFLAGS) $@) + cd lisp && $(MAKE) $(MFLAGS) $@ diff --git a/README b/README index ebd07eaaa3d..ceb09bf3fd4 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. @@ -24,8 +24,9 @@ list bug-gnu-emacs@gnu.org. If possible, use M-x report-emacs-bug. See the "Bugs" section of the Emacs manual for more information on how to report bugs. (The file `BUGS' in this directory explains how you can find and read that section using the Info files that come with -Emacs.) See `etc/MAILINGLISTS' for more information on mailing lists -relating to GNU packages. +Emacs.) For a list of mailing lists related to Emacs, see +. For the complete +list of GNU mailing lists, see . The `etc' subdirectory contains several other files, named in capital letters, which you might consider looking at when installing GNU @@ -64,9 +65,10 @@ There are several subdirectories: its primitives, the redisplay code, and some basic editing functions). `lisp' holds the Emacs Lisp code for Emacs (most everything else). -`leim' holds the library of Emacs input methods, Lisp code and - auxiliary data files required to type international characters - which can't be directly produced by your keyboard. +`leim' holds the original source files for the generated files + in lisp/leim. These form the library of Emacs input methods, + required to type international characters that can't be + directly produced by your keyboard. `lib' holds source code for libraries used by Emacs and its utilities `lib-src' holds the source code for some utility programs for use by or with Emacs, like movemail and etags. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index da8dec5a0f6..27d87dcaa2a 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -9,7 +9,6 @@ documented in config.in, and this file would not be necessary. AIX _AIX -BSD_SYSTEM CYGWIN Compiling the Cygwin port. __CYGWIN__ Ditto GNU_LINUX @@ -25,7 +24,6 @@ _MSC_VER Compiling the W32 port with the Microsoft C compiler. DARWIN_OS Compiling on Mac OS X or pure Darwin (and using s/darwin.h). SOLARIS2 USG -USG5 USG5_4 ** Distinguishing GUIs ** @@ -136,8 +134,6 @@ HAVE_DECL_STRTOUMAX HAVE_DECL_SYS_SIGLIST HAVE_DECL_TZNAME HAVE_DECL___SYS_SIGLIST -HAVE_DES_H -HAVE_DEV_PTMX HAVE_DIALOGS HAVE_DIFFTIME HAVE_DUP2 @@ -149,7 +145,6 @@ HAVE_FORK HAVE_FREEIFADDRS HAVE_FREETYPE HAVE_FSEEKO -HAVE_FSYNC HAVE_FUTIMENS HAVE_FUTIMES HAVE_FUTIMESAT @@ -176,8 +171,6 @@ HAVE_GET_CURRENT_DIR_NAME HAVE_GHOSTSCRIPT HAVE_GIF HAVE_GNUTLS -HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY -HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION HAVE_GPM HAVE_GRANTPT HAVE_GSETTINGS @@ -200,26 +193,15 @@ HAVE_IMAGEMAGICK HAVE_INET_SOCKETS HAVE_INTTYPES_H HAVE_JPEG -HAVE_KERBEROSIV_DES_H HAVE_KERBEROSIV_KRB_H -HAVE_KERBEROS_DES_H HAVE_KERBEROS_KRB_H HAVE_KRB5_ERROR_E_TEXT HAVE_KRB5_ERROR_TEXT HAVE_KRB5_H HAVE_KRB_H HAVE_LANGINFO_CODESET -HAVE_LIBCOM_ERR -HAVE_LIBCRYPTO -HAVE_LIBDES -HAVE_LIBDES425 HAVE_LIBDGC HAVE_LIBDNET -HAVE_LIBHESIOD -HAVE_LIBK5CRYPTO -HAVE_LIBKRB -HAVE_LIBKRB4 -HAVE_LIBKRB5 HAVE_LIBKSTAT HAVE_LIBLOCKFILE HAVE_LIBM @@ -228,12 +210,10 @@ HAVE_LIBOTF HAVE_LIBPERFSTAT HAVE_LIBPNG_PNG_H HAVE_LIBPTHREADS -HAVE_LIBRESOLV HAVE_LIBSELINUX HAVE_LIBXEXT HAVE_LIBXML2 HAVE_LIBXMU -HAVE_LINUX_VERSION_H HAVE_LOCALTIME_R HAVE_LOCAL_SOCKETS HAVE_LONG_FILE_NAMES @@ -300,7 +280,6 @@ HAVE_SNPRINTF HAVE_SOCKETS HAVE_SOUND HAVE_SOUNDCARD_H -HAVE_SPEED_T HAVE_STDINT_H HAVE_STDIO_EXT_H HAVE_STDLIB_H @@ -379,7 +358,6 @@ HAVE_WS2TCPIP_H HAVE_XAW3D HAVE_XFT HAVE_XIM -HAVE_XKBGETKEYBOARD HAVE_XPM HAVE_XRMSETDATABASE HAVE_XSCREENNUMBEROFSCREEN diff --git a/admin/ChangeLog b/admin/ChangeLog index 28e25ad98a3..f27a03af773 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,440 @@ +2014-02-06 David Engster + + * grammars/c.by (function-pointer): Correctly deal with anonymous + function pointers. + (opt-brackets-after-symbol): New. + (multi-stage-dereference): Use it. Add rules for explicit + matching the last dereference. + +2014-01-16 Eric S. Raymond + + * notes/commits: Add a 'graph on VCS-independent ways of + identifying commits and the desirability thereof. + +2014-01-15 Paul Eggert + + Fix copyright license notices for Adobe Unicode mapping files. + * charsets/mapfiles/README: The copied files are not compressed. + Check for copies as of today. + * charsets/mapfiles/stdenc.txt, charsets/mapfiles/symbol.txt: + Update from table version 0.2 (1999-03-30) to 1.0 (2011-07-12). + This doesn't change the table data, just copyright license notice. + The new notices are compatible with the GPL, the old ones were not. + +2014-01-13 Glenn Morris + + * update_autogen (status): New function. Use throughout. + +2014-01-10 Glenn Morris + + * update_autogen: Fix sed bug that was losing the last AUTOGEN_VCS. + +2014-01-04 Glenn Morris + + * admin.el (manual-html-fix-node-div): Handle Texinfo 5's movable
. + (manual-html-fix-index-2): Tweak Texinfo 5 table format. + Fix minor Texinfo 4 issue with start of detailed menu. + +2014-01-03 Glenn Morris + + * admin.el: More Texinfo 5 updates. + (manual-html-fix-headers): Tweak Texinfo 5 body. + (manual-html-fix-node-div): Treat "header" like "node". + (manual-html-fix-index-1): Handle Texinfo 5 top heading. + (manual-html-fix-index-2): Tweak Texinfo 5 listing tables. + +2014-01-02 Xue Fuqiao + + * check-doc-strings: Replace `perl -w' with `use warnings;'. + +2013-12-30 Glenn Morris + + * admin.el (manual-html-fix-headers, manual-html-fix-index-1): + Some updates for changes in Texinfo 5 output. + +2013-12-29 Xue Fuqiao + + * make-emacs: + * build-configs: Add the "use strict;" and "use warnings;" pragmas. + +2013-12-28 Glenn Morris + + * admin.el (cusver-scan): Warn about missing :types. + (cusver-check): Interactively, require existing directories. + +2013-12-27 Xue Fuqiao + + * admin.el (manual-misc-manuals, make-manuals): + (manual-pdf, cusver-find-files): + (cusver-new-version, cusver-scan, cusver-goto-xref): + (cusver-check): Doc fix. + (manual-html-node, cusver-check): Use `user-error'. + +2013-12-24 Paul Eggert + + Automate the procedure for updating copyright year. + * merge-gnulib (GNULIB_MODULES): Add update-copyright. + * notes/years: Mention admin/update-copyright. + * update-copyright: New file. + +2013-12-24 Xue Fuqiao + + * admin.el (add-release-logs): + (set-version-in-file, set-version, set-copyright): + Use `user-error'. + +2013-12-22 Eli Zaretskii + + * unidata/unidata-gen.el (unidata-split-name): Don't give any NAME + to characters: the Unicode Standard says they have no + name. (Bug#16216) + (unidata-describe-bidi-class): Add new "isolate" classes + introduced by Unicode 6.3. + +2013-12-12 David Engster + + * grammars/c.by (expr-binop): Add MOD. + (variablearg): Add 'opt-assign'. + (variablearg, varnamelist): Add default values so that it can be + later expanded into the tag. + (opt-stuff-after-symbol): Rename to 'brackets-after-symbol' and + remove empty match. + (multi-stage-dereference): Adapt to above rename. + (unaryexpression): Use 'symbol' instead of 'namespace-symbol', + since the latter also leads to an empty match at the end which + would make this too greedy. + (variablearg-opt-name): Support parsing of function pointers + inside an argument list. + +2013-12-12 Glenn Morris + + * update_autogen (info_dir): + Use dir_top from build-aux/ rather than admin/. + + * update_autogen: Add option to generate info/dir. + (Usage): Add -I. + (info_flag): New variable. + (-I): New option. + (doc): Maybe check its status. + (info_dir): New function. + * dir_top: New file. + +2013-12-11 Paul Eggert + + Remove the option of using libcrypto. + * merge-gnulib: Remove lib/gl_openssh.h and m4/gl-openssl.m4. + +2013-12-04 Eli Zaretskii + + * unidata/unidata-gen.el (unidata-prop-alist): Update bidi-class + to include the new isolate-related classes introduced with Unicode + v6.3. + (unidata-encode-val): Accept an additional optional argument, a + warning message to emit when UnicodeData.txt defines bidi-class + values that are not in unidata-prop-alist. Add a comment + explaining what should maintainers do if/when such a warning ever + appears. + (unidata-gen-table): Call unidata-encode-val with 3rd arg non-nil + when generating uni-bidi.el. + +2013-12-01 Glenn Morris + + * unidata/Makefile.in (${DSTDIR}/charprop.el): + Ensure output files are writable. + +2013-11-30 Glenn Morris + + * grammars/Makefile.in: Ensure output files are writable. + +2013-11-30 Eli Zaretskii + + * charsets/mule-charsets.el: Rewritten to work in Emacs 23 and + later. (Bug#16007) + +2013-11-30 Glenn Morris + + Stop keeping (most) generated cedet grammar files in the repository. + * grammars/README: Remove. + * grammars/Makefile.in: New file. + * grammars/c.by, grammars/java-tags.wy, grammars/js.wy: + * grammars/python.wy: Update declarations to match generated outputs. + +2013-11-28 Glenn Morris + + * unidata/unidata-gen.el (unidata-gen-files): + Disable autoloads in generated files. + +2013-11-27 Glenn Morris + + * unidata/Makefile.in (all, install, clean, bootstrap-clean) + (distclean, maintainer-clean): Declare as PHONY. + (compile, extraclean): New. + (${DSTDIR}/charprop.el): Depend on source files rather than + intermediate products. + +2013-11-11 Glenn Morris + + * unidata/BidiMirroring.txt, unidata/UnicodeData.txt: Update to 6.3.0. + + * unidata/unidata-gen.el (unidata-gen-files): + Tweak whitespace in generated files. + +2013-11-09 Glenn Morris + + * unidata/unidata-gen.el (unidata-gen-files): + Fix deletion of existing output files after 2013-10-30 changes. + +2013-11-07 Glenn Morris + + * unidata/unidata-gen.el (unidata-gen-files): + Disable version-control in generated files. + Update Unicode Inc. copyright years. + +2013-11-05 Glenn Morris + + * update_autogen: Move here from ../autogen. + (usage): Update. Remove -l, add -A. + (autogendir): New variable. + (ldefs_flag): Default to set. + (genfiles): Reduce to only ms-dos relevant files. + (main): Make checking autogen sources optional. + Make copying of autogen files optional. + +2013-10-30 Glenn Morris + + * unidata/unidata-gen.el (unidata-gen-files): Use pop. + Also take the output directory as an argument. + * unidata/Makefile.in: Simplify now that unidata-gen-files takes + the output directory as an argument (no need to cd, etc). + (abs_srcdir, abs_builddir): Remove. + (abs_top_builddir): Replace by top_builddir. + (${DSTDIR}/charprop.el): No need to cd. Pass dest as argument. + (${DSTDIR}/charprop.el, charprop.el): + No need to pass unidata.txt as argument. + + * unidata/unidata-gen.el (unidata--ensure-compiled): New function. + (unidata-gen-table-name, unidata-gen-table-decomposition) + (unidata-gen-files): Use unidata--ensure-compiled. + + * unidata/Makefile.in (abs_srcdir): New, set by configure. + (${DSTDIR}/charprop.el, charprop.el): Update for srcdir not absolute. + (clean): Delete all .elc files. + (bootstrap-clean): New rule. + +2013-10-23 Glenn Morris + + * unidata/Makefile.in (emacs, ${DSTDIR}/charprop.el): + Quote entities that might contain whitespace. + +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + * merge-gnulib (GNULIB_MODULES): Add count-one-bits + and count-trailing-zeros. + +2013-10-04 Paul Eggert + + Use hardware support for byteswapping on glibc x86 etc. + * merge-gnulib (GNULIB_MODULES): Add byteswap. + +2013-08-28 Paul Eggert + + * unidata/Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-27 Glenn Morris + + * admin.el (manual-misc-manuals): Use INFO_COMMON rather than + INFO_TARGETS. "faq" does not need special treatment any more. + +2013-08-15 Glenn Morris + + * make-tarball.txt: Mention generating pdfs in etc/refcards. + +2013-08-15 Xue Fuqiao + + * notes/hydra: More information about Hydra. + +2013-08-10 Xue Fuqiao + + * notes/hydra: New file. + +2013-08-04 Paul Eggert + + Fix some minor races in hosts lacking mkostemp (Bug#15015). + * merge-gnulib (GNULIB_MODULES): Add mkostemp. + +2013-07-12 Glenn Morris + + * admin.el (manual-style-string): Use non-abbreviated url. + +2013-07-09 Paul Eggert + + Port recent close-on-exec changes to Cygwin (Bug#14821). + * merge-gnulib (GNULIB_TOOL_FLAGS): Don't avoid binary-io. + + Handle error numbers a bit more reliably. + * merge-gnulib (GNULIB_MODULES): Remove ignore-value. + +2013-07-07 Paul Eggert + + Make file descriptors close-on-exec when possible (Bug#14803). + * merge-gnulib (GNULIB_MODULES): Add fcntl, pipe2. + (GNULIB_TOOL_FLAGS): Avoid binary-io, close. Do not avoid fcntl. + +2013-07-06 Glenn Morris + + * admin.el (manual-misc-manuals): New function. + (make-manuals): Avoid hard-coding list of misc manuals. + Add the option to only make certain type(s) of output. + (manual-misc-html): Special-case ccmode and efaq. + (manual-html-mono, manual-html-node, manual-pdf, manual-ps): + Move creation of output directory here from make-manuals. + (manual-html-fix-index-2): Avoid dynamic reference to `f'. + +2013-07-05 Glenn Morris + + * admin.el (make-manuals): Use a standard location for lispintro. + Use a pdf/ subdirectory for pdf versions. + +2013-06-29 Glenn Morris + + * admin.el (make-manuals): Don't bother with txt or dvi any more. + (manual-txt): Remove. + (manual-pdf): Doc fix. + (manual-ps): Rename from manual-dvi. + (manual-pdf, manual-ps): Work in the directory with the texi file, + so that TeX intermediate files go there rather than to PWD. + +2013-06-15 Xue Fuqiao + + * notes/changelogs: Mention trivial changes in Change Log. + +2013-06-13 Glenn Morris + + * admin.el (manual-style-string): Use new file manual.css. + +2013-06-02 Eric Ludlam + + * grammars/srecode-template.wy (variable): Accept a single number + as a variable value. Allows the 'priority' to be set to a number. + (wisent-srecode-template-lexer): Move number up so it can be created. + +2013-05-16 Glenn Morris + + * cus-test.el (cus-test-cus-load-groups): New function. + (cus-test-get-options): Add option to return groups. + (cus-test-noloads): Also check custom groups. + +2013-05-15 Stefan Monnier + + * quick-install-emacs: Don't prune DOC-* files a any more. + +2013-05-14 Glenn Morris + + * cus-test.el (cus-test-get-lisp-files): Ignore obsolete/. + (cus-test-libs): Fix let-binding of default-directory. + (cus-test-noloads): Load all libs for the comparison. + +2013-05-11 Glenn Morris + + * cus-test.el (cus-test-libs-noloads): Add a few more files. + (cus-test-load-libs, cus-test-opts): + Add option to load more/all Lisp files. + (cus-test-get-lisp-files): Ignore .*.el files. + +2013-05-10 Glenn Morris + + * cus-test.el (cus-test-libs-noloads): Add some files. + (cus-test-get-lisp-files): New function. + (cus-test-libs): Add option to load more/all Lisp files. + +2013-05-09 Glenn Morris + + * cus-test.el: No need to provide bbdb, bbdb-com any more. + (cus-test-libs-noloads): Add dunnet in the defvar. + (dunnet): Don't always load it. + (viper-mode): Only set if interactive. + (cus-test-load-custom-loads): Load dunnet if necessary. + (cus-test-load-1): New macro, with common code from cus-test-load-libs + and cus-test-libs. + (cus-test-load-libs, cus-test-libs): Use cus-test-load-1 macro. + Update for cus-test-get-autoload-deps changed result. + (cus-test-get-autoload-deps): Simplify. Return file names as they + appear in loaddefs.el (directory parts are needed now that not all + lisp subdirs are in load-path). + (cus-test-deps): Explicitly skip dunnet. + +2013-05-07 Paul Eggert + + Use Gnulib ACL implementation, for benefit of Solaris etc. (Bug#14295) + * merge-gnulib (GNULIB_MODULES): Add qacl. + (GNULIB_TOOL_FLAGS): Do not avoid errno. + +2013-04-01 Paul Eggert + + Use UTF-8 for most files with non-ASCII characters (Bug#13936). + * notes/unicode (etc/tutorials/TUTORIAL.ko, leim/quail/hanja.el) + (leim/quail/hanja3.el, leim/quail/symbol-ksc.el): + Now utf-8, not iso-2022-7bit. Also, files that contain non-UTF-8 + characters are now encoded in utf-8-emacs, not iso-2022-7bit. + +2013-03-18 Paul Eggert + + * notes/unicode: Mention some more iso-2022-7bit files (Bug#13936). + + Automate the build of ja-dic.el (Bug#13984). + * notes/unicode: ja-dic.el is now UTF-8. + +2013-03-16 Glenn Morris + + * admin.el (manual-pdf, manual-dvi): Pass -I to texi2pdf, texi2dvi. + +2013-03-16 Glenn Morris + + * admin.el (manual-html-mono, manual-html-node): Add -DWWW_GNU_ORG. + +2013-03-13 Paul Eggert + + File synchronization fixes (Bug#13944). + * CPP-DEFINES (BSD_SYSTEM, HAVE_FSYNC): Remove. + * merge-gnulib (GNULIB_MODULES): Add fsync, fdatasync. + +2013-03-11 Paul Eggert + + * notes/unicode: Improve notes about Emacs source file encoding. + +2013-03-11 Glenn Morris + + * admin.el (make-manuals): Add emacs-lisp-intro and some more + doc/misc manuals. + (manual-html-mono, manual-html-node, manual-txt): + Pass -I to makeinfo. + +2013-03-10 Glenn Morris + + * admin.el (add-release-logs): Use UTC for release date. + +2013-03-09 Glenn Morris + + * admin.el (add-release-logs): Provide interactive defaults. + Allow specification of the release date. Don't exclude gnus/. + +2013-03-05 Paul Eggert + + * notes/unicode: Add notes about Emacs source file encoding. + +2013-03-04 Paul Eggert + + * grammars/java-tags.wy (CHAR): Remove "('\u0000' to '\uffff')" + from summary, as this causes javat-wy.el to contain both a null byte + and a byte sequence that is not valid UTF-8, which is inconvenient. + +2013-03-03 Paul Eggert + + * bzrmerge.el (bzrmerge-apply): Omit Latin-1 char from diagnostic. + If there were a real need, it should be UTF-8 anyway. + 2013-02-25 Paul Eggert Simplify data_start configuration (Bug#13783). @@ -29,7 +466,7 @@ 2012-12-14 Paul Eggert - Fix permissions bugs with setgid directories etc. (Bug#13125) + Fix permissions bugs with setgid directories etc. (Bug#13125) * CPP-DEFINES (BSD4_2): Remove. 2012-12-08 Paul Eggert @@ -145,10 +582,10 @@ (cusver-scan): Check if containing group has a :version. (cusver-check): Add VERSION argument. -2012-10-01 David Engster +2012-10-06 David Engster * grammars/bovine-grammar.el: - * grammars/wisent-grammar.el: Move to lisp directory. + * grammars/wisent-grammar.el: Move to lisp/cedet/semantic directory. 2012-10-01 David Engster @@ -161,7 +598,7 @@ * grammars/grammar.wy (semantic-grammar-lexer): Remove, since it was copied to grammar.el. New %provide token to generate prefix - which conforms with Emacs conventions. Remove lexer definition, + which conforms with Emacs conventions. Remove lexer definition, which is now in grammar.el. 2012-09-27 Glenn Morris @@ -607,6 +1044,10 @@ * notes/bugtracker (bugtracker_debbugs_url): Fix typo. +2011-02-20 Paul Eggert + + * notes/copyright: Remove src/md5.c and src/md5.h as special cases. + 2011-02-19 Eli Zaretskii * admin.el (set-version): Add msdos/sed2v2.inp. @@ -616,6 +1057,7 @@ Remove no-longer needed getloadavg symbols. * CPP-DEFINES (LOAD_AVE_CVT, LOAD_AVE_TYPE, FSCALE, KERNEL_FILE): (LDAV_SYMBOL): Remove. + * notes/copyright: Remove src/getloadavg.c as a special case. 2011-02-12 Glenn Morris @@ -1138,7 +1580,7 @@ Sub-directory `unidata' is for codes to generate charprop.el and many other uni-*.el files from `UnicodeData.txt'. - * Unidata/README: New file. + * unidata/README: New file. * unidata/Makefile: New file. @@ -1564,8 +2006,6 @@ emacs.exe before zipping, and including batch file to recreate after unpacking. - * nt/stitch.bat: New file. - * nt/README-ftp-server: Update wording and version number etc. Add extra instructions for installing multi-file .zip distribution. @@ -1685,7 +2125,7 @@ 2001-09-04 Andrew Innes - * admin/nt/makedist.bat: Remove reference to obsolete file + * nt/makedist.bat: Remove reference to obsolete file GETTING.GNU.SOFTWARE. Remove outdated comments. Explain about version of tar used. @@ -1693,7 +2133,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2001-2013 Free Software Foundation, Inc. + Copyright (C) 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 1e4f9f3b48d..8b6bddbbd2f 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -2,7 +2,13 @@ Tasks needed before the next release. * TO BE DONE SHORTLY BEFORE RELEASE +** Either update, test, and support the old w32 build method, or remove it. + ** Manuals +Check for node names using problematic characters: + find doc -name '*.texi' -exec grep '^@node[^,]*[:.()]' {} + +Sadly makeinfo does not warn about such characters. + Check cross-references between the manuals (eg from emacs to elisp) are correct. You can use something like the following in the info directory in the Emacs build tree: @@ -10,6 +16,28 @@ directory in the Emacs build tree: emacs -Q --eval "(progn (require 'info) (setq Info-directory-list '(\".\")))" \ -f info-xref-check-all +Setting Info-directory-list avoids having system info pages confuse +things. References to external manuals will be flagged as +uncheckable. You should still check these, and also that each +external manual has an appropriate redirect in the file manual/.htaccess +in the web pages repository. E.g.: +Redirect /software/emacs/manual/html_mono/automake.html /software/automake/manual/automake.html +Redirect /software/emacs/manual/html_node/automake/ /software/automake/manual/html_node/ + +Another tool you can use to check links is gnu.org's linc.py: +http://www.gnu.org/server/source/ + +You run this something like: + +cd /path/to/cvs/emacs-www +linc.py -o /path/to/output-dir --url http://www.gnu.org/software/emacs/ . + +Be warned that it is really, really slow (as in, can take ~ a full day +to check the manual/ directory). It is probably best to run it on a +single directory at a time from eg manual/html_node. It is very +inefficient, but may reveal a few things that info-xref does not. + + make emacs.dvi, elisp.dvi, and deal with any errors (undefined references etc) in the output. Break any overfull lines. Underfull hboxes are not serious, but it can be nice to get rid of @@ -42,7 +70,6 @@ I think this is different to what you get if you just use eg `make emacs.pdf' (e.g., enable "smallbook"). ** Check the keybindings in the refcards are correct, and add any new ones. -Regenerate the pdf versions in etc/refcards/. What paper size are the English versions supposed to be on? On Debian testing, the packages texlive-lang-czechslovak and texlive-lang-polish will let you generate the cs-* and sk-* pdfs. @@ -112,7 +139,7 @@ SECTION READERS ---------------------------------- TUTORIAL cyd TUTORIAL.bg ogi -TUTORIAL.cn +TUTORIAL.cn xfq TUTORIAL.cs TUTORIAL.de wl TUTORIAL.eo @@ -120,7 +147,7 @@ TUTORIAL.es TUTORIAL.fr TUTORIAL.he eliz TUTORIAL.it -TUTORIAL.ja +TUTORIAL.ja TUTORIAL.ko TUTORIAL.nl Pieter Schoenmakers TUTORIAL.pl @@ -191,7 +218,6 @@ xresources.texi cyd ** Check the Lisp manual. abbrevs.texi rgm -advice.texi cyd anti.texi rgm back.texi rgm backups.texi cyd diff --git a/admin/README b/admin/README index d696a14176e..6a5fce688a9 100644 --- a/admin/README +++ b/admin/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/admin.el b/admin/admin.el index e815dfade47..007cb06e592 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -1,6 +1,6 @@ ;;; admin.el --- utilities for Emacs administration -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -21,46 +21,64 @@ ;; add-release-logs Add ``Version X released'' change log entries. ;; set-version Change Emacs version number in source tree. -;; set-copyright Change emacs short copyright string (eg as +;; set-copyright Change Emacs short copyright string (eg as ;; printed by --version) in source tree. ;;; Code: (defvar add-log-time-format) ; in add-log -(defun add-release-logs (root version) +;; Does this information need to be in every ChangeLog, as opposed to +;; just the top-level one? Only if you allow changes the same +;; day as the release. +;; http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00161.html +(defun add-release-logs (root version &optional date) "Add \"Version VERSION released.\" change log entries in ROOT. -Root must be the root of an Emacs source tree." - (interactive "DEmacs root directory: \nNVersion number: ") +Root must be the root of an Emacs source tree. +Optional argument DATE is the release date, default today." + (interactive (list (read-directory-name "Emacs root directory: ") + (read-string "Version number: " + (format "%s.%s" emacs-major-version + emacs-minor-version)) + (read-string "Release date: " + (progn (require 'add-log) + (let ((add-log-time-zone-rule t)) + (funcall add-log-time-format)))))) (setq root (expand-file-name root)) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) - (error "%s doesn't seem to be the root of an Emacs source tree" root)) + (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) (require 'add-log) + (or date (setq date (let ((add-log-time-zone-rule t)) + (funcall add-log-time-format)))) (let* ((logs (process-lines "find" root "-name" "ChangeLog")) (entry (format "%s %s <%s>\n\n\t* Version %s released.\n\n" - (funcall add-log-time-format) + date (or add-log-full-name (user-full-name)) (or add-log-mailing-address user-mail-address) version))) (dolist (log logs) - (unless (string-match "/gnus/" log) - (find-file log) - (goto-char (point-min)) - (insert entry))))) + (find-file log) + (goto-char (point-min)) + (insert entry)))) (defun set-version-in-file (root file version rx) + "Subroutine of `set-version' and `set-copyright'." (find-file (expand-file-name file root)) (goto-char (point-min)) - (unless (re-search-forward rx nil t) - (error "Version not found in %s" file)) + (unless (re-search-forward rx nil :noerror) + (user-error "Version not found in %s" file)) (replace-match (format "%s" version) nil nil nil 1)) +;; TODO report the progress (defun set-version (root version) "Set Emacs version to VERSION in relevant files under ROOT. Root must be the root of an Emacs source tree." (interactive "DEmacs root directory: \nsVersion number: ") (unless (file-exists-p (expand-file-name "src/emacs.c" root)) - (error "%s doesn't seem to be the root of an Emacs source tree" root)) + (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) + ;; There's also a "version 3" (standing for GPLv3) at the end of + ;; `README', but since `set-version-in-file' only replaces the first + ;; occurrence, it won't be replaced. (set-version-in-file root "README" version (rx (and "version" (1+ space) (submatch (1+ (in "0-9.")))))) @@ -91,7 +109,7 @@ Root must be the root of an Emacs source tree." ;; in two places those commas are followed by space, in two other ;; places they are not. (let* ((version-components (append (split-string version "\\.") - '("0" "0"))) + '("0" "0"))) (comma-version (concat (car version-components) "," (cadr version-components) "," @@ -144,6 +162,7 @@ Root must be the root of an Emacs source tree." ;; Note this makes some assumptions about form of short copyright. +;; TODO report the progress (defun set-copyright (root copyright) "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT. Root must be the root of an Emacs source tree." @@ -154,7 +173,7 @@ Root must be the root of an Emacs source tree." (format "Copyright (C) %s Free Software Foundation, Inc." (format-time-string "%Y"))))) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) - (error "%s doesn't seem to be the root of an Emacs source tree" root)) + (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) (set-version-in-file root "configure.ac" copyright (rx (and bol "copyright" (0+ (not (in ?\"))) ?\" (submatch (1+ (not (in ?\")))) ?\"))) @@ -180,54 +199,87 @@ Root must be the root of an Emacs source tree." ;;; Various bits of magic for generating the web manuals -(defun make-manuals (root) - "Generate the web manuals for the Emacs webpage." - (interactive "DEmacs root directory: ") +(defun manual-misc-manuals (root) + "Return doc/misc manuals as list of strings. +ROOT should be the root of an Emacs source tree." + ;; Similar to `make -C doc/misc echo-info', but works if unconfigured, + ;; and for INFO_TARGETS rather than INFO_INSTALL. + (with-temp-buffer + (insert-file-contents (expand-file-name "doc/misc/Makefile.in" root)) + ;; Should really use expanded value of INFO_TARGETS. + (search-forward "INFO_COMMON = ") + (let ((start (point))) + (end-of-line) + (while (and (looking-back "\\\\") + (zerop (forward-line 1))) + (end-of-line)) + (append (split-string (replace-regexp-in-string + "\\(\\\\\\|\\.info\\)" "" + (buffer-substring start (point)))) + '("efaq-w32"))))) + +;; TODO report the progress +(defun make-manuals (root &optional type) + "Generate the web manuals for the Emacs webpage. +ROOT should be the root of an Emacs source tree. +Interactively with a prefix argument, prompt for TYPE. +Optional argument TYPE is type of output (nil means all)." + (interactive (let ((root (read-directory-name "Emacs root directory: " + source-directory nil t))) + (list root + (if current-prefix-arg + (completing-read + "Type: " + (append + '("misc" "pdf" "ps") + (let (res) + (dolist (i '("emacs" "elisp" "eintr") res) + (dolist (j '("" "-mono" "-node" "-ps" "-pdf")) + (push (concat i j) res)))) + (manual-misc-manuals root))))))) (let* ((dest (expand-file-name "manual" root)) (html-node-dir (expand-file-name "html_node" dest)) (html-mono-dir (expand-file-name "html_mono" dest)) - (txt-dir (expand-file-name "text" dest)) - (dvi-dir (expand-file-name "dvi" dest)) - (ps-dir (expand-file-name "ps" dest))) + (ps-dir (expand-file-name "ps" dest)) + (pdf-dir (expand-file-name "pdf" dest)) + (emacs (expand-file-name "doc/emacs/emacs.texi" root)) + (elisp (expand-file-name "doc/lispref/elisp.texi" root)) + (eintr (expand-file-name "doc/lispintro/emacs-lisp-intro.texi" root)) + (misc (manual-misc-manuals root))) + ;; TODO this makes it non-continuable. + ;; Instead, delete the individual dest directory each time. (when (file-directory-p dest) - (if (y-or-n-p (format "Directory %s exists, delete it first?" dest)) + (if (y-or-n-p (format "Directory %s exists, delete it first? " dest)) (delete-directory dest t) - (error "Aborted"))) - (make-directory dest) - (make-directory html-node-dir) - (make-directory html-mono-dir) - (make-directory txt-dir) - (make-directory dvi-dir) - (make-directory ps-dir) - ;; Emacs manual - (let ((texi (expand-file-name "doc/emacs/emacs.texi" root))) - (manual-html-node texi (expand-file-name "emacs" html-node-dir)) - (manual-html-mono texi (expand-file-name "emacs.html" html-mono-dir)) - (manual-txt texi (expand-file-name "emacs.txt" txt-dir)) - (manual-pdf texi (expand-file-name "emacs.pdf" dest)) - (manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir) - (expand-file-name "emacs.ps" ps-dir))) - ;; Lisp manual - (let ((texi (expand-file-name "doc/lispref/elisp.texi" root))) - (manual-html-node texi (expand-file-name "elisp" html-node-dir)) - (manual-html-mono texi (expand-file-name "elisp.html" html-mono-dir)) - (manual-txt texi (expand-file-name "elisp.txt" txt-dir)) - (manual-pdf texi (expand-file-name "elisp.pdf" dest)) - (manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir) - (expand-file-name "elisp.ps" ps-dir))) + (user-error "Aborted"))) + (if (member type '(nil "emacs" "emacs-node")) + (manual-html-node emacs (expand-file-name "emacs" html-node-dir))) + (if (member type '(nil "emacs" "emacs-mono")) + (manual-html-mono emacs (expand-file-name "emacs.html" html-mono-dir))) + (if (member type '(nil "emacs" "emacs-pdf" "pdf")) + (manual-pdf emacs (expand-file-name "emacs.pdf" pdf-dir))) + (if (member type '(nil "emacs" "emacs-ps" "ps")) + (manual-ps emacs (expand-file-name "emacs.ps" ps-dir))) + (if (member type '(nil "elisp" "elisp-node")) + (manual-html-node elisp (expand-file-name "elisp" html-node-dir))) + (if (member type '(nil "elisp" "elisp-mono")) + (manual-html-mono elisp (expand-file-name "elisp.html" html-mono-dir))) + (if (member type '(nil "elisp" "elisp-pdf" "pdf")) + (manual-pdf elisp (expand-file-name "elisp.pdf" pdf-dir))) + (if (member type '(nil "elisp" "elisp-ps" "ps")) + (manual-ps elisp (expand-file-name "elisp.ps" ps-dir))) + (if (member type '(nil "eintr" "eintr-node")) + (manual-html-node eintr (expand-file-name "eintr" html-node-dir))) + (if (member type '(nil "eintr" "eintr-node")) + (manual-html-mono eintr (expand-file-name "eintr.html" html-mono-dir))) + (if (member type '(nil "eintr" "eintr-pdf" "pdf")) + (manual-pdf eintr (expand-file-name "eintr.pdf" pdf-dir))) + (if (member type '(nil "eintr" "eintr-ps" "ps")) + (manual-ps eintr (expand-file-name "eintr.ps" ps-dir))) ;; Misc manuals - (let ((manuals '("ada-mode" "auth" "autotype" "calc" "cc-mode" - "cl" "dbus" "dired-x" "ebrowse" "ede" "ediff" - "edt" "eieio" "emacs-mime" "epa" "erc" "ert" - "eshell" "eudc" "faq" "flymake" "forms" - "gnus" "emacs-gnutls" "idlwave" "info" - "mairix-el" "message" "mh-e" "newsticker" - "nxml-mode" "org" "pcl-cvs" "pgg" "rcirc" - "remember" "reftex" "sasl" "sc" "semantic" - "ses" "sieve" "smtpmail" "speedbar" "tramp" - "url" "vip" "viper" "widget" "woman"))) - (dolist (manual manuals) - (manual-misc-html manual root html-node-dir html-mono-dir))) + (dolist (manual misc) + (if (member type `(nil ,manual "misc")) + (manual-misc-html manual root html-node-dir html-mono-dir))) (message "Manuals created in %s" dest))) (defconst manual-doctype-string @@ -242,10 +294,14 @@ Root must be the root of an Emacs source tree." \n\n") (defconst manual-style-string "\n") +@import url('/software/emacs/manual.css');\n\n") (defun manual-misc-html (name root html-node-dir html-mono-dir) - (let ((texi (expand-file-name (format "doc/misc/%s.texi" name) root))) + ;; Hack to deal with the cases where .texi creates a different .info. + ;; Blech. TODO Why not just rename the .texi (or .info) files? + (let* ((texiname (cond ((equal name "ccmode") "cc-mode") + (t name))) + (texi (expand-file-name (format "doc/misc/%s.texi" texiname) root))) (manual-html-node texi (expand-file-name name html-node-dir)) (manual-html-mono texi (expand-file-name (concat name ".html") html-mono-dir)))) @@ -255,7 +311,13 @@ Root must be the root of an Emacs source tree." This function also edits the HTML files so that they validate as HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using the @import directive." + (make-directory (or (file-name-directory dest) ".") t) (call-process "makeinfo" nil nil nil + "-D" "WWW_GNU_ORG" + "-I" (expand-file-name "../emacs" + (file-name-directory texi-file)) + "-I" (expand-file-name "../misc" + (file-name-directory texi-file)) "--html" "--no-split" texi-file "-o" dest) (with-temp-buffer (insert-file-contents dest) @@ -266,6 +328,7 @@ the @import directive." (manual-html-fix-node-div) (goto-char (point-max)) (re-search-backward "[\n \t]*") + ;; Close the div id="content" that fix-index-1 added. (insert "\n\n") (save-buffer))) @@ -275,8 +338,14 @@ This function also edits the HTML files so that they validate as HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using the @import directive." (unless (file-exists-p texi-file) - (error "Manual file %s not found" texi-file)) + (user-error "Manual file %s not found" texi-file)) + (make-directory dir t) (call-process "makeinfo" nil nil nil + "-D" "WWW_GNU_ORG" + "-I" (expand-file-name "../emacs" + (file-name-directory texi-file)) + "-I" (expand-file-name "../misc" + (file-name-directory texi-file)) "--html" texi-file "-o" dir) ;; Loop through the node files, fixing them up. (dolist (f (directory-files dir nil "\\.html\\'")) @@ -300,143 +369,244 @@ the @import directive." (manual-html-fix-index-2) (if copyright-text (insert copyright-text)) + ;; Close the div id="content" that fix-index-1 added. (insert "\n\n")) ;; For normal nodes, give the header div a blue bg. - (manual-html-fix-node-div)) + (manual-html-fix-node-div t)) (save-buffer)))))) -(defun manual-txt (texi-file dest) - "Run Makeinfo on TEXI-FILE, emitting plaintext output to DEST." - (call-process "makeinfo" nil nil nil - "--plaintext" "--no-split" texi-file "-o" dest) - (shell-command (concat "gzip -c " dest " > " (concat dest ".gz")))) - (defun manual-pdf (texi-file dest) - "Run texi2pdf on TEXI-FILE, emitting plaintext output to DEST." - (call-process "texi2pdf" nil nil nil texi-file "-o" dest)) + "Run texi2pdf on TEXI-FILE, emitting PDF output to DEST." + (make-directory (or (file-name-directory dest) ".") t) + (let ((default-directory (file-name-directory texi-file))) + (call-process "texi2pdf" nil nil nil + "-I" "../emacs" "-I" "../misc" + texi-file "-o" dest))) -(defun manual-dvi (texi-file dest ps-dest) - "Run texi2dvi on TEXI-FILE, emitting dvi output to DEST. -Also generate PostScript output in PS-DEST." - (call-process "texi2dvi" nil nil nil texi-file "-o" dest) - (call-process "dvips" nil nil nil dest "-o" ps-dest) - (call-process "gzip" nil nil nil dest) - (call-process "gzip" nil nil nil ps-dest)) +(defun manual-ps (texi-file dest) + "Generate a PostScript version of TEXI-FILE as DEST." + (make-directory (or (file-name-directory dest) ".") t) + (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi")) + (default-directory (file-name-directory texi-file))) + ;; FIXME: Use `texi2dvi --ps'? --xfq + (call-process "texi2dvi" nil nil nil + "-I" "../emacs" "-I" "../misc" + texi-file "-o" dvi-dest) + (call-process "dvips" nil nil nil dvi-dest "-o" dest) + (delete-file dvi-dest) + (call-process "gzip" nil nil nil dest))) (defun manual-html-fix-headers () "Fix up HTML headers for the Emacs manual in the current buffer." - (let (opoint) - (insert manual-doctype-string) + (let ((texi5 (search-forward "\n") (insert manual-meta-string) (search-forward "") (goto-char (match-beginning 0)) (delete-region opoint (point)) (insert manual-style-string) - (search-forward "") - (delete-region opoint (match-beginning 0)))) - -(defun manual-html-fix-node-div () - "Fix up HTML \"node\" divs in the current buffer." - (let (opoint div-end) - (while (search-forward "
" nil t) - (replace-match - "
" - t t) + ;; Remove Texinfo 5 hard-coding bgcolor, text, link, vlink, alink. + (when (re-search-forward "") - (setq div-end (match-beginning 0)) - (goto-char opoint) - (if (search-forward "
" div-end 'move) - (replace-match "" t t))))) + (search-forward ">") + (if (> (point) (1+ opoint)) + (delete-region opoint (1- (point)))) + (search-backward "\\)" nil t) + (setq type (match-string 1)) + ;; NB it is this that makes the bg of non-header cells in the + ;; index tables be blue. Is that intended? + ;; Also, if you don't remove the
, the color of the first + ;; row in the table will be wrong. + ;; This all seems rather odd to me... + (replace-match " style=\"background-color:#DDDDFF\">" t t nil 2) + (setq opoint (point)) + (when (or split (equal type "node")) + ;; In Texinfo 4, the
(and anchor) comes after the
. + (re-search-forward "
") + (setq div-end (if (equal type "node") + (match-beginning 0) + (line-end-position 2))) + (goto-char opoint) + (if (search-forward "
" div-end 'move) + (replace-match "" t t) + (if split (forward-line -1)))) + ;; In Texinfo 5, the
(and anchor) comes before the
(?). + ;; Except in split output, where it comes on the line after + ;; the
. But only sometimes. I have no clue what the + ;; logic of where it goes is. + (when (equal type "header") + (goto-char opoint) + (when (re-search-backward "^
$" (line-beginning-position -3) t) + (replace-match "") + (goto-char opoint)))))) + (defun manual-html-fix-index-1 () + "Remove the h1 header, and the short and long contents lists. +Also start a \"content\" div." (let (opoint) - (re-search-forward "\n") + (re-search-forward "\n") (setq opoint (match-end 0)) - (search-forward "

\n\n"))) (defun manual-html-fix-index-2 (&optional table-workaround) - "Replace the index list in the current buffer with a HTML table." - (let (done open-td tag desc) - ;; Convert the list that Makeinfo made into a table. - (or (search-forward "
    " nil t) - (search-forward "
      ")) - (replace-match "") - (forward-line 1) - (while (not done) - (cond - ((or (looking-at "
    • \\(\\):[ \t]+\\(.*\\)$") - (looking-at "
    • \\(\\)$")) - (setq tag (match-string 1)) - (setq desc (match-string 2)) - (replace-match "" t t) - (when open-td - (save-excursion - (forward-char -1) - (skip-chars-backward " ") - (delete-region (point) (line-end-position)) - (insert "\n "))) - (insert "
    • \n ") - (if table-workaround - ;; This works around a Firefox bug in the mono file. - (insert "\n
      ") - (insert "")) - (insert tag "" (or desc "")) - (setq open-td t)) - ((eq (char-after) ?\n) - (delete-char 1) - ;; Negate the following `forward-line'. - (forward-line -1)) - ((looking-at "")) - ((looking-at "

      [- ]*The Detailed Node Listing[- \n]*") - (replace-match "

      \n + "Replace the index list in the current buffer with a HTML table. +Leave point after the table." + (if (re-search-forward "" nil t) + ;; Texinfo 5 already uses a table. Tweak it a bit. + (let (opoint done) + (replace-match " style=\"float:left\" width=\"100%\"" nil t nil 1) + (forward-line 1) + (while (not done) + (cond ((re-search-forward "\\)\ +:]*>\\(.*\\)" (line-end-position) t) + (replace-match (format "\\1\n") + (forward-line 1)) + ((looking-at "\n") + (replace-match "") + (replace-match "\n")) + ;; Not all manuals have the detailed menu. + ;; If it is there, split it into a separate table. + ((re-search-forward ".*The Detailed Node Listing *" + (line-end-position) t) + (setq opoint (match-beginning 0)) + (while (and (looking-at " *—") + (zerop (forward-line 1)))) + (delete-region opoint (point)) + (insert "
        
      \\2" + (if table-workaround + " bgcolor=\"white\"" ""))) + (search-forward "
      ") + (search-forward "
      \n\n\ +

      Detailed Node Listing

      \n\n

      ") + ;; FIXME Fragile! + ;; The Emacs and Elisp manual have some text at the + ;; start of the detailed menu that is not part of the menu. + ;; Other manuals do not. + (if (re-search-forward "in one step:" (line-end-position 3) t) + (forward-line 1)) + (insert "

      \n") + (search-forward "") + (delete-region (match-beginning 0) (match-end 0)) + (forward-line -1) + (or (looking-at "^$") (error "Parse error 1")) + (forward-line -1) + (if (looking-at "^$") (error "Parse error 2")) + (forward-line -1) + (or (looking-at "^$") (error "Parse error 3")) + (forward-line 1) + (insert "\n\ +") + (forward-line 1)) + ((looking-at ".*" nil t) + ;; FIXME? The following search seems dangerously lax. + (search-forward "
        ")) + (replace-match "
      \n") + (forward-line 1) + (insert "
      ") + (forward-line 1) + (while (not done) + (cond + ((or (looking-at "
    • \\(\\):[ \t]+\\(.*\\)$") + (looking-at "
    • \\(\\)$")) + (setq tag (match-string 1)) + (setq desc (match-string 2)) + (replace-match "" t t) + (when open-td + (save-excursion + (forward-char -1) + (skip-chars-backward " ") + (delete-region (point) (line-end-position)) + (insert "\n "))) + (insert "
    • \n ") + (if table-workaround + ;; This works around a Firefox bug in the mono file. + (insert "\n
      ") + (insert "")) + (insert tag "" (or desc "")) + (setq open-td t)) + ((eq (char-after) ?\n) + (delete-char 1) + ;; Negate the following `forward-line'. + (forward-line -1)) + ((looking-at "")) + ((looking-at "

      [- ]*The Detailed Node Listing[- \n]*") + (replace-match "

      \n

      Detailed Node Listing

      \n\n" t t) - (search-forward "

      ") - (search-forward "

      " nil t) - (goto-char (match-beginning 0)) - (skip-chars-backward "\n ") - (setq open-td nil) - (insert "

      \n\n")) - ((looking-at "") - (replace-match "" t t)) - ((looking-at "

      ") - (replace-match "" t t) - (when open-td - (insert " ") - (setq open-td nil)) - (insert "

      + (search-forward "

      ") + ;; FIXME Fragile! + ;; The Emacs and Elisp manual have some text at the + ;; start of the detailed menu that is not part of the menu. + ;; Other manuals do not. + (if (looking-at "Here are some other nodes") + (search-forward "

      ")) + (goto-char (match-beginning 0)) + (skip-chars-backward "\n ") + (setq open-td nil) + (insert "

      \n\n
      ")) + ((looking-at "") + (replace-match "" t t)) + ((looking-at "

      ") + (replace-match "" t t) + (when open-td + (insert " ") + (setq open-td nil)) + (insert "

      "))) - ((looking-at "[ \t]*[ \t]*$") - (replace-match - (if open-td - " \n
      ") - (if (re-search-forward "

      [ \t\n]*
        " nil t) - (replace-match "
      " - "") t t) - (setq done t)) - (t - (if (eobp) - (error "Parse error in %s" f)) ; f is bound in manual-html-node - (unless open-td - (setq done t)))) - (forward-line 1)))) + (if (re-search-forward "

      [ \t\n]*
        " nil t) + (replace-match " "))) + ((looking-at "[ \t]*
      [ \t]*$") + (replace-match + (if open-td + " \n" + "") t t) + (setq done t)) + (t + (if (eobp) + (error "Parse error in %s" + (file-name-nondirectory buffer-file-name))) + (unless open-td + (setq done t)))) + (forward-line 1))))) -;; Stuff to check new defcustoms got :version tags. +;; Stuff to check new `defcustom's got :version tags. ;; Adapted from check-declare.el. (defun cusver-find-files (root &optional old) - "Find .el files beneath directory ROOT that contain defcustoms. -If optional OLD is non-nil, also include defvars." + "Find .el files beneath directory ROOT that contain `defcustom's. +If optional OLD is non-nil, also include `defvar's." (process-lines find-program root "-name" "*.el" "-exec" grep-program @@ -448,14 +618,14 @@ If optional OLD is non-nil, also include defvars." (defvar cusver-new-version (format "%s.%s" emacs-major-version (1+ emacs-minor-version)) - "Version number that new defcustoms should have.") + "Version number that new `defcustom's should have.") (defun cusver-scan (file &optional old) "Scan FILE for `defcustom' calls. Return a list with elements of the form (VAR . VER), This means that FILE contains a defcustom for variable VAR, with a :version tag having value VER (may be nil). -If optional argument OLD is non-nil, also scan for defvars." +If optional argument OLD is non-nil, also scan for `defvar's." (let ((m (format "Scanning %s..." file)) (re (format "^[ \t]*\\((def%s\\)[ \t\n]" (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)"))) @@ -464,13 +634,19 @@ If optional argument OLD is non-nil, also scan for defvars." (with-temp-buffer (insert-file-contents file) ;; FIXME we could theoretically be inside a string. - (while (re-search-forward re nil t) + (while (re-search-forward re nil :noerror) (goto-char (match-beginning 1)) (if (and (setq form (ignore-errors (read (current-buffer)))) (setq var (car-safe (cdr-safe form))) ;; Exclude macros, eg (defcustom ,varname ...). (symbolp var)) (progn + ;; FIXME It should be cus-test-apropos that does this. + (and (not old) + (equal "custom" (match-string 2)) + (not (memq :type form)) + (display-warning 'custom + (format "Missing type in: `%s'" form))) (setq ver (car (cdr-safe (memq :version form)))) (if (equal "group" (match-string 2)) ;; Group :version could be old. @@ -506,7 +682,7 @@ If optional argument OLD is non-nil, also scan for defvars." (define-button-type 'cusver-xref 'action #'cusver-goto-xref) (defun cusver-goto-xref (button) - "Jump to a lisp file for the BUTTON at point." + "Jump to a Lisp file for the BUTTON at point." (let ((file (button-get button 'file)) (var (button-get button 'var))) (if (not (file-readable-p file)) @@ -522,34 +698,36 @@ If optional argument OLD is non-nil, also scan for defvars." ;; TODO Check cus-start if something moved from C to Lisp. ;; TODO Handle renamed things with aliases to the old names. (defun cusver-check (newdir olddir version) - "Check that defcustoms have :version tags where needed. -NEWDIR is the current lisp/ directory, OLDDIR is that from the previous -release. A defcustom that is only in NEWDIR should have a :version -tag. We exclude cases where a defvar exists in OLDDIR, since -just converting a defvar to a defcustom does not require a :version bump. + "Check that `defcustom's have :version tags where needed. +NEWDIR is the current lisp/ directory, OLDDIR is that from the +previous release, VERSION is the new version number. A +`defcustom' that is only in NEWDIR should have a :version tag. +We exclude cases where a `defvar' exists in OLDDIR, since just +converting a `defvar' to a `defcustom' does not require +a :version bump. Note that a :version tag should also be added if the value of a defcustom changes (in a non-trivial way). This function does not check for that." - (interactive (list (read-directory-name "New Lisp directory: ") - (read-directory-name "Old Lisp directory: ") + (interactive (list (read-directory-name "New Lisp directory: " nil nil t) + (read-directory-name "Old Lisp directory: " nil nil t) (number-to-string (read-number "New version number: " (string-to-number cusver-new-version))))) (or (file-directory-p (setq newdir (expand-file-name newdir))) - (error "Directory `%s' not found" newdir)) + (user-error "Directory `%s' not found" newdir)) (or (file-directory-p (setq olddir (expand-file-name olddir))) - (error "Directory `%s' not found" olddir)) + (user-error "Directory `%s' not found" olddir)) (setq cusver-new-version version) - (let* ((newfiles (progn (message "Finding new files with defcustoms...") + (let* ((newfiles (progn (message "Finding new files with `defcustom's...") (cusver-find-files newdir))) - (oldfiles (progn (message "Finding old files with defcustoms...") + (oldfiles (progn (message "Finding old files with `defcustom's...") (cusver-find-files olddir t))) - (newcus (progn (message "Reading new defcustoms...") + (newcus (progn (message "Reading new `defcustom's...") (mapcar (lambda (file) (cons file (cusver-scan file))) newfiles))) oldcus result thisfile file) - (message "Reading old defcustoms...") + (message "Reading old `defcustom's...") (dolist (file oldfiles) (setq oldcus (append oldcus (cusver-scan file t)))) (setq oldcus (append oldcus (cusver-scan-cus-start @@ -574,7 +752,7 @@ changes (in a non-trivial way). This function does not check for that." (message "No missing :version tags") (pop-to-buffer "*cusver*") (erase-buffer) - (insert "These defcustoms might be missing :version tags:\n\n") + (insert "These `defcustom's might be missing :version tags:\n\n") (dolist (elem result) (let* ((str (file-relative-name (car elem) newdir)) (strlen (length str))) diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c index d8fc97cc721..a63e1bacef5 100644 --- a/admin/alloc-colors.c +++ b/admin/alloc-colors.c @@ -1,6 +1,6 @@ /* Allocate X colors. Used for testing with dense colormaps. -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/build-configs b/admin/build-configs index 8b738befb18..6a369416696 100755 --- a/admin/build-configs +++ b/admin/build-configs @@ -1,7 +1,7 @@ #! /usr/bin/perl # Build Emacs in several different configurations. -# Copyright (C) 2001-2013 Free Software Foundation, Inc. +# Copyright (C) 2001-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -20,6 +20,8 @@ require 5; +use strict; +use warnings; use Getopt::Long; use File::Basename; use Cwd; diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index b95c96d77ef..924033b1554 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -1,6 +1,6 @@ ;;; bzrmerge.el --- help merge one Emacs bzr branch to another -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: maint @@ -50,7 +50,7 @@ The list returned is sorted by oldest-first." (call-process "bzr" nil t nil "status" "-v") (goto-char (point-min)) (when (re-search-forward "^conflicts:\n" nil t) - (error "You still have unresolved conflicts")) + (user-error "You still have unresolved conflicts")) (let ((merges ()) found) (if (not (re-search-forward "^pending merges:\n" nil t)) @@ -62,7 +62,7 @@ The list returned is sorted by oldest-first." (setq found (not (equal "unknown" (match-string 1))))))) found) - (error "You still have uncommitted changes")) + (user-error "You still have uncommitted changes")) ;; This is really stupid, but it seems there's no easy way to figure ;; out which revisions have been merged already. The only info I can ;; find is the "pending merges" from "bzr status -v", which is not @@ -171,7 +171,7 @@ Type `y' to skip this revision, (enable-local-eval nil)) (find-file-noselect file)) (if (buffer-modified-p) - (error "Unsaved changes in %s" (current-buffer))) + (user-error "Unsaved changes in %s" (current-buffer))) (save-excursion (cond ((derived-mode-p 'change-log-mode) @@ -320,10 +320,10 @@ Does not make other difference." ;; bzrmerge-add-metadata does not work when there ;; are conflicts. (display-warning 'bzrmerge "Resolve conflicts manually. -BEWARE! Important metadata is kept in this Emacs session! +BEWARE! Important metadata is kept in this Emacs session! Do not commit without re-running `M-x bzrmerge' first!" :warning bzrmerge-warning-buffer)) - (error "Resolve conflicts manually"))))) + (user-error "Resolve conflicts manually"))))) (cons merge skip))))) (defun bzrmerge (from) diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index 0a742854811..15ec320589f 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -1,4 +1,4 @@ -Copyright (C) 2009-2013 Free Software Foundation, Inc. +Copyright (C) 2009-2014 Free Software Foundation, Inc. Copyright (C) 2009, 2010, 2011 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H13PRO009 @@ -6,47 +6,48 @@ See the end of the file for license conditions. The charset map files directory -This directory contains two kinds of charset map files; verbatim copies -(or their compressed versions) of files freely available in the -Internet, and newly created files based on freely available -information. +This directory contains two kinds of charset map files; verbatim +copies of files freely available in the Internet, and newly created +files based on freely available information. -(1) Copied files (all files are copied on 2009-06-12) +(1) Copied files (all files were copied on 2014-01-15): -* CP932.TXT.gz +* CP932.TXT -The uncompressed version is available at: +Available at: -* PTCP154.gz +* PTCP154 -The uncompressed version is available at: +Available at: -* Uni2JIS.gz +* Uni2JIS The version compressed by Unix's "compress" command is available at: +This directory's copy has corrected the misspellings of "characters" +and of "Byelorussian". -* bulgarian-mik.txt.gz +* bulgarian-mik.txt -It is available at: - . +The compressed version is available at: + -* cns2ucsdkw.txt.gz +* cns2ucsdkw.txt -Uncompressed version is available at: +Available at: -* stdenc.txt.gz and symbol.txt.gz +* stdenc.txt and symbol.txt -The uncompressed versions are available at: +Available at: (2) Newly created files -* CP720.map.gz and CP858.map.gz +* CP720.map and CP858.map Created manually by looking at these pages: . @@ -54,13 +55,13 @@ Created manually by looking at these pages: The text in that page is under the terms of the GNU Free Documentation License. -* JISX213A.map.gz +* JISX213A.map Created manually based on the description of the section 33 in "JIS X 0213:2004 Amendment 1". It lists 10 characters that are newly added to "JIS X 0213:2004". -* MULE-*.map.gz +* MULE-*.map Created by using ../mule-charsets.el in Emacs 22 as this: % emacs-22 -batch -l ../mule-charsets.el diff --git a/admin/charsets/mapfiles/stdenc.txt b/admin/charsets/mapfiles/stdenc.txt index d4b9d7c9343..e39486a3195 100644 --- a/admin/charsets/mapfiles/stdenc.txt +++ b/admin/charsets/mapfiles/stdenc.txt @@ -1,10 +1,10 @@ # # Name: Adobe Standard Encoding to Unicode # Unicode version: 2.0 -# Table version: 0.2 -# Date: 30 March 1999 +# Table version: 1.0 +# Date: 2011 July 12 # -# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# Copyright (c) 1991-2011 Unicode, Inc. All Rights reserved. # # This file is provided as-is by Unicode, Inc. (The Unicode Consortium). No # claims are made as to fitness for any particular purpose. No warranties of @@ -13,12 +13,12 @@ # magnetic media by Unicode, Inc., the sole remedy for any claim will be # exchange of defective media within 90 days of receipt. # -# Recipient is granted the right to make copies in any form for internal -# distribution and to freely use the information supplied in the creation of -# products supporting Unicode. Unicode, Inc. specifically excludes the right -# to re-distribute this file directly to third parties or other organizations -# whether for profit or not. -# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# # Format: 4 tab-delimited fields: # # (1) The Unicode value (in hexadecimal) @@ -36,8 +36,17 @@ # Standard Encoding characters, such as "space", are mapped to 2 Unicode # values. Refer to the above document for more details. # +# 2011 July 12: The above link is no longer valid. For comparable, +# more current information, see the document, "Glyph", at: +# +# # Revision History: # +# [v1.0, 2011 July 12] +# Updated terms of use to current wording. +# Updated contact information and document link. +# No changes to the mapping data. +# # [v0.2, 30 March 1999] # Different algorithm to produce Unicode values (see notes above) results in # some character codes being mapped to 2 Unicode values. Updated Unicode @@ -45,7 +54,8 @@ # # [v0.1, 5 May 1995] First release. # -# Contact with any questions or comments. +# Use the Unicode reporting form +# for any questions or comments or to report errors in the data. # 0020 20 # SPACE # space 00A0 20 # NO-BREAK SPACE # space diff --git a/admin/charsets/mapfiles/symbol.txt b/admin/charsets/mapfiles/symbol.txt index a545915a323..b98baf6cf0c 100644 --- a/admin/charsets/mapfiles/symbol.txt +++ b/admin/charsets/mapfiles/symbol.txt @@ -1,10 +1,10 @@ # # Name: Adobe Symbol Encoding to Unicode # Unicode version: 2.0 -# Table version: 0.2 -# Date: 30 March 1999 +# Table version: 1.0 +# Date: 2011 July 12 # -# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# Copyright (c) 1991-2011 Unicode, Inc. All Rights reserved. # # This file is provided as-is by Unicode, Inc. (The Unicode Consortium). No # claims are made as to fitness for any particular purpose. No warranties of @@ -13,11 +13,11 @@ # magnetic media by Unicode, Inc., the sole remedy for any claim will be # exchange of defective media within 90 days of receipt. # -# Recipient is granted the right to make copies in any form for internal -# distribution and to freely use the information supplied in the creation of -# products supporting Unicode. Unicode, Inc. specifically excludes the right -# to re-distribute this file directly to third parties or other organizations -# whether for profit or not. +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. # # Format: 4 tab-delimited fields: # @@ -37,8 +37,17 @@ # Corporate Use Subarea; these are indicated by "(CUS)" in field 4. Refer to # the above document for more details. # +# 2011 July 12: The above link is no longer valid. For comparable, +# more current information, see the document, "Glyph", at: +# +# # Revision History: # +# [v1.0, 2011 July 12] +# Updated terms of use to current wording. +# Updated contact information and document link. +# No changes to the mapping data. +# # [v0.2, 30 March 1999] # Different algorithm to produce Unicode values (see notes above) results in # some character codes being mapped to 2 Unicode values; use of Corporate @@ -48,7 +57,8 @@ # # [v0.1, 5 May 1995] First release. # -# Contact with any questions or comments. +# Use the Unicode reporting form +# for any questions or comments or to report errors in the data. # 0020 20 # SPACE # space 00A0 20 # NO-BREAK SPACE # space diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el index 4a48d994b1b..4ccf4bfb5be 100644 --- a/admin/charsets/mule-charsets.el +++ b/admin/charsets/mule-charsets.el @@ -19,20 +19,32 @@ ;; along with GNU Emacs. If not, see . -(if (not (or (and (= emacs-major-version 21) (= emacs-minor-version 4)) - (= emacs-major-version 22))) - (error "Use Emacs of version 21.4 or any of version 22")) +;; For the record: the old, pre-v23 code was this: +;; (if (not (or (and (= emacs-major-version 21) (= emacs-minor-version 4)) +;; (= emacs-major-version 22))) +;; (error "Use Emacs of version 21.4 or any of version 22")) +;; +;; (defun func (start end) +;; (while (<= start end) +;; (let ((split (split-char start)) +;; (unicode (encode-char start 'ucs))) +;; (if unicode +;; (if (nth 2 split) +;; (insert (format "0x%02X%02X 0x%04X\n" +;; (nth 1 split) (nth 2 split) unicode)) +;; (insert (format "0x%02X 0x%04X\n" (nth 1 split) unicode))))) +;; (setq start (1+ start)))) -(defun func (start end) - (while (<= start end) - (let ((split (split-char start)) - (unicode (encode-char start 'ucs))) - (if unicode - (if (nth 2 split) - (insert (format "0x%02X%02X 0x%04X\n" - (nth 1 split) (nth 2 split) unicode)) - (insert (format "0x%02X 0x%04X\n" (nth 1 split) unicode))))) - (setq start (1+ start)))) +(defun func (range charset) + (let ((start (car range)) + (end (cdr range))) + (while (and (<= start end) (<= start #x10ffff)) + (let ((ch (encode-char start charset))) + (if ch + (if (> ch 256) + (insert (format "0x%04X 0x%04X\n" ch start)) + (insert (format "0x%02X 0x%04X\n" ch start))))) + (setq start (1+ start))))) (defconst charset-alist '(("MULE-ethiopic.map" . ethiopic) @@ -51,6 +63,8 @@ (dolist (elt charset-alist) (with-temp-buffer (insert header) - (map-charset-chars 'func (cdr elt)) - (write-file (car elt)))) + (map-charset-chars 'func (cdr elt) (cdr elt)) + (sort-lines nil (point-min) (point-max)) + (let ((coding-system-for-write 'unix)) + (write-file (car elt))))) diff --git a/admin/check-doc-strings b/admin/check-doc-strings index c69ff47ebfb..a0b5acb623f 100755 --- a/admin/check-doc-strings +++ b/admin/check-doc-strings @@ -1,11 +1,12 @@ : #-*- Perl -*- -eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge +eval 'exec perl -S $0 ${1+"$@"}' # Portability kludge if 0; # Author: Martin Buchholz # This program is in the public domain. use strict; +use warnings; use POSIX; (my $myName = $0) =~ s@.*/@@; my $usage=" diff --git a/admin/cus-test.el b/admin/cus-test.el index c93a14297f8..b60eac28d2a 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -1,6 +1,6 @@ ;;; cus-test.el --- tests for custom types and load problems -;; Copyright (C) 1998, 2000, 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2002-2014 Free Software Foundation, Inc. ;; Author: Markus Rost ;; Maintainer: Markus Rost @@ -30,11 +30,11 @@ ;; ;; The basic tests can be run in batch mode. Invoke them with ;; -;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts +;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts [all] ;; ;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps ;; -;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs +;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs [all] ;; ;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads ;; @@ -87,43 +87,6 @@ ;; The command `cus-test-noloads' returns a list of variables which ;; are somewhere declared as custom options, but not loaded by ;; `custom-load-symbol'. -;; -;; Some results from October 2002: -;; -;; 4523 options tested -;; The following variables might have problems: -;; ps-mule-font-info-database-default -;; grep-tree-command -;; grep-find-command -;; -;; 288 features required -;; 10 files loaded -;; The following load problems appeared: -;; (killing x-win (file-error Cannot open load file x-win)) -;; Symbol faces has loaddefs as custom dependency -;; (reftex-index-support reftex-vars (void-function reftex-set-dirty)) -;; (eshell-script em-script (void-variable eshell-directory-name)) -;; (pcomplete em-cmpl (void-function eshell-under-windows-p)) -;; (eshell-ext esh-ext (void-function eshell-under-windows-p)) -;; ... -;; -;; 422 libraries had no load errors -;; The following load problems appeared: -;; (eudc-export error 255) -;; (ada-xref error 255) -;; (ada-stmt error 255) -;; -;; The following options were not loaded by custom-load-symbol: -;; edt-bottom-scroll-margin -;; edt-keep-current-page-delimiter -;; edt-top-scroll-margin -;; edt-use-EDT-control-key-bindings -;; edt-word-entities -;; grep-find-use-xargs -;; master-mode-hook -;; outline-level -;; outline-minor-mode-hook -;; refill-mode-hook ;;; Code: @@ -136,24 +99,23 @@ (defvar cus-test-skip-list nil "List of variables to disregard by `cus-test-apropos'.") -(defvar cus-test-libs-noloads nil - "List of libraries not to load by `cus-test-load-libs'.") - -;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which -;; are not part of GNU Emacs: (locate-library "bbdb") => nil -;; We avoid the resulting errors from loading eudc-export.el: -(provide 'bbdb) -(provide 'bbdb-com) +(defvar cus-test-libs-noloads + ;; Loading dunnet in batch mode leads to a Dead end. + ;; blessmail writes a file. + ;; characters cannot be loaded twice ("Category `a' is already defined"). + '("play/dunnet.el" "emulation/edt-mapper.el" + "loadup.el" "mail/blessmail.el" "international/characters.el" + "cedet/ede/loaddefs.el" "cedet/semantic/loaddefs.el" + "net/tramp-loaddefs.el") + "List of files not to load by `cus-test-load-libs'. +Names should be as they appear in loaddefs.el.") ;; This avoids a hang of `cus-test-apropos' in 21.2. ;; (add-to-list 'cus-test-skip-list 'sh-alias-alist) -;; Loading dunnet in batch mode leads to a Dead end. -(let (noninteractive) (load "dunnet")) -(add-to-list 'cus-test-libs-noloads "dunnet") - -;; Never Viperize. -(setq viper-mode nil) +(or noninteractive + ;; Never Viperize. + (setq viper-mode nil)) ;; Don't create a file `save-place-file'. (eval-after-load "saveplace" @@ -225,6 +187,9 @@ The detected problematic options are stored in `cus-test-errors'." (message "Cus Test running...%s %s" (length cus-test-tested-variables) symbol) (condition-case alpha + ;; FIXME This defaults to 'sexp if no type was specified. + ;; Always report such instances as a type mismatch. + ;; Currently abusing cusver-scan to do that. (let* ((type (custom-variable-type symbol)) (conv (widget-convert type)) (get (or (get symbol 'custom-get) 'default-value)) @@ -240,6 +205,8 @@ The detected problematic options are stored in `cus-test-errors'." ;; Check the values (mapc (lambda (value) + ;; TODO for booleans, check for values that can be + ;; evaluated and are not t or nil. Usually a bug. (unless (widget-apply conv :match value) (setq mismatch 'mismatch))) values) @@ -270,17 +237,38 @@ The detected problematic options are stored in `cus-test-errors'." (length cus-test-tested-variables)) (cus-test-errors-display)) -(defun cus-test-get-options (regexp) - "Return a list of custom options matching REGEXP." - (let (found) +(defun cus-test-cus-load-groups (&optional cus-load) + "Return a list of current custom groups. +If CUS-LOAD is non-nil, include groups from cus-load.el." + (append (mapcar 'cdr custom-current-group-alist) + (if cus-load + (with-temp-buffer + (insert-file-contents (locate-library "cus-load.el")) + (search-forward "(put '") + (beginning-of-line) + (let (res) + (while (and (looking-at "^(put '\\(\\S-+\\)") + (zerop (forward-line 1))) + (push (intern (match-string 1)) res)) + res))))) + +(defun cus-test-get-options (regexp &optional group) + "Return a list of custom options matching REGEXP. +If GROUP is non-nil, return groups rather than options. +If GROUP is `cus-load', include groups listed in cus-loads as well as +currently defined groups." + (let ((groups (if group (cus-test-cus-load-groups (eq group 'cus-load)))) + found) (mapatoms (lambda (symbol) (and - (or - ;; (user-variable-p symbol) - (get symbol 'standard-value) - ;; (get symbol 'saved-value) - (get symbol 'custom-type)) + (if group + (memq symbol groups) + (or + ;; (user-variable-p symbol) + (get symbol 'standard-value) + ;; (get symbol 'saved-value) + (get symbol 'custom-type))) (string-match regexp (symbol-name symbol)) (not (member symbol cus-test-skip-list)) (push symbol found)))) @@ -302,49 +290,71 @@ The detected problematic options are stored in `cus-test-errors'." (defun cus-test-load-custom-loads () "Call `custom-load-symbol' on all atoms." (interactive) + (if noninteractive (let (noninteractive) (require 'dunnet))) (mapatoms 'custom-load-symbol) (run-hooks 'cus-test-after-load-libs-hook)) -(defun cus-test-load-libs () +(defmacro cus-test-load-1 (&rest body) + `(progn + (setq cus-test-libs-errors nil + cus-test-libs-loaded nil) + ,@body + (message "%s libraries loaded successfully" + (length cus-test-libs-loaded)) + (if (not cus-test-libs-errors) + (message "No load problems encountered") + (message "The following load problems appeared:") + (cus-test-message cus-test-libs-errors)) + (run-hooks 'cus-test-after-load-libs-hook))) + +;; This is just cus-test-libs, but loading in the current Emacs process. +(defun cus-test-load-libs (&optional more) "Load the libraries with autoloads. -Don't load libraries in `cus-test-libs-noloads'." +Don't load libraries in `cus-test-libs-noloads'. +If optional argument MORE is \"defcustom\", load all files with defcustoms. +If it is \"all\", load all Lisp files." (interactive) - (setq cus-test-libs-errors nil) - (setq cus-test-libs-loaded nil) - (mapc - (lambda (file) - (condition-case alpha - (unless (member file cus-test-libs-noloads) - (load file) - (push file cus-test-libs-loaded)) - (error - (push (cons file alpha) cus-test-libs-errors) - (message "Error for %s: %s" file alpha)))) - (cus-test-get-autoload-deps)) - (message "%s libraries loaded successfully" - (length cus-test-libs-loaded)) - (if (not cus-test-libs-errors) - (message "No load problems encountered") - (message "The following load problems appeared:") - (cus-test-message cus-test-libs-errors)) - (run-hooks 'cus-test-after-load-libs-hook)) + (cus-test-load-1 + (let ((lispdir (file-name-directory (locate-library "loaddefs")))) + (mapc + (lambda (file) + (condition-case alpha + (unless (member file cus-test-libs-noloads) + (load (file-name-sans-extension (expand-file-name file lispdir))) + (push file cus-test-libs-loaded)) + (error + (push (cons file alpha) cus-test-libs-errors) + (message "Error for %s: %s" file alpha)))) + (if more + (cus-test-get-lisp-files (equal more "all")) + (cus-test-get-autoload-deps)))))) (defun cus-test-get-autoload-deps () - "Return the list of libraries with autoloads." + "Return the list of files with autoloads." (with-temp-buffer (insert-file-contents (locate-library "loaddefs")) - ;; This is from `customize-option'. - (let (deps file) - (while - (search-forward "\n;;; Generated autoloads from " nil t) - (goto-char (match-end 0)) - (setq file (buffer-substring (point) - (progn (end-of-line) (point)))) - (setq file (file-name-nondirectory file)) - (string-match "\\.el\\'" file) - (setq file (substring file 0 (match-beginning 0))) - (setq deps (nconc deps (list file)))) - deps))) + (let (files) + (while (search-forward "\n;;; Generated autoloads from " nil t) + (push (buffer-substring (match-end 0) (line-end-position)) files)) + files))) + +(defun cus-test-get-lisp-files (&optional all) + "Return list of all Lisp files with defcustoms. +Optional argument ALL non-nil means list all (non-obsolete) Lisp files." + (let ((default-directory (expand-file-name "lisp/" source-directory)) + (msg "Finding files...")) + (message "%s" msg) + (prog1 + ;; Hack to remove leading "./". + (mapcar (lambda (e) (substring e 2)) + (apply 'process-lines find-program + "-name" "obsolete" "-prune" "-o" + "-name" "[^.]*.el" ; ignore .dir-locals.el + (if all + '("-print") + (list "-exec" grep-program + "-l" "^[ \t]*(defcustom" "{}" "+")))) + (message "%sdone" msg)))) (defun cus-test-message (list) "Print the members of LIST line by line." @@ -353,16 +363,21 @@ Don't load libraries in `cus-test-libs-noloads'." ;;; The routines for batch mode: -(defun cus-test-opts () +(defun cus-test-opts (&optional all) "Test custom options. This function is suitable for batch mode. E.g., invoke src/emacs -batch -l admin/cus-test.el -f cus-test-opts -in the Emacs source directory." +in the Emacs source directory. +Normally only tests options belonging to files in loaddefs.el. +If optional argument ALL is non-nil, test all files with defcustoms." (interactive) + (and noninteractive + command-line-args-left + (setq all (pop command-line-args-left))) (message "Running %s" 'cus-test-load-libs) - (cus-test-load-libs) + (cus-test-load-libs (if all "defcustom")) (message "Running %s" 'cus-test-load-custom-loads) (cus-test-load-custom-loads) (message "Running %s" 'cus-test-apropos) @@ -392,7 +407,8 @@ in the Emacs source directory." ((symbolp load) ;; (condition-case nil (require load) (error nil)) (condition-case alpha - (unless (featurep load) + (unless (or (featurep load) + (and noninteractive (eq load 'dunnet))) (require load) (push (list symbol load) cus-test-deps-required)) (error @@ -444,47 +460,54 @@ in the Emacs source directory." (cus-test-message cus-test-deps-errors)) (run-hooks 'cus-test-after-load-libs-hook)) -(defun cus-test-libs () +(defun cus-test-libs (&optional more) "Load the libraries with autoloads in separate processes. This function is useful to detect load problems of libraries. It is suitable for batch mode. E.g., invoke - src/emacs -batch -l admin/cus-test.el -f cus-test-libs + ./src/emacs -batch -l admin/cus-test.el -f cus-test-libs -in the Emacs source directory." +in the Emacs source directory. + +If optional argument MORE is \"defcustom\", load all files with defcustoms. +If it is \"all\", load all Lisp files." (interactive) - (with-temp-buffer - (setq cus-test-libs-errors nil) - (setq cus-test-libs-loaded nil) - (cd source-directory) - (if (not (file-executable-p "src/emacs")) - (error "No Emacs executable in %ssrc" default-directory)) - (mapc - (lambda (file) - (condition-case alpha - (let (fn cmd status) - (setq fn (locate-library file)) - (if (not fn) - (error "Library %s not found" file)) - (setq cmd (concat "src/emacs -batch -l " fn)) - (setq status (call-process shell-file-name nil nil nil - shell-command-switch cmd)) - (if (equal status 0) - (message "%s" file) - (error "%s" status)) - (push file cus-test-libs-loaded)) - (error - (push (cons file alpha) cus-test-libs-errors) - (message "Error for %s: %s" file alpha)))) - (cus-test-get-autoload-deps)) - (message "Default Directory: %s" default-directory) - (message "%s libraries had no load errors" - (length cus-test-libs-loaded)) - (if (not cus-test-libs-errors) - (message "No load problems encountered") - (message "The following load problems appeared:") - (cus-test-message cus-test-libs-errors)) - (run-hooks 'cus-test-after-load-libs-hook))) + (and noninteractive + command-line-args-left + (setq more (pop command-line-args-left))) + (cus-test-load-1 + (let* ((default-directory source-directory) + (emacs (expand-file-name "src/emacs")) + skipped) + (or (file-executable-p emacs) + (error "No such executable `%s'" emacs)) + (mapc + (lambda (file) + (if (member file cus-test-libs-noloads) + (push file skipped) + (condition-case alpha + (let* ((fn (expand-file-name file "lisp/")) + (elc (concat fn "c")) + status) + (if (file-readable-p elc) ; load compiled if present (faster) + (setq fn elc) + (or (file-readable-p fn) + (error "Library %s not found" file))) + (if (equal 0 (setq status (call-process emacs nil nil nil + "-batch" "-l" fn))) + (message "%s" file) + (error "%s" status)) + (push file cus-test-libs-loaded)) + (error + (push (cons file alpha) cus-test-libs-errors) + (message "Error for %s: %s" file alpha))))) + (if more + (cus-test-get-lisp-files (equal more "all")) + (cus-test-get-autoload-deps))) + (message "Default directory: %s" default-directory) + (when skipped + (message "The following libraries were skipped:") + (cus-test-message skipped))))) (defun cus-test-noloads () "Find custom options not loaded by `custom-load-symbol'. @@ -495,17 +518,17 @@ It is suitable for batch mode. E.g., invoke in the Emacs source directory." (interactive) - (let (cus-loaded) + (let ((groups-loaded (cus-test-get-options "" 'cus-load)) + cus-loaded groups-not-loaded) (message "Running %s" 'cus-test-load-custom-loads) (cus-test-load-custom-loads) - (setq cus-loaded - (cus-test-get-options "")) + (setq cus-loaded (cus-test-get-options "")) (message "Running %s" 'cus-test-load-libs) - (cus-test-load-libs) - (setq cus-test-vars-not-cus-loaded - (cus-test-get-options "")) + (cus-test-load-libs "all") + (setq cus-test-vars-not-cus-loaded (cus-test-get-options "") + groups-not-loaded (cus-test-get-options "" t)) (dolist (o cus-loaded) (setq cus-test-vars-not-cus-loaded @@ -515,12 +538,15 @@ in the Emacs source directory." (message "No options not loaded by custom-load-symbol found") (message "The following options were not loaded by custom-load-symbol:") (cus-test-message - (sort cus-test-vars-not-cus-loaded 'string<))))) + (sort cus-test-vars-not-cus-loaded 'string<))) -;; And last but not least a quiz: -;; -;; Evaluation of the form (customize-option 'debug-on-error) yields a -;; *Customize* buffer with a mismatch mess. Why? + (dolist (o groups-loaded) + (setq groups-not-loaded (delete o groups-not-loaded))) + + (if (not groups-not-loaded) + (message "No groups not in cus-load.el found") + (message "The following groups are not in cus-load.el:") + (cus-test-message (sort groups-not-loaded 'string<))))) (provide 'cus-test) diff --git a/admin/diff-tar-files b/admin/diff-tar-files index af892d6ce41..9bdc91ff5fd 100755 --- a/admin/diff-tar-files +++ b/admin/diff-tar-files @@ -1,6 +1,6 @@ #! /bin/sh -# Copyright (C) 2001-2013 Free Software Foundation, Inc. +# Copyright (C) 2001-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in new file mode 100644 index 00000000000..827240a8d4e --- /dev/null +++ b/admin/grammars/Makefile.in @@ -0,0 +1,113 @@ +### @configure_input@ + +## Copyright (C) 2013-2014 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 . + +### Commentary: + +## This directory contains grammar files in Bison and Wisent, +## used to generate the parser data in the lisp/cedet directory. + +SHELL = @SHELL@ + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +top_builddir = @top_builddir@ + +EMACS = ${top_builddir}/src/emacs +emacs = EMACSLOADPATH= "${EMACS}" -batch --no-site-file --no-site-lisp + +make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser +make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser + +cedetdir = ${top_srcdir}/lisp/cedet +bovinedir = ${cedetdir}/semantic/bovine +wisentdir = ${cedetdir}/semantic/wisent + +BOVINE = \ + ${bovinedir}/c-by.el \ + ${bovinedir}/make-by.el \ + ${bovinedir}/scm-by.el + +## FIXME Should include this one too: +## ${cedetdir}/semantic/grammar-wy.el +## but semantic/grammar.el (which is what we use to generate grammar-wy.el) +## requires it! +WISENT = \ + ${wisentdir}/javat-wy.el \ + ${wisentdir}/js-wy.el \ + ${wisentdir}/python-wy.el \ + ${cedetdir}/srecode/srt-wy.el + +ALL = ${BOVINE} ${WISENT} + +.PHONY: all bovine wisent + +all: ${ALL} + +bovine: ${BOVINE} + +wisent: ${WISENT} + + +${bovinedir}/c-by.el: ${srcdir}/c.by + [ ! -f "$@" ] || chmod +w "$@" + ${make_bovine} -o "$@" ${srcdir}/c.by + +${bovinedir}/make-by.el: ${srcdir}/make.by + [ ! -f "$@" ] || chmod +w "$@" + ${make_bovine} -o "$@" ${srcdir}/make.by + +${bovinedir}/scm-by.el: ${srcdir}/scheme.by + [ ! -f "$@" ] || chmod +w "$@" + ${make_bovine} -o "$@" ${srcdir}/scheme.by + + +${cedetdir}/semantic/grammar-wy.el: ${srcdir}/grammar.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" ${srcdir}/grammar.wy + +${wisentdir}/javat-wy.el: ${srcdir}/java-tags.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" ${srcdir}/java-tags.wy + +${wisentdir}/js-wy.el: ${srcdir}/js.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" ${srcdir}/js.wy + +${wisentdir}/python-wy.el: ${srcdir}/python.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" ${srcdir}/python.wy + +${cedetdir}/srecode/srt-wy.el: ${srcdir}/srecode-template.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" ${srcdir}/srecode-template.wy + + +.PHONY: distclean bootstrap-clean maintainer-clean extraclean + +distclean: + rm -f Makefile + +bootstrap-clean maintainer-clean: distclean + +## We do not normally delete the generated files, even in bootstrap. +## Creating them does not take long, so we could easily change this. +extraclean: + rm -f ${ALL} + +# Makefile.in ends here diff --git a/admin/grammars/README b/admin/grammars/README deleted file mode 100644 index e38260952a5..00000000000 --- a/admin/grammars/README +++ /dev/null @@ -1,11 +0,0 @@ -This directory contains grammar files in Bison and Wisent, used to -generate the parser data in the lisp/semantic/bovine/ and -lisp/semantic/wisent/ directories. You can run the parser generators -with - -emacs -batch -Q -l semantic/bovine/grammar -f bovine-make-parsers -emacs -batch -Q -l semantic/wisent/grammar -f wisent-make-parsers - -Currently, the parser files in lisp/ are not generated directly from -these grammar files when making Emacs. This state of affairs, and the -contents of this directory, will change in a future version of Emacs. diff --git a/admin/grammars/c.by b/admin/grammars/c.by index 5d2f407e8e3..0fd8a33f25a 100644 --- a/admin/grammars/c.by +++ b/admin/grammars/c.by @@ -1,5 +1,5 @@ ;;; c.by -- LL grammar for C/C++ language specification -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam ;; David Ponce @@ -41,9 +41,13 @@ %provide semantic/bovine/c-by %{ -(declare-function semantic-c-reconstitute-token "semantic/bovine/c") -(declare-function semantic-c-reconstitute-template "semantic/bovine/c") -(declare-function semantic-expand-c-tag "semantic/bovine/c") +(declare-function semantic-c-reconstitute-token "semantic/bovine/c" + (tokenpart declmods typedecl)) +(declare-function semantic-c-reconstitute-template "semantic/bovine/c" + (tag specifier)) +(declare-function semantic-expand-c-tag "semantic/bovine/c" (tag)) +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) } %languagemode c-mode c++-mode @@ -897,8 +901,8 @@ varname ;; I should store more in this def, but leave it simple for now. ;; Klaus Berndl: const and volatile can be written after the type! variablearg - : declmods typeformbase cv-declmods opt-ref variablearg-opt-name - ( VARIABLE-TAG (list $5) $2 nil + : declmods typeformbase cv-declmods opt-ref variablearg-opt-name opt-assign + ( VARIABLE-TAG (list (append $5 ,$6)) $2 nil :constant-flag (if (member "const" (append $1 $3)) t nil) :typemodifiers (delete "const" (append $1 $3)) :reference (car ,$4) @@ -908,6 +912,8 @@ variablearg variablearg-opt-name : varname ( ,$1 ) + | semantic-list arg-list + ( (car ( EXPAND $1 function-pointer )) $2) ;; Klaus Berndl: This allows variableargs without a arg-name being ;; parsed correct even if there several pointers (*) | opt-stars @@ -922,9 +928,9 @@ varname-opt-initializer varnamelist : opt-ref varname varname-opt-initializer COMA varnamelist - ( ,(cons $2 $5) ) + ( ,(cons (append $2 $3) $5) ) | opt-ref varname varname-opt-initializer - ( $2 ) + ( (append $2 $3) ) ; ;; Klaus Berndl: Is necessary to parse stuff like @@ -1107,8 +1113,8 @@ functionname ; function-pointer - : LPAREN STAR symbol RPAREN - ( (concat "*" $3) ) + : LPAREN STAR opt-symbol RPAREN + ( (concat "*" ,(car $3)) ) | LPAREN symbol RPAREN ( $2 ) ; @@ -1148,16 +1154,26 @@ type-cast-list : open-paren typeformbase close-paren ; -opt-stuff-after-symbol - : PAREN_BLCK - | BRACK_BLCK +opt-brackets-after-symbol + : brackets-after-symbol | ;; EMPTY ; +brackets-after-symbol + : PAREN_BLCK + | BRACK_BLCK + ; + multi-stage-dereference - : namespace-symbol opt-stuff-after-symbol PERIOD multi-stage-dereference ;; method call - | namespace-symbol opt-stuff-after-symbol MINUS GREATER multi-stage-dereference ;;method call - | namespace-symbol opt-stuff-after-symbol + : namespace-symbol opt-brackets-after-symbol + PERIOD multi-stage-dereference ;; method call + | namespace-symbol opt-brackets-after-symbol + MINUS GREATER multi-stage-dereference ;;method call + | namespace-symbol opt-brackets-after-symbol + PERIOD namespace-symbol opt-brackets-after-symbol + | namespace-symbol opt-brackets-after-symbol + MINUS GREATER namespace-symbol opt-brackets-after-symbol + | namespace-symbol brackets-after-symbol ; string-seq @@ -1183,6 +1199,7 @@ expr-binop | AMPERSAND | OR OR | OR + | MOD ;; There are more. ; @@ -1200,8 +1217,7 @@ unaryexpression | multi-stage-dereference | NEW multi-stage-dereference | NEW builtintype-types semantic-list - ;; Klaus Berndl: symbol -> namespace-symbol! - | namespace-symbol + | symbol ;; Klaus Berndl: C/C++ allows sequences of strings which are ;; concatenated by the precompiler to one string | string-seq diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy index c5e5413e64c..4605e3c4f70 100644 --- a/admin/grammars/grammar.wy +++ b/admin/grammars/grammar.wy @@ -1,6 +1,6 @@ ;;; semantic-grammar.wy -- LALR grammar of Semantic input grammars ;; -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Maintainer: David Ponce @@ -94,7 +94,7 @@ %token LBRACE "{" %token RBRACE "}" -;; Punctuations +;; Punctuation %type %token COLON ":" %token SEMI ";" diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy index 408d0f0da29..9ff27f3a2be 100644 --- a/admin/grammars/java-tags.wy +++ b/admin/grammars/java-tags.wy @@ -1,6 +1,6 @@ ;;; java-tags.wy -- Semantic LALR grammar for Java -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Maintainer: David Ponce @@ -25,6 +25,11 @@ %package wisent-java-tags-wy %provide semantic/wisent/javat-wy +%{ +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) +} + %languagemode java-mode ;; The default start symbol @@ -154,7 +159,7 @@ %keyword CHAR "char" %put CHAR summary -"Integral primitive type ('\u0000' to '\uffff') (0 to 65535)" +"Integral primitive type (0 to 65535)" %keyword CLASS "class" %put CLASS summary @@ -312,7 +317,7 @@ %keyword WHILE "while" %put WHILE summary "while () | do while ();" - + ;; -------------------------- ;; Official javadoc line tags ;; -------------------------- @@ -340,27 +345,27 @@ %keyword _AUTHOR "@author" %put _AUTHOR javadoc (seq 1 usage (type)) %keyword _VERSION "@version" -%put _VERSION javadoc (seq 2 usage (type)) +%put _VERSION javadoc (seq 2 usage (type)) %keyword _PARAM "@param" -%put _PARAM javadoc (seq 3 usage (function) with-name t) +%put _PARAM javadoc (seq 3 usage (function) with-name t) %keyword _RETURN "@return" -%put _RETURN javadoc (seq 4 usage (function)) +%put _RETURN javadoc (seq 4 usage (function)) %keyword _EXCEPTION "@exception" -%put _EXCEPTION javadoc (seq 5 usage (function) with-name t) +%put _EXCEPTION javadoc (seq 5 usage (function) with-name t) %keyword _THROWS "@throws" -%put _THROWS javadoc (seq 6 usage (function) with-name t) +%put _THROWS javadoc (seq 6 usage (function) with-name t) %keyword _SEE "@see" -%put _SEE javadoc (seq 7 usage (type function variable) opt t with-ref t) +%put _SEE javadoc (seq 7 usage (type function variable) opt t with-ref t) %keyword _SINCE "@since" -%put _SINCE javadoc (seq 8 usage (type function variable) opt t) +%put _SINCE javadoc (seq 8 usage (type function variable) opt t) %keyword _SERIAL "@serial" -%put _SERIAL javadoc (seq 9 usage (variable) opt t) +%put _SERIAL javadoc (seq 9 usage (variable) opt t) %keyword _SERIALDATA "@serialData" -%put _SERIALDATA javadoc (seq 10 usage (function) opt t) +%put _SERIALDATA javadoc (seq 10 usage (function) opt t) %keyword _SERIALFIELD "@serialField" -%put _SERIALFIELD javadoc (seq 11 usage (variable) opt t) +%put _SERIALFIELD javadoc (seq 11 usage (variable) opt t) %keyword _DEPRECATED "@deprecated" -%put _DEPRECATED javadoc (seq 12 usage (type function variable) opt t) +%put _DEPRECATED javadoc (seq 12 usage (type function variable) opt t) %% @@ -387,7 +392,7 @@ package_declaration ; ;;; Include file token -;; ("FILE" include SYSTEM "DOCSTRING") +;; ("FILE" include SYSTEM "DOCSTRING") import_declaration : IMPORT qualified_name SEMICOLON (INCLUDE-TAG $2 nil) @@ -476,7 +481,7 @@ static_initializer ; ;;; Function token -;; ("NAME" function "TYPE" ( ARG-LIST ) EXTRA-SPEC "DOCSTRING") +;; ("NAME" function "TYPE" ( ARG-LIST ) EXTRA-SPEC "DOCSTRING") constructor_declaration : modifiers_opt constructor_declarator throwsc_opt constructor_body (FUNCTION-TAG (car $2) nil (cdr $2) @@ -491,11 +496,11 @@ constructor_declarator ; constructor_body - : block + : block ; ;;; Function token -;; ("NAME" function "TYPE" ( ARG-LIST ) EXTRA-SPEC "DOCSTRING") +;; ("NAME" function "TYPE" ( ARG-LIST ) EXTRA-SPEC "DOCSTRING") method_declaration : modifiers_opt VOID method_declarator throwsc_opt method_body (FUNCTION-TAG (car $3) $2 (cdr $3) :typemodifiers $1 :throws $4) diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy index 3b602296552..91dbff2330d 100644 --- a/admin/grammars/js.wy +++ b/admin/grammars/js.wy @@ -1,6 +1,6 @@ ;;; javascript-jv.wy -- LALR grammar for Javascript -;; Copyright (C) 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 2005-2014 Free Software Foundation, Inc. ;; Copyright (C) 1998-2011 Ecma International. ;; Author: Joakim Verona @@ -59,7 +59,13 @@ %package wisent-javascript-jv-wy %provide semantic/wisent/js-wy -;; JAVE I prefere ecmascript-mode + +%{ +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) +} + +;; JAVE I preferred ecmascript-mode. %languagemode ecmascript-mode javascript-mode ;; The default goal @@ -270,8 +276,8 @@ Statement : Block | BreakStatement | ReturnStatement | WithStatement - ; - + ; + FunctionDeclaration : FUNCTION VARIABLE FormalParameterListBlock Block (FUNCTION-TAG $2 nil $3) ; @@ -347,7 +353,7 @@ IterationExpression : WHILE OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statem ContinueStatement : CONTINUE SEMICOLON ; -;;JAVE break needs labels +;;JAVE break needs labels BreakStatement : BREAK SEMICOLON ;; | BREAK identifier SEMICOLON ; diff --git a/admin/grammars/make.by b/admin/grammars/make.by index dcb3bb2f7d7..7fc39518faf 100644 --- a/admin/grammars/make.by +++ b/admin/grammars/make.by @@ -1,6 +1,6 @@ ;;; make.by -- BY notation for Makefiles. -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam ;; David Ponce diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy index 02fb7390b01..330264de459 100644 --- a/admin/grammars/python.wy +++ b/admin/grammars/python.wy @@ -1,6 +1,6 @@ ;;; python.wy -- LALR grammar for Python -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, ;; 2009, 2010 Python Software Foundation; All Rights Reserved @@ -91,8 +91,12 @@ %provide semantic/wisent/python-wy %{ -(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python") -(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python") +(declare-function wisent-python-reconstitute-function-tag + "semantic/wisent/python" (tag suite)) +(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python" + (tag)) +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) } %languagemode python-mode diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by index a433d776df5..cceec0914f6 100644 --- a/admin/grammars/scheme.by +++ b/admin/grammars/scheme.by @@ -1,6 +1,6 @@ ;;; scheme.by -- Scheme BNF language specification -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy index de9bf351ac6..d4dd2ad907a 100644 --- a/admin/grammars/srecode-template.wy +++ b/admin/grammars/srecode-template.wy @@ -1,6 +1,6 @@ ;;; srecode-template.wy --- Semantic Recoder Template parser -;; Copyright (C) 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 2005-2014 Free Software Foundation, Inc. ;; Author: Eric Ludlam ;; Keywords: syntax @@ -125,6 +125,10 @@ opt-read-fcn variable : SET symbol insertable-string-list newline (VARIABLE-TAG $2 nil $3) + | SET symbol number newline + ;; This so a common error w/ priority works. + ;; Note that "number" still has a string value in the lexer. + (VARIABLE-TAG $2 nil (list $3)) | SHOW symbol newline (VARIABLE-TAG $2 nil t) ; @@ -260,8 +264,8 @@ It ignores whitespace, newlines and comments." srecode-template-separator-block srecode-template-wy---keyword-analyzer srecode-template-property-analyzer - srecode-template-wy---regexp-analyzer srecode-template-wy---regexp-analyzer + srecode-template-wy---regexp-analyzer srecode-template-wy---sexp-analyzer srecode-template-wy---string-analyzer semantic-lex-default-action diff --git a/admin/make-emacs b/admin/make-emacs index 58295c9607a..17d1cdc239a 100755 --- a/admin/make-emacs +++ b/admin/make-emacs @@ -2,7 +2,7 @@ # Build Emacs with various options for profiling, debugging, # with and without warnings enabled etc. -# Copyright (C) 2001-2013 Free Software Foundation, Inc. +# Copyright (C) 2001-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -21,6 +21,8 @@ require 5; +use strict; +use warnings; use Getopt::Long; use File::Basename; use Cwd; diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 3825ac49278..50183f75561 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -1,5 +1,5 @@ -Instructions to create pretest or release tarballs. --- originally written by Gerd Moellmann, amended by Francesco Potort +Instructions to create pretest or release tarballs. -*- coding: utf-8 -*- +-- originally written by Gerd Moellmann, amended by Francesco Potortì with the initial help of Eli Zaretskii @@ -28,14 +28,10 @@ General steps (for each step, check for possible errors): M-: (require 'authors) RET M-x authors RET - There is almost guaranteed to be an "*Authors Errors*" buffer with - problems caused by certain bad ChangeLog entries. You can ignore - the very old ones (eg lisp/erc has a lot). If there are errors - related to new entries (especially entries that are new since the - last pretest), see if you can fix them. If there was a ChangeLog - typo, fix it. If a file was deleted or renamed, consider adding - an appropriate entry to authors-ignored-files, authors-valid-file-names, - or authors-renamed-files-alist. + If there is an "*Authors Errors*" buffer, address the issues. + If there was a ChangeLog typo, fix it. If a file was deleted or + renamed, consider adding an appropriate entry to authors-ignored-files, + authors-valid-file-names, or authors-renamed-files-alist. If necessary, repeat M-x authors after making those changes. Save the "*Authors*" buffer as etc/AUTHORS. @@ -50,9 +46,20 @@ General steps (for each step, check for possible errors): For a pretest, start at version .90. After .99, use .990 (so that it sorts). + The final pretest should be a release candidate. Set the version + number to that of the actual release. Pick a date about a week + from now when you intend to make the release. Use M-x add-release-logs + to add the ChangeLog entries for that date to the tar file (but + not yet to the repository). Name the tar file as + emacs-XX.Y-rc1.tar. If all goes well in the following week, you + can simply rename the file and use it for the actual release. + 5. autoreconf -i -I m4 --force make bootstrap + make -C etc/refcards + make -C etc/refcards clean + 6. Copy lisp/loaddefs.el to lisp/ldefs-boot.el. Commit etc/AUTHORS, lisp/ldefs-boot.el, and the files changed @@ -77,7 +84,8 @@ General steps (for each step, check for possible errors): compile-NEW.log and compare it against an old one. The easiest way to do that is to visit the old log in Emacs, change the version number of the old Emacs to __, do the same with the new log and do - M-x ediff. Especially check that Info files aren't built. + M-x ediff. Especially check that Info files aren't built, and that + no autotools (autoconf etc) run. 9. cd EMACS_ROOT_DIR && bzr tag TAG TAG is emacs-XX.Y.ZZ for a pretest, emacs-XX.Y for a release. @@ -135,6 +143,8 @@ General steps (for each step, check for possible errors): Download them and check the signatures. Check they build. 12. For a pretest, announce it on emacs-devel and info-gnu-emacs@gnu.org. + Probably should also include the platform-testers list: + https://lists.gnu.org/mailman/listinfo/platform-testers For a release, also announce it on info-gnu@gnu.org. (Probably bcc the info- addresses to make it less likely that people will followup on those lists.) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index b43f2bd9bb8..75808d30b60 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -4,7 +4,7 @@ # # admin/merge-gnulib -# Copyright 2012-2013 Free Software Foundation, Inc. +# Copyright 2012-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -26,22 +26,25 @@ GNULIB_URL=git://git.savannah.gnu.org/gnulib.git GNULIB_MODULES=' - alloca-opt c-ctype c-strcase - careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 + alloca-opt byteswap c-ctype c-strcase + careadlinkat close-stream count-one-bits count-trailing-zeros + crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat - fcntl-h fdopendir filemode fstatat getloadavg getopt-gnu gettime gettimeofday - ignore-value intprops largefile lstat - manywarnings memrchr mktime - pselect pthread_sigmask putenv readlink readlinkat + fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync + getloadavg getopt-gnu gettime gettimeofday + intprops largefile lstat + manywarnings memrchr mkostemp mktime + pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat - sys_time time timer-time timespec-add timespec-sub unsetenv utimens + sys_time time timer-time timespec-add timespec-sub + unsetenv update-copyright utimens warnings ' GNULIB_TOOL_FLAGS=' - --avoid=dup - --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat + --avoid=close --avoid=dup + --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise @@ -89,7 +92,8 @@ test -x "$gnulib_srcdir"/gnulib-tool || { } "$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES && -rm -- "$src"m4/fcntl-o.m4 "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 && +rm -- "$src"lib/gl_openssl.h "$src"m4/fcntl-o.m4 "$src"m4/gl-openssl.m4 \ + "$src"m4/gnulib-cache.m4"$src" m4/warn-on-use.m4 && cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc && cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux && autoreconf -i -I m4 -- ${src:+"$src"} diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index ee385f4dd75..7947b17973b 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -8,7 +8,8 @@ This is 95% of all you will ever need to know. ** How do I report a bug? Use M-x report-emacs-bug, or send mail to bug-gnu-emacs@gnu.org. -If you want to Cc someone, use an "X-Debbugs-CC" header instead. +If you want to Cc someone, use an "X-Debbugs-CC" header (or +pseudo-header, see below) instead. ** How do I comment on a bug? Reply to a mail on the bug-gnu-emacs list in the normal way. @@ -52,8 +53,8 @@ i) Your report will be assigned a number and generate an automatic reply. ii) Optionally, you can set some database parameters when you first report a bug (see "Setting bug parameters" below). -iii) If you want to CC: someone, use X-Debbugs-CC: (this is important; -see below). +iii) If you want to CC: someone, use X-Debbugs-CC: (note this only +applies to _new_ reports, not followups). Once your report is filed and assigned a number, it is sent out to the bug mailing list. In some cases, it may be appropriate to just file a @@ -92,18 +93,21 @@ but create duplicates and errors. (It is possible, but unlikely, that you might want to have a dialog with the owner address, outside of normal bug reporting.) -** When reporting a bug, to send a Cc to another address +** When reporting a new bug, to send a Cc to another address (e.g. bug-cc-mode@gnu.org), do NOT just use a Cc: header. Instead, use "X-Debbugs-CC:". This ensures the Cc address will get a mail with the bug report number in. If you do not do this, each reply -in the subsequent discussion will end up creating a new bug. -This is annoying. +in the subsequent discussion might end up creating a new bug. +This is annoying. (So annoying that a form of message-id tracking has +been implemented to hopefully stop this happening, but it is still +better to use X-Debbugs-CC.) -(So annoying that a form of message-id tracking has been implemented -to hopefully stop this happening, but it is still better to use X-Debbugs-CC.) +Like any X-Debbugs- header, this one can also be specified in the +pseudo-header (see below), if your mail client does not let you add +"X-" headers. If a new report contains X-Debbugs-CC in the input, this is -converted to a real Cc header in the output. (See Bug#1720). +converted to a real Cc header in the output. (See Bug#1780,5384) It is also merged into the Resent-CC header (see below). ** How does Debbugs send out mails? @@ -218,8 +222,8 @@ Package: emacs Version: 23.0.60 Severity: minor -This can also include tags. Some things (e.g. submitter) don't seem to -work here. +This can also include tags, or any X-Debbugs- setting. +Some things (e.g. submitter) don't seem to work here. Otherwise, send mail to the control server, control@debbugs.gnu.org. At the start of the message body, supply the desired commands, one per @@ -627,7 +631,9 @@ following headers: 1) The leading envelope From line. 2) Message-ID (get it from /var/log/mailman/vette). -3) X-Debbugs-Envelope-To: submit +3) X-Debbugs-Envelope-To: xxx +For a new report, xxx = submit; for a control message, xxx = control; +for a reply to bug#123, xxx = 123 Then pipe it to receive as above. diff --git a/admin/notes/bzr b/admin/notes/bzr index f35ff95f9d6..a3a125cd675 100644 --- a/admin/notes/bzr +++ b/admin/notes/bzr @@ -316,3 +316,85 @@ When finished, use bzr bisect reset or simply delete the entire branch if you created it just for this. + +* Commit emails + +** Old method: bzr-hookless-email +https://launchpad.net/bzr-hookless-email + +Runs hourly via cron. Must ask Savannah admins to enable/disable it +for each branch. Stores the last revision that it mailed as +last_revision_mailed in branch.conf on the server. Breaks with bzr 2.6: + +http://lists.gnu.org/archive/html/savannah-hackers-public/2013-05/msg00000.html + +Fix from https://bugs.launchpad.net/bzr-hookless-email/+bug/988195 +only partially works. Breaks again on every merge commit: + +https://lists.ubuntu.com/archives/bazaar/2013q2/075520.html +http://lists.gnu.org/archive/html/savannah-hackers-public/2013-05/msg00024.html + +You can force it to skip the merge commit by changing the value for +last_revision_mailed, eg: + +bzr config last_revision_mailed=xfq.free@gmail.com-20130603233720-u1aumaxvf3o0rlai -d bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/trunk/ + +** New method: bzr-email plugin +https://launchpad.net/bzr-email +http://lists.gnu.org/archive/html/savannah-hackers-public/2013-06/msg00007.html + +Runs on commit. Projects can enable it themselves by using `bzr +config' to set post_commit_to option for a branch. See `bzr help email' +(if you have the plugin installed) for other options. + +The From: address will be that of your Savannah account, rather than +your `bzr whoami' information. + +Note: if you have the bzr-email plugin installed locally, then when +you commit to the Emacs repository it will also try to send a commit +email from your local machine. If your machine is not configured to +send external mail, this will just fail. In any case, you may prefer +to either remove the plugin from your machine, or disable it for Emacs +branches. You can do this either by editing branch.conf in your Emacs +branches, to override the server setting (untested; not sure this +works), or by adding an entry to ~/.bazaar/locations.conf: + + [bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/*/] + post_commit_to = "" + +You have to use locations.conf rather than bazaar.conf because the +latter has a lower priority than branch.conf. + +* Using git-bzr + +** initially + +You can use Git locally to talk to the Bazaar repo as a "remote" repo +via git-bzr (aka git-remote-bzr). Initial clone: + + git clone bzr::bzr+ssh://USER@bzr.sv.gnu.org/emacs/trunk e + +This creates the working dir e/ (with subdir .git, etc). Disk usage +is 13G (as of early 2014), so you will probably want to repack: + + git repack -a -d -f --window=250 --depth=250 --window-memory=N + +where N is chosen to avoid swapping. E.g., given 512MB RAM, N="200m" +results in "du -sh .git" => 559M, about double the smallest reported +value (obtained with "deprecated" command "git gc --aggressive"). + +** steady-state + +Use "fetch", "pull" and other remote-to-local commands as usual. + +For "push", the Emacs Bazaar repo is configured with + + append_revisions_only = True + +so some versions of git-remote-bzr may raise AppendRevisionsOnlyViolation +(in func do_export) instead of displaying a "non fast-forward" message +and skipping the branch. See: + + http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00436.html + +which includes a provisional patch to git-remote-bzr to do that. diff --git a/admin/notes/changelogs b/admin/notes/changelogs index 2e954570ce8..1025cfc217f 100644 --- a/admin/notes/changelogs +++ b/admin/notes/changelogs @@ -5,6 +5,8 @@ entry in their name, not yours. http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg00793.html There is no need to make change log entries for files such as NEWS, MAINTAINERS, and FOR-RELEASE. +"There is no need" means you don't have to, but you can if you want to. + http://lists.gnu.org/archive/html/emacs-devel/2006-12/msg01135.html There is no need to indicate regeneration of files such as configure diff --git a/admin/notes/commits b/admin/notes/commits index 2c6f80c56f0..f33c6905d4c 100644 --- a/admin/notes/commits +++ b/admin/notes/commits @@ -45,6 +45,15 @@ Date: Tue, 31 Mar 2009 12:21:20 +0900 for modern source-control systems with a global log, it's better to have something like "Regenerate configure". +(4) (Added in 2014) In commit comments, and ChangeLog files, it is best + to use ways of identifying revisions that are not dependent on a + particular version control system. (At time of writing Emacs is + about to move to its fourth VCS and another move in the future is + not impossible.) An excellent way to identify commits is by + quoting their summary line. Another is with an action stamp - an + RFC3339 date followed by ! followed by the committer's email - for + example, "2014-01-16T05:43:35Z!esr@thyrsus.com". Often, "my + previous commit" will suffice. Followup discussion: http://lists.gnu.org/archive/html/emacs-devel/2010-01/msg00897.html diff --git a/admin/notes/copyright b/admin/notes/copyright index 3a404b69678..a54bcb6108b 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright @@ -1,4 +1,4 @@ -Copyright (C) 2007-2013 Free Software Foundation, Inc. +Copyright (C) 2007-2014 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/notes/elpa b/admin/notes/elpa index db14456fe32..469a0ca8bd1 100644 --- a/admin/notes/elpa +++ b/admin/notes/elpa @@ -1,24 +1,21 @@ NOTES ON THE EMACS PACKAGE ARCHIVE -The GNU Emacs package archive, at elpa.gnu.org, is managed using a Bzr -branch named "elpa", hosted on Savannah. To check it out: +The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git +repository named "elpa", hosted on Savannah. To check it out: - bzr branch bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa elpa + git clone git://bzr.sv.gnu.org/emacs/elpa cd elpa - echo "public_branch = bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa" >> .bzr/branch/branch.conf - bzr bind bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/elpa + git remote set-url --push origin git+ssh://bzr.sv.gnu.org/srv/git/emacs/elpa [create task branch for edits, etc.] -Changes to this branch propagate to elpa.gnu.org in a semi-manual way. -There exists a copy of the elpa branch on that machine. Someone with -access logs in, pulls the latest changes from Savannah, and runs a -"deployment" script. This script (which is itself kept in the Bzr -branch) generates the content visible at http://elpa.gnu.org/packages. +Changes to this branch propagate to elpa.gnu.org via a "deployment" script run +daily. This script (which is kept in elpa/admin/update-archive.sh) generates +the content visible at http://elpa.gnu.org/packages. -The reason we set things up this way, instead of using the package -upload commands in package-x.el, is to let Emacs hackers conveniently -edit the contents of the "elpa" branch. (In particular, multi-file -packages are stored on the branch in source form, not as tarfiles.) +A new package is released as soon as the "version number" of that package is +changed. So you can use `elpa' to work on a package without fear of releasing +those changes prematurely. And once the code is ready, just bump the +version number to make a new release of the package. It is easy to use the elpa branch to deploy a "local" copy of the package archive. For details, see the README file in the elpa branch. diff --git a/admin/notes/font-backend b/admin/notes/font-backend index cdf2001580d..5c36cf08c62 100644 --- a/admin/notes/font-backend +++ b/admin/notes/font-backend @@ -1,4 +1,4 @@ -Copyright (C) 2002-2013 Free Software Foundation, Inc. +Copyright (C) 2002-2014 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/notes/hydra b/admin/notes/hydra new file mode 100644 index 00000000000..3b6bc87a2f6 --- /dev/null +++ b/admin/notes/hydra @@ -0,0 +1,66 @@ +-*- outline -*- + +Copyright (C) 2013-2014 Free Software Foundation, Inc. +See the end of the file for license conditions. + +NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA + +A continuous build for Emacs can be found at +http://hydra.nixos.org/jobset/gnu/emacs-trunk +http://hydra.nixos.org/jobset/gnu/emacs-24 + +* It builds Emacs on various platforms. +Sometimes jobs fail due to hydra problems rather than Emacs problems. +Eg it seems like the cygwin build will never work again. +http://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html + +* Mail notifications +In addition to the web interface, Hydra can send notifications by +email when the build status of a project changes—e.g., from +`SUCCEEDED' to `FAILED'. It sends notifications about build status in +Emacs trunk to emacs-buildstatus@gnu.org. + +If you want to receive these notifications, please subscribe at +http://lists.gnu.org/mailman/listinfo/emacs-buildstatus + +* The Emacs jobset consists of the following jobs: + +** The `tarball' job +which gets a checkout from bzr, and does a bootstrap followed +by running make-dist to create a tarball. If this job fails, all the +others will too (because they use the tarball as input). + +** The `build' job +which starts from the tarball and does a normal build + +** The 'coverage' job +does a gcov build and then runs `make check'. Fails if any test fails. + +* Nix expressions +The recipe for GNU Emacs are available via Git: +http://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs + +To modify the build job, email the patch to hydra-users@gnu.org. The +build recipes are written in the Nix language. + +* Other Information +For a list of other GNU packages that have a continuous build on +Hydra, see http://hydra.nixos.org/project/gnu + +See http://www.gnu.org/software/devel.html#Hydra for more information. + + +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 . diff --git a/admin/notes/lel-TODO b/admin/notes/lel-TODO index 2c6d86a4ffd..4a4ccb5e6e8 100644 --- a/admin/notes/lel-TODO +++ b/admin/notes/lel-TODO @@ -1,6 +1,6 @@ Some lisp/emacs-lisp/ Features and Where They Are Documented -Copyright (C) 2007-2013 Free Software Foundation, Inc. +Copyright (C) 2007-2014 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index c4edd3abc93..dff788351a9 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -1,6 +1,6 @@ -*- coding: utf-8; mode: text; -*- -Copyright (C) 2007-2013 Free Software Foundation, Inc. +Copyright (C) 2007-2014 Free Software Foundation, Inc. See the end of the file for license conditions. From README.multi-tty in the multi-tty branch. diff --git a/admin/notes/unicode b/admin/notes/unicode index 21704c78a00..654580639f7 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -1,6 +1,6 @@ - -*-mode: text; coding: latin-1;-*- + -*-mode: text; coding: utf-8;-*- -Copyright (C) 2002-2013 Free Software Foundation, Inc. +Copyright (C) 2002-2014 Free Software Foundation, Inc. See the end of the file for license conditions. Problems, fixmes and other unicode-related issues @@ -12,9 +12,9 @@ regard to completeness. * SINGLE_BYTE_CHAR_P returns true for Latin-1 characters, which has undesirable effects. E.g.: - (multibyte-string-p (let ((s "x")) (aset s 0 ?) s)) => nil - (multibyte-string-p (concat [?])) => nil - (text-char-description ?) => "M-#" + (multibyte-string-p (let ((s "x")) (aset s 0 ?£) s)) => nil + (multibyte-string-p (concat [?£])) => nil + (text-char-description ?£) => "M-#" These examples are all fixed by the change of 2002-10-14, but there still exist questionable SINGLE_BYTE_CHAR_P in the @@ -77,7 +77,7 @@ regard to completeness. spelling and calendar, but that's not a Unicode issue.) * Handle Unicode combining characters usefully, e.g. diacritics, and - handle more scripts specifically ( la Devanagari). There are + handle more scripts specifically (à la Devanagari). There are issues with canonicalization. * We need tabular input methods, e.g. for maths symbols. (Not @@ -98,6 +98,134 @@ regard to completeness. * Old auto-save files, and similar files, such as Gnus drafts, containing non-ASCII characters probably won't be re-read correctly. + +Source file encoding +-------------------- + +Most Emacs source files are encoded in UTF-8 (or in ASCII, which is a +subset), but there are a few exceptions, listed below. Perhaps +someday many of these files will be converted to UTF-8, for +convenience when using tools like 'grep -r', but this might need +nontrivial changes to the build process. + + * chinese-big5 + + These are verbatim copies of files taken from external sources. + They haven't been converted to UTF-8. + + leim/CXTERM-DIC/4Corner.tit + leim/CXTERM-DIC/ARRAY30.tit + leim/CXTERM-DIC/ECDICT.tit + leim/CXTERM-DIC/ETZY.tit + leim/CXTERM-DIC/PY-b5.tit + leim/CXTERM-DIC/Punct-b5.tit + leim/CXTERM-DIC/QJ-b5.tit + leim/CXTERM-DIC/ZOZY.tit + leim/MISC-DIC/CTLau-b5.html + leim/MISC-DIC/cangjie-table.b5 + + * chinese-iso-8bit + + These are verbatim copies of files taken from external sources. + They haven't been converted to UTF-8. + + leim/CXTERM-DIC/CCDOSPY.tit + leim/CXTERM-DIC/Punct.tit + leim/CXTERM-DIC/QJ.tit + leim/CXTERM-DIC/SW.tit + leim/CXTERM-DIC/TONEPY.tit + leim/MISC-DIC/pinyin.map + leim/MISC-DIC/CTLau.html + leim/MISC-DIC/ziranma.cin + + * cp850 + + This file contains non-ASCII characters in unibyte strings. When + editing a keyboard layout it's more convenient to see 'é' than + '\202', and the MS-DOS compiler requires the single byte if a + backslash escape is not being used. + + src/msdos.c + + * iso-2022-cn-ext + + This file is externally generated from leim/MISC-DIC/cangjie-table.b5 + by Big5->CNS converter. It hasn't been converted to UTF-8. + + leim/MISC-DIC/cangjie-table.cns + + * iso-latin-2 + + These files are processed by csplain, a program that requires + Latin-2 input. In 2012 the csplain maintainers started + recommending UTF-8, but these files haven't been converted yet. + + etc/refcards/cs-dired-ref.tex + etc/refcards/cs-refcard.tex + etc/refcards/cs-survival.tex + etc/refcards/sk-dired-ref.tex + etc/refcards/sk-refcard.tex + etc/refcards/sk-survival.tex + + * japanese-iso-8bit + + SKK-JISYO.L is a verbatim copy of a file taken from an external source. + It hasn't been converted to UTF-8. + + leim/SKK-DIC/SKK-JISYO.L + + * japanese-shift-jis + + This is a verbatim copy of a file taken from an external source. + It hasn't been converted to UTF-8. + + admin/charsets/mapfiles/cns2ucsdkw.txt + + * no-conversion + + This file purposely contains arbitrary bytes interspersed within text, + to test whether the Emacs distribution is corrupted. + + lib-src/testfile + + * iso-2022-7bit + + This file switches between CJK charsets, which is not encoded in UTF-8. + + etc/HELLO + + Each of these files contains just one CJK charset, but Emacs + currently has no easy way to specify set-charset-priority on a + per-file basis, so converting any of these files to UTF-8 might + change the file's appearance when viewed by an Emacs that is + operating in some other language environment. + + etc/tutorials/TUTORIAL.ja + leim/quail/cyril-jis.el + leim/quail/hanja-jis.el + leim/quail/japanese.el + leim/quail/py-punct.el + leim/quail/pypunct-b5.el + lisp/international/ja-dic-cnv.el + lisp/international/ja-dic-utl.el + lisp/international/kinsoku.el + lisp/international/kkc.el + lisp/international/titdic-cnv.el + lisp/language/japan-util.el + lisp/language/japanese.el + lisp/term/x-win.el + + * utf-8-emacs + + These files contain characters that cannot be encoded in UTF-8. + + leim/quail/tibetan.el + leim/quail/ethiopic.el + lisp/international/titdic-cnv.el + lisp/language/tibetan.el + lisp/language/tibet-util.el + lisp/language/ind-util.el + This file is part of GNU Emacs. diff --git a/admin/notes/www b/admin/notes/www new file mode 100644 index 00000000000..4d092ca7fa0 --- /dev/null +++ b/admin/notes/www @@ -0,0 +1,82 @@ +-*- outline -*- + +Copyright (C) 2013-2014 Free Software Foundation, Inc. +See the end of the file for license conditions. + +NOTES FOR EMACS WWW PAGES + +* Renaming pages, redirects + +Sometimes you want to move a page to a new location. +If the old location might be referenced somewhere else, you should add +some form of redirect to the new location. There are several ways to +do this: + +** Use a refresh directive in the old file +https://www.gnu.org/server/standards/README.webmastering.html#htaccess + +Change the entire contents of the old file to be something like: + + + +I can't think of any reason to use this method. + +** Use a .symlinks file +https://www.gnu.org/server/standards/README.webmastering.html#symlinks + +This is really an interface to mod_rewrite rules, but it acts like +symlinks. Remove old-page.html altogether, and create a ".symlinks" +file in the relevant directory, with contents of the form: + + # This is a comment line. + old-page.html new-page.html + +Anyone visiting old-page.html will be shown the contents of new-page.html. +Note that changes to .symlinks file are only updated periodically on +the server via cron (twice an hour?). So there will be a delay (of up +to 30 minutes?) before you see your changes take effect. + +This method is ok, but: +i) a person visiting old-page.html has no idea that the page has moved. +They still see old-page.html in their address bar. (In other words, +the mod_rewrite rule does not use the [R] flag.) Sometimes this is +what you want, sometimes not. + +ii) it doesn't work right if the new page is in a different directory +to the old page: relative links from the visited page will break. + +** Use a .htaccess file + +Remove old-page.html altogether, and create a ".htaccess" file in the +relevant directory, with contents of the form: + + # This is a comment line. + Redirect 301 /software/emacs/old-page.html /software/emacs/dir/new-page.html + +Use "301" for a permanent redirection, otherwise you can omit the number. +Note that paths must (?) be relative to the top-level www.gnu.org. + +I think this is the best method. You can specify temporary or +permanent redirects, and changes go live more-or-less straight away. + +This method is useful for making cross-references to non-Emacs manuals +work; see manual/.htaccess in the repository. You only have to add a +single redirect for every given external manual, you can redirect +html_node to hmtl_node and html_mono to html_mono. + + + +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 . diff --git a/admin/notes/years b/admin/notes/years index e6b38c5aefd..342fe9e2307 100644 --- a/admin/notes/years +++ b/admin/notes/years @@ -2,6 +2,8 @@ HOW TO MAINTAIN COPYRIGHT YEARS FOR GNU EMACS Maintaining copyright years is now very simple: every time a new year rolls around, add that year to every FSF (and AIST) copyright notice. +Do this by running the 'admin/update-copyright' script on a fresh bzr +checkout. Inspect the results for plausibility, then commit them. There's no need to worry about whether an individual file has changed in a given year - it's sufficient that Emacs as a whole has changed. @@ -28,10 +30,10 @@ but should keep the full list in a comment in the source. since Emacs 21 came out in 2001, all the subsequent years[1]. We don't need to check whether *that file* was changed in those years. It's sufficient that *Emacs* was changed in those years (and it was!). - + For those files that have been added since then, we should add the year it was added to Emacs, and all subsequent years." - + --RMS, 2005-07-13 [1] Note that this includes 2001 - see diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32 index 8138d0ba0f1..2859140ce42 100644 --- a/admin/nt/README-UNDUMP.W32 +++ b/admin/nt/README-UNDUMP.W32 @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. Emacs for Windows diff --git a/admin/nt/README-ftp-server b/admin/nt/README-ftp-server index 5983a0f9617..5f5b4a951af 100644 --- a/admin/nt/README-ftp-server +++ b/admin/nt/README-ftp-server @@ -1,12 +1,12 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. Precompiled Distributions of Emacs for Windows - Version 24.1 + Version 24.3 - January 1, 2011 + March 18, 2013 This directory contains precompiled distributions for GNU Emacs on Windows (versions before Windows 95 and NT4 are not supported). @@ -14,21 +14,15 @@ See the end of the file for license conditions. Free Software Foundation; the precompiled distributions are provided here for convenience since the majority of Windows users are not accustomed to compiling programs themselves. Corresponding source - can be found in the parent directory in emacs-24.1.tar.gz. - - If you have access to the World Wide Web, I would recommend pointing - your favorite web browser to the following document (if you haven't - already): - - http://www.gnu.org/software/emacs/windows/ntemacs.html + can be found in the parent directory in emacs-24.3.tar.gz. * IMPORTANT LEGAL REMINDER If you want to redistribute any of the precompiled distributions of Emacs, be careful to check the implications of the GPL. For instance, - if you put the emacs-24.1-bin-i386.tar.gz file from this directory on + if you put the emacs-24.3-bin-i386.zip file from this directory on an Internet site, you must arrange to distribute the source files of - the SAME version (i.e. ../emacs-24.1.tar.gz). + the SAME version (i.e. ../emacs-24.3.tar.gz). Making a link to our copy of the source is NOT sufficient, since we might upgrade to a new version while you are still distributing the @@ -37,8 +31,8 @@ See the end of the file for license conditions. * Files in this directory - + emacs-24.1-bin-i386.zip - Windows binaries of Emacs-24.1, with all lisp code and documentation + + emacs-24.3-bin-i386.zip + Windows binaries of Emacs-24.3, with all lisp code and documentation included. Download this file if you want a single installation package, and @@ -49,21 +43,12 @@ See the end of the file for license conditions. If you need the C source code at a later date, it will be safe to unpack the source distribution on top of this installation. - + emacs-24.1-barebin-i386.zip - Windows binaries of Emacs-24.1, without lisp code or documentation. - - Download this file if you already have the source distribution. - - Unpack this over the top of the source distribution. It contains the - bin subdirectory and etc/DOC file. - - + libxpm-3.5.7-w32-src.zip - Source code required to compile libXpm-3.5.7 on Windows. Contains + + libXpm-3.5.8-w32-src.zip + Source code required to compile libXpm-3.5.8 on Windows. Contains a basic Makefile for compiling with mingw32 and a .def file for generating a DLL with the appropriate exports in addition to the source code to provide the subset of functionality Emacs uses from - libXpm. This corresponds to the libXpm.dll in emacs-24.1-bin-i386.zip - and emacs-24.1-barebin-i386.zip. + libXpm. This corresponds to the libXpm.dll in emacs-24.3-bin-i386.zip. * Prerequisites for running Emacs on Windows 9X @@ -73,7 +58,7 @@ See the end of the file for license conditions. * Image support - Emacs 24.1 contains support for images, however for most image + Emacs 24.3 contains support for images, however for most image formats supporting libraries are required. This distribution has been tested with the libraries that are distributed with GTK for Windows (http://www.gtk.org/download/win32.php), and the libraries @@ -112,6 +97,16 @@ See the end of the file for license conditions. as well as the base librsvg library. Known to crash Emacs on many sample images. +* XML support + + In order to support XML via libxml2 at runtime, a libxml2-enabled + Emacs must be able to find the relevant DLLs during startup; failure + to do so is not an error, but libxml2 features won't be available to + the running session. + + You can get pre-built binaries (including any required DLL and the + header files) at http://sourceforge.net/projects/ezwinports/files/. + * Distributions in .tar.gz and .zip format Emacs is distributed primarily as source code in a large gzipped tar @@ -229,16 +224,10 @@ See the end of the file for license conditions. * Further information - If you have access to the World Wide Web, I would recommend pointing - your favorite web browser to following the document (if you haven't - already): + The Emacs on MS Windows FAQ is distributed with Emacs (info + manual "efaq-w32"), and at - http://www.gnu.org/software/emacs/windows/ntemacs.html - - This document serves as an FAQ and a source for further information - about the Windows port and related software packages. Note that as - most of the information in that FAQ is for earlier versions, so some - information may not be relevant to Emacs-24.1. + http://www.gnu.org/software/emacs/manual/efaq-w32.html In addition to the FAQ, there is a mailing list for discussing issues related to the Windows port of Emacs. For information about the @@ -268,11 +257,8 @@ See the end of the file for license conditions. Enjoy! - Jason Rumney - (jasonr@gnu.org) - - Most of this README was contributed by former maintainer Andrew Innes - (andrewi@gnu.org) + Most of this README was contributed by former maintainers Andrew Innes + (andrewi@gnu.org) and Jason Rumney (jasonr@gnu.org). This file is part of GNU Emacs. diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index e74a2a5af49..f29d1cb377f 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -1,7 +1,7 @@ #!/bin/sh ### quick-install-emacs --- do a halfway-decent job of installing emacs quickly -## Copyright (C) 2001-2013 Free Software Foundation, Inc. +## Copyright (C) 2001-2014 Free Software Foundation, Inc. ## Author: Miles Bader @@ -105,8 +105,8 @@ and build directories reside. Optionally, $me can also remove old versions of automatically generated files that are version-specific (such as the -versioned emacs executables in the \`src' directory, and the DOC-* files -in the \`etc' directory). The latter action is called \`pruning,' and +versioned emacs executables in the \`src' directory). +The latter action is called \`pruning,' and can be enabled using the \`-p' or \`--prune' options. EOF exit 0 @@ -209,10 +209,6 @@ maybe_mkdir "$DST_INFO" PRUNED="" if test x"$PRUNE" != xno; then - for D in `ls -1t $BUILD/etc/DOC-* | sed 1d`; do - echo $REMOVE_CMD $D - PRUNED="$PRUNED $D" - done for D in `ls -1t $BUILD/src/emacs-$VERSION.* | sed 1d`; do echo $REMOVE_CMD $D PRUNED="$PRUNED $D" diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt index ec41b769375..d97c0dd9617 100644 --- a/admin/unidata/BidiMirroring.txt +++ b/admin/unidata/BidiMirroring.txt @@ -1,19 +1,19 @@ -# BidiMirroring-6.2.0.txt -# Date: 2012-05-15, 24:19:00 GMT [KW, LI] +# BidiMirroring-6.3.0.txt +# Date: 2013-02-12, 08:20:00 GMT [KW, LI] # # Bidi_Mirroring_Glyph Property # # This file is an informative contributory data file in the # Unicode Character Database. # -# Copyright (c) 1991-2012 Unicode, Inc. +# Copyright (c) 1991-2013 Unicode, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # This data file lists characters that have the Bidi_Mirrored=Yes property # value, for which there is another Unicode character that typically has a glyph # that is the mirror image of the original character's glyph. # -# The repertoire covered by the file is Unicode 6.2.0. +# The repertoire covered by the file is Unicode 6.3.0. # # The file contains a list of lines with mappings from one code point # to another one for character-based mirroring. @@ -42,7 +42,7 @@ # # This file was originally created by Markus Scherer. # Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler, -# and for Unicode 6.1 and 6.2 by Ken Whistler and Laurentiu Iancu. +# and for Unicode 6.1, 6.2, and 6.3 by Ken Whistler and Laurentiu Iancu. # # ############################################################ # @@ -204,8 +204,8 @@ 276F; 276E # HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT 2770; 2771 # HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT 2771; 2770 # HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT -2772; 2773 # LIGHT LEFT TORTOISE SHELL BRACKET -2773; 2772 # LIGHT RIGHT TORTOISE SHELL BRACKET +2772; 2773 # LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT +2773; 2772 # LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT 2774; 2775 # MEDIUM LEFT CURLY BRACKET ORNAMENT 2775; 2774 # MEDIUM RIGHT CURLY BRACKET ORNAMENT 27C3; 27C4 # OPEN SUBSET diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 49cd9bb6d3a..3ad81a94bae 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -1,6 +1,6 @@ -# Makefile -- Makefile to generate character property tables. +### @configure_input@ -# Copyright (C) 2012-2013 Free Software Foundation, Inc. +# Copyright (C) 2012-2014 Free Software Foundation, Inc. # Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 # National Institute of Advanced Industrial Science and Technology (AIST) @@ -21,16 +21,17 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -SHELL = /bin/sh +SHELL = @SHELL@ srcdir = @srcdir@ -abs_builddir = @abs_builddir@ top_srcdir = @top_srcdir@ -abs_top_builddir = @abs_top_builddir@ +top_builddir = @top_builddir@ -EMACS = ${abs_top_builddir}/src/emacs +EMACS = ${top_builddir}/src/emacs DSTDIR = ${top_srcdir}/lisp/international -emacs = ${EMACS} -batch --no-site-file --no-site-lisp +emacs = "${EMACS}" -batch --no-site-file --no-site-lisp + +.PHONY: all compile install all: ${DSTDIR}/charprop.el @@ -40,14 +41,25 @@ all: ${DSTDIR}/charprop.el unidata.txt: ${srcdir}/UnicodeData.txt sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < ${srcdir}/UnicodeData.txt > $@ -${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.elc unidata.txt - cd ${DSTDIR} && ${emacs} -l ${srcdir}/unidata-gen \ - -f unidata-gen-files ${srcdir} ${abs_builddir}/unidata.txt +compile: ${srcdir}/unidata-gen.elc + +## Depend on .el rather than .elc so as not to needlessly rebuild +## uni-*.el files just because .elc is missing. +## Same for UnicodeData.txt v unidata.txt. +${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.el ${srcdir}/UnicodeData.txt + ${MAKE} ${MFLAGS} compile unidata.txt EMACS="${EMACS}" + -if [ -f "$@" ]; then \ + cd ${DSTDIR} && chmod +w charprop.el `sed -n 's/^;; FILE: //p' < charprop.el`; \ + fi + ${emacs} -L ${srcdir} -l unidata-gen -f unidata-gen-files \ + ${srcdir} "${DSTDIR}" ## Like the above, but generate in PWD rather than lisp/international. charprop.el: ${srcdir}/unidata-gen.elc unidata.txt - ${emacs} -l ${srcdir}/unidata-gen \ - -f unidata-gen-files ${srcdir} unidata.txt + ${emacs} -L ${srcdir} -l unidata-gen -f unidata-gen-files \ + ${srcdir} + +.PHONY: clean bootstrap-clean distclean maintainer-clean extraclean install: charprop.el cp charprop.el ${DSTDIR} @@ -57,9 +69,20 @@ clean: if test -f charprop.el; then \ rm -f `sed -n 's/^;; FILE: //p' < charprop.el`; \ fi - rm -f charprop.el ${srcdir}/unidata-gen.elc unidata.txt + rm -f charprop.el ${srcdir}/*.elc unidata.txt + +bootstrap-clean: clean distclean: clean - -rm -f ./Makefile + rm -f Makefile maintainer-clean: distclean + +## Do not remove these files, even in a bootstrap, because they rarely +## change and it slows down bootstrap (a tiny bit). +## Cf leim/ja-dic (which is much slower). +extraclean: + if test -f ${DSTDIR}/charprop.el; then \ + (cd ${DSTDIR} && rm -f `sed -n 's/^;; FILE: //p' < charprop.el`); \ + rm -f ${DSTDIR}/charprop.el; \ + fi diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt index 086379eb4f3..9fffa71a1e9 100644 --- a/admin/unidata/UnicodeData.txt +++ b/admin/unidata/UnicodeData.txt @@ -1509,6 +1509,7 @@ 0619;ARABIC SMALL DAMMA;Mn;31;NSM;;;;;N;;;;; 061A;ARABIC SMALL KASRA;Mn;32;NSM;;;;;N;;;;; 061B;ARABIC SEMICOLON;Po;0;AL;;;;;N;;;;; +061C;ARABIC LETTER MARK;Cf;0;AL;;;;;N;;;;; 061E;ARABIC TRIPLE DOT PUNCTUATION MARK;Po;0;AL;;;;;N;;;;; 061F;ARABIC QUESTION MARK;Po;0;AL;;;;;N;;;;; 0620;ARABIC LETTER KASHMIRI YEH;Lo;0;AL;;;;;N;;;;; @@ -5296,7 +5297,7 @@ 180B;MONGOLIAN FREE VARIATION SELECTOR ONE;Mn;0;NSM;;;;;N;;;;; 180C;MONGOLIAN FREE VARIATION SELECTOR TWO;Mn;0;NSM;;;;;N;;;;; 180D;MONGOLIAN FREE VARIATION SELECTOR THREE;Mn;0;NSM;;;;;N;;;;; -180E;MONGOLIAN VOWEL SEPARATOR;Zs;0;WS;;;;;N;;;;; +180E;MONGOLIAN VOWEL SEPARATOR;Cf;0;BN;;;;;N;;;;; 1810;MONGOLIAN DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;; 1811;MONGOLIAN DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; 1812;MONGOLIAN DIGIT TWO;Nd;0;L;;2;2;2;N;;;;; @@ -5751,7 +5752,7 @@ 1A18;BUGINESE VOWEL SIGN U;Mn;220;NSM;;;;;N;;;;; 1A19;BUGINESE VOWEL SIGN E;Mc;0;L;;;;;N;;;;; 1A1A;BUGINESE VOWEL SIGN O;Mc;0;L;;;;;N;;;;; -1A1B;BUGINESE VOWEL SIGN AE;Mc;0;L;;;;;N;;;;; +1A1B;BUGINESE VOWEL SIGN AE;Mn;0;NSM;;;;;N;;;;; 1A1E;BUGINESE PALLAWA;Po;0;L;;;;;N;;;;; 1A1F;BUGINESE END OF SECTION;Po;0;L;;;;;N;;;;; 1A20;TAI THAM LETTER HIGH KA;Lo;0;L;;;;;N;;;;; @@ -7116,6 +7117,10 @@ 2062;INVISIBLE TIMES;Cf;0;BN;;;;;N;;;;; 2063;INVISIBLE SEPARATOR;Cf;0;BN;;;;;N;;;;; 2064;INVISIBLE PLUS;Cf;0;BN;;;;;N;;;;; +2066;LEFT-TO-RIGHT ISOLATE;Cf;0;LRI;;;;;N;;;;; +2067;RIGHT-TO-LEFT ISOLATE;Cf;0;RLI;;;;;N;;;;; +2068;FIRST STRONG ISOLATE;Cf;0;FSI;;;;;N;;;;; +2069;POP DIRECTIONAL ISOLATE;Cf;0;PDI;;;;;N;;;;; 206A;INHIBIT SYMMETRIC SWAPPING;Cf;0;BN;;;;;N;;;;; 206B;ACTIVATE SYMMETRIC SWAPPING;Cf;0;BN;;;;;N;;;;; 206C;INHIBIT ARABIC FORM SHAPING;Cf;0;BN;;;;;N;;;;; @@ -7738,10 +7743,10 @@ 2305;PROJECTIVE;So;0;ON;;;;;N;;;;; 2306;PERSPECTIVE;So;0;ON;;;;;N;;;;; 2307;WAVY LINE;So;0;ON;;;;;N;;;;; -2308;LEFT CEILING;Sm;0;ON;;;;;Y;;;;; -2309;RIGHT CEILING;Sm;0;ON;;;;;Y;;;;; -230A;LEFT FLOOR;Sm;0;ON;;;;;Y;;;;; -230B;RIGHT FLOOR;Sm;0;ON;;;;;Y;;;;; +2308;LEFT CEILING;Ps;0;ON;;;;;Y;;;;; +2309;RIGHT CEILING;Pe;0;ON;;;;;Y;;;;; +230A;LEFT FLOOR;Ps;0;ON;;;;;Y;;;;; +230B;RIGHT FLOOR;Pe;0;ON;;;;;Y;;;;; 230C;BOTTOM RIGHT CROP;So;0;ON;;;;;N;;;;; 230D;BOTTOM LEFT CROP;So;0;ON;;;;;N;;;;; 230E;TOP RIGHT CROP;So;0;ON;;;;;N;;;;; @@ -18740,8 +18745,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 12453;CUNEIFORM NUMERIC SIGN FOUR BAN2 VARIANT FORM;Nl;0;L;;;;4;N;;;;; 12454;CUNEIFORM NUMERIC SIGN FIVE BAN2;Nl;0;L;;;;5;N;;;;; 12455;CUNEIFORM NUMERIC SIGN FIVE BAN2 VARIANT FORM;Nl;0;L;;;;5;N;;;;; -12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;-1;N;;;;; -12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;-1;N;;;;; +12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;2;N;;;;; +12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;3;N;;;;; 12458;CUNEIFORM NUMERIC SIGN ONE ESHE3;Nl;0;L;;;;1;N;;;;; 12459;CUNEIFORM NUMERIC SIGN TWO ESHE3;Nl;0;L;;;;2;N;;;;; 1245A;CUNEIFORM NUMERIC SIGN ONE THIRD DISH;Nl;0;L;;;;1/3;N;;;;; diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html index 90cd895d984..81722bd091f 100644 --- a/admin/unidata/copyright.html +++ b/admin/unidata/copyright.html @@ -10,7 +10,7 @@ - + @@ -136,7 +136,7 @@

      Unicode Terms of Use

      1. Unicode Copyright.
          -
        1. Copyright © 1991-2012 Unicode, Inc. All rights reserved.
        2. +
        3. Copyright © 1991-2013 Unicode, Inc. All rights reserved.
        4. Certain documents and files on this website contain a legend indicating that "Modification is permitted." Any person is hereby authorized, without fee, to modify such documents and @@ -268,7 +268,7 @@

          EXHIBIT 1

          NOTICE TO USER: Carefully read the following legal agreement. BY DOWNLOADING, INSTALLING, COPYING OR OTHERWISE USING UNICODE INC.'S DATA FILES ("DATA FILES"), AND/OR SOFTWARE ("SOFTWARE"), YOU UNEQUIVOCALLY ACCEPT, AND AGREE TO BE BOUND BY, ALL OF THE TERMS AND CONDITIONS OF THIS AGREEMENT. IF YOU DO NOT AGREE, DO NOT DOWNLOAD, INSTALL, COPY, DISTRIBUTE OR USE THE DATA FILES OR SOFTWARE.

          COPYRIGHT AND PERMISSION NOTICE

          -

          Copyright © 1991-2012 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in +

          Copyright © 1991-2013 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in http://www.unicode.org/copyright.html.

          Permission is hereby granted, free of charge, to any person obtaining a copy of the Unicode data files and diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index d9277217f0e..ff45b79aab7 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -1,4 +1,7 @@ ;; unidata-gen.el -- Create files containing character property data. + +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. + ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H13PRO009 @@ -23,13 +26,12 @@ ;; SPECIAL NOTICE ;; ;; This file must be byte-compilable/loadable by `temacs' and also -;; the entry function `unidata-gen-files' must be runnable by -;; `temacs'. +;; the entry function `unidata-gen-files' must be runnable by `temacs'. ;; FILES TO BE GENERATED ;; ;; The entry function `unidata-gen-files' generates these files in -;; the current directory. +;; in directory specified by its dest-dir argument. ;; ;; charprop.el ;; It contains a series of forms of this format: @@ -88,9 +90,9 @@ (defvar unidata-list nil) -;; Name of the directory containing files of Unicode Character -;; Database. +;; Name of the directory containing files of Unicode Character Database. +;; Dynamically bound in unidata-gen-files. (defvar unidata-dir nil) (defun unidata-setup-list (unidata-text-file) @@ -192,8 +194,8 @@ Property value is an integer." 4 unidata-gen-table-symbol "uni-bidi.el" "Unicode bidi class. Property value is one of the following symbols: - L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET, - AN, CS, NSM, BN, B, S, WS, ON" + L, LRE, LRO, LRI, R, AL, RLE, RLO, RLI, FSI, PDF, PDI, + EN, ES, ET, AN, CS, NSM, BN, B, S, WS, ON" unidata-describe-bidi-class ;; The assignment of default values to blocks of code points ;; follows the file DerivedBidiClass.txt from the Unicode @@ -203,7 +205,8 @@ Property value is one of the following symbols: (#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R)) ;; The order of elements must be in sync with bidi_type_t in ;; src/dispextern.h. - (L R EN AN BN B AL LRE LRO RLE RLO PDF ES ET CS NSM S WS ON)) + (L R EN AN BN B AL LRE LRO RLE RLO PDF LRI RLI FSI PDI + ES ET CS NSM S WS ON)) (decomposition 5 unidata-gen-table-decomposition "uni-decomposition.el" "Unicode decomposition mapping. @@ -395,12 +398,17 @@ is the character itself."))) ;; If VAL is one of VALn, just return n. ;; Otherwise, VAL-LIST is modified to this: ;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ... (VAL . n+1)) +;; +;; WARN is an optional warning to display when the value list is +;; extended, for property values that need to be in sync with other +;; parts of Emacs; currently only used for bidi-class. -(defun unidata-encode-val (val-list val) +(defun unidata-encode-val (val-list val &optional warn) (let ((slot (assoc val val-list)) val-code) (if slot (cdr slot) + (if warn (message warn val)) (setq val-code (length val-list)) (nconc val-list (list (cons val val-code))) val-code))) @@ -411,6 +419,16 @@ is the character itself."))) (let ((table (make-char-table 'char-code-property-table)) (prop-idx (unidata-prop-index prop)) (vec (make-vector 128 0)) + ;; When this warning is printed, there's a need to make the + ;; following changes: + ;; (1) update unidata-prop-alist with the new bidi-class values; + ;; (2) extend bidi_type_t enumeration on src/dispextern.h to + ;; include the new classes; + ;; (3) possibly update the assertion in bidi.c:bidi_check_type; and + ;; (4) possibly update the switch cases in + ;; bidi.c:bidi_get_type and bidi.c:bidi_get_category. + (bidi-warning "\ +** Found new bidi-class '%s', please update bidi.c and dispextern.h") tail elt range val val-code idx slot prev-range-data) (setq val-list (cons nil (copy-sequence val-list))) @@ -436,7 +454,9 @@ is the character itself."))) (setq elt (car tail) tail (cdr tail)) (setq range (car elt) val (funcall val-func (nth prop-idx elt))) - (setq val-code (if val (unidata-encode-val val-list val))) + (setq val-code (if val (unidata-encode-val val-list val + (and (eq prop 'bidi-class) + bidi-warning)))) (if (consp range) (when val-code (set-char-table-range table range val-code) @@ -484,7 +504,9 @@ is the character itself."))) (setq new-val (funcall val-func (nth prop-idx elt))) (if (not (eq val new-val)) (setq val new-val - val-code (if val (unidata-encode-val val-list val)))) + val-code (if val (unidata-encode-val + val-list val (and (eq prop 'bidi-class) + bidi-warning))))) (if val-code (aset vec (- range start) val-code)) (setq tail (cdr tail))) @@ -962,7 +984,14 @@ is the character itself."))) (l nil) (idx 0) c) - (if (= len 0) + (if (or (= len 0) + ;; Unicode Standard, paragraph 4.8: "For all other + ;; Unicode code points of all other types (Control, + ;; Private-Use, Surrogate, Noncharacter, and Reserved), + ;; the value of the Name property is the null string." + ;; We already handle elsewhere all the characters except + ;; Cc, Control characters, which are handled here. + (string= str "")) nil (dotimes (i len) (setq c (aref str i)) @@ -975,11 +1004,15 @@ is the character itself."))) idx (1+ i))))) (nreverse (cons (intern (substring str idx)) l)))))) +(defun unidata--ensure-compiled (&rest funcs) + (dolist (fun funcs) + (or (byte-code-function-p (symbol-function fun)) + (byte-compile fun)))) + (defun unidata-gen-table-name (prop &rest ignore) (let* ((table (unidata-gen-table-word-list prop 'unidata-split-name)) (word-tables (char-table-extra-slot table 4))) - (byte-compile 'unidata-get-name) - (byte-compile 'unidata-put-name) + (unidata--ensure-compiled 'unidata-get-name 'unidata-put-name) (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-name)) (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-name)) @@ -1017,8 +1050,8 @@ is the character itself."))) (defun unidata-gen-table-decomposition (prop &rest ignore) (let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition)) (word-tables (char-table-extra-slot table 4))) - (byte-compile 'unidata-get-decomposition) - (byte-compile 'unidata-put-decomposition) + (unidata--ensure-compiled 'unidata-get-decomposition + 'unidata-put-decomposition) (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-decomposition)) (set-char-table-extra-slot table 2 @@ -1101,6 +1134,10 @@ is the character itself."))) (RLE . "Right-to-Left Embedding") (RLO . "Right-to-Left Override") (PDF . "Pop Directional Format") + (LRI . "Left-to-Right Isolate") + (RLI . "Right-to-Left Isolate") + (FSI . "First Strong Isolate") + (PDI . "Pop Directional Isolate") (EN . "European Number") (ES . "European Number Separator") (ET . "European Number Terminator") @@ -1176,18 +1213,21 @@ is the character itself."))) ;; The entry function. It generates files described in the header ;; comment of this file. -(defun unidata-gen-files (&optional data-dir unidata-text-file) +;; Write files (charprop.el, uni-*.el) to dest-dir (default PWD), +;; using as input files from data-dir, and +;; unidata-text-file (default "unidata.txt" in PWD). +(defun unidata-gen-files (&optional data-dir dest-dir unidata-text-file) (or data-dir - (setq data-dir (car command-line-args-left) - command-line-args-left (cdr command-line-args-left) - unidata-text-file (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) + (setq data-dir (pop command-line-args-left) + dest-dir (or (pop command-line-args-left) default-directory) + unidata-text-file (or (pop command-line-args-left) + (expand-file-name "unidata.txt")))) (let ((coding-system-for-write 'utf-8-unix) - (charprop-file "charprop.el") + (charprop-file (expand-file-name "charprop.el" dest-dir)) (unidata-dir data-dir)) (dolist (elt unidata-prop-alist) (let* ((prop (car elt)) - (file (unidata-prop-file prop))) + (file (expand-file-name (unidata-prop-file prop) dest-dir))) (if (file-exists-p file) (delete-file file)))) (unidata-setup-list unidata-text-file) @@ -1196,7 +1236,8 @@ is the character itself."))) (dolist (elt unidata-prop-alist) (let* ((prop (car elt)) (generator (unidata-prop-generator prop)) - (file (unidata-prop-file prop)) + (file (expand-file-name (unidata-prop-file prop) dest-dir)) + (basename (file-name-nondirectory file)) (docstring (unidata-prop-docstring prop)) (describer (unidata-prop-describer prop)) (default-value (unidata-prop-default prop)) @@ -1204,9 +1245,9 @@ is the character itself."))) table) ;; Filename in this comment line is extracted by sed in ;; Makefile. - (insert (format ";; FILE: %s\n" file)) + (insert (format ";; FILE: %s\n" basename)) (insert (format "(define-char-code-property '%S %S\n %S)\n" - prop file docstring)) + prop basename docstring)) (with-temp-buffer (message "Generating %s..." file) (when (file-exists-p file) @@ -1216,30 +1257,35 @@ is the character itself."))) (setq table (funcall generator prop default-value val-list)) (when describer (unless (subrp (symbol-function describer)) - (byte-compile describer) + (unidata--ensure-compiled describer) (setq describer (symbol-function describer))) (set-char-table-extra-slot table 3 describer)) (if (bobp) - (insert ";; Copyright (C) 1991-2009 Unicode, Inc. + (insert ";; Copyright (C) 1991-2013 Unicode, Inc. ;; This file was generated from the Unicode data files at ;; http://www.unicode.org/Public/UNIDATA/. ;; See lisp/international/README for the copyright and permission notice.\n")) - (insert (format "(define-char-code-property '%S %S %S)\n" + (insert (format "(define-char-code-property '%S\n %S\n %S)\n" prop table docstring)) (if (eobp) (insert ";; Local Variables:\n" ";; coding: utf-8\n" + ";; version-control: never\n" ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" ";; End:\n\n" - (format ";; %s ends here\n" file))) + (format ";; %s ends here\n" basename))) (write-file file) (message "Generating %s...done" file)))) (message "Writing %s..." charprop-file) (insert ";; Local Variables:\n" ";; coding: utf-8\n" + ";; version-control: never\n" ";; no-byte-compile: t\n" + ";; no-update-autoloads: t\n" ";; End:\n\n" - (format ";; %s ends here\n" charprop-file))))) + (format ";; %s ends here\n" + (file-name-nondirectory charprop-file)))))) diff --git a/admin/update-copyright b/admin/update-copyright new file mode 100755 index 00000000000..2b33506f9c1 --- /dev/null +++ b/admin/update-copyright @@ -0,0 +1,75 @@ +#! /bin/sh +# Update the copyright dates in Emacs sources. +# Typical usage: +# +# admin/update-copyright +# +# By default, this script uses the local-time calendar year. +# Set the UPDATE_COPYRIGHT_YEAR environment variable to override the default. + +# Copyright 2013-2014 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 . + +# written by Paul Eggert + +# FIXME: The file 'notes/copyright' says that the AIST copyright years +# should be updated, but by inspection it appears that some should be +# updated and some should not be, due to registration numbers, so +# this script leaves these copyright years alone for now. + +: ${UPDATE_COPYRIGHT_USE_INTERVALS=1} +export UPDATE_COPYRIGHT_USE_INTERVALS + +: ${UPDATE_COPYRIGHT_YEAR=$(date +%Y)} +export UPDATE_COPYRIGHT_YEAR + +emacsver=etc/refcards/emacsver.tex +sed 's/\\def\\year[{][0-9]*[}]/\\def\\year{'"$UPDATE_COPYRIGHT_YEAR"'}'/g \ + $emacsver >$emacsver.aux && +{ cmp -s $emacsver $emacsver.aux || + cp $emacsver.aux $emacsver +} && +rm $emacsver.aux && + +bzr_files=$(bzr ls -RV --kind file) && + +# Do not update the copyright of files that have one or more of the +# following problems: +# . They are license files, maintained by the FSF, with their own dates. +# . Their format cannot withstand changing the contents of copyright strings. + +updatable_files=$(find $bzr_files \ + ! -name COPYING \ + ! -name doclicense.texi \ + ! -name gpl.texi \ + ! -name '*-gzipped' \ + ! -name '*.ico' \ + ! -name '*.icns' \ + ! -name '*.pbm' \ + ! -name '*.pdf' \ + ! -name '*.png' \ + ! -name '*.sig' \ + ! -name '*.tar' \ + ! -name '*.tiff' \ + ! -name '*.xpm' \ + ! -name eterm-color \ + ! -name hand.cur \ + ! -name key.pub \ + ! -name key.sec \ + -print) && + +build-aux/update-copyright $updatable_files diff --git a/autogen/update_autogen b/admin/update_autogen similarity index 54% rename from autogen/update_autogen rename to admin/update_autogen index 264d8d83d6d..b9511969a15 100755 --- a/autogen/update_autogen +++ b/admin/update_autogen @@ -1,7 +1,7 @@ #!/bin/bash -### update_autogen - update the generated files in Emacs autogen/ directory +### update_autogen - update some auto-generated files in the Emacs tree -## Copyright (C) 2011-2013 Free Software Foundation, Inc. +## Copyright (C) 2011-2014 Free Software Foundation, Inc. ## Author: Glenn Morris @@ -22,12 +22,12 @@ ### Commentary: -## This is a helper script to update the pre-built generated files in -## the autogen/ directory. This is suitable for running from cron. +## This is a helper script to update some generated files in the Emacs +## repository. This is suitable for running from cron. ## Only Emacs maintainers need use this, so it uses bash features. ## -## With the -l option, it also updates the versioned loaddefs-like -## files in lisp/. These include ldefs-boot, cl-loaddefs, rmail, etc. +## By default, it updates the versioned loaddefs-like files in lisp, +## except ldefs-boot.el. ### Code: @@ -42,24 +42,26 @@ PD=${0%/*} [ "$PD" = "$0" ] && PD=. # if PATH includes PWD -## This should be the autogen directory. +## This should be the admin directory. cd $PD cd ../ -[ -d autogen ] || die "Could not locate autogen directory" +[ -d admin ] || die "Could not locate admin directory" usage () { cat 1>&2 < /dev/null" EXIT -while getopts ":hcflqCL" option ; do +while getopts ":hcfqA:CIL" option ; do case $option in (h) usage ;; @@ -105,12 +113,16 @@ while getopts ":hcflqCL" option ; do (f) force=1 ;; - (l) ldefs_flag=1 ;; - (q) quiet=1 ;; + (A) autogendir=$OPTARG + [ -d "$autogendir" ] || die "No autogen directory: $autogendir" + ;; + (C) clean=1 ;; + (I) info_flag=1 ;; + (L) lboot_flag=1 ;; (\?) die "Bad option -$OPTARG" ;; @@ -128,23 +140,36 @@ OPTIND=1 [ "$quiet" ] && exec 1> /dev/null -echo "Running bzr status..." +## Run status on inputs, list modified files on stdout. +status () +{ + bzr status -S "$@" >| $tempfile || die "bzr status error for $@" -bzr status -S $sources ${ldefs_flag:+lisp} >| $tempfile || \ - die "bzr status error for sources" + local stat file modified + + while read stat file; do + + [ "$stat" != "M" ] && \ + die "Unexpected status ($stat) for generated $file" + modified="$modified $file" + + done < $tempfile + + echo "$modified" + + return 0 +} # function status + + +echo "Checking input file status..." ## The lisp portion could be more permissive, eg only care about .el files. -while read stat file; do +modified=$(status ${autogendir:+$sources} ${ldefs_flag:+lisp} ${info_flag:+doc}) || die - case $stat in - M) - echo "Locally modified: $file" - [ "$force" ] || die "There are local modifications" - ;; - - *) die "Unexpected status ($stat) for $file" ;; - esac -done < $tempfile +[ "$modified" ] && { + echo "Locally modified: $modified" + [ "$force" ] || die "There are local modifications" +} ## Probably this is overkill, and there's no need to "bootstrap" just @@ -175,31 +200,6 @@ fi [ $retval -ne 0 ] && die "autoreconf error" -cp $genfiles autogen/ - - -cd autogen - -echo "Checking status of generated files..." - -bzr status -S $basegen >| $tempfile || \ - die "bzr status error for generated files" - - -modified= - -while read stat file; do - - [ "$stat" != "M" ] && die "Unexpected status ($stat) for generated $file" - - modified="$modified $file" - -done < $tempfile - - -cd ../ - - ## Uses global $commit. commit () { @@ -224,7 +224,82 @@ commit () } # function commit -commit "generated" $modified || die "bzr commit error" +## No longer used since info/dir is now generated at install time if needed, +## and is not in the repository any more. +info_dir () +{ + local basefile=build-aux/dir_top outfile=info/dir + + echo "Regenerating info/dir..." + + ## Header contains non-printing characters, so this is more + ## reliable than using echo. + rm -f $outfile + cp $basefile $outfile + + local topic file dircat dirent + + ## FIXME inefficient looping. + for topic in "Texinfo documentation system" "Emacs" "GNU Emacs Lisp" \ + "Emacs editing modes" "Emacs network features" "Emacs misc features" \ + "Emacs lisp libraries"; do + + cat - <> $outfile + +$topic +EOF + ## Bit faster than doc/*/*.texi. + for file in doc/emacs/emacs.texi doc/lispintro/*.texi \ + doc/lispref/elisp.texi doc/misc/*.texi; do + + ## FIXME do not ignore w32 if OS is w32. + case $file in + *-xtra.texi|*efaq-w32.texi) continue ;; + esac + + dircat=`sed -n -e 's/@value{emacsname}/Emacs/' -e 's/^@dircategory //p' $file` + + ## TODO warn about unknown topics (check-info in top-level + ## Makefile does this). + [ "$dircat" = "$topic" ] || continue + + sed -n -e 's/@value{emacsname}/Emacs/' \ + -e 's/@acronym{\([A-Z]*\)}/\1/' \ + -e '/^@direntry/,/^@end direntry/ s/^\([^@]\)/\1/p' \ + $file >> $outfile + + done + done + + local modified + + modified=$(status $outfile) || die + + commit "info/dir" $modified || die "commit error" +} # function info_dir + + +[ "$autogendir" ] && { + + oldpwd=$PWD + + cp $genfiles $autogendir/ + + cd $autogendir || die "cd error for $autogendir" + + echo "Checking status of generated files..." + + modified=$(status $basegen) || die + + cd $oldpwd + + commit "generated" $modified || die "commit error" + + exit 0 +} # $autogendir + + +[ "$info_flag" ] && info_dir [ "$ldefs_flag" ] || exit 0 @@ -232,8 +307,9 @@ commit "generated" $modified || die "bzr commit error" echo "Finding loaddef targets..." -sed -n -e '/^AUTOGEN_VCS/,/^$/ s/\\//p' lisp/Makefile.in | \ - sed '/AUTOGEN_VCS/d' >| $tempfile || die "sed error" +sed -n -e '/^AUTOGEN_VCS/,/^$/p' lisp/Makefile.in | \ + sed -e '/AUTOGEN_VCS/d' -e '/^$/d' -e 's/\\//' \ + >| $tempfile || die "sed error" genfiles= @@ -285,24 +361,13 @@ echo "Checking status of loaddef files..." ## It probably would be fine to just check+commit lisp/, since ## making autoloads should not effect any other files. But better ## safe than sorry. -bzr status -S $genfiles ${ldefs_out#lisp/} >| $tempfile || \ - die "bzr status error for generated files" - - -modified= - -while read stat file; do - - [ "$stat" != "M" ] && die "Unexpected status ($stat) for generated $file" - modified="$modified $file" - -done < $tempfile +modified=$(status $genfiles ${ldefs_out#lisp/}) || die cd ../ -commit "loaddefs" $modified || die "bzr commit error" +commit "loaddefs" $modified || die "commit error" exit 0 diff --git a/autogen.sh b/autogen.sh index e7c28c16d94..6b7c647c4c5 100755 --- a/autogen.sh +++ b/autogen.sh @@ -1,9 +1,10 @@ #!/bin/sh ### autogen.sh - tool to help build Emacs from a bzr checkout -## Copyright (C) 2011-2013 Free Software Foundation, Inc. +## Copyright (C) 2011-2014 Free Software Foundation, Inc. ## Author: Glenn Morris +## Maintainer: emacs-devel@gnu.org ## This file is part of GNU Emacs. @@ -25,7 +26,7 @@ ## The Emacs bzr repository does not include the configure script ## (and associated helpers). The first time you fetch Emacs from bzr, ## run this script to generate the necessary files. -## For more details, see the file INSTALL.BZR. +## For more details, see the file INSTALL.REPO. ### Code: @@ -105,7 +106,7 @@ check_version () cat <. -# -# As a special exception to the GNU General Public License, -# this file may be distributed as part of a program that -# contains a configuration script generated by Autoconf, under -# 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=build-aux --avoid=dup --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h fdopendir filemode fstatat getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings memrchr mktime pselect pthread_sigmask putenv readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings - -VPATH = @srcdir@ -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \ - $(srcdir)/gnulib.mk COPYING -@gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE@am__append_1 = gettext.h -subdir = lib -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ - $(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \ - $(top_srcdir)/m4/clock_time.m4 \ - $(top_srcdir)/m4/close-stream.m4 $(top_srcdir)/m4/dirent_h.m4 \ - $(top_srcdir)/m4/dup2.m4 $(top_srcdir)/m4/environ.m4 \ - $(top_srcdir)/m4/euidaccess.m4 $(top_srcdir)/m4/execinfo.m4 \ - $(top_srcdir)/m4/extensions.m4 \ - $(top_srcdir)/m4/extern-inline.m4 \ - $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl_h.m4 \ - $(top_srcdir)/m4/fdopendir.m4 $(top_srcdir)/m4/filemode.m4 \ - $(top_srcdir)/m4/fpending.m4 $(top_srcdir)/m4/fstatat.m4 \ - $(top_srcdir)/m4/getgroups.m4 $(top_srcdir)/m4/getloadavg.m4 \ - $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gettime.m4 \ - $(top_srcdir)/m4/gettimeofday.m4 \ - $(top_srcdir)/m4/gnulib-common.m4 \ - $(top_srcdir)/m4/gnulib-comp.m4 \ - $(top_srcdir)/m4/group-member.m4 \ - $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \ - $(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \ - $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/manywarnings.m4 \ - $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/memrchr.m4 \ - $(top_srcdir)/m4/mktime.m4 $(top_srcdir)/m4/multiarch.m4 \ - $(top_srcdir)/m4/nocrash.m4 $(top_srcdir)/m4/off_t.m4 \ - $(top_srcdir)/m4/pathmax.m4 $(top_srcdir)/m4/pselect.m4 \ - $(top_srcdir)/m4/pthread_sigmask.m4 $(top_srcdir)/m4/putenv.m4 \ - $(top_srcdir)/m4/readlink.m4 $(top_srcdir)/m4/readlinkat.m4 \ - $(top_srcdir)/m4/setenv.m4 $(top_srcdir)/m4/sha1.m4 \ - $(top_srcdir)/m4/sha256.m4 $(top_srcdir)/m4/sha512.m4 \ - $(top_srcdir)/m4/sig2str.m4 $(top_srcdir)/m4/signal_h.m4 \ - $(top_srcdir)/m4/socklen.m4 $(top_srcdir)/m4/ssize_t.m4 \ - $(top_srcdir)/m4/st_dm_mode.m4 $(top_srcdir)/m4/stat-time.m4 \ - $(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdalign.m4 \ - $(top_srcdir)/m4/stdarg.m4 $(top_srcdir)/m4/stdbool.m4 \ - $(top_srcdir)/m4/stddef_h.m4 $(top_srcdir)/m4/stdint.m4 \ - $(top_srcdir)/m4/stdio_h.m4 $(top_srcdir)/m4/stdlib_h.m4 \ - $(top_srcdir)/m4/strftime.m4 $(top_srcdir)/m4/string_h.m4 \ - $(top_srcdir)/m4/strtoimax.m4 $(top_srcdir)/m4/strtoll.m4 \ - $(top_srcdir)/m4/strtoull.m4 $(top_srcdir)/m4/strtoumax.m4 \ - $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_select_h.m4 \ - $(top_srcdir)/m4/sys_socket_h.m4 \ - $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_time_h.m4 \ - $(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \ - $(top_srcdir)/m4/timer_time.m4 $(top_srcdir)/m4/timespec.m4 \ - $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \ - $(top_srcdir)/m4/utimbuf.m4 $(top_srcdir)/m4/utimens.m4 \ - $(top_srcdir)/m4/utimes.m4 $(top_srcdir)/m4/warnings.m4 \ - $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -mkinstalldirs = $(install_sh) -d -CONFIG_HEADER = $(top_builddir)/src/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -LIBRARIES = $(noinst_LIBRARIES) -libgnu_a_AR = $(AR) $(ARFLAGS) -am__DEPENDENCIES_1 = -am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \ - c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \ - close-stream.c md5.c sha1.c sha256.c sha512.c dtoastr.c \ - dtotimespec.c filemode.c gettext.h gettime.c stat-time.c \ - strftime.c timespec.c timespec-add.c timespec-sub.c u64.c \ - unistd.c utimens.c openat-die.c save-cwd.c -am__objects_1 = -am_libgnu_a_OBJECTS = allocator.$(OBJEXT) c-ctype.$(OBJEXT) \ - c-strcasecmp.$(OBJEXT) c-strncasecmp.$(OBJEXT) \ - careadlinkat.$(OBJEXT) close-stream.$(OBJEXT) md5.$(OBJEXT) \ - sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \ - dtoastr.$(OBJEXT) dtotimespec.$(OBJEXT) filemode.$(OBJEXT) \ - $(am__objects_1) gettime.$(OBJEXT) stat-time.$(OBJEXT) \ - strftime.$(OBJEXT) timespec.$(OBJEXT) timespec-add.$(OBJEXT) \ - timespec-sub.$(OBJEXT) u64.$(OBJEXT) unistd.$(OBJEXT) \ - utimens.$(OBJEXT) openat-die.$(OBJEXT) save-cwd.$(OBJEXT) -libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS) -depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp -am__depfiles_maybe = depfiles -am__mv = mv -f -COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ - $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -CCLD = $(CC) -LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ -SOURCES = $(libgnu_a_SOURCES) $(EXTRA_libgnu_a_SOURCES) -DIST_SOURCES = $(am__libgnu_a_SOURCES_DIST) $(EXTRA_libgnu_a_SOURCES) -ETAGS = etags -CTAGS = ctags -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -ALLOCA = @ALLOCA@ -ALLOCA_H = @ALLOCA_H@ -ALSA_CFLAGS = @ALSA_CFLAGS@ -ALSA_LIBS = @ALSA_LIBS@ -AMTAR = @AMTAR@ -APPLE_UNIVERSAL_BUILD = @APPLE_UNIVERSAL_BUILD@ -AR = @AR@ -ARFLAGS = @ARFLAGS@ -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@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CFLAGS_SOUND = @CFLAGS_SOUND@ -COM_ERRLIB = @COM_ERRLIB@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CRYPTOLIB = @CRYPTOLIB@ -CYGPATH_W = @CYGPATH_W@ -CYGWIN_OBJ = @CYGWIN_OBJ@ -C_SWITCH_MACHINE = @C_SWITCH_MACHINE@ -C_SWITCH_SYSTEM = @C_SWITCH_SYSTEM@ -C_SWITCH_X_SITE = @C_SWITCH_X_SITE@ -DBUS_CFLAGS = @DBUS_CFLAGS@ -DBUS_LIBS = @DBUS_LIBS@ -DBUS_OBJ = @DBUS_OBJ@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DEPFLAGS = @DEPFLAGS@ -DESLIB = @DESLIB@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXECINFO_H = @EXECINFO_H@ -EXEEXT = @EXEEXT@ -FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ -FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ -FONT_OBJ = @FONT_OBJ@ -FREETYPE_CFLAGS = @FREETYPE_CFLAGS@ -FREETYPE_LIBS = @FREETYPE_LIBS@ -GCONF_CFLAGS = @GCONF_CFLAGS@ -GCONF_LIBS = @GCONF_LIBS@ -GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ -GETOPT_H = @GETOPT_H@ -GMALLOC_OBJ = @GMALLOC_OBJ@ -GNULIB_ALPHASORT = @GNULIB_ALPHASORT@ -GNULIB_ATOLL = @GNULIB_ATOLL@ -GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@ -GNULIB_CANONICALIZE_FILE_NAME = @GNULIB_CANONICALIZE_FILE_NAME@ -GNULIB_CHDIR = @GNULIB_CHDIR@ -GNULIB_CHOWN = @GNULIB_CHOWN@ -GNULIB_CLOSE = @GNULIB_CLOSE@ -GNULIB_CLOSEDIR = @GNULIB_CLOSEDIR@ -GNULIB_DIRFD = @GNULIB_DIRFD@ -GNULIB_DPRINTF = @GNULIB_DPRINTF@ -GNULIB_DUP = @GNULIB_DUP@ -GNULIB_DUP2 = @GNULIB_DUP2@ -GNULIB_DUP3 = @GNULIB_DUP3@ -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_FCLOSE = @GNULIB_FCLOSE@ -GNULIB_FCNTL = @GNULIB_FCNTL@ -GNULIB_FDATASYNC = @GNULIB_FDATASYNC@ -GNULIB_FDOPEN = @GNULIB_FDOPEN@ -GNULIB_FDOPENDIR = @GNULIB_FDOPENDIR@ -GNULIB_FFLUSH = @GNULIB_FFLUSH@ -GNULIB_FFSL = @GNULIB_FFSL@ -GNULIB_FFSLL = @GNULIB_FFSLL@ -GNULIB_FGETC = @GNULIB_FGETC@ -GNULIB_FGETS = @GNULIB_FGETS@ -GNULIB_FOPEN = @GNULIB_FOPEN@ -GNULIB_FPRINTF = @GNULIB_FPRINTF@ -GNULIB_FPRINTF_POSIX = @GNULIB_FPRINTF_POSIX@ -GNULIB_FPURGE = @GNULIB_FPURGE@ -GNULIB_FPUTC = @GNULIB_FPUTC@ -GNULIB_FPUTS = @GNULIB_FPUTS@ -GNULIB_FREAD = @GNULIB_FREAD@ -GNULIB_FREOPEN = @GNULIB_FREOPEN@ -GNULIB_FSCANF = @GNULIB_FSCANF@ -GNULIB_FSEEK = @GNULIB_FSEEK@ -GNULIB_FSEEKO = @GNULIB_FSEEKO@ -GNULIB_FSTAT = @GNULIB_FSTAT@ -GNULIB_FSTATAT = @GNULIB_FSTATAT@ -GNULIB_FSYNC = @GNULIB_FSYNC@ -GNULIB_FTELL = @GNULIB_FTELL@ -GNULIB_FTELLO = @GNULIB_FTELLO@ -GNULIB_FTRUNCATE = @GNULIB_FTRUNCATE@ -GNULIB_FUTIMENS = @GNULIB_FUTIMENS@ -GNULIB_FWRITE = @GNULIB_FWRITE@ -GNULIB_GETC = @GNULIB_GETC@ -GNULIB_GETCHAR = @GNULIB_GETCHAR@ -GNULIB_GETCWD = @GNULIB_GETCWD@ -GNULIB_GETDELIM = @GNULIB_GETDELIM@ -GNULIB_GETDOMAINNAME = @GNULIB_GETDOMAINNAME@ -GNULIB_GETDTABLESIZE = @GNULIB_GETDTABLESIZE@ -GNULIB_GETGROUPS = @GNULIB_GETGROUPS@ -GNULIB_GETHOSTNAME = @GNULIB_GETHOSTNAME@ -GNULIB_GETLINE = @GNULIB_GETLINE@ -GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@ -GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ -GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ -GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ -GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ -GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@ -GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ -GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@ -GNULIB_GRANTPT = @GNULIB_GRANTPT@ -GNULIB_GROUP_MEMBER = @GNULIB_GROUP_MEMBER@ -GNULIB_IMAXABS = @GNULIB_IMAXABS@ -GNULIB_IMAXDIV = @GNULIB_IMAXDIV@ -GNULIB_ISATTY = @GNULIB_ISATTY@ -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_MBSCASECMP = @GNULIB_MBSCASECMP@ -GNULIB_MBSCASESTR = @GNULIB_MBSCASESTR@ -GNULIB_MBSCHR = @GNULIB_MBSCHR@ -GNULIB_MBSCSPN = @GNULIB_MBSCSPN@ -GNULIB_MBSLEN = @GNULIB_MBSLEN@ -GNULIB_MBSNCASECMP = @GNULIB_MBSNCASECMP@ -GNULIB_MBSNLEN = @GNULIB_MBSNLEN@ -GNULIB_MBSPBRK = @GNULIB_MBSPBRK@ -GNULIB_MBSPCASECMP = @GNULIB_MBSPCASECMP@ -GNULIB_MBSRCHR = @GNULIB_MBSRCHR@ -GNULIB_MBSSEP = @GNULIB_MBSSEP@ -GNULIB_MBSSPN = @GNULIB_MBSSPN@ -GNULIB_MBSSTR = @GNULIB_MBSSTR@ -GNULIB_MBSTOK_R = @GNULIB_MBSTOK_R@ -GNULIB_MBTOWC = @GNULIB_MBTOWC@ -GNULIB_MEMCHR = @GNULIB_MEMCHR@ -GNULIB_MEMMEM = @GNULIB_MEMMEM@ -GNULIB_MEMPCPY = @GNULIB_MEMPCPY@ -GNULIB_MEMRCHR = @GNULIB_MEMRCHR@ -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_NONBLOCKING = @GNULIB_NONBLOCKING@ -GNULIB_OBSTACK_PRINTF = @GNULIB_OBSTACK_PRINTF@ -GNULIB_OBSTACK_PRINTF_POSIX = @GNULIB_OBSTACK_PRINTF_POSIX@ -GNULIB_OPEN = @GNULIB_OPEN@ -GNULIB_OPENAT = @GNULIB_OPENAT@ -GNULIB_OPENDIR = @GNULIB_OPENDIR@ -GNULIB_PCLOSE = @GNULIB_PCLOSE@ -GNULIB_PERROR = @GNULIB_PERROR@ -GNULIB_PIPE = @GNULIB_PIPE@ -GNULIB_PIPE2 = @GNULIB_PIPE2@ -GNULIB_POPEN = @GNULIB_POPEN@ -GNULIB_POSIX_OPENPT = @GNULIB_POSIX_OPENPT@ -GNULIB_PREAD = @GNULIB_PREAD@ -GNULIB_PRINTF = @GNULIB_PRINTF@ -GNULIB_PRINTF_POSIX = @GNULIB_PRINTF_POSIX@ -GNULIB_PSELECT = @GNULIB_PSELECT@ -GNULIB_PTHREAD_SIGMASK = @GNULIB_PTHREAD_SIGMASK@ -GNULIB_PTSNAME = @GNULIB_PTSNAME@ -GNULIB_PTSNAME_R = @GNULIB_PTSNAME_R@ -GNULIB_PUTC = @GNULIB_PUTC@ -GNULIB_PUTCHAR = @GNULIB_PUTCHAR@ -GNULIB_PUTENV = @GNULIB_PUTENV@ -GNULIB_PUTS = @GNULIB_PUTS@ -GNULIB_PWRITE = @GNULIB_PWRITE@ -GNULIB_RAISE = @GNULIB_RAISE@ -GNULIB_RANDOM = @GNULIB_RANDOM@ -GNULIB_RANDOM_R = @GNULIB_RANDOM_R@ -GNULIB_RAWMEMCHR = @GNULIB_RAWMEMCHR@ -GNULIB_READ = @GNULIB_READ@ -GNULIB_READDIR = @GNULIB_READDIR@ -GNULIB_READLINK = @GNULIB_READLINK@ -GNULIB_READLINKAT = @GNULIB_READLINKAT@ -GNULIB_REALLOC_POSIX = @GNULIB_REALLOC_POSIX@ -GNULIB_REALPATH = @GNULIB_REALPATH@ -GNULIB_REMOVE = @GNULIB_REMOVE@ -GNULIB_RENAME = @GNULIB_RENAME@ -GNULIB_RENAMEAT = @GNULIB_RENAMEAT@ -GNULIB_REWINDDIR = @GNULIB_REWINDDIR@ -GNULIB_RMDIR = @GNULIB_RMDIR@ -GNULIB_RPMATCH = @GNULIB_RPMATCH@ -GNULIB_SCANDIR = @GNULIB_SCANDIR@ -GNULIB_SCANF = @GNULIB_SCANF@ -GNULIB_SECURE_GETENV = @GNULIB_SECURE_GETENV@ -GNULIB_SELECT = @GNULIB_SELECT@ -GNULIB_SETENV = @GNULIB_SETENV@ -GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@ -GNULIB_SIGACTION = @GNULIB_SIGACTION@ -GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@ -GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@ -GNULIB_SLEEP = @GNULIB_SLEEP@ -GNULIB_SNPRINTF = @GNULIB_SNPRINTF@ -GNULIB_SPRINTF_POSIX = @GNULIB_SPRINTF_POSIX@ -GNULIB_STAT = @GNULIB_STAT@ -GNULIB_STDIO_H_NONBLOCKING = @GNULIB_STDIO_H_NONBLOCKING@ -GNULIB_STDIO_H_SIGPIPE = @GNULIB_STDIO_H_SIGPIPE@ -GNULIB_STPCPY = @GNULIB_STPCPY@ -GNULIB_STPNCPY = @GNULIB_STPNCPY@ -GNULIB_STRCASESTR = @GNULIB_STRCASESTR@ -GNULIB_STRCHRNUL = @GNULIB_STRCHRNUL@ -GNULIB_STRDUP = @GNULIB_STRDUP@ -GNULIB_STRERROR = @GNULIB_STRERROR@ -GNULIB_STRERROR_R = @GNULIB_STRERROR_R@ -GNULIB_STRNCAT = @GNULIB_STRNCAT@ -GNULIB_STRNDUP = @GNULIB_STRNDUP@ -GNULIB_STRNLEN = @GNULIB_STRNLEN@ -GNULIB_STRPBRK = @GNULIB_STRPBRK@ -GNULIB_STRPTIME = @GNULIB_STRPTIME@ -GNULIB_STRSEP = @GNULIB_STRSEP@ -GNULIB_STRSIGNAL = @GNULIB_STRSIGNAL@ -GNULIB_STRSTR = @GNULIB_STRSTR@ -GNULIB_STRTOD = @GNULIB_STRTOD@ -GNULIB_STRTOIMAX = @GNULIB_STRTOIMAX@ -GNULIB_STRTOK_R = @GNULIB_STRTOK_R@ -GNULIB_STRTOLL = @GNULIB_STRTOLL@ -GNULIB_STRTOULL = @GNULIB_STRTOULL@ -GNULIB_STRTOUMAX = @GNULIB_STRTOUMAX@ -GNULIB_STRVERSCMP = @GNULIB_STRVERSCMP@ -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_TMPFILE = @GNULIB_TMPFILE@ -GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@ -GNULIB_UNISTD_H_NONBLOCKING = @GNULIB_UNISTD_H_NONBLOCKING@ -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_VASPRINTF = @GNULIB_VASPRINTF@ -GNULIB_VDPRINTF = @GNULIB_VDPRINTF@ -GNULIB_VFPRINTF = @GNULIB_VFPRINTF@ -GNULIB_VFPRINTF_POSIX = @GNULIB_VFPRINTF_POSIX@ -GNULIB_VFSCANF = @GNULIB_VFSCANF@ -GNULIB_VPRINTF = @GNULIB_VPRINTF@ -GNULIB_VPRINTF_POSIX = @GNULIB_VPRINTF_POSIX@ -GNULIB_VSCANF = @GNULIB_VSCANF@ -GNULIB_VSNPRINTF = @GNULIB_VSNPRINTF@ -GNULIB_VSPRINTF_POSIX = @GNULIB_VSPRINTF_POSIX@ -GNULIB_WARN_CFLAGS = @GNULIB_WARN_CFLAGS@ -GNULIB_WCTOMB = @GNULIB_WCTOMB@ -GNULIB_WRITE = @GNULIB_WRITE@ -GNULIB__EXIT = @GNULIB__EXIT@ -GNUSTEP_CFLAGS = @GNUSTEP_CFLAGS@ -GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@ -GOBJECT_CFLAGS = @GOBJECT_CFLAGS@ -GOBJECT_LIBS = @GOBJECT_LIBS@ -GREP = @GREP@ -GSETTINGS_CFLAGS = @GSETTINGS_CFLAGS@ -GSETTINGS_LIBS = @GSETTINGS_LIBS@ -GTK_CFLAGS = @GTK_CFLAGS@ -GTK_LIBS = @GTK_LIBS@ -GTK_OBJ = @GTK_OBJ@ -GZIP_INFO = @GZIP_INFO@ -GZIP_PROG = @GZIP_PROG@ -HAVE_ALPHASORT = @HAVE_ALPHASORT@ -HAVE_ATOLL = @HAVE_ATOLL@ -HAVE_CANONICALIZE_FILE_NAME = @HAVE_CANONICALIZE_FILE_NAME@ -HAVE_CHOWN = @HAVE_CHOWN@ -HAVE_CLOSEDIR = @HAVE_CLOSEDIR@ -HAVE_DECL_DIRFD = @HAVE_DECL_DIRFD@ -HAVE_DECL_ENVIRON = @HAVE_DECL_ENVIRON@ -HAVE_DECL_FCHDIR = @HAVE_DECL_FCHDIR@ -HAVE_DECL_FDATASYNC = @HAVE_DECL_FDATASYNC@ -HAVE_DECL_FDOPENDIR = @HAVE_DECL_FDOPENDIR@ -HAVE_DECL_FPURGE = @HAVE_DECL_FPURGE@ -HAVE_DECL_FSEEKO = @HAVE_DECL_FSEEKO@ -HAVE_DECL_FTELLO = @HAVE_DECL_FTELLO@ -HAVE_DECL_GETDELIM = @HAVE_DECL_GETDELIM@ -HAVE_DECL_GETDOMAINNAME = @HAVE_DECL_GETDOMAINNAME@ -HAVE_DECL_GETLINE = @HAVE_DECL_GETLINE@ -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_IMAXABS = @HAVE_DECL_IMAXABS@ -HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@ -HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@ -HAVE_DECL_MEMMEM = @HAVE_DECL_MEMMEM@ -HAVE_DECL_MEMRCHR = @HAVE_DECL_MEMRCHR@ -HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@ -HAVE_DECL_SETENV = @HAVE_DECL_SETENV@ -HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@ -HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@ -HAVE_DECL_STRDUP = @HAVE_DECL_STRDUP@ -HAVE_DECL_STRERROR_R = @HAVE_DECL_STRERROR_R@ -HAVE_DECL_STRNDUP = @HAVE_DECL_STRNDUP@ -HAVE_DECL_STRNLEN = @HAVE_DECL_STRNLEN@ -HAVE_DECL_STRSIGNAL = @HAVE_DECL_STRSIGNAL@ -HAVE_DECL_STRTOIMAX = @HAVE_DECL_STRTOIMAX@ -HAVE_DECL_STRTOK_R = @HAVE_DECL_STRTOK_R@ -HAVE_DECL_STRTOUMAX = @HAVE_DECL_STRTOUMAX@ -HAVE_DECL_TTYNAME_R = @HAVE_DECL_TTYNAME_R@ -HAVE_DECL_UNSETENV = @HAVE_DECL_UNSETENV@ -HAVE_DECL_VSNPRINTF = @HAVE_DECL_VSNPRINTF@ -HAVE_DIRENT_H = @HAVE_DIRENT_H@ -HAVE_DPRINTF = @HAVE_DPRINTF@ -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_FCNTL = @HAVE_FCNTL@ -HAVE_FDATASYNC = @HAVE_FDATASYNC@ -HAVE_FDOPENDIR = @HAVE_FDOPENDIR@ -HAVE_FFSL = @HAVE_FFSL@ -HAVE_FFSLL = @HAVE_FFSLL@ -HAVE_FSEEKO = @HAVE_FSEEKO@ -HAVE_FSTATAT = @HAVE_FSTATAT@ -HAVE_FSYNC = @HAVE_FSYNC@ -HAVE_FTELLO = @HAVE_FTELLO@ -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_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ -HAVE_GRANTPT = @HAVE_GRANTPT@ -HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@ -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_MBSLEN = @HAVE_MBSLEN@ -HAVE_MEMCHR = @HAVE_MEMCHR@ -HAVE_MEMPCPY = @HAVE_MEMPCPY@ -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_OPENAT = @HAVE_OPENAT@ -HAVE_OPENDIR = @HAVE_OPENDIR@ -HAVE_OS_H = @HAVE_OS_H@ -HAVE_PCLOSE = @HAVE_PCLOSE@ -HAVE_PIPE = @HAVE_PIPE@ -HAVE_PIPE2 = @HAVE_PIPE2@ -HAVE_POPEN = @HAVE_POPEN@ -HAVE_POSIX_OPENPT = @HAVE_POSIX_OPENPT@ -HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@ -HAVE_PREAD = @HAVE_PREAD@ -HAVE_PSELECT = @HAVE_PSELECT@ -HAVE_PTHREAD_SIGMASK = @HAVE_PTHREAD_SIGMASK@ -HAVE_PTSNAME = @HAVE_PTSNAME@ -HAVE_PTSNAME_R = @HAVE_PTSNAME_R@ -HAVE_PWRITE = @HAVE_PWRITE@ -HAVE_RAISE = @HAVE_RAISE@ -HAVE_RANDOM = @HAVE_RANDOM@ -HAVE_RANDOM_H = @HAVE_RANDOM_H@ -HAVE_RANDOM_R = @HAVE_RANDOM_R@ -HAVE_RAWMEMCHR = @HAVE_RAWMEMCHR@ -HAVE_READDIR = @HAVE_READDIR@ -HAVE_READLINK = @HAVE_READLINK@ -HAVE_READLINKAT = @HAVE_READLINKAT@ -HAVE_REALPATH = @HAVE_REALPATH@ -HAVE_RENAMEAT = @HAVE_RENAMEAT@ -HAVE_REWINDDIR = @HAVE_REWINDDIR@ -HAVE_RPMATCH = @HAVE_RPMATCH@ -HAVE_SCANDIR = @HAVE_SCANDIR@ -HAVE_SECURE_GETENV = @HAVE_SECURE_GETENV@ -HAVE_SETENV = @HAVE_SETENV@ -HAVE_SETHOSTNAME = @HAVE_SETHOSTNAME@ -HAVE_SIGACTION = @HAVE_SIGACTION@ -HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@ -HAVE_SIGINFO_T = @HAVE_SIGINFO_T@ -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_SIGSET_T = @HAVE_SIGSET_T@ -HAVE_SLEEP = @HAVE_SLEEP@ -HAVE_STDINT_H = @HAVE_STDINT_H@ -HAVE_STPCPY = @HAVE_STPCPY@ -HAVE_STPNCPY = @HAVE_STPNCPY@ -HAVE_STRCASESTR = @HAVE_STRCASESTR@ -HAVE_STRCHRNUL = @HAVE_STRCHRNUL@ -HAVE_STRPBRK = @HAVE_STRPBRK@ -HAVE_STRPTIME = @HAVE_STRPTIME@ -HAVE_STRSEP = @HAVE_STRSEP@ -HAVE_STRTOD = @HAVE_STRTOD@ -HAVE_STRTOLL = @HAVE_STRTOLL@ -HAVE_STRTOULL = @HAVE_STRTOULL@ -HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@ -HAVE_STRUCT_SIGACTION_SA_SIGACTION = @HAVE_STRUCT_SIGACTION_SA_SIGACTION@ -HAVE_STRUCT_TIMEVAL = @HAVE_STRUCT_TIMEVAL@ -HAVE_STRVERSCMP = @HAVE_STRVERSCMP@ -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_SELECT_H = @HAVE_SYS_SELECT_H@ -HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@ -HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@ -HAVE_TIMEGM = @HAVE_TIMEGM@ -HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@ -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_VASPRINTF = @HAVE_VASPRINTF@ -HAVE_VDPRINTF = @HAVE_VDPRINTF@ -HAVE_WCHAR_H = @HAVE_WCHAR_H@ -HAVE_WCHAR_T = @HAVE_WCHAR_T@ -HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@ -HAVE_XSERVER = @HAVE_XSERVER@ -HAVE__BOOL = @HAVE__BOOL@ -HAVE__EXIT = @HAVE__EXIT@ -IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@ -IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@ -INCLUDE_NEXT = @INCLUDE_NEXT@ -INCLUDE_NEXT_AS_FIRST_DIRECTIVE = @INCLUDE_NEXT_AS_FIRST_DIRECTIVE@ -INFO_EXT = @INFO_EXT@ -INFO_OPTS = @INFO_OPTS@ -INSTALL = @INSTALL@ -INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_INFO = @INSTALL_INFO@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INT32_MAX_LT_INTMAX_MAX = @INT32_MAX_LT_INTMAX_MAX@ -INT64_MAX_EQ_LONG_MAX = @INT64_MAX_EQ_LONG_MAX@ -KRB4LIB = @KRB4LIB@ -KRB5LIB = @KRB5LIB@ -LDFLAGS = @LDFLAGS@ -LD_SWITCH_SYSTEM = @LD_SWITCH_SYSTEM@ -LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@ -LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@ -LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@ -LIBACL_LIBS = @LIBACL_LIBS@ -LIBGIF = @LIBGIF@ -LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ -LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@ -LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@ -LIBGNU_LTLIBDEPS = @LIBGNU_LTLIBDEPS@ -LIBGPM = @LIBGPM@ -LIBHESIOD = @LIBHESIOD@ -LIBINTL = @LIBINTL@ -LIBJPEG = @LIBJPEG@ -LIBOBJS = @LIBOBJS@ -LIBOTF_CFLAGS = @LIBOTF_CFLAGS@ -LIBOTF_LIBS = @LIBOTF_LIBS@ -LIBPNG = @LIBPNG@ -LIBRESOLV = @LIBRESOLV@ -LIBS = @LIBS@ -LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ -LIBSOUND = @LIBSOUND@ -LIBS_GNUSTEP = @LIBS_GNUSTEP@ -LIBS_MAIL = @LIBS_MAIL@ -LIBS_SYSTEM = @LIBS_SYSTEM@ -LIBS_TERMCAP = @LIBS_TERMCAP@ -LIBTIFF = @LIBTIFF@ -LIBXMENU = @LIBXMENU@ -LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ -LIBXML2_LIBS = @LIBXML2_LIBS@ -LIBXMU = @LIBXMU@ -LIBXPM = @LIBXPM@ -LIBXSM = @LIBXSM@ -LIBXTR6 = @LIBXTR6@ -LIBXT_OTHER = @LIBXT_OTHER@ -LIBX_OTHER = @LIBX_OTHER@ -LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ -LIB_EACCESS = @LIB_EACCESS@ -LIB_EXECINFO = @LIB_EXECINFO@ -LIB_MATH = @LIB_MATH@ -LIB_PTHREAD = @LIB_PTHREAD@ -LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ -LIB_TIMER_TIME = @LIB_TIMER_TIME@ -LN_S = @LN_S@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ -M17N_FLT_LIBS = @M17N_FLT_LIBS@ -MAKEINFO = @MAKEINFO@ -MKDEPDIR = @MKDEPDIR@ -MKDIR_P = @MKDIR_P@ -NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@ -NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@ -NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ -NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@ -NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@ -NEXT_AS_FIRST_DIRECTIVE_STDARG_H = @NEXT_AS_FIRST_DIRECTIVE_STDARG_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_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@ -NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@ -NEXT_AS_FIRST_DIRECTIVE_STRING_H = @NEXT_AS_FIRST_DIRECTIVE_STRING_H@ -NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H@ -NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@ -NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_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_DIRENT_H = @NEXT_DIRENT_H@ -NEXT_FCNTL_H = @NEXT_FCNTL_H@ -NEXT_GETOPT_H = @NEXT_GETOPT_H@ -NEXT_INTTYPES_H = @NEXT_INTTYPES_H@ -NEXT_SIGNAL_H = @NEXT_SIGNAL_H@ -NEXT_STDARG_H = @NEXT_STDARG_H@ -NEXT_STDDEF_H = @NEXT_STDDEF_H@ -NEXT_STDINT_H = @NEXT_STDINT_H@ -NEXT_STDIO_H = @NEXT_STDIO_H@ -NEXT_STDLIB_H = @NEXT_STDLIB_H@ -NEXT_STRING_H = @NEXT_STRING_H@ -NEXT_SYS_SELECT_H = @NEXT_SYS_SELECT_H@ -NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@ -NEXT_SYS_TIME_H = @NEXT_SYS_TIME_H@ -NEXT_TIME_H = @NEXT_TIME_H@ -NEXT_UNISTD_H = @NEXT_UNISTD_H@ -NS_OBJ = @NS_OBJ@ -NS_OBJC_OBJ = @NS_OBJC_OBJ@ -OBJEXT = @OBJEXT@ -OLDXMENU = @OLDXMENU@ -OLDXMENU_DEPS = @OLDXMENU_DEPS@ -OLDXMENU_TARGET = @OLDXMENU_TARGET@ -OTHER_FILES = @OTHER_FILES@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PAXCTL = @PAXCTL@ -PKG_CONFIG = @PKG_CONFIG@ -POST_ALLOC_OBJ = @POST_ALLOC_OBJ@ -PRAGMA_COLUMNS = @PRAGMA_COLUMNS@ -PRAGMA_SYSTEM_HEADER = @PRAGMA_SYSTEM_HEADER@ -PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@ -PRIPTR_PREFIX = @PRIPTR_PREFIX@ -PRI_MACROS_BROKEN = @PRI_MACROS_BROKEN@ -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_CLOSEDIR = @REPLACE_CLOSEDIR@ -REPLACE_DIRFD = @REPLACE_DIRFD@ -REPLACE_DPRINTF = @REPLACE_DPRINTF@ -REPLACE_DUP = @REPLACE_DUP@ -REPLACE_DUP2 = @REPLACE_DUP2@ -REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ -REPLACE_FCLOSE = @REPLACE_FCLOSE@ -REPLACE_FCNTL = @REPLACE_FCNTL@ -REPLACE_FDOPEN = @REPLACE_FDOPEN@ -REPLACE_FDOPENDIR = @REPLACE_FDOPENDIR@ -REPLACE_FFLUSH = @REPLACE_FFLUSH@ -REPLACE_FOPEN = @REPLACE_FOPEN@ -REPLACE_FPRINTF = @REPLACE_FPRINTF@ -REPLACE_FPURGE = @REPLACE_FPURGE@ -REPLACE_FREOPEN = @REPLACE_FREOPEN@ -REPLACE_FSEEK = @REPLACE_FSEEK@ -REPLACE_FSEEKO = @REPLACE_FSEEKO@ -REPLACE_FSTAT = @REPLACE_FSTAT@ -REPLACE_FSTATAT = @REPLACE_FSTATAT@ -REPLACE_FTELL = @REPLACE_FTELL@ -REPLACE_FTELLO = @REPLACE_FTELLO@ -REPLACE_FTRUNCATE = @REPLACE_FTRUNCATE@ -REPLACE_FUTIMENS = @REPLACE_FUTIMENS@ -REPLACE_GETCWD = @REPLACE_GETCWD@ -REPLACE_GETDELIM = @REPLACE_GETDELIM@ -REPLACE_GETDOMAINNAME = @REPLACE_GETDOMAINNAME@ -REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ -REPLACE_GETLINE = @REPLACE_GETLINE@ -REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@ -REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@ -REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ -REPLACE_ISATTY = @REPLACE_ISATTY@ -REPLACE_LCHOWN = @REPLACE_LCHOWN@ -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_MBTOWC = @REPLACE_MBTOWC@ -REPLACE_MEMCHR = @REPLACE_MEMCHR@ -REPLACE_MEMMEM = @REPLACE_MEMMEM@ -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_OBSTACK_PRINTF = @REPLACE_OBSTACK_PRINTF@ -REPLACE_OPEN = @REPLACE_OPEN@ -REPLACE_OPENAT = @REPLACE_OPENAT@ -REPLACE_OPENDIR = @REPLACE_OPENDIR@ -REPLACE_PERROR = @REPLACE_PERROR@ -REPLACE_POPEN = @REPLACE_POPEN@ -REPLACE_PREAD = @REPLACE_PREAD@ -REPLACE_PRINTF = @REPLACE_PRINTF@ -REPLACE_PSELECT = @REPLACE_PSELECT@ -REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@ -REPLACE_PTSNAME = @REPLACE_PTSNAME@ -REPLACE_PTSNAME_R = @REPLACE_PTSNAME_R@ -REPLACE_PUTENV = @REPLACE_PUTENV@ -REPLACE_PWRITE = @REPLACE_PWRITE@ -REPLACE_RAISE = @REPLACE_RAISE@ -REPLACE_RANDOM_R = @REPLACE_RANDOM_R@ -REPLACE_READ = @REPLACE_READ@ -REPLACE_READLINK = @REPLACE_READLINK@ -REPLACE_REALLOC = @REPLACE_REALLOC@ -REPLACE_REALPATH = @REPLACE_REALPATH@ -REPLACE_REMOVE = @REPLACE_REMOVE@ -REPLACE_RENAME = @REPLACE_RENAME@ -REPLACE_RENAMEAT = @REPLACE_RENAMEAT@ -REPLACE_RMDIR = @REPLACE_RMDIR@ -REPLACE_SELECT = @REPLACE_SELECT@ -REPLACE_SETENV = @REPLACE_SETENV@ -REPLACE_SLEEP = @REPLACE_SLEEP@ -REPLACE_SNPRINTF = @REPLACE_SNPRINTF@ -REPLACE_SPRINTF = @REPLACE_SPRINTF@ -REPLACE_STAT = @REPLACE_STAT@ -REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@ -REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@ -REPLACE_STPNCPY = @REPLACE_STPNCPY@ -REPLACE_STRCASESTR = @REPLACE_STRCASESTR@ -REPLACE_STRCHRNUL = @REPLACE_STRCHRNUL@ -REPLACE_STRDUP = @REPLACE_STRDUP@ -REPLACE_STRERROR = @REPLACE_STRERROR@ -REPLACE_STRERROR_R = @REPLACE_STRERROR_R@ -REPLACE_STRNCAT = @REPLACE_STRNCAT@ -REPLACE_STRNDUP = @REPLACE_STRNDUP@ -REPLACE_STRNLEN = @REPLACE_STRNLEN@ -REPLACE_STRSIGNAL = @REPLACE_STRSIGNAL@ -REPLACE_STRSTR = @REPLACE_STRSTR@ -REPLACE_STRTOD = @REPLACE_STRTOD@ -REPLACE_STRTOIMAX = @REPLACE_STRTOIMAX@ -REPLACE_STRTOK_R = @REPLACE_STRTOK_R@ -REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@ -REPLACE_SYMLINK = @REPLACE_SYMLINK@ -REPLACE_TIMEGM = @REPLACE_TIMEGM@ -REPLACE_TMPFILE = @REPLACE_TMPFILE@ -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_VASPRINTF = @REPLACE_VASPRINTF@ -REPLACE_VDPRINTF = @REPLACE_VDPRINTF@ -REPLACE_VFPRINTF = @REPLACE_VFPRINTF@ -REPLACE_VPRINTF = @REPLACE_VPRINTF@ -REPLACE_VSNPRINTF = @REPLACE_VSNPRINTF@ -REPLACE_VSPRINTF = @REPLACE_VSPRINTF@ -REPLACE_WCTOMB = @REPLACE_WCTOMB@ -REPLACE_WRITE = @REPLACE_WRITE@ -RSVG_CFLAGS = @RSVG_CFLAGS@ -RSVG_LIBS = @RSVG_LIBS@ -SETTINGS_CFLAGS = @SETTINGS_CFLAGS@ -SETTINGS_LIBS = @SETTINGS_LIBS@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@ -SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ -STDALIGN_H = @STDALIGN_H@ -STDARG_H = @STDARG_H@ -STDBOOL_H = @STDBOOL_H@ -STDDEF_H = @STDDEF_H@ -STDINT_H = @STDINT_H@ -STRIP = @STRIP@ -SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@ -SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@ -TERMCAP_OBJ = @TERMCAP_OBJ@ -TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@ -TOOLKIT_LIBW = @TOOLKIT_LIBW@ -UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@ -UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@ -UNDEFINE_STRTOK_R = @UNDEFINE_STRTOK_R@ -UNEXEC_OBJ = @UNEXEC_OBJ@ -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@ -W32_LIBS = @W32_LIBS@ -W32_OBJ = @W32_OBJ@ -W32_RES = @W32_RES@ -W32_RES_LINK = @W32_RES_LINK@ -WARN_CFLAGS = @WARN_CFLAGS@ -WCHAR_T_SUFFIX = @WCHAR_T_SUFFIX@ -WERROR_CFLAGS = @WERROR_CFLAGS@ -WIDGET_OBJ = @WIDGET_OBJ@ -WINDOWS_64_BIT_OFF_T = @WINDOWS_64_BIT_OFF_T@ -WINDOWS_64_BIT_ST_SIZE = @WINDOWS_64_BIT_ST_SIZE@ -WINDOW_SYSTEM_OBJ = @WINDOW_SYSTEM_OBJ@ -WINDRES = @WINDRES@ -WINT_T_SUFFIX = @WINT_T_SUFFIX@ -XFT_CFLAGS = @XFT_CFLAGS@ -XFT_LIBS = @XFT_LIBS@ -XMENU_OBJ = @XMENU_OBJ@ -XMKMF = @XMKMF@ -XOBJ = @XOBJ@ -X_TOOLKIT_TYPE = @X_TOOLKIT_TYPE@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_CC = @ac_ct_CC@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -archlibdir = @archlibdir@ -bindir = @bindir@ -bitmapdir = @bitmapdir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -cache_file = @cache_file@ -canonical = @canonical@ -configuration = @configuration@ -copyright = @copyright@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -etcdir = @etcdir@ -exec_prefix = @exec_prefix@ -gamedir = @gamedir@ -gameuser = @gameuser@ -gl_LIBOBJS = @gl_LIBOBJS@ -gl_LTLIBOBJS = @gl_LTLIBOBJS@ -gltests_LIBOBJS = @gltests_LIBOBJS@ -gltests_LTLIBOBJS = @gltests_LTLIBOBJS@ -gltests_WITNESS = @gltests_WITNESS@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -leimdir = @leimdir@ -libdir = @libdir@ -libexecdir = @libexecdir@ -liblockfile = @liblockfile@ -lispdir = @lispdir@ -lisppath = @lisppath@ -localedir = @localedir@ -locallisppath = @locallisppath@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -ns_appbindir = @ns_appbindir@ -ns_appdir = @ns_appdir@ -ns_appresdir = @ns_appresdir@ -ns_appsrc = @ns_appsrc@ -ns_self_contained = @ns_self_contained@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -standardlisppath = @standardlisppath@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -version = @version@ -x_default_search_path = @x_default_search_path@ - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. -BUILT_SOURCES = $(ALLOCA_H) dirent.h $(EXECINFO_H) fcntl.h $(GETOPT_H) \ - inttypes.h signal.h arg-nonnull.h c++defs.h warn-on-use.h \ - $(STDALIGN_H) $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) \ - stdio.h stdlib.h string.h sys/select.h sys/stat.h sys/time.h \ - time.h unistd.h -EXTRA_DIST = alloca.in.h allocator.h openat-priv.h openat-proc.c \ - careadlinkat.h close-stream.h md5.h sha1.h sha256.h sha512.h \ - dirent.in.h dosname.h ftoastr.c ftoastr.h dup2.c euidaccess.c \ - execinfo.c execinfo.in.h at-func.c faccessat.c fcntl.in.h \ - fdopendir.c filemode.h fpending.c fpending.h at-func.c \ - fstatat.c getgroups.c getloadavg.c getopt.c getopt.in.h \ - getopt1.c getopt_int.h gettimeofday.c group-member.c \ - ignore-value.h intprops.h inttypes.in.h lstat.c memrchr.c \ - mktime-internal.h mktime.c openat.h pathmax.h pselect.c \ - pthread_sigmask.c putenv.c readlink.c at-func.c readlinkat.c \ - root-uid.h sig2str.c sig2str.h signal.in.h \ - $(top_srcdir)/build-aux/snippet/_Noreturn.h \ - $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ - $(top_srcdir)/build-aux/snippet/c++defs.h \ - $(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \ - stat-time.h stdalign.in.h stdarg.in.h stdbool.in.h stddef.in.h \ - stdint.in.h stdio.in.h stdlib.in.h strftime.h string.in.h \ - strtoimax.c strtol.c strtoll.c strtol.c strtoul.c strtoull.c \ - strtoimax.c strtoumax.c symlink.c sys_select.in.h \ - sys_stat.in.h sys_time.in.h time.in.h time_r.c timespec.h \ - u64.h unistd.in.h unsetenv.c utimens.h verify.h \ - xalloc-oversized.h -MOSTLYCLEANDIRS = sys sys -MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t dirent.h \ - dirent.h-t execinfo.h execinfo.h-t fcntl.h fcntl.h-t getopt.h \ - getopt.h-t inttypes.h inttypes.h-t signal.h signal.h-t \ - arg-nonnull.h arg-nonnull.h-t c++defs.h c++defs.h-t \ - warn-on-use.h warn-on-use.h-t stdalign.h stdalign.h-t stdarg.h \ - stdarg.h-t stdbool.h stdbool.h-t stddef.h stddef.h-t stdint.h \ - stdint.h-t stdio.h stdio.h-t stdlib.h stdlib.h-t string.h \ - string.h-t sys/select.h sys/select.h-t sys/stat.h sys/stat.h-t \ - sys/time.h sys/time.h-t time.h time.h-t unistd.h unistd.h-t -noinst_LIBRARIES = libgnu.a -AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) -DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src -libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \ - c-strcasecmp.c c-strncasecmp.c careadlinkat.c close-stream.c \ - md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \ - filemode.c $(am__append_1) gettime.c stat-time.c strftime.c \ - timespec.c timespec-add.c timespec-sub.c u64.c unistd.c \ - utimens.c openat-die.c save-cwd.c -libgnu_a_LIBADD = $(gl_LIBOBJS) -libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = openat-proc.c ftoastr.c dup2.c euidaccess.c \ - execinfo.c at-func.c faccessat.c fdopendir.c fpending.c \ - at-func.c fstatat.c getgroups.c getloadavg.c getopt.c \ - getopt1.c gettimeofday.c group-member.c lstat.c memrchr.c \ - mktime.c pselect.c pthread_sigmask.c putenv.c readlink.c \ - at-func.c readlinkat.c sig2str.c stat.c strtoimax.c strtol.c \ - strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \ - strtoumax.c symlink.c time_r.c unsetenv.c - -# Because this Makefile snippet defines a variable used by other -# gnulib Makefile snippets, it must be present in all Makefile.am that -# need it. This is ensured by the applicability 'all' defined above. -_NORETURN_H = $(top_srcdir)/build-aux/snippet/_Noreturn.h -ARG_NONNULL_H = arg-nonnull.h -CXXDEFS_H = c++defs.h -WARN_ON_USE_H = warn-on-use.h -all: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) all-am - -.SUFFIXES: -.SUFFIXES: .c .o .obj -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(srcdir)/gnulib.mk $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu lib/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu lib/Makefile -.PRECIOUS: Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -clean-noinstLIBRARIES: - -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) -libgnu.a: $(libgnu_a_OBJECTS) $(libgnu_a_DEPENDENCIES) - -rm -f libgnu.a - $(libgnu_a_AR) libgnu.a $(libgnu_a_OBJECTS) $(libgnu_a_LIBADD) - $(RANLIB) libgnu.a - -mostlyclean-compile: - -rm -f *.$(OBJEXT) - -distclean-compile: - -rm -f *.tab.c - -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/at-func.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close-stream.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/euidaccess.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execinfo.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/faccessat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fdopendir.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpending.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fstatat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getgroups.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)/gettime.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/group-member.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memrchr.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openat-die.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openat-proc.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pselect.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pthread_sigmask.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/putenv.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlinkat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/save-cwd.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sig2str.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat-time.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtol.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoll.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoul.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoull.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoumax.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symlink.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time_r.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-add.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-sub.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/u64.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unistd.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unsetenv.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utimens.Po@am__quote@ - -.c.o: -@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(COMPILE) -c $< - -.c.obj: -@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` -@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` - -ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) - list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | \ - $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in files) print i; }; }'`; \ - mkid -fID $$unique -tags: TAGS - -TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ - $(TAGS_FILES) $(LISP) - set x; \ - here=`pwd`; \ - list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | \ - $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in files) print i; }; }'`; \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: CTAGS -CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ - $(TAGS_FILES) $(LISP) - list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | \ - $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in files) print i; }; }'`; \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) check-am -all-am: Makefile $(LIBRARIES) -installdirs: -install: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - `test -z '$(STRIP)' || \ - echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -clean: clean-am - -clean-am: clean-generic clean-noinstLIBRARIES mostlyclean-am - -distclean: distclean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -distclean-am: clean-am distclean-compile distclean-generic \ - distclean-tags - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-compile mostlyclean-generic \ - mostlyclean-local - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: - -.MAKE: all check install install-am install-strip - -.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ - clean-noinstLIBRARIES ctags distclean distclean-compile \ - distclean-generic distclean-tags distdir dvi dvi-am html \ - html-am info info-am install install-am install-data \ - install-data-am install-dvi install-dvi-am install-exec \ - install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ - install-ps install-ps-am install-strip installcheck \ - installcheck-am installdirs maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-compile \ - mostlyclean-generic mostlyclean-local pdf pdf-am ps ps-am tags \ - uninstall uninstall-am - - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -@GL_GENERATE_ALLOCA_H_TRUE@alloca.h: alloca.in.h $(top_builddir)/config.status -@GL_GENERATE_ALLOCA_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_ALLOCA_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_ALLOCA_H_TRUE@ cat $(srcdir)/alloca.in.h; \ -@GL_GENERATE_ALLOCA_H_TRUE@ } > $@-t && \ -@GL_GENERATE_ALLOCA_H_TRUE@ mv -f $@-t $@ -@GL_GENERATE_ALLOCA_H_FALSE@alloca.h: $(top_builddir)/config.status -@GL_GENERATE_ALLOCA_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -dirent.h: dirent.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_DIRENT_H''@|$(HAVE_DIRENT_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_DIRENT_H''@|$(NEXT_DIRENT_H)|g' \ - -e 's/@''GNULIB_OPENDIR''@/$(GNULIB_OPENDIR)/g' \ - -e 's/@''GNULIB_READDIR''@/$(GNULIB_READDIR)/g' \ - -e 's/@''GNULIB_REWINDDIR''@/$(GNULIB_REWINDDIR)/g' \ - -e 's/@''GNULIB_CLOSEDIR''@/$(GNULIB_CLOSEDIR)/g' \ - -e 's/@''GNULIB_DIRFD''@/$(GNULIB_DIRFD)/g' \ - -e 's/@''GNULIB_FDOPENDIR''@/$(GNULIB_FDOPENDIR)/g' \ - -e 's/@''GNULIB_SCANDIR''@/$(GNULIB_SCANDIR)/g' \ - -e 's/@''GNULIB_ALPHASORT''@/$(GNULIB_ALPHASORT)/g' \ - -e 's/@''HAVE_OPENDIR''@/$(HAVE_OPENDIR)/g' \ - -e 's/@''HAVE_READDIR''@/$(HAVE_READDIR)/g' \ - -e 's/@''HAVE_REWINDDIR''@/$(HAVE_REWINDDIR)/g' \ - -e 's/@''HAVE_CLOSEDIR''@/$(HAVE_CLOSEDIR)/g' \ - -e 's|@''HAVE_DECL_DIRFD''@|$(HAVE_DECL_DIRFD)|g' \ - -e 's|@''HAVE_DECL_FDOPENDIR''@|$(HAVE_DECL_FDOPENDIR)|g' \ - -e 's|@''HAVE_FDOPENDIR''@|$(HAVE_FDOPENDIR)|g' \ - -e 's|@''HAVE_SCANDIR''@|$(HAVE_SCANDIR)|g' \ - -e 's|@''HAVE_ALPHASORT''@|$(HAVE_ALPHASORT)|g' \ - -e 's|@''REPLACE_OPENDIR''@|$(REPLACE_OPENDIR)|g' \ - -e 's|@''REPLACE_CLOSEDIR''@|$(REPLACE_CLOSEDIR)|g' \ - -e 's|@''REPLACE_DIRFD''@|$(REPLACE_DIRFD)|g' \ - -e 's|@''REPLACE_FDOPENDIR''@|$(REPLACE_FDOPENDIR)|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)/dirent.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works. -@GL_GENERATE_EXECINFO_H_TRUE@execinfo.h: execinfo.in.h $(top_builddir)/config.status -@GL_GENERATE_EXECINFO_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_EXECINFO_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_EXECINFO_H_TRUE@ cat $(srcdir)/execinfo.in.h; \ -@GL_GENERATE_EXECINFO_H_TRUE@ } > $@-t && \ -@GL_GENERATE_EXECINFO_H_TRUE@ mv $@-t $@ -@GL_GENERATE_EXECINFO_H_FALSE@execinfo.h: $(top_builddir)/config.status -@GL_GENERATE_EXECINFO_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \ - -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \ - -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \ - -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \ - -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \ - -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \ - -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \ - -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \ - -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \ - -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|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)/fcntl.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_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_GETOPT_H''@|$(NEXT_GETOPT_H)|g' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - < $(srcdir)/getopt.in.h; \ - } > $@-t && \ - mv -f $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) $(ARG_NONNULL_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_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_INTTYPES_H''@|$(NEXT_INTTYPES_H)|g' \ - -e 's/@''PRI_MACROS_BROKEN''@/$(PRI_MACROS_BROKEN)/g' \ - -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/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/@''PRIPTR_PREFIX''@/$(PRIPTR_PREFIX)/g' \ - -e 's/@''GNULIB_IMAXABS''@/$(GNULIB_IMAXABS)/g' \ - -e 's/@''GNULIB_IMAXDIV''@/$(GNULIB_IMAXDIV)/g' \ - -e 's/@''GNULIB_STRTOIMAX''@/$(GNULIB_STRTOIMAX)/g' \ - -e 's/@''GNULIB_STRTOUMAX''@/$(GNULIB_STRTOUMAX)/g' \ - -e 's/@''HAVE_DECL_IMAXABS''@/$(HAVE_DECL_IMAXABS)/g' \ - -e 's/@''HAVE_DECL_IMAXDIV''@/$(HAVE_DECL_IMAXDIV)/g' \ - -e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \ - -e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \ - -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \ - -e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \ - -e 's/@''INT64_MAX_EQ_LONG_MAX''@/$(INT64_MAX_EQ_LONG_MAX)/g' \ - -e 's/@''UINT32_MAX_LT_UINTMAX_MAX''@/$(UINT32_MAX_LT_UINTMAX_MAX)/g' \ - -e 's/@''UINT64_MAX_EQ_ULONG_MAX''@/$(UINT64_MAX_EQ_ULONG_MAX)/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)/inttypes.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have a complete one. -signal.h: signal.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_SIGNAL_H''@|$(NEXT_SIGNAL_H)|g' \ - -e 's|@''GNULIB_PTHREAD_SIGMASK''@|$(GNULIB_PTHREAD_SIGMASK)|g' \ - -e 's|@''GNULIB_RAISE''@|$(GNULIB_RAISE)|g' \ - -e 's/@''GNULIB_SIGNAL_H_SIGPIPE''@/$(GNULIB_SIGNAL_H_SIGPIPE)/g' \ - -e 's/@''GNULIB_SIGPROCMASK''@/$(GNULIB_SIGPROCMASK)/g' \ - -e 's/@''GNULIB_SIGACTION''@/$(GNULIB_SIGACTION)/g' \ - -e 's|@''HAVE_POSIX_SIGNALBLOCKING''@|$(HAVE_POSIX_SIGNALBLOCKING)|g' \ - -e 's|@''HAVE_PTHREAD_SIGMASK''@|$(HAVE_PTHREAD_SIGMASK)|g' \ - -e 's|@''HAVE_RAISE''@|$(HAVE_RAISE)|g' \ - -e 's|@''HAVE_SIGSET_T''@|$(HAVE_SIGSET_T)|g' \ - -e 's|@''HAVE_SIGINFO_T''@|$(HAVE_SIGINFO_T)|g' \ - -e 's|@''HAVE_SIGACTION''@|$(HAVE_SIGACTION)|g' \ - -e 's|@''HAVE_STRUCT_SIGACTION_SA_SIGACTION''@|$(HAVE_STRUCT_SIGACTION_SA_SIGACTION)|g' \ - -e 's|@''HAVE_TYPE_VOLATILE_SIG_ATOMIC_T''@|$(HAVE_TYPE_VOLATILE_SIG_ATOMIC_T)|g' \ - -e 's|@''HAVE_SIGHANDLER_T''@|$(HAVE_SIGHANDLER_T)|g' \ - -e 's|@''REPLACE_PTHREAD_SIGMASK''@|$(REPLACE_PTHREAD_SIGMASK)|g' \ - -e 's|@''REPLACE_RAISE''@|$(REPLACE_RAISE)|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)/signal.in.h; \ - } > $@-t && \ - mv $@-t $@ -# The arg-nonnull.h that gets inserted into generated .h files is the same as -# build-aux/snippet/arg-nonnull.h, except that it has the copyright header cut -# off. -arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/GL_ARG_NONNULL/,$$p' \ - < $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ - > $@-t && \ - mv $@-t $@ -# The c++defs.h that gets inserted into generated .h files is the same as -# build-aux/snippet/c++defs.h, except that it has the copyright header cut off. -c++defs.h: $(top_srcdir)/build-aux/snippet/c++defs.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/_GL_CXXDEFS/,$$p' \ - < $(top_srcdir)/build-aux/snippet/c++defs.h \ - > $@-t && \ - mv $@-t $@ -# The warn-on-use.h that gets inserted into generated .h files is the same as -# build-aux/snippet/warn-on-use.h, except that it has the copyright header cut -# off. -warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/^.ifndef/,$$p' \ - < $(top_srcdir)/build-aux/snippet/warn-on-use.h \ - > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works. -@GL_GENERATE_STDALIGN_H_TRUE@stdalign.h: stdalign.in.h $(top_builddir)/config.status -@GL_GENERATE_STDALIGN_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_STDALIGN_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_STDALIGN_H_TRUE@ cat $(srcdir)/stdalign.in.h; \ -@GL_GENERATE_STDALIGN_H_TRUE@ } > $@-t && \ -@GL_GENERATE_STDALIGN_H_TRUE@ mv $@-t $@ -@GL_GENERATE_STDALIGN_H_FALSE@stdalign.h: $(top_builddir)/config.status -@GL_GENERATE_STDALIGN_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -@GL_GENERATE_STDARG_H_TRUE@stdarg.h: stdarg.in.h $(top_builddir)/config.status -@GL_GENERATE_STDARG_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_STDARG_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ -@GL_GENERATE_STDARG_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ -@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -@GL_GENERATE_STDARG_H_TRUE@ -e 's|@''NEXT_STDARG_H''@|$(NEXT_STDARG_H)|g' \ -@GL_GENERATE_STDARG_H_TRUE@ < $(srcdir)/stdarg.in.h; \ -@GL_GENERATE_STDARG_H_TRUE@ } > $@-t && \ -@GL_GENERATE_STDARG_H_TRUE@ mv $@-t $@ -@GL_GENERATE_STDARG_H_FALSE@stdarg.h: $(top_builddir)/config.status -@GL_GENERATE_STDARG_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works. -@GL_GENERATE_STDBOOL_H_TRUE@stdbool.h: stdbool.in.h $(top_builddir)/config.status -@GL_GENERATE_STDBOOL_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_STDBOOL_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_STDBOOL_H_TRUE@ sed -e 's/@''HAVE__BOOL''@/$(HAVE__BOOL)/g' < $(srcdir)/stdbool.in.h; \ -@GL_GENERATE_STDBOOL_H_TRUE@ } > $@-t && \ -@GL_GENERATE_STDBOOL_H_TRUE@ mv $@-t $@ -@GL_GENERATE_STDBOOL_H_FALSE@stdbool.h: $(top_builddir)/config.status -@GL_GENERATE_STDBOOL_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -@GL_GENERATE_STDDEF_H_TRUE@stddef.h: stddef.in.h $(top_builddir)/config.status -@GL_GENERATE_STDDEF_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_STDDEF_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ -@GL_GENERATE_STDDEF_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''HAVE_WCHAR_T''@|$(HAVE_WCHAR_T)|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \ -@GL_GENERATE_STDDEF_H_TRUE@ < $(srcdir)/stddef.in.h; \ -@GL_GENERATE_STDDEF_H_TRUE@ } > $@-t && \ -@GL_GENERATE_STDDEF_H_TRUE@ mv $@-t $@ -@GL_GENERATE_STDDEF_H_FALSE@stddef.h: $(top_builddir)/config.status -@GL_GENERATE_STDDEF_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -@GL_GENERATE_STDINT_H_TRUE@stdint.h: stdint.in.h $(top_builddir)/config.status -@GL_GENERATE_STDINT_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \ -@GL_GENERATE_STDINT_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ -@GL_GENERATE_STDINT_H_TRUE@ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ -@GL_GENERATE_STDINT_H_TRUE@ < $(srcdir)/stdint.in.h; \ -@GL_GENERATE_STDINT_H_TRUE@ } > $@-t && \ -@GL_GENERATE_STDINT_H_TRUE@ mv $@-t $@ -@GL_GENERATE_STDINT_H_FALSE@stdint.h: $(top_builddir)/config.status -@GL_GENERATE_STDINT_H_FALSE@ rm -f $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_STDIO_H''@|$(NEXT_STDIO_H)|g' \ - -e 's/@''GNULIB_DPRINTF''@/$(GNULIB_DPRINTF)/g' \ - -e 's/@''GNULIB_FCLOSE''@/$(GNULIB_FCLOSE)/g' \ - -e 's/@''GNULIB_FDOPEN''@/$(GNULIB_FDOPEN)/g' \ - -e 's/@''GNULIB_FFLUSH''@/$(GNULIB_FFLUSH)/g' \ - -e 's/@''GNULIB_FGETC''@/$(GNULIB_FGETC)/g' \ - -e 's/@''GNULIB_FGETS''@/$(GNULIB_FGETS)/g' \ - -e 's/@''GNULIB_FOPEN''@/$(GNULIB_FOPEN)/g' \ - -e 's/@''GNULIB_FPRINTF''@/$(GNULIB_FPRINTF)/g' \ - -e 's/@''GNULIB_FPRINTF_POSIX''@/$(GNULIB_FPRINTF_POSIX)/g' \ - -e 's/@''GNULIB_FPURGE''@/$(GNULIB_FPURGE)/g' \ - -e 's/@''GNULIB_FPUTC''@/$(GNULIB_FPUTC)/g' \ - -e 's/@''GNULIB_FPUTS''@/$(GNULIB_FPUTS)/g' \ - -e 's/@''GNULIB_FREAD''@/$(GNULIB_FREAD)/g' \ - -e 's/@''GNULIB_FREOPEN''@/$(GNULIB_FREOPEN)/g' \ - -e 's/@''GNULIB_FSCANF''@/$(GNULIB_FSCANF)/g' \ - -e 's/@''GNULIB_FSEEK''@/$(GNULIB_FSEEK)/g' \ - -e 's/@''GNULIB_FSEEKO''@/$(GNULIB_FSEEKO)/g' \ - -e 's/@''GNULIB_FTELL''@/$(GNULIB_FTELL)/g' \ - -e 's/@''GNULIB_FTELLO''@/$(GNULIB_FTELLO)/g' \ - -e 's/@''GNULIB_FWRITE''@/$(GNULIB_FWRITE)/g' \ - -e 's/@''GNULIB_GETC''@/$(GNULIB_GETC)/g' \ - -e 's/@''GNULIB_GETCHAR''@/$(GNULIB_GETCHAR)/g' \ - -e 's/@''GNULIB_GETDELIM''@/$(GNULIB_GETDELIM)/g' \ - -e 's/@''GNULIB_GETLINE''@/$(GNULIB_GETLINE)/g' \ - -e 's/@''GNULIB_OBSTACK_PRINTF''@/$(GNULIB_OBSTACK_PRINTF)/g' \ - -e 's/@''GNULIB_OBSTACK_PRINTF_POSIX''@/$(GNULIB_OBSTACK_PRINTF_POSIX)/g' \ - -e 's/@''GNULIB_PCLOSE''@/$(GNULIB_PCLOSE)/g' \ - -e 's/@''GNULIB_PERROR''@/$(GNULIB_PERROR)/g' \ - -e 's/@''GNULIB_POPEN''@/$(GNULIB_POPEN)/g' \ - -e 's/@''GNULIB_PRINTF''@/$(GNULIB_PRINTF)/g' \ - -e 's/@''GNULIB_PRINTF_POSIX''@/$(GNULIB_PRINTF_POSIX)/g' \ - -e 's/@''GNULIB_PUTC''@/$(GNULIB_PUTC)/g' \ - -e 's/@''GNULIB_PUTCHAR''@/$(GNULIB_PUTCHAR)/g' \ - -e 's/@''GNULIB_PUTS''@/$(GNULIB_PUTS)/g' \ - -e 's/@''GNULIB_REMOVE''@/$(GNULIB_REMOVE)/g' \ - -e 's/@''GNULIB_RENAME''@/$(GNULIB_RENAME)/g' \ - -e 's/@''GNULIB_RENAMEAT''@/$(GNULIB_RENAMEAT)/g' \ - -e 's/@''GNULIB_SCANF''@/$(GNULIB_SCANF)/g' \ - -e 's/@''GNULIB_SNPRINTF''@/$(GNULIB_SNPRINTF)/g' \ - -e 's/@''GNULIB_SPRINTF_POSIX''@/$(GNULIB_SPRINTF_POSIX)/g' \ - -e 's/@''GNULIB_STDIO_H_NONBLOCKING''@/$(GNULIB_STDIO_H_NONBLOCKING)/g' \ - -e 's/@''GNULIB_STDIO_H_SIGPIPE''@/$(GNULIB_STDIO_H_SIGPIPE)/g' \ - -e 's/@''GNULIB_TMPFILE''@/$(GNULIB_TMPFILE)/g' \ - -e 's/@''GNULIB_VASPRINTF''@/$(GNULIB_VASPRINTF)/g' \ - -e 's/@''GNULIB_VDPRINTF''@/$(GNULIB_VDPRINTF)/g' \ - -e 's/@''GNULIB_VFPRINTF''@/$(GNULIB_VFPRINTF)/g' \ - -e 's/@''GNULIB_VFPRINTF_POSIX''@/$(GNULIB_VFPRINTF_POSIX)/g' \ - -e 's/@''GNULIB_VFSCANF''@/$(GNULIB_VFSCANF)/g' \ - -e 's/@''GNULIB_VSCANF''@/$(GNULIB_VSCANF)/g' \ - -e 's/@''GNULIB_VPRINTF''@/$(GNULIB_VPRINTF)/g' \ - -e 's/@''GNULIB_VPRINTF_POSIX''@/$(GNULIB_VPRINTF_POSIX)/g' \ - -e 's/@''GNULIB_VSNPRINTF''@/$(GNULIB_VSNPRINTF)/g' \ - -e 's/@''GNULIB_VSPRINTF_POSIX''@/$(GNULIB_VSPRINTF_POSIX)/g' \ - < $(srcdir)/stdio.in.h | \ - sed -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \ - -e 's|@''HAVE_DECL_FSEEKO''@|$(HAVE_DECL_FSEEKO)|g' \ - -e 's|@''HAVE_DECL_FTELLO''@|$(HAVE_DECL_FTELLO)|g' \ - -e 's|@''HAVE_DECL_GETDELIM''@|$(HAVE_DECL_GETDELIM)|g' \ - -e 's|@''HAVE_DECL_GETLINE''@|$(HAVE_DECL_GETLINE)|g' \ - -e 's|@''HAVE_DECL_OBSTACK_PRINTF''@|$(HAVE_DECL_OBSTACK_PRINTF)|g' \ - -e 's|@''HAVE_DECL_SNPRINTF''@|$(HAVE_DECL_SNPRINTF)|g' \ - -e 's|@''HAVE_DECL_VSNPRINTF''@|$(HAVE_DECL_VSNPRINTF)|g' \ - -e 's|@''HAVE_DPRINTF''@|$(HAVE_DPRINTF)|g' \ - -e 's|@''HAVE_FSEEKO''@|$(HAVE_FSEEKO)|g' \ - -e 's|@''HAVE_FTELLO''@|$(HAVE_FTELLO)|g' \ - -e 's|@''HAVE_PCLOSE''@|$(HAVE_PCLOSE)|g' \ - -e 's|@''HAVE_POPEN''@|$(HAVE_POPEN)|g' \ - -e 's|@''HAVE_RENAMEAT''@|$(HAVE_RENAMEAT)|g' \ - -e 's|@''HAVE_VASPRINTF''@|$(HAVE_VASPRINTF)|g' \ - -e 's|@''HAVE_VDPRINTF''@|$(HAVE_VDPRINTF)|g' \ - -e 's|@''REPLACE_DPRINTF''@|$(REPLACE_DPRINTF)|g' \ - -e 's|@''REPLACE_FCLOSE''@|$(REPLACE_FCLOSE)|g' \ - -e 's|@''REPLACE_FDOPEN''@|$(REPLACE_FDOPEN)|g' \ - -e 's|@''REPLACE_FFLUSH''@|$(REPLACE_FFLUSH)|g' \ - -e 's|@''REPLACE_FOPEN''@|$(REPLACE_FOPEN)|g' \ - -e 's|@''REPLACE_FPRINTF''@|$(REPLACE_FPRINTF)|g' \ - -e 's|@''REPLACE_FPURGE''@|$(REPLACE_FPURGE)|g' \ - -e 's|@''REPLACE_FREOPEN''@|$(REPLACE_FREOPEN)|g' \ - -e 's|@''REPLACE_FSEEK''@|$(REPLACE_FSEEK)|g' \ - -e 's|@''REPLACE_FSEEKO''@|$(REPLACE_FSEEKO)|g' \ - -e 's|@''REPLACE_FTELL''@|$(REPLACE_FTELL)|g' \ - -e 's|@''REPLACE_FTELLO''@|$(REPLACE_FTELLO)|g' \ - -e 's|@''REPLACE_GETDELIM''@|$(REPLACE_GETDELIM)|g' \ - -e 's|@''REPLACE_GETLINE''@|$(REPLACE_GETLINE)|g' \ - -e 's|@''REPLACE_OBSTACK_PRINTF''@|$(REPLACE_OBSTACK_PRINTF)|g' \ - -e 's|@''REPLACE_PERROR''@|$(REPLACE_PERROR)|g' \ - -e 's|@''REPLACE_POPEN''@|$(REPLACE_POPEN)|g' \ - -e 's|@''REPLACE_PRINTF''@|$(REPLACE_PRINTF)|g' \ - -e 's|@''REPLACE_REMOVE''@|$(REPLACE_REMOVE)|g' \ - -e 's|@''REPLACE_RENAME''@|$(REPLACE_RENAME)|g' \ - -e 's|@''REPLACE_RENAMEAT''@|$(REPLACE_RENAMEAT)|g' \ - -e 's|@''REPLACE_SNPRINTF''@|$(REPLACE_SNPRINTF)|g' \ - -e 's|@''REPLACE_SPRINTF''@|$(REPLACE_SPRINTF)|g' \ - -e 's|@''REPLACE_STDIO_READ_FUNCS''@|$(REPLACE_STDIO_READ_FUNCS)|g' \ - -e 's|@''REPLACE_STDIO_WRITE_FUNCS''@|$(REPLACE_STDIO_WRITE_FUNCS)|g' \ - -e 's|@''REPLACE_TMPFILE''@|$(REPLACE_TMPFILE)|g' \ - -e 's|@''REPLACE_VASPRINTF''@|$(REPLACE_VASPRINTF)|g' \ - -e 's|@''REPLACE_VDPRINTF''@|$(REPLACE_VDPRINTF)|g' \ - -e 's|@''REPLACE_VFPRINTF''@|$(REPLACE_VFPRINTF)|g' \ - -e 's|@''REPLACE_VPRINTF''@|$(REPLACE_VPRINTF)|g' \ - -e 's|@''REPLACE_VSNPRINTF''@|$(REPLACE_VSNPRINTF)|g' \ - -e 's|@''REPLACE_VSPRINTF''@|$(REPLACE_VSPRINTF)|g' \ - -e 's|@''ASM_SYMBOL_PREFIX''@|$(ASM_SYMBOL_PREFIX)|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 when the system -# doesn't have one that works with the given compiler. -stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ - $(_NORETURN_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_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_MBTOWC''@/$(GNULIB_MBTOWC)/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_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \ - -e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \ - -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \ - -e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \ - -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/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_SECURE_GETENV''@/$(GNULIB_SECURE_GETENV)/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' \ - -e 's/@''GNULIB_WCTOMB''@/$(GNULIB_WCTOMB)/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_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \ - -e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \ - -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \ - -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|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_SECURE_GETENV''@|$(HAVE_SECURE_GETENV)|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_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ - -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ - -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ - -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ - -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ - -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|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 's|@''REPLACE_WCTOMB''@|$(REPLACE_WCTOMB)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _Noreturn/r $(_NORETURN_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 when the system -# doesn't have one that works with the given compiler. -string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_STRING_H''@|$(NEXT_STRING_H)|g' \ - -e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \ - -e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \ - -e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \ - -e 's/@''GNULIB_MBSNLEN''@/$(GNULIB_MBSNLEN)/g' \ - -e 's/@''GNULIB_MBSCHR''@/$(GNULIB_MBSCHR)/g' \ - -e 's/@''GNULIB_MBSRCHR''@/$(GNULIB_MBSRCHR)/g' \ - -e 's/@''GNULIB_MBSSTR''@/$(GNULIB_MBSSTR)/g' \ - -e 's/@''GNULIB_MBSCASECMP''@/$(GNULIB_MBSCASECMP)/g' \ - -e 's/@''GNULIB_MBSNCASECMP''@/$(GNULIB_MBSNCASECMP)/g' \ - -e 's/@''GNULIB_MBSPCASECMP''@/$(GNULIB_MBSPCASECMP)/g' \ - -e 's/@''GNULIB_MBSCASESTR''@/$(GNULIB_MBSCASESTR)/g' \ - -e 's/@''GNULIB_MBSCSPN''@/$(GNULIB_MBSCSPN)/g' \ - -e 's/@''GNULIB_MBSPBRK''@/$(GNULIB_MBSPBRK)/g' \ - -e 's/@''GNULIB_MBSSPN''@/$(GNULIB_MBSSPN)/g' \ - -e 's/@''GNULIB_MBSSEP''@/$(GNULIB_MBSSEP)/g' \ - -e 's/@''GNULIB_MBSTOK_R''@/$(GNULIB_MBSTOK_R)/g' \ - -e 's/@''GNULIB_MEMCHR''@/$(GNULIB_MEMCHR)/g' \ - -e 's/@''GNULIB_MEMMEM''@/$(GNULIB_MEMMEM)/g' \ - -e 's/@''GNULIB_MEMPCPY''@/$(GNULIB_MEMPCPY)/g' \ - -e 's/@''GNULIB_MEMRCHR''@/$(GNULIB_MEMRCHR)/g' \ - -e 's/@''GNULIB_RAWMEMCHR''@/$(GNULIB_RAWMEMCHR)/g' \ - -e 's/@''GNULIB_STPCPY''@/$(GNULIB_STPCPY)/g' \ - -e 's/@''GNULIB_STPNCPY''@/$(GNULIB_STPNCPY)/g' \ - -e 's/@''GNULIB_STRCHRNUL''@/$(GNULIB_STRCHRNUL)/g' \ - -e 's/@''GNULIB_STRDUP''@/$(GNULIB_STRDUP)/g' \ - -e 's/@''GNULIB_STRNCAT''@/$(GNULIB_STRNCAT)/g' \ - -e 's/@''GNULIB_STRNDUP''@/$(GNULIB_STRNDUP)/g' \ - -e 's/@''GNULIB_STRNLEN''@/$(GNULIB_STRNLEN)/g' \ - -e 's/@''GNULIB_STRPBRK''@/$(GNULIB_STRPBRK)/g' \ - -e 's/@''GNULIB_STRSEP''@/$(GNULIB_STRSEP)/g' \ - -e 's/@''GNULIB_STRSTR''@/$(GNULIB_STRSTR)/g' \ - -e 's/@''GNULIB_STRCASESTR''@/$(GNULIB_STRCASESTR)/g' \ - -e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \ - -e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \ - -e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \ - -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ - -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ - < $(srcdir)/string.in.h | \ - sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ - -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ - -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ - -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ - -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ - -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ - -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ - -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \ - -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \ - -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ - -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \ - -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \ - -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \ - -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \ - -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \ - -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \ - -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \ - -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \ - -e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \ - -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \ - -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \ - -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ - -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ - -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ - -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \ - -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ - -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ - -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \ - -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \ - -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \ - -e 's|@''REPLACE_STRNCAT''@|$(REPLACE_STRNCAT)|g' \ - -e 's|@''REPLACE_STRNDUP''@|$(REPLACE_STRNDUP)|g' \ - -e 's|@''REPLACE_STRNLEN''@|$(REPLACE_STRNLEN)|g' \ - -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \ - -e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \ - -e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|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)/string.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_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|@''GUARD_PREFIX''@|GL|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_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \ - -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \ - -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \ - -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \ - -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ - -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \ - -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \ - -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ - < $(srcdir)/sys_select.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# has one that is incomplete. -sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(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|@''GUARD_PREFIX''@|GL|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_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ - -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \ - -e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \ - -e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/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 when the system -# doesn't have one that works with the given compiler. -sys/time.h: sys_time.in.h $(top_builddir)/config.status $(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|@''GUARD_PREFIX''@|GL|g' \ - -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_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_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \ - -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ - -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ - -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \ - -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \ - -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \ - -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/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_time.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|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_TIME_H''@|$(NEXT_TIME_H)|g' \ - -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \ - -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \ - -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \ - -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \ - -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \ - -e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \ - -e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \ - -e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \ - -e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \ - -e 's|@''REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \ - -e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \ - -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ - -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ - -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|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)/time.in.h; \ - } > $@-t && \ - mv $@-t $@ - -# We need the following in order to create an empty placeholder for -# when the system doesn't have one. -unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_UNISTD_H''@|$(HAVE_UNISTD_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_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \ - -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \ - -e 's/@''GNULIB_CHDIR''@/$(GNULIB_CHDIR)/g' \ - -e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \ - -e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \ - -e 's/@''GNULIB_DUP''@/$(GNULIB_DUP)/g' \ - -e 's/@''GNULIB_DUP2''@/$(GNULIB_DUP2)/g' \ - -e 's/@''GNULIB_DUP3''@/$(GNULIB_DUP3)/g' \ - -e 's/@''GNULIB_ENVIRON''@/$(GNULIB_ENVIRON)/g' \ - -e 's/@''GNULIB_EUIDACCESS''@/$(GNULIB_EUIDACCESS)/g' \ - -e 's/@''GNULIB_FACCESSAT''@/$(GNULIB_FACCESSAT)/g' \ - -e 's/@''GNULIB_FCHDIR''@/$(GNULIB_FCHDIR)/g' \ - -e 's/@''GNULIB_FCHOWNAT''@/$(GNULIB_FCHOWNAT)/g' \ - -e 's/@''GNULIB_FDATASYNC''@/$(GNULIB_FDATASYNC)/g' \ - -e 's/@''GNULIB_FSYNC''@/$(GNULIB_FSYNC)/g' \ - -e 's/@''GNULIB_FTRUNCATE''@/$(GNULIB_FTRUNCATE)/g' \ - -e 's/@''GNULIB_GETCWD''@/$(GNULIB_GETCWD)/g' \ - -e 's/@''GNULIB_GETDOMAINNAME''@/$(GNULIB_GETDOMAINNAME)/g' \ - -e 's/@''GNULIB_GETDTABLESIZE''@/$(GNULIB_GETDTABLESIZE)/g' \ - -e 's/@''GNULIB_GETGROUPS''@/$(GNULIB_GETGROUPS)/g' \ - -e 's/@''GNULIB_GETHOSTNAME''@/$(GNULIB_GETHOSTNAME)/g' \ - -e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \ - -e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \ - -e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \ - -e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \ - -e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \ - -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \ - -e 's/@''GNULIB_LCHOWN''@/$(GNULIB_LCHOWN)/g' \ - -e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \ - -e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \ - -e 's/@''GNULIB_LSEEK''@/$(GNULIB_LSEEK)/g' \ - -e 's/@''GNULIB_PIPE''@/$(GNULIB_PIPE)/g' \ - -e 's/@''GNULIB_PIPE2''@/$(GNULIB_PIPE2)/g' \ - -e 's/@''GNULIB_PREAD''@/$(GNULIB_PREAD)/g' \ - -e 's/@''GNULIB_PWRITE''@/$(GNULIB_PWRITE)/g' \ - -e 's/@''GNULIB_READ''@/$(GNULIB_READ)/g' \ - -e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \ - -e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \ - -e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/g' \ - -e 's/@''GNULIB_SETHOSTNAME''@/$(GNULIB_SETHOSTNAME)/g' \ - -e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \ - -e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \ - -e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \ - -e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \ - -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \ - -e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \ - -e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \ - -e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \ - -e 's/@''GNULIB_UNLINKAT''@/$(GNULIB_UNLINKAT)/g' \ - -e 's/@''GNULIB_USLEEP''@/$(GNULIB_USLEEP)/g' \ - -e 's/@''GNULIB_WRITE''@/$(GNULIB_WRITE)/g' \ - < $(srcdir)/unistd.in.h | \ - sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \ - -e 's|@''HAVE_DUP2''@|$(HAVE_DUP2)|g' \ - -e 's|@''HAVE_DUP3''@|$(HAVE_DUP3)|g' \ - -e 's|@''HAVE_EUIDACCESS''@|$(HAVE_EUIDACCESS)|g' \ - -e 's|@''HAVE_FACCESSAT''@|$(HAVE_FACCESSAT)|g' \ - -e 's|@''HAVE_FCHDIR''@|$(HAVE_FCHDIR)|g' \ - -e 's|@''HAVE_FCHOWNAT''@|$(HAVE_FCHOWNAT)|g' \ - -e 's|@''HAVE_FDATASYNC''@|$(HAVE_FDATASYNC)|g' \ - -e 's|@''HAVE_FSYNC''@|$(HAVE_FSYNC)|g' \ - -e 's|@''HAVE_FTRUNCATE''@|$(HAVE_FTRUNCATE)|g' \ - -e 's|@''HAVE_GETDTABLESIZE''@|$(HAVE_GETDTABLESIZE)|g' \ - -e 's|@''HAVE_GETGROUPS''@|$(HAVE_GETGROUPS)|g' \ - -e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \ - -e 's|@''HAVE_GETLOGIN''@|$(HAVE_GETLOGIN)|g' \ - -e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \ - -e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \ - -e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \ - -e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \ - -e 's|@''HAVE_LINKAT''@|$(HAVE_LINKAT)|g' \ - -e 's|@''HAVE_PIPE''@|$(HAVE_PIPE)|g' \ - -e 's|@''HAVE_PIPE2''@|$(HAVE_PIPE2)|g' \ - -e 's|@''HAVE_PREAD''@|$(HAVE_PREAD)|g' \ - -e 's|@''HAVE_PWRITE''@|$(HAVE_PWRITE)|g' \ - -e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \ - -e 's|@''HAVE_READLINKAT''@|$(HAVE_READLINKAT)|g' \ - -e 's|@''HAVE_SETHOSTNAME''@|$(HAVE_SETHOSTNAME)|g' \ - -e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \ - -e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \ - -e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \ - -e 's|@''HAVE_UNLINKAT''@|$(HAVE_UNLINKAT)|g' \ - -e 's|@''HAVE_USLEEP''@|$(HAVE_USLEEP)|g' \ - -e 's|@''HAVE_DECL_ENVIRON''@|$(HAVE_DECL_ENVIRON)|g' \ - -e 's|@''HAVE_DECL_FCHDIR''@|$(HAVE_DECL_FCHDIR)|g' \ - -e 's|@''HAVE_DECL_FDATASYNC''@|$(HAVE_DECL_FDATASYNC)|g' \ - -e 's|@''HAVE_DECL_GETDOMAINNAME''@|$(HAVE_DECL_GETDOMAINNAME)|g' \ - -e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \ - -e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \ - -e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \ - -e 's|@''HAVE_DECL_SETHOSTNAME''@|$(HAVE_DECL_SETHOSTNAME)|g' \ - -e 's|@''HAVE_DECL_TTYNAME_R''@|$(HAVE_DECL_TTYNAME_R)|g' \ - -e 's|@''HAVE_OS_H''@|$(HAVE_OS_H)|g' \ - -e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \ - | \ - sed -e 's|@''REPLACE_CHOWN''@|$(REPLACE_CHOWN)|g' \ - -e 's|@''REPLACE_CLOSE''@|$(REPLACE_CLOSE)|g' \ - -e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \ - -e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \ - -e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \ - -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \ - -e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \ - -e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \ - -e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \ - -e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \ - -e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \ - -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \ - -e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \ - -e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \ - -e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \ - -e 's|@''REPLACE_LSEEK''@|$(REPLACE_LSEEK)|g' \ - -e 's|@''REPLACE_PREAD''@|$(REPLACE_PREAD)|g' \ - -e 's|@''REPLACE_PWRITE''@|$(REPLACE_PWRITE)|g' \ - -e 's|@''REPLACE_READ''@|$(REPLACE_READ)|g' \ - -e 's|@''REPLACE_READLINK''@|$(REPLACE_READLINK)|g' \ - -e 's|@''REPLACE_RMDIR''@|$(REPLACE_RMDIR)|g' \ - -e 's|@''REPLACE_SLEEP''@|$(REPLACE_SLEEP)|g' \ - -e 's|@''REPLACE_SYMLINK''@|$(REPLACE_SYMLINK)|g' \ - -e 's|@''REPLACE_TTYNAME_R''@|$(REPLACE_TTYNAME_R)|g' \ - -e 's|@''REPLACE_UNLINK''@|$(REPLACE_UNLINK)|g' \ - -e 's|@''REPLACE_UNLINKAT''@|$(REPLACE_UNLINKAT)|g' \ - -e 's|@''REPLACE_USLEEP''@|$(REPLACE_USLEEP)|g' \ - -e 's|@''REPLACE_WRITE''@|$(REPLACE_WRITE)|g' \ - -e 's|@''UNISTD_H_HAVE_WINSOCK2_H''@|$(UNISTD_H_HAVE_WINSOCK2_H)|g' \ - -e 's|@''UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS''@|$(UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS)|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 $@ - -mostlyclean-local: mostlyclean-generic - @for dir in '' $(MOSTLYCLEANDIRS); do \ - if test -n "$$dir" && test -d $$dir; then \ - echo "rmdir $$dir"; rmdir $$dir; \ - fi; \ - done; \ - : - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/autogen/README b/autogen/README deleted file mode 100644 index d4c2236581b..00000000000 --- a/autogen/README +++ /dev/null @@ -1,20 +0,0 @@ -This directory contains some pre-built generated files. -Most people do not need to use these files - instead you should -generate them yourself using eg `autogen.sh'. - -File: Destination: Created by: -configure ../ autoconf -config.in ../src autoheader * also used by MSDOS bzr build -aclocal.m4 ../ aclocal -Makefile.in ../lib automake -compile ../build-aux automake -config.guess ../build-aux automake -config.sub ../build-aux automake -depcomp ../build-aux automake -install-sh ../build-aux automake -missing ../build-aux automake - -There are also some scripts: - -copy_autogen - copy pre-built generated files into place -update_autogen - regenerate generated files (for maintainers) diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 deleted file mode 100644 index 8065a9e643b..00000000000 --- a/autogen/aclocal.m4 +++ /dev/null @@ -1,1070 +0,0 @@ -# generated automatically by aclocal 1.11.1 -*- Autoconf -*- - -# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -# 2005, 2006, 2007, 2008, 2009 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. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -m4_ifndef([AC_AUTOCONF_VERSION], - [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl -m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.65],, -[m4_warning([this file was generated for autoconf 2.65. -You have another version of autoconf. It may work, but is not guaranteed to. -If you have problems, you may need to regenerate the build system entirely. -To do so, use the procedure documented by the package, typically `autoreconf'.])]) - -# Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 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. - -# AM_AUTOMAKE_VERSION(VERSION) -# ---------------------------- -# Automake X.Y traces this macro to ensure aclocal.m4 has been -# generated from the m4 files accompanying Automake X.Y. -# (This private macro should not be called outside this file.) -AC_DEFUN([AM_AUTOMAKE_VERSION], -[am__api_version='1.11' -dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to -dnl require some minimum version. Point them to the right macro. -m4_if([$1], [1.11.1], [], - [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl -]) - -# _AM_AUTOCONF_VERSION(VERSION) -# ----------------------------- -# aclocal traces this macro to find the Autoconf version. -# This is a private macro too. Using m4_define simplifies -# the logic in aclocal, which can simply ignore this definition. -m4_define([_AM_AUTOCONF_VERSION], []) - -# AM_SET_CURRENT_AUTOMAKE_VERSION -# ------------------------------- -# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced. -# This function is AC_REQUIREd by AM_INIT_AUTOMAKE. -AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], -[AM_AUTOMAKE_VERSION([1.11.1])dnl -m4_ifndef([AC_AUTOCONF_VERSION], - [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl -_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))]) - -# AM_AUX_DIR_EXPAND -*- Autoconf -*- - -# Copyright (C) 2001, 2003, 2005 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. - -# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets -# $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to -# `$srcdir', `$srcdir/..', or `$srcdir/../..'. -# -# Of course, Automake must honor this variable whenever it calls a -# tool from the auxiliary directory. The problem is that $srcdir (and -# therefore $ac_aux_dir as well) can be either absolute or relative, -# depending on how configure is run. This is pretty annoying, since -# it makes $ac_aux_dir quite unusable in subdirectories: in the top -# source directory, any form will work fine, but in subdirectories a -# relative path needs to be adjusted first. -# -# $ac_aux_dir/missing -# fails when called from a subdirectory if $ac_aux_dir is relative -# $top_srcdir/$ac_aux_dir/missing -# fails if $ac_aux_dir is absolute, -# fails when called from a subdirectory in a VPATH build with -# a relative $ac_aux_dir -# -# The reason of the latter failure is that $top_srcdir and $ac_aux_dir -# are both prefixed by $srcdir. In an in-source build this is usually -# harmless because $srcdir is `.', but things will broke when you -# start a VPATH build or use an absolute $srcdir. -# -# So we could use something similar to $top_srcdir/$ac_aux_dir/missing, -# iff we strip the leading $srcdir from $ac_aux_dir. That would be: -# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` -# and then we would define $MISSING as -# MISSING="\${SHELL} $am_aux_dir/missing" -# This will work as long as MISSING is not called from configure, because -# unfortunately $(top_srcdir) has no meaning in configure. -# However there are other variables, like CC, which are often used in -# configure, and could therefore not use this "fixed" $ac_aux_dir. -# -# Another solution, used here, is to always expand $ac_aux_dir to an -# absolute PATH. The drawback is that using absolute paths prevent a -# configured tree to be moved without reconfiguration. - -AC_DEFUN([AM_AUX_DIR_EXPAND], -[dnl Rely on autoconf to set up CDPATH properly. -AC_PREREQ([2.50])dnl -# expand $ac_aux_dir to an absolute path -am_aux_dir=`cd $ac_aux_dir && pwd` -]) - -# AM_CONDITIONAL -*- Autoconf -*- - -# Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005, 2006, 2008 -# 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 9 - -# AM_CONDITIONAL(NAME, SHELL-CONDITION) -# ------------------------------------- -# Define a conditional. -AC_DEFUN([AM_CONDITIONAL], -[AC_PREREQ(2.52)dnl - ifelse([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], - [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl -AC_SUBST([$1_TRUE])dnl -AC_SUBST([$1_FALSE])dnl -_AM_SUBST_NOTMAKE([$1_TRUE])dnl -_AM_SUBST_NOTMAKE([$1_FALSE])dnl -m4_define([_AM_COND_VALUE_$1], [$2])dnl -if $2; then - $1_TRUE= - $1_FALSE='#' -else - $1_TRUE='#' - $1_FALSE= -fi -AC_CONFIG_COMMANDS_PRE( -[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then - AC_MSG_ERROR([[conditional "$1" was never defined. -Usually this means the macro was only invoked conditionally.]]) -fi])]) - -# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009 -# 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 10 - -# There are a few dirty hacks below to avoid letting `AC_PROG_CC' be -# written in clear, in which case automake, when reading aclocal.m4, -# will think it sees a *use*, and therefore will trigger all it's -# C support machinery. Also note that it means that autoscan, seeing -# CC etc. in the Makefile, will ask for an AC_PROG_CC use... - - -# _AM_DEPENDENCIES(NAME) -# ---------------------- -# See how the compiler implements dependency checking. -# NAME is "CC", "CXX", "GCJ", or "OBJC". -# We try a few techniques and use that to set a single cache variable. -# -# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was -# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular -# dependency, and given that the user is not expected to run this macro, -# just rely on AC_PROG_CC. -AC_DEFUN([_AM_DEPENDENCIES], -[AC_REQUIRE([AM_SET_DEPDIR])dnl -AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl -AC_REQUIRE([AM_MAKE_INCLUDE])dnl -AC_REQUIRE([AM_DEP_TRACK])dnl - -ifelse([$1], CC, [depcc="$CC" am_compiler_list=], - [$1], CXX, [depcc="$CXX" am_compiler_list=], - [$1], OBJC, [depcc="$OBJC" am_compiler_list='gcc3 gcc'], - [$1], UPC, [depcc="$UPC" am_compiler_list=], - [$1], GCJ, [depcc="$GCJ" am_compiler_list='gcc3 gcc'], - [depcc="$$1" am_compiler_list=]) - -AC_CACHE_CHECK([dependency style of $depcc], - [am_cv_$1_dependencies_compiler_type], -[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then - # We make a subdir and do the tests there. Otherwise we can end up - # making bogus files that we don't know about and never remove. For - # instance it was reported that on HP-UX the gcc test will end up - # making a dummy file named `D' -- because `-MD' means `put the output - # in D'. - mkdir conftest.dir - # Copy depcomp to subdir because otherwise we won't find it if we're - # using a relative directory. - cp "$am_depcomp" conftest.dir - cd conftest.dir - # We will build objects and dependencies in a subdirectory because - # it helps to detect inapplicable dependency modes. For instance - # both Tru64's cc and ICC support -MD to output dependencies as a - # side effect of compilation, but ICC will put the dependencies in - # the current directory while Tru64 will put them in the object - # directory. - mkdir sub - - am_cv_$1_dependencies_compiler_type=none - if test "$am_compiler_list" = ""; then - am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp` - fi - am__universal=false - m4_case([$1], [CC], - [case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac], - [CXX], - [case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac]) - - for depmode in $am_compiler_list; do - # Setup a source with many dependencies, because some compilers - # like to wrap large dependency lists on column 80 (with \), and - # we should not choose a depcomp mode which is confused by this. - # - # We need to recreate these files for each test, as the compiler may - # overwrite some of them when testing with obscure command lines. - # This happens at least with the AIX C compiler. - : > sub/conftest.c - for i in 1 2 3 4 5 6; do - echo '#include "conftst'$i'.h"' >> sub/conftest.c - # Using `: > sub/conftst$i.h' creates only sub/conftst1.h with - # Solaris 8's {/usr,}/bin/sh. - touch sub/conftst$i.h - done - echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf - - # We check with `-c' and `-o' for the sake of the "dashmstdout" - # mode. It turns out that the SunPro C++ compiler does not properly - # handle `-M -o', and we need to detect this. Also, some Intel - # versions had trouble with output in subdirs - am__obj=sub/conftest.${OBJEXT-o} - am__minus_obj="-o $am__obj" - case $depmode in - gcc) - # This depmode causes a compiler race in universal mode. - test "$am__universal" = false || continue - ;; - nosideeffect) - # after this tag, mechanisms are not by side-effect, so they'll - # only be used when explicitly requested - if test "x$enable_dependency_tracking" = xyes; then - continue - else - break - fi - ;; - msvisualcpp | msvcmsys) - # This compiler won't grok `-c -o', but also, the minuso test has - # not run yet. These depmodes are late enough in the game, and - # so weak that their functioning should not be impacted. - am__obj=conftest.${OBJEXT-o} - am__minus_obj= - ;; - none) break ;; - esac - if depmode=$depmode \ - source=sub/conftest.c object=$am__obj \ - depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ - $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ - >/dev/null 2>conftest.err && - grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && - grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && - grep $am__obj sub/conftest.Po > /dev/null 2>&1 && - ${MAKE-make} -s -f confmf > /dev/null 2>&1; then - # icc doesn't choke on unknown options, it will just issue warnings - # or remarks (even with -Werror). So we grep stderr for any message - # that says an option was ignored or not supported. - # When given -MP, icc 7.0 and 7.1 complain thusly: - # icc: Command line warning: ignoring option '-M'; no argument required - # The diagnosis changed in icc 8.0: - # icc: Command line remark: option '-MP' not supported - if (grep 'ignoring option' conftest.err || - grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else - am_cv_$1_dependencies_compiler_type=$depmode - break - fi - fi - done - - cd .. - rm -rf conftest.dir -else - am_cv_$1_dependencies_compiler_type=none -fi -]) -AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type]) -AM_CONDITIONAL([am__fastdep$1], [ - test "x$enable_dependency_tracking" != xno \ - && test "$am_cv_$1_dependencies_compiler_type" = gcc3]) -]) - - -# AM_SET_DEPDIR -# ------------- -# Choose a directory name for dependency files. -# This macro is AC_REQUIREd in _AM_DEPENDENCIES -AC_DEFUN([AM_SET_DEPDIR], -[AC_REQUIRE([AM_SET_LEADING_DOT])dnl -AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl -]) - - -# AM_DEP_TRACK -# ------------ -AC_DEFUN([AM_DEP_TRACK], -[AC_ARG_ENABLE(dependency-tracking, -[ --disable-dependency-tracking speeds up one-time build - --enable-dependency-tracking do not reject slow dependency extractors]) -if test "x$enable_dependency_tracking" != xno; then - am_depcomp="$ac_aux_dir/depcomp" - AMDEPBACKSLASH='\' -fi -AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno]) -AC_SUBST([AMDEPBACKSLASH])dnl -_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl -]) - -# Generate code to set up dependency tracking. -*- Autoconf -*- - -# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2008 -# 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 5 - -# _AM_OUTPUT_DEPENDENCY_COMMANDS -# ------------------------------ -AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS], -[{ - # Autoconf 2.62 quotes --file arguments for eval, but not when files - # are listed without --file. Let's play safe and only enable the eval - # if we detect the quoting. - case $CONFIG_FILES in - *\'*) eval set x "$CONFIG_FILES" ;; - *) set x $CONFIG_FILES ;; - esac - shift - for mf - do - # Strip MF so we end up with the name of the file. - mf=`echo "$mf" | sed -e 's/:.*$//'` - # Check whether this is an Automake generated Makefile or not. - # We used to match only the files named `Makefile.in', but - # some people rename them; so instead we look at the file content. - # Grep'ing the first line is not enough: some people post-process - # each Makefile.in and add a new line on top of each file to say so. - # Grep'ing the whole file is not good either: AIX grep has a line - # limit of 2048, but all sed's we know have understand at least 4000. - if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then - dirpart=`AS_DIRNAME("$mf")` - else - continue - fi - # Extract the definition of DEPDIR, am__include, and am__quote - # from the Makefile without running `make'. - DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` - test -z "$DEPDIR" && continue - am__include=`sed -n 's/^am__include = //p' < "$mf"` - test -z "am__include" && continue - am__quote=`sed -n 's/^am__quote = //p' < "$mf"` - # When using ansi2knr, U may be empty or an underscore; expand it - U=`sed -n 's/^U = //p' < "$mf"` - # Find all dependency output files, they are included files with - # $(DEPDIR) in their names. We invoke sed twice because it is the - # simplest approach to changing $(DEPDIR) to its actual value in the - # expansion. - for file in `sed -n " - s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ - sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do - # Make sure the directory exists. - test -f "$dirpart/$file" && continue - fdir=`AS_DIRNAME(["$file"])` - AS_MKDIR_P([$dirpart/$fdir]) - # echo "creating $dirpart/$file" - echo '# dummy' > "$dirpart/$file" - done - done -} -])# _AM_OUTPUT_DEPENDENCY_COMMANDS - - -# AM_OUTPUT_DEPENDENCY_COMMANDS -# ----------------------------- -# This macro should only be invoked once -- use via AC_REQUIRE. -# -# This code is only required when automatic dependency tracking -# is enabled. FIXME. This creates each `.P' file that we will -# need in order to bootstrap the dependency handling code. -AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS], -[AC_CONFIG_COMMANDS([depfiles], - [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS], - [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"]) -]) - -# Do all the work for Automake. -*- Autoconf -*- - -# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -# 2005, 2006, 2008, 2009 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 16 - -# This macro actually does too much. Some checks are only needed if -# your package does certain things. But this isn't really a big deal. - -# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) -# AM_INIT_AUTOMAKE([OPTIONS]) -# ----------------------------------------------- -# The call with PACKAGE and VERSION arguments is the old style -# call (pre autoconf-2.50), which is being phased out. PACKAGE -# and VERSION should now be passed to AC_INIT and removed from -# the call to AM_INIT_AUTOMAKE. -# We support both call styles for the transition. After -# the next Automake release, Autoconf can make the AC_INIT -# arguments mandatory, and then we can depend on a new Autoconf -# release and drop the old call support. -AC_DEFUN([AM_INIT_AUTOMAKE], -[AC_PREREQ([2.62])dnl -dnl Autoconf wants to disallow AM_ names. We explicitly allow -dnl the ones we care about. -m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl -AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl -AC_REQUIRE([AC_PROG_INSTALL])dnl -if test "`cd $srcdir && pwd`" != "`pwd`"; then - # Use -I$(srcdir) only when $(srcdir) != ., so that make's output - # is not polluted with repeated "-I." - AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl - # test to see if srcdir already configured - if test -f $srcdir/config.status; then - AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) - fi -fi - -# test whether we have cygpath -if test -z "$CYGPATH_W"; then - if (cygpath --version) >/dev/null 2>/dev/null; then - CYGPATH_W='cygpath -w' - else - CYGPATH_W=echo - fi -fi -AC_SUBST([CYGPATH_W]) - -# Define the identity of the package. -dnl Distinguish between old-style and new-style calls. -m4_ifval([$2], -[m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl - AC_SUBST([PACKAGE], [$1])dnl - AC_SUBST([VERSION], [$2])], -[_AM_SET_OPTIONS([$1])dnl -dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT. -m4_if(m4_ifdef([AC_PACKAGE_NAME], 1)m4_ifdef([AC_PACKAGE_VERSION], 1), 11,, - [m4_fatal([AC_INIT should be called with package and version arguments])])dnl - AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl - AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl - -_AM_IF_OPTION([no-define],, -[AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package]) - AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])])dnl - -# Some tools Automake needs. -AC_REQUIRE([AM_SANITY_CHECK])dnl -AC_REQUIRE([AC_ARG_PROGRAM])dnl -AM_MISSING_PROG(ACLOCAL, aclocal-${am__api_version}) -AM_MISSING_PROG(AUTOCONF, autoconf) -AM_MISSING_PROG(AUTOMAKE, automake-${am__api_version}) -AM_MISSING_PROG(AUTOHEADER, autoheader) -AM_MISSING_PROG(MAKEINFO, makeinfo) -AC_REQUIRE([AM_PROG_INSTALL_SH])dnl -AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl -AC_REQUIRE([AM_PROG_MKDIR_P])dnl -# We need awk for the "check" target. The system "awk" is bad on -# some platforms. -AC_REQUIRE([AC_PROG_AWK])dnl -AC_REQUIRE([AC_PROG_MAKE_SET])dnl -AC_REQUIRE([AM_SET_LEADING_DOT])dnl -_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])], - [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])], - [_AM_PROG_TAR([v7])])]) -_AM_IF_OPTION([no-dependencies],, -[AC_PROVIDE_IFELSE([AC_PROG_CC], - [_AM_DEPENDENCIES(CC)], - [define([AC_PROG_CC], - defn([AC_PROG_CC])[_AM_DEPENDENCIES(CC)])])dnl -AC_PROVIDE_IFELSE([AC_PROG_CXX], - [_AM_DEPENDENCIES(CXX)], - [define([AC_PROG_CXX], - defn([AC_PROG_CXX])[_AM_DEPENDENCIES(CXX)])])dnl -AC_PROVIDE_IFELSE([AC_PROG_OBJC], - [_AM_DEPENDENCIES(OBJC)], - [define([AC_PROG_OBJC], - defn([AC_PROG_OBJC])[_AM_DEPENDENCIES(OBJC)])])dnl -]) -_AM_IF_OPTION([silent-rules], [AC_REQUIRE([AM_SILENT_RULES])])dnl -dnl The `parallel-tests' driver may need to know about EXEEXT, so add the -dnl `am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This macro -dnl is hooked onto _AC_COMPILER_EXEEXT early, see below. -AC_CONFIG_COMMANDS_PRE(dnl -[m4_provide_if([_AM_COMPILER_EXEEXT], - [AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl -]) - -dnl Hook into `_AC_COMPILER_EXEEXT' early to learn its expansion. Do not -dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further -dnl mangled by Autoconf and run in a shell conditional statement. -m4_define([_AC_COMPILER_EXEEXT], -m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])]) - - -# When config.status generates a header, we must update the stamp-h file. -# This file resides in the same directory as the config header -# that is generated. The stamp files are numbered to have different names. - -# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the -# loop where config.status creates the headers, so we can generate -# our stamp files there. -AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], -[# Compute $1's index in $config_headers. -_am_arg=$1 -_am_stamp_count=1 -for _am_header in $config_headers :; do - case $_am_header in - $_am_arg | $_am_arg:* ) - break ;; - * ) - _am_stamp_count=`expr $_am_stamp_count + 1` ;; - esac -done -echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count]) - -# Copyright (C) 2001, 2003, 2005, 2008 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. - -# AM_PROG_INSTALL_SH -# ------------------ -# Define $install_sh. -AC_DEFUN([AM_PROG_INSTALL_SH], -[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -if test x"${install_sh}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; - *) - install_sh="\${SHELL} $am_aux_dir/install-sh" - esac -fi -AC_SUBST(install_sh)]) - -# Copyright (C) 2003, 2005 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 - -# Check whether the underlying file-system supports filenames -# with a leading dot. For instance MS-DOS doesn't. -AC_DEFUN([AM_SET_LEADING_DOT], -[rm -rf .tst 2>/dev/null -mkdir .tst 2>/dev/null -if test -d .tst; then - am__leading_dot=. -else - am__leading_dot=_ -fi -rmdir .tst 2>/dev/null -AC_SUBST([am__leading_dot])]) - -# Check to see how 'make' treats includes. -*- Autoconf -*- - -# Copyright (C) 2001, 2002, 2003, 2005, 2009 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 4 - -# AM_MAKE_INCLUDE() -# ----------------- -# Check to see how make treats includes. -AC_DEFUN([AM_MAKE_INCLUDE], -[am_make=${MAKE-make} -cat > confinc << 'END' -am__doit: - @echo this is the am__doit target -.PHONY: am__doit -END -# If we don't find an include directive, just comment out the code. -AC_MSG_CHECKING([for style of include used by $am_make]) -am__include="#" -am__quote= -_am_result=none -# First try GNU make style include. -echo "include confinc" > confmf -# Ignore all kinds of additional output from `make'. -case `$am_make -s -f confmf 2> /dev/null` in #( -*the\ am__doit\ target*) - am__include=include - am__quote= - _am_result=GNU - ;; -esac -# Now try BSD make style include. -if test "$am__include" = "#"; then - echo '.include "confinc"' > confmf - case `$am_make -s -f confmf 2> /dev/null` in #( - *the\ am__doit\ target*) - am__include=.include - am__quote="\"" - _am_result=BSD - ;; - esac -fi -AC_SUBST([am__include]) -AC_SUBST([am__quote]) -AC_MSG_RESULT([$_am_result]) -rm -f confinc confmf -]) - -# Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2008 -# 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 6 - -# AM_PROG_CC_C_O -# -------------- -# Like AC_PROG_CC_C_O, but changed for automake. -AC_DEFUN([AM_PROG_CC_C_O], -[AC_REQUIRE([AC_PROG_CC_C_O])dnl -AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -AC_REQUIRE_AUX_FILE([compile])dnl -# FIXME: we rely on the cache variable name because -# there is no other way. -set dummy $CC -am_cc=`echo $[2] | sed ['s/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/']` -eval am_t=\$ac_cv_prog_cc_${am_cc}_c_o -if test "$am_t" != yes; then - # Losing compiler, so override with the script. - # FIXME: It is wrong to rewrite CC. - # But if we don't then we get into trouble of one sort or another. - # A longer-term fix would be to have automake use am__CC in this case, - # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" - CC="$am_aux_dir/compile $CC" -fi -dnl Make sure AC_PROG_CC is never called again, or it will override our -dnl setting of CC. -m4_define([AC_PROG_CC], - [m4_fatal([AC_PROG_CC cannot be called after AM_PROG_CC_C_O])]) -]) - -# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- - -# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2004, 2005, 2008 -# 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 6 - -# AM_MISSING_PROG(NAME, PROGRAM) -# ------------------------------ -AC_DEFUN([AM_MISSING_PROG], -[AC_REQUIRE([AM_MISSING_HAS_RUN]) -$1=${$1-"${am_missing_run}$2"} -AC_SUBST($1)]) - - -# AM_MISSING_HAS_RUN -# ------------------ -# Define MISSING if not defined so far and test if it supports --run. -# If it does, set am_missing_run to use it, otherwise, to nothing. -AC_DEFUN([AM_MISSING_HAS_RUN], -[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -AC_REQUIRE_AUX_FILE([missing])dnl -if test x"${MISSING+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; - *) - MISSING="\${SHELL} $am_aux_dir/missing" ;; - esac -fi -# Use eval to expand $SHELL -if eval "$MISSING --run true"; then - am_missing_run="$MISSING --run " -else - am_missing_run= - AC_MSG_WARN([`missing' script is too old or missing]) -fi -]) - -# Copyright (C) 2003, 2004, 2005, 2006 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. - -# AM_PROG_MKDIR_P -# --------------- -# Check for `mkdir -p'. -AC_DEFUN([AM_PROG_MKDIR_P], -[AC_PREREQ([2.60])dnl -AC_REQUIRE([AC_PROG_MKDIR_P])dnl -dnl Automake 1.8 to 1.9.6 used to define mkdir_p. We now use MKDIR_P, -dnl while keeping a definition of mkdir_p for backward compatibility. -dnl @MKDIR_P@ is magic: AC_OUTPUT adjusts its value for each Makefile. -dnl However we cannot define mkdir_p as $(MKDIR_P) for the sake of -dnl Makefile.ins that do not define MKDIR_P, so we do our own -dnl adjustment using top_builddir (which is defined more often than -dnl MKDIR_P). -AC_SUBST([mkdir_p], ["$MKDIR_P"])dnl -case $mkdir_p in - [[\\/$]]* | ?:[[\\/]]*) ;; - */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; -esac -]) - -# Helper functions for option handling. -*- Autoconf -*- - -# Copyright (C) 2001, 2002, 2003, 2005, 2008 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 4 - -# _AM_MANGLE_OPTION(NAME) -# ----------------------- -AC_DEFUN([_AM_MANGLE_OPTION], -[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) - -# _AM_SET_OPTION(NAME) -# ------------------------------ -# Set option NAME. Presently that only means defining a flag for this option. -AC_DEFUN([_AM_SET_OPTION], -[m4_define(_AM_MANGLE_OPTION([$1]), 1)]) - -# _AM_SET_OPTIONS(OPTIONS) -# ---------------------------------- -# OPTIONS is a space-separated list of Automake options. -AC_DEFUN([_AM_SET_OPTIONS], -[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) - -# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) -# ------------------------------------------- -# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. -AC_DEFUN([_AM_IF_OPTION], -[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) - -# Check to make sure that the build environment is sane. -*- Autoconf -*- - -# Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005, 2008 -# 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 5 - -# AM_SANITY_CHECK -# --------------- -AC_DEFUN([AM_SANITY_CHECK], -[AC_MSG_CHECKING([whether build environment is sane]) -# Just in case -sleep 1 -echo timestamp > conftest.file -# Reject unsafe characters in $srcdir or the absolute working directory -# name. Accept space and tab only in the latter. -am_lf=' -' -case `pwd` in - *[[\\\"\#\$\&\'\`$am_lf]]*) - AC_MSG_ERROR([unsafe absolute working directory name]);; -esac -case $srcdir in - *[[\\\"\#\$\&\'\`$am_lf\ \ ]]*) - AC_MSG_ERROR([unsafe srcdir value: `$srcdir']);; -esac - -# Do `set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` - if test "$[*]" = "X"; then - # -L didn't work. - set X `ls -t "$srcdir/configure" conftest.file` - fi - rm -f conftest.file - if test "$[*]" != "X $srcdir/configure conftest.file" \ - && test "$[*]" != "X conftest.file $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken -alias in your environment]) - fi - - test "$[2]" = conftest.file - ) -then - # Ok. - : -else - AC_MSG_ERROR([newly created file is older than distributed files! -Check your system clock]) -fi -AC_MSG_RESULT(yes)]) - -# Copyright (C) 2001, 2003, 2005 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. - -# AM_PROG_INSTALL_STRIP -# --------------------- -# One issue with vendor `install' (even GNU) is that you can't -# specify the program used to strip binaries. This is especially -# annoying in cross-compiling environments, where the build's strip -# is unlikely to handle the host's binaries. -# Fortunately install-sh will honor a STRIPPROG variable, so we -# always use install-sh in `make install-strip', and initialize -# STRIPPROG with the value of the STRIP variable (set by the user). -AC_DEFUN([AM_PROG_INSTALL_STRIP], -[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl -# Installed binaries are usually stripped using `strip' when the user -# run `make install-strip'. However `strip' might not be the right -# tool to use in cross-compilation environments, therefore Automake -# will honor the `STRIP' environment variable to overrule this program. -dnl Don't test for $cross_compiling = yes, because it might be `maybe'. -if test "$cross_compiling" != no; then - AC_CHECK_TOOL([STRIP], [strip], :) -fi -INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" -AC_SUBST([INSTALL_STRIP_PROGRAM])]) - -# Copyright (C) 2006, 2008 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 - -# _AM_SUBST_NOTMAKE(VARIABLE) -# --------------------------- -# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in. -# This macro is traced by Automake. -AC_DEFUN([_AM_SUBST_NOTMAKE]) - -# AM_SUBST_NOTMAKE(VARIABLE) -# --------------------------- -# Public sister of _AM_SUBST_NOTMAKE. -AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)]) - -# Check how to create a tarball. -*- Autoconf -*- - -# Copyright (C) 2004, 2005 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 - -# _AM_PROG_TAR(FORMAT) -# -------------------- -# Check how to create a tarball in format FORMAT. -# FORMAT should be one of `v7', `ustar', or `pax'. -# -# Substitute a variable $(am__tar) that is a command -# writing to stdout a FORMAT-tarball containing the directory -# $tardir. -# tardir=directory && $(am__tar) > result.tar -# -# Substitute a variable $(am__untar) that extract such -# a tarball read from stdin. -# $(am__untar) < result.tar -AC_DEFUN([_AM_PROG_TAR], -[# Always define AMTAR for backward compatibility. -AM_MISSING_PROG([AMTAR], [tar]) -m4_if([$1], [v7], - [am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'], - [m4_case([$1], [ustar],, [pax],, - [m4_fatal([Unknown tar format])]) -AC_MSG_CHECKING([how to create a $1 tar archive]) -# Loop over all known methods to create a tar archive until one works. -_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none' -_am_tools=${am_cv_prog_tar_$1-$_am_tools} -# Do not fold the above two line into one, because Tru64 sh and -# Solaris sh will not grok spaces in the rhs of `-'. -for _am_tool in $_am_tools -do - case $_am_tool in - gnutar) - for _am_tar in tar gnutar gtar; - do - AM_RUN_LOG([$_am_tar --version]) && break - done - am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"' - am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"' - am__untar="$_am_tar -xf -" - ;; - plaintar) - # Must skip GNU tar: if it does not support --format= it doesn't create - # ustar tarball either. - (tar --version) >/dev/null 2>&1 && continue - am__tar='tar chf - "$$tardir"' - am__tar_='tar chf - "$tardir"' - am__untar='tar xf -' - ;; - pax) - am__tar='pax -L -x $1 -w "$$tardir"' - am__tar_='pax -L -x $1 -w "$tardir"' - am__untar='pax -r' - ;; - cpio) - am__tar='find "$$tardir" -print | cpio -o -H $1 -L' - am__tar_='find "$tardir" -print | cpio -o -H $1 -L' - am__untar='cpio -i -H $1 -d' - ;; - none) - am__tar=false - am__tar_=false - am__untar=false - ;; - esac - - # If the value was cached, stop now. We just wanted to have am__tar - # and am__untar set. - test -n "${am_cv_prog_tar_$1}" && break - - # tar/untar a dummy directory, and stop if the command works - rm -rf conftest.dir - mkdir conftest.dir - echo GrepMe > conftest.dir/file - AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar]) - rm -rf conftest.dir - if test -s conftest.tar; then - AM_RUN_LOG([$am__untar /dev/null 2>&1 && break - fi -done -rm -rf conftest.dir - -AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool]) -AC_MSG_RESULT([$am_cv_prog_tar_$1])]) -AC_SUBST([am__tar]) -AC_SUBST([am__untar]) -]) # _AM_PROG_TAR - -m4_include([m4/00gnulib.m4]) -m4_include([m4/alloca.m4]) -m4_include([m4/c-strtod.m4]) -m4_include([m4/clock_time.m4]) -m4_include([m4/close-stream.m4]) -m4_include([m4/dirent_h.m4]) -m4_include([m4/dup2.m4]) -m4_include([m4/environ.m4]) -m4_include([m4/euidaccess.m4]) -m4_include([m4/execinfo.m4]) -m4_include([m4/extensions.m4]) -m4_include([m4/extern-inline.m4]) -m4_include([m4/faccessat.m4]) -m4_include([m4/fcntl_h.m4]) -m4_include([m4/fdopendir.m4]) -m4_include([m4/filemode.m4]) -m4_include([m4/fpending.m4]) -m4_include([m4/fstatat.m4]) -m4_include([m4/getgroups.m4]) -m4_include([m4/getloadavg.m4]) -m4_include([m4/getopt.m4]) -m4_include([m4/gettime.m4]) -m4_include([m4/gettimeofday.m4]) -m4_include([m4/gnulib-common.m4]) -m4_include([m4/gnulib-comp.m4]) -m4_include([m4/group-member.m4]) -m4_include([m4/include_next.m4]) -m4_include([m4/inttypes.m4]) -m4_include([m4/largefile.m4]) -m4_include([m4/longlong.m4]) -m4_include([m4/lstat.m4]) -m4_include([m4/manywarnings.m4]) -m4_include([m4/md5.m4]) -m4_include([m4/memrchr.m4]) -m4_include([m4/mktime.m4]) -m4_include([m4/multiarch.m4]) -m4_include([m4/nocrash.m4]) -m4_include([m4/off_t.m4]) -m4_include([m4/pathmax.m4]) -m4_include([m4/pselect.m4]) -m4_include([m4/pthread_sigmask.m4]) -m4_include([m4/putenv.m4]) -m4_include([m4/readlink.m4]) -m4_include([m4/readlinkat.m4]) -m4_include([m4/setenv.m4]) -m4_include([m4/sha1.m4]) -m4_include([m4/sha256.m4]) -m4_include([m4/sha512.m4]) -m4_include([m4/sig2str.m4]) -m4_include([m4/signal_h.m4]) -m4_include([m4/socklen.m4]) -m4_include([m4/ssize_t.m4]) -m4_include([m4/st_dm_mode.m4]) -m4_include([m4/stat-time.m4]) -m4_include([m4/stat.m4]) -m4_include([m4/stdalign.m4]) -m4_include([m4/stdarg.m4]) -m4_include([m4/stdbool.m4]) -m4_include([m4/stddef_h.m4]) -m4_include([m4/stdint.m4]) -m4_include([m4/stdio_h.m4]) -m4_include([m4/stdlib_h.m4]) -m4_include([m4/strftime.m4]) -m4_include([m4/string_h.m4]) -m4_include([m4/strtoimax.m4]) -m4_include([m4/strtoll.m4]) -m4_include([m4/strtoull.m4]) -m4_include([m4/strtoumax.m4]) -m4_include([m4/symlink.m4]) -m4_include([m4/sys_select_h.m4]) -m4_include([m4/sys_socket_h.m4]) -m4_include([m4/sys_stat_h.m4]) -m4_include([m4/sys_time_h.m4]) -m4_include([m4/time_h.m4]) -m4_include([m4/time_r.m4]) -m4_include([m4/timer_time.m4]) -m4_include([m4/timespec.m4]) -m4_include([m4/tm_gmtoff.m4]) -m4_include([m4/unistd_h.m4]) -m4_include([m4/utimbuf.m4]) -m4_include([m4/utimens.m4]) -m4_include([m4/utimes.m4]) -m4_include([m4/warnings.m4]) -m4_include([m4/wchar_t.m4]) diff --git a/autogen/compile b/autogen/compile deleted file mode 100755 index c0096a7b563..00000000000 --- a/autogen/compile +++ /dev/null @@ -1,143 +0,0 @@ -#! /bin/sh -# Wrapper for compilers which do not understand `-c -o'. - -scriptversion=2009-10-06.20; # UTC - -# Copyright (C) 1999, 2000, 2003, 2004, 2005, 2009 Free Software -# Foundation, Inc. -# Written by Tom Tromey . -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -case $1 in - '') - echo "$0: No command. Try \`$0 --help' for more information." 1>&2 - exit 1; - ;; - -h | --h*) - cat <<\EOF -Usage: compile [--help] [--version] PROGRAM [ARGS] - -Wrapper for compilers which do not understand `-c -o'. -Remove `-o dest.o' from ARGS, run PROGRAM with the remaining -arguments, and rename the output as expected. - -If you are trying to build a whole package this is not the -right script to run: please start by reading the file `INSTALL'. - -Report bugs to . -EOF - exit $? - ;; - -v | --v*) - echo "compile $scriptversion" - exit $? - ;; -esac - -ofile= -cfile= -eat= - -for arg -do - if test -n "$eat"; then - eat= - else - case $1 in - -o) - # configure might choose to run compile as `compile cc -o foo foo.c'. - # So we strip `-o arg' only if arg is an object. - eat=1 - case $2 in - *.o | *.obj) - ofile=$2 - ;; - *) - set x "$@" -o "$2" - shift - ;; - esac - ;; - *.c) - cfile=$1 - set x "$@" "$1" - shift - ;; - *) - set x "$@" "$1" - shift - ;; - esac - fi - shift -done - -if test -z "$ofile" || test -z "$cfile"; then - # If no `-o' option was seen then we might have been invoked from a - # pattern rule where we don't need one. That is ok -- this is a - # normal compilation that the losing compiler can handle. If no - # `.c' file was seen then we are probably linking. That is also - # ok. - exec "$@" -fi - -# Name of file we expect compiler to create. -cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` - -# Create the lock directory. -# Note: use `[/\\:.-]' here to ensure that we don't use the same name -# that we are using for the .o file. Also, base the name on the expected -# object file name, since that is what matters with a parallel build. -lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d -while true; do - if mkdir "$lockdir" >/dev/null 2>&1; then - break - fi - sleep 1 -done -# FIXME: race condition here if user kills between mkdir and trap. -trap "rmdir '$lockdir'; exit 1" 1 2 15 - -# Run the compile. -"$@" -ret=$? - -if test -f "$cofile"; then - test "$cofile" = "$ofile" || mv "$cofile" "$ofile" -elif test -f "${cofile}bj"; then - test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" -fi - -rmdir "$lockdir" -exit $ret - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff --git a/autogen/config.guess b/autogen/config.guess deleted file mode 100755 index e3a2116a7dc..00000000000 --- a/autogen/config.guess +++ /dev/null @@ -1,1533 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -# Free Software Foundation, Inc. - -timestamp='2009-06-10' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 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, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner . -# Please send patches to . Submit a context -# diff and a properly formatted ChangeLog entry. -# -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. -# -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -trap 'exit 1' 1 2 15 - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int x;" > $dummy.c ; - for c in cc gcc c89 c99 ; do - if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ - /usr/sbin/$sysctl 2>/dev/null || echo unknown)` - case "${UNAME_MACHINE_ARCH}" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - *) machine=${UNAME_MACHINE_ARCH}-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently, or will in the future. - case "${UNAME_MACHINE_ARCH}" in - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval $set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case "${UNAME_VERSION}" in - Debian*) - release='-gnu' - ;; - *) - release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} - exit ;; - *:ekkoBSD:*:*) - echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} - exit ;; - *:SolidBSD:*:*) - echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} - exit ;; - macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd${UNAME_RELEASE} - exit ;; - *:MirBSD:*:*) - echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} - exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") - UNAME_MACHINE="alpha" ;; - "EV4.5 (21064)") - UNAME_MACHINE="alpha" ;; - "LCA4 (21066/21068)") - UNAME_MACHINE="alpha" ;; - "EV5 (21164)") - UNAME_MACHINE="alphaev5" ;; - "EV5.6 (21164A)") - UNAME_MACHINE="alphaev56" ;; - "EV5.6 (21164PC)") - UNAME_MACHINE="alphapca56" ;; - "EV5.7 (21164PC)") - UNAME_MACHINE="alphapca57" ;; - "EV6 (21264)") - UNAME_MACHINE="alphaev6" ;; - "EV6.7 (21264A)") - UNAME_MACHINE="alphaev67" ;; - "EV6.8CB (21264C)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8AL (21264B)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8CX (21264D)") - UNAME_MACHINE="alphaev68" ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE="alphaev69" ;; - "EV7 (21364)") - UNAME_MACHINE="alphaev7" ;; - "EV7.9 (21364A)") - UNAME_MACHINE="alphaev79" ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; - *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; - *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; - DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - s390x:SunOS:*:*) - echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval $set_cc_for_build - SUN_ARCH="i386" - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH="x86_64" - fi - fi - echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; - m68k:machten:*:*) - echo m68k-apple-machten${UNAME_RELEASE} - exit ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && - dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`$dummy $dummyarg` && - { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos${UNAME_RELEASE} - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; - Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] - then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ - [ ${TARGET_BINARY_INTERFACE}x = x ] - then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else - echo i586-dg-dgux${UNAME_RELEASE} - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` - then - echo "$SYSTEM_NAME" - else - echo rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit ;; - *:AIX:*:[456]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; - '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac - fi - if [ "${HP_ARCH}" = "" ]; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if [ ${HP_ARCH} = "hppa2.0w" ] - then - eval $set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then - HP_ARCH="hppa2.0w" - else - HP_ARCH="hppa64" - fi - fi - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux${HPUX_REV} - exit ;; - 3050*:HI-UX:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - amd64) - echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - esac - exit ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin - exit ;; - *:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; - i*:PW*:*) - echo ${UNAME_MACHINE}-pc-pw32 - exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - EM64T | authenticamd | genuineintel) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; - IA64) - echo ia64-unknown-interix${UNAME_RELEASE} - exit ;; - esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - 8664:Windows_NT:*) - echo x86_64-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; - i*:UWIN*:*) - echo ${UNAME_MACHINE}-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin - exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - *:GNU:*:*) - # the GNU system - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu - exit ;; - i*86:Minix:*:*) - echo ${UNAME_MACHINE}-pc-minix - exit ;; - arm*:Linux:*:*) - eval $set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - echo ${UNAME_MACHINE}-unknown-linux-gnu - else - echo ${UNAME_MACHINE}-unknown-linux-gnueabi - fi - exit ;; - avr32*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - cris:Linux:*:*) - echo cris-axis-linux-gnu - exit ;; - crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu - exit ;; - frv:Linux:*:*) - echo frv-unknown-linux-gnu - exit ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m32r*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - mips:Linux:*:* | mips64:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef ${UNAME_MACHINE} - #undef ${UNAME_MACHINE}el - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=${UNAME_MACHINE}el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=${UNAME_MACHINE} - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu - exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu - exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} - exit ;; - padre:Linux:*:*) - echo sparc-unknown-linux-gnu - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-gnu ;; - PA8*) echo hppa2.0-unknown-linux-gnu ;; - *) echo hppa-unknown-linux-gnu ;; - esac - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux - exit ;; - sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sh*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - vax:Linux:*:*) - echo ${UNAME_MACHINE}-dec-linux-gnu - exit ;; - x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu - exit ;; - xtensa*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo ${UNAME_MACHINE}-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) - echo ${UNAME_MACHINE}-unknown-stop - exit ;; - i*86:atheos:*:*) - echo ${UNAME_MACHINE}-unknown-atheos - exit ;; - i*86:syllable:*:*) - echo ${UNAME_MACHINE}-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit ;; - i*86:*DOS:*:*) - echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit ;; - i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) - UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} - fi - exit ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub - # prints for the "djgpp" host, or else GDB configury will decide that - # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit ;; - mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; - M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - NCR*:*:4.2:* | MPRAS*:*:4.2:*) - OS_REL='.3' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - echo ${UNAME_MACHINE}-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux${UNAME_RELEASE} - exit ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux${UNAME_RELEASE} - exit ;; - SX-6:SUPER-UX:*:*) - echo sx6-nec-superux${UNAME_RELEASE} - exit ;; - SX-7:SUPER-UX:*:*) - echo sx7-nec-superux${UNAME_RELEASE} - exit ;; - SX-8:SUPER-UX:*:*) - echo sx8-nec-superux${UNAME_RELEASE} - exit ;; - SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux${UNAME_RELEASE} - exit ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Rhapsody:*:*) - echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - case $UNAME_PROCESSOR in - unknown) UNAME_PROCESSOR=powerpc ;; - esac - echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = "x86"; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; - NSE-?:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk${UNAME_RELEASE} - exit ;; - NSR-?:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk${UNAME_RELEASE} - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) - echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "$cputype" = "386"; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo ${UNAME_MACHINE}-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} - exit ;; - *:DragonFly:*:*) - echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "${UNAME_MACHINE}" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; - esac ;; - *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) - echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' - exit ;; - i*86:rdos:*:*) - echo ${UNAME_MACHINE}-pc-rdos - exit ;; - i*86:AROS:*:*) - echo ${UNAME_MACHINE}-pc-aros - exit ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -eval $set_cc_for_build -cat >$dummy.c < -# include -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix\n"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -# if !defined (ultrix) -# include -# if defined (BSD) -# if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -# else -# if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# endif -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# else - printf ("vax-dec-ultrix\n"); exit (0); -# endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - c34*) - echo c34-convex-bsd - exit ;; - c38*) - echo c38-convex-bsd - exit ;; - c4*) - echo c4-convex-bsd - exit ;; - esac -fi - -cat >&2 < in order to provide the needed -information to handle your system. - -config.guess timestamp = $timestamp - -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = ${UNAME_MACHINE} -UNAME_RELEASE = ${UNAME_RELEASE} -UNAME_SYSTEM = ${UNAME_SYSTEM} -UNAME_VERSION = ${UNAME_VERSION} -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/autogen/config.sub b/autogen/config.sub deleted file mode 100755 index eb0389a693f..00000000000 --- a/autogen/config.sub +++ /dev/null @@ -1,1693 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -# Free Software Foundation, Inc. - -timestamp='2009-06-11' - -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 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, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Please send patches to . Submit a context -# diff and a properly formatted ChangeLog entry. -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS - $0 [OPTION] ALIAS - -Canonicalize a configuration name. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo $1 - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ - kopensolaris*-gnu* | \ - storm-chaos* | os2-emx* | rtmk-nova*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) - os= - basic_machine=$1 - ;; - -bluegene*) - os=-cnk - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -chorusos*) - os=-chorusos - basic_machine=$1 - ;; - -chorusrdb) - os=-chorusrdb - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco6) - os=-sco5v6 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ - | bfin \ - | c4x | clipper \ - | d10v | d30v | dlx | dsp16xx \ - | fido | fr30 | frv \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | i370 | i860 | i960 | ia64 \ - | ip2k | iq2000 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | moxie \ - | mt \ - | msp430 \ - | nios | nios2 \ - | ns16k | ns32k \ - | or32 \ - | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ - | pyramid \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ - | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. - basic_machine=$basic_machine-unknown - os=-none - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) - ;; - ms1) - basic_machine=mt-unknown - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - 580-* \ - | a29k-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* | avr32-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | craynv-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* | iq2000-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mt-* \ - | msp430-* \ - | nios-* | nios2-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ - | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* | tile-* \ - | tron-* \ - | v850-* | v850e-* | vax-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-unknown - os=-bsd - ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - abacus) - basic_machine=abacus-unknown - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aros) - basic_machine=i386-pc - os=-aros - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=-linux - ;; - blackfin-*) - basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - bluegene*) - basic_machine=powerpc-ibm - os=-cnk - ;; - c90) - basic_machine=c90-cray - os=-unicos - ;; - cegcc) - basic_machine=arm-unknown - os=-cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | j90) - basic_machine=j90-cray - os=-unicos - ;; - craynv) - basic_machine=craynv-cray - os=-unicosmp - ;; - cr16) - basic_machine=cr16-unknown - os=-elf - ;; - crds | unos) - basic_machine=m68k-crds - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=-elf - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - decsystem10* | dec10*) - basic_machine=pdp10-dec - os=-tops10 - ;; - decsystem20* | dec20*) - basic_machine=pdp10-dec - os=-tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dicos) - basic_machine=i686-pc - os=-dicos - ;; - djgpp) - basic_machine=i586-pc - os=-msdosdjgpp - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i*86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i*86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i*86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i*86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - i386-vsta | vsta) - basic_machine=i386-unknown - os=-vsta - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m68knommu) - basic_machine=m68k-unknown - os=-linux - ;; - m68knommu-*) - basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - mingw32) - basic_machine=i386-pc - os=-mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=-mingw32ce - ;; - miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - morphos) - basic_machine=powerpc-unknown - os=-morphos - ;; - msdos) - basic_machine=i386-pc - os=-msdos - ;; - ms1-*) - basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; - np1) - basic_machine=np1-gould - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; - os400) - basic_machine=powerpc-ibm - os=-os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - parisc) - basic_machine=hppa-unknown - os=-linux - ;; - parisc-*) - basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pc98) - basic_machine=i386-pc - ;; - pc98-*) - basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc - ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc - ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc - ;; - pentium4) - basic_machine=i786-pc - ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium4-*) - basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=power-ibm - ;; - ppc) basic_machine=powerpc-unknown - ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64) basic_machine=powerpc64-unknown - ;; - ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64le | powerpc64little | ppc64-le | powerpc64-little) - basic_machine=powerpc64le-unknown - ;; - ppc64le-* | powerpc64little-*) - basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - pw32) - basic_machine=i586-unknown - os=-pw32 - ;; - rdos) - basic_machine=i386-pc - os=-rdos - ;; - rom68k) - basic_machine=m68k-rom68k - os=-coff - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - s390 | s390-*) - basic_machine=s390-ibm - ;; - s390x | s390x-*) - basic_machine=s390x-ibm - ;; - sa29200) - basic_machine=a29k-amd - os=-udi - ;; - sb1) - basic_machine=mipsisa64sb1-unknown - ;; - sb1el) - basic_machine=mipsisa64sb1el-unknown - ;; - sde) - basic_machine=mipsisa32-sde - os=-elf - ;; - sei) - basic_machine=mips-sei - os=-seiux - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sh5el) - basic_machine=sh5le-unknown - ;; - sh64) - basic_machine=sh64-unknown - ;; - sparclite-wrs | simso-wrs) - basic_machine=sparclite-wrs - os=-vxworks - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - st2000) - basic_machine=m68k-tandem - ;; - stratus) - basic_machine=i860-stratus - os=-sysv4 - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - sv1) - basic_machine=sv1-cray - os=-unicos - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - t3e) - basic_machine=alphaev5-cray - os=-unicos - ;; - t90) - basic_machine=t90-cray - os=-unicos - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff - ;; - tile*) - basic_machine=tile-unknown - os=-linux-gnu - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - toad1) - basic_machine=pdp10-xkl - os=-tops20 - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - tpf) - basic_machine=s390x-ibm - os=-tpf - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=-none - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - w65*) - basic_machine=w65-wdc - os=-none - ;; - w89k-*) - basic_machine=hppa1.1-winbond - os=-proelf - ;; - xbox) - basic_machine=i686-pc - os=-mingw32 - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - ymp) - basic_machine=ymp-cray - os=-unicos - ;; - z8k-*-coff) - basic_machine=z8k-unknown - os=-sim - ;; - z80-*-coff) - basic_machine=z80-unknown - os=-sim - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp10) - # there are many clones, so DEC is not a safe bet - basic_machine=pdp10-unknown - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) - basic_machine=sh-unknown - ;; - sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - *-unknown) - # Make sure to match an already-canonicalized machine name. - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ - | -kopensolaris* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* | -aros* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ - | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ - | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* | -cegcc* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ - | -uxpv* | -beos* | -mpeix* | -udk* \ - | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ - | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ - | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ - | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ - | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -qnx*) - case $basic_machine in - x86-* | i*86-*) - ;; - *) - os=-nto$os - ;; - esac - ;; - -nto-qnx*) - ;; - -nto*) - os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; - -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ - | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) - ;; - -mac*) - os=`echo $os | sed -e 's|mac|macos|'` - ;; - -linux-dietlibc) - os=-linux-dietlibc - ;; - -linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -opened*) - os=-openedition - ;; - -os400*) - os=-os400 - ;; - -wince*) - os=-wince - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -atheos*) - os=-atheos - ;; - -syllable*) - os=-syllable - ;; - -386bsd) - os=-bsd - ;; - -ctix* | -uts*) - os=-sysv - ;; - -nova*) - os=-rtmk-nova - ;; - -ns2 ) - os=-nextstep2 - ;; - -nsk*) - os=-nsk - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -tpf*) - os=-tpf - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -ose*) - os=-ose - ;; - -es1800*) - os=-ose - ;; - -xenix) - os=-xenix - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - os=-mint - ;; - -aros*) - os=-aros - ;; - -kaos*) - os=-kaos - ;; - -zvmoe) - os=-zvmoe - ;; - -dicos*) - os=-dicos - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - score-*) - os=-elf - ;; - spu-*) - os=-elf - ;; - *-acorn) - os=-riscix1.2 - ;; - arm*-rebel) - os=-linux - ;; - arm*-semi) - os=-aout - ;; - c4x-* | tic4x-*) - os=-coff - ;; - # This must come before the *-dec entry. - pdp10-*) - os=-tops20 - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 - ;; - m68*-cisco) - os=-aout - ;; - mep-*) - os=-elf - ;; - mips*-cisco) - os=-elf - ;; - mips*-*) - os=-elf - ;; - or32-*) - os=-coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-haiku) - os=-haiku - ;; - *-ibm) - os=-aix - ;; - *-knuth) - os=-mmixware - ;; - *-wec) - os=-proelf - ;; - *-winbond) - os=-proelf - ;; - *-oki) - os=-proelf - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=-uxpv - ;; - *-rom68k) - os=-coff - ;; - *-*bug) - os=-coff - ;; - *-apple) - os=-macos - ;; - *-atari*) - os=-mint - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -cnk*|-aix*) - vendor=ibm - ;; - -beos*) - vendor=be - ;; - -hpux*) - vendor=hp - ;; - -mpeix*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs* | -opened*) - vendor=ibm - ;; - -os400*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -tpf*) - vendor=ibm - ;; - -vxsim* | -vxworks* | -windiss*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - -hms*) - vendor=hitachi - ;; - -mpw* | -macos*) - vendor=apple - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - vendor=atari - ;; - -vos*) - vendor=stratus - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os -exit - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/autogen/configure b/autogen/configure deleted file mode 100755 index a1844067f9d..00000000000 --- a/autogen/configure +++ /dev/null @@ -1,28329 +0,0 @@ -#! /bin/sh -# Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.65 for emacs 24.3.50. -# -# -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, -# Inc. -# -# -# This configure script is free software; the Free Software Foundation -# gives unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - # We cannot yet assume a decent shell, so we have to provide a - # neutralization value for shells without unset; and this also - # works around shells that cannot unset nonexistent variables. - BASH_ENV=/dev/null - ENV=/dev/null - (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." - else - $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, -$0: including any error possibly output before this -$0: message. Then install a modern shell, or manually run -$0: the script under such a shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" - - -} # as_fn_mkdir_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. -as_fn_error () -{ - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 - fi - $as_echo "$as_me: error: $1" >&2 - as_fn_exit $as_status -} # as_fn_error - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - - - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | - sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno - N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ - t loop - s/-\n.*// - ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" - # Exit status is that of the last command. - exit -} - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -p' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -p' - fi -else - as_ln_s='cp -p' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -if test -x / >/dev/null 2>&1; then - as_test_x='test -x' -else - if ls -dL / >/dev/null 2>&1; then - as_ls_L_option=L - else - as_ls_L_option= - fi - as_test_x=' - eval sh -c '\'' - if test -d "$1"; then - test -d "$1/."; - else - case $1 in #( - -*)set "./$1";; - esac; - case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( - ???[sx]*):;;*)false;;esac;fi - '\'' sh - ' -fi -as_executable_p=$as_test_x - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -test -n "$DJDIR" || exec 7<&0 &1 - -# Name of the host. -# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, -# so uname gets run too. -ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` - -# -# Initializations. -# -ac_default_prefix=/usr/local -ac_clean_files= -ac_config_libobj_dir=. -LIBOBJS= -cross_compiling=no -subdirs= -MFLAGS= -MAKEFLAGS= - -# Identity of this package. -PACKAGE_NAME='emacs' -PACKAGE_TARNAME='emacs' -PACKAGE_VERSION='24.3.50' -PACKAGE_STRING='emacs 24.3.50' -PACKAGE_BUGREPORT='' -PACKAGE_URL='' - -ac_unique_file="src/lisp.h" -# Factoring default headers for most tests. -ac_includes_default="\ -#include -#ifdef HAVE_SYS_TYPES_H -# include -#endif -#ifdef HAVE_SYS_STAT_H -# include -#endif -#ifdef STDC_HEADERS -# include -# include -#else -# ifdef HAVE_STDLIB_H -# include -# endif -#endif -#ifdef HAVE_STRING_H -# if !defined STDC_HEADERS && defined HAVE_MEMORY_H -# include -# endif -# include -#endif -#ifdef HAVE_STRINGS_H -# include -#endif -#ifdef HAVE_INTTYPES_H -# include -#endif -#ifdef HAVE_STDINT_H -# include -#endif -#ifdef HAVE_UNISTD_H -# include -#endif" - -ac_header_list= -ac_func_list= -gl_getopt_required=POSIX -gl_getopt_required=POSIX -ac_subst_vars='gltests_LTLIBOBJS -gltests_LIBOBJS -gl_LTLIBOBJS -gl_LIBOBJS -am__EXEEXT_FALSE -am__EXEEXT_TRUE -LTLIBOBJS -LIBOBJS -SUBDIR_MAKEFILES_IN -WINDOW_SYSTEM_OBJ -LD_SWITCH_SYSTEM_TEMACS -LIBGNU_LTLIBDEPS -LIBGNU_LIBDEPS -gltests_WITNESS -gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE -gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE -gl_GNULIB_ENABLED_verify_FALSE -gl_GNULIB_ENABLED_verify_TRUE -gl_GNULIB_ENABLED_strtoull_FALSE -gl_GNULIB_ENABLED_strtoull_TRUE -gl_GNULIB_ENABLED_strtoll_FALSE -gl_GNULIB_ENABLED_strtoll_TRUE -gl_GNULIB_ENABLED_stat_FALSE -gl_GNULIB_ENABLED_stat_TRUE -gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE -gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE -gl_GNULIB_ENABLED_pathmax_FALSE -gl_GNULIB_ENABLED_pathmax_TRUE -gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_FALSE -gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_TRUE -gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE -gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE -gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE -gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE -gl_GNULIB_ENABLED_getgroups_FALSE -gl_GNULIB_ENABLED_getgroups_TRUE -gl_GNULIB_ENABLED_euidaccess_FALSE -gl_GNULIB_ENABLED_euidaccess_TRUE -gl_GNULIB_ENABLED_dosname_FALSE -gl_GNULIB_ENABLED_dosname_TRUE -gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_FALSE -gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_TRUE -LTLIBINTL -LIBINTL -LIB_EACCESS -WINDOWS_64_BIT_OFF_T -HAVE_UNISTD_H -NEXT_AS_FIRST_DIRECTIVE_UNISTD_H -NEXT_UNISTD_H -LIB_TIMER_TIME -PTHREAD_H_DEFINES_STRUCT_TIMESPEC -SYS_TIME_H_DEFINES_STRUCT_TIMESPEC -TIME_H_DEFINES_STRUCT_TIMESPEC -NEXT_AS_FIRST_DIRECTIVE_TIME_H -NEXT_TIME_H -WINDOWS_64_BIT_ST_SIZE -NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H -NEXT_SYS_STAT_H -NEXT_AS_FIRST_DIRECTIVE_STRING_H -NEXT_STRING_H -NEXT_AS_FIRST_DIRECTIVE_STDLIB_H -NEXT_STDLIB_H -NEXT_AS_FIRST_DIRECTIVE_STDIO_H -NEXT_STDIO_H -REPLACE_VSPRINTF -REPLACE_VSNPRINTF -REPLACE_VPRINTF -REPLACE_VFPRINTF -REPLACE_VDPRINTF -REPLACE_VASPRINTF -REPLACE_TMPFILE -REPLACE_STDIO_WRITE_FUNCS -REPLACE_STDIO_READ_FUNCS -REPLACE_SPRINTF -REPLACE_SNPRINTF -REPLACE_RENAMEAT -REPLACE_RENAME -REPLACE_REMOVE -REPLACE_PRINTF -REPLACE_POPEN -REPLACE_PERROR -REPLACE_OBSTACK_PRINTF -REPLACE_GETLINE -REPLACE_GETDELIM -REPLACE_FTELLO -REPLACE_FTELL -REPLACE_FSEEKO -REPLACE_FSEEK -REPLACE_FREOPEN -REPLACE_FPURGE -REPLACE_FPRINTF -REPLACE_FOPEN -REPLACE_FFLUSH -REPLACE_FDOPEN -REPLACE_FCLOSE -REPLACE_DPRINTF -HAVE_VDPRINTF -HAVE_VASPRINTF -HAVE_RENAMEAT -HAVE_POPEN -HAVE_PCLOSE -HAVE_FTELLO -HAVE_FSEEKO -HAVE_DPRINTF -HAVE_DECL_VSNPRINTF -HAVE_DECL_SNPRINTF -HAVE_DECL_OBSTACK_PRINTF -HAVE_DECL_GETLINE -HAVE_DECL_GETDELIM -HAVE_DECL_FTELLO -HAVE_DECL_FSEEKO -HAVE_DECL_FPURGE -GNULIB_VSPRINTF_POSIX -GNULIB_VSNPRINTF -GNULIB_VPRINTF_POSIX -GNULIB_VPRINTF -GNULIB_VFPRINTF_POSIX -GNULIB_VFPRINTF -GNULIB_VDPRINTF -GNULIB_VSCANF -GNULIB_VFSCANF -GNULIB_VASPRINTF -GNULIB_TMPFILE -GNULIB_STDIO_H_SIGPIPE -GNULIB_STDIO_H_NONBLOCKING -GNULIB_SPRINTF_POSIX -GNULIB_SNPRINTF -GNULIB_SCANF -GNULIB_RENAMEAT -GNULIB_RENAME -GNULIB_REMOVE -GNULIB_PUTS -GNULIB_PUTCHAR -GNULIB_PUTC -GNULIB_PRINTF_POSIX -GNULIB_PRINTF -GNULIB_POPEN -GNULIB_PERROR -GNULIB_PCLOSE -GNULIB_OBSTACK_PRINTF_POSIX -GNULIB_OBSTACK_PRINTF -GNULIB_GETLINE -GNULIB_GETDELIM -GNULIB_GETCHAR -GNULIB_GETC -GNULIB_FWRITE -GNULIB_FTELLO -GNULIB_FTELL -GNULIB_FSEEKO -GNULIB_FSEEK -GNULIB_FSCANF -GNULIB_FREOPEN -GNULIB_FREAD -GNULIB_FPUTS -GNULIB_FPUTC -GNULIB_FPURGE -GNULIB_FPRINTF_POSIX -GNULIB_FPRINTF -GNULIB_FOPEN -GNULIB_FGETS -GNULIB_FGETC -GNULIB_FFLUSH -GNULIB_FDOPEN -GNULIB_FCLOSE -GNULIB_DPRINTF -NEXT_AS_FIRST_DIRECTIVE_STDDEF_H -NEXT_STDDEF_H -GL_GENERATE_STDDEF_H_FALSE -GL_GENERATE_STDDEF_H_TRUE -STDDEF_H -HAVE_WCHAR_T -REPLACE_NULL -HAVE__BOOL -GL_GENERATE_STDBOOL_H_FALSE -GL_GENERATE_STDBOOL_H_TRUE -STDBOOL_H -GL_GENERATE_STDARG_H_FALSE -GL_GENERATE_STDARG_H_TRUE -STDARG_H -NEXT_AS_FIRST_DIRECTIVE_STDARG_H -NEXT_STDARG_H -GL_GENERATE_STDALIGN_H_FALSE -GL_GENERATE_STDALIGN_H_TRUE -STDALIGN_H -NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H -NEXT_SIGNAL_H -LIB_PTHREAD_SIGMASK -REPLACE_RAISE -REPLACE_PTHREAD_SIGMASK -HAVE_SIGHANDLER_T -HAVE_TYPE_VOLATILE_SIG_ATOMIC_T -HAVE_STRUCT_SIGACTION_SA_SIGACTION -HAVE_SIGACTION -HAVE_SIGINFO_T -HAVE_SIGSET_T -HAVE_RAISE -HAVE_PTHREAD_SIGMASK -HAVE_POSIX_SIGNALBLOCKING -GNULIB_SIGACTION -GNULIB_SIGPROCMASK -GNULIB_SIGNAL_H_SIGPIPE -GNULIB_RAISE -GNULIB_PTHREAD_SIGMASK -HAVE_SYS_SELECT_H -NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H -NEXT_SYS_SELECT_H -REPLACE_SELECT -REPLACE_PSELECT -HAVE_PSELECT -GNULIB_SELECT -GNULIB_PSELECT -REPLACE_TIMEGM -REPLACE_NANOSLEEP -REPLACE_MKTIME -REPLACE_LOCALTIME_R -HAVE_TIMEGM -HAVE_STRPTIME -HAVE_NANOSLEEP -HAVE_DECL_LOCALTIME_R -GNULIB_TIME_R -GNULIB_TIMEGM -GNULIB_STRPTIME -GNULIB_NANOSLEEP -GNULIB_MKTIME -UNDEFINE_STRTOK_R -REPLACE_STRTOK_R -REPLACE_STRSIGNAL -REPLACE_STRNLEN -REPLACE_STRNDUP -REPLACE_STRNCAT -REPLACE_STRERROR_R -REPLACE_STRERROR -REPLACE_STRCHRNUL -REPLACE_STRCASESTR -REPLACE_STRSTR -REPLACE_STRDUP -REPLACE_STPNCPY -REPLACE_MEMMEM -REPLACE_MEMCHR -HAVE_STRVERSCMP -HAVE_DECL_STRSIGNAL -HAVE_DECL_STRERROR_R -HAVE_DECL_STRTOK_R -HAVE_STRCASESTR -HAVE_STRSEP -HAVE_STRPBRK -HAVE_DECL_STRNLEN -HAVE_DECL_STRNDUP -HAVE_DECL_STRDUP -HAVE_STRCHRNUL -HAVE_STPNCPY -HAVE_STPCPY -HAVE_RAWMEMCHR -HAVE_DECL_MEMRCHR -HAVE_MEMPCPY -HAVE_DECL_MEMMEM -HAVE_MEMCHR -HAVE_FFSLL -HAVE_FFSL -HAVE_MBSLEN -GNULIB_STRVERSCMP -GNULIB_STRSIGNAL -GNULIB_STRERROR_R -GNULIB_STRERROR -GNULIB_MBSTOK_R -GNULIB_MBSSEP -GNULIB_MBSSPN -GNULIB_MBSPBRK -GNULIB_MBSCSPN -GNULIB_MBSCASESTR -GNULIB_MBSPCASECMP -GNULIB_MBSNCASECMP -GNULIB_MBSCASECMP -GNULIB_MBSSTR -GNULIB_MBSRCHR -GNULIB_MBSCHR -GNULIB_MBSNLEN -GNULIB_MBSLEN -GNULIB_STRTOK_R -GNULIB_STRCASESTR -GNULIB_STRSTR -GNULIB_STRSEP -GNULIB_STRPBRK -GNULIB_STRNLEN -GNULIB_STRNDUP -GNULIB_STRNCAT -GNULIB_STRDUP -GNULIB_STRCHRNUL -GNULIB_STPNCPY -GNULIB_STPCPY -GNULIB_RAWMEMCHR -GNULIB_MEMRCHR -GNULIB_MEMPCPY -GNULIB_MEMMEM -GNULIB_MEMCHR -GNULIB_FFSLL -GNULIB_FFSL -NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H -NEXT_INTTYPES_H -UINT64_MAX_EQ_ULONG_MAX -UINT32_MAX_LT_UINTMAX_MAX -PRIPTR_PREFIX -PRI_MACROS_BROKEN -INT64_MAX_EQ_LONG_MAX -INT32_MAX_LT_INTMAX_MAX -REPLACE_STRTOIMAX -HAVE_DECL_STRTOUMAX -HAVE_DECL_STRTOIMAX -HAVE_DECL_IMAXDIV -HAVE_DECL_IMAXABS -GNULIB_STRTOUMAX -GNULIB_STRTOIMAX -GNULIB_IMAXDIV -GNULIB_IMAXABS -GL_GENERATE_STDINT_H_FALSE -GL_GENERATE_STDINT_H_TRUE -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 -APPLE_UNIVERSAL_BUILD -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 -HAVE_WINSOCK2_H -NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H -NEXT_SYS_TIME_H -REPLACE_STRUCT_TIMEVAL -REPLACE_GETTIMEOFDAY -HAVE_SYS_TIME_H -HAVE_STRUCT_TIMEVAL -HAVE_GETTIMEOFDAY -GNULIB_GETTIMEOFDAY -GNULIB_GL_UNISTD_H_GETOPT -GETOPT_H -HAVE_GETOPT_H -NEXT_AS_FIRST_DIRECTIVE_GETOPT_H -NEXT_GETOPT_H -GETLOADAVG_LIBS -REPLACE_WCTOMB -REPLACE_UNSETENV -REPLACE_STRTOD -REPLACE_SETENV -REPLACE_REALPATH -REPLACE_REALLOC -REPLACE_RANDOM_R -REPLACE_PUTENV -REPLACE_PTSNAME_R -REPLACE_PTSNAME -REPLACE_MKSTEMP -REPLACE_MBTOWC -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_SECURE_GETENV -HAVE_RPMATCH -HAVE_REALPATH -HAVE_RANDOM_R -HAVE_RANDOM_H -HAVE_RANDOM -HAVE_PTSNAME_R -HAVE_PTSNAME -HAVE_POSIX_OPENPT -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_WCTOMB -GNULIB_UNSETENV -GNULIB_UNLOCKPT -GNULIB_SYSTEM_POSIX -GNULIB_STRTOULL -GNULIB_STRTOLL -GNULIB_STRTOD -GNULIB_SETENV -GNULIB_SECURE_GETENV -GNULIB_RPMATCH -GNULIB_REALPATH -GNULIB_REALLOC_POSIX -GNULIB_RANDOM_R -GNULIB_RANDOM -GNULIB_PUTENV -GNULIB_PTSNAME_R -GNULIB_PTSNAME -GNULIB_POSIX_OPENPT -GNULIB_MKSTEMPS -GNULIB_MKSTEMP -GNULIB_MKOSTEMPS -GNULIB_MKOSTEMP -GNULIB_MKDTEMP -GNULIB_MBTOWC -GNULIB_MALLOC_POSIX -GNULIB_GRANTPT -GNULIB_GETSUBOPT -GNULIB_GETLOADAVG -GNULIB_CANONICALIZE_FILE_NAME -GNULIB_CALLOC_POSIX -GNULIB_ATOLL -GNULIB__EXIT -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_FSTAT -GNULIB_FCHMODAT -NEXT_AS_FIRST_DIRECTIVE_FCNTL_H -NEXT_FCNTL_H -REPLACE_OPENAT -REPLACE_OPEN -REPLACE_FCNTL -HAVE_OPENAT -HAVE_FCNTL -GNULIB_OPENAT -GNULIB_OPEN -GNULIB_NONBLOCKING -GNULIB_FCNTL -GL_GENERATE_EXECINFO_H_FALSE -GL_GENERATE_EXECINFO_H_TRUE -LIB_EXECINFO -EXECINFO_H -HAVE_DIRENT_H -NEXT_AS_FIRST_DIRECTIVE_DIRENT_H -NEXT_DIRENT_H -PRAGMA_COLUMNS -PRAGMA_SYSTEM_HEADER -INCLUDE_NEXT_AS_FIRST_DIRECTIVE -INCLUDE_NEXT -REPLACE_FDOPENDIR -REPLACE_DIRFD -REPLACE_CLOSEDIR -REPLACE_OPENDIR -HAVE_ALPHASORT -HAVE_SCANDIR -HAVE_FDOPENDIR -HAVE_DECL_FDOPENDIR -HAVE_DECL_DIRFD -HAVE_CLOSEDIR -HAVE_REWINDDIR -HAVE_READDIR -HAVE_OPENDIR -GNULIB_ALPHASORT -GNULIB_SCANDIR -GNULIB_FDOPENDIR -GNULIB_DIRFD -GNULIB_CLOSEDIR -GNULIB_REWINDDIR -GNULIB_READDIR -GNULIB_OPENDIR -UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS -UNISTD_H_HAVE_WINSOCK2_H -REPLACE_WRITE -REPLACE_USLEEP -REPLACE_UNLINKAT -REPLACE_UNLINK -REPLACE_TTYNAME_R -REPLACE_SYMLINK -REPLACE_SLEEP -REPLACE_RMDIR -REPLACE_READLINK -REPLACE_READ -REPLACE_PWRITE -REPLACE_PREAD -REPLACE_LSEEK -REPLACE_LINKAT -REPLACE_LINK -REPLACE_LCHOWN -REPLACE_ISATTY -REPLACE_GETPAGESIZE -REPLACE_GETGROUPS -REPLACE_GETLOGIN_R -REPLACE_GETDOMAINNAME -REPLACE_GETCWD -REPLACE_FTRUNCATE -REPLACE_FCHOWNAT -REPLACE_DUP2 -REPLACE_DUP -REPLACE_CLOSE -REPLACE_CHOWN -HAVE_SYS_PARAM_H -HAVE_OS_H -HAVE_DECL_TTYNAME_R -HAVE_DECL_SETHOSTNAME -HAVE_DECL_GETUSERSHELL -HAVE_DECL_GETPAGESIZE -HAVE_DECL_GETLOGIN_R -HAVE_DECL_GETDOMAINNAME -HAVE_DECL_FDATASYNC -HAVE_DECL_FCHDIR -HAVE_DECL_ENVIRON -HAVE_USLEEP -HAVE_UNLINKAT -HAVE_SYMLINKAT -HAVE_SYMLINK -HAVE_SLEEP -HAVE_SETHOSTNAME -HAVE_READLINKAT -HAVE_READLINK -HAVE_PWRITE -HAVE_PREAD -HAVE_PIPE2 -HAVE_PIPE -HAVE_LINKAT -HAVE_LINK -HAVE_LCHOWN -HAVE_GROUP_MEMBER -HAVE_GETPAGESIZE -HAVE_GETLOGIN -HAVE_GETHOSTNAME -HAVE_GETGROUPS -HAVE_GETDTABLESIZE -HAVE_FTRUNCATE -HAVE_FSYNC -HAVE_FDATASYNC -HAVE_FCHOWNAT -HAVE_FCHDIR -HAVE_FACCESSAT -HAVE_EUIDACCESS -HAVE_DUP3 -HAVE_DUP2 -HAVE_CHOWN -GNULIB_WRITE -GNULIB_USLEEP -GNULIB_UNLINKAT -GNULIB_UNLINK -GNULIB_UNISTD_H_SIGPIPE -GNULIB_UNISTD_H_NONBLOCKING -GNULIB_TTYNAME_R -GNULIB_SYMLINKAT -GNULIB_SYMLINK -GNULIB_SLEEP -GNULIB_SETHOSTNAME -GNULIB_RMDIR -GNULIB_READLINKAT -GNULIB_READLINK -GNULIB_READ -GNULIB_PWRITE -GNULIB_PREAD -GNULIB_PIPE2 -GNULIB_PIPE -GNULIB_LSEEK -GNULIB_LINKAT -GNULIB_LINK -GNULIB_LCHOWN -GNULIB_ISATTY -GNULIB_GROUP_MEMBER -GNULIB_GETUSERSHELL -GNULIB_GETPAGESIZE -GNULIB_GETLOGIN_R -GNULIB_GETLOGIN -GNULIB_GETHOSTNAME -GNULIB_GETGROUPS -GNULIB_GETDTABLESIZE -GNULIB_GETDOMAINNAME -GNULIB_GETCWD -GNULIB_FTRUNCATE -GNULIB_FSYNC -GNULIB_FDATASYNC -GNULIB_FCHOWNAT -GNULIB_FCHDIR -GNULIB_FACCESSAT -GNULIB_EUIDACCESS -GNULIB_ENVIRON -GNULIB_DUP3 -GNULIB_DUP2 -GNULIB_DUP -GNULIB_CLOSE -GNULIB_CHOWN -GNULIB_CHDIR -LIB_CLOCK_GETTIME -GL_GENERATE_ALLOCA_H_FALSE -GL_GENERATE_ALLOCA_H_TRUE -ALLOCA_H -ALLOCA -GL_COND_LIBTOOL_FALSE -GL_COND_LIBTOOL_TRUE -POST_ALLOC_OBJ -PRE_ALLOC_OBJ -CYGWIN_OBJ -RALLOC_OBJ -OLDXMENU_DEPS -LIBX_OTHER -LIBXMENU -OLDXMENU -OLDXMENU_TARGET -LIBXT_OTHER -TOOLKIT_LIBW -WIDGET_OBJ -XOBJ -XMENU_OBJ -FONT_OBJ -OTHER_FILES -GNU_OBJC_CFLAGS -ns_appsrc -ns_appresdir -ns_appbindir -ns_appdir -X_TOOLKIT_TYPE -GNUSTEP_CFLAGS -C_SWITCH_X_SITE -LD_SWITCH_X_SITE -gameuser -gamedir -bitmapdir -archlibdir -etcdir -x_default_search_path -lisppath -locallisppath -standardlisppath -leimdir -lispdir -srcdir -canonical -configuration -version -copyright -KRB4LIB -DESLIB -KRB5LIB -CRYPTOLIB -COM_ERRLIB -LIBRESOLV -LIBHESIOD -TERMCAP_OBJ -LIBS_TERMCAP -BLESSMAIL_TARGET -LIBS_MAIL -liblockfile -LIBXML2_LIBS -LIBXML2_CFLAGS -LIBXSM -LIBGPM -LIBGIF -LIBTIFF -LIBPNG -LIBJPEG -LIBXPM -M17N_FLT_LIBS -M17N_FLT_CFLAGS -LIBOTF_LIBS -LIBOTF_CFLAGS -FREETYPE_LIBS -FREETYPE_CFLAGS -XFT_LIBS -XFT_CFLAGS -FONTCONFIG_LIBS -FONTCONFIG_CFLAGS -LIBXMU -LIBXTR6 -LIBACL_LIBS -LIBGNUTLS_LIBS -LIBGNUTLS_CFLAGS -LIBSELINUX_LIBS -SETTINGS_LIBS -SETTINGS_CFLAGS -GOBJECT_LIBS -GOBJECT_CFLAGS -GCONF_LIBS -GCONF_CFLAGS -GSETTINGS_LIBS -GSETTINGS_CFLAGS -DBUS_OBJ -DBUS_LIBS -DBUS_CFLAGS -GTK_OBJ -GTK_LIBS -GTK_CFLAGS -IMAGEMAGICK_LIBS -IMAGEMAGICK_CFLAGS -RSVG_LIBS -RSVG_CFLAGS -LIB_PTHREAD -VMLIMIT_OBJ -GMALLOC_OBJ -HAVE_XSERVER -W32_RES_LINK -W32_RES -W32_LIBS -W32_OBJ -WINDRES -NS_OBJC_OBJ -NS_OBJ -ns_self_contained -INSTALL_ARCH_INDEP_EXTRA -LIBS_GNUSTEP -LD_SWITCH_X_SITE_RPATH -XMKMF -DEPFLAGS -MKDEPDIR -CFLAGS_SOUND -ALSA_LIBS -ALSA_CFLAGS -LIBSOUND -PKG_CONFIG -LIB_MATH -LIBS_SYSTEM -C_SWITCH_SYSTEM -UNEXEC_OBJ -C_SWITCH_MACHINE -LD_SWITCH_SYSTEM -CANNOT_DUMP -INFO_OPTS -INFO_EXT -HAVE_MAKEINFO -PAXCTL -GZIP_PROG -INSTALL_INFO -LN_S -GNULIB_WARN_CFLAGS -WARN_CFLAGS -WERROR_CFLAGS -RANLIB -ARFLAGS -AR -EGREP -GREP -CPP -am__fastdepCC_FALSE -am__fastdepCC_TRUE -CCDEPMODE -AMDEPBACKSLASH -AMDEP_FALSE -AMDEP_TRUE -am__quote -am__include -DEPDIR -OBJEXT -EXEEXT -ac_ct_CC -CPPFLAGS -LDFLAGS -CFLAGS -CC -host_os -host_vendor -host_cpu -host -build_os -build_vendor -build_cpu -build -PROFILING_CFLAGS -GZIP_INFO -cache_file -am__untar -am__tar -AMTAR -am__leading_dot -SET_MAKE -AWK -mkdir_p -MKDIR_P -INSTALL_STRIP_PROGRAM -STRIP -install_sh -MAKEINFO -AUTOHEADER -AUTOMAKE -AUTOCONF -ACLOCAL -VERSION -PACKAGE -CYGPATH_W -am__isrc -INSTALL_DATA -INSTALL_SCRIPT -INSTALL_PROGRAM -target_alias -host_alias -build_alias -LIBS -ECHO_T -ECHO_N -ECHO_C -DEFS -mandir -localedir -libdir -psdir -pdfdir -dvidir -htmldir -infodir -docdir -oldincludedir -includedir -localstatedir -sharedstatedir -sysconfdir -datadir -datarootdir -libexecdir -sbindir -bindir -program_transform_name -prefix -exec_prefix -PACKAGE_URL -PACKAGE_BUGREPORT -PACKAGE_STRING -PACKAGE_VERSION -PACKAGE_TARNAME -PACKAGE_NAME -PATH_SEPARATOR -SHELL' -ac_subst_files='deps_frag -lisp_frag' -ac_user_opts=' -enable_option_checking -with_all -with_pop -with_kerberos -with_kerberos5 -with_hesiod -with_mmdf -with_mail_unlink -with_mailhost -with_sound -with_x_toolkit -with_wide_int -with_xpm -with_jpeg -with_tiff -with_gif -with_png -with_rsvg -with_xml2 -with_imagemagick -with_xft -with_libotf -with_m17n_flt -with_toolkit_scroll_bars -with_xaw3d -with_xim -with_ns -with_w32 -with_gpm -with_dbus -with_gconf -with_gsettings -with_selinux -with_acl -with_gnutls -with_inotify -with_makeinfo -with_compress_info -with_pkg_config_prog -with_gameuser -with_gnustep_conf -enable_ns_self_contained -enable_locallisppath -enable_checking -enable_check_lisp_object_type -enable_profiling -enable_autodepend -enable_gtk_deprecation_warnings -enable_dependency_tracking -enable_largefile -enable_gcc_warnings -enable_link_time_optimization -with_x -' - ac_precious_vars='build_alias -host_alias -target_alias -CC -CFLAGS -LDFLAGS -LIBS -CPPFLAGS -CPP -XMKMF' - - -# Initialize some variables set by options. -ac_init_help= -ac_init_version=false -ac_unrecognized_opts= -ac_unrecognized_sep= -# The variables have the same names as the options, with -# dashes changed to underlines. -cache_file=/dev/null -exec_prefix=NONE -no_create= -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -verbose= -x_includes=NONE -x_libraries=NONE - -# Installation directory options. -# These are left unexpanded so users can "make install exec_prefix=/foo" -# and all the variables that are supposed to be based on exec_prefix -# by default will actually change. -# Use braces instead of parens because sh, perl, etc. also accept them. -# (The list follows the same order as the GNU Coding Standards.) -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datarootdir='${prefix}/share' -datadir='${datarootdir}' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -includedir='${prefix}/include' -oldincludedir='/usr/include' -docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' -infodir='${datarootdir}/info' -htmldir='${docdir}' -dvidir='${docdir}' -pdfdir='${docdir}' -psdir='${docdir}' -libdir='${exec_prefix}/lib' -localedir='${datarootdir}/locale' -mandir='${datarootdir}/man' - -ac_prev= -ac_dashdash= -for ac_option -do - # If the previous option needs an argument, assign it. - if test -n "$ac_prev"; then - eval $ac_prev=\$ac_option - ac_prev= - continue - fi - - case $ac_option in - *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *) ac_optarg=yes ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case $ac_dashdash$ac_option in - --) - ac_dashdash=yes ;; - - -bindir | --bindir | --bindi | --bind | --bin | --bi) - ac_prev=bindir ;; - -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir=$ac_optarg ;; - - -build | --build | --buil | --bui | --bu) - ac_prev=build_alias ;; - -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build_alias=$ac_optarg ;; - - -cache-file | --cache-file | --cache-fil | --cache-fi \ - | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) - ac_prev=cache_file ;; - -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ - | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file=$ac_optarg ;; - - --config-cache | -C) - cache_file=config.cache ;; - - -datadir | --datadir | --datadi | --datad) - ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=*) - datadir=$ac_optarg ;; - - -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ - | --dataroo | --dataro | --datar) - ac_prev=datarootdir ;; - -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ - | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) - datarootdir=$ac_optarg ;; - - -disable-* | --disable-*) - ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=no ;; - - -docdir | --docdir | --docdi | --doc | --do) - ac_prev=docdir ;; - -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) - docdir=$ac_optarg ;; - - -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) - ac_prev=dvidir ;; - -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) - dvidir=$ac_optarg ;; - - -enable-* | --enable-*) - ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=\$ac_optarg ;; - - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ - | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ - | --exec | --exe | --ex) - ac_prev=exec_prefix ;; - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ - | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ - | --exec=* | --exe=* | --ex=*) - exec_prefix=$ac_optarg ;; - - -gas | --gas | --ga | --g) - # Obsolete; use --with-gas. - with_gas=yes ;; - - -help | --help | --hel | --he | -h) - ac_init_help=long ;; - -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) - ac_init_help=recursive ;; - -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) - ac_init_help=short ;; - - -host | --host | --hos | --ho) - ac_prev=host_alias ;; - -host=* | --host=* | --hos=* | --ho=*) - host_alias=$ac_optarg ;; - - -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) - ac_prev=htmldir ;; - -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ - | --ht=*) - htmldir=$ac_optarg ;; - - -includedir | --includedir | --includedi | --included | --include \ - | --includ | --inclu | --incl | --inc) - ac_prev=includedir ;; - -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ - | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir=$ac_optarg ;; - - -infodir | --infodir | --infodi | --infod | --info | --inf) - ac_prev=infodir ;; - -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir=$ac_optarg ;; - - -libdir | --libdir | --libdi | --libd) - ac_prev=libdir ;; - -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir=$ac_optarg ;; - - -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ - | --libexe | --libex | --libe) - ac_prev=libexecdir ;; - -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ - | --libexe=* | --libex=* | --libe=*) - libexecdir=$ac_optarg ;; - - -localedir | --localedir | --localedi | --localed | --locale) - ac_prev=localedir ;; - -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) - localedir=$ac_optarg ;; - - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst | --locals) - ac_prev=localstatedir ;; - -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) - localstatedir=$ac_optarg ;; - - -mandir | --mandir | --mandi | --mand | --man | --ma | --m) - ac_prev=mandir ;; - -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir=$ac_optarg ;; - - -nfp | --nfp | --nf) - # Obsolete; use --without-fp. - with_fp=no ;; - - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c | -n) - no_create=yes ;; - - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) - no_recursion=yes ;; - - -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ - | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ - | --oldin | --oldi | --old | --ol | --o) - ac_prev=oldincludedir ;; - -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ - | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ - | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir=$ac_optarg ;; - - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - ac_prev=prefix ;; - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix=$ac_optarg ;; - - -program-prefix | --program-prefix | --program-prefi | --program-pref \ - | --program-pre | --program-pr | --program-p) - ac_prev=program_prefix ;; - -program-prefix=* | --program-prefix=* | --program-prefi=* \ - | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix=$ac_optarg ;; - - -program-suffix | --program-suffix | --program-suffi | --program-suff \ - | --program-suf | --program-su | --program-s) - ac_prev=program_suffix ;; - -program-suffix=* | --program-suffix=* | --program-suffi=* \ - | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix=$ac_optarg ;; - - -program-transform-name | --program-transform-name \ - | --program-transform-nam | --program-transform-na \ - | --program-transform-n | --program-transform- \ - | --program-transform | --program-transfor \ - | --program-transfo | --program-transf \ - | --program-trans | --program-tran \ - | --progr-tra | --program-tr | --program-t) - ac_prev=program_transform_name ;; - -program-transform-name=* | --program-transform-name=* \ - | --program-transform-nam=* | --program-transform-na=* \ - | --program-transform-n=* | --program-transform-=* \ - | --program-transform=* | --program-transfor=* \ - | --program-transfo=* | --program-transf=* \ - | --program-trans=* | --program-tran=* \ - | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name=$ac_optarg ;; - - -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) - ac_prev=pdfdir ;; - -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) - pdfdir=$ac_optarg ;; - - -psdir | --psdir | --psdi | --psd | --ps) - ac_prev=psdir ;; - -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) - psdir=$ac_optarg ;; - - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - silent=yes ;; - - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) - ac_prev=sbindir ;; - -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ - | --sbi=* | --sb=*) - sbindir=$ac_optarg ;; - - -sharedstatedir | --sharedstatedir | --sharedstatedi \ - | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ - | --sharedst | --shareds | --shared | --share | --shar \ - | --sha | --sh) - ac_prev=sharedstatedir ;; - -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ - | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ - | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ - | --sha=* | --sh=*) - sharedstatedir=$ac_optarg ;; - - -site | --site | --sit) - ac_prev=site ;; - -site=* | --site=* | --sit=*) - site=$ac_optarg ;; - - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) - ac_prev=srcdir ;; - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir=$ac_optarg ;; - - -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ - | --syscon | --sysco | --sysc | --sys | --sy) - ac_prev=sysconfdir ;; - -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ - | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir=$ac_optarg ;; - - -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target_alias ;; - -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target_alias=$ac_optarg ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb) - verbose=yes ;; - - -version | --version | --versio | --versi | --vers | -V) - ac_init_version=: ;; - - -with-* | --with-*) - ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=\$ac_optarg ;; - - -without-* | --without-*) - ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=no ;; - - --x) - # Obsolete; use --with-x. - with_x=yes ;; - - -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ - | --x-incl | --x-inc | --x-in | --x-i) - ac_prev=x_includes ;; - -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ - | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes=$ac_optarg ;; - - -x-libraries | --x-libraries | --x-librarie | --x-librari \ - | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) - ac_prev=x_libraries ;; - -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ - | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries=$ac_optarg ;; - - -*) as_fn_error "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information." - ;; - - *=*) - ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` - # Reject names that are not valid shell variable names. - case $ac_envvar in #( - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error "invalid variable name: \`$ac_envvar'" ;; - esac - eval $ac_envvar=\$ac_optarg - export $ac_envvar ;; - - *) - # FIXME: should be removed in autoconf 3.0. - $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 - expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} - ;; - - esac -done - -if test -n "$ac_prev"; then - ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error "missing argument to $ac_option" -fi - -if test -n "$ac_unrecognized_opts"; then - case $enable_option_checking in - no) ;; - fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; - *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; - esac -fi - -# Check all directory arguments for consistency. -for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir -do - eval ac_val=\$$ac_var - # Remove trailing slashes. - case $ac_val in - */ ) - ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` - eval $ac_var=\$ac_val;; - esac - # Be sure to have absolute directory names. - case $ac_val in - [\\/$]* | ?:[\\/]* ) continue;; - NONE | '' ) case $ac_var in *prefix ) continue;; esac;; - esac - as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" -done - -# There might be people who depend on the old broken behavior: `$host' -# used to hold the argument of --host etc. -# FIXME: To remove some day. -build=$build_alias -host=$host_alias -target=$target_alias - -# FIXME: To remove some day. -if test "x$host_alias" != x; then - if test "x$build_alias" = x; then - cross_compiling=maybe - $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used." >&2 - elif test "x$build_alias" != "x$host_alias"; then - cross_compiling=yes - fi -fi - -ac_tool_prefix= -test -n "$host_alias" && ac_tool_prefix=$host_alias- - -test "$silent" = yes && exec 6>/dev/null - - -ac_pwd=`pwd` && test -n "$ac_pwd" && -ac_ls_di=`ls -di .` && -ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error "working directory cannot be determined" -test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error "pwd does not report name of working directory" - - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - ac_srcdir_defaulted=yes - # Try the directory containing this script, then the parent directory. - ac_confdir=`$as_dirname -- "$as_myself" || -$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_myself" : 'X\(//\)[^/]' \| \ - X"$as_myself" : 'X\(//\)$' \| \ - X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_myself" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - srcdir=$ac_confdir - if test ! -r "$srcdir/$ac_unique_file"; then - srcdir=.. - fi -else - ac_srcdir_defaulted=no -fi -if test ! -r "$srcdir/$ac_unique_file"; then - test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" -fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" -ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" - pwd)` -# When building in place, set srcdir=. -if test "$ac_abs_confdir" = "$ac_pwd"; then - srcdir=. -fi -# Remove unnecessary trailing slashes from srcdir. -# Double slashes in file names in object file debugging info -# mess up M-x gdb in Emacs. -case $srcdir in -*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; -esac -for ac_var in $ac_precious_vars; do - eval ac_env_${ac_var}_set=\${${ac_var}+set} - eval ac_env_${ac_var}_value=\$${ac_var} - eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} - eval ac_cv_env_${ac_var}_value=\$${ac_var} -done - -# -# Report the --help message. -# -if test "$ac_init_help" = "long"; then - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat <<_ACEOF -\`configure' configures emacs 24.3.50 to adapt to many kinds of systems. - -Usage: $0 [OPTION]... [VAR=VALUE]... - -To assign environment variables (e.g., CC, CFLAGS...), specify them as -VAR=VALUE. See below for descriptions of some of the useful variables. - -Defaults for the options are specified in brackets. - -Configuration: - -h, --help display this help and exit - --help=short display options specific to this package - --help=recursive display the short help of all the included packages - -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking...' messages - --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' - -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] - -Installation directories: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] - -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. - -For better control, use the options below. - -Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/emacs] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] -_ACEOF - - cat <<\_ACEOF - -Program names: - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM run sed PROGRAM on installed program names - -X features: - --x-includes=DIR X include files are in DIR - --x-libraries=DIR X library files are in DIR - -System types: - --build=BUILD configure for building on BUILD [guessed] - --host=HOST cross-compile to build programs to run on HOST [BUILD] -_ACEOF -fi - -if test -n "$ac_init_help"; then - case $ac_init_help in - short | recursive ) echo "Configuration of emacs 24.3.50:";; - esac - cat <<\_ACEOF - -Optional Features: - --disable-option-checking ignore unrecognized --enable/--with options - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --disable-ns-self-contained - disable self contained build under NeXTstep - --enable-locallisppath=PATH - directories Emacs should search for lisp files - specific to this site - --enable-checking[=LIST] - enable expensive run-time checks. With LIST, enable - only specific categories of checks. Categories are: - all,yes,no. Flags are: stringbytes, stringoverrun, - stringfreelist, xmallocoverrun, conslist, glyphs - --enable-check-lisp-object-type - enable compile time checks for the Lisp_Object data - type. This is useful for development for catching - certain types of bugs. - --enable-profiling build emacs with low-level, gprof profiling support. - Mainly useful for debugging Emacs itself. May not - work on all platforms. Stops profiler.el working. - --enable-autodepend automatically generate dependencies to .h-files. - Requires GNU Make and Gcc. Enabled if GNU Make and - Gcc is found - --enable-gtk-deprecation-warnings - Show Gtk+/Gdk deprecation warnings for Gtk+ >= 3.0 - --disable-dependency-tracking speeds up one-time build - --enable-dependency-tracking do not reject slow dependency extractors - --disable-largefile omit support for large files - --enable-gcc-warnings turn on lots of GCC warnings/errors. This is - intended for developers, and may generate false - alarms when used with older or non-GNU development - tools. - --enable-link-time-optimization - build emacs with link-time optimization. This is - supported only for GCC since 4.5.0. - -Optional Packages: - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --without-all omit almost all features and build small executable - with minimal dependencies - --without-pop don't support POP mail retrieval with movemail - --with-kerberos support Kerberos-authenticated POP - --with-kerberos5 support Kerberos version 5 authenticated POP - --with-hesiod support Hesiod to get the POP server host - --with-mmdf support MMDF mailboxes - --with-mail-unlink unlink, rather than empty, mail spool after reading - --with-mailhost=HOSTNAME - string giving default POP mail host - --without-sound don't compile with sound support - --with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk2, - gtk3, lucid or athena, motif, no) - --with-wide-int prefer wide Emacs integers (typically 62-bit) - --without-xpm don't compile with XPM image support - --without-jpeg don't compile with JPEG image support - --without-tiff don't compile with TIFF image support - --without-gif don't compile with GIF image support - --without-png don't compile with PNG image support - --without-rsvg don't compile with SVG image support - --without-xml2 don't compile with XML parsing support - --without-imagemagick don't compile with ImageMagick image support - --without-xft don't use XFT for anti aliased fonts - --without-libotf don't use libotf for OpenType font support - --without-m17n-flt don't use m17n-flt for text shaping - --without-toolkit-scroll-bars - don't use Motif or Xaw3d scroll bars - --without-xaw3d don't use Xaw3d - --without-xim don't use X11 XIM - --with-ns use NeXTstep (Cocoa or GNUstep) windowing system - --with-w32 use native MS Windows GUI - --without-gpm don't use -lgpm for mouse support on a GNU/Linux - console - --without-dbus don't compile with D-Bus support - --without-gconf don't compile with GConf support - --without-gsettings don't compile with GSettings support - --without-selinux don't compile with SELinux support - --without-acl don't compile with ACL support - --without-gnutls don't use -lgnutls for SSL/TLS support - --without-inotify don't compile with inotify (file-watch) support - --without-makeinfo don't require makeinfo for building manuals - --without-compress-info don't compress the installed Info pages - --with-pkg-config-prog=FILENAME - file name of pkg-config for finding GTK and librsvg - --with-gameuser=USER user for shared game score files - --with-gnustep-conf=FILENAME - name of GNUstep.conf; default $GNUSTEP_CONFIG_FILE, - or /etc/GNUstep/GNUstep.conf - --with-x use the X Window System - -Some influential environment variables: - CC C compiler command - CFLAGS C compiler flags - LDFLAGS linker flags, e.g. -L if you have libraries in a - nonstandard directory - LIBS libraries to pass to the linker, e.g. -l - CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if - you have headers in a nonstandard directory - CPP C preprocessor - XMKMF Path to xmkmf, Makefile generator for X Window System - -Use these variables to override the choices made by `configure' or to help -it to find libraries and programs with nonstandard names/locations. - -Report bugs to the package provider. -_ACEOF -ac_status=$? -fi - -if test "$ac_init_help" = "recursive"; then - # If there are subdirs, report their specific --help. - for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d "$ac_dir" || - { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || - continue - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - cd "$ac_dir" || { ac_status=$?; continue; } - # Check for guested configure. - if test -f "$ac_srcdir/configure.gnu"; then - echo && - $SHELL "$ac_srcdir/configure.gnu" --help=recursive - elif test -f "$ac_srcdir/configure"; then - echo && - $SHELL "$ac_srcdir/configure" --help=recursive - else - $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi || ac_status=$? - cd "$ac_pwd" || { ac_status=$?; break; } - done -fi - -test -n "$ac_init_help" && exit $ac_status -if $ac_init_version; then - cat <<\_ACEOF -emacs configure 24.3.50 -generated by GNU Autoconf 2.65 - -Copyright (C) 2009 Free Software Foundation, Inc. -This configure script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it. -_ACEOF - exit -fi - -## ------------------------ ## -## Autoconf initialization. ## -## ------------------------ ## - -# ac_fn_c_try_compile LINENO -# -------------------------- -# Try to compile conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext - if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -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_try_compile - -# ac_fn_c_try_cpp LINENO -# ---------------------- -# Try to preprocess conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_cpp () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_cpp conftest.$ac_ext" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } >/dev/null && { - test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || - test ! -s conftest.err - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -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_try_cpp - -# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists, giving a warning if it cannot be compiled using -# the include files in INCLUDES and setting the cache variable VAR -# accordingly. -ac_fn_c_check_header_mongrel () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -else - # Is the header compilable? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 -$as_echo_n "checking $2 usability... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_header_compiler=yes -else - ac_header_compiler=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 -$as_echo "$ac_header_compiler" >&6; } - -# Is the header present? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 -$as_echo_n "checking $2 presence... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <$2> -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - ac_header_preproc=yes -else - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 -$as_echo "$ac_header_preproc" >&6; } - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( - yes:no: ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 -$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} - ;; - no:yes:* ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 -$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 -$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 -$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 -$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} - ;; -esac - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=\$ac_header_compiler" -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_header_mongrel - -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes -# that executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then : - ac_retval=0 -else - $as_echo "$as_me: program exited with status $ac_status" >&5 - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_header_compile - -# ac_fn_c_try_link LINENO -# ----------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_link () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext conftest$ac_exeext - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && { - test "$cross_compiling" = yes || - $as_test_x conftest$ac_exeext - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information - # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would - # interfere with the next link command; also delete a directory that is - # left behind by Apple's compiler. We do this before executing the actions. - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - as_fn_set_status $ac_retval - -} # ac_fn_c_try_link - -# ac_fn_c_check_decl LINENO SYMBOL VAR -# ------------------------------------ -# Tests whether SYMBOL is declared, setting cache variable VAR accordingly. -ac_fn_c_check_decl () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $2 is declared" >&5 -$as_echo_n "checking whether $2 is declared... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -#ifndef $2 - (void) $2; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_decl - -# ac_fn_c_check_header_preproc LINENO HEADER VAR -# ---------------------------------------------- -# Tests whether HEADER is present, setting the cache variable VAR accordingly. -ac_fn_c_check_header_preproc () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <$2> -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f conftest.err conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_header_preproc - -# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES -# ---------------------------------------------------- -# Tries to find if the field MEMBER exists in type AGGR, after including -# INCLUDES, setting cache variable VAR accordingly. -ac_fn_c_check_member () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 -$as_echo_n "checking for $2.$3... " >&6; } -if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$5 -int -main () -{ -static $2 ac_aggr; -if (ac_aggr.$3) -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$4=yes" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$5 -int -main () -{ -static $2 ac_aggr; -if (sizeof ac_aggr.$3) -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$4=yes" -else - eval "$4=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$4 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_member - -# ac_fn_c_check_func LINENO FUNC VAR -# ---------------------------------- -# Tests whether FUNC exists, setting the cache variable VAR accordingly -ac_fn_c_check_func () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Define $2 to an innocuous variant, in case declares $2. - For example, HP-UX 11i declares gettimeofday. */ -#define $2 innocuous_$2 - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $2 (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $2 - -/* 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 $2 (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined __stub_$2 || defined __stub___$2 -choke me -#endif - -int -main () -{ -return $2 (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} - -} # ac_fn_c_check_func - -# ac_fn_c_check_type LINENO TYPE VAR INCLUDES -# ------------------------------------------- -# Tests whether TYPE exists after having included INCLUDES, setting cache -# variable VAR accordingly. -ac_fn_c_check_type () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=no" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof ($2)) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof (($2))) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - eval "$3=yes" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$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 -#include -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 config.log <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by emacs $as_me 24.3.50, which was -generated by GNU Autoconf 2.65. Invocation command line was - - $ $0 $@ - -_ACEOF -exec 5>>config.log -{ -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS - -} >&5 - -cat >&5 <<_ACEOF - - -## ----------- ## -## Core tests. ## -## ----------- ## - -_ACEOF - - -# Keep a trace of the command line. -# Strip out --no-create and --no-recursion so they do not pile up. -# Strip out --silent because we don't want to record it for future runs. -# Also quote any args containing shell meta-characters. -# Make two passes to allow for proper duplicate-argument suppression. -ac_configure_args= -ac_configure_args0= -ac_configure_args1= -ac_must_keep_next=false -for ac_pass in 1 2 -do - for ac_arg - do - case $ac_arg in - -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - continue ;; - *\'*) - ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - case $ac_pass in - 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; - 2) - as_fn_append ac_configure_args1 " '$ac_arg'" - if test $ac_must_keep_next = true; then - ac_must_keep_next=false # Got value, back to normal. - else - case $ac_arg in - *=* | --config-cache | -C | -disable-* | --disable-* \ - | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ - | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ - | -with-* | --with-* | -without-* | --without-* | --x) - case "$ac_configure_args0 " in - "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; - esac - ;; - -* ) ac_must_keep_next=true ;; - esac - fi - as_fn_append ac_configure_args " '$ac_arg'" - ;; - esac - done -done -{ ac_configure_args0=; unset ac_configure_args0;} -{ ac_configure_args1=; unset ac_configure_args1;} - -# When interrupted or exit'd, cleanup temporary files, and complete -# config.log. We remove comments because anyway the quotes in there -# would cause problems or look ugly. -# WARNING: Use '\'' to represent an apostrophe within the trap. -# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. -trap 'exit_status=$? - # Save into config.log some information that might help in debugging. - { - echo - - cat <<\_ASBOX -## ---------------- ## -## Cache variables. ## -## ---------------- ## -_ASBOX - echo - # The following way of writing the cache mishandles newlines in values, -( - for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - (set) 2>&1 | - case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - sed -n \ - "s/'\''/'\''\\\\'\'''\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" - ;; #( - *) - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) - echo - - cat <<\_ASBOX -## ----------------- ## -## Output variables. ## -## ----------------- ## -_ASBOX - echo - for ac_var in $ac_subst_vars - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - - if test -n "$ac_subst_files"; then - cat <<\_ASBOX -## ------------------- ## -## File substitutions. ## -## ------------------- ## -_ASBOX - echo - for ac_var in $ac_subst_files - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - fi - - if test -s confdefs.h; then - cat <<\_ASBOX -## ----------- ## -## confdefs.h. ## -## ----------- ## -_ASBOX - echo - cat confdefs.h - echo - fi - test "$ac_signal" != 0 && - $as_echo "$as_me: caught signal $ac_signal" - $as_echo "$as_me: exit $exit_status" - } >&5 - rm -f core *.core core.conftest.* && - rm -f -r conftest* confdefs* conf$$* $ac_clean_files && - exit $exit_status -' 0 -for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal -done -ac_signal=0 - -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -f -r conftest* confdefs.h - -$as_echo "/* confdefs.h */" > confdefs.h - -# Predefined preprocessor variables. - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_NAME "$PACKAGE_NAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_TARNAME "$PACKAGE_TARNAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_VERSION "$PACKAGE_VERSION" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_STRING "$PACKAGE_STRING" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_URL "$PACKAGE_URL" -_ACEOF - - -# Let the site file select an alternate cache file if it wants to. -# Prefer an explicitly selected file to automatically selected ones. -ac_site_file1=NONE -ac_site_file2=NONE -if test -n "$CONFIG_SITE"; then - ac_site_file1=$CONFIG_SITE -elif test "x$prefix" != xNONE; then - ac_site_file1=$prefix/share/config.site - ac_site_file2=$prefix/etc/config.site -else - ac_site_file1=$ac_default_prefix/share/config.site - ac_site_file2=$ac_default_prefix/etc/config.site -fi -for ac_site_file in "$ac_site_file1" "$ac_site_file2" -do - test "x$ac_site_file" = xNONE && continue - if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 -$as_echo "$as_me: loading site script $ac_site_file" >&6;} - sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" - fi -done - -if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special files - # actually), so we avoid doing that. DJGPP emulates it as a regular file. - if test /dev/null != "$cache_file" && test -f "$cache_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 -$as_echo "$as_me: loading cache $cache_file" >&6;} - case $cache_file in - [\\/]* | ?:[\\/]* ) . "$cache_file";; - *) . "./$cache_file";; - esac - fi -else - { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 -$as_echo "$as_me: creating cache $cache_file" >&6;} - >$cache_file -fi - -as_fn_append ac_header_list " linux/version.h" -as_fn_append ac_header_list " sys/systeminfo.h" -as_fn_append ac_header_list " coff.h" -as_fn_append ac_header_list " pty.h" -as_fn_append ac_header_list " sys/resource.h" -as_fn_append ac_header_list " sys/utsname.h" -as_fn_append ac_header_list " pwd.h" -as_fn_append ac_header_list " utmp.h" -as_fn_append ac_header_list " util.h" -as_fn_append ac_header_list " sys/socket.h" -as_fn_append ac_header_list " stdlib.h" -as_fn_append ac_header_list " unistd.h" -as_fn_append ac_header_list " sys/param.h" -as_fn_append ac_header_list " pthread.h" -as_fn_append ac_header_list " malloc/malloc.h" -as_fn_append ac_header_list " maillock.h" -as_fn_append ac_header_list " sys/un.h" -as_fn_append ac_func_list " tzset" -as_fn_append ac_func_list " readlinkat" -as_fn_append ac_header_list " dirent.h" -as_fn_append ac_header_list " execinfo.h" -as_fn_append ac_func_list " faccessat" -as_fn_append ac_func_list " fdopendir" -as_fn_append ac_header_list " stdio_ext.h" -as_fn_append ac_func_list " __fpending" -as_fn_append ac_func_list " fstatat" -gl_getopt_required=GNU -as_fn_append ac_header_list " getopt.h" -as_fn_append ac_func_list " gettimeofday" -as_fn_append ac_func_list " nanotime" -as_fn_append ac_header_list " sys/time.h" -as_fn_append ac_header_list " wchar.h" -as_fn_append ac_header_list " stdint.h" -as_fn_append ac_header_list " inttypes.h" -as_fn_append ac_func_list " lstat" -as_fn_append ac_func_list " alarm" -as_fn_append ac_header_list " sys/select.h" -as_fn_append ac_func_list " pselect" -as_fn_append ac_func_list " pthread_sigmask" -as_fn_append ac_func_list " readlink" -as_fn_append ac_func_list " strtoimax" -as_fn_append ac_func_list " strtoumax" -as_fn_append ac_func_list " symlink" -as_fn_append ac_header_list " sys/stat.h" -as_fn_append ac_func_list " localtime_r" -as_fn_append ac_header_list " utime.h" -as_fn_append ac_func_list " futimes" -as_fn_append ac_func_list " futimesat" -as_fn_append ac_func_list " futimens" -as_fn_append ac_func_list " utimensat" -as_fn_append ac_func_list " lutimes" -# Check that the precious variables saved in the cache have kept the same -# value. -ac_cache_corrupted=false -for ac_var in $ac_precious_vars; do - eval ac_old_set=\$ac_cv_env_${ac_var}_set - eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val=\$ac_cv_env_${ac_var}_value - eval ac_new_val=\$ac_env_${ac_var}_value - case $ac_old_set,$ac_new_set in - set,) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,set) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,);; - *) - if test "x$ac_old_val" != "x$ac_new_val"; then - # differences in whitespace do not lead to failure. - ac_old_val_w=`echo x $ac_old_val` - ac_new_val_w=`echo x $ac_new_val` - if test "$ac_old_val_w" != "$ac_new_val_w"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - ac_cache_corrupted=: - else - { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} - eval $ac_var=\$ac_old_val - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} - fi;; - esac - # Pass precious variables to config.status. - if test "$ac_new_set" = set; then - case $ac_new_val in - *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; - *) ac_arg=$ac_var=$ac_new_val ;; - esac - case " $ac_configure_args " in - *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) as_fn_append ac_configure_args " '$ac_arg'" ;; - esac - fi -done -if $ac_cache_corrupted; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 -$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 -fi -## -------------------- ## -## Main body of script. ## -## -------------------- ## - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - - -emacs_config_options="$@" -## Add some environment variables, if they were passed via the environment -## rather than on the command-line. -for var in CFLAGS CPPFLAGS LDFLAGS; do - case "$emacs_config_options" in - *$var=*) continue ;; - esac - eval val="\$${var}" - test x"$val" = x && continue - emacs_config_options="${emacs_config_options}${emacs_config_options:+ }$var=\"$val\"" -done - -ac_config_headers="$ac_config_headers src/config.h:src/config.in" - - -ac_aux_dir= -for ac_dir in build-aux "$srcdir"/build-aux; do - for ac_t in install-sh install.sh shtool; do - if test -f "$ac_dir/$ac_t"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/$ac_t -c" - break 2 - fi - done -done -if test -z "$ac_aux_dir"; then - as_fn_error "cannot find install-sh, install.sh, or shtool in build-aux \"$srcdir\"/build-aux" "$LINENO" 5 -fi - -# These three variables are undocumented and unsupported, -# and are intended to be withdrawn in a future Autoconf release. -# They can cause serious problems if a builder's source tree is in a directory -# whose full name contains unusual characters. -ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. -ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. -ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. - - -am__api_version='1.11' - -# Find a good install program. We prefer a C program (faster), -# so one script is as good as another. But avoid the broken or -# incompatible versions: -# SysV /etc/install, /usr/sbin/install -# SunOS /usr/etc/install -# IRIX /sbin/install -# AIX /bin/install -# AmigaOS /C/install, which installs bootblocks on floppy discs -# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag -# AFS /usr/afsws/bin/install, which mishandles nonexistent args -# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" -# OS/2's system install, which has a completely different semantic -# ./install, which can be erroneously created by make from ./install.sh. -# Reject install programs that cannot install multiple files. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 -$as_echo_n "checking for a BSD-compatible install... " >&6; } -if test -z "$INSTALL"; then -if test "${ac_cv_path_install+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - # Account for people who put trailing slashes in PATH elements. -case $as_dir/ in #(( - ./ | .// | /[cC]/* | \ - /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ - ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ - /usr/ucb/* ) ;; - *) - # OSF1 and SCO ODT 3.0 have their own names for install. - # Don't use installbsd from OSF since it installs stuff as root - # by default. - for ac_prog in ginstall scoinst install; do - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then - if test $ac_prog = install && - grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then - # AIX install. It has an incompatible calling convention. - : - elif test $ac_prog = install && - grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then - # program-specific install script used by HP pwplus--don't use. - : - else - rm -rf conftest.one conftest.two conftest.dir - echo one > conftest.one - echo two > conftest.two - mkdir conftest.dir - if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && - test -s conftest.one && test -s conftest.two && - test -s conftest.dir/conftest.one && - test -s conftest.dir/conftest.two - then - ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" - break 3 - fi - fi - fi - done - done - ;; -esac - - done -IFS=$as_save_IFS - -rm -rf conftest.one conftest.two conftest.dir - -fi - if test "${ac_cv_path_install+set}" = set; then - INSTALL=$ac_cv_path_install - else - # As a last resort, use the slow shell script. Don't cache a - # value for INSTALL within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the value is a relative name. - INSTALL=$ac_install_sh - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 -$as_echo "$INSTALL" >&6; } - -# Use test -z because SunOS4 sh mishandles braces in ${var-val}. -# It thinks the first close brace ends the variable substitution. -test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' - -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' - -test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 -$as_echo_n "checking whether build environment is sane... " >&6; } -# Just in case -sleep 1 -echo timestamp > conftest.file -# Reject unsafe characters in $srcdir or the absolute working directory -# name. Accept space and tab only in the latter. -am_lf=' -' -case `pwd` in - *[\\\"\#\$\&\'\`$am_lf]*) - as_fn_error "unsafe absolute working directory name" "$LINENO" 5;; -esac -case $srcdir in - *[\\\"\#\$\&\'\`$am_lf\ \ ]*) - as_fn_error "unsafe srcdir value: \`$srcdir'" "$LINENO" 5;; -esac - -# Do `set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` - if test "$*" = "X"; then - # -L didn't work. - set X `ls -t "$srcdir/configure" conftest.file` - fi - rm -f conftest.file - if test "$*" != "X $srcdir/configure conftest.file" \ - && test "$*" != "X conftest.file $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - as_fn_error "ls -t appears to fail. Make sure there is not a broken -alias in your environment" "$LINENO" 5 - fi - - test "$2" = conftest.file - ) -then - # Ok. - : -else - as_fn_error "newly created file is older than distributed files! -Check your system clock" "$LINENO" 5 -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -test "$program_prefix" != NONE && - program_transform_name="s&^&$program_prefix&;$program_transform_name" -# Use a double $ so make ignores it. -test "$program_suffix" != NONE && - program_transform_name="s&\$&$program_suffix&;$program_transform_name" -# Double any \ or $. -# By default was `s,x,x', remove it if useless. -ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' -program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` - -# expand $ac_aux_dir to an absolute path -am_aux_dir=`cd $ac_aux_dir && pwd` - -if test x"${MISSING+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; - *) - MISSING="\${SHELL} $am_aux_dir/missing" ;; - esac -fi -# Use eval to expand $SHELL -if eval "$MISSING --run true"; then - am_missing_run="$MISSING --run " -else - am_missing_run= - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`missing' script is too old or missing" >&5 -$as_echo "$as_me: WARNING: \`missing' script is too old or missing" >&2;} -fi - -if test x"${install_sh}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; - *) - install_sh="\${SHELL} $am_aux_dir/install-sh" - esac -fi - -# Installed binaries are usually stripped using `strip' when the user -# run `make install-strip'. However `strip' might not be the right -# tool to use in cross-compilation environments, therefore Automake -# will honor the `STRIP' environment variable to overrule this program. -if test "$cross_compiling" != no; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. -set dummy ${ac_tool_prefix}strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_STRIP+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$STRIP"; then - ac_cv_prog_STRIP="$STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_STRIP="${ac_tool_prefix}strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -STRIP=$ac_cv_prog_STRIP -if test -n "$STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 -$as_echo "$STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_STRIP"; then - ac_ct_STRIP=$STRIP - # Extract the first word of "strip", so it can be a program name with args. -set dummy strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_STRIP"; then - ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_STRIP="strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP -if test -n "$ac_ct_STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 -$as_echo "$ac_ct_STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_STRIP" = x; then - STRIP=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - STRIP=$ac_ct_STRIP - fi -else - STRIP="$ac_cv_prog_STRIP" -fi - -fi -INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 -$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } -if test -z "$MKDIR_P"; then - if test "${ac_cv_path_mkdir+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in mkdir gmkdir; do - for ac_exec_ext in '' $ac_executable_extensions; do - { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; } || continue - case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( - 'mkdir (GNU coreutils) '* | \ - 'mkdir (coreutils) '* | \ - 'mkdir (fileutils) '4.1*) - ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext - break 3;; - esac - done - done - done -IFS=$as_save_IFS - -fi - - test -d ./--version && rmdir ./--version - if test "${ac_cv_path_mkdir+set}" = set; then - MKDIR_P="$ac_cv_path_mkdir -p" - else - # As a last resort, use the slow shell script. Don't cache a - # value for MKDIR_P within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the value is a relative name. - MKDIR_P="$ac_install_sh -d" - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 -$as_echo "$MKDIR_P" >&6; } - -mkdir_p="$MKDIR_P" -case $mkdir_p in - [\\/$]* | ?:[\\/]*) ;; - */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; -esac - -for ac_prog in gawk mawk nawk awk -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_AWK+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$AWK"; then - ac_cv_prog_AWK="$AWK" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_AWK="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -AWK=$ac_cv_prog_AWK -if test -n "$AWK"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 -$as_echo "$AWK" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$AWK" && break -done - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } -set x ${MAKE-make} -ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat >conftest.make <<\_ACEOF -SHELL = /bin/sh -all: - @echo '@@@%%%=$(MAKE)=@@@%%%' -_ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -case `${MAKE-make} -f conftest.make 2>/dev/null` in - *@@@%%%=?*=@@@%%%*) - eval ac_cv_prog_make_${ac_make}_set=yes;; - *) - eval ac_cv_prog_make_${ac_make}_set=no;; -esac -rm -f conftest.make -fi -if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - SET_MAKE= -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - SET_MAKE="MAKE=${MAKE-make}" -fi - -rm -rf .tst 2>/dev/null -mkdir .tst 2>/dev/null -if test -d .tst; then - am__leading_dot=. -else - am__leading_dot=_ -fi -rmdir .tst 2>/dev/null - -if test "`cd $srcdir && pwd`" != "`pwd`"; then - # Use -I$(srcdir) only when $(srcdir) != ., so that make's output - # is not polluted with repeated "-I." - am__isrc=' -I$(srcdir)' - # test to see if srcdir already configured - if test -f $srcdir/config.status; then - as_fn_error "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 - fi -fi - -# test whether we have cygpath -if test -z "$CYGPATH_W"; then - if (cygpath --version) >/dev/null 2>/dev/null; then - CYGPATH_W='cygpath -w' - else - CYGPATH_W=echo - fi -fi - - -# Define the identity of the package. - PACKAGE='emacs' - VERSION='24.3.50' - - -cat >>confdefs.h <<_ACEOF -#define PACKAGE "$PACKAGE" -_ACEOF - - -cat >>confdefs.h <<_ACEOF -#define VERSION "$VERSION" -_ACEOF - -# Some tools Automake needs. - -ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} - - -AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} - - -AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} - - -AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} - - -MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} - -# We need awk for the "check" target. The system "awk" is bad on -# some platforms. -# Always define AMTAR for backward compatibility. - -AMTAR=${AMTAR-"${am_missing_run}tar"} - -am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -' - - - - - - - - -lispdir='${datadir}/emacs/${version}/lisp' -leimdir='${datadir}/emacs/${version}/leim' -standardlisppath='${lispdir}:${leimdir}' -locallisppath='${datadir}/emacs/${version}/site-lisp:'\ -'${datadir}/emacs/site-lisp' -lisppath='${locallisppath}:${standardlisppath}' -etcdir='${datadir}/emacs/${version}/etc' -archlibdir='${libexecdir}/emacs/${version}/${configuration}' -docdir='${datadir}/emacs/${version}/etc' -gamedir='${localstatedir}/games/emacs' - - -# Check whether --with-all was given. -if test "${with_all+set}" = set; then : - withval=$with_all; with_features=$withval -else - with_features=yes -fi - - - - - -# Check whether --with-pop was given. -if test "${with_pop+set}" = set; then : - withval=$with_pop; -else - with_pop=$with_features -fi - -if test "$with_pop" = yes; then - $as_echo "#define MAIL_USE_POP 1" >>confdefs.h - -fi - - -# Check whether --with-kerberos was given. -if test "${with_kerberos+set}" = set; then : - withval=$with_kerberos; -else - with_kerberos=no -fi - -if test "$with_kerberos" != no; then - $as_echo "#define KERBEROS 1" >>confdefs.h - -fi - - -# Check whether --with-kerberos5 was given. -if test "${with_kerberos5+set}" = set; then : - withval=$with_kerberos5; -else - with_kerberos5=no -fi - -if test "${with_kerberos5}" != no; then - if test "${with_kerberos}" = no; then - with_kerberos=yes - $as_echo "#define KERBEROS 1" >>confdefs.h - - fi - -$as_echo "#define KERBEROS5 1" >>confdefs.h - -fi - - -# Check whether --with-hesiod was given. -if test "${with_hesiod+set}" = set; then : - withval=$with_hesiod; -else - with_hesiod=no -fi - -if test "$with_hesiod" != no; then - -$as_echo "#define HESIOD 1" >>confdefs.h - -fi - - -# Check whether --with-mmdf was given. -if test "${with_mmdf+set}" = set; then : - withval=$with_mmdf; -else - with_mmdf=no -fi - -if test "$with_mmdf" != no; then - -$as_echo "#define MAIL_USE_MMDF 1" >>confdefs.h - -fi - - -# Check whether --with-mail-unlink was given. -if test "${with_mail_unlink+set}" = set; then : - withval=$with_mail_unlink; -else - with_mail_unlink=no -fi - -if test "$with_mail_unlink" != no; then - -$as_echo "#define MAIL_UNLINK_SPOOL 1" >>confdefs.h - -fi - - -# Check whether --with-mailhost was given. -if test "${with_mailhost+set}" = set; then : - withval=$with_mailhost; -cat >>confdefs.h <<_ACEOF -#define MAILHOST "$withval" -_ACEOF - -fi - - - -# Check whether --with-sound was given. -if test "${with_sound+set}" = set; then : - withval=$with_sound; -else - with_sound=$with_features -fi - - - -# Check whether --with-x-toolkit was given. -if test "${with_x_toolkit+set}" = set; then : - withval=$with_x_toolkit; case "${withval}" in - y | ye | yes ) val=gtk ;; - n | no ) val=no ;; - l | lu | luc | luci | lucid ) val=lucid ;; - a | at | ath | athe | athen | athena ) val=athena ;; - m | mo | mot | moti | motif ) val=motif ;; - g | gt | gtk ) val=gtk ;; - gtk2 ) val=gtk2 ;; - gtk3 ) val=gtk3 ;; - * ) -as_fn_error "\`--with-x-toolkit=$withval' is invalid; -this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk', -\`gtk2' or \`gtk3'. \`yes' and \`gtk' are synonyms. -\`athena' and \`lucid' are synonyms." "$LINENO" 5 - ;; - esac - with_x_toolkit=$val - -fi - - - -# Check whether --with-wide-int was given. -if test "${with_wide_int+set}" = set; then : - withval=$with_wide_int; -else - with_wide_int=no -fi - -if test "$with_wide_int" = yes; then - -$as_echo "#define WIDE_EMACS_INT 1" >>confdefs.h - -fi - - -# Check whether --with-xpm was given. -if test "${with_xpm+set}" = set; then : - withval=$with_xpm; -else - with_xpm=$with_features -fi - - -# Check whether --with-jpeg was given. -if test "${with_jpeg+set}" = set; then : - withval=$with_jpeg; -else - with_jpeg=$with_features -fi - - -# Check whether --with-tiff was given. -if test "${with_tiff+set}" = set; then : - withval=$with_tiff; -else - with_tiff=$with_features -fi - - -# Check whether --with-gif was given. -if test "${with_gif+set}" = set; then : - withval=$with_gif; -else - with_gif=$with_features -fi - - -# Check whether --with-png was given. -if test "${with_png+set}" = set; then : - withval=$with_png; -else - with_png=$with_features -fi - - -# Check whether --with-rsvg was given. -if test "${with_rsvg+set}" = set; then : - withval=$with_rsvg; -else - with_rsvg=$with_features -fi - - -# Check whether --with-xml2 was given. -if test "${with_xml2+set}" = set; then : - withval=$with_xml2; -else - with_xml2=$with_features -fi - - -# Check whether --with-imagemagick was given. -if test "${with_imagemagick+set}" = set; then : - withval=$with_imagemagick; -else - with_imagemagick=$with_features -fi - - - -# Check whether --with-xft was given. -if test "${with_xft+set}" = set; then : - withval=$with_xft; -else - with_xft=$with_features -fi - - -# Check whether --with-libotf was given. -if test "${with_libotf+set}" = set; then : - withval=$with_libotf; -else - with_libotf=$with_features -fi - - -# Check whether --with-m17n-flt was given. -if test "${with_m17n_flt+set}" = set; then : - withval=$with_m17n_flt; -else - with_m17n_flt=$with_features -fi - - - -# Check whether --with-toolkit-scroll-bars was given. -if test "${with_toolkit_scroll_bars+set}" = set; then : - withval=$with_toolkit_scroll_bars; -else - with_toolkit_scroll_bars=$with_features -fi - - -# Check whether --with-xaw3d was given. -if test "${with_xaw3d+set}" = set; then : - withval=$with_xaw3d; -else - with_xaw3d=$with_features -fi - - -# Check whether --with-xim was given. -if test "${with_xim+set}" = set; then : - withval=$with_xim; -else - with_xim=$with_features -fi - - -# Check whether --with-ns was given. -if test "${with_ns+set}" = set; then : - withval=$with_ns; -else - with_ns=no -fi - - -# Check whether --with-w32 was given. -if test "${with_w32+set}" = set; then : - withval=$with_w32; -else - with_w32=no -fi - - - -# Check whether --with-gpm was given. -if test "${with_gpm+set}" = set; then : - withval=$with_gpm; -else - with_gpm=$with_features -fi - - -# Check whether --with-dbus was given. -if test "${with_dbus+set}" = set; then : - withval=$with_dbus; -else - with_dbus=$with_features -fi - - -# Check whether --with-gconf was given. -if test "${with_gconf+set}" = set; then : - withval=$with_gconf; -else - with_gconf=$with_features -fi - - -# Check whether --with-gsettings was given. -if test "${with_gsettings+set}" = set; then : - withval=$with_gsettings; -else - with_gsettings=$with_features -fi - - -# Check whether --with-selinux was given. -if test "${with_selinux+set}" = set; then : - withval=$with_selinux; -else - with_selinux=$with_features -fi - - -# Check whether --with-acl was given. -if test "${with_acl+set}" = set; then : - withval=$with_acl; -else - with_acl=$with_features -fi - - -# Check whether --with-gnutls was given. -if test "${with_gnutls+set}" = set; then : - withval=$with_gnutls; -else - with_gnutls=$with_features -fi - - -# Check whether --with-inotify was given. -if test "${with_inotify+set}" = set; then : - withval=$with_inotify; -else - with_inotify=$with_features -fi - - -## For the times when you want to build Emacs but don't have -## a suitable makeinfo, and can live without the manuals. - -# Check whether --with-makeinfo was given. -if test "${with_makeinfo+set}" = set; then : - withval=$with_makeinfo; -else - with_makeinfo=$with_features -fi - - -## Makefile.in needs the cache file name. - - -## This is an option because I do not know if all info/man support -## compressed files, nor how to test if they do so. - -# Check whether --with-compress-info was given. -if test "${with_compress_info+set}" = set; then : - withval=$with_compress_info; -else - with_compress_info=$with_features -fi - -if test $with_compress_info = yes; then - GZIP_INFO=yes -else - GZIP_INFO= -fi - - - -# Check whether --with-pkg-config-prog was given. -if test "${with_pkg_config_prog+set}" = set; then : - withval=$with_pkg_config_prog; -fi - -if test "X${with_pkg_config_prog}" != X; then - if test "${with_pkg_config_prog}" != yes; then - PKG_CONFIG="${with_pkg_config_prog}" - fi -fi - - -# Check whether --with-gameuser was given. -if test "${with_gameuser+set}" = set; then : - withval=$with_gameuser; -fi - -test "X${with_gameuser}" != X && test "${with_gameuser}" != yes \ - && gameuser="${with_gameuser}" -test "X$gameuser" = X && gameuser=games - - -# Check whether --with-gnustep-conf was given. -if test "${with_gnustep_conf+set}" = set; then : - withval=$with_gnustep_conf; -fi - -test "X${with_gnustep_conf}" != X && test "${with_gnustep_conf}" != yes && \ - GNUSTEP_CONFIG_FILE="${with_gnustep_conf}" -test "X$GNUSTEP_CONFIG_FILE" = "X" && \ - GNUSTEP_CONFIG_FILE=/etc/GNUstep/GNUstep.conf - -# Check whether --enable-ns-self-contained was given. -if test "${enable_ns_self_contained+set}" = set; then : - enableval=$enable_ns_self_contained; EN_NS_SELF_CONTAINED=$enableval -else - EN_NS_SELF_CONTAINED=yes -fi - - -# Check whether --enable-locallisppath was given. -if test "${enable_locallisppath+set}" = set; then : - enableval=$enable_locallisppath; if test "${enableval}" = "no"; then - locallisppath= -elif test "${enableval}" != "yes"; then - locallisppath=${enableval} -fi -fi - - -# Check whether --enable-checking was given. -if test "${enable_checking+set}" = set; then : - enableval=$enable_checking; ac_checking_flags="${enableval}" -fi - -IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS," -for check in $ac_checking_flags -do - case $check in - # these set all the flags to specific states - yes) ac_enable_checking=1 ;; - no) ac_enable_checking= ; - ac_gc_check_stringbytes= ; - ac_gc_check_string_overrun= ; - ac_gc_check_string_free_list= ; - ac_xmalloc_overrun= ; - ac_gc_check_cons_list= ; - ac_glyphs_debug= ;; - all) ac_enable_checking=1 ; - ac_gc_check_stringbytes=1 ; - ac_gc_check_string_overrun=1 ; - ac_gc_check_string_free_list=1 ; - ac_xmalloc_overrun=1 ; - ac_gc_check_cons_list=1 ; - ac_glyphs_debug=1 ;; - # these enable particular checks - stringbytes) ac_gc_check_stringbytes=1 ;; - stringoverrun) ac_gc_check_string_overrun=1 ;; - stringfreelist) ac_gc_check_string_free_list=1 ;; - xmallocoverrun) ac_xmalloc_overrun=1 ;; - conslist) ac_gc_check_cons_list=1 ;; - glyphs) ac_glyphs_debug=1 ;; - *) as_fn_error "unknown check category $check" "$LINENO" 5 ;; - esac -done -IFS="$ac_save_IFS" - -if test x$ac_enable_checking != x ; then - -$as_echo "#define ENABLE_CHECKING 1" >>confdefs.h - -fi -if test x$ac_gc_check_stringbytes != x ; then - -$as_echo "#define GC_CHECK_STRING_BYTES 1" >>confdefs.h - -fi -if test x$ac_gc_check_string_overrun != x ; then - -$as_echo "#define GC_CHECK_STRING_OVERRUN 1" >>confdefs.h - -fi -if test x$ac_gc_check_string_free_list != x ; then - -$as_echo "#define GC_CHECK_STRING_FREE_LIST 1" >>confdefs.h - -fi -if test x$ac_xmalloc_overrun != x ; then - -$as_echo "#define XMALLOC_OVERRUN_CHECK 1" >>confdefs.h - -fi -if test x$ac_gc_check_cons_list != x ; then - -$as_echo "#define GC_CHECK_CONS_LIST 1" >>confdefs.h - -fi -if test x$ac_glyphs_debug != x ; then - -$as_echo "#define GLYPH_DEBUG 1" >>confdefs.h - -fi - -# Check whether --enable-check-lisp-object-type was given. -if test "${enable_check_lisp_object_type+set}" = set; then : - enableval=$enable_check_lisp_object_type; if test "${enableval}" != "no"; then - -$as_echo "#define CHECK_LISP_OBJECT_TYPE 1" >>confdefs.h - -fi -fi - - - -# Check whether --enable-profiling was given. -if test "${enable_profiling+set}" = set; then : - enableval=$enable_profiling; ac_enable_profiling="${enableval}" -fi - -if test x$ac_enable_profiling != x ; then - PROFILING_CFLAGS="-DPROFILING=1 -pg" -else - PROFILING_CFLAGS= -fi - - -# Check whether --enable-autodepend was given. -if test "${enable_autodepend+set}" = set; then : - enableval=$enable_autodepend; ac_enable_autodepend="${enableval}" -else - ac_enable_autodepend=yes -fi - - -# Check whether --enable-gtk-deprecation-warnings was given. -if test "${enable_gtk_deprecation_warnings+set}" = set; then : - enableval=$enable_gtk_deprecation_warnings; ac_enable_gtk_deprecation_warnings="${enableval}" -fi - - -#### Make srcdir absolute, if it isn't already. It's important to -#### avoid running the file name through pwd unnecessarily, since pwd can -#### give you automounter prefixes, which can go away. We do all this -#### so Emacs can find its files when run uninstalled. -## Make sure CDPATH doesn't affect cd (in case PWD is relative). -unset CDPATH -case "${srcdir}" in - /* ) ;; - . ) - ## We may be able to use the $PWD environment variable to make this - ## absolute. But sometimes PWD is inaccurate. - ## Note: we used to use $PWD at the end instead of `pwd`, - ## but that tested only for a well-formed and valid PWD, - ## it did not object when PWD was well-formed and valid but just wrong. - if test ".$PWD" != "." && test ".`(cd "$PWD" ; sh -c pwd)`" = ".`pwd`" ; - then - srcdir="$PWD" - else - srcdir=`(cd "$srcdir"; pwd)` - fi - ;; - * ) srcdir=`(cd "$srcdir"; pwd)` ;; -esac - -### Canonicalize the configuration name. - -# Make sure we can run config.sub. -$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || - as_fn_error "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 -$as_echo_n "checking build system type... " >&6; } -if test "${ac_cv_build+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_build_alias=$build_alias -test "x$ac_build_alias" = x && - ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` -test "x$ac_build_alias" = x && - as_fn_error "cannot guess build type; you must specify one" "$LINENO" 5 -ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || - as_fn_error "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 -$as_echo "$ac_cv_build" >&6; } -case $ac_cv_build in -*-*-*) ;; -*) as_fn_error "invalid value of canonical build" "$LINENO" 5;; -esac -build=$ac_cv_build -ac_save_IFS=$IFS; IFS='-' -set x $ac_cv_build -shift -build_cpu=$1 -build_vendor=$2 -shift; shift -# Remember, the first character of IFS is used to create $*, -# except with old shells: -build_os=$* -IFS=$ac_save_IFS -case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 -$as_echo_n "checking host system type... " >&6; } -if test "${ac_cv_host+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "x$host_alias" = x; then - ac_cv_host=$ac_cv_build -else - ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || - as_fn_error "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 -$as_echo "$ac_cv_host" >&6; } -case $ac_cv_host in -*-*-*) ;; -*) as_fn_error "invalid value of canonical host" "$LINENO" 5;; -esac -host=$ac_cv_host -ac_save_IFS=$IFS; IFS='-' -set x $ac_cv_host -shift -host_cpu=$1 -host_vendor=$2 -shift; shift -# Remember, the first character of IFS is used to create $*, -# except with old shells: -host_os=$* -IFS=$ac_save_IFS -case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac - - -canonical=$host -configuration=${host_alias-${build_alias-$host}} - - - -### If you add support for a new configuration, add code to this -### switch statement to recognize your configuration name and select -### the appropriate operating system file. - -### You would hope that you could choose an s/*.h -### file based on the operating system portion. However, it turns out -### that each s/*.h file is pretty manufacturer-specific. -### So we basically have to have a special case for each -### configuration name. -### -### As far as handling version numbers on operating systems is -### concerned, make sure things will fail in a fixable way. If -### /etc/MACHINES doesn't say anything about version numbers, be -### prepared to handle anything reasonably. If version numbers -### matter, be sure /etc/MACHINES says something about it. - -opsys='' unported=no -case "${canonical}" in - - ## GNU/Linux and similar ports - *-*-linux* ) - opsys=gnu-linux - ;; - - ## FreeBSD ports - *-*-freebsd* ) - opsys=freebsd - ;; - - ## FreeBSD kernel + glibc based userland - *-*-kfreebsd*gnu* ) - opsys=gnu-kfreebsd - ;; - - ## NetBSD ports - *-*-netbsd* ) - opsys=netbsd - ;; - - ## OpenBSD ports - *-*-openbsd* ) - opsys=openbsd - ;; - - ## Apple Darwin / Mac OS X - *-apple-darwin* ) - case "${canonical}" in - i[3456]86-* ) ;; - powerpc-* ) ;; - x86_64-* ) ;; - * ) unported=yes ;; - esac - opsys=darwin - ## Use fink packages if available. - ## FIXME find a better way to do this: http://debbugs.gnu.org/11507 -## if test -d /sw/include && test -d /sw/lib; then -## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib" -## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS} -## fi - ;; - - ## HP 9000 series 700 and 800, running HP/UX - hppa*-hp-hpux10.2* ) - opsys=hpux10-20 - ;; - hppa*-hp-hpux1[1-9]* ) - opsys=hpux11 - CFLAGS="-D_INCLUDE__STDC_A1_SOURCE $CFLAGS" - ;; - - ## IBM machines - rs6000-ibm-aix4.[23]* ) - opsys=aix4-2 - ;; - powerpc-ibm-aix4.[23]* ) - opsys=aix4-2 - ;; - rs6000-ibm-aix[56]* ) - opsys=aix4-2 - ;; - powerpc-ibm-aix[56]* ) - opsys=aix4-2 - ;; - - ## Silicon Graphics machines - ## Iris 4D - mips-sgi-irix6.5 ) - opsys=irix6-5 - # Without defining _LANGUAGE_C, things get masked out in the headers - # so that, for instance, grepping for `free' in stdlib.h fails and - # AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m). - NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C" - ;; - - ## Suns - *-sun-solaris* \ - | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \ - | x86_64-*-solaris2* | x86_64-*-sunos5*) - case "${canonical}" in - i[3456]86-*-* ) ;; - amd64-*-*|x86_64-*-*) ;; - sparc* ) ;; - * ) unported=yes ;; - esac - case "${canonical}" in - *-sunos5.6* | *-solaris2.6* ) - opsys=sol2-6 - RANLIB="ar -ts" - ;; - *-sunos5.[7-9]* | *-solaris2.[7-9]* ) - opsys=sol2-6 - emacs_check_sunpro_c=yes - ;; - *-sunos5* | *-solaris* ) - opsys=sol2-10 - emacs_check_sunpro_c=yes - ;; - esac - ## Watch out for a compiler that we know will not work. - case "${canonical}" in - *-solaris* | *-sunos5* ) - if [ "x$CC" = x/usr/ucb/cc ]; then - ## /usr/ucb/cc doesn't work; - ## we should find some other compiler that does work. - unset CC - fi - ;; - *) ;; - esac - ;; - - ## Intel 386 machines where we don't care about the manufacturer. - i[3456]86-*-* ) - case "${canonical}" in - *-cygwin ) opsys=cygwin ;; - *-darwin* ) opsys=darwin ;; - *-sysv4.2uw* ) opsys=unixware ;; - *-sysv5uw* ) opsys=unixware ;; - *-sysv5OpenUNIX* ) opsys=unixware ;; - ## Otherwise, we'll fall through to the generic opsys code at the bottom. - esac - ;; - - * ) - unported=yes - ;; -esac - -### If the code above didn't choose an operating system, just choose -### an operating system based on the configuration name. You really -### only want to use this when you have no idea what the right -### operating system is; if you know what operating systems a machine -### runs, it's cleaner to make it explicit in the case statement -### above. -if test x"${opsys}" = x; then - case "${canonical}" in - *-gnu* ) opsys=gnu ;; - * ) - unported=yes - ;; - esac -fi - - - -if test $unported = yes; then - as_fn_error "Emacs hasn't been ported to \`${canonical}' systems. -Check \`etc/MACHINES' for recognized configuration names." "$LINENO" 5 -fi - - -#### Choose a compiler. - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. -set dummy ${ac_tool_prefix}gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_CC="${ac_tool_prefix}gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_CC"; then - ac_ct_CC=$CC - # Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_CC="gcc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -else - CC="$ac_cv_prog_CC" -fi - -if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. -set dummy ${ac_tool_prefix}cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_CC="${ac_tool_prefix}cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - fi -fi -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - ac_prog_rejected=no -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# != 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" - fi -fi -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - for ac_prog in cl.exe - do - # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. -set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$CC" && break - done -fi -if test -z "$CC"; then - ac_ct_CC=$CC - for ac_prog in cl.exe -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_CC="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$ac_ct_CC" && break -done - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -fi - -fi - - -test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "no acceptable C compiler found in \$PATH -See \`config.log' for more details." "$LINENO" 5; } - -# Provide some information about the compiler. -$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 -set X $ac_compile -ac_compiler=$2 -for ac_option in --version -v -V -qversion; do - { { ac_try="$ac_compiler $ac_option >&5" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compiler $ac_option >&5") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - sed '10a\ -... rest of stderr output deleted ... - 10q' conftest.err >conftest.er1 - cat conftest.er1 >&5 - fi - rm -f conftest.er1 conftest.err - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -done - -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" -# Try to create an executable without -o first, disregard a.out. -# It will help us diagnose broken compilers, and finding out an intuition -# of exeext. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 -$as_echo_n "checking whether the C compiler works... " >&6; } -ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` - -# The possible output files: -ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" - -ac_rmfiles= -for ac_file in $ac_files -do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - * ) ac_rmfiles="$ac_rmfiles $ac_file";; - esac -done -rm -f $ac_rmfiles - -if { { ac_try="$ac_link_default" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link_default") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' -# in a Makefile. We should not override ac_cv_exeext if it was cached, -# so that the user can short-circuit this test for compilers unknown to -# Autoconf. -for ac_file in $ac_files '' -do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) - ;; - [ab].out ) - # We found the default executable, but exeext='' is most - # certainly right. - break;; - *.* ) - if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; - then :; else - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - fi - # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' - # argument, so we may need to know it at that point already. - # Even if this section looks crufty: it has the advantage of - # actually working. - break;; - * ) - break;; - esac -done -test "$ac_cv_exeext" = no && ac_cv_exeext= - -else - ac_file='' -fi -if test -z "$ac_file"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -$as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "C compiler cannot create executables -See \`config.log' for more details." "$LINENO" 5; }; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 -$as_echo_n "checking for C compiler default output file name... " >&6; } -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 -$as_echo "$ac_file" >&6; } -ac_exeext=$ac_cv_exeext - -rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 -$as_echo_n "checking for suffix of executables... " >&6; } -if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. -for ac_file in conftest.exe conftest conftest.*; do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - break;; - * ) break;; - esac -done -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details." "$LINENO" 5; } -fi -rm -f conftest conftest$ac_cv_exeext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 -$as_echo "$ac_cv_exeext" >&6; } - -rm -f conftest.$ac_ext -EXEEXT=$ac_cv_exeext -ac_exeext=$EXEEXT -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -FILE *f = fopen ("conftest.out", "w"); - return ferror (f) || fclose (f) != 0; - - ; - return 0; -} -_ACEOF -ac_clean_files="$ac_clean_files conftest.out" -# Check that the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 -$as_echo_n "checking whether we are cross compiling... " >&6; } -if test "$cross_compiling" != yes; then - { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if { ac_try='./conftest$ac_cv_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details." "$LINENO" 5; } - fi - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 -$as_echo "$cross_compiling" >&6; } - -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 -$as_echo_n "checking for suffix of object files... " >&6; } -if test "${ac_cv_objext+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -rm -f conftest.o conftest.obj -if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - for ac_file in conftest.o conftest.obj conftest.*; do - test -f "$ac_file" || continue; - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; - *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` - break;; - esac -done -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot compute suffix of object files: cannot compile -See \`config.log' for more details." "$LINENO" 5; } -fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 -$as_echo "$ac_cv_objext" >&6; } -OBJEXT=$ac_cv_objext -ac_objext=$OBJEXT -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 -$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -#ifndef __GNUC__ - choke me -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_compiler_gnu=yes -else - ac_compiler_gnu=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -ac_cv_c_compiler_gnu=$ac_compiler_gnu - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 -$as_echo "$ac_cv_c_compiler_gnu" >&6; } -if test $ac_compiler_gnu = yes; then - GCC=yes -else - GCC= -fi -ac_test_CFLAGS=${CFLAGS+set} -ac_save_CFLAGS=$CFLAGS -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 -$as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_save_c_werror_flag=$ac_c_werror_flag - ac_c_werror_flag=yes - ac_cv_prog_cc_g=no - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -else - CFLAGS="" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - ac_c_werror_flag=$ac_save_c_werror_flag - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 -$as_echo "$ac_cv_prog_cc_g" >&6; } -if test "$ac_test_CFLAGS" = set; then - CFLAGS=$ac_save_CFLAGS -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include -/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ -struct buf { int x; }; -FILE * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; -{ - return p[i]; -} -static char *f (char * (*g) (char **, int), char **p, ...) -{ - char *s; - va_list v; - va_start (v,p); - s = g (p, va_arg (v,int)); - va_end (v); - return s; -} - -/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has - function prototypes and stuff, but not '\xHH' hex character constants. - These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get - proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an - array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ -int osf4_cc_array ['\x00' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); -int argc; -char **argv; -int -main () -{ -return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; - ; - return 0; -} -_ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno; then : - -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -DEPDIR="${am__leading_dot}deps" - -ac_config_commands="$ac_config_commands depfiles" - - -am_make=${MAKE-make} -cat > confinc << 'END' -am__doit: - @echo this is the am__doit target -.PHONY: am__doit -END -# If we don't find an include directive, just comment out the code. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 -$as_echo_n "checking for style of include used by $am_make... " >&6; } -am__include="#" -am__quote= -_am_result=none -# First try GNU make style include. -echo "include confinc" > confmf -# Ignore all kinds of additional output from `make'. -case `$am_make -s -f confmf 2> /dev/null` in #( -*the\ am__doit\ target*) - am__include=include - am__quote= - _am_result=GNU - ;; -esac -# Now try BSD make style include. -if test "$am__include" = "#"; then - echo '.include "confinc"' > confmf - case `$am_make -s -f confmf 2> /dev/null` in #( - *the\ am__doit\ target*) - am__include=.include - am__quote="\"" - _am_result=BSD - ;; - esac -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 -$as_echo "$_am_result" >&6; } -rm -f confinc confmf - -# Check whether --enable-dependency-tracking was given. -if test "${enable_dependency_tracking+set}" = set; then : - enableval=$enable_dependency_tracking; -fi - -if test "x$enable_dependency_tracking" != xno; then - am_depcomp="$ac_aux_dir/depcomp" - AMDEPBACKSLASH='\' -fi - if test "x$enable_dependency_tracking" != xno; then - AMDEP_TRUE= - AMDEP_FALSE='#' -else - AMDEP_TRUE='#' - AMDEP_FALSE= -fi - - - -depcc="$CC" am_compiler_list= - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 -$as_echo_n "checking dependency style of $depcc... " >&6; } -if test "${am_cv_CC_dependencies_compiler_type+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then - # We make a subdir and do the tests there. Otherwise we can end up - # making bogus files that we don't know about and never remove. For - # instance it was reported that on HP-UX the gcc test will end up - # making a dummy file named `D' -- because `-MD' means `put the output - # in D'. - mkdir conftest.dir - # Copy depcomp to subdir because otherwise we won't find it if we're - # using a relative directory. - cp "$am_depcomp" conftest.dir - cd conftest.dir - # We will build objects and dependencies in a subdirectory because - # it helps to detect inapplicable dependency modes. For instance - # both Tru64's cc and ICC support -MD to output dependencies as a - # side effect of compilation, but ICC will put the dependencies in - # the current directory while Tru64 will put them in the object - # directory. - mkdir sub - - am_cv_CC_dependencies_compiler_type=none - if test "$am_compiler_list" = ""; then - am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` - fi - am__universal=false - case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac - - for depmode in $am_compiler_list; do - # Setup a source with many dependencies, because some compilers - # like to wrap large dependency lists on column 80 (with \), and - # we should not choose a depcomp mode which is confused by this. - # - # We need to recreate these files for each test, as the compiler may - # overwrite some of them when testing with obscure command lines. - # This happens at least with the AIX C compiler. - : > sub/conftest.c - for i in 1 2 3 4 5 6; do - echo '#include "conftst'$i'.h"' >> sub/conftest.c - # Using `: > sub/conftst$i.h' creates only sub/conftst1.h with - # Solaris 8's {/usr,}/bin/sh. - touch sub/conftst$i.h - done - echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf - - # We check with `-c' and `-o' for the sake of the "dashmstdout" - # mode. It turns out that the SunPro C++ compiler does not properly - # handle `-M -o', and we need to detect this. Also, some Intel - # versions had trouble with output in subdirs - am__obj=sub/conftest.${OBJEXT-o} - am__minus_obj="-o $am__obj" - case $depmode in - gcc) - # This depmode causes a compiler race in universal mode. - test "$am__universal" = false || continue - ;; - nosideeffect) - # after this tag, mechanisms are not by side-effect, so they'll - # only be used when explicitly requested - if test "x$enable_dependency_tracking" = xyes; then - continue - else - break - fi - ;; - msvisualcpp | msvcmsys) - # This compiler won't grok `-c -o', but also, the minuso test has - # not run yet. These depmodes are late enough in the game, and - # so weak that their functioning should not be impacted. - am__obj=conftest.${OBJEXT-o} - am__minus_obj= - ;; - none) break ;; - esac - if depmode=$depmode \ - source=sub/conftest.c object=$am__obj \ - depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ - $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ - >/dev/null 2>conftest.err && - grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && - grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && - grep $am__obj sub/conftest.Po > /dev/null 2>&1 && - ${MAKE-make} -s -f confmf > /dev/null 2>&1; then - # icc doesn't choke on unknown options, it will just issue warnings - # or remarks (even with -Werror). So we grep stderr for any message - # that says an option was ignored or not supported. - # When given -MP, icc 7.0 and 7.1 complain thusly: - # icc: Command line warning: ignoring option '-M'; no argument required - # The diagnosis changed in icc 8.0: - # icc: Command line remark: option '-MP' not supported - if (grep 'ignoring option' conftest.err || - grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else - am_cv_CC_dependencies_compiler_type=$depmode - break - fi - fi - done - - cd .. - rm -rf conftest.dir -else - am_cv_CC_dependencies_compiler_type=none -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 -$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } -CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type - - if - test "x$enable_dependency_tracking" != xno \ - && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then - am__fastdepCC_TRUE= - am__fastdepCC_FALSE='#' -else - am__fastdepCC_TRUE='#' - am__fastdepCC_FALSE= -fi - - -if test "x$CC" != xcc; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC and cc understand -c and -o together" >&5 -$as_echo_n "checking whether $CC and cc understand -c and -o together... " >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether cc understands -c and -o together" >&5 -$as_echo_n "checking whether cc understands -c and -o together... " >&6; } -fi -set dummy $CC; ac_cc=`$as_echo "$2" | - sed 's/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/'` -if { as_var=ac_cv_prog_cc_${ac_cc}_c_o; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -# Make sure it works both with $CC and with simple cc. -# We do the test twice because some compilers refuse to overwrite an -# existing .o file with -o, though they will create one. -ac_try='$CC -c conftest.$ac_ext -o conftest2.$ac_objext >&5' -rm -f conftest2.* -if { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && - test -f conftest2.$ac_objext && { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; -then - eval ac_cv_prog_cc_${ac_cc}_c_o=yes - if test "x$CC" != xcc; then - # Test first that cc exists at all. - if { ac_try='cc -c conftest.$ac_ext >&5' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - ac_try='cc -c conftest.$ac_ext -o conftest2.$ac_objext >&5' - rm -f conftest2.* - if { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && - test -f conftest2.$ac_objext && { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; - then - # cc works too. - : - else - # cc exists but doesn't like -o. - eval ac_cv_prog_cc_${ac_cc}_c_o=no - fi - fi - fi -else - eval ac_cv_prog_cc_${ac_cc}_c_o=no -fi -rm -f core conftest* - -fi -if eval test \$ac_cv_prog_cc_${ac_cc}_c_o = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -$as_echo "#define NO_MINUS_C_MINUS_O 1" >>confdefs.h - -fi - -# FIXME: we rely on the cache variable name because -# there is no other way. -set dummy $CC -am_cc=`echo $2 | sed 's/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/'` -eval am_t=\$ac_cv_prog_cc_${am_cc}_c_o -if test "$am_t" != yes; then - # Losing compiler, so override with the script. - # FIXME: It is wrong to rewrite CC. - # But if we don't then we get into trouble of one sort or another. - # A longer-term fix would be to have automake use am__CC in this case, - # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" - CC="$am_aux_dir/compile $CC" -fi - - - -if test x$GCC = xyes; then - test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS" -else - test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" -fi - -# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them. - -# Avoid gnulib's threadlib module, as we do threads our own way. - - -# Initialize gnulib right after choosing the compiler. - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 -$as_echo_n "checking how to run the C preprocessor... " >&6; } -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # Double quotes because CPP needs to be expanded - for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" - do - ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - break -fi - - done - ac_cv_prog_CPP=$CPP - -fi - CPP=$ac_cv_prog_CPP -else - ac_cv_prog_CPP=$CPP -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 -$as_echo "$CPP" >&6; } -ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details." "$LINENO" 5; } -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -$as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if test "${ac_cv_path_GREP+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$GREP"; then - ac_path_GREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in grep ggrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in -*GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_GREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_GREP=$GREP -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -$as_echo "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -$as_echo_n "checking for egrep... " >&6; } -if test "${ac_cv_path_EGREP+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in -*GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then - as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP=$EGREP -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -$as_echo "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Minix Amsterdam compiler" >&5 -$as_echo_n "checking for Minix Amsterdam compiler... " >&6; } -if test "${gl_cv_c_amsterdam_compiler+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifdef __ACK__ -Amsterdam -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "Amsterdam" >/dev/null 2>&1; then : - gl_cv_c_amsterdam_compiler=yes -else - gl_cv_c_amsterdam_compiler=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_c_amsterdam_compiler" >&5 -$as_echo "$gl_cv_c_amsterdam_compiler" >&6; } - if test -z "$AR"; then - if test $gl_cv_c_amsterdam_compiler = yes; then - AR='cc -c.a' - if test -z "$ARFLAGS"; then - ARFLAGS='-o' - fi - else - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. -set dummy ${ac_tool_prefix}ar; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_AR+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$AR"; then - ac_cv_prog_AR="$AR" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_AR="${ac_tool_prefix}ar" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -AR=$ac_cv_prog_AR -if test -n "$AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 -$as_echo "$AR" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_AR"; then - ac_ct_AR=$AR - # Extract the first word of "ar", so it can be a program name with args. -set dummy ar; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_AR+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_AR"; then - ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_AR="ar" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_AR=$ac_cv_prog_ac_ct_AR -if test -n "$ac_ct_AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 -$as_echo "$ac_ct_AR" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_AR" = x; then - AR="ar" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - AR=$ac_ct_AR - fi -else - AR="$ac_cv_prog_AR" -fi - - if test -z "$ARFLAGS"; then - ARFLAGS='cru' - fi - fi - else - if test -z "$ARFLAGS"; then - ARFLAGS='cru' - fi - fi - - - if test -z "$RANLIB"; then - if test $gl_cv_c_amsterdam_compiler = yes; then - RANLIB=':' - else - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. -set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_RANLIB+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$RANLIB"; then - ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -RANLIB=$ac_cv_prog_RANLIB -if test -n "$RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 -$as_echo "$RANLIB" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_RANLIB"; then - ac_ct_RANLIB=$RANLIB - # Extract the first word of "ranlib", so it can be a program name with args. -set dummy ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_RANLIB"; then - ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_RANLIB="ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB -if test -n "$ac_ct_RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 -$as_echo "$ac_ct_RANLIB" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_RANLIB" = x; then - RANLIB=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - RANLIB=$ac_ct_RANLIB - fi -else - RANLIB="$ac_cv_prog_RANLIB" -fi - - fi - fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 -$as_echo_n "checking for ANSI C header files... " >&6; } -if test "${ac_cv_header_stdc+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_stdc=yes -else - ac_cv_header_stdc=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then : - : -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#if ((' ' & 0x0FF) == 0x020) -# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#else -# define ISLOWER(c) \ - (('a' <= (c) && (c) <= 'i') \ - || ('j' <= (c) && (c) <= 'r') \ - || ('s' <= (c) && (c) <= 'z')) -# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) -#endif - -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int -main () -{ - int i; - for (i = 0; i < 256; i++) - if (XOR (islower (i), ISLOWER (i)) - || toupper (i) != TOUPPER (i)) - return 2; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -else - ac_cv_header_stdc=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 -$as_echo "$ac_cv_header_stdc" >&6; } -if test $ac_cv_header_stdc = yes; then - -$as_echo "#define STDC_HEADERS 1" >>confdefs.h - -fi - -# On IRIX 5.3, sys/types and inttypes.h are conflicting. -for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ - inttypes.h stdint.h unistd.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default -" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - - - ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" -if test "x$ac_cv_header_minix_config_h" = x""yes; then : - MINIX=yes -else - MINIX= -fi - - - if test "$MINIX" = yes; then - -$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h - - -$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h - - -$as_echo "#define _MINIX 1" >>confdefs.h - - -$as_echo "#define _NETBSD_SOURCE 1" >>confdefs.h - - fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 -$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } -if test "${ac_cv_safe_to_define___extensions__+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -# define __EXTENSIONS__ 1 - $ac_includes_default -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_safe_to_define___extensions__=yes -else - ac_cv_safe_to_define___extensions__=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 -$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } - test $ac_cv_safe_to_define___extensions__ = yes && - $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h - - $as_echo "#define _ALL_SOURCE 1" >>confdefs.h - - $as_echo "#define _DARWIN_C_SOURCE 1" >>confdefs.h - - $as_echo "#define _GNU_SOURCE 1" >>confdefs.h - - $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h - - $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether _XOPEN_SOURCE should be defined" >&5 -$as_echo_n "checking whether _XOPEN_SOURCE should be defined... " >&6; } -if test "${ac_cv_should_define__xopen_source+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_should_define__xopen_source=no - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - mbstate_t x; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #define _XOPEN_SOURCE 500 - #include - mbstate_t x; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_should_define__xopen_source=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_should_define__xopen_source" >&5 -$as_echo "$ac_cv_should_define__xopen_source" >&6; } - test $ac_cv_should_define__xopen_source = yes && - $as_echo "#define _XOPEN_SOURCE 500" >>confdefs.h - - - - - - - - -# Check whether --enable-largefile was given. -if test "${enable_largefile+set}" = set; then : - enableval=$enable_largefile; -fi - -if test "$enable_largefile" != no; then - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 -$as_echo_n "checking for special C compiler options needed for large files... " >&6; } -if test "${ac_cv_sys_largefile_CC+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_sys_largefile_CC=no - if test "$GCC" != yes; then - ac_save_CC=$CC - while :; do - # IRIX 6.2 and later do not support large files by default, - # so use the C compiler's -n32 option if that helps. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - /* Check that off_t can represent 2**63 - 1 correctly. - We can't simply define LARGE_OFF_T to be 9223372036854775807, - since some C++ compilers masquerading as C compilers - incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) - int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 - && LARGE_OFF_T % 2147483647 == 1) - ? 1 : -1]; -int -main () -{ - - ; - return 0; -} -_ACEOF - if ac_fn_c_try_compile "$LINENO"; then : - break -fi -rm -f core conftest.err conftest.$ac_objext - CC="$CC -n32" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_sys_largefile_CC=' -n32'; break -fi -rm -f core conftest.err conftest.$ac_objext - break - done - CC=$ac_save_CC - rm -f conftest.$ac_ext - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5 -$as_echo "$ac_cv_sys_largefile_CC" >&6; } - if test "$ac_cv_sys_largefile_CC" != no; then - CC=$CC$ac_cv_sys_largefile_CC - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 -$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } -if test "${ac_cv_sys_file_offset_bits+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - while :; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - /* Check that off_t can represent 2**63 - 1 correctly. - We can't simply define LARGE_OFF_T to be 9223372036854775807, - since some C++ compilers masquerading as C compilers - incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) - int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 - && LARGE_OFF_T % 2147483647 == 1) - ? 1 : -1]; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_sys_file_offset_bits=no; break -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#define _FILE_OFFSET_BITS 64 -#include - /* Check that off_t can represent 2**63 - 1 correctly. - We can't simply define LARGE_OFF_T to be 9223372036854775807, - since some C++ compilers masquerading as C compilers - incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) - int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 - && LARGE_OFF_T % 2147483647 == 1) - ? 1 : -1]; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_sys_file_offset_bits=64; break -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_cv_sys_file_offset_bits=unknown - break -done -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5 -$as_echo "$ac_cv_sys_file_offset_bits" >&6; } -case $ac_cv_sys_file_offset_bits in #( - no | unknown) ;; - *) -cat >>confdefs.h <<_ACEOF -#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits -_ACEOF -;; -esac -rm -rf conftest* - if test $ac_cv_sys_file_offset_bits = unknown; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 -$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } -if test "${ac_cv_sys_large_files+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - while :; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - /* Check that off_t can represent 2**63 - 1 correctly. - We can't simply define LARGE_OFF_T to be 9223372036854775807, - since some C++ compilers masquerading as C compilers - incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) - int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 - && LARGE_OFF_T % 2147483647 == 1) - ? 1 : -1]; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_sys_large_files=no; break -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#define _LARGE_FILES 1 -#include - /* Check that off_t can represent 2**63 - 1 correctly. - We can't simply define LARGE_OFF_T to be 9223372036854775807, - since some C++ compilers masquerading as C compilers - incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) - int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 - && LARGE_OFF_T % 2147483647 == 1) - ? 1 : -1]; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_sys_large_files=1; break -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_cv_sys_large_files=unknown - break -done -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5 -$as_echo "$ac_cv_sys_large_files" >&6; } -case $ac_cv_sys_large_files in #( - no | unknown) ;; - *) -cat >>confdefs.h <<_ACEOF -#define _LARGE_FILES $ac_cv_sys_large_files -_ACEOF -;; -esac -rm -rf conftest* - fi - - -$as_echo "#define _DARWIN_USE_64_BIT_INODE 1" >>confdefs.h - -fi - - case $ac_cv_prog_cc_stdc in #( - no) : - ac_cv_prog_cc_c99=no; ac_cv_prog_cc_c89=no ;; #( - *) : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C99" >&5 -$as_echo_n "checking for $CC option to accept ISO C99... " >&6; } -if test "${ac_cv_prog_cc_c99+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c99=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include -#include - -// Check varargs macros. These examples are taken from C99 6.10.3.5. -#define debug(...) fprintf (stderr, __VA_ARGS__) -#define showlist(...) puts (#__VA_ARGS__) -#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) -static void -test_varargs_macros (void) -{ - int x = 1234; - int y = 5678; - debug ("Flag"); - debug ("X = %d\n", x); - showlist (The first, second, and third items.); - report (x>y, "x is %d but y is %d", x, y); -} - -// Check long long types. -#define BIG64 18446744073709551615ull -#define BIG32 4294967295ul -#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) -#if !BIG_OK - your preprocessor is broken; -#endif -#if BIG_OK -#else - your preprocessor is broken; -#endif -static long long int bignum = -9223372036854775807LL; -static unsigned long long int ubignum = BIG64; - -struct incomplete_array -{ - int datasize; - double data[]; -}; - -struct named_init { - int number; - const wchar_t *name; - double average; -}; - -typedef const char *ccp; - -static inline int -test_restrict (ccp restrict text) -{ - // See if C++-style comments work. - // Iterate through items via the restricted pointer. - // Also check for declarations in for loops. - for (unsigned int i = 0; *(text+i) != '\0'; ++i) - continue; - return 0; -} - -// Check varargs and va_copy. -static void -test_varargs (const char *format, ...) -{ - va_list args; - va_start (args, format); - va_list args_copy; - va_copy (args_copy, args); - - const char *str; - int number; - float fnumber; - - while (*format) - { - switch (*format++) - { - case 's': // string - str = va_arg (args_copy, const char *); - break; - case 'd': // int - number = va_arg (args_copy, int); - break; - case 'f': // float - fnumber = va_arg (args_copy, double); - break; - default: - break; - } - } - va_end (args_copy); - va_end (args); -} - -int -main () -{ - - // Check bool. - _Bool success = false; - - // Check restrict. - if (test_restrict ("String literal") == 0) - success = true; - char *restrict newvar = "Another string"; - - // Check varargs. - test_varargs ("s, d' f .", "string", 65, 34.234); - test_varargs_macros (); - - // Check flexible array members. - struct incomplete_array *ia = - malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); - ia->datasize = 10; - for (int i = 0; i < ia->datasize; ++i) - ia->data[i] = i * 1.234; - - // Check named initializers. - struct named_init ni = { - .number = 34, - .name = L"Test wide string", - .average = 543.34343, - }; - - ni.number = 58; - - int dynamic_array[ni.number]; - dynamic_array[ni.number - 1] = 543; - - // work around unused variable warnings - return (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == 'x' - || dynamic_array[ni.number - 1] != 543); - - ; - return 0; -} -_ACEOF -for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -xc99=all -qlanglvl=extc99 -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c99=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c99" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c99" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c99" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -$as_echo "$ac_cv_prog_cc_c99" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c99" != xno; then : - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include -/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ -struct buf { int x; }; -FILE * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; -{ - return p[i]; -} -static char *f (char * (*g) (char **, int), char **p, ...) -{ - char *s; - va_list v; - va_start (v,p); - s = g (p, va_arg (v,int)); - va_end (v); - return s; -} - -/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has - function prototypes and stuff, but not '\xHH' hex character constants. - These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get - proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an - array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ -int osf4_cc_array ['\x00' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); -int argc; -char **argv; -int -main () -{ -return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; - ; - return 0; -} -_ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno; then : - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 -else - ac_cv_prog_cc_stdc=no -fi - -fi - ;; -esac - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO Standard C" >&5 -$as_echo_n "checking for $CC option to accept ISO Standard C... " >&6; } - if test "${ac_cv_prog_cc_stdc+set}" = set; then : - $as_echo_n "(cached) " >&6 -fi - - case $ac_cv_prog_cc_stdc in #( - no) : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; #( - '') : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; #( - *) : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_stdc" >&5 -$as_echo "$ac_cv_prog_cc_stdc" >&6; } ;; -esac - - - - # Code from module alloca-opt: - # Code from module allocator: - # Code from module at-internal: - # Code from module c-ctype: - # Code from module c-strcase: - # Code from module careadlinkat: - # Code from module clock-time: - # Code from module close-stream: - # Code from module crypto/md5: - # Code from module crypto/sha1: - # Code from module crypto/sha256: - # Code from module crypto/sha512: - # Code from module dirent: - # Code from module dosname: - # Code from module dtoastr: - # Code from module dtotimespec: - # Code from module dup2: - # Code from module environ: - # Code from module euidaccess: - # Code from module execinfo: - # Code from module extensions: - - # Code from module extern-inline: - # Code from module faccessat: - # Code from module fcntl-h: - # Code from module fdopendir: - # Code from module filemode: - # Code from module fpending: - # Code from module fstatat: - # Code from module getgroups: - # Code from module getloadavg: - # Code from module getopt-gnu: - # Code from module getopt-posix: - # Code from module gettext-h: - # Code from module gettime: - # Code from module gettimeofday: - # Code from module group-member: - # Code from module ignore-value: - # Code from module include_next: - # Code from module intprops: - # Code from module inttypes-incomplete: - # Code from module largefile: - - # Code from module lstat: - # Code from module manywarnings: - # Code from module memrchr: - # Code from module mktime: - # Code from module multiarch: - # Code from module nocrash: - # Code from module openat-h: - # Code from module pathmax: - # Code from module pselect: - # Code from module pthread_sigmask: - # Code from module putenv: - # Code from module readlink: - # Code from module readlinkat: - # Code from module root-uid: - # Code from module sig2str: - # Code from module signal-h: - # Code from module snippet/_Noreturn: - # Code from module snippet/arg-nonnull: - # Code from module snippet/c++defs: - # Code from module snippet/warn-on-use: - # Code from module socklen: - # Code from module ssize_t: - # Code from module stat: - # Code from module stat-time: - # Code from module stdalign: - # Code from module stdarg: - - - - # Code from module stdbool: - # Code from module stddef: - # Code from module stdint: - # Code from module stdio: - # Code from module stdlib: - # Code from module strftime: - # Code from module string: - # Code from module strtoimax: - # Code from module strtoll: - # Code from module strtoull: - # Code from module strtoumax: - # Code from module symlink: - # Code from module sys_select: - # Code from module sys_stat: - # Code from module sys_time: - # Code from module time: - # Code from module time_r: - # Code from module timer-time: - # Code from module timespec: - # Code from module timespec-add: - # Code from module timespec-sub: - # Code from module u64: - # Code from module unistd: - # Code from module unsetenv: - # Code from module utimens: - # Code from module verify: - # Code from module warnings: - # Code from module xalloc-oversized: - - -# It's helpful to have C macros available to GDB, so prefer -g3 to -g -# if -g3 works and the user does not specify CFLAGS. -# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains. -if test "$ac_test_CFLAGS" != set; then - case $CFLAGS in - '-g') - emacs_g3_CFLAGS='-g3';; - '-g -O2') - emacs_g3_CFLAGS='-g3 -O2';; - *) - emacs_g3_CFLAGS='';; - esac - if test -n "$emacs_g3_CFLAGS"; then - emacs_save_CFLAGS=$CFLAGS - CFLAGS=$emacs_g3_CFLAGS - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts $emacs_g3_CFLAGS" >&5 -$as_echo_n "checking whether $CC accepts $emacs_g3_CFLAGS... " >&6; } -if test "${emacs_cv_prog_cc_g3+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_prog_cc_g3=yes -else - emacs_cv_prog_cc_g3=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_prog_cc_g3" >&5 -$as_echo "$emacs_cv_prog_cc_g3" >&6; } - if test $emacs_cv_prog_cc_g3 = yes; then - CFLAGS=$emacs_g3_CFLAGS - else - CFLAGS=$emacs_save_CFLAGS - fi - fi -fi - -# Check whether --enable-gcc-warnings was given. -if test "${enable_gcc_warnings+set}" = set; then : - enableval=$enable_gcc_warnings; case $enableval in - yes|no) ;; - *) as_fn_error "bad value $enableval for gcc-warnings option" "$LINENO" 5 ;; - esac - gl_gcc_warnings=$enableval -else - gl_gcc_warnings=no - -fi - - -# Check whether --enable-link-time-optimization was given. -if test "${enable_link_time_optimization+set}" = set; then : - enableval=$enable_link_time_optimization; if test "${enableval}" != "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether link-time optimization is supported" >&5 -$as_echo_n "checking whether link-time optimization is supported... " >&6; } - ac_lto_supported=no - if test x$GCC = xyes; then - CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null` - if test x$CPUS != x; then - LTO="-flto=$CPUS" - else - LTO="-flto" - fi - old_CFLAGS=$CFLAGS - CFLAGS="$CFLAGS $LTO" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_lto_supported=yes -else - ac_lto_supported=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$old_CFLAGS" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_lto_supported" >&5 -$as_echo "$ac_lto_supported" >&6; } - if test "$ac_lto_supported" = "yes"; then - CFLAGS="$CFLAGS $LTO" - fi -fi -fi - - -# gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found]) -# ------------------------------------------------ -# If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND. -# Otherwise, run RUN-IF-NOT-FOUND. - - -# When compiling with GCC, prefer -isystem to -I when including system -# include files, to avoid generating useless diagnostics for the files. -if test "$gl_gcc_warnings" != yes; then - isystem='-I' -else - isystem='-isystem ' - - # This, $nw, is the list of warnings we disable. - nw= - - case $with_x_toolkit in - lucid | athena | motif) - # Old toolkits mishandle 'const'. - nw="$nw -Wwrite-strings" - ;; - *) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Werror" >&5 -$as_echo_n "checking whether C compiler handles -Werror... " >&6; } -if test "${gl_cv_warn_c__Werror+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Werror" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Werror=yes -else - gl_cv_warn_c__Werror=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Werror" >&5 -$as_echo "$gl_cv_warn_c__Werror" >&6; } -if test "x$gl_cv_warn_c__Werror" = x""yes; then : - as_fn_append WERROR_CFLAGS " -Werror" -fi - - - ;; - esac - - - nw="$nw -Waggregate-return" # anachronistic - nw="$nw -Wlong-long" # C90 is anachronistic - nw="$nw -Wc++-compat" # We don't care about C++ compilers - nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib - nw="$nw -Wtraditional" # Warns on #elif which we use often - nw="$nw -Wcast-qual" # Too many warnings for now - nw="$nw -Wconversion" # Too many warnings for now - nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings - nw="$nw -Wsign-conversion" # Too many warnings for now - nw="$nw -Woverlength-strings" # Not a problem these days - nw="$nw -Wtraditional-conversion" # Too many warnings for now - nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored - nw="$nw -Wpadded" # Our structs are not padded - nw="$nw -Wredundant-decls" # we regularly (re)declare functions - nw="$nw -Wlogical-op" # any use of fwrite provokes this - nw="$nw -Wformat-nonliteral" # we do this a lot - nw="$nw -Wvla" # warnings in gettext.h - nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__ - nw="$nw -Wswitch-enum" # Too many warnings for now - nw="$nw -Wswitch-default" # Too many warnings for now - nw="$nw -Wfloat-equal" # warns about high-quality code - nw="$nw -Winline" # OK to ignore 'inline' - nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. - nw="$nw -Wstrict-overflow" # OK to optimize assuming that - # signed overflow has undefined behavior - nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning - nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations - - # Emacs doesn't care about shadowing; see - # . - nw="$nw -Wshadow" - - # Emacs's use of alloca inhibits protecting the stack. - nw="$nw -Wstack-protector" - - # The following line should be removable at some point. - nw="$nw -Wsuggest-attribute=pure" - - - - if test -n "$GCC"; then - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is supported" >&5 -$as_echo_n "checking whether -Wno-missing-field-initializers is supported... " >&6; } - if test "${gl_cv_cc_nomfi_supported+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_cc_nomfi_supported=yes -else - gl_cv_cc_nomfi_supported=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_CFLAGS" -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_supported" >&5 -$as_echo "$gl_cv_cc_nomfi_supported" >&6; } - - if test "$gl_cv_cc_nomfi_supported" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is needed" >&5 -$as_echo_n "checking whether -Wno-missing-field-initializers is needed... " >&6; } - if test "${gl_cv_cc_nomfi_needed+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -void f (void) - { - typedef struct { int a; int b; } s_t; - s_t s1 = { 0, }; - } - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_cc_nomfi_needed=no -else - gl_cv_cc_nomfi_needed=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_CFLAGS" - -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_needed" >&5 -$as_echo "$gl_cv_cc_nomfi_needed" >&6; } - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wuninitialized is supported" >&5 -$as_echo_n "checking whether -Wuninitialized is supported... " >&6; } - if test "${gl_cv_cc_uninitialized_supported+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -Werror -Wuninitialized" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_cc_uninitialized_supported=yes -else - gl_cv_cc_uninitialized_supported=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_CFLAGS" -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_uninitialized_supported" >&5 -$as_echo "$gl_cv_cc_uninitialized_supported" >&6; } - - fi - - # List all gcc warning categories. - gl_manywarn_set= - for gl_manywarn_item in \ - -W \ - -Wabi \ - -Waddress \ - -Wall \ - -Warray-bounds \ - -Wattributes \ - -Wbad-function-cast \ - -Wbuiltin-macro-redefined \ - -Wcast-align \ - -Wchar-subscripts \ - -Wclobbered \ - -Wcomment \ - -Wcomments \ - -Wcoverage-mismatch \ - -Wcpp \ - -Wdeprecated \ - -Wdeprecated-declarations \ - -Wdisabled-optimization \ - -Wdiv-by-zero \ - -Wdouble-promotion \ - -Wempty-body \ - -Wendif-labels \ - -Wenum-compare \ - -Wextra \ - -Wformat-contains-nul \ - -Wformat-extra-args \ - -Wformat-nonliteral \ - -Wformat-security \ - -Wformat-y2k \ - -Wformat-zero-length \ - -Wformat=2 \ - -Wfree-nonheap-object \ - -Wignored-qualifiers \ - -Wimplicit \ - -Wimplicit-function-declaration \ - -Wimplicit-int \ - -Winit-self \ - -Winline \ - -Wint-to-pointer-cast \ - -Winvalid-memory-model \ - -Winvalid-pch \ - -Wjump-misses-init \ - -Wlogical-op \ - -Wmain \ - -Wmaybe-uninitialized \ - -Wmissing-braces \ - -Wmissing-declarations \ - -Wmissing-field-initializers \ - -Wmissing-format-attribute \ - -Wmissing-include-dirs \ - -Wmissing-noreturn \ - -Wmissing-parameter-type \ - -Wmissing-prototypes \ - -Wmudflap \ - -Wmultichar \ - -Wnarrowing \ - -Wnested-externs \ - -Wnonnull \ - -Wnormalized=nfc \ - -Wold-style-declaration \ - -Wold-style-definition \ - -Woverflow \ - -Woverlength-strings \ - -Woverride-init \ - -Wpacked \ - -Wpacked-bitfield-compat \ - -Wparentheses \ - -Wpointer-arith \ - -Wpointer-sign \ - -Wpointer-to-int-cast \ - -Wpragmas \ - -Wreturn-type \ - -Wsequence-point \ - -Wshadow \ - -Wsizeof-pointer-memaccess \ - -Wstack-protector \ - -Wstrict-aliasing \ - -Wstrict-overflow \ - -Wstrict-prototypes \ - -Wsuggest-attribute=const \ - -Wsuggest-attribute=format \ - -Wsuggest-attribute=noreturn \ - -Wsuggest-attribute=pure \ - -Wswitch \ - -Wswitch-default \ - -Wsync-nand \ - -Wsystem-headers \ - -Wtrampolines \ - -Wtrigraphs \ - -Wtype-limits \ - -Wuninitialized \ - -Wunknown-pragmas \ - -Wunreachable-code \ - -Wunsafe-loop-optimizations \ - -Wunused \ - -Wunused-but-set-parameter \ - -Wunused-but-set-variable \ - -Wunused-function \ - -Wunused-label \ - -Wunused-local-typedefs \ - -Wunused-macros \ - -Wunused-parameter \ - -Wunused-result \ - -Wunused-value \ - -Wunused-variable \ - -Wvarargs \ - -Wvariadic-macros \ - -Wvector-operation-performance \ - -Wvla \ - -Wvolatile-register-var \ - -Wwrite-strings \ - \ - ; do - gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item" - done - - # Disable specific options as needed. - if test "$gl_cv_cc_nomfi_needed" = yes; then - gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers" - fi - - if test "$gl_cv_cc_uninitialized_supported" = no; then - gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized" - fi - - ws=$gl_manywarn_set - - - gl_warn_set= - set x $ws; shift - for gl_warn_item - do - case " $nw " in - *" $gl_warn_item "*) - ;; - *) - gl_warn_set="$gl_warn_set $gl_warn_item" - ;; - esac - done - ws=$gl_warn_set - - for w in $ws; do - as_gl_Warn=`$as_echo "gl_cv_warn_c_$w" | $as_tr_sh` -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles $w" >&5 -$as_echo_n "checking whether C compiler handles $w... " >&6; } -if { as_var=$as_gl_Warn; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " $w" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$as_gl_Warn=yes" -else - eval "$as_gl_Warn=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -eval ac_res=\$$as_gl_Warn - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -eval as_val=\$$as_gl_Warn - if test "x$as_val" = x""yes; then : - as_fn_append WARN_CFLAGS " $w" -fi - - - done - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-missing-field-initializers" >&5 -$as_echo_n "checking whether C compiler handles -Wno-missing-field-initializers... " >&6; } -if test "${gl_cv_warn_c__Wno_missing_field_initializers+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-missing-field-initializers" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_missing_field_initializers=yes -else - gl_cv_warn_c__Wno_missing_field_initializers=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_missing_field_initializers" >&5 -$as_echo "$gl_cv_warn_c__Wno_missing_field_initializers" >&6; } -if test "x$gl_cv_warn_c__Wno_missing_field_initializers" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-missing-field-initializers" -fi - - # We need this one - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-sign-compare" >&5 -$as_echo_n "checking whether C compiler handles -Wno-sign-compare... " >&6; } -if test "${gl_cv_warn_c__Wno_sign_compare+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-sign-compare" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_sign_compare=yes -else - gl_cv_warn_c__Wno_sign_compare=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_sign_compare" >&5 -$as_echo "$gl_cv_warn_c__Wno_sign_compare" >&6; } -if test "x$gl_cv_warn_c__Wno_sign_compare" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-sign-compare" -fi - - # Too many warnings for now - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-type-limits" >&5 -$as_echo_n "checking whether C compiler handles -Wno-type-limits... " >&6; } -if test "${gl_cv_warn_c__Wno_type_limits+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-type-limits" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_type_limits=yes -else - gl_cv_warn_c__Wno_type_limits=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_type_limits" >&5 -$as_echo "$gl_cv_warn_c__Wno_type_limits" >&6; } -if test "x$gl_cv_warn_c__Wno_type_limits" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-type-limits" -fi - - # Too many warnings for now - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-switch" >&5 -$as_echo_n "checking whether C compiler handles -Wno-switch... " >&6; } -if test "${gl_cv_warn_c__Wno_switch+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-switch" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_switch=yes -else - gl_cv_warn_c__Wno_switch=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_switch" >&5 -$as_echo "$gl_cv_warn_c__Wno_switch" >&6; } -if test "x$gl_cv_warn_c__Wno_switch" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-switch" -fi - - # Too many warnings for now - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-parameter" >&5 -$as_echo_n "checking whether C compiler handles -Wno-unused-parameter... " >&6; } -if test "${gl_cv_warn_c__Wno_unused_parameter+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-unused-parameter" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_unused_parameter=yes -else - gl_cv_warn_c__Wno_unused_parameter=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_parameter" >&5 -$as_echo "$gl_cv_warn_c__Wno_unused_parameter" >&6; } -if test "x$gl_cv_warn_c__Wno_unused_parameter" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-unused-parameter" -fi - - # Too many warnings for now - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-format-nonliteral" >&5 -$as_echo_n "checking whether C compiler handles -Wno-format-nonliteral... " >&6; } -if test "${gl_cv_warn_c__Wno_format_nonliteral+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-format-nonliteral" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_format_nonliteral=yes -else - gl_cv_warn_c__Wno_format_nonliteral=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_format_nonliteral" >&5 -$as_echo "$gl_cv_warn_c__Wno_format_nonliteral" >&6; } -if test "x$gl_cv_warn_c__Wno_format_nonliteral" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-format-nonliteral" -fi - - - - # In spite of excluding -Wlogical-op above, it is enabled, as of - # gcc 4.5.0 20090517. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-logical-op" >&5 -$as_echo_n "checking whether C compiler handles -Wno-logical-op... " >&6; } -if test "${gl_cv_warn_c__Wno_logical_op+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -Wno-logical-op" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__Wno_logical_op=yes -else - gl_cv_warn_c__Wno_logical_op=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_logical_op" >&5 -$as_echo "$gl_cv_warn_c__Wno_logical_op" >&6; } -if test "x$gl_cv_warn_c__Wno_logical_op" = x""yes; then : - as_fn_append WARN_CFLAGS " -Wno-logical-op" -fi - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -fdiagnostics-show-option" >&5 -$as_echo_n "checking whether C compiler handles -fdiagnostics-show-option... " >&6; } -if test "${gl_cv_warn_c__fdiagnostics_show_option+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -fdiagnostics-show-option" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__fdiagnostics_show_option=yes -else - gl_cv_warn_c__fdiagnostics_show_option=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__fdiagnostics_show_option" >&5 -$as_echo "$gl_cv_warn_c__fdiagnostics_show_option" >&6; } -if test "x$gl_cv_warn_c__fdiagnostics_show_option" = x""yes; then : - as_fn_append WARN_CFLAGS " -fdiagnostics-show-option" -fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -funit-at-a-time" >&5 -$as_echo_n "checking whether C compiler handles -funit-at-a-time... " >&6; } -if test "${gl_cv_warn_c__funit_at_a_time+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_compiler_FLAGS="$CFLAGS" - as_fn_append CFLAGS " -funit-at-a-time" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_warn_c__funit_at_a_time=yes -else - gl_cv_warn_c__funit_at_a_time=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$gl_save_compiler_FLAGS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__funit_at_a_time" >&5 -$as_echo "$gl_cv_warn_c__funit_at_a_time" >&6; } -if test "x$gl_cv_warn_c__funit_at_a_time" = x""yes; then : - as_fn_append WARN_CFLAGS " -funit-at-a-time" -fi - - - - -$as_echo "#define lint 1" >>confdefs.h - - - -$as_echo "#define GNULIB_PORTCHECK 1" >>confdefs.h - - - # We use a slightly smaller set of warning options for lib/. - # Remove the following and save the result in GNULIB_WARN_CFLAGS. - nw= - nw="$nw -Wunused-macros" - - - gl_warn_set= - set x $WARN_CFLAGS; shift - for gl_warn_item - do - case " $nw " in - *" $gl_warn_item "*) - ;; - *) - gl_warn_set="$gl_warn_set $gl_warn_item" - ;; - esac - done - GNULIB_WARN_CFLAGS=$gl_warn_set - - -fi - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 -$as_echo_n "checking whether ln -s works... " >&6; } -LN_S=$as_ln_s -if test "$LN_S" = "ln -s"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 -$as_echo "no, using $LN_S" >&6; } -fi - - -# Extract the first word of "install-info", so it can be a program name with args. -set dummy install-info; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $INSTALL_INFO in - [\\/]* | ?:[\\/]*) - ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_path_INSTALL_INFO" && ac_cv_path_INSTALL_INFO=":" - ;; -esac -fi -INSTALL_INFO=$ac_cv_path_INSTALL_INFO -if test -n "$INSTALL_INFO"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5 -$as_echo "$INSTALL_INFO" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -# Extract the first word of "gzip", so it can be a program name with args. -set dummy gzip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_GZIP_PROG+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $GZIP_PROG in - [\\/]* | ?:[\\/]*) - ac_cv_path_GZIP_PROG="$GZIP_PROG" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_path_GZIP_PROG="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - ;; -esac -fi -GZIP_PROG=$ac_cv_path_GZIP_PROG -if test -n "$GZIP_PROG"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GZIP_PROG" >&5 -$as_echo "$GZIP_PROG" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - -if test $opsys = gnu-linux; then - # Extract the first word of "paxctl", so it can be a program name with args. -set dummy paxctl; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PAXCTL+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $PAXCTL in - [\\/]* | ?:[\\/]*) - ac_cv_path_PAXCTL="$PAXCTL" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_path_PAXCTL="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - ;; -esac -fi -PAXCTL=$ac_cv_path_PAXCTL -if test -n "$PAXCTL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAXCTL" >&5 -$as_echo "$PAXCTL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test "X$PAXCTL" != X; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether binaries have a PT_PAX_FLAGS header" >&5 -$as_echo_n "checking whether binaries have a PT_PAX_FLAGS header... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; }; PAXCTL=""; fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - fi -fi - -## Need makeinfo >= 4.7 (?) to build the manuals. -# Extract the first word of "makeinfo", so it can be a program name with args. -set dummy makeinfo; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_MAKEINFO+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $MAKEINFO in - [\\/]* | ?:[\\/]*) - ac_cv_path_MAKEINFO="$MAKEINFO" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_path_MAKEINFO="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_path_MAKEINFO" && ac_cv_path_MAKEINFO="no" - ;; -esac -fi -MAKEINFO=$ac_cv_path_MAKEINFO -if test -n "$MAKEINFO"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 -$as_echo "$MAKEINFO" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -if test "$MAKEINFO" != "no"; then - case ` - $MAKEINFO --version 2> /dev/null | - $EGREP 'texinfo[^0-9]*([1-4][0-9]+|[5-9]|4\.[7-9]|4\.[1-6][0-9]+)' - ` in - '') MAKEINFO=no;; - esac -fi - -## Makeinfo is unusual. For a released Emacs, the manuals are -## pre-built, and not deleted by the normal clean rules. makeinfo is -## therefore in the category of "special tools" not normally required, which -## configure does not have to check for (eg autoconf itself). -## In a Bazaar checkout on the other hand, the manuals are not included. -## So makeinfo is a requirement to build from Bazaar, and configure -## should test for it as it does for any other build requirement. -## We use the presence of $srcdir/info/emacs to distinguish a release, -## with pre-built manuals, from a Bazaar checkout. -HAVE_MAKEINFO=yes - -if test "$MAKEINFO" = "no"; then - MAKEINFO=makeinfo - if test "x${with_makeinfo}" = "xno"; then - HAVE_MAKEINFO=no - elif test ! -e "$srcdir/info/emacs" && test ! -e "$srcdir/info/emacs.info"; then - as_fn_error "You do not seem to have makeinfo >= 4.7, and your -source tree does not seem to have pre-built manuals in the \`info' directory. -Either install a suitable version of makeinfo, or re-run configure -with the \`--without-makeinfo' option to build without the manuals. " "$LINENO" 5 - fi -fi - - -INFO_EXT=.info -INFO_OPTS=--no-split - - - - -if test x$GCC = xyes; then - test "x$GCC_LINK_TEST_OPTIONS" != x && \ - ac_link="$ac_link $GCC_LINK_TEST_OPTIONS" -else - test "x$NON_GCC_LINK_TEST_OPTIONS" != x && \ - ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" -fi - - -late_LDFLAGS=$LDFLAGS -if test x$GCC = xyes; then - LDFLAGS="$LDFLAGS -Wl,-znocombreloc" -else - LDFLAGS="$LDFLAGS -znocombreloc" -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -znocombreloc" >&5 -$as_echo_n "checking for -znocombreloc... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - LDFLAGS=$late_LDFLAGS - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - - -test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no -case "$opsys" in - your-opsys-here) CANNOT_DUMP=yes ;; -esac - -test "$CANNOT_DUMP" = "yes" && \ - -$as_echo "#define CANNOT_DUMP 1" >>confdefs.h - - - - - -UNEXEC_OBJ=unexelf.o -case "$opsys" in - # MSDOS uses unexcoff.o - # MSWindows uses unexw32.o - aix4-2) - UNEXEC_OBJ=unexaix.o - ;; - cygwin) - UNEXEC_OBJ=unexcw.o - ;; - darwin) - UNEXEC_OBJ=unexmacosx.o - ;; - hpux10-20 | hpux11) - UNEXEC_OBJ=unexhp9k800.o - ;; - sol2-10) - # Use the Solaris dldump() function, called from unexsol.c, to dump - # emacs, instead of the generic ELF dump code found in unexelf.c. - # The resulting binary has a complete symbol table, and is better - # for debugging and other observability tools (debuggers, pstack, etc). - # - # If you encounter a problem using dldump(), please consider sending - # a message to the OpenSolaris tools-linking mailing list: - # http://mail.opensolaris.org/mailman/listinfo/tools-linking - # - # It is likely that dldump() works with older Solaris too, but this has - # not been tested, so for now this change is for Solaris 10 or newer. - UNEXEC_OBJ=unexsol.o - ;; -esac - -LD_SWITCH_SYSTEM= -case "$opsys" in - freebsd) - ## Let `ld' find image libs and similar things in /usr/local/lib. - ## The system compiler, GCC, has apparently been modified to not - ## look there, contrary to what a stock GCC would do. -### It's not our place to do this. See bug#10313#17. -### LD_SWITCH_SYSTEM=-L/usr/local/lib - : - ;; - - gnu-linux) - ## cpp test was "ifdef __mips__", but presumably this is equivalent... - case $host_cpu in mips*) LD_SWITCH_SYSTEM="-G 0";; esac - ;; - - netbsd) -### It's not our place to do this. See bug#10313#17. -### LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib" - : - ;; - - openbsd) - ## Han Boetes says this is necessary, - ## otherwise Emacs dumps core on elf systems. - LD_SWITCH_SYSTEM="-Z" - ;; -esac - - -ac_link="$ac_link $LD_SWITCH_SYSTEM" - -## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_RPATH, -## which has not been defined yet. When this was handled with cpp, -## it was expanded to null when configure sourced the s/*.h file. -## Thus LD_SWITCH_SYSTEM had different values in configure and the Makefiles. -## FIXME it would be cleaner to put this in LD_SWITCH_SYSTEM_TEMACS -## (or somesuch), but because it is supposed to go at the _front_ -## of LD_SWITCH_SYSTEM, we cannot do that in exactly the same way. -## Compare with the gnu-linux case below, which added to the end -## of LD_SWITCH_SYSTEM, and so can instead go at the front of -## LD_SWITCH_SYSTEM_TEMACS. -case "$opsys" in - netbsd|openbsd) - LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_RPATH) $LD_SWITCH_SYSTEM" ;; -esac - - -C_SWITCH_MACHINE= -case $canonical in - alpha*) - ac_fn_c_check_decl "$LINENO" "__ELF__" "ac_cv_have_decl___ELF__" "$ac_includes_default" -if test "x$ac_cv_have_decl___ELF__" = x""yes; then : - -fi - - if test "$ac_cv_have_decl___ELF__" = "yes"; then - ## With ELF, make sure that all common symbols get allocated to in the - ## data section. Otherwise, the dump of temacs may miss variables in - ## the shared library that have been initialized. For example, with - ## GNU libc, __malloc_initialized would normally be resolved to the - ## shared library's .bss section, which is fatal. - if test "x$GCC" = "xyes"; then - C_SWITCH_MACHINE="-fno-common" - else - as_fn_error "What gives? Fix me if DEC Unix supports ELF now." "$LINENO" 5 - fi - else - UNEXEC_OBJ=unexalpha.o - fi - ;; -esac - - - - -C_SWITCH_SYSTEM= -## Some programs in src produce warnings saying certain subprograms -## are too complex and need a MAXMEM value greater than 2000 for -## additional optimization. --nils@exp-math.uni-essen.de -test "$opsys" = "aix4.2" && test "x$GCC" != "xyes" && \ - C_SWITCH_SYSTEM="-ma -qmaxmem=4000" -## gnu-linux might need -D_BSD_SOURCE on old libc5 systems. -## It is redundant in glibc2, since we define _GNU_SOURCE. - - - -LIBS_SYSTEM= -case "$opsys" in - ## IBM's X11R5 uses -lIM and -liconv in AIX 3.2.2. - aix4-2) LIBS_SYSTEM="-lrts -lIM -liconv" ;; - - freebsd) LIBS_SYSTEM="-lutil" ;; - - hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; - - sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; - - ## Motif needs -lgen. - unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; -esac - - - -### Make sure subsequent tests use flags consistent with the build flags. - -if test x"${OVERRIDE_CPPFLAGS}" != x; then - CPPFLAGS="${OVERRIDE_CPPFLAGS}" -else - CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS" -fi - -# Suppress obsolescent Autoconf test for size_t; Emacs assumes C89 or better. - -# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. - - - -LIB_MATH=-lm -SYSTEM_TYPE=`echo $opsys | sed -e 's/[0-9].*//' -e 's|-|/|'` - -case $opsys in - cygwin ) - LIB_MATH= - ;; - darwin ) - ## Adding -lm confuses the dynamic linker, so omit it. - LIB_MATH= - ;; - freebsd ) - SYSTEM_TYPE=berkeley-unix - ;; - gnu-linux | gnu-kfreebsd ) - ;; - hpux10-20 | hpux11 ) - ;; - netbsd | openbsd ) - SYSTEM_TYPE=berkeley-unix - ;; - - sol2* | unixware ) - SYSTEM_TYPE=usg-unix-v - ;; - -esac - - - -cat >>confdefs.h <<_ACEOF -#define SYSTEM_TYPE "$SYSTEM_TYPE" -_ACEOF - - - -pre_PKG_CONFIG_CFLAGS=$CFLAGS -pre_PKG_CONFIG_LIBS=$LIBS - -# Extract the first word of "pkg-config", so it can be a program name with args. -set dummy pkg-config; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $PKG_CONFIG in - [\\/]* | ?:[\\/]*) - ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" - ;; -esac -fi -PKG_CONFIG=$ac_cv_path_PKG_CONFIG -if test -n "$PKG_CONFIG"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 -$as_echo "$PKG_CONFIG" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - - - - -if test "${with_sound}" != "no"; then - # Sound support for GNU/Linux and the free BSDs. - for ac_header in machine/soundcard.h sys/soundcard.h soundcard.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" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - have_sound_header=yes -fi - -done - - # Emulation library used on NetBSD. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _oss_ioctl in -lossaudio" >&5 -$as_echo_n "checking for _oss_ioctl in -lossaudio... " >&6; } -if test "${ac_cv_lib_ossaudio__oss_ioctl+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lossaudio $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 _oss_ioctl (); -int -main () -{ -return _oss_ioctl (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ossaudio__oss_ioctl=yes -else - ac_cv_lib_ossaudio__oss_ioctl=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_ossaudio__oss_ioctl" >&5 -$as_echo "$ac_cv_lib_ossaudio__oss_ioctl" >&6; } -if test "x$ac_cv_lib_ossaudio__oss_ioctl" = x""yes; then : - LIBSOUND=-lossaudio -else - LIBSOUND= -fi - - - - ALSA_REQUIRED=1.0.0 - ALSA_MODULES="alsa >= $ALSA_REQUIRED" - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_ALSA=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ALSA_MODULES" >&5 -$as_echo_n "checking for $ALSA_MODULES... " >&6; } - - if "$PKG_CONFIG" --exists "$ALSA_MODULES" 2>&5 && - ALSA_CFLAGS=`"$PKG_CONFIG" --cflags "$ALSA_MODULES" 2>&5` && - ALSA_LIBS=`"$PKG_CONFIG" --libs "$ALSA_MODULES" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - ALSA_CFLAGS=`$as_echo "$ALSA_CFLAGS" | sed -e "$edit_cflags"` - ALSA_LIBS=`$as_echo "$ALSA_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&5 -$as_echo "yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - ALSA_CFLAGS="" - ALSA_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - ALSA_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "$ALSA_MODULES") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_ALSA=yes - else - HAVE_ALSA=no - fi - - if test $HAVE_ALSA = yes; then - SAVE_CFLAGS="$CFLAGS" - SAVE_LIBS="$LIBS" - CFLAGS="$ALSA_CFLAGS $CFLAGS" - LIBS="$ALSA_LIBS $LIBS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -snd_lib_error_set_handler (0); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_alsa_normal=yes -else - emacs_alsa_normal=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test "$emacs_alsa_normal" != yes; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -snd_lib_error_set_handler (0); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_alsa_subdir=yes -else - emacs_alsa_subdir=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test "$emacs_alsa_subdir" != yes; then - as_fn_error "pkg-config found alsa, but it does not compile. See config.log for error messages." "$LINENO" 5 - fi - ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE" - fi - - CFLAGS="$SAVE_CFLAGS" - LIBS="$SAVE_LIBS" - LIBSOUND="$LIBSOUND $ALSA_LIBS" - CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS" - -$as_echo "#define HAVE_ALSA 1" >>confdefs.h - - fi - - if test x$have_sound_header = xyes || test $HAVE_ALSA = yes; then - case "$opsys" in - gnu-linux|freebsd|netbsd) - -$as_echo "#define HAVE_SOUND 1" >>confdefs.h - - ;; - esac - fi - - -fi - - - - - for ac_header in $ac_header_list -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default -" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - - - - - - - - - - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if personality LINUX32 can be set" >&5 -$as_echo_n "checking if personality LINUX32 can be set... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -personality (PER_LINUX32) - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_personality_linux32=yes -else - emacs_cv_personality_linux32=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_personality_linux32" >&5 -$as_echo "$emacs_cv_personality_linux32" >&6; } - -if test $emacs_cv_personality_linux32 = yes; then - -$as_echo "#define HAVE_PERSONALITY_LINUX32 1" >>confdefs.h - -fi - -for ac_header in term.h -do : - ac_fn_c_check_header_preproc "$LINENO" "term.h" "ac_cv_header_term_h" -if test "x$ac_cv_header_term_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_TERM_H 1 -_ACEOF - -fi - -done - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 -$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } -if test "${ac_cv_header_time+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include - -int -main () -{ -if ((struct tm *) 0) -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_time=yes -else - ac_cv_header_time=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5 -$as_echo "$ac_cv_header_time" >&6; } -if test $ac_cv_header_time = yes; then - -$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h - -fi - -ac_fn_c_check_decl "$LINENO" "sys_siglist" "ac_cv_have_decl_sys_siglist" "#include - -" -if test "x$ac_cv_have_decl_sys_siglist" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_SYS_SIGLIST $ac_have_decl -_ACEOF - -if test $ac_cv_have_decl_sys_siglist != yes; then - # For Tru64, at least: - ac_fn_c_check_decl "$LINENO" "__sys_siglist" "ac_cv_have_decl___sys_siglist" "#include - -" -if test "x$ac_cv_have_decl___sys_siglist" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL___SYS_SIGLIST $ac_have_decl -_ACEOF - - if test $ac_cv_have_decl___sys_siglist = yes; then - -$as_echo "#define sys_siglist __sys_siglist" >>confdefs.h - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5 -$as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; } -if test "${ac_cv_header_sys_wait_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#ifndef WEXITSTATUS -# define WEXITSTATUS(stat_val) ((unsigned int) (stat_val) >> 8) -#endif -#ifndef WIFEXITED -# define WIFEXITED(stat_val) (((stat_val) & 255) == 0) -#endif - -int -main () -{ - int s; - wait (&s); - s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_sys_wait_h=yes -else - ac_cv_header_sys_wait_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_sys_wait_h" >&5 -$as_echo "$ac_cv_header_sys_wait_h" >&6; } -if test $ac_cv_header_sys_wait_h = yes; then - -$as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h - -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5 -$as_echo_n "checking for speed_t... " >&6; } -if test "${emacs_cv_speed_t+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -speed_t x = 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_speed_t=yes -else - emacs_cv_speed_t=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_speed_t" >&5 -$as_echo "$emacs_cv_speed_t" >&6; } -if test $emacs_cv_speed_t = yes; then - -$as_echo "#define HAVE_SPEED_T 1" >>confdefs.h - -fi - - - - -for ac_header in net/if.h -do : - ac_fn_c_check_header_compile "$LINENO" "net/if.h" "ac_cv_header_net_if_h" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -" -if test "x$ac_cv_header_net_if_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NET_IF_H 1 -_ACEOF - -fi - -done - -for ac_header in ifaddrs.h -do : - ac_fn_c_check_header_compile "$LINENO" "ifaddrs.h" "ac_cv_header_ifaddrs_h" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -" -if test "x$ac_cv_header_ifaddrs_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_IFADDRS_H 1 -_ACEOF - -fi - -done - -for ac_header in net/if_dl.h -do : - ac_fn_c_check_header_compile "$LINENO" "net/if_dl.h" "ac_cv_header_net_if_dl_h" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -" -if test "x$ac_cv_header_net_if_dl_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NET_IF_DL_H 1 -_ACEOF - -fi - -done - - -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_flags" "ac_cv_member_struct_ifreq_ifr_flags" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_flags" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_FLAGS 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_hwaddr" "ac_cv_member_struct_ifreq_ifr_hwaddr" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_HWADDR 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_netmask" "ac_cv_member_struct_ifreq_ifr_netmask" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_NETMASK 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_broadaddr" "ac_cv_member_struct_ifreq_ifr_broadaddr" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_BROADADDR 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_addr" "ac_cv_member_struct_ifreq_ifr_addr" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_addr" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_ADDR 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_addr.sa_len" "ac_cv_member_struct_ifreq_ifr_addr_sa_len" "$ac_includes_default -#if HAVE_SYS_SOCKET_H -#include -#endif -#if HAVE_NET_IF_H -#include -#endif -" -if test "x$ac_cv_member_struct_ifreq_ifr_addr_sa_len" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN 1 -_ACEOF - - -fi - - - - -DEPFLAGS= -MKDEPDIR=":" -deps_frag=deps.mk -if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using GNU Make" >&5 -$as_echo_n "checking whether we are using GNU Make... " >&6; } - HAVE_GNU_MAKE=no - testval=`${MAKE-make} --version 2>/dev/null | grep 'GNU Make'` - if test "x$testval" != x; then - HAVE_GNU_MAKE=yes - else - ac_enable_autodepend=no - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_GNU_MAKE" >&5 -$as_echo "$HAVE_GNU_MAKE" >&6; } - if test $HAVE_GNU_MAKE = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -MMD -MF" >&5 -$as_echo_n "checking whether gcc understands -MMD -MF... " >&6; } - SAVE_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -MMD -MF deps.d -MP" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - ac_enable_autodepend=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$SAVE_CFLAGS" - test -f deps.d || ac_enable_autodepend=no - rm -rf deps.d - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_enable_autodepend" >&5 -$as_echo "$ac_enable_autodepend" >&6; } - fi - if test $ac_enable_autodepend = yes; then - DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP' - ## MKDIR_P is documented (see AC_PROG_MKDIR_P) to be parallel-safe. - MKDEPDIR='${MKDIR_P} ${DEPDIR}' - deps_frag=autodeps.mk - fi -fi -deps_frag=$srcdir/src/$deps_frag - - - - - -lisp_frag=$srcdir/src/lisp.mk - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5 -$as_echo_n "checking for long file names... " >&6; } -if test "${ac_cv_sys_long_file_names+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_sys_long_file_names=yes -# Test for long file names in all the places we know might matter: -# . the current directory, where building will happen -# $prefix/lib where we will be installing things -# $exec_prefix/lib likewise -# $TMPDIR if set, where it might want to write temporary files -# /tmp where it might want to write temporary files -# /var/tmp likewise -# /usr/tmp likewise -for ac_dir in . "$TMPDIR" /tmp /var/tmp /usr/tmp "$prefix/lib" "$exec_prefix/lib"; do - # Skip $TMPDIR if it is empty or bogus, and skip $exec_prefix/lib - # in the usual case where exec_prefix is '${prefix}'. - case $ac_dir in #( - . | /* | ?:[\\/]*) ;; #( - *) continue;; - esac - test -w "$ac_dir/." || continue # It is less confusing to not echo anything here. - ac_xdir=$ac_dir/cf$$ - (umask 077 && mkdir "$ac_xdir" 2>/dev/null) || continue - ac_tf1=$ac_xdir/conftest9012345 - ac_tf2=$ac_xdir/conftest9012346 - touch "$ac_tf1" 2>/dev/null && test -f "$ac_tf1" && test ! -f "$ac_tf2" || - ac_cv_sys_long_file_names=no - rm -f -r "$ac_xdir" 2>/dev/null - test $ac_cv_sys_long_file_names = no && break -done -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_long_file_names" >&5 -$as_echo "$ac_cv_sys_long_file_names" >&6; } -if test $ac_cv_sys_long_file_names = yes; then - -$as_echo "#define HAVE_LONG_FILE_NAMES 1" >>confdefs.h - -fi - - -#### Choose a window system. - -## We leave window_system equal to none if -## we end up building without one. Any new window system should -## set window_system to an appropriate value and add objects to -## window-system-specific substs. - -window_system=none -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 -$as_echo_n "checking for X... " >&6; } - - -# Check whether --with-x was given. -if test "${with_x+set}" = set; then : - withval=$with_x; -fi - -# $have_x is `yes', `no', `disabled', or empty when we do not yet know. -if test "x$with_x" = xno; then - # The user explicitly disabled X. - have_x=disabled -else - case $x_includes,$x_libraries in #( - *\'*) as_fn_error "cannot use X directory names containing '" "$LINENO" 5;; #( - *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # One or both of the vars are not set, and there is no cached value. -ac_x_includes=no ac_x_libraries=no -rm -f -r conftest.dir -if mkdir conftest.dir; then - cd conftest.dir - cat >Imakefile <<'_ACEOF' -incroot: - @echo incroot='${INCROOT}' -usrlibdir: - @echo usrlibdir='${USRLIBDIR}' -libdir: - @echo libdir='${LIBDIR}' -_ACEOF - if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. - for ac_var in incroot usrlibdir libdir; do - eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" - done - # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. - for ac_extension in a so sl dylib la dll; do - if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && - test -f "$ac_im_libdir/libX11.$ac_extension"; then - ac_im_usrlibdir=$ac_im_libdir; break - fi - done - # Screen out bogus values from the imake configuration. They are - # bogus both because they are the default anyway, and because - # using them would break gcc on systems where it needs fixed includes. - case $ac_im_incroot in - /usr/include) ac_x_includes= ;; - *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; - esac - case $ac_im_usrlibdir in - /usr/lib | /usr/lib64 | /lib | /lib64) ;; - *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; - esac - fi - cd .. - rm -f -r conftest.dir -fi - -# Standard set of common directories for X headers. -# Check X11 before X11Rn because it is often a symlink to the current release. -ac_x_header_dirs=' -/usr/X11/include -/usr/X11R7/include -/usr/X11R6/include -/usr/X11R5/include -/usr/X11R4/include - -/usr/include/X11 -/usr/include/X11R7 -/usr/include/X11R6 -/usr/include/X11R5 -/usr/include/X11R4 - -/usr/local/X11/include -/usr/local/X11R7/include -/usr/local/X11R6/include -/usr/local/X11R5/include -/usr/local/X11R4/include - -/usr/local/include/X11 -/usr/local/include/X11R7 -/usr/local/include/X11R6 -/usr/local/include/X11R5 -/usr/local/include/X11R4 - -/usr/X386/include -/usr/x386/include -/usr/XFree86/include/X11 - -/usr/include -/usr/local/include -/usr/unsupported/include -/usr/athena/include -/usr/local/x11r5/include -/usr/lpp/Xamples/include - -/usr/openwin/include -/usr/openwin/share/include' - -if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for Xlib.h. - # First, try using that file with no special directory specified. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # We can compile using X headers with no special include directory. -ac_x_includes= -else - for ac_dir in $ac_x_header_dirs; do - if test -r "$ac_dir/X11/Xlib.h"; then - ac_x_includes=$ac_dir - break - fi -done -fi -rm -f conftest.err conftest.$ac_ext -fi # $ac_x_includes = no - -if test "$ac_x_libraries" = no; then - # Check for the libraries. - # See if we find them without any special options. - # Don't add to $LIBS permanently. - ac_save_LIBS=$LIBS - LIBS="-lX11 $LIBS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -XrmInitialize () - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - LIBS=$ac_save_LIBS -# We can link X programs with no special library path. -ac_x_libraries= -else - LIBS=$ac_save_LIBS -for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` -do - # Don't even attempt the hair of trying to link an X program! - for ac_extension in a so sl dylib la dll; do - if test -r "$ac_dir/libX11.$ac_extension"; then - ac_x_libraries=$ac_dir - break 2 - fi - done -done -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi # $ac_x_libraries = no - -case $ac_x_includes,$ac_x_libraries in #( - no,* | *,no | *\'*) - # Didn't find X, or a directory has "'" in its name. - ac_cv_have_x="have_x=no";; #( - *) - # Record where we found X for the cache. - ac_cv_have_x="have_x=yes\ - ac_x_includes='$ac_x_includes'\ - ac_x_libraries='$ac_x_libraries'" -esac -fi -;; #( - *) have_x=yes;; - esac - eval "$ac_cv_have_x" -fi # $with_x != no - -if test "$have_x" != yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5 -$as_echo "$have_x" >&6; } - no_x=yes -else - # If each of the values was on the command line, it overrides each guess. - test "x$x_includes" = xNONE && x_includes=$ac_x_includes - test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries - # Update the cache value to reflect the command line values. - ac_cv_have_x="have_x=yes\ - ac_x_includes='$x_includes'\ - ac_x_libraries='$x_libraries'" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5 -$as_echo "libraries $x_libraries, headers $x_includes" >&6; } -fi - -if test "$no_x" != yes; then - window_system=x11 -fi - -LD_SWITCH_X_SITE_RPATH= -if test "${x_libraries}" != NONE; then - if test -n "${x_libraries}"; then - LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"` - LD_SWITCH_X_SITE_RPATH=-Wl,-rpath,`echo ${x_libraries} | sed -e "s/:/ -Wl,-rpath,/g"` - fi - x_default_search_path="" - x_search_path=${x_libraries} - if test -z "${x_search_path}"; then - x_search_path=/usr/lib - fi - for x_library in `echo ${x_search_path}: | \ - sed -e "s/:/ /g" -e p -e "s:/lib[^ /]* :/share :g"`; do - x_search_path="\ -${x_library}/X11/%L/%T/%N%C%S:\ -${x_library}/X11/%l/%T/%N%C%S:\ -${x_library}/X11/%T/%N%C%S:\ -${x_library}/X11/%L/%T/%N%S:\ -${x_library}/X11/%l/%T/%N%S:\ -${x_library}/X11/%T/%N%S" - if test x"${x_default_search_path}" = x; then - x_default_search_path=${x_search_path} - else - x_default_search_path="${x_search_path}:${x_default_search_path}" - fi - done -fi - - -if test "${x_includes}" != NONE && test -n "${x_includes}"; then - C_SWITCH_X_SITE="$isystem"`echo ${x_includes} | sed -e "s/:/ $isystem/g"` -fi - -if test x"${x_includes}" = x; then - bitmapdir=/usr/include/X11/bitmaps -else - # accumulate include directories that have X11 bitmap subdirectories - bmd_acc="dummyval" - for bmd in `echo ${x_includes} | sed -e "s/:/ /g"`; do - if test -d "${bmd}/X11/bitmaps"; then - bmd_acc="${bmd_acc}:${bmd}/X11/bitmaps" - fi - if test -d "${bmd}/bitmaps"; then - bmd_acc="${bmd_acc}:${bmd}/bitmaps" - fi - done - if test ${bmd_acc} != "dummyval"; then - bitmapdir=`echo ${bmd_acc} | sed -e "s/^dummyval://"` - fi -fi - -HAVE_NS=no -NS_IMPL_COCOA=no -NS_IMPL_GNUSTEP=no -tmp_CPPFLAGS="$CPPFLAGS" -tmp_CFLAGS="$CFLAGS" -CPPFLAGS="$CPPFLAGS -x objective-c" -CFLAGS="$CFLAGS -x objective-c" -GNU_OBJC_CFLAGS= -LIBS_GNUSTEP= -if test "${with_ns}" != no; then - if test "${opsys}" = darwin; then - NS_IMPL_COCOA=yes - ns_appdir=`pwd`/nextstep/Emacs.app - ns_appbindir=${ns_appdir}/Contents/MacOS - ns_appresdir=${ns_appdir}/Contents/Resources - ns_appsrc=Cocoa/Emacs.base - elif test -f $GNUSTEP_CONFIG_FILE; then - NS_IMPL_GNUSTEP=yes - ns_appdir=`pwd`/nextstep/Emacs.app - ns_appbindir=${ns_appdir} - ns_appresdir=${ns_appdir}/Resources - ns_appsrc=GNUstep/Emacs.base - GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)" - GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)" - GNUSTEP_LOCAL_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_HEADERS)" - GNUSTEP_LOCAL_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_LIBRARIES)" - test "x${GNUSTEP_LOCAL_HEADERS}" != "x" && \ - GNUSTEP_LOCAL_HEADERS="-I${GNUSTEP_LOCAL_HEADERS}" - test "x${GNUSTEP_LOCAL_LIBRARIES}" != "x" && \ - GNUSTEP_LOCAL_LIBRARIES="-L${GNUSTEP_LOCAL_LIBRARIES}" - CPPFLAGS="$CPPFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}" - CFLAGS="$CFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}" - LDFLAGS="$LDFLAGS -L${GNUSTEP_SYSTEM_LIBRARIES} ${GNUSTEP_LOCAL_LIBRARIES}" - LIBS_GNUSTEP="-lgnustep-gui -lgnustep-base -lobjc -lpthread" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS" >&5 -$as_echo_n "checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS... " >&6; } -if test "${emacs_cv_objc_exceptions+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -#if defined BASE_NATIVE_OBJC_EXCEPTIONS && BASE_NATIVE_OBJC_EXCEPTIONS > 0 -1; -#else -fail; -#endif - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_objc_exceptions=yes -else - emacs_cv_objc_exceptions=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_objc_exceptions" >&5 -$as_echo "$emacs_cv_objc_exceptions" >&6; } - if test $emacs_cv_objc_exceptions = yes; then - -$as_echo "#define _NATIVE_OBJC_EXCEPTIONS 1" >>confdefs.h - - GNU_OBJC_CFLAGS="-fobjc-exceptions" - fi - fi - - CFLAGS="$CFLAGS $GNU_OBJC_CFLAGS" - - ac_fn_c_check_header_mongrel "$LINENO" "AppKit/AppKit.h" "ac_cv_header_AppKit_AppKit_h" "$ac_includes_default" -if test "x$ac_cv_header_AppKit_AppKit_h" = x""yes; then : - HAVE_NS=yes -else - as_fn_error "\`--with-ns' was specified, but the include - files are missing or cannot be compiled." "$LINENO" 5 -fi - - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - -#ifdef MAC_OS_X_VERSION_MAX_ALLOWED -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1040 - ; /* OK */ -#else -#error "OSX 10.4 or newer required" -#endif -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ns_osx_have_104=yes -else - ns_osx_have_104=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -NSInteger i; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ns_have_nsinteger=yes -else - ns_have_nsinteger=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $ns_osx_have_104 = no; then - as_fn_error "\`OSX 10.4 or newer is required'" "$LINENO" 5; - fi - if test $ns_have_nsinteger = yes; then - -$as_echo "#define NS_HAVE_NSINTEGER 1" >>confdefs.h - - fi -fi - - - -INSTALL_ARCH_INDEP_EXTRA=install-etc -ns_self_contained=no -NS_OBJ= -NS_OBJC_OBJ= -if test "${HAVE_NS}" = yes; then - if test "$with_toolkit_scroll_bars" = "no"; then - as_fn_error "Non-toolkit scroll bars are not implemented for Nextstep." "$LINENO" 5 - fi - - window_system=nextstep - # set up packaging dirs - if test "${EN_NS_SELF_CONTAINED}" = yes; then - ns_self_contained=yes - prefix=${ns_appresdir} - exec_prefix=${ns_appbindir} - libexecdir="\${ns_appbindir}/libexec" - archlibdir="\${ns_appbindir}/libexec" - docdir="\${ns_appresdir}/etc" - etcdir="\${ns_appresdir}/etc" - infodir="\${ns_appresdir}/info" - mandir="\${ns_appresdir}/man" - lispdir="\${ns_appresdir}/lisp" - leimdir="\${ns_appresdir}/leim" - INSTALL_ARCH_INDEP_EXTRA= - fi - NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o" -fi -CFLAGS="$tmp_CFLAGS" -CPPFLAGS="$tmp_CPPFLAGS" - - - - - -HAVE_W32=no -W32_OBJ= -W32_LIBS= -W32_RES= -W32_RES_LINK= -if test "${with_w32}" != no; then - if test "${opsys}" != "cygwin"; then - as_fn_error "Using w32 with an autotools build is only supported for Cygwin." "$LINENO" 5 - fi - ac_fn_c_check_header_mongrel "$LINENO" "windows.h" "ac_cv_header_windows_h" "$ac_includes_default" -if test "x$ac_cv_header_windows_h" = x""yes; then : - HAVE_W32=yes -else - as_fn_error "\`--with-w32' was specified, but windows.h - cannot be found." "$LINENO" 5 -fi - - - -$as_echo "#define HAVE_NTGUI 1" >>confdefs.h - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. -set dummy ${ac_tool_prefix}windres; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_WINDRES+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$WINDRES"; then - ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_WINDRES="${ac_tool_prefix}windres" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -WINDRES=$ac_cv_prog_WINDRES -if test -n "$WINDRES"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINDRES" >&5 -$as_echo "$WINDRES" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_WINDRES"; then - ac_ct_WINDRES=$WINDRES - # Extract the first word of "windres", so it can be a program name with args. -set dummy windres; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_WINDRES+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_WINDRES"; then - ac_cv_prog_ac_ct_WINDRES="$ac_ct_WINDRES" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_ac_ct_WINDRES="windres" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_WINDRES=$ac_cv_prog_ac_ct_WINDRES -if test -n "$ac_ct_WINDRES"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_WINDRES" >&5 -$as_echo "$ac_ct_WINDRES" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_WINDRES" = x; then - WINDRES="as_fn_error "No resource compiler found." "$LINENO" 5" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - WINDRES=$ac_ct_WINDRES - fi -else - WINDRES="$ac_cv_prog_WINDRES" -fi - - W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o" - W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o" - W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" - W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool" - W32_RES="emacs.res" - # Tell the linker that emacs.res is an object (which we compile from - # the rc file), not a linker script. - W32_RES_LINK="-Wl,-bpe-i386 -Wl,emacs.res" -fi - - - - - -if test "${HAVE_W32}" = "yes"; then - window_system=w32 - with_xft=no -fi - -## $window_system is now set to the window system we will -## ultimately use. - -term_header= -HAVE_X_WINDOWS=no -HAVE_X11=no -USE_X_TOOLKIT=none - -case "${window_system}" in - x11 ) - HAVE_X_WINDOWS=yes - HAVE_X11=yes - term_header=xterm.h - case "${with_x_toolkit}" in - athena | lucid ) USE_X_TOOLKIT=LUCID ;; - motif ) USE_X_TOOLKIT=MOTIF ;; - gtk ) with_gtk=yes - term_header=gtkutil.h - USE_X_TOOLKIT=none ;; - gtk2 ) with_gtk2=yes - term_header=gtkutil.h - USE_X_TOOLKIT=none ;; - gtk3 ) with_gtk3=yes - term_header=gtkutil.h - USE_X_TOOLKIT=none ;; - no ) USE_X_TOOLKIT=none ;; - * ) USE_X_TOOLKIT=maybe ;; - esac - ;; - nextstep ) - term_header=nsterm.h - ;; - w32 ) - term_header=w32term.h - ;; -esac - -if test -n "${term_header}"; then - -cat >>confdefs.h <<_ACEOF -#define TERM_HEADER "${term_header}" -_ACEOF - -fi - -if test "$window_system" = none && test "X$with_x" != "Xno"; then - # Extract the first word of "X", so it can be a program name with args. -set dummy X; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$HAVE_XSERVER"; then - ac_cv_prog_HAVE_XSERVER="$HAVE_XSERVER" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_HAVE_XSERVER="true" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_prog_HAVE_XSERVER" && ac_cv_prog_HAVE_XSERVER="false" -fi -fi -HAVE_XSERVER=$ac_cv_prog_HAVE_XSERVER -if test -n "$HAVE_XSERVER"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_XSERVER" >&5 -$as_echo "$HAVE_XSERVER" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test "$HAVE_XSERVER" = true || - test -n "$DISPLAY" || - test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then - as_fn_error "You seem to be running X, but no X development libraries -were found. You should install the relevant development files for X -and for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make -sure you have development files for image handling, i.e. -tiff, gif, jpeg, png and xpm. -If you are sure you want Emacs compiled without X window support, pass - --without-x -to configure." "$LINENO" 5 - fi -fi - -### If we're using X11, we should use the X menu package. -HAVE_MENUS=no -case ${HAVE_X11} in - yes ) HAVE_MENUS=yes ;; -esac - -# Does the opsystem file prohibit the use of the GNU malloc? -# Assume not, until told otherwise. -GNU_MALLOC=yes - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether malloc is Doug Lea style" >&5 -$as_echo_n "checking whether malloc is Doug Lea style... " >&6; } -if test "${emacs_cv_var_doug_lea_malloc+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - static void hook (void) {} -int -main () -{ -malloc_set_state (malloc_get_state ()); - __after_morecore_hook = hook; - __malloc_initialize_hook = hook; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_var_doug_lea_malloc=yes -else - emacs_cv_var_doug_lea_malloc=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_var_doug_lea_malloc" >&5 -$as_echo "$emacs_cv_var_doug_lea_malloc" >&6; } -doug_lea_malloc=$emacs_cv_var_doug_lea_malloc - - -system_malloc=no -case "$opsys" in - ## darwin ld insists on the use of malloc routines in the System framework. - darwin|sol2-10) system_malloc=yes ;; -esac - -if test "${system_malloc}" = "yes"; then - -$as_echo "#define SYSTEM_MALLOC 1" >>confdefs.h - - GNU_MALLOC=no - GNU_MALLOC_reason=" - (The GNU allocators don't work with this system configuration.)" - GMALLOC_OBJ= - VMLIMIT_OBJ= -else - test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o - VMLIMIT_OBJ=vm-limit.o - - for ac_header in sys/vlimit.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/vlimit.h" "ac_cv_header_sys_vlimit_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_vlimit_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_VLIMIT_H 1 -_ACEOF - -fi - -done - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for data_start" >&5 -$as_echo_n "checking for data_start... " >&6; } -if test "${emacs_cv_data_start+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -extern char data_start[]; char ch; -int -main () -{ -return data_start < &ch; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_data_start=yes -else - emacs_cv_data_start=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_data_start" >&5 -$as_echo "$emacs_cv_data_start" >&6; } - if test $emacs_cv_data_start = yes; then - -$as_echo "#define HAVE_DATA_START 1" >>confdefs.h - - fi -fi - - - -if test "$doug_lea_malloc" = "yes" ; then - if test "$GNU_MALLOC" = yes ; then - GNU_MALLOC_reason=" - (Using Doug Lea's new malloc from the GNU C Library.)" - fi - -$as_echo "#define DOUG_LEA_MALLOC 1" >>confdefs.h - - - ## Use mmap directly for allocating larger buffers. - ## FIXME this comes from src/s/{gnu,gnu-linux}.h: - ## #ifdef DOUG_LEA_MALLOC; #undef REL_ALLOC; #endif - ## Does the AC_FUNC_MMAP test below make this check unnecessary? - case "$opsys" in - gnu*) REL_ALLOC=no ;; - esac -fi - -if test x"${REL_ALLOC}" = x; then - REL_ALLOC=${GNU_MALLOC} -fi - -use_mmap_for_buffers=no -case "$opsys" in - cygwin|freebsd|irix6-5) use_mmap_for_buffers=yes ;; -esac - - - - - - - - -for ac_func in getpagesize -do : - ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" -if test "x$ac_cv_func_getpagesize" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETPAGESIZE 1 -_ACEOF - -fi -done - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 -$as_echo_n "checking for working mmap... " >&6; } -if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_func_mmap_fixed_mapped=no -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -/* malloc might have been renamed as rpl_malloc. */ -#undef malloc - -/* Thanks to Mike Haertel and Jim Avera for this test. - Here is a matrix of mmap possibilities: - mmap private not fixed - mmap private fixed at somewhere currently unmapped - mmap private fixed at somewhere already mapped - mmap shared not fixed - mmap shared fixed at somewhere currently unmapped - mmap shared fixed at somewhere already mapped - For private mappings, we should verify that changes cannot be read() - back from the file, nor mmap's back from the file at a different - address. (There have been systems where private was not correctly - implemented like the infamous i386 svr4.0, and systems where the - VM page cache was not coherent with the file system buffer cache - like early versions of FreeBSD and possibly contemporary NetBSD.) - For shared mappings, we should conversely verify that changes get - propagated back to all the places they're supposed to be. - - Grep wants private fixed already mapped. - The main things grep needs to know about mmap are: - * does it exist and is it safe to write into the mmap'd area - * how to use it (BSD variants) */ - -#include -#include - -#if !defined STDC_HEADERS && !defined HAVE_STDLIB_H -char *malloc (); -#endif - -/* This mess was copied from the GNU getpagesize.h. */ -#ifndef HAVE_GETPAGESIZE -# ifdef _SC_PAGESIZE -# define getpagesize() sysconf(_SC_PAGESIZE) -# else /* no _SC_PAGESIZE */ -# ifdef HAVE_SYS_PARAM_H -# include -# ifdef EXEC_PAGESIZE -# define getpagesize() EXEC_PAGESIZE -# else /* no EXEC_PAGESIZE */ -# ifdef NBPG -# define getpagesize() NBPG * CLSIZE -# ifndef CLSIZE -# define CLSIZE 1 -# endif /* no CLSIZE */ -# else /* no NBPG */ -# ifdef NBPC -# define getpagesize() NBPC -# else /* no NBPC */ -# ifdef PAGESIZE -# define getpagesize() PAGESIZE -# endif /* PAGESIZE */ -# endif /* no NBPC */ -# endif /* no NBPG */ -# endif /* no EXEC_PAGESIZE */ -# else /* no HAVE_SYS_PARAM_H */ -# define getpagesize() 8192 /* punt totally */ -# endif /* no HAVE_SYS_PARAM_H */ -# endif /* no _SC_PAGESIZE */ - -#endif /* no HAVE_GETPAGESIZE */ - -int -main () -{ - char *data, *data2, *data3; - const char *cdata2; - int i, pagesize; - int fd, fd2; - - pagesize = getpagesize (); - - /* First, make a file with some known garbage in it. */ - data = (char *) malloc (pagesize); - if (!data) - return 1; - for (i = 0; i < pagesize; ++i) - *(data + i) = rand (); - umask (0); - fd = creat ("conftest.mmap", 0600); - if (fd < 0) - return 2; - if (write (fd, data, pagesize) != pagesize) - return 3; - close (fd); - - /* Next, check that the tail of a page is zero-filled. File must have - non-zero length, otherwise we risk SIGBUS for entire page. */ - fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600); - if (fd2 < 0) - return 4; - cdata2 = ""; - if (write (fd2, cdata2, 1) != 1) - return 5; - data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L); - if (data2 == MAP_FAILED) - return 6; - for (i = 0; i < pagesize; ++i) - if (*(data2 + i)) - return 7; - close (fd2); - if (munmap (data2, pagesize)) - return 8; - - /* Next, try to mmap the file at a fixed address which already has - something else allocated at it. If we can, also make sure that - we see the same garbage. */ - fd = open ("conftest.mmap", O_RDWR); - if (fd < 0) - return 9; - if (data2 != mmap (data2, pagesize, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_FIXED, fd, 0L)) - return 10; - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data2 + i)) - return 11; - - /* Finally, make sure that changes to the mapped area do not - percolate back to the file as seen by read(). (This is a bug on - some variants of i386 svr4.0.) */ - for (i = 0; i < pagesize; ++i) - *(data2 + i) = *(data2 + i) + 1; - data3 = (char *) malloc (pagesize); - if (!data3) - return 12; - if (read (fd, data3, pagesize) != pagesize) - return 13; - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data3 + i)) - return 14; - close (fd); - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_mmap_fixed_mapped=yes -else - ac_cv_func_mmap_fixed_mapped=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_mmap_fixed_mapped" >&5 -$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; } -if test $ac_cv_func_mmap_fixed_mapped = yes; then - -$as_echo "#define HAVE_MMAP 1" >>confdefs.h - -fi -rm -f conftest.mmap conftest.txt - -if test $use_mmap_for_buffers = yes; then - -$as_echo "#define USE_MMAP_FOR_BUFFERS 1" >>confdefs.h - - REL_ALLOC=no -fi - -LIBS="$LIBS_SYSTEM $LIBS" - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5 -$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; } -if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldnet $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 dnet_ntoa (); -int -main () -{ -return dnet_ntoa (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dnet_dnet_ntoa=yes -else - ac_cv_lib_dnet_dnet_ntoa=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_dnet_dnet_ntoa" >&5 -$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; } -if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBDNET 1 -_ACEOF - - LIBS="-ldnet $LIBS" - -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5 -$as_echo_n "checking for main in -lXbsd... " >&6; } -if test "${ac_cv_lib_Xbsd_main+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXbsd $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - -int -main () -{ -return main (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xbsd_main=yes -else - ac_cv_lib_Xbsd_main=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_Xbsd_main" >&5 -$as_echo "$ac_cv_lib_Xbsd_main" >&6; } -if test "x$ac_cv_lib_Xbsd_main" = x""yes; then : - LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd" -fi - - -LIB_PTHREAD= - - - -if test "$ac_cv_header_pthread_h"; then - if test "$GMALLOC_OBJ" = gmalloc.o; then - emacs_pthread_function=pthread_atfork - else - emacs_pthread_function=pthread_self - fi - as_ac_Lib=`$as_echo "ac_cv_lib_pthread_$emacs_pthread_function" | $as_tr_sh` -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $emacs_pthread_function in -lpthread" >&5 -$as_echo_n "checking for $emacs_pthread_function in -lpthread... " >&6; } -if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthread $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 $emacs_pthread_function (); -int -main () -{ -return $emacs_pthread_function (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$as_ac_Lib=yes" -else - eval "$as_ac_Lib=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -eval ac_res=\$$as_ac_Lib - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -eval as_val=\$$as_ac_Lib - if test "x$as_val" = x""yes; then : - HAVE_PTHREAD=yes -fi - -fi -if test "$HAVE_PTHREAD" = yes; then - case "${canonical}" in - *-hpux*) ;; - *) LIB_PTHREAD="-lpthread" - LIBS="$LIB_PTHREAD $LIBS" ;; - esac - -$as_echo "#define HAVE_PTHREAD 1" >>confdefs.h - -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cma_open in -lpthreads" >&5 -$as_echo_n "checking for cma_open in -lpthreads... " >&6; } -if test "${ac_cv_lib_pthreads_cma_open+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpthreads $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 cma_open (); -int -main () -{ -return cma_open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_pthreads_cma_open=yes -else - ac_cv_lib_pthreads_cma_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_pthreads_cma_open" >&5 -$as_echo "$ac_cv_lib_pthreads_cma_open" >&6; } -if test "x$ac_cv_lib_pthreads_cma_open" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBPTHREADS 1 -_ACEOF - - LIBS="-lpthreads $LIBS" - -fi - - -## Note: when using cpp in s/aix4.2.h, this definition depended on -## HAVE_LIBPTHREADS. That was not defined earlier in configure when -## the system file was sourced. Hence the value of LIBS_SYSTEM -## added to LIBS in configure would never contain the pthreads part, -## but the value used in Makefiles might. FIXME? -## -## -lpthreads seems to be necessary for Xlib in X11R6, and should -## be harmless on older versions of X where it happens to exist. -test "$opsys" = "aix4-2" && \ - test $ac_cv_lib_pthreads_cma_open = yes && \ - LIBS_SYSTEM="$LIBS_SYSTEM -lpthreads" - - -case ${host_os} in -aix*) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5 -$as_echo_n "checking for -bbigtoc option... " >&6; } -if test "${gdb_cv_bigtoc+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - case $GCC in - yes) gdb_cv_bigtoc=-Wl,-bbigtoc ;; - *) gdb_cv_bigtoc=-bbigtoc ;; - esac - - LDFLAGS=$LDFLAGS\ $gdb_cv_bigtoc - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -int i; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - -else - gdb_cv_bigtoc= -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gdb_cv_bigtoc" >&5 -$as_echo "$gdb_cv_bigtoc" >&6; } - ;; -esac - -# Change CFLAGS and CPPFLAGS temporarily so that C_SWITCH_X_SITE gets -# used for the tests that follow. We set them back to REAL_CFLAGS and -# REAL_CPPFLAGS later on. - -REAL_CFLAGS="$CFLAGS" -REAL_CPPFLAGS="$CPPFLAGS" - -if test "${HAVE_X11}" = "yes"; then - DEFS="$C_SWITCH_X_SITE $DEFS" - LDFLAGS="$LDFLAGS $LD_SWITCH_X_SITE" - LIBS="-lX11 $LIBS" - CFLAGS="$C_SWITCH_X_SITE $CFLAGS" - CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS" - - # On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests. - # This is handled by LD_SWITCH_X_SITE_RPATH during the real build, - # but it's more convenient here to set LD_RUN_PATH since this - # also works on hosts that don't understand LD_SWITCH_X_SITE_RPATH. - if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then - LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH - export LD_RUN_PATH - fi - - if test "${opsys}" = "gnu-linux"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether X on GNU/Linux needs -b to link" >&5 -$as_echo_n "checking whether X on GNU/Linux needs -b to link... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -XOpenDisplay ("foo"); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - xgnu_linux_first_failure=no -else - xgnu_linux_first_failure=yes -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "${xgnu_linux_first_failure}" = "yes"; then - OLD_LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE" - OLD_C_SWITCH_X_SITE="$C_SWITCH_X_SITE" - OLD_CPPFLAGS="$CPPFLAGS" - OLD_LIBS="$LIBS" - LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" - C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" - CPPFLAGS="$CPPFLAGS -b i486-linuxaout" - LIBS="$LIBS -b i486-linuxaout" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -XOpenDisplay ("foo"); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - xgnu_linux_second_failure=no -else - xgnu_linux_second_failure=yes -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "${xgnu_linux_second_failure}" = "yes"; then - # If we get the same failure with -b, there is no use adding -b. - # So take it out. This plays safe. - LD_SWITCH_X_SITE="$OLD_LD_SWITCH_X_SITE" - C_SWITCH_X_SITE="$OLD_C_SWITCH_X_SITE" - CPPFLAGS="$OLD_CPPFLAGS" - LIBS="$OLD_LIBS" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - fi - fi - - # Reportedly, some broken Solaris systems have XKBlib.h but are missing - # header files included from there. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Xkb" >&5 -$as_echo_n "checking for Xkb... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -int -main () -{ -XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_xkb=yes -else - emacs_xkb=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_xkb" >&5 -$as_echo "$emacs_xkb" >&6; } - if test $emacs_xkb = yes; then - -$as_echo "#define HAVE_XKBGETKEYBOARD 1" >>confdefs.h - - fi - - for ac_func in XrmSetDatabase XScreenResourceString \ -XScreenNumberOfScreen -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - -fi - -if test "${window_system}" = "x11"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 version 6" >&5 -$as_echo_n "checking X11 version 6... " >&6; } - if test "${emacs_cv_x11_version_6+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -#if XlibSpecificationRelease < 6 -fail; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_x11_version_6=yes -else - emacs_cv_x11_version_6=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - if test $emacs_cv_x11_version_6 = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5 -$as_echo "6 or newer" >&6; } - -$as_echo "#define HAVE_X11R6 1" >>confdefs.h - - -$as_echo "#define HAVE_X_I18N 1" >>confdefs.h - - ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style - ## XIM support. - case "$opsys" in - sol2-*) : ;; - *) -$as_echo "#define HAVE_X11R6_XIM 1" >>confdefs.h - - ;; - esac - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5 -$as_echo "before 6" >&6; } - fi -fi - - -### Use -lrsvg-2 if available, unless `--with-rsvg=no' is specified. -HAVE_RSVG=no -if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then - if test "${with_rsvg}" != "no"; then - RSVG_REQUIRED=2.11.0 - RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED" - - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - : - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $RSVG_MODULE" >&5 -$as_echo_n "checking for $RSVG_MODULE... " >&6; } - - if "$PKG_CONFIG" --exists "$RSVG_MODULE" 2>&5 && - RSVG_CFLAGS=`"$PKG_CONFIG" --cflags "$RSVG_MODULE" 2>&5` && - RSVG_LIBS=`"$PKG_CONFIG" --libs "$RSVG_MODULE" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - RSVG_CFLAGS=`$as_echo "$RSVG_CFLAGS" | sed -e "$edit_cflags"` - RSVG_LIBS=`$as_echo "$RSVG_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&5 -$as_echo "yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - RSVG_CFLAGS="" - RSVG_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - RSVG_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "$RSVG_MODULE") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_RSVG=yes - else - : - fi - - - - - if test $HAVE_RSVG = yes; then - -$as_echo "#define HAVE_RSVG 1" >>confdefs.h - - CFLAGS="$CFLAGS $RSVG_CFLAGS" - LIBS="$RSVG_LIBS $LIBS" - fi - fi -fi - -HAVE_IMAGEMAGICK=no -if test "${HAVE_X11}" = "yes"; then - if test "${with_imagemagick}" != "no"; then - ## 6.2.8 is the earliest version known to work, but earlier versions - ## might work - let us know if you find one. - ## 6.0.7 does not work. See bug#7955. - IMAGEMAGICK_MODULE="Wand >= 6.2.8" - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - : - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $IMAGEMAGICK_MODULE" >&5 -$as_echo_n "checking for $IMAGEMAGICK_MODULE... " >&6; } - - if "$PKG_CONFIG" --exists "$IMAGEMAGICK_MODULE" 2>&5 && - IMAGEMAGICK_CFLAGS=`"$PKG_CONFIG" --cflags "$IMAGEMAGICK_MODULE" 2>&5` && - IMAGEMAGICK_LIBS=`"$PKG_CONFIG" --libs "$IMAGEMAGICK_MODULE" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - IMAGEMAGICK_CFLAGS=`$as_echo "$IMAGEMAGICK_CFLAGS" | sed -e "$edit_cflags"` - IMAGEMAGICK_LIBS=`$as_echo "$IMAGEMAGICK_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&5 -$as_echo "yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - IMAGEMAGICK_CFLAGS="" - IMAGEMAGICK_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - IMAGEMAGICK_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "$IMAGEMAGICK_MODULE") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_IMAGEMAGICK=yes - else - : - fi - - - - - if test $HAVE_IMAGEMAGICK = yes; then - -$as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h - - CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS" - LIBS="$IMAGEMAGICK_LIBS $LIBS" - for ac_func in MagickExportImagePixels MagickMergeImageLayers -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - fi - fi -fi - - -HAVE_GTK=no -GTK_OBJ= -check_gtk2=no -gtk3_pkg_errors= -if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then - GLIB_REQUIRED=2.28 - GTK_REQUIRED=3.0 - GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" - - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - pkg_check_gtk=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5 -$as_echo_n "checking for $GTK_MODULES... " >&6; } - - if "$PKG_CONFIG" --exists "$GTK_MODULES" 2>&5 && - GTK_CFLAGS=`"$PKG_CONFIG" --cflags "$GTK_MODULES" 2>&5` && - GTK_LIBS=`"$PKG_CONFIG" --libs "$GTK_MODULES" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"` - GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5 -$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - GTK_CFLAGS="" - GTK_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - GTK_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "$GTK_MODULES") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - pkg_check_gtk=yes - else - pkg_check_gtk=no - fi - - if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then - as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5 - fi - if test "$pkg_check_gtk" = "yes"; then - -$as_echo "#define HAVE_GTK3 1" >>confdefs.h - - GTK_OBJ=emacsgtkfixed.o - term_header=gtkutil.h - USE_GTK_TOOLKIT="GTK3" - if test "x$ac_enable_gtk_deprecation_warnings" = x; then - GTK_CFLAGS="$GTK_CFLAGS -DGDK_DISABLE_DEPRECATION_WARNINGS" - fi - else - check_gtk2=yes - gtk3_pkg_errors="$GTK_PKG_ERRORS " - fi -fi - -if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then - GLIB_REQUIRED=2.10 - GTK_REQUIRED=2.10 - GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" - - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - pkg_check_gtk=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5 -$as_echo_n "checking for $GTK_MODULES... " >&6; } - - if "$PKG_CONFIG" --exists "$GTK_MODULES" 2>&5 && - GTK_CFLAGS=`"$PKG_CONFIG" --cflags "$GTK_MODULES" 2>&5` && - GTK_LIBS=`"$PKG_CONFIG" --libs "$GTK_MODULES" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"` - GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5 -$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - GTK_CFLAGS="" - GTK_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - GTK_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "$GTK_MODULES") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - pkg_check_gtk=yes - else - pkg_check_gtk=no - fi - - if test "$pkg_check_gtk" = "no" && - { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; } - then - as_fn_error "$gtk3_pkg_errors$GTK_PKG_ERRORS" "$LINENO" 5 - fi - test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2" -fi - -if test x"$pkg_check_gtk" = xyes; then - - - - C_SWITCH_X_SITE="$C_SWITCH_X_SITE $GTK_CFLAGS" - CFLAGS="$CFLAGS $GTK_CFLAGS" - LIBS="$GTK_LIBS $LIBS" - GTK_COMPILES=no - for ac_func in gtk_main -do : - ac_fn_c_check_func "$LINENO" "gtk_main" "ac_cv_func_gtk_main" -if test "x$ac_cv_func_gtk_main" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GTK_MAIN 1 -_ACEOF - GTK_COMPILES=yes -fi -done - - if test "${GTK_COMPILES}" != "yes"; then - if test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5; - fi - else - HAVE_GTK=yes - -$as_echo "#define USE_GTK 1" >>confdefs.h - - GTK_OBJ="gtkutil.o $GTK_OBJ" - USE_X_TOOLKIT=none - if "$PKG_CONFIG" --atleast-version=2.10 gtk+-2.0; then - : - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Your version of Gtk+ will have problems with - closing open displays. This is no problem if you just use - one display, but if you use more than one and close one of them - Emacs may crash." >&5 -$as_echo "$as_me: WARNING: Your version of Gtk+ will have problems with - closing open displays. This is no problem if you just use - one display, but if you use more than one and close one of them - Emacs may crash." >&2;} - sleep 3 - fi - fi - -fi - - - -if test "${HAVE_GTK}" = "yes"; then - - if test "$with_toolkit_scroll_bars" != no; then - with_toolkit_scroll_bars=yes - fi - - HAVE_GTK_FILE_SELECTION=no - ac_fn_c_check_decl "$LINENO" "GTK_TYPE_FILE_SELECTION" "ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" "$ac_includes_default -#include -" -if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = x""yes; then : - HAVE_GTK_FILE_SELECTION=yes -else - HAVE_GTK_FILE_SELECTION=no -fi - - if test "$HAVE_GTK_FILE_SELECTION" = yes; then - for ac_func in gtk_file_selection_new -do : - ac_fn_c_check_func "$LINENO" "gtk_file_selection_new" "ac_cv_func_gtk_file_selection_new" -if test "x$ac_cv_func_gtk_file_selection_new" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GTK_FILE_SELECTION_NEW 1 -_ACEOF - -fi -done - - fi - - HAVE_GTK_HANDLE_BOX=no - ac_fn_c_check_decl "$LINENO" "GTK_TYPE_HANDLE_BOX" "ac_cv_have_decl_GTK_TYPE_HANDLE_BOX" "$ac_includes_default -#include -" -if test "x$ac_cv_have_decl_GTK_TYPE_HANDLE_BOX" = x""yes; then : - HAVE_GTK_HANDLE_BOX=yes -else - HAVE_GTK_HANDLE_BOX=no -fi - - if test "$HAVE_GTK_HANDLE_BOX" = yes; then - for ac_func in gtk_handle_box_new -do : - ac_fn_c_check_func "$LINENO" "gtk_handle_box_new" "ac_cv_func_gtk_handle_box_new" -if test "x$ac_cv_func_gtk_handle_box_new" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GTK_HANDLE_BOX_NEW 1 -_ACEOF - -fi -done - - fi - - HAVE_GTK_TEAROFF_MENU_ITEM=no - ac_fn_c_check_decl "$LINENO" "GTK_TYPE_TEAROFF_MENU_ITEM" "ac_cv_have_decl_GTK_TYPE_TEAROFF_MENU_ITEM" "$ac_includes_default -#include -" -if test "x$ac_cv_have_decl_GTK_TYPE_TEAROFF_MENU_ITEM" = x""yes; then : - HAVE_GTK_TEAROFF_MENU_ITEM=yes -else - HAVE_GTK_TEAROFF_MENU_ITEM=no -fi - - if test "$HAVE_GTK_TEAROFF_MENU_ITEM" = yes; then - for ac_func in gtk_tearoff_menu_item_new -do : - ac_fn_c_check_func "$LINENO" "gtk_tearoff_menu_item_new" "ac_cv_func_gtk_tearoff_menu_item_new" -if test "x$ac_cv_func_gtk_tearoff_menu_item_new" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GTK_TEAROFF_MENU_ITEM_NEW 1 -_ACEOF - -fi -done - - fi - - for ac_func in gtk_widget_get_window gtk_widget_set_has_window \ - gtk_dialog_get_action_area gtk_widget_get_sensitive \ - gtk_widget_get_mapped gtk_adjustment_get_page_size \ - gtk_orientable_set_orientation \ - gtk_window_set_has_resize_grip -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - - term_header=gtkutil.h -fi - -HAVE_DBUS=no -DBUS_OBJ= -if test "${with_dbus}" = "yes"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_DBUS=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbus-1 >= 1.0" >&5 -$as_echo_n "checking for dbus-1 >= 1.0... " >&6; } - - if "$PKG_CONFIG" --exists "dbus-1 >= 1.0" 2>&5 && - DBUS_CFLAGS=`"$PKG_CONFIG" --cflags "dbus-1 >= 1.0" 2>&5` && - DBUS_LIBS=`"$PKG_CONFIG" --libs "dbus-1 >= 1.0" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - DBUS_CFLAGS=`$as_echo "$DBUS_CFLAGS" | sed -e "$edit_cflags"` - DBUS_LIBS=`$as_echo "$DBUS_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&5 -$as_echo "yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - DBUS_CFLAGS="" - DBUS_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - DBUS_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "dbus-1 >= 1.0") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_DBUS=yes - else - HAVE_DBUS=no - fi - - if test "$HAVE_DBUS" = yes; then - LIBS="$LIBS $DBUS_LIBS" - -$as_echo "#define HAVE_DBUS 1" >>confdefs.h - - for ac_func in dbus_watch_get_unix_fd \ - dbus_type_is_valid \ - dbus_validate_bus_name \ - dbus_validate_path \ - dbus_validate_interface \ - dbus_validate_member -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - DBUS_OBJ=dbusbind.o - fi -fi - - -HAVE_GSETTINGS=no -if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_GSETTINGS=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gio-2.0 >= 2.26" >&5 -$as_echo_n "checking for gio-2.0 >= 2.26... " >&6; } - - if "$PKG_CONFIG" --exists "gio-2.0 >= 2.26" 2>&5 && - GSETTINGS_CFLAGS=`"$PKG_CONFIG" --cflags "gio-2.0 >= 2.26" 2>&5` && - GSETTINGS_LIBS=`"$PKG_CONFIG" --libs "gio-2.0 >= 2.26" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - GSETTINGS_CFLAGS=`$as_echo "$GSETTINGS_CFLAGS" | sed -e "$edit_cflags"` - GSETTINGS_LIBS=`$as_echo "$GSETTINGS_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&5 -$as_echo "yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - GSETTINGS_CFLAGS="" - GSETTINGS_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - GSETTINGS_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "gio-2.0 >= 2.26") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_GSETTINGS=yes - else - HAVE_GSETTINGS=no - fi - - if test "$HAVE_GSETTINGS" = "yes"; then - -$as_echo "#define HAVE_GSETTINGS 1" >>confdefs.h - - SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" - SETTINGS_LIBS="$GSETTINGS_LIBS" - fi -fi - -HAVE_GCONF=no -if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_GCONF=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gconf-2.0 >= 2.13" >&5 -$as_echo_n "checking for gconf-2.0 >= 2.13... " >&6; } - - if "$PKG_CONFIG" --exists "gconf-2.0 >= 2.13" 2>&5 && - GCONF_CFLAGS=`"$PKG_CONFIG" --cflags "gconf-2.0 >= 2.13" 2>&5` && - GCONF_LIBS=`"$PKG_CONFIG" --libs "gconf-2.0 >= 2.13" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - GCONF_CFLAGS=`$as_echo "$GCONF_CFLAGS" | sed -e "$edit_cflags"` - GCONF_LIBS=`$as_echo "$GCONF_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&5 -$as_echo "yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - GCONF_CFLAGS="" - GCONF_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - GCONF_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "gconf-2.0 >= 2.13") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_GCONF=yes - else - HAVE_GCONF=no - fi - - if test "$HAVE_GCONF" = yes; then - -$as_echo "#define HAVE_GCONF 1" >>confdefs.h - - SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS" - SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS" - fi -fi - -if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_GOBJECT=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gobject-2.0 >= 2.0" >&5 -$as_echo_n "checking for gobject-2.0 >= 2.0... " >&6; } - - if "$PKG_CONFIG" --exists "gobject-2.0 >= 2.0" 2>&5 && - GOBJECT_CFLAGS=`"$PKG_CONFIG" --cflags "gobject-2.0 >= 2.0" 2>&5` && - GOBJECT_LIBS=`"$PKG_CONFIG" --libs "gobject-2.0 >= 2.0" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - GOBJECT_CFLAGS=`$as_echo "$GOBJECT_CFLAGS" | sed -e "$edit_cflags"` - GOBJECT_LIBS=`$as_echo "$GOBJECT_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&5 -$as_echo "yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - GOBJECT_CFLAGS="" - GOBJECT_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - GOBJECT_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "gobject-2.0 >= 2.0") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_GOBJECT=yes - else - HAVE_GOBJECT=no - fi - - if test "$HAVE_GOBJECT" = "yes"; then - SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GOBJECT_CFLAGS" - SETTINGS_LIBS="$SETTINGS_LIBS $GOBJECT_LIBS" - fi - SAVE_CFLAGS="$CFLAGS" - SAVE_LIBS="$LIBS" - CFLAGS="$SETTINGS_CFLAGS $CFLAGS" - LIBS="$SETTINGS_LIBS $LIBS" - for ac_func in g_type_init -do : - ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init" -if test "x$ac_cv_func_g_type_init" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_G_TYPE_INIT 1 -_ACEOF - -fi -done - - CFLAGS="$SAVE_CFLAGS" - LIBS="$SAVE_LIBS" -fi - - - - -HAVE_LIBSELINUX=no -LIBSELINUX_LIBS= -if test "${with_selinux}" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgetfilecon in -lselinux" >&5 -$as_echo_n "checking for lgetfilecon in -lselinux... " >&6; } -if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lselinux $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 lgetfilecon (); -int -main () -{ -return lgetfilecon (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_selinux_lgetfilecon=yes -else - ac_cv_lib_selinux_lgetfilecon=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_selinux_lgetfilecon" >&5 -$as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; } -if test "x$ac_cv_lib_selinux_lgetfilecon" = x""yes; then : - HAVE_LIBSELINUX=yes -else - HAVE_LIBSELINUX=no -fi - - if test "$HAVE_LIBSELINUX" = yes; then - -$as_echo "#define HAVE_LIBSELINUX 1" >>confdefs.h - - LIBSELINUX_LIBS=-lselinux - fi -fi - - -HAVE_GNUTLS=no -HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no -if test "${with_gnutls}" = "yes" ; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_GNUTLS=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.6.6" >&5 -$as_echo_n "checking for gnutls >= 2.6.6... " >&6; } - - if "$PKG_CONFIG" --exists "gnutls >= 2.6.6" 2>&5 && - LIBGNUTLS_CFLAGS=`"$PKG_CONFIG" --cflags "gnutls >= 2.6.6" 2>&5` && - LIBGNUTLS_LIBS=`"$PKG_CONFIG" --libs "gnutls >= 2.6.6" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - LIBGNUTLS_CFLAGS=`$as_echo "$LIBGNUTLS_CFLAGS" | sed -e "$edit_cflags"` - LIBGNUTLS_LIBS=`$as_echo "$LIBGNUTLS_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&5 -$as_echo "yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - LIBGNUTLS_CFLAGS="" - LIBGNUTLS_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - LIBGNUTLS_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "gnutls >= 2.6.6") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_GNUTLS=yes - else - HAVE_GNUTLS=no - fi - - if test "${HAVE_GNUTLS}" = "yes"; then - -$as_echo "#define HAVE_GNUTLS 1" >>confdefs.h - - fi - - CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS" - LIBS="$LIBGNUTLS_LIBS $LIBS" - for ac_func in gnutls_certificate_set_verify_function -do : - ac_fn_c_check_func "$LINENO" "gnutls_certificate_set_verify_function" "ac_cv_func_gnutls_certificate_set_verify_function" -if test "x$ac_cv_func_gnutls_certificate_set_verify_function" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION 1 -_ACEOF - HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes -fi -done - - - if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then - -$as_echo "#define HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 1" >>confdefs.h - - fi -fi - - - - -if test "${with_inotify}" = "yes"; then - for ac_header in sys/inotify.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/inotify.h" "ac_cv_header_sys_inotify_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_inotify_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_INOTIFY_H 1 -_ACEOF - -fi - -done - - if test "$ac_cv_header_sys_inotify_h" = yes ; then - ac_fn_c_check_func "$LINENO" "inotify_init1" "ac_cv_func_inotify_init1" -if test "x$ac_cv_func_inotify_init1" = x""yes; then : - -fi - - fi -fi -if test "$ac_cv_func_inotify_init1" = yes; then - -$as_echo "#define HAVE_INOTIFY 1" >>confdefs.h - -fi - -HAVE_POSIX_ACL=no -LIBACL_LIBS= -if test "${with_acl}" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for acl_set_file in -lacl" >&5 -$as_echo_n "checking for acl_set_file in -lacl... " >&6; } -if test "${ac_cv_lib_acl_acl_set_file+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lacl $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 acl_set_file (); -int -main () -{ -return acl_set_file (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_acl_acl_set_file=yes -else - ac_cv_lib_acl_acl_set_file=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_acl_acl_set_file" >&5 -$as_echo "$ac_cv_lib_acl_acl_set_file" >&6; } -if test "x$ac_cv_lib_acl_acl_set_file" = x""yes; then : - HAVE_POSIX_ACL=yes -else - HAVE_POSIX_ACL=no -fi - - if test "$HAVE_POSIX_ACL" = yes; then - -$as_echo "#define HAVE_POSIX_ACL 1" >>confdefs.h - - LIBACL_LIBS=-lacl - else - ac_fn_c_check_func "$LINENO" "acl_set_file" "ac_cv_func_acl_set_file" -if test "x$ac_cv_func_acl_set_file" = x""yes; then : - HAVE_POSIX_ACL=yes -else - HAVE_POSIX_ACL=no -fi - - if test "$HAVE_POSIX_ACL" = yes; then - -$as_echo "#define HAVE_POSIX_ACL 1" >>confdefs.h - - fi - fi -fi - - -HAVE_XAW3D=no -LUCID_LIBW= -if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then - if test "$with_xaw3d" != no; then - if test "${emacs_cv_xaw3d+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawScrollbarSetThumb in -lXaw3d" >&5 -$as_echo_n "checking for XawScrollbarSetThumb in -lXaw3d... " >&6; } -if test "${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXaw3d $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 XawScrollbarSetThumb (); -int -main () -{ -return XawScrollbarSetThumb (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xaw3d_XawScrollbarSetThumb=yes -else - ac_cv_lib_Xaw3d_XawScrollbarSetThumb=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_Xaw3d_XawScrollbarSetThumb" >&5 -$as_echo "$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&6; } -if test "x$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" = x""yes; then : - emacs_cv_xaw3d=yes -else - emacs_cv_xaw3d=no -fi - -else - emacs_cv_xaw3d=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - else - emacs_cv_xaw3d=no - fi - if test $emacs_cv_xaw3d = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5 -$as_echo_n "checking for xaw3d... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5 -$as_echo "yes; using Lucid toolkit" >&6; } - USE_X_TOOLKIT=LUCID - HAVE_XAW3D=yes - LUCID_LIBW=-lXaw3d - -$as_echo "#define HAVE_XAW3D 1" >>confdefs.h - - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5 -$as_echo_n "checking for xaw3d... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5 -$as_echo_n "checking for libXaw... " >&6; } - if test "${emacs_cv_xaw+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_xaw=yes -else - emacs_cv_xaw=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - if test $emacs_cv_xaw = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5 -$as_echo "yes; using Lucid toolkit" >&6; } - USE_X_TOOLKIT=LUCID - LUCID_LIBW=-lXaw - elif test x"${USE_X_TOOLKIT}" = xLUCID; then - as_fn_error "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5 - else - as_fn_error "No X toolkit could be found. -If you are sure you want Emacs compiled without an X toolkit, pass - --with-x-toolkit=no -to configure. Otherwise, install the development libraries for the toolkit -that you want to use (e.g. Gtk+) and re-run configure." "$LINENO" 5 - fi - fi -fi - -X_TOOLKIT_TYPE=$USE_X_TOOLKIT - -LIBXTR6= -if test "${USE_X_TOOLKIT}" != "none"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 toolkit version" >&5 -$as_echo_n "checking X11 toolkit version... " >&6; } - if test "${emacs_cv_x11_toolkit_version_6+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -#if XtSpecificationRelease < 6 -fail; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_x11_toolkit_version_6=yes -else - emacs_cv_x11_toolkit_version_6=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - HAVE_X11XTR6=$emacs_cv_x11_toolkit_version_6 - if test $emacs_cv_x11_toolkit_version_6 = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5 -$as_echo "6 or newer" >&6; } - -$as_echo "#define HAVE_X11XTR6 1" >>confdefs.h - - LIBXTR6="-lSM -lICE" - case "$opsys" in - ## Use libw.a along with X11R6 Xt. - unixware) LIBXTR6="$LIBXTR6 -lw" ;; - esac - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5 -$as_echo "before 6" >&6; } - fi - - OLDLIBS="$LIBS" - if test x$HAVE_X11XTR6 = xyes; then - LIBS="-lXt -lSM -lICE $LIBS" - else - LIBS="-lXt $LIBS" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5 -$as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; } -if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXmu $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 XmuConvertStandardSelection (); -int -main () -{ -return XmuConvertStandardSelection (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xmu_XmuConvertStandardSelection=yes -else - ac_cv_lib_Xmu_XmuConvertStandardSelection=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_Xmu_XmuConvertStandardSelection" >&5 -$as_echo "$ac_cv_lib_Xmu_XmuConvertStandardSelection" >&6; } -if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBXMU 1 -_ACEOF - - LIBS="-lXmu $LIBS" - -fi - - test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS" - fi - - -LIBXMU=-lXmu -case $opsys in - ## These systems don't supply Xmu. - hpux* | aix4-2 ) - test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU= - ;; -esac - - -# On Irix 6.5, at least, we need XShapeQueryExtension from -lXext for Xaw3D. -if test "${HAVE_X11}" = "yes"; then - if test "${USE_X_TOOLKIT}" != "none"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5 -$as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; } -if test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXext $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 XShapeQueryExtension (); -int -main () -{ -return XShapeQueryExtension (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xext_XShapeQueryExtension=yes -else - ac_cv_lib_Xext_XShapeQueryExtension=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_Xext_XShapeQueryExtension" >&5 -$as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; } -if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBXEXT 1 -_ACEOF - - LIBS="-lXext $LIBS" - -fi - - fi -fi - -LIBXP= -if test "${USE_X_TOOLKIT}" = "MOTIF"; then - # OpenMotif may be installed in such a way on some GNU/Linux systems. - if test -d /usr/include/openmotif; then - CPPFLAGS="-I/usr/include/openmotif $CPPFLAGS" - emacs_cv_openmotif=yes - case "$canonical" in - x86_64-*-linux-gnu* | powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) - test -d /usr/lib64/openmotif && LDFLAGS="-L/usr/lib64/openmotif $LDFLAGS" - ;; - *) - test -d /usr/lib/openmotif && LDFLAGS="-L/usr/lib/openmotif $LDFLAGS" - esac - else - emacs_cv_openmotif=no - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for (Open)Motif version 2.1" >&5 -$as_echo_n "checking for (Open)Motif version 2.1... " >&6; } -if test "${emacs_cv_motif_version_2_1+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -#if XmVERSION > 2 || (XmVERSION == 2 && XmREVISION >= 1) -int x = 5; -#else -Motif version prior to 2.1. -#endif - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_motif_version_2_1=yes -else - emacs_cv_motif_version_2_1=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_motif_version_2_1" >&5 -$as_echo "$emacs_cv_motif_version_2_1" >&6; } - if test $emacs_cv_motif_version_2_1 = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpCreateContext in -lXp" >&5 -$as_echo_n "checking for XpCreateContext in -lXp... " >&6; } -if test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXp $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 XpCreateContext (); -int -main () -{ -return XpCreateContext (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xp_XpCreateContext=yes -else - ac_cv_lib_Xp_XpCreateContext=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_Xp_XpCreateContext" >&5 -$as_echo "$ac_cv_lib_Xp_XpCreateContext" >&6; } -if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then : - LIBXP=-lXp -fi - - if test x$emacs_cv_openmotif = xyes; then - REAL_CPPFLAGS="-I/usr/include/openmotif $REAL_CPPFLAGS" - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5 -$as_echo_n "checking for LessTif where some systems put it... " >&6; } -if test "${emacs_cv_lesstif+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # We put this in CFLAGS temporarily to precede other -I options - # that might be in CFLAGS temporarily. - # We put this in CPPFLAGS where it precedes the other -I options. - OLD_CPPFLAGS=$CPPFLAGS - OLD_CFLAGS=$CFLAGS - CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CPPFLAGS" - CFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CFLAGS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -int x = 5; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_lesstif=yes -else - emacs_cv_lesstif=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_lesstif" >&5 -$as_echo "$emacs_cv_lesstif" >&6; } - if test $emacs_cv_lesstif = yes; then - # Make sure this -I option remains in CPPFLAGS after it is set - # back to REAL_CPPFLAGS. - # There is no need to change REAL_CFLAGS, because REAL_CFLAGS does not - # have those other -I options anyway. Ultimately, having this - # directory ultimately in CPPFLAGS will be enough. - REAL_CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $REAL_CPPFLAGS" - LDFLAGS="-L/usr/X11R6/LessTif/Motif1.2/lib $LDFLAGS" - else - CFLAGS=$OLD_CFLAGS - CPPFLAGS=$OLD_CPPFLAGS - fi - fi - ac_fn_c_check_header_mongrel "$LINENO" "Xm/BulletinB.h" "ac_cv_header_Xm_BulletinB_h" "$ac_includes_default" -if test "x$ac_cv_header_Xm_BulletinB_h" = x""yes; then : - -else - as_fn_error "Motif toolkit requested but requirements not found." "$LINENO" 5 -fi - - -fi - - -USE_TOOLKIT_SCROLL_BARS=no -if test "${with_toolkit_scroll_bars}" != "no"; then - if test "${USE_X_TOOLKIT}" != "none"; then - if test "${USE_X_TOOLKIT}" = "MOTIF"; then - $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h - - HAVE_XAW3D=no - USE_TOOLKIT_SCROLL_BARS=yes - elif test "${HAVE_XAW3D}" = "yes" || test "${USE_X_TOOLKIT}" = "LUCID"; then - $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h - - USE_TOOLKIT_SCROLL_BARS=yes - fi - elif test "${HAVE_GTK}" = "yes"; then - $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h - - USE_TOOLKIT_SCROLL_BARS=yes - elif test "${HAVE_NS}" = "yes"; then - $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h - - USE_TOOLKIT_SCROLL_BARS=yes - elif test "${HAVE_W32}" = "yes"; then - $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h - - USE_TOOLKIT_SCROLL_BARS=yes - fi -fi - -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include -int -main () -{ -XIMProc callback; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - HAVE_XIM=yes - -$as_echo "#define HAVE_XIM 1" >>confdefs.h - -else - HAVE_XIM=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - - -if test "${with_xim}" != "no"; then - -$as_echo "#define USE_XIM 1" >>confdefs.h - -fi - - -if test "${HAVE_XIM}" != "no"; then - late_CFLAGS=$CFLAGS - if test "$GCC" = yes; then - CFLAGS="$CFLAGS --pedantic-errors" - fi - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -int -main () -{ -Display *display; -XrmDatabase db; -char *res_name; -char *res_class; -XIMProc callback; -XPointer *client_data; -#ifndef __GNUC__ -/* If we're not using GCC, it's probably not XFree86, and this is - probably right, but we can't use something like --pedantic-errors. */ -extern Bool XRegisterIMInstantiateCallback(Display*, XrmDatabase, char*, - char*, XIMProc, XPointer*); -#endif -(void)XRegisterIMInstantiateCallback(display, db, res_name, res_class, callback, - client_data); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_arg6_star=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test "$emacs_cv_arg6_star" = yes; then - $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer*" >>confdefs.h - - else - $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer" >>confdefs.h - - fi - CFLAGS=$late_CFLAGS -fi - -### Start of font-backend (under any platform) section. -# (nothing here yet -- this is a placeholder) -### End of font-backend (under any platform) section. - -### Start of font-backend (under X11) section. -if test "${HAVE_X11}" = "yes"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_FC=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fontconfig >= 2.2.0" >&5 -$as_echo_n "checking for fontconfig >= 2.2.0... " >&6; } - - if "$PKG_CONFIG" --exists "fontconfig >= 2.2.0" 2>&5 && - FONTCONFIG_CFLAGS=`"$PKG_CONFIG" --cflags "fontconfig >= 2.2.0" 2>&5` && - FONTCONFIG_LIBS=`"$PKG_CONFIG" --libs "fontconfig >= 2.2.0" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - FONTCONFIG_CFLAGS=`$as_echo "$FONTCONFIG_CFLAGS" | sed -e "$edit_cflags"` - FONTCONFIG_LIBS=`$as_echo "$FONTCONFIG_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&5 -$as_echo "yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - FONTCONFIG_CFLAGS="" - FONTCONFIG_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - FONTCONFIG_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "fontconfig >= 2.2.0") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_FC=yes - else - HAVE_FC=no - fi - - - ## Use -lXft if available, unless `--with-xft=no'. - HAVE_XFT=maybe - if test "${HAVE_FC}" = "no" || test "x${with_x}" = "xno"; then - with_xft="no"; - fi - if test "x${with_xft}" != "xno"; then - - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_XFT=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xft >= 0.13.0" >&5 -$as_echo_n "checking for xft >= 0.13.0... " >&6; } - - if "$PKG_CONFIG" --exists "xft >= 0.13.0" 2>&5 && - XFT_CFLAGS=`"$PKG_CONFIG" --cflags "xft >= 0.13.0" 2>&5` && - XFT_LIBS=`"$PKG_CONFIG" --libs "xft >= 0.13.0" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - XFT_CFLAGS=`$as_echo "$XFT_CFLAGS" | sed -e "$edit_cflags"` - XFT_LIBS=`$as_echo "$XFT_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&5 -$as_echo "yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - XFT_CFLAGS="" - XFT_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - XFT_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "xft >= 0.13.0") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - : - else - HAVE_XFT=no - fi - - ## Because xftfont.c uses XRenderQueryExtension, we also - ## need to link to -lXrender. - HAVE_XRENDER=no - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5 -$as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; } -if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXrender $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 XRenderQueryExtension (); -int -main () -{ -return XRenderQueryExtension (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xrender_XRenderQueryExtension=yes -else - ac_cv_lib_Xrender_XRenderQueryExtension=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_Xrender_XRenderQueryExtension" >&5 -$as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; } -if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then : - HAVE_XRENDER=yes -fi - - if test "$HAVE_XFT" != no && test "$HAVE_XRENDER" != no; then - OLD_CPPFLAGS="$CPPFLAGS" - OLD_CFLAGS="$CFLAGS" - OLD_LIBS="$LIBS" - CPPFLAGS="$CPPFLAGS $XFT_CFLAGS" - CFLAGS="$CFLAGS $XFT_CFLAGS" - XFT_LIBS="-lXrender $XFT_LIBS" - LIBS="$XFT_LIBS $LIBS" - ac_fn_c_check_header_mongrel "$LINENO" "X11/Xft/Xft.h" "ac_cv_header_X11_Xft_Xft_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xft_Xft_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5 -$as_echo_n "checking for XftFontOpen in -lXft... " >&6; } -if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXft $XFT_LIBS $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 XftFontOpen (); -int -main () -{ -return XftFontOpen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xft_XftFontOpen=yes -else - ac_cv_lib_Xft_XftFontOpen=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_Xft_XftFontOpen" >&5 -$as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; } -if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then : - HAVE_XFT=yes -fi - -fi - - - - if test "${HAVE_XFT}" = "yes"; then - -$as_echo "#define HAVE_XFT 1" >>confdefs.h - - - C_SWITCH_X_SITE="$C_SWITCH_X_SITE $XFT_CFLAGS" - else - CPPFLAGS="$OLD_CPPFLAGS" - CFLAGS="$OLD_CFLAGS" - LIBS="$OLD_LIBS" - fi # "${HAVE_XFT}" = "yes" - fi # "$HAVE_XFT" != no - fi # "x${with_xft}" != "xno" - - ## We used to allow building with FreeType and without Xft. - ## However, the ftx font backend driver is not in good shape. - if test "$HAVE_XFT" != "yes"; then - HAVE_XFT=no - HAVE_FREETYPE=no - else - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_FREETYPE=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for freetype2" >&5 -$as_echo_n "checking for freetype2... " >&6; } - - if "$PKG_CONFIG" --exists "freetype2" 2>&5 && - FREETYPE_CFLAGS=`"$PKG_CONFIG" --cflags "freetype2" 2>&5` && - FREETYPE_LIBS=`"$PKG_CONFIG" --libs "freetype2" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - FREETYPE_CFLAGS=`$as_echo "$FREETYPE_CFLAGS" | sed -e "$edit_cflags"` - FREETYPE_LIBS=`$as_echo "$FREETYPE_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&5 -$as_echo "yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - FREETYPE_CFLAGS="" - FREETYPE_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - FREETYPE_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "freetype2") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_FREETYPE=yes - else - HAVE_FREETYPE=no - fi - - - test "$HAVE_FREETYPE" = "no" && as_fn_error "libxft requires libfreetype" "$LINENO" 5 - fi - - HAVE_LIBOTF=no - if test "${HAVE_FREETYPE}" = "yes"; then - -$as_echo "#define HAVE_FREETYPE 1" >>confdefs.h - - if test "${with_libotf}" != "no"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_LIBOTF=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libotf" >&5 -$as_echo_n "checking for libotf... " >&6; } - - if "$PKG_CONFIG" --exists "libotf" 2>&5 && - LIBOTF_CFLAGS=`"$PKG_CONFIG" --cflags "libotf" 2>&5` && - LIBOTF_LIBS=`"$PKG_CONFIG" --libs "libotf" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - LIBOTF_CFLAGS=`$as_echo "$LIBOTF_CFLAGS" | sed -e "$edit_cflags"` - LIBOTF_LIBS=`$as_echo "$LIBOTF_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&5 -$as_echo "yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - LIBOTF_CFLAGS="" - LIBOTF_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - LIBOTF_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "libotf") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_LIBOTF=yes - else - HAVE_LIBOTF=no - fi - - if test "$HAVE_LIBOTF" = "yes"; then - -$as_echo "#define HAVE_LIBOTF 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OTF_get_variation_glyphs in -lotf" >&5 -$as_echo_n "checking for OTF_get_variation_glyphs in -lotf... " >&6; } -if test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lotf $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 OTF_get_variation_glyphs (); -int -main () -{ -return OTF_get_variation_glyphs (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_otf_OTF_get_variation_glyphs=yes -else - ac_cv_lib_otf_OTF_get_variation_glyphs=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_otf_OTF_get_variation_glyphs" >&5 -$as_echo "$ac_cv_lib_otf_OTF_get_variation_glyphs" >&6; } -if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = x""yes; then : - HAVE_OTF_GET_VARIATION_GLYPHS=yes -else - HAVE_OTF_GET_VARIATION_GLYPHS=no -fi - - if test "${HAVE_OTF_GET_VARIATION_GLYPHS}" = "yes"; then - -$as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h - - fi - fi - fi - fi - - HAVE_M17N_FLT=no - if test "${HAVE_LIBOTF}" = yes; then - if test "${with_m17n_flt}" != "no"; then - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_M17N_FLT=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for m17n-flt" >&5 -$as_echo_n "checking for m17n-flt... " >&6; } - - if "$PKG_CONFIG" --exists "m17n-flt" 2>&5 && - M17N_FLT_CFLAGS=`"$PKG_CONFIG" --cflags "m17n-flt" 2>&5` && - M17N_FLT_LIBS=`"$PKG_CONFIG" --libs "m17n-flt" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - M17N_FLT_CFLAGS=`$as_echo "$M17N_FLT_CFLAGS" | sed -e "$edit_cflags"` - M17N_FLT_LIBS=`$as_echo "$M17N_FLT_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&5 -$as_echo "yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - M17N_FLT_CFLAGS="" - M17N_FLT_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - M17N_FLT_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "m17n-flt") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_M17N_FLT=yes - else - HAVE_M17N_FLT=no - fi - - if test "$HAVE_M17N_FLT" = "yes"; then - -$as_echo "#define HAVE_M17N_FLT 1" >>confdefs.h - - fi - fi - fi -else - HAVE_XFT=no - HAVE_FREETYPE=no - HAVE_LIBOTF=no - HAVE_M17N_FLT=no -fi - -### End of font-backend (under X11) section. - - - - - - - - - - -### Use -lXpm if available, unless `--with-xpm=no'. -HAVE_XPM=no -LIBXPM= - -if test "${HAVE_W32}" = "yes"; then - if test "${with_xpm}" != "no"; then - SAVE_CPPFLAGS="$CPPFLAGS" - SAVE_LDFLAGS="$LDFLAGS" - CPPFLAGS="$CPPFLAGS -I/usr/include/noX" - LDFLAGS="$LDFLAGS -L/usr/lib/noX" - ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_xpm_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToImage in -lXpm" >&5 -$as_echo_n "checking for XpmReadFileToImage in -lXpm... " >&6; } -if test "${ac_cv_lib_Xpm_XpmReadFileToImage+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXpm $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 XpmReadFileToImage (); -int -main () -{ -return XpmReadFileToImage (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xpm_XpmReadFileToImage=yes -else - ac_cv_lib_Xpm_XpmReadFileToImage=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_Xpm_XpmReadFileToImage" >&5 -$as_echo "$ac_cv_lib_Xpm_XpmReadFileToImage" >&6; } -if test "x$ac_cv_lib_Xpm_XpmReadFileToImage" = x""yes; then : - HAVE_XPM=yes -fi - -fi - - - if test "${HAVE_XPM}" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReturnAllocPixels preprocessor define" >&5 -$as_echo_n "checking for XpmReturnAllocPixels preprocessor define... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include "X11/xpm.h" -#ifndef XpmReturnAllocPixels -no_return_alloc_pixels -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "no_return_alloc_pixels" >/dev/null 2>&1; then : - HAVE_XPM=no -else - HAVE_XPM=yes -fi -rm -f conftest* - - - if test "${HAVE_XPM}" = "yes"; then - REAL_CPPFLAGS="$REAL_CPPFLAGS -I/usr/include/noX" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - CPPFLAGS="$SAVE_CPPFLAGS" - LDFLAGS="$SAVE_LDFLAGS" - fi - fi - fi - - if test "${HAVE_XPM}" = "yes"; then - -$as_echo "#define HAVE_XPM 1" >>confdefs.h - - LIBXPM=-lXpm - fi -fi - -if test "${HAVE_X11}" = "yes"; then - if test "${with_xpm}" != "no"; then - ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_xpm_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5 -$as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; } -if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXpm -lX11 $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 XpmReadFileToPixmap (); -int -main () -{ -return XpmReadFileToPixmap (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_Xpm_XpmReadFileToPixmap=yes -else - ac_cv_lib_Xpm_XpmReadFileToPixmap=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_Xpm_XpmReadFileToPixmap" >&5 -$as_echo "$ac_cv_lib_Xpm_XpmReadFileToPixmap" >&6; } -if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = x""yes; then : - HAVE_XPM=yes -fi - -fi - - - if test "${HAVE_XPM}" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReturnAllocPixels preprocessor define" >&5 -$as_echo_n "checking for XpmReturnAllocPixels preprocessor define... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include "X11/xpm.h" -#ifndef XpmReturnAllocPixels -no_return_alloc_pixels -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "no_return_alloc_pixels" >/dev/null 2>&1; then : - HAVE_XPM=no -else - HAVE_XPM=yes -fi -rm -f conftest* - - - if test "${HAVE_XPM}" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - fi - fi - fi - - if test "${HAVE_XPM}" = "yes"; then - -$as_echo "#define HAVE_XPM 1" >>confdefs.h - - LIBXPM=-lXpm - fi -fi - - - -### Use -ljpeg if available, unless `--with-jpeg=no'. -HAVE_JPEG=no -LIBJPEG= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then - if test "${with_jpeg}" != "no"; then - ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default" -if test "x$ac_cv_header_jerror_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5 -$as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; } -if test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ljpeg $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 jpeg_destroy_compress (); -int -main () -{ -return jpeg_destroy_compress (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_jpeg_jpeg_destroy_compress=yes -else - ac_cv_lib_jpeg_jpeg_destroy_compress=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_jpeg_jpeg_destroy_compress" >&5 -$as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; } -if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = x""yes; then : - HAVE_JPEG=yes -fi - -fi - - - fi - - if test "${HAVE_JPEG}" = "yes"; then - $as_echo "#define HAVE_JPEG 1" >>confdefs.h - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - version=JPEG_LIB_VERSION - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "version= *(6[2-9]|[7-9][0-9])" >/dev/null 2>&1; then : - $as_echo "#define HAVE_JPEG 1" >>confdefs.h - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libjpeg found, but not version 6b or later" >&5 -$as_echo "$as_me: WARNING: libjpeg found, but not version 6b or later" >&2;} - HAVE_JPEG=no -fi -rm -f conftest* - - fi - if test "${HAVE_JPEG}" = "yes"; then - LIBJPEG=-ljpeg - fi -fi - - -### Use -lpng if available, unless `--with-png=no'. -HAVE_PNG=no -LIBPNG= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then - if test "${with_png}" != "no"; then - # Debian unstable as of July 2003 has multiple libpngs, and puts png.h - # in /usr/include/libpng. - for ac_header in png.h libpng/png.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" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - break -fi - -done - - if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_get_channels in -lpng" >&5 -$as_echo_n "checking for png_get_channels in -lpng... " >&6; } -if test "${ac_cv_lib_png_png_get_channels+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpng -lz -lm $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 png_get_channels (); -int -main () -{ -return png_get_channels (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_png_png_get_channels=yes -else - ac_cv_lib_png_png_get_channels=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_png_png_get_channels" >&5 -$as_echo "$ac_cv_lib_png_png_get_channels" >&6; } -if test "x$ac_cv_lib_png_png_get_channels" = x""yes; then : - HAVE_PNG=yes -fi - - fi - fi - - if test "${HAVE_PNG}" = "yes"; then - -$as_echo "#define HAVE_PNG 1" >>confdefs.h - - LIBPNG="-lpng -lz -lm" - - ac_fn_c_check_decl "$LINENO" "png_longjmp" "ac_cv_have_decl_png_longjmp" "#ifdef HAVE_LIBPNG_PNG_H - # include - #else - # include - #endif - -" -if test "x$ac_cv_have_decl_png_longjmp" = x""yes; then : - -else - -$as_echo "#define PNG_DEPSTRUCT /**/" >>confdefs.h - -fi - - fi -fi - - -### Use -ltiff if available, unless `--with-tiff=no'. -HAVE_TIFF=no -LIBTIFF= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then - if test "${with_tiff}" != "no"; then - ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" -if test "x$ac_cv_header_tiffio_h" = x""yes; then : - tifflibs="-lz -lm" - # At least one tiff package requires the jpeg library. - if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFGetVersion in -ltiff" >&5 -$as_echo_n "checking for TIFFGetVersion in -ltiff... " >&6; } -if test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ltiff $tifflibs $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 TIFFGetVersion (); -int -main () -{ -return TIFFGetVersion (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_tiff_TIFFGetVersion=yes -else - ac_cv_lib_tiff_TIFFGetVersion=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_tiff_TIFFGetVersion" >&5 -$as_echo "$ac_cv_lib_tiff_TIFFGetVersion" >&6; } -if test "x$ac_cv_lib_tiff_TIFFGetVersion" = x""yes; then : - HAVE_TIFF=yes -fi - -fi - - - fi - - if test "${HAVE_TIFF}" = "yes"; then - -$as_echo "#define HAVE_TIFF 1" >>confdefs.h - - LIBTIFF=-ltiff - fi -fi - - -### Use -lgif or -lungif if available, unless `--with-gif=no'. -HAVE_GIF=no -LIBGIF= -if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \ - || test "${HAVE_W32}" = "yes"; then - ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default" -if test "x$ac_cv_header_gif_lib_h" = x""yes; then : - # EGifPutExtensionLast only exists from version libungif-4.1.0b1. -# Earlier versions can crash Emacs. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5 -$as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; } -if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgif $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 EGifPutExtensionLast (); -int -main () -{ -return EGifPutExtensionLast (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_gif_EGifPutExtensionLast=yes -else - ac_cv_lib_gif_EGifPutExtensionLast=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_gif_EGifPutExtensionLast" >&5 -$as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then : - HAVE_GIF=yes -else - HAVE_GIF=maybe -fi - -fi - - - - if test "$HAVE_GIF" = yes; then - LIBGIF=-lgif - elif test "$HAVE_GIF" = maybe; then -# If gif_lib.h but no libgif, try libungif. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5 -$as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; } -if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lungif $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 EGifPutExtensionLast (); -int -main () -{ -return EGifPutExtensionLast (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ungif_EGifPutExtensionLast=yes -else - ac_cv_lib_ungif_EGifPutExtensionLast=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_ungif_EGifPutExtensionLast" >&5 -$as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then : - HAVE_GIF=yes -else - HAVE_GIF=no -fi - - test "$HAVE_GIF" = yes && LIBGIF=-lungif - fi - - if test "${HAVE_GIF}" = "yes"; then - -$as_echo "#define HAVE_GIF 1" >>confdefs.h - - fi -fi - - -if test "${HAVE_X11}" = "yes"; then - MISSING="" - WITH_NO="" - test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" && - MISSING="libXpm" && WITH_NO="--with-xpm=no" - test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" && - MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no" - test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" && - MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no" - test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" && - MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no" - test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" && - MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no" - - if test "X${MISSING}" != X; then - as_fn_error "The following required libraries were not found: - $MISSING -Maybe some development libraries/packages are missing? -If you don't want to link with them give - $WITH_NO -as options to configure" "$LINENO" 5 - fi -fi - -### Use -lgpm if available, unless `--with-gpm=no'. -HAVE_GPM=no -LIBGPM= -if test "${with_gpm}" != "no"; then - ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default" -if test "x$ac_cv_header_gpm_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5 -$as_echo_n "checking for Gpm_Open in -lgpm... " >&6; } -if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgpm $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 Gpm_Open (); -int -main () -{ -return Gpm_Open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_gpm_Gpm_Open=yes -else - ac_cv_lib_gpm_Gpm_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_gpm_Gpm_Open" >&5 -$as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; } -if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then : - HAVE_GPM=yes -fi - -fi - - - - if test "${HAVE_GPM}" = "yes"; then - -$as_echo "#define HAVE_GPM 1" >>confdefs.h - - LIBGPM=-lgpm - fi -fi - - - - - - -GNUSTEP_CFLAGS= -### Use NeXTstep API to implement GUI. -if test "${HAVE_NS}" = "yes"; then - -$as_echo "#define HAVE_NS 1" >>confdefs.h - - if test "${NS_IMPL_COCOA}" = "yes"; then - -$as_echo "#define NS_IMPL_COCOA 1" >>confdefs.h - - fi - if test "${NS_IMPL_GNUSTEP}" = "yes"; then - -$as_echo "#define NS_IMPL_GNUSTEP 1" >>confdefs.h - - # See also .m.o rule in Makefile.in */ - # FIXME: are all these flags really needed? Document here why. */ - GNUSTEP_CFLAGS="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}" - ## Extra CFLAGS applied to src/*.m files. - GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE" - fi - # We also have mouse menus. - HAVE_MENUS=yes - OTHER_FILES=ns-app -fi - -if test "${HAVE_W32}" = "yes"; then - HAVE_MENUS=yes -fi - -### Use session management (-lSM -lICE) if available -HAVE_X_SM=no -LIBXSM= -if test "${HAVE_X11}" = "yes"; then - ac_fn_c_check_header_mongrel "$LINENO" "X11/SM/SMlib.h" "ac_cv_header_X11_SM_SMlib_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_SM_SMlib_h" = x""yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5 -$as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; } -if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lSM -lICE $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 SmcOpenConnection (); -int -main () -{ -return SmcOpenConnection (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_SM_SmcOpenConnection=yes -else - ac_cv_lib_SM_SmcOpenConnection=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_SM_SmcOpenConnection" >&5 -$as_echo "$ac_cv_lib_SM_SmcOpenConnection" >&6; } -if test "x$ac_cv_lib_SM_SmcOpenConnection" = x""yes; then : - HAVE_X_SM=yes -fi - -fi - - - - if test "${HAVE_X_SM}" = "yes"; then - -$as_echo "#define HAVE_X_SM 1" >>confdefs.h - - LIBXSM="-lSM -lICE" - case "$LIBS" in - *-lSM*) ;; - *) LIBS="$LIBXSM $LIBS" ;; - esac - fi -fi - - -### Use libxml (-lxml2) if available -HAVE_LIBXML2=no -if test "${with_xml2}" != "no"; then - ### I'm not sure what the version number should be, so I just guessed. - - succeeded=no - - if test "$PKG_CONFIG" = "no" ; then - HAVE_LIBXML2=no - else - PKG_CONFIG_MIN_VERSION=0.9.0 - if "$PKG_CONFIG" --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.6.17" >&5 -$as_echo_n "checking for libxml-2.0 > 2.6.17... " >&6; } - - if "$PKG_CONFIG" --exists "libxml-2.0 > 2.6.17" 2>&5 && - LIBXML2_CFLAGS=`"$PKG_CONFIG" --cflags "libxml-2.0 > 2.6.17" 2>&5` && - LIBXML2_LIBS=`"$PKG_CONFIG" --libs "libxml-2.0 > 2.6.17" 2>&5`; then - edit_cflags=" - s,///*,/,g - s/^/ / - s/ -I/ $isystem/g - s/^ // - " - LIBXML2_CFLAGS=`$as_echo "$LIBXML2_CFLAGS" | sed -e "$edit_cflags"` - LIBXML2_LIBS=`$as_echo "$LIBXML2_LIBS" | sed -e 's,///*,/,g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&5 -$as_echo "yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&6; } - succeeded=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - LIBXML2_CFLAGS="" - LIBXML2_LIBS="" - ## If we have a custom action on failure, don't print errors, but - ## do set a variable so people can do so. Do it in a subshell - ## to capture any diagnostics in invoking pkg-config. - LIBXML2_PKG_ERRORS=`("$PKG_CONFIG" --print-errors "libxml-2.0 > 2.6.17") 2>&1` - - fi - - - - else - echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." - echo "*** See http://www.freedesktop.org/software/pkgconfig" - fi - fi - - if test $succeeded = yes; then - HAVE_LIBXML2=yes - else - HAVE_LIBXML2=no - fi - - if test "${HAVE_LIBXML2}" = "yes"; then - LIBS="$LIBXML2_LIBS $LIBS" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5 -$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; } -if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lxml2 $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 htmlReadMemory (); -int -main () -{ -return htmlReadMemory (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_xml2_htmlReadMemory=yes -else - ac_cv_lib_xml2_htmlReadMemory=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_xml2_htmlReadMemory" >&5 -$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; } -if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then : - HAVE_LIBXML2=yes -else - HAVE_LIBXML2=no -fi - - if test "${HAVE_LIBXML2}" = "yes"; then - -$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h - - else - LIBXML2_LIBS="" - LIBXML2_CFLAGS="" - fi - fi -fi - - - -# If netdb.h doesn't declare h_errno, we must declare it by hand. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 -$as_echo_n "checking whether netdb declares h_errno... " >&6; } -if test "${emacs_cv_netdb_declares_h_errno+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -return h_errno; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_netdb_declares_h_errno=yes -else - emacs_cv_netdb_declares_h_errno=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_netdb_declares_h_errno" >&5 -$as_echo "$emacs_cv_netdb_declares_h_errno" >&6; } -if test $emacs_cv_netdb_declares_h_errno = yes; then - -$as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h - -fi - -# sqrt and other floating-point functions such as fmod and frexp -# are found in -lm on most systems. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5 -$as_echo_n "checking for sqrt in -lm... " >&6; } -if test "${ac_cv_lib_m_sqrt+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lm $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 sqrt (); -int -main () -{ -return sqrt (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_m_sqrt=yes -else - ac_cv_lib_m_sqrt=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_m_sqrt" >&5 -$as_echo "$ac_cv_lib_m_sqrt" >&6; } -if test "x$ac_cv_lib_m_sqrt" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBM 1 -_ACEOF - - LIBS="-lm $LIBS" - -fi - - -# Check for mail-locking functions in a "mail" library. Probably this should -# have the same check as for liblockfile below. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -lmail" >&5 -$as_echo_n "checking for maillock in -lmail... " >&6; } -if test "${ac_cv_lib_mail_maillock+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lmail $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 maillock (); -int -main () -{ -return maillock (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_mail_maillock=yes -else - ac_cv_lib_mail_maillock=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_mail_maillock" >&5 -$as_echo "$ac_cv_lib_mail_maillock" >&6; } -if test "x$ac_cv_lib_mail_maillock" = x""yes; then : - have_mail=yes -else - have_mail=no -fi - -if test $have_mail = yes; then - LIBS_MAIL=-lmail - LIBS="$LIBS_MAIL $LIBS" - -$as_echo "#define HAVE_LIBMAIL 1" >>confdefs.h - -else - LIBS_MAIL= -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5 -$as_echo_n "checking for maillock in -llockfile... " >&6; } -if test "${ac_cv_lib_lockfile_maillock+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-llockfile $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 maillock (); -int -main () -{ -return maillock (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_lockfile_maillock=yes -else - ac_cv_lib_lockfile_maillock=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_lockfile_maillock" >&5 -$as_echo "$ac_cv_lib_lockfile_maillock" >&6; } -if test "x$ac_cv_lib_lockfile_maillock" = x""yes; then : - have_lockfile=yes -else - have_lockfile=no -fi - -if test $have_lockfile = yes; then - LIBS_MAIL=-llockfile - LIBS="$LIBS_MAIL $LIBS" - -$as_echo "#define HAVE_LIBLOCKFILE 1" >>confdefs.h - -else -# If we have the shared liblockfile, assume we must use it for mail -# locking (e.g. Debian). If we couldn't link against liblockfile -# (no liblockfile.a installed), ensure that we don't need to. - # Extract the first word of "liblockfile.so", so it can be a program name with args. -set dummy liblockfile.so; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_liblockfile+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$liblockfile"; then - ac_cv_prog_liblockfile="$liblockfile" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_dummy="/usr/lib:/lib:/usr/local/lib:$LD_LIBRARY_PATH" -for as_dir in $as_dummy -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then - ac_cv_prog_liblockfile="yes" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_prog_liblockfile" && ac_cv_prog_liblockfile="no" -fi -fi -liblockfile=$ac_cv_prog_liblockfile -if test -n "$liblockfile"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $liblockfile" >&5 -$as_echo "$liblockfile" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test $ac_cv_prog_liblockfile = yes; then - as_fn_error "Shared liblockfile found but can't link against it. -This probably means that movemail could lose mail. -There may be a \`development' package to install containing liblockfile." "$LINENO" 5 - fi -fi - - - - - -## Define MAIL_USE_FLOCK (or LOCKF) if the mailer uses flock (or lockf) to -## interlock access to the mail spool. The alternative is a lock file named -## /usr/spool/mail/$USER.lock. -mail_lock=no -case "$opsys" in - aix4-2) mail_lock="lockf" ;; - - gnu|freebsd|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;; - - ## On GNU/Linux systems, both methods are used by various mail programs. - ## I assume most people are using newer mailers that have heard of flock. - ## Change this if you need to. - ## Debian contains a patch which says: ``On Debian/GNU/Linux systems, - ## configure gets the right answers, and that means *NOT* using flock. - ## Using flock is guaranteed to be the wrong thing. See Debian Policy - ## for details.'' and then uses `#ifdef DEBIAN'. Unfortunately the - ## Debian maintainer hasn't provided a clean fix for Emacs. - ## movemail.c will use `maillock' when MAILDIR, HAVE_LIBMAIL and - ## HAVE_MAILLOCK_H are defined, so the following appears to be the - ## correct logic. -- fx - ## We must check for HAVE_LIBLOCKFILE too, as movemail does. - ## liblockfile is a Free Software replacement for libmail, used on - ## Debian systems and elsewhere. -rfr. - gnu-*) - mail_lock="flock" - if test $have_mail = yes || test $have_lockfile = yes; then - test $ac_cv_header_maillock_h = yes && mail_lock=no - fi - ;; -esac - -BLESSMAIL_TARGET= -case "$mail_lock" in - flock) -$as_echo "#define MAIL_USE_FLOCK 1" >>confdefs.h - ;; - - lockf) -$as_echo "#define MAIL_USE_LOCKF 1" >>confdefs.h - ;; - - *) BLESSMAIL_TARGET="need-blessmail" ;; -esac - - - -for ac_func in gethostname \ -getrusage get_current_dir_name \ -lrand48 \ -select getpagesize setlocale \ -utimes getrlimit setrlimit shutdown getaddrinfo \ -strsignal setitimer \ -sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -gai_strerror mkstemp getline getdelim fsync sync \ -difftime posix_memalign \ -getpwent endpwent getgrent endgrent \ -touchlock \ -cfmakeraw cfsetspeed copysign __executable_start -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -## Eric Backus says, HP-UX 9.x on HP 700 machines -## has a broken `rint' in some library versions including math library -## version number A.09.05. -## You can fix the math library by installing patch number PHSS_4630. -## But we can fix it more reliably for Emacs by just not using rint. -## We also skip HAVE_RANDOM - see comments in src/conf_post.h. -case $opsys in - hpux*) : ;; - *) for ac_func in random rint -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - ;; -esac - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __builtin_unwind_init" >&5 -$as_echo_n "checking for __builtin_unwind_init... " >&6; } -if test "${emacs_cv_func___builtin_unwind_init+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -__builtin_unwind_init (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_func___builtin_unwind_init=yes -else - emacs_cv_func___builtin_unwind_init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func___builtin_unwind_init" >&5 -$as_echo "$emacs_cv_func___builtin_unwind_init" >&6; } -if test $emacs_cv_func___builtin_unwind_init = yes; then - -$as_echo "#define HAVE___BUILTIN_UNWIND_INIT 1" >>confdefs.h - -fi - - - - - -{ $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 -/* end confdefs.h. */ -#include /* for off_t */ - #include -int -main () -{ -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_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 -/* end confdefs.h. */ -#define _LARGEFILE_SOURCE 1 -#include /* for off_t */ - #include -int -main () -{ -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_sys_largefile_source=1; break -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - ac_cv_sys_largefile_source=unknown - break -done -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 - -fi - - -# UNIX98 PTYs. -for ac_func in grantpt -do : - ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt" -if test "x$ac_cv_func_grantpt" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GRANTPT 1 -_ACEOF - -fi -done - - -# PTY-related GNU extensions. -for ac_func in getpt posix_openpt -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -# Check this now, so that we will NOT find the above functions in ncurses. -# That is because we have not set up to link ncurses in lib-src. -# It's better to believe a function is not available -# than to expect to find it in ncurses. -# Also we need tputs and friends to be able to build at all. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5 -$as_echo_n "checking for library containing tputs... " >&6; } -# Run a test program that contains a call to tputs, a call that is -# never executed. This tests whether a pre-'main' dynamic linker -# works with the library. It's too much trouble to actually call -# tputs in the test program, due to portability hassles. When -# cross-compiling, assume the test program will run if it links. - -# Maybe curses should be tried earlier? -# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35 -for tputs_library in '' tinfo ncurses terminfo termcap curses; do - OLIBS=$LIBS - if test -z "$tputs_library"; then - LIBS_TERMCAP= - msg='none required' - else - LIBS_TERMCAP=-l$tputs_library - msg=$LIBS_TERMCAP - LIBS="$LIBS_TERMCAP $LIBS" - fi - if test "$cross_compiling" = yes; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - extern void tputs (const char *, int, int (*)(int)); - int main (int argc, char **argv) - { - if (argc == 10000) - tputs (argv[0], 0, 0); - return 0; - } - -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - -else - msg=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - extern void tputs (const char *, int, int (*)(int)); - int main (int argc, char **argv) - { - if (argc == 10000) - tputs (argv[0], 0, 0); - return 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -else - msg=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - LIBS=$OLIBS - if test "X$msg" != Xno; then - break - fi -done -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $msg" >&5 -$as_echo "$msg" >&6; } -if test "X$msg" = Xno; then - as_fn_error "The required function \`tputs' was not found in any library. -The following libraries were tried (in order): - libtinfo, libncurses, libterminfo, libtermcap, libcurses -Please try installing whichever of these libraries is most appropriate -for your system, together with its header files. -For example, a libncurses-dev(el) or similar package." "$LINENO" 5 -fi - -## Use termcap instead of terminfo? -## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500. -TERMINFO=yes -## FIXME? In the cases below where we unconditionally set -## LIBS_TERMCAP="-lncurses", this overrides LIBS_TERMCAP = -ltinfo, -## if that was found above to have tputs. -## Should we use the gnu* logic everywhere? -case "$opsys" in - ## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2. - ## The ncurses library has been moved out of the System framework in - ## Mac OS X 10.2. So if configure detects it, set the command-line - ## option to use it. - darwin) LIBS_TERMCAP="-lncurses" ;; - - gnu*) test -z "$LIBS_TERMCAP" && LIBS_TERMCAP="-lncurses" ;; - - freebsd) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5 -$as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; } - if test "${emacs_cv_freebsd_terminfo+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -#if __FreeBSD_version < 400000 -fail; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_freebsd_terminfo=yes -else - emacs_cv_freebsd_terminfo=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_freebsd_terminfo" >&5 -$as_echo "$emacs_cv_freebsd_terminfo" >&6; } - - if test $emacs_cv_freebsd_terminfo = yes; then - LIBS_TERMCAP="-lncurses" - else - TERMINFO=no - LIBS_TERMCAP="-ltermcap" - fi - ;; - - netbsd) - if test "x$LIBS_TERMCAP" != "x-lterminfo"; then - TERMINFO=no - LIBS_TERMCAP="-ltermcap" - fi - ;; - - openbsd) LIBS_TERMCAP="-lncurses" ;; - - ## hpux: Make sure we get select from libc rather than from libcurses - ## because libcurses on HPUX 10.10 has a broken version of select. - ## We used to use -lc -lcurses, but this may be cleaner. - ## FIXME? But TERMINFO = yes on hpux (it used to be explicitly - # set that way, now it uses the default). Isn't this a contradiction? - hpux*) LIBS_TERMCAP="-ltermcap" ;; - -esac - -TERMCAP_OBJ=tparam.o -if test $TERMINFO = yes; then - -$as_echo "#define TERMINFO 1" >>confdefs.h - - TERMCAP_OBJ=terminfo.o -fi - - - - -# Do we have res_init, for detecting changes in /etc/resolv.conf? -# On Darwin, res_init appears not to be useful: see bug#562 and -# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html -resolv=no - -if test $opsys != darwin; then - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -int -main () -{ -return res_init(); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - have_res_init=yes -else - have_res_init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "$have_res_init" = no; then - OLIBS="$LIBS" - LIBS="$LIBS -lresolv" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_init with -lresolv" >&5 -$as_echo_n "checking for res_init with -lresolv... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -int -main () -{ -return res_init(); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - have_res_init=yes -else - have_res_init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_res_init" >&5 -$as_echo "$have_res_init" >&6; } - if test "$have_res_init" = yes ; then - resolv=yes - fi - LIBS="$OLIBS" - fi - - if test "$have_res_init" = yes; then - -$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h - - fi -fi -# Do we need the Hesiod library to provide the support routines? -LIBHESIOD= -if test "$with_hesiod" != no ; then - # Don't set $LIBS here -- see comments above. FIXME which comments? - ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send" -if test "x$ac_cv_func_res_send" = x""yes; then : - -else - ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send" -if test "x$ac_cv_func___res_send" = x""yes; then : - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5 -$as_echo_n "checking for res_send in -lresolv... " >&6; } -if test "${ac_cv_lib_resolv_res_send+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lresolv $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 res_send (); -int -main () -{ -return res_send (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_resolv_res_send=yes -else - ac_cv_lib_resolv_res_send=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_resolv_res_send" >&5 -$as_echo "$ac_cv_lib_resolv_res_send" >&6; } -if test "x$ac_cv_lib_resolv_res_send" = x""yes; then : - resolv=yes -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5 -$as_echo_n "checking for __res_send in -lresolv... " >&6; } -if test "${ac_cv_lib_resolv___res_send+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lresolv $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 __res_send (); -int -main () -{ -return __res_send (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_resolv___res_send=yes -else - ac_cv_lib_resolv___res_send=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_resolv___res_send" >&5 -$as_echo "$ac_cv_lib_resolv___res_send" >&6; } -if test "x$ac_cv_lib_resolv___res_send" = x""yes; then : - resolv=yes -fi - -fi - -fi - -fi - - if test "$resolv" = yes ; then - RESOLVLIB=-lresolv - else - RESOLVLIB= - fi - ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost" -if test "x$ac_cv_func_hes_getmailhost" = x""yes; then : - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5 -$as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; } -if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lhesiod $RESOLVLIB $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 hes_getmailhost (); -int -main () -{ -return hes_getmailhost (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_hesiod_hes_getmailhost=yes -else - ac_cv_lib_hesiod_hes_getmailhost=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_hesiod_hes_getmailhost" >&5 -$as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; } -if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then : - hesiod=yes -else - : -fi - -fi - - - if test x"$hesiod" = xyes; then - -$as_echo "#define HAVE_LIBHESIOD 1" >>confdefs.h - - LIBHESIOD=-lhesiod - fi -fi - - -# Do we need libresolv (due to res_init or Hesiod)? -if test "$resolv" = yes && test $opsys != darwin; then - -$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h - - LIBRESOLV=-lresolv -else - LIBRESOLV= -fi - - -# These tell us which Kerberos-related libraries to use. -COM_ERRLIB= -CRYPTOLIB= -KRB5LIB= -DESLIB= -KRB4LIB= - -if test "${with_kerberos}" != no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5 -$as_echo_n "checking for com_err in -lcom_err... " >&6; } -if test "${ac_cv_lib_com_err_com_err+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lcom_err $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 com_err (); -int -main () -{ -return com_err (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_com_err_com_err=yes -else - ac_cv_lib_com_err_com_err=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_com_err_com_err" >&5 -$as_echo "$ac_cv_lib_com_err_com_err" >&6; } -if test "x$ac_cv_lib_com_err_com_err" = x""yes; then : - have_com_err=yes -else - have_com_err=no -fi - - if test $have_com_err = yes; then - COM_ERRLIB=-lcom_err - LIBS="$COM_ERRLIB $LIBS" - -$as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h - - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5 -$as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; } -if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lcrypto $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 mit_des_cbc_encrypt (); -int -main () -{ -return mit_des_cbc_encrypt (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_crypto_mit_des_cbc_encrypt=yes -else - ac_cv_lib_crypto_mit_des_cbc_encrypt=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_crypto_mit_des_cbc_encrypt" >&5 -$as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then : - have_crypto=yes -else - have_crypto=no -fi - - if test $have_crypto = yes; then - CRYPTOLIB=-lcrypto - LIBS="$CRYPTOLIB $LIBS" - -$as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h - - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5 -$as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; } -if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lk5crypto $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 mit_des_cbc_encrypt (); -int -main () -{ -return mit_des_cbc_encrypt (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_k5crypto_mit_des_cbc_encrypt=yes -else - ac_cv_lib_k5crypto_mit_des_cbc_encrypt=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_k5crypto_mit_des_cbc_encrypt" >&5 -$as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then : - have_k5crypto=yes -else - have_k5crypto=no -fi - - if test $have_k5crypto = yes; then - CRYPTOLIB=-lk5crypto - LIBS="$CRYPTOLIB $LIBS" - -$as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h - - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5 -$as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; } -if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkrb5 $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 krb5_init_context (); -int -main () -{ -return krb5_init_context (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_krb5_krb5_init_context=yes -else - ac_cv_lib_krb5_krb5_init_context=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_krb5_krb5_init_context" >&5 -$as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; } -if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then : - have_krb5=yes -else - have_krb5=no -fi - - if test $have_krb5=yes; then - KRB5LIB=-lkrb5 - LIBS="$KRB5LIB $LIBS" - -$as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h - - fi - if test "${with_kerberos5}" = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5 -$as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; } -if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldes425 $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 des_cbc_encrypt (); -int -main () -{ -return des_cbc_encrypt (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_des425_des_cbc_encrypt=yes -else - ac_cv_lib_des425_des_cbc_encrypt=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_des425_des_cbc_encrypt" >&5 -$as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then : - have_des425=yes -else - have_des425=no -fi - - if test $have_des425 = yes; then - DESLIB=-ldes425 - LIBS="$DESLIB $LIBS" - -$as_echo "#define HAVE_LIBDES425 1" >>confdefs.h - - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5 -$as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; } -if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldes $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 des_cbc_encrypt (); -int -main () -{ -return des_cbc_encrypt (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_des_des_cbc_encrypt=yes -else - ac_cv_lib_des_des_cbc_encrypt=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_des_des_cbc_encrypt" >&5 -$as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then : - have_des=yes -else - have_des=no -fi - - if test $have_des = yes; then - DESLIB=-ldes - LIBS="$DESLIB $LIBS" - -$as_echo "#define HAVE_LIBDES 1" >>confdefs.h - - fi - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5 -$as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; } -if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkrb4 $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 krb_get_cred (); -int -main () -{ -return krb_get_cred (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_krb4_krb_get_cred=yes -else - ac_cv_lib_krb4_krb_get_cred=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_krb4_krb_get_cred" >&5 -$as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then : - have_krb4=yes -else - have_krb4=no -fi - - if test $have_krb4 = yes; then - KRB4LIB=-lkrb4 - LIBS="$KRB4LIB $LIBS" - -$as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h - - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5 -$as_echo_n "checking for krb_get_cred in -lkrb... " >&6; } -if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkrb $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 krb_get_cred (); -int -main () -{ -return krb_get_cred (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_krb_krb_get_cred=yes -else - ac_cv_lib_krb_krb_get_cred=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_krb_krb_get_cred" >&5 -$as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then : - have_krb=yes -else - have_krb=no -fi - - if test $have_krb = yes; then - KRB4LIB=-lkrb - LIBS="$KRB4LIB $LIBS" - -$as_echo "#define HAVE_LIBKRB 1" >>confdefs.h - - fi - fi - fi - - if test "${with_kerberos5}" != no; then - for ac_header in krb5.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default" -if test "x$ac_cv_header_krb5_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KRB5_H 1 -_ACEOF - ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include -" -if test "x$ac_cv_member_krb5_error_text" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_KRB5_ERROR_TEXT 1 -_ACEOF - - -fi -ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include -" -if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_KRB5_ERROR_E_TEXT 1 -_ACEOF - - -fi - -fi - -done - - else - for ac_header in des.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default" -if test "x$ac_cv_header_des_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_DES_H 1 -_ACEOF - -else - for ac_header in kerberosIV/des.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KERBEROSIV_DES_H 1 -_ACEOF - -else - for ac_header in kerberos/des.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_des_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KERBEROS_DES_H 1 -_ACEOF - -fi - -done - -fi - -done - -fi - -done - - for ac_header in krb.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_krb_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KRB_H 1 -_ACEOF - -else - for ac_header in kerberosIV/krb.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KERBEROSIV_KRB_H 1 -_ACEOF - -else - for ac_header in kerberos/krb.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_KERBEROS_KRB_H 1 -_ACEOF - -fi - -done - -fi - -done - -fi - -done - - fi - for ac_header in com_err.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default" -if test "x$ac_cv_header_com_err_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_COM_ERR_H 1 -_ACEOF - -fi - -done - -fi - - - - - - - - - - - for ac_func in $ac_func_list -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5 -$as_echo_n "checking whether localtime caches TZ... " >&6; } -if test "${emacs_cv_localtime_cache+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test x$ac_cv_func_tzset = xyes; then -if test "$cross_compiling" = yes; then : - # If we have tzset, assume the worst when cross-compiling. -emacs_cv_localtime_cache=yes -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -char TZ_GMT0[] = "TZ=GMT0"; -char TZ_PST8[] = "TZ=PST8"; -main() -{ - time_t now = time ((time_t *) 0); - int hour_GMT0, hour_unset; - if (putenv (TZ_GMT0) != 0) - exit (1); - hour_GMT0 = localtime (&now)->tm_hour; - unsetenv("TZ"); - hour_unset = localtime (&now)->tm_hour; - if (putenv (TZ_PST8) != 0) - exit (1); - if (localtime (&now)->tm_hour == hour_GMT0) - exit (1); - unsetenv("TZ"); - if (localtime (&now)->tm_hour != hour_unset) - exit (1); - exit (0); -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - emacs_cv_localtime_cache=no -else - emacs_cv_localtime_cache=yes -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -else - # If we lack tzset, report that localtime does not cache TZ, - # since we can't invalidate the cache if we don't have tzset. - emacs_cv_localtime_cache=no -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_localtime_cache" >&5 -$as_echo "$emacs_cv_localtime_cache" >&6; } -if test $emacs_cv_localtime_cache = yes; then - -$as_echo "#define LOCALTIME_CACHE 1" >>confdefs.h - -fi - -ok_so_far=yes -ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket" -if test "x$ac_cv_func_socket" = x""yes; then : - -else - ok_so_far=no -fi - -if test $ok_so_far = yes; then - ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default" -if test "x$ac_cv_header_netinet_in_h" = x""yes; then : - -else - ok_so_far=no -fi - - -fi -if test $ok_so_far = yes; then - ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default" -if test "x$ac_cv_header_arpa_inet_h" = x""yes; then : - -else - ok_so_far=no -fi - - -fi -if test $ok_so_far = yes; then - -$as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h - -fi - -if test -f /usr/lpp/X11/bin/smt.exp; then - -$as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h - -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system supports dynamic ptys" >&5 -$as_echo_n "checking whether system supports dynamic ptys... " >&6; } -if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - -$as_echo "#define HAVE_DEV_PTMX 1" >>confdefs.h - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - -case $canonical in - *-solaris2.4 | *-solaris2.4.*) - : ${ac_cv_func_vfork_works=no};; -esac - -ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" -if test "x$ac_cv_type_pid_t" = x""yes; then : - -else - -cat >>confdefs.h <<_ACEOF -#define pid_t int -_ACEOF - -fi - -for ac_header in vfork.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default" -if test "x$ac_cv_header_vfork_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_VFORK_H 1 -_ACEOF - -fi - -done - -for ac_func in fork vfork -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - -if test "x$ac_cv_func_fork" = xyes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5 -$as_echo_n "checking for working fork... " >&6; } -if test "${ac_cv_func_fork_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_func_fork_works=cross -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* By Ruediger Kuhlmann. */ - return fork () < 0; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_fork_works=yes -else - ac_cv_func_fork_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_fork_works" >&5 -$as_echo "$ac_cv_func_fork_works" >&6; } - -else - ac_cv_func_fork_works=$ac_cv_func_fork -fi -if test "x$ac_cv_func_fork_works" = xcross; then - case $host in - *-*-amigaos* | *-*-msdosdjgpp*) - # Override, as these systems have only a dummy fork() stub - ac_cv_func_fork_works=no - ;; - *) - ac_cv_func_fork_works=yes - ;; - esac - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5 -$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;} -fi -ac_cv_func_vfork_works=$ac_cv_func_vfork -if test "x$ac_cv_func_vfork" = xyes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5 -$as_echo_n "checking for working vfork... " >&6; } -if test "${ac_cv_func_vfork_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_func_vfork_works=cross -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Thanks to Paul Eggert for this test. */ -$ac_includes_default -#include -#ifdef HAVE_VFORK_H -# include -#endif -/* On some sparc systems, changes by the child to local and incoming - argument registers are propagated back to the parent. The compiler - is told about this with #include , but some compilers - (e.g. gcc -O) don't grok . Test for this by using a - static variable whose address is put into a register that is - clobbered by the vfork. */ -static void -#ifdef __cplusplus -sparc_address_test (int arg) -# else -sparc_address_test (arg) int arg; -#endif -{ - static pid_t child; - if (!child) { - child = vfork (); - if (child < 0) { - perror ("vfork"); - _exit(2); - } - if (!child) { - arg = getpid(); - write(-1, "", 0); - _exit (arg); - } - } -} - -int -main () -{ - pid_t parent = getpid (); - pid_t child; - - sparc_address_test (0); - - child = vfork (); - - if (child == 0) { - /* Here is another test for sparc vfork register problems. This - test uses lots of local variables, at least as many local - variables as main has allocated so far including compiler - temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris - 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should - reuse the register of parent for one of the local variables, - since it will think that parent can't possibly be used any more - in this routine. Assigning to the local variable will thus - munge parent in the parent process. */ - pid_t - p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(), - p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid(); - /* Convince the compiler that p..p7 are live; otherwise, it might - use the same hardware register for all 8 local variables. */ - if (p != p1 || p != p2 || p != p3 || p != p4 - || p != p5 || p != p6 || p != p7) - _exit(1); - - /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent - from child file descriptors. If the child closes a descriptor - before it execs or exits, this munges the parent's descriptor - as well. Test for this by closing stdout in the child. */ - _exit(close(fileno(stdout)) != 0); - } else { - int status; - struct stat st; - - while (wait(&status) != child) - ; - return ( - /* Was there some problem with vforking? */ - child < 0 - - /* Did the child fail? (This shouldn't happen.) */ - || status - - /* Did the vfork/compiler bug occur? */ - || parent != getpid() - - /* Did the file descriptor bug occur? */ - || fstat(fileno(stdout), &st) != 0 - ); - } -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_vfork_works=yes -else - ac_cv_func_vfork_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_vfork_works" >&5 -$as_echo "$ac_cv_func_vfork_works" >&6; } - -fi; -if test "x$ac_cv_func_fork_works" = xcross; then - ac_cv_func_vfork_works=$ac_cv_func_vfork - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5 -$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;} -fi - -if test "x$ac_cv_func_vfork_works" = xyes; then - -$as_echo "#define HAVE_WORKING_VFORK 1" >>confdefs.h - -else - -$as_echo "#define vfork fork" >>confdefs.h - -fi -if test "x$ac_cv_func_fork_works" = xyes; then - -$as_echo "#define HAVE_WORKING_FORK 1" >>confdefs.h - -fi - - -for ac_func in snprintf -do : - ac_fn_c_check_func "$LINENO" "snprintf" "ac_cv_func_snprintf" -if test "x$ac_cv_func_snprintf" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SNPRINTF 1 -_ACEOF - -fi -done - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 -$as_echo_n "checking for nl_langinfo and CODESET... " >&6; } -if test "${emacs_cv_langinfo_codeset+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -char* cs = nl_langinfo(CODESET); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_langinfo_codeset=yes -else - emacs_cv_langinfo_codeset=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_langinfo_codeset" >&5 -$as_echo "$emacs_cv_langinfo_codeset" >&6; } -if test $emacs_cv_langinfo_codeset = yes; then - -$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h - -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5 -$as_echo_n "checking for mbstate_t... " >&6; } -if test "${ac_cv_type_mbstate_t+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -# include -int -main () -{ -mbstate_t x; return sizeof x; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_type_mbstate_t=yes -else - ac_cv_type_mbstate_t=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_mbstate_t" >&5 -$as_echo "$ac_cv_type_mbstate_t" >&6; } - if test $ac_cv_type_mbstate_t = yes; then - -$as_echo "#define HAVE_MBSTATE_T 1" >>confdefs.h - - else - -$as_echo "#define mbstate_t int" >>confdefs.h - - fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5 -$as_echo_n "checking for C restricted array declarations... " >&6; } -if test "${emacs_cv_c_restrict_arr+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -void fred (int x[__restrict]); -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_c_restrict_arr=yes -else - emacs_cv_c_restrict_arr=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_c_restrict_arr" >&5 -$as_echo "$emacs_cv_c_restrict_arr" >&6; } -if test "$emacs_cv_c_restrict_arr" = yes; then - -$as_echo "#define __restrict_arr __restrict" >>confdefs.h - -fi - - - -$as_echo "#define AMPERSAND_FULL_NAME 1" >>confdefs.h - - - -$as_echo "#define CLASH_DETECTION 1" >>confdefs.h - - -## Note: PTYs are broken on darwin <6. Use at your own risk. - -$as_echo "#define HAVE_PTYS 1" >>confdefs.h - - - -$as_echo "#define HAVE_SOCKETS 1" >>confdefs.h - - - - - -$as_echo "#define NULL_DEVICE \"/dev/null\"" >>confdefs.h - - - -$as_echo "#define SEPCHAR ':'" >>confdefs.h - - - -$as_echo "#define subprocesses 1" >>confdefs.h - - - -$as_echo "#define USER_FULL_NAME pw->pw_gecos" >>confdefs.h - - - - -$as_echo "#define DIRECTORY_SEP '/'" >>confdefs.h - - - - - -$as_echo "#define IS_DEVICE_SEP(_c_) 0" >>confdefs.h - - - -$as_echo "#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)" >>confdefs.h - - - -$as_echo "#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))" >>confdefs.h - - - - - -case $opsys in - aix4-2) - if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then - $as_echo "#define NO_EDITRES 1" >>confdefs.h - - fi - ;; - - hpux*) - $as_echo "#define NO_EDITRES 1" >>confdefs.h - - ;; -esac - - -case $opsys in - irix6-5 | sol2* | unixware ) - -$as_echo "#define NSIG_MINIMUM 32" >>confdefs.h - - ;; -esac - -emacs_broken_SIGIO=no - -case $opsys in - hpux* | irix6-5 | openbsd | sol2* | unixware ) - emacs_broken_SIGIO=yes - ;; - - aix4-2) - -$as_echo "#define BROKEN_GET_CURRENT_DIR_NAME 1" >>confdefs.h - - ;; - - freebsd) - -$as_echo "#define BROKEN_PTY_READ_AFTER_EAGAIN 1" >>confdefs.h - - ;; -esac - -case $opsys in - gnu-* | sol2-10 ) - -$as_echo "#define HAVE_PROCFS 1" >>confdefs.h - - ;; -esac - -case $opsys in - darwin | freebsd | netbsd | openbsd ) - -$as_echo "#define DONT_REOPEN_PTY 1" >>confdefs.h - - ;; -esac - -case $opsys in - netbsd | openbsd) sound_device="/dev/audio" ;; - *) sound_device="/dev/dsp" ;; -esac - - -cat >>confdefs.h <<_ACEOF -#define DEFAULT_SOUND_DEVICE "$sound_device" -_ACEOF - - - -case $opsys in - darwin | gnu-linux | gnu-kfreebsd ) - -$as_echo "#define INTERRUPT_INPUT 1" >>confdefs.h - - ;; -esac - - -case $opsys in - cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd) - -$as_echo "#define NARROWPROTO 1" >>confdefs.h - - ;; -esac - - - - - - - - -case $opsys in - aix4-2 ) - $as_echo "#define PTY_ITERATION int c; for (c = 0; !c ; c++)" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptc\");" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd));" >>confdefs.h - - ;; - - cygwin ) - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - - $as_echo "#define PTY_OPEN do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h - - ;; - - darwin ) - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - - $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - - $as_echo "#define PTY_OPEN do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h - - ;; - - gnu | openbsd ) - $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - - ;; - - gnu-linux | gnu-kfreebsd | freebsd | netbsd ) - if test "x$ac_cv_func_grantpt" = xyes; then - -$as_echo "#define UNIX98_PTYS 1" >>confdefs.h - - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h - - if test "x$ac_cv_func_posix_openpt" = xyes; then - $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_NOCTTY)" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - - elif test "x$ac_cv_func_getpt" = xyes; then - $as_echo "#define PTY_OPEN fd = getpt ()" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - - else - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h - - fi - else - $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - - fi - ;; - - hpux*) - $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF sprintf (pty_name, \"/dev/ptym/pty%c%x\", c, i);" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF sprintf (pty_name, \"/dev/pty/tty%c%x\", c, i);" >>confdefs.h - - ;; - - irix6-5 ) - $as_echo "#define PTY_ITERATION /**/" >>confdefs.h - - $as_echo "#define FIRST_PTY_LETTER 'q'" >>confdefs.h - - $as_echo "#define PTY_OPEN { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCHLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCHLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - - $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h - - ;; - - sol2* ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h - - ;; - - unixware ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal(\"could not grant slave pty\"); if (unlockpt(fd) == -1) fatal(\"could not unlock slave pty\"); if (!(ptyname = ptsname(fd))) fatal (\"could not enable slave pty\"); snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h - - ;; -esac - - -case $opsys in - sol2* | unixware ) - $as_echo "#define FIRST_PTY_LETTER 'z'" >>confdefs.h - - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h - - -$as_echo "#define SETUP_SLAVE_PTY if (ioctl (xforkin, I_PUSH, \"ptem\") == -1) fatal (\"ioctl I_PUSH ptem\"); if (ioctl (xforkin, I_PUSH, \"ldterm\") == -1) fatal (\"ioctl I_PUSH ldterm\"); if (ioctl (xforkin, I_PUSH, \"ttcompat\") == -1) fatal (\"ioctl I_PUSH ttcompat\");" >>confdefs.h - - ;; -esac - - - - -case $opsys in - aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd | darwin ) - $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h - - ;; - - gnu-linux | gnu-kfreebsd ) - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signals via characters" >&5 -$as_echo_n "checking for signals via characters... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#if LINUX_VERSION_CODE < 0x20400 -# error "Linux version too old" -#endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - emacs_signals_via_chars=yes -else - emacs_signals_via_chars=no -fi -rm -f conftest.err conftest.$ac_ext - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_signals_via_chars" >&5 -$as_echo "$emacs_signals_via_chars" >&6; } - test $emacs_signals_via_chars = yes && $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h - - ;; -esac - - - - -case $opsys in - aix*) - $as_echo "#define DATA_SEG_BITS 0x20000000" >>confdefs.h - - ;; - hpux*) - $as_echo "#define DATA_SEG_BITS 0x40000000" >>confdefs.h - - ;; - irix6-5) - $as_echo "#define DATA_SEG_BITS 0x10000000" >>confdefs.h - - ;; -esac - - - - -case $opsys in - darwin) $as_echo "#define TAB3 OXTABS" >>confdefs.h - ;; - - gnu | freebsd | netbsd | openbsd ) - -$as_echo "#define TABDLY OXTABS" >>confdefs.h - - $as_echo "#define TAB3 OXTABS" >>confdefs.h - - ;; - - gnu-linux | gnu-kfreebsd ) - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifndef __ia64__ -# error "not ia64" -#endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -$as_echo "#define GC_MARK_SECONDARY_STACK() do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)" >>confdefs.h - -fi -rm -f conftest.err conftest.$ac_ext - ;; - - hpux*) - -$as_echo "#define RUN_TIME_REMAP 1" >>confdefs.h - - ;; -esac - - - - - -case $opsys in - gnu-linux | gnu-kfreebsd ) - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#if defined __i386__ || defined __sparc__ || defined __mc68000__ \ - || defined __alpha__ || defined __mips__ || defined __s390__ \ - || defined __arm__ || defined __powerpc__ || defined __amd64__ \ - || defined __ia64__ || defined __sh__ -/* ok */ -#else -# error "setjmp not known to work on this arch" -#endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h - -fi -rm -f conftest.err conftest.$ac_ext - ;; -esac - - -if test x$GCC = xyes; then - $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h - -else - case $opsys in - freebsd | netbsd | openbsd | irix6-5 | sol2* ) - $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h - - ;; - esac -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _setjmp" >&5 -$as_echo_n "checking for _setjmp... " >&6; } -if test "${emacs_cv_func__setjmp+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -jmp_buf j; - if (! _setjmp (j)) - _longjmp (j, 1); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_func__setjmp=yes -else - emacs_cv_func__setjmp=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func__setjmp" >&5 -$as_echo "$emacs_cv_func__setjmp" >&6; } -if test $emacs_cv_func__setjmp = yes; then - -$as_echo "#define HAVE__SETJMP 1" >>confdefs.h - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigsetjmp" >&5 -$as_echo_n "checking for sigsetjmp... " >&6; } -if test "${emacs_cv_func_sigsetjmp+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -sigjmp_buf j; - if (! sigsetjmp (j, 1)) - siglongjmp (j, 1); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - emacs_cv_func_sigsetjmp=yes -else - emacs_cv_func_sigsetjmp=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func_sigsetjmp" >&5 -$as_echo "$emacs_cv_func_sigsetjmp" >&6; } - if test $emacs_cv_func_sigsetjmp = yes; then - -$as_echo "#define HAVE_SIGSETJMP 1" >>confdefs.h - - fi -fi - -case $opsys in - sol2* | unixware ) - -$as_echo "#define TIOCSIGSEND TIOCSIGNAL" >>confdefs.h - - ;; -esac - - -case $opsys in - hpux* | sol2* ) - -$as_echo "#define XOS_NEEDS_TIME_H 1" >>confdefs.h - - ;; -esac - - - - - - - - - -case $opsys in - aix4-2) - $as_echo "#define USG /**/" >>confdefs.h - - $as_echo "#define USG5 /**/" >>confdefs.h - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifndef _AIX -# error "_AIX not defined" -#endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - -$as_echo "#define _AIX /**/" >>confdefs.h - -fi -rm -f conftest.err conftest.$ac_ext - ;; - - cygwin) - -$as_echo "#define CYGWIN 1" >>confdefs.h - - ;; - - darwin) - $as_echo "#define BSD_SYSTEM /**/" >>confdefs.h - - -$as_echo "#define DARWIN_OS /**/" >>confdefs.h - - ;; - - freebsd) - -$as_echo "#define BSD_SYSTEM_AHB 1" >>confdefs.h - - ;; - - gnu | netbsd | openbsd ) - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifndef BSD_SYSTEM -# error "BSD_SYSTEM not defined" -#endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - $as_echo "#define BSD_SYSTEM 43" >>confdefs.h - -fi -rm -f conftest.err conftest.$ac_ext - ;; - - gnu-linux | gnu-kfreebsd ) - $as_echo "#define USG /**/" >>confdefs.h - - -$as_echo "#define GNU_LINUX /**/" >>confdefs.h - - ;; - - hpux*) - $as_echo "#define USG /**/" >>confdefs.h - - $as_echo "#define USG5 /**/" >>confdefs.h - - -$as_echo "#define HPUX /**/" >>confdefs.h - - ;; - - irix6-5) - $as_echo "#define USG /**/" >>confdefs.h - - $as_echo "#define USG5 /**/" >>confdefs.h - - $as_echo "#define USG5_4 /**/" >>confdefs.h - - -$as_echo "#define IRIX6_5 /**/" >>confdefs.h - - ;; - - sol2*) - $as_echo "#define USG /**/" >>confdefs.h - - $as_echo "#define USG5 /**/" >>confdefs.h - - $as_echo "#define USG5_4 /**/" >>confdefs.h - - -$as_echo "#define SOLARIS2 /**/" >>confdefs.h - - ;; - - unixware) - $as_echo "#define USG /**/" >>confdefs.h - - $as_echo "#define USG5 /**/" >>confdefs.h - - $as_echo "#define USG5_4 /**/" >>confdefs.h - - ;; -esac - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable FIONREAD" >&5 -$as_echo_n "checking for usable FIONREAD... " >&6; } -if test "${emacs_cv_usable_FIONREAD+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - case $opsys in - aix4-2) - emacs_cv_usable_FIONREAD=no - ;; - - *) - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - #ifdef USG5_4 - # include - #endif - -int -main () -{ -int foo = ioctl (0, FIONREAD, &foo); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_usable_FIONREAD=yes -else - emacs_cv_usable_FIONREAD=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ;; - esac -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_FIONREAD" >&5 -$as_echo "$emacs_cv_usable_FIONREAD" >&6; } -if test $emacs_cv_usable_FIONREAD = yes; then - -$as_echo "#define USABLE_FIONREAD 1" >>confdefs.h - - - if test $emacs_broken_SIGIO = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable SIGIO" >&5 -$as_echo_n "checking for usable SIGIO... " >&6; } -if test "${emacs_cv_usable_SIGIO+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -int foo = SIGIO | F_SETFL | FASYNC; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - emacs_cv_usable_SIGIO=yes -else - emacs_cv_usable_SIGIO=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_SIGIO" >&5 -$as_echo "$emacs_cv_usable_SIGIO" >&6; } - if test $emacs_cv_usable_SIGIO = yes; then - -$as_echo "#define USABLE_SIGIO 1" >>confdefs.h - - fi - fi -fi - - -case $opsys in - cygwin) - -$as_echo "#define G_SLICE_ALWAYS_MALLOC 1" >>confdefs.h - - ;; - - hpux11) - -$as_echo "#define USG_SUBTTY_WORKS 1" >>confdefs.h - - ;; - - irix6-5) - -$as_echo "#define PREFER_VSUSP 1" >>confdefs.h - - ;; - - sol2-10) - -$as_echo "#define _STRUCTURED_PROC 1" >>confdefs.h - - ;; -esac - -# Set up the CFLAGS for real compilation, so we can substitute it. -CFLAGS="$REAL_CFLAGS" -CPPFLAGS="$REAL_CPPFLAGS" - -## Hack to detect a buggy GCC version. -if test "x$GCC" = xyes \ - && test x"`$CC --version 2> /dev/null | grep 'gcc.* 4.5.0'`" != x \ - && test x"`echo $CFLAGS | grep '\-O[23]'`" != x \ - && test x"`echo $CFLAGS | grep '\-fno-optimize-sibling-calls'`" = x; then - as_fn_error "GCC 4.5.0 has problems compiling Emacs; see etc/PROBLEMS'." "$LINENO" 5 -fi - -version=$PACKAGE_VERSION - -copyright="Copyright (C) 2013 Free Software Foundation, Inc." - -cat >>confdefs.h <<_ACEOF -#define COPYRIGHT "$copyright" -_ACEOF - - - -### Specify what sort of things we'll be editing into Makefile and config.h. -### Use configuration here uncanonicalized to avoid exceeding size limits. - - -## Unused? - - - - - - - - - - - - - - - - - - - - - - -## FIXME? Nothing uses @LD_SWITCH_X_SITE@. -## src/Makefile.in did add LD_SWITCH_X_SITE (as a cpp define) to the -## end of LIBX_BASE, but nothing ever set it. - - - - -## Used in lwlib/Makefile.in. - - - - - - - - -if test -n "${term_header}"; then - -cat >>confdefs.h <<_ACEOF -#define TERM_HEADER "${term_header}" -_ACEOF - -fi - - -cat >>confdefs.h <<_ACEOF -#define EMACS_CONFIGURATION "${canonical}" -_ACEOF - -emacs_config_options=`echo "$emacs_config_options " | sed -e 's/--no-create //' -e 's/--no-recursion //' -e 's/ *$//' -e "s/\"/'/g"` - -cat >>confdefs.h <<_ACEOF -#define EMACS_CONFIG_OPTIONS "${emacs_config_options}" -_ACEOF - - - -XMENU_OBJ= -XOBJ= -FONT_OBJ= -if test "${HAVE_X_WINDOWS}" = "yes" ; then - -$as_echo "#define HAVE_X_WINDOWS 1" >>confdefs.h - - XMENU_OBJ=xmenu.o - XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o" - FONT_OBJ=xfont.o - if test "$HAVE_XFT" = "yes"; then - FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o" - elif test "$HAVE_FREETYPE" = "yes"; then - FONT_OBJ="$FONT_OBJ ftfont.o ftxfont.o" - fi - -fi - - - - -WIDGET_OBJ= -MOTIF_LIBW= -if test "${USE_X_TOOLKIT}" != "none" ; then - WIDGET_OBJ=widget.o - -$as_echo "#define USE_X_TOOLKIT 1" >>confdefs.h - - if test "${USE_X_TOOLKIT}" = "LUCID"; then - -$as_echo "#define USE_LUCID 1" >>confdefs.h - - elif test "${USE_X_TOOLKIT}" = "MOTIF"; then - -$as_echo "#define USE_MOTIF 1" >>confdefs.h - - MOTIF_LIBW=-lXm - case "$opsys" in - gnu-linux) - ## Paul Abrahams says this is needed. - MOTIF_LIBW="$MOTIF_LIBW -lXpm" - ;; - - unixware) - ## Richard Anthony Ryan - ## says -lXimp is needed in UNIX_SV ... 4.2 1.1.2. - MOTIF_LIBW="MOTIF_LIBW -lXimp" - ;; - - aix4-2) - ## olson@mcs.anl.gov says -li18n is needed by -lXm. - MOTIF_LIBW="$MOTIF_LIBW -li18n" - ;; - esac - MOTIF_LIBW="$MOTIF_LIBW $LIBXP" - fi -fi - - -TOOLKIT_LIBW= -case "$USE_X_TOOLKIT" in - MOTIF) TOOLKIT_LIBW="$MOTIF_LIBW" ;; - LUCID) TOOLKIT_LIBW="$LUCID_LIBW" ;; - none) test "x$HAVE_GTK" = "xyes" && TOOLKIT_LIBW="$GTK_LIBS" ;; -esac - - -if test "$USE_X_TOOLKIT" = "none"; then - LIBXT_OTHER="\$(LIBXSM)" - OLDXMENU_TARGET="really-oldXMenu" -else - LIBXT_OTHER="\$(LIBXMU) -lXt \$(LIBXTR6) -lXext" - OLDXMENU_TARGET="really-lwlib" -fi - - -## The X Menu stuff is present in the X10 distribution, but missing -## from X11. If we have X10, just use the installed library; -## otherwise, use our own copy. -if test "${HAVE_X11}" = "yes" ; then - -$as_echo "#define HAVE_X11 1" >>confdefs.h - - - if test "$USE_X_TOOLKIT" = "none"; then - OLDXMENU="\${oldXMenudir}/libXMenu11.a" - else - OLDXMENU="\${lwlibdir}/liblw.a" - fi - LIBXMENU="\$(OLDXMENU)" - LIBX_OTHER="\$(LIBXT) \$(LIBX_EXTRA)" - OLDXMENU_DEPS="\${OLDXMENU} ../src/\${OLDXMENU}" -else - ## For a syntactically valid Makefile; not actually used for anything. - ## See comments in src/Makefile.in. - OLDXMENU=nothing - ## FIXME This case (!HAVE_X11 && HAVE_X_WINDOWS) is no longer possible(?). - if test "${HAVE_X_WINDOWS}" = "yes"; then - LIBXMENU="-lXMenu" - else - LIBXMENU= - fi - LIBX_OTHER= - OLDXMENU_DEPS= -fi - -if test "$HAVE_GTK" = "yes" || test "$HAVE_MENUS" != "yes"; then - OLDXMENU_TARGET= - OLDXMENU=nothing - LIBXMENU= - OLDXMENU_DEPS= -fi - - - - - - - -if test "${HAVE_MENUS}" = "yes" ; then - -$as_echo "#define HAVE_MENUS 1" >>confdefs.h - -fi - -if test "${GNU_MALLOC}" = "yes" ; then - -$as_echo "#define GNU_MALLOC 1" >>confdefs.h - -fi - -RALLOC_OBJ= -if test "${REL_ALLOC}" = "yes" ; then - -$as_echo "#define REL_ALLOC 1" >>confdefs.h - - - test "$system_malloc" != "yes" && RALLOC_OBJ=ralloc.o -fi - - -if test "$opsys" = "cygwin"; then - CYGWIN_OBJ="sheap.o cygw32.o" - ## Cygwin differs because of its unexec(). - PRE_ALLOC_OBJ= - POST_ALLOC_OBJ=lastfile.o -else - CYGWIN_OBJ= - PRE_ALLOC_OBJ=lastfile.o - POST_ALLOC_OBJ= -fi - - - - -# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently. -# it temporarily reverts them to their pre-pkg-config values, -# because gnulib needs to work with both src (which uses the -# pkg-config stuff) and lib-src (which does not). For example, gnulib -# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt, -# and it therefore needs to run in an environment where LIBS does not -# already contain -lrt merely because 'pkg-config --libs' printed '-lrt' -# for some package unrelated to lib-src. -SAVE_CFLAGS=$CFLAGS -SAVE_LIBS=$LIBS -CFLAGS=$pre_PKG_CONFIG_CFLAGS -LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS" - - - - - - - - - - - - LIBC_FATAL_STDERR_=1 - export LIBC_FATAL_STDERR_ - -# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works -# for constant arguments. Useless! -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 -$as_echo_n "checking for working alloca.h... " >&6; } -if test "${ac_cv_working_alloca_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -char *p = (char *) alloca (2 * sizeof (int)); - if (p) return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_working_alloca_h=yes -else - ac_cv_working_alloca_h=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5 -$as_echo "$ac_cv_working_alloca_h" >&6; } -if test $ac_cv_working_alloca_h = yes; then - -$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h - -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 -$as_echo_n "checking for alloca... " >&6; } -if test "${ac_cv_func_alloca_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __GNUC__ -# define alloca __builtin_alloca -#else -# ifdef _MSC_VER -# include -# define alloca _alloca -# else -# ifdef HAVE_ALLOCA_H -# include -# else -# ifdef _AIX - #pragma alloca -# else -# ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); -# endif -# endif -# endif -# endif -#endif - -int -main () -{ -char *p = (char *) alloca (1); - if (p) return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_func_alloca_works=yes -else - ac_cv_func_alloca_works=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5 -$as_echo "$ac_cv_func_alloca_works" >&6; } - -if test $ac_cv_func_alloca_works = yes; then - -$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h - -else - # The SVR3 libPW and SVR4 libucb both contain incompatible functions -# that cause trouble. Some versions do not even contain alloca or -# contain a buggy version. If you still want to use their alloca, -# use ar to extract alloca.o from them instead of compiling alloca.c. - - - - - -ALLOCA=\${LIBOBJDIR}alloca.$ac_objext - -$as_echo "#define C_ALLOCA 1" >>confdefs.h - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether 'alloca.c' needs Cray hooks" >&5 -$as_echo_n "checking whether 'alloca.c' needs Cray hooks... " >&6; } -if test "${ac_cv_os_cray+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if defined CRAY && ! defined CRAY2 -webecray -#else -wenotbecray -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "webecray" >/dev/null 2>&1; then : - ac_cv_os_cray=yes -else - ac_cv_os_cray=no -fi -rm -f conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5 -$as_echo "$ac_cv_os_cray" >&6; } -if test $ac_cv_os_cray = yes; then - for ac_func in _getb67 GETB67 getb67; do - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define CRAY_STACKSEG_END $ac_func -_ACEOF - - break -fi - - done -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 -$as_echo_n "checking stack direction for C alloca... " >&6; } -if test "${ac_cv_c_stack_direction+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_c_stack_direction=0 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -find_stack_direction (int *addr, int depth) -{ - int dir, dummy = 0; - if (! addr) - addr = &dummy; - *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1; - dir = depth ? find_stack_direction (addr, depth - 1) : 0; - return dir + dummy; -} - -int -main (int argc, char **argv) -{ - return find_stack_direction (0, argc + !argv + 20) < 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_c_stack_direction=1 -else - ac_cv_c_stack_direction=-1 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5 -$as_echo "$ac_cv_c_stack_direction" >&6; } -cat >>confdefs.h <<_ACEOF -#define STACK_DIRECTION $ac_cv_c_stack_direction -_ACEOF - - -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; - -_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 - #include - -int -main () -{ -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ - && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ - && LITTLE_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -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 - #include - -int -main () -{ -#if BYTE_ORDER != BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -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_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -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 - -int -main () -{ -#ifndef _BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -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_ext -fi -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 -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* 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_run "$LINENO"; then : - ac_cv_c_bigendian=no -else - ac_cv_c_bigendian=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 -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 - - ;; #( - *) - as_fn_error "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; - esac - - - - GNULIB_CHDIR=0; - GNULIB_CHOWN=0; - GNULIB_CLOSE=0; - GNULIB_DUP=0; - GNULIB_DUP2=0; - GNULIB_DUP3=0; - GNULIB_ENVIRON=0; - GNULIB_EUIDACCESS=0; - GNULIB_FACCESSAT=0; - GNULIB_FCHDIR=0; - GNULIB_FCHOWNAT=0; - GNULIB_FDATASYNC=0; - GNULIB_FSYNC=0; - GNULIB_FTRUNCATE=0; - GNULIB_GETCWD=0; - GNULIB_GETDOMAINNAME=0; - GNULIB_GETDTABLESIZE=0; - GNULIB_GETGROUPS=0; - GNULIB_GETHOSTNAME=0; - GNULIB_GETLOGIN=0; - GNULIB_GETLOGIN_R=0; - GNULIB_GETPAGESIZE=0; - GNULIB_GETUSERSHELL=0; - GNULIB_GROUP_MEMBER=0; - GNULIB_ISATTY=0; - GNULIB_LCHOWN=0; - GNULIB_LINK=0; - GNULIB_LINKAT=0; - GNULIB_LSEEK=0; - GNULIB_PIPE=0; - GNULIB_PIPE2=0; - GNULIB_PREAD=0; - GNULIB_PWRITE=0; - GNULIB_READ=0; - GNULIB_READLINK=0; - GNULIB_READLINKAT=0; - GNULIB_RMDIR=0; - GNULIB_SETHOSTNAME=0; - GNULIB_SLEEP=0; - GNULIB_SYMLINK=0; - GNULIB_SYMLINKAT=0; - GNULIB_TTYNAME_R=0; - GNULIB_UNISTD_H_NONBLOCKING=0; - GNULIB_UNISTD_H_SIGPIPE=0; - GNULIB_UNLINK=0; - GNULIB_UNLINKAT=0; - GNULIB_USLEEP=0; - GNULIB_WRITE=0; - HAVE_CHOWN=1; - HAVE_DUP2=1; - HAVE_DUP3=1; - HAVE_EUIDACCESS=1; - HAVE_FACCESSAT=1; - HAVE_FCHDIR=1; - HAVE_FCHOWNAT=1; - HAVE_FDATASYNC=1; - HAVE_FSYNC=1; - HAVE_FTRUNCATE=1; - HAVE_GETDTABLESIZE=1; - HAVE_GETGROUPS=1; - HAVE_GETHOSTNAME=1; - HAVE_GETLOGIN=1; - HAVE_GETPAGESIZE=1; - HAVE_GROUP_MEMBER=1; - HAVE_LCHOWN=1; - HAVE_LINK=1; - HAVE_LINKAT=1; - HAVE_PIPE=1; - HAVE_PIPE2=1; - HAVE_PREAD=1; - HAVE_PWRITE=1; - HAVE_READLINK=1; - HAVE_READLINKAT=1; - HAVE_SETHOSTNAME=1; - HAVE_SLEEP=1; - HAVE_SYMLINK=1; - HAVE_SYMLINKAT=1; - HAVE_UNLINKAT=1; - HAVE_USLEEP=1; - HAVE_DECL_ENVIRON=1; - HAVE_DECL_FCHDIR=1; - HAVE_DECL_FDATASYNC=1; - HAVE_DECL_GETDOMAINNAME=1; - HAVE_DECL_GETLOGIN_R=1; - HAVE_DECL_GETPAGESIZE=1; - HAVE_DECL_GETUSERSHELL=1; - HAVE_DECL_SETHOSTNAME=1; - HAVE_DECL_TTYNAME_R=1; - HAVE_OS_H=0; - HAVE_SYS_PARAM_H=0; - REPLACE_CHOWN=0; - REPLACE_CLOSE=0; - REPLACE_DUP=0; - REPLACE_DUP2=0; - REPLACE_FCHOWNAT=0; - REPLACE_FTRUNCATE=0; - REPLACE_GETCWD=0; - REPLACE_GETDOMAINNAME=0; - REPLACE_GETLOGIN_R=0; - REPLACE_GETGROUPS=0; - REPLACE_GETPAGESIZE=0; - REPLACE_ISATTY=0; - REPLACE_LCHOWN=0; - REPLACE_LINK=0; - REPLACE_LINKAT=0; - REPLACE_LSEEK=0; - REPLACE_PREAD=0; - REPLACE_PWRITE=0; - REPLACE_READ=0; - REPLACE_READLINK=0; - REPLACE_RMDIR=0; - REPLACE_SLEEP=0; - REPLACE_SYMLINK=0; - REPLACE_TTYNAME_R=0; - REPLACE_UNLINK=0; - REPLACE_UNLINKAT=0; - REPLACE_USLEEP=0; - REPLACE_WRITE=0; - UNISTD_H_HAVE_WINSOCK2_H=0; - UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS=0; - - - - GNULIB_OPENDIR=0; - GNULIB_READDIR=0; - GNULIB_REWINDDIR=0; - GNULIB_CLOSEDIR=0; - GNULIB_DIRFD=0; - GNULIB_FDOPENDIR=0; - GNULIB_SCANDIR=0; - GNULIB_ALPHASORT=0; - HAVE_OPENDIR=1; - HAVE_READDIR=1; - HAVE_REWINDDIR=1; - HAVE_CLOSEDIR=1; - HAVE_DECL_DIRFD=1; - HAVE_DECL_FDOPENDIR=1; - HAVE_FDOPENDIR=1; - HAVE_SCANDIR=1; - HAVE_ALPHASORT=1; - REPLACE_OPENDIR=0; - REPLACE_CLOSEDIR=0; - REPLACE_DIRFD=0; - REPLACE_FDOPENDIR=0; - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 -$as_echo_n "checking whether the preprocessor supports include_next... " >&6; } -if test "${gl_cv_have_include_next+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - rm -rf conftestd1a conftestd1b conftestd2 - mkdir conftestd1a conftestd1b conftestd2 - cat < conftestd1a/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd1b/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd2/conftest.h -#ifndef DEFINED_IN_CONFTESTD1 -#error "include_next test doesn't work" -#endif -#define DEFINED_IN_CONFTESTD2 -EOF - gl_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=yes -else - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=buggy -else - gl_cv_have_include_next=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CPPFLAGS="$gl_save_CPPFLAGS" - rm -rf conftestd1a conftestd1b conftestd2 - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_have_include_next" >&5 -$as_echo "$gl_cv_have_include_next" >&6; } - PRAGMA_SYSTEM_HEADER= - if test $gl_cv_have_include_next = yes; then - INCLUDE_NEXT=include_next - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - if test -n "$GCC"; then - PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' - fi - else - if test $gl_cv_have_include_next = buggy; then - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - else - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include - fi - fi - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 -$as_echo_n "checking whether system header files limit the line length... " >&6; } -if test "${gl_cv_pragma_columns+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifdef __TANDEM -choke me -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "choke me" >/dev/null 2>&1; then : - gl_cv_pragma_columns=yes -else - gl_cv_pragma_columns=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_pragma_columns" >&5 -$as_echo "$gl_cv_pragma_columns" >&6; } - if test $gl_cv_pragma_columns = yes; then - PRAGMA_COLUMNS="#pragma COLUMNS 10000" - else - PRAGMA_COLUMNS= - fi - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtold conforms to C99" >&5 -$as_echo_n "checking whether strtold conforms to C99... " >&6; } -if test "${gl_cv_func_c99_strtold+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* On HP-UX before 11.23, strtold returns a struct instead of - long double. Reject implementations like that, by requiring - compatibility with the C99 prototype. */ - #include - static long double (*p) (char const *, char **) = strtold; - static long double - test (char const *nptr, char **endptr) - { - long double r; - r = strtold (nptr, endptr); - return r; - } -int -main () -{ -return test ("1.0", NULL) != 1 || p ("1.0", NULL) != 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - gl_cv_func_c99_strtold=yes -else - gl_cv_func_c99_strtold=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_c99_strtold" >&5 -$as_echo "$gl_cv_func_c99_strtold" >&6; } - if test $gl_cv_func_c99_strtold = yes; then - -$as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h - - fi - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if environ is properly declared" >&5 -$as_echo_n "checking if environ is properly declared... " >&6; } - if test "${gt_cv_var_environ_declaration+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if HAVE_UNISTD_H - #include - #endif - /* mingw, BeOS, Haiku declare environ in , not in . */ - #include - - extern struct { int foo; } environ; -int -main () -{ -environ.foo = 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gt_cv_var_environ_declaration=no -else - gt_cv_var_environ_declaration=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_var_environ_declaration" >&5 -$as_echo "$gt_cv_var_environ_declaration" >&6; } - if test $gt_cv_var_environ_declaration = yes; then - -$as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h - - fi - - - if test $gt_cv_var_environ_declaration != yes; then - HAVE_DECL_ENVIRON=0 - fi - - - - - - - - - - GNULIB_FCNTL=0; - GNULIB_NONBLOCKING=0; - GNULIB_OPEN=0; - GNULIB_OPENAT=0; - HAVE_FCNTL=1; - HAVE_OPENAT=1; - REPLACE_FCNTL=0; - REPLACE_OPEN=0; - REPLACE_OPENAT=0; - - -ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" -if test "x$ac_cv_type_mode_t" = x""yes; then : - -else - -cat >>confdefs.h <<_ACEOF -#define mode_t int -_ACEOF - -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 -#include -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_FCHMODAT=0; - GNULIB_FSTAT=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 lstat correctly handles trailing slash" >&5 -$as_echo_n "checking whether lstat correctly handles trailing slash... " >&6; } -if test "${gl_cv_func_lstat_dereferences_slashed_symlink+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - rm -f conftest.sym conftest.file - echo >conftest.file - if test "$as_ln_s" = "ln -s" && ln -s conftest.file conftest.sym; then - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -struct stat sbuf; - /* Linux will dereference the symlink and fail, as required by - POSIX. That is better in the sense that it means we will not - have to compile and use the lstat wrapper. */ - return lstat ("conftest.sym/", &sbuf) == 0; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_lstat_dereferences_slashed_symlink=yes -else - gl_cv_func_lstat_dereferences_slashed_symlink=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - else - # If the 'ln -s' command failed, then we probably don't even - # have an lstat function. - gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" - fi - rm -f conftest.sym conftest.file - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_lstat_dereferences_slashed_symlink" >&5 -$as_echo "$gl_cv_func_lstat_dereferences_slashed_symlink" >&6; } - case "$gl_cv_func_lstat_dereferences_slashed_symlink" in - *yes) - -cat >>confdefs.h <<_ACEOF -#define LSTAT_FOLLOWS_SLASHED_SYMLINK 1 -_ACEOF - - ;; - esac - - - - - 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_MBTOWC=0; - GNULIB_MKDTEMP=0; - GNULIB_MKOSTEMP=0; - GNULIB_MKOSTEMPS=0; - GNULIB_MKSTEMP=0; - GNULIB_MKSTEMPS=0; - GNULIB_POSIX_OPENPT=0; - GNULIB_PTSNAME=0; - GNULIB_PTSNAME_R=0; - GNULIB_PUTENV=0; - GNULIB_RANDOM=0; - GNULIB_RANDOM_R=0; - GNULIB_REALLOC_POSIX=0; - GNULIB_REALPATH=0; - GNULIB_RPMATCH=0; - GNULIB_SECURE_GETENV=0; - GNULIB_SETENV=0; - GNULIB_STRTOD=0; - GNULIB_STRTOLL=0; - GNULIB_STRTOULL=0; - GNULIB_SYSTEM_POSIX=0; - GNULIB_UNLOCKPT=0; - GNULIB_UNSETENV=0; - GNULIB_WCTOMB=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_POSIX_OPENPT=1; - HAVE_PTSNAME=1; - HAVE_PTSNAME_R=1; - HAVE_RANDOM=1; - HAVE_RANDOM_H=1; - HAVE_RANDOM_R=1; - HAVE_REALPATH=1; - HAVE_RPMATCH=1; - HAVE_SECURE_GETENV=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_MBTOWC=0; - REPLACE_MKSTEMP=0; - REPLACE_PTSNAME=0; - REPLACE_PTSNAME_R=0; - REPLACE_PUTENV=0; - REPLACE_RANDOM_R=0; - REPLACE_REALLOC=0; - REPLACE_REALPATH=0; - REPLACE_SETENV=0; - REPLACE_STRTOD=0; - REPLACE_UNSETENV=0; - REPLACE_WCTOMB=0; - - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_getopt_h='<'getopt.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_getopt_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_getopt_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'getopt.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_getopt_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_getopt_h='<'getopt.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_getopt_h" >&5 -$as_echo "$gl_cv_next_getopt_h" >&6; } - fi - NEXT_GETOPT_H=$gl_cv_next_getopt_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='<'getopt.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_getopt_h - fi - NEXT_AS_FIRST_DIRECTIVE_GETOPT_H=$gl_next_as_first_directive - - - - - if test $ac_cv_header_getopt_h = yes; then - HAVE_GETOPT_H=1 - else - HAVE_GETOPT_H=0 - fi - - - gl_replace_getopt= - - if test -z "$gl_replace_getopt" && test $gl_getopt_required = GNU; then - for ac_header in getopt.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "getopt.h" "ac_cv_header_getopt_h" "$ac_includes_default" -if test "x$ac_cv_header_getopt_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETOPT_H 1 -_ACEOF - -else - gl_replace_getopt=yes -fi - -done - - fi - - if test -z "$gl_replace_getopt" && test $gl_getopt_required = GNU; then - for ac_func in getopt_long_only -do : - ac_fn_c_check_func "$LINENO" "getopt_long_only" "ac_cv_func_getopt_long_only" -if test "x$ac_cv_func_getopt_long_only" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETOPT_LONG_ONLY 1 -_ACEOF - -else - gl_replace_getopt=yes -fi -done - - fi - - if test -z "$gl_replace_getopt"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getopt is POSIX compatible" >&5 -$as_echo_n "checking whether getopt is POSIX compatible... " >&6; } -if test "${gl_cv_func_getopt_posix+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $cross_compiling = no; then - if test "$cross_compiling" = yes; then : - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include - -int -main () -{ - static char program[] = "program"; - static char a[] = "-a"; - static char foo[] = "foo"; - static char bar[] = "bar"; - char *argv[] = { program, a, foo, bar, NULL }; - int c; - - c = getopt (4, argv, "ab"); - if (!(c == 'a')) - return 1; - c = getopt (4, argv, "ab"); - if (!(c == -1)) - return 2; - if (!(optind == 2)) - return 3; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getopt_posix=maybe -else - gl_cv_func_getopt_posix=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - if test $gl_cv_func_getopt_posix = maybe; then - if test "$cross_compiling" = yes; then : - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include - -int -main () -{ - static char program[] = "program"; - static char donald[] = "donald"; - static char p[] = "-p"; - static char billy[] = "billy"; - static char duck[] = "duck"; - static char a[] = "-a"; - static char bar[] = "bar"; - char *argv[] = { program, donald, p, billy, duck, a, bar, NULL }; - int c; - - c = getopt (7, argv, "+abp:q:"); - if (!(c == -1)) - return 4; - if (!(strcmp (argv[0], "program") == 0)) - return 5; - if (!(strcmp (argv[1], "donald") == 0)) - return 6; - if (!(strcmp (argv[2], "-p") == 0)) - return 7; - if (!(strcmp (argv[3], "billy") == 0)) - return 8; - if (!(strcmp (argv[4], "duck") == 0)) - return 9; - if (!(strcmp (argv[5], "-a") == 0)) - return 10; - if (!(strcmp (argv[6], "bar") == 0)) - return 11; - if (!(optind == 1)) - return 12; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getopt_posix=maybe -else - gl_cv_func_getopt_posix=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 - if test $gl_cv_func_getopt_posix = maybe; then - if test "$cross_compiling" = yes; then : - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error "cannot run test program while cross compiling -See \`config.log' for more details." "$LINENO" 5; } -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include - -int -main () -{ - static char program[] = "program"; - static char ab[] = "-ab"; - char *argv[3] = { program, ab, NULL }; - if (getopt (2, argv, "ab:") != 'a') - return 13; - if (getopt (2, argv, "ab:") != '?') - return 14; - if (optopt != 'b') - return 15; - if (optind != 2) - return 16; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getopt_posix=yes -else - gl_cv_func_getopt_posix=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 - else - case "$host_os" in - darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";; - *) gl_cv_func_getopt_posix="guessing yes";; - esac - fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_posix" >&5 -$as_echo "$gl_cv_func_getopt_posix" >&6; } - case "$gl_cv_func_getopt_posix" in - *no) gl_replace_getopt=yes ;; - esac - fi - - if test -z "$gl_replace_getopt" && test $gl_getopt_required = GNU; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt function" >&5 -$as_echo_n "checking for working GNU getopt function... " >&6; } -if test "${gl_cv_func_getopt_gnu+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # Even with POSIXLY_CORRECT, the GNU extension of leading '-' in the - # optstring is necessary for programs like m4 that have POSIX-mandated - # semantics for supporting options interspersed with files. - # Also, since getopt_long is a GNU extension, we require optind=0. - # Bash ties 'set -o posix' to a non-exported POSIXLY_CORRECT; - # so take care to revert to the correct (non-)export state. - gl_awk_probe='BEGIN { if ("POSIXLY_CORRECT" in ENVIRON) print "x" }' - case ${POSIXLY_CORRECT+x}`$AWK "$gl_awk_probe" conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - #include - -#include -#if defined __MACH__ && defined __APPLE__ -/* Avoid a crash on Mac OS X. */ -#include -#include -#include -#include -#include -#include -/* The exception port on which our thread listens. */ -static mach_port_t our_exception_port; -/* The main function of the thread listening for exceptions of type - EXC_BAD_ACCESS. */ -static void * -mach_exception_thread (void *arg) -{ - /* Buffer for a message to be received. */ - struct { - mach_msg_header_t head; - mach_msg_body_t msgh_body; - char data[1024]; - } msg; - mach_msg_return_t retval; - /* Wait for a message on the exception port. */ - retval = mach_msg (&msg.head, MACH_RCV_MSG | MACH_RCV_LARGE, 0, sizeof (msg), - our_exception_port, MACH_MSG_TIMEOUT_NONE, MACH_PORT_NULL); - if (retval != MACH_MSG_SUCCESS) - abort (); - exit (1); -} -static void -nocrash_init (void) -{ - mach_port_t self = mach_task_self (); - /* Allocate a port on which the thread shall listen for exceptions. */ - if (mach_port_allocate (self, MACH_PORT_RIGHT_RECEIVE, &our_exception_port) - == KERN_SUCCESS) { - /* See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/mach_port_insert_right.html. */ - if (mach_port_insert_right (self, our_exception_port, our_exception_port, - MACH_MSG_TYPE_MAKE_SEND) - == KERN_SUCCESS) { - /* The exceptions we want to catch. Only EXC_BAD_ACCESS is interesting - for us. */ - exception_mask_t mask = EXC_MASK_BAD_ACCESS; - /* Create the thread listening on the exception port. */ - pthread_attr_t attr; - pthread_t thread; - if (pthread_attr_init (&attr) == 0 - && pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) == 0 - && pthread_create (&thread, &attr, mach_exception_thread, NULL) == 0) { - pthread_attr_destroy (&attr); - /* Replace the exception port info for these exceptions with our own. - Note that we replace the exception port for the entire task, not only - for a particular thread. This has the effect that when our exception - port gets the message, the thread specific exception port has already - been asked, and we don't need to bother about it. - See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/task_set_exception_ports.html. */ - task_set_exception_ports (self, mask, our_exception_port, - EXCEPTION_DEFAULT, MACHINE_THREAD_STATE); - } - } - } -} -#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ -/* Avoid a crash on native Windows. */ -#define WIN32_LEAN_AND_MEAN -#include -#include -static LONG WINAPI -exception_filter (EXCEPTION_POINTERS *ExceptionInfo) -{ - switch (ExceptionInfo->ExceptionRecord->ExceptionCode) - { - case EXCEPTION_ACCESS_VIOLATION: - case EXCEPTION_IN_PAGE_ERROR: - case EXCEPTION_STACK_OVERFLOW: - case EXCEPTION_GUARD_PAGE: - case EXCEPTION_PRIV_INSTRUCTION: - case EXCEPTION_ILLEGAL_INSTRUCTION: - case EXCEPTION_DATATYPE_MISALIGNMENT: - case EXCEPTION_ARRAY_BOUNDS_EXCEEDED: - case EXCEPTION_NONCONTINUABLE_EXCEPTION: - exit (1); - } - return EXCEPTION_CONTINUE_SEARCH; -} -static void -nocrash_init (void) -{ - SetUnhandledExceptionFilter ((LPTOP_LEVEL_EXCEPTION_FILTER) exception_filter); -} -#else -/* Avoid a crash on POSIX systems. */ -#include -/* A POSIX signal handler. */ -static void -exception_handler (int sig) -{ - exit (1); -} -static void -nocrash_init (void) -{ -#ifdef SIGSEGV - signal (SIGSEGV, exception_handler); -#endif -#ifdef SIGBUS - signal (SIGBUS, exception_handler); -#endif -} -#endif - - -int -main () -{ - - int result = 0; - - nocrash_init(); - - /* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw, - and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5, - OSF/1 5.1, Solaris 10. */ - { - static char conftest[] = "conftest"; - static char plus[] = "-+"; - char *argv[3] = { conftest, plus, NULL }; - opterr = 0; - if (getopt (2, argv, "+a") != '?') - result |= 1; - } - /* This code succeeds on glibc 2.8, mingw, - and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11, - IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */ - { - static char program[] = "program"; - static char p[] = "-p"; - static char foo[] = "foo"; - static char bar[] = "bar"; - char *argv[] = { program, p, foo, bar, NULL }; - - optind = 1; - if (getopt (4, argv, "p::") != 'p') - result |= 2; - else if (optarg != NULL) - result |= 4; - else if (getopt (4, argv, "p::") != -1) - result |= 6; - else if (optind != 2) - result |= 8; - } - /* This code succeeds on glibc 2.8 and fails on Cygwin 1.7.0. */ - { - static char program[] = "program"; - static char foo[] = "foo"; - static char p[] = "-p"; - char *argv[] = { program, foo, p, NULL }; - optind = 0; - if (getopt (3, argv, "-p") != 1) - result |= 16; - else if (getopt (3, argv, "-p") != 'p') - result |= 16; - } - /* This code fails on glibc 2.11. */ - { - static char program[] = "program"; - static char b[] = "-b"; - static char a[] = "-a"; - char *argv[] = { program, b, a, NULL }; - optind = opterr = 0; - if (getopt (3, argv, "+:a:b") != 'b') - result |= 32; - else if (getopt (3, argv, "+:a:b") != ':') - result |= 32; - } - /* This code dumps core on glibc 2.14. */ - { - static char program[] = "program"; - static char w[] = "-W"; - static char dummy[] = "dummy"; - char *argv[] = { program, w, dummy, NULL }; - optind = opterr = 1; - if (getopt (3, argv, "W;") != 'W') - result |= 64; - } - return result; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getopt_gnu=yes -else - gl_cv_func_getopt_gnu=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - case $gl_had_POSIXLY_CORRECT in - exported) ;; - yes) { POSIXLY_CORRECT=; unset POSIXLY_CORRECT;}; POSIXLY_CORRECT=1 ;; - *) { POSIXLY_CORRECT=; unset POSIXLY_CORRECT;} ;; - esac - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_gnu" >&5 -$as_echo "$gl_cv_func_getopt_gnu" >&6; } - if test "$gl_cv_func_getopt_gnu" != yes; then - gl_replace_getopt=yes - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt_long function" >&5 -$as_echo_n "checking for working GNU getopt_long function... " >&6; } -if test "${gl_cv_func_getopt_long_gnu+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - openbsd*) gl_cv_func_getopt_long_gnu="guessing no";; - *) gl_cv_func_getopt_long_gnu="guessing yes";; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - #include - -int -main () -{ -static const struct option long_options[] = - { - { "xtremely-",no_argument, NULL, 1003 }, - { "xtra", no_argument, NULL, 1001 }, - { "xtreme", no_argument, NULL, 1002 }, - { "xtremely", no_argument, NULL, 1003 }, - { NULL, 0, NULL, 0 } - }; - /* This code fails on OpenBSD 5.0. */ - { - static char program[] = "program"; - static char xtremel[] = "--xtremel"; - char *argv[] = { program, xtremel, NULL }; - int option_index; - optind = 1; opterr = 0; - if (getopt_long (2, argv, "", long_options, &option_index) != 1003) - return 1; - } - return 0; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getopt_long_gnu=yes -else - gl_cv_func_getopt_long_gnu=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_long_gnu" >&5 -$as_echo "$gl_cv_func_getopt_long_gnu" >&6; } - case "$gl_cv_func_getopt_long_gnu" in - *yes) ;; - *) gl_replace_getopt=yes ;; - esac - fi - fi - - - - - - - REPLACE_GETOPT=0 - if test -n "$gl_replace_getopt"; then - REPLACE_GETOPT=1 - fi - - if test $REPLACE_GETOPT = 1; then - - GETOPT_H=getopt.h - -$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h - - - - fi - -ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default" -if test "x$ac_cv_have_decl_getenv" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_GETENV $ac_have_decl -_ACEOF - -: - - - - -{ $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 : - $as_echo_n "(cached) " >&6 -else - ac_cv_c_restrict=no - # The order here caters to the fact that C++ does not require restrict. - for ac_kw in __restrict __restrict__ _Restrict restrict; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -typedef int * int_ptr; - int foo (int_ptr $ac_kw ip) { - return ip[0]; - } -int -main () -{ -int s[1]; - int * $ac_kw t = s; - t[0] = 0; - return foo(t) - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_restrict=$ac_kw -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$ac_cv_c_restrict" != no && break - done - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_restrict" >&5 -$as_echo "$ac_cv_c_restrict" >&6; } - - case $ac_cv_c_restrict in - restrict) ;; - no) $as_echo "#define restrict /**/" >>confdefs.h - ;; - *) cat >>confdefs.h <<_ACEOF -#define restrict $ac_cv_c_restrict -_ACEOF - ;; - esac - - - GNULIB_GETTIMEOFDAY=0; - HAVE_GETTIMEOFDAY=1; - HAVE_STRUCT_TIMEVAL=1; - HAVE_SYS_TIME_H=1; - REPLACE_GETTIMEOFDAY=0; - REPLACE_STRUCT_TIMEVAL=0; - - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_sys_time_h='<'sys/time.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_sys_time_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_sys_time_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'sys/time.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_sys_time_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_sys_time_h='<'sys/time.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_time_h" >&5 -$as_echo "$gl_cv_next_sys_time_h" >&6; } - fi - NEXT_SYS_TIME_H=$gl_cv_next_sys_time_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/time.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_sys_time_h - fi - NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H=$gl_next_as_first_directive - - - - - - if test $ac_cv_header_sys_time_h != yes; then - HAVE_SYS_TIME_H=0 - fi - - - - - - if test $ac_cv_header_sys_socket_h != yes; then - for ac_header in winsock2.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default" -if test "x$ac_cv_header_winsock2_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_WINSOCK2_H 1 -_ACEOF - -fi - -done - - fi - if test "$ac_cv_header_winsock2_h" = yes; then - HAVE_WINSOCK2_H=1 - UNISTD_H_HAVE_WINSOCK2_H=1 - SYS_IOCTL_H_HAVE_WINSOCK2_H=1 - else - HAVE_WINSOCK2_H=0 - fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5 -$as_echo_n "checking for struct timeval... " >&6; } -if test "${gl_cv_sys_struct_timeval+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if HAVE_SYS_TIME_H - #include - #endif - #include - #if HAVE_WINSOCK2_H - # include - #endif - -int -main () -{ -static struct timeval x; x.tv_sec = x.tv_usec; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_timeval=yes -else - gl_cv_sys_struct_timeval=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval" >&5 -$as_echo "$gl_cv_sys_struct_timeval" >&6; } - if test $gl_cv_sys_struct_timeval != yes; then - HAVE_STRUCT_TIMEVAL=0 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wide-enough struct timeval.tv_sec member" >&5 -$as_echo_n "checking for wide-enough struct timeval.tv_sec member... " >&6; } -if test "${gl_cv_sys_struct_timeval_tv_sec+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if HAVE_SYS_TIME_H - #include - #endif - #include - #if HAVE_WINSOCK2_H - # include - #endif - -int -main () -{ -static struct timeval x; - typedef int verify_tv_sec_type[ - sizeof (time_t) <= sizeof x.tv_sec ? 1 : -1 - ]; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_timeval_tv_sec=yes -else - gl_cv_sys_struct_timeval_tv_sec=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval_tv_sec" >&5 -$as_echo "$gl_cv_sys_struct_timeval_tv_sec" >&6; } - if test $gl_cv_sys_struct_timeval_tv_sec != yes; then - REPLACE_STRUCT_TIMEVAL=1 - fi - 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 - #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 - - - - - - - gl_cv_c_multiarch=no - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifndef __APPLE_CC__ - not a universal capable compiler - #endif - typedef int dummy; - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - - arch= - prev= - for word in ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS}; do - if test -n "$prev"; then - case $word in - i?86 | x86_64 | ppc | ppc64) - if test -z "$arch" || test "$arch" = "$word"; then - arch="$word" - else - gl_cv_c_multiarch=yes - fi - ;; - esac - prev= - else - if test "x$word" = "x-arch"; then - prev=arch - fi - fi - done - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $gl_cv_c_multiarch = yes; then - APPLE_UNIVERSAL_BUILD=1 - else - APPLE_UNIVERSAL_BUILD=0 - fi - - - - - - 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 " >&5 -$as_echo_n "checking absolute name of ... " >&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 - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'stdint.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_stdint_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - 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 _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ -#include -/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in . */ -#if !(defined WCHAR_MIN && defined WCHAR_MAX) -#error "WCHAR_MIN, WCHAR_MAX not defined in " -#endif - - - /* BSD/OS 4.0.1 has a bug: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #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 /* 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 _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ -#include - - - /* BSD/OS 4.0.1 has a bug: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #endif - - -#include -#include -#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" -eval as_val=\$$as_ac_Header - if test "x$as_val" = 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 { as_var=gl_cv_bitsizeof_${gltype}; eval "test \"\${$as_var+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: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #endif - -#include "; 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 { as_var=gl_cv_bitsizeof_${gltype}; eval "test \"\${$as_var+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: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #endif - -#include "; 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 { as_var=gl_cv_type_${gltype}_signed; eval "test \"\${$as_var+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: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #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 { as_var=gl_cv_type_${gltype}_suffix; eval "test \"\${$as_var+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: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #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 { as_var=gl_cv_type_${gltype}_suffix; eval "test \"\${$as_var+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: , and must be - included before . */ - #include - #include - #if HAVE_WCHAR_H - # include - # include - # include - #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 - - - - if test $BITSIZEOF_WINT_T -lt 32; then - BITSIZEOF_WINT_T=32 - fi - - STDINT_H=stdint.h - fi - - if test -n "$STDINT_H"; then - GL_GENERATE_STDINT_H_TRUE= - GL_GENERATE_STDINT_H_FALSE='#' -else - GL_GENERATE_STDINT_H_TRUE='#' - GL_GENERATE_STDINT_H_FALSE= -fi - - - - - - GNULIB_IMAXABS=0; - GNULIB_IMAXDIV=0; - GNULIB_STRTOIMAX=0; - GNULIB_STRTOUMAX=0; - HAVE_DECL_IMAXABS=1; - HAVE_DECL_IMAXDIV=1; - HAVE_DECL_STRTOIMAX=1; - HAVE_DECL_STRTOUMAX=1; - REPLACE_STRTOIMAX=0; - INT32_MAX_LT_INTMAX_MAX=1; - INT64_MAX_EQ_LONG_MAX='defined _LP64'; - PRI_MACROS_BROKEN=0; - PRIPTR_PREFIX=__PRIPTR_PREFIX; - UINT32_MAX_LT_UINTMAX_MAX=1; - UINT64_MAX_EQ_ULONG_MAX='defined _LP64'; - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_inttypes_h='<'inttypes.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_inttypes_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_inttypes_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'inttypes.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_inttypes_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_inttypes_h='<'inttypes.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_inttypes_h" >&5 -$as_echo "$gl_cv_next_inttypes_h" >&6; } - fi - NEXT_INTTYPES_H=$gl_cv_next_inttypes_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='<'inttypes.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_inttypes_h - fi - NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H=$gl_next_as_first_directive - - - - - - - - - - - - case "$host_os" in - mingw*) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit off_t" >&5 -$as_echo_n "checking for 64-bit off_t... " >&6; } -if test "${gl_cv_type_off_t_64+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - int verify_off_t_size[sizeof (off_t) >= 8 ? 1 : -1]; - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_type_off_t_64=yes -else - gl_cv_type_off_t_64=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_type_off_t_64" >&5 -$as_echo "$gl_cv_type_off_t_64" >&6; } - if test $gl_cv_type_off_t_64 = no; then - WINDOWS_64_BIT_OFF_T=1 - else - WINDOWS_64_BIT_OFF_T=0 - fi - WINDOWS_64_BIT_ST_SIZE=1 - ;; - *) - WINDOWS_64_BIT_OFF_T=0 - WINDOWS_64_BIT_ST_SIZE=0 - ;; - esac - - - - - GNULIB_FFSL=0; - GNULIB_FFSLL=0; - GNULIB_MEMCHR=0; - GNULIB_MEMMEM=0; - GNULIB_MEMPCPY=0; - GNULIB_MEMRCHR=0; - GNULIB_RAWMEMCHR=0; - GNULIB_STPCPY=0; - GNULIB_STPNCPY=0; - GNULIB_STRCHRNUL=0; - GNULIB_STRDUP=0; - GNULIB_STRNCAT=0; - GNULIB_STRNDUP=0; - GNULIB_STRNLEN=0; - GNULIB_STRPBRK=0; - GNULIB_STRSEP=0; - GNULIB_STRSTR=0; - GNULIB_STRCASESTR=0; - GNULIB_STRTOK_R=0; - GNULIB_MBSLEN=0; - GNULIB_MBSNLEN=0; - GNULIB_MBSCHR=0; - GNULIB_MBSRCHR=0; - GNULIB_MBSSTR=0; - GNULIB_MBSCASECMP=0; - GNULIB_MBSNCASECMP=0; - GNULIB_MBSPCASECMP=0; - GNULIB_MBSCASESTR=0; - GNULIB_MBSCSPN=0; - GNULIB_MBSPBRK=0; - GNULIB_MBSSPN=0; - GNULIB_MBSSEP=0; - GNULIB_MBSTOK_R=0; - GNULIB_STRERROR=0; - GNULIB_STRERROR_R=0; - GNULIB_STRSIGNAL=0; - GNULIB_STRVERSCMP=0; - HAVE_MBSLEN=0; - HAVE_FFSL=1; - HAVE_FFSLL=1; - HAVE_MEMCHR=1; - HAVE_DECL_MEMMEM=1; - HAVE_MEMPCPY=1; - HAVE_DECL_MEMRCHR=1; - HAVE_RAWMEMCHR=1; - HAVE_STPCPY=1; - HAVE_STPNCPY=1; - HAVE_STRCHRNUL=1; - HAVE_DECL_STRDUP=1; - HAVE_DECL_STRNDUP=1; - HAVE_DECL_STRNLEN=1; - HAVE_STRPBRK=1; - HAVE_STRSEP=1; - HAVE_STRCASESTR=1; - HAVE_DECL_STRTOK_R=1; - HAVE_DECL_STRERROR_R=1; - HAVE_DECL_STRSIGNAL=1; - HAVE_STRVERSCMP=1; - REPLACE_MEMCHR=0; - REPLACE_MEMMEM=0; - REPLACE_STPNCPY=0; - REPLACE_STRDUP=0; - REPLACE_STRSTR=0; - REPLACE_STRCASESTR=0; - REPLACE_STRCHRNUL=0; - REPLACE_STRERROR=0; - REPLACE_STRERROR_R=0; - REPLACE_STRNCAT=0; - REPLACE_STRNDUP=0; - REPLACE_STRNLEN=0; - REPLACE_STRSIGNAL=0; - REPLACE_STRTOK_R=0; - UNDEFINE_STRTOK_R=0; - -ac_fn_c_check_decl "$LINENO" "memrchr" "ac_cv_have_decl_memrchr" "$ac_includes_default" -if test "x$ac_cv_have_decl_memrchr" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_MEMRCHR $ac_have_decl -_ACEOF - - - GNULIB_MKTIME=0; - GNULIB_NANOSLEEP=0; - GNULIB_STRPTIME=0; - GNULIB_TIMEGM=0; - GNULIB_TIME_R=0; - HAVE_DECL_LOCALTIME_R=1; - HAVE_NANOSLEEP=1; - HAVE_STRPTIME=1; - HAVE_TIMEGM=1; - REPLACE_LOCALTIME_R=GNULIB_PORTCHECK; - REPLACE_MKTIME=GNULIB_PORTCHECK; - REPLACE_NANOSLEEP=GNULIB_PORTCHECK; - REPLACE_TIMEGM=GNULIB_PORTCHECK; - - - - - GNULIB_PSELECT=0; - GNULIB_SELECT=0; - HAVE_PSELECT=1; - REPLACE_PSELECT=0; - REPLACE_SELECT=0; - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether is self-contained" >&5 -$as_echo_n "checking whether is self-contained... " >&6; } -if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -struct timeval b; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_header_sys_select_h_selfcontained=yes -else - gl_cv_header_sys_select_h_selfcontained=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $gl_cv_header_sys_select_h_selfcontained = yes; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -int memset; int bzero; - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - - #undef memset - #define memset nonexistent_memset - extern - #ifdef __cplusplus - "C" - #endif - void *memset (void *, int, unsigned long); - #undef bzero - #define bzero nonexistent_bzero - extern - #ifdef __cplusplus - "C" - #endif - void bzero (void *, unsigned long); - fd_set fds; - FD_ZERO (&fds); - - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - -else - gl_cv_header_sys_select_h_selfcontained=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5 -$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; } - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_sys_select_h='<'sys/select.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_sys_select_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_sys_select_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'sys/select.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_sys_select_h='<'sys/select.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5 -$as_echo "$gl_cv_next_sys_select_h" >&6; } - fi - NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_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/select.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_sys_select_h - fi - NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive - - - - - if test $ac_cv_header_sys_select_h = yes; then - HAVE_SYS_SELECT_H=1 - else - HAVE_SYS_SELECT_H=0 - fi - - - - - - if test $ac_cv_header_sys_socket_h != yes; then - for ac_header in winsock2.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default" -if test "x$ac_cv_header_winsock2_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_WINSOCK2_H 1 -_ACEOF - -fi - -done - - fi - if test "$ac_cv_header_winsock2_h" = yes; then - HAVE_WINSOCK2_H=1 - UNISTD_H_HAVE_WINSOCK2_H=1 - SYS_IOCTL_H_HAVE_WINSOCK2_H=1 - else - HAVE_WINSOCK2_H=0 - fi - - - - - - - - - GNULIB_PTHREAD_SIGMASK=0; - GNULIB_RAISE=0; - GNULIB_SIGNAL_H_SIGPIPE=0; - GNULIB_SIGPROCMASK=0; - GNULIB_SIGACTION=0; - HAVE_POSIX_SIGNALBLOCKING=1; - HAVE_PTHREAD_SIGMASK=1; - HAVE_RAISE=1; - HAVE_SIGSET_T=1; - HAVE_SIGINFO_T=1; - HAVE_SIGACTION=1; - HAVE_STRUCT_SIGACTION_SA_SIGACTION=1; - - HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=1; - - HAVE_SIGHANDLER_T=1; - REPLACE_PTHREAD_SIGMASK=0; - REPLACE_RAISE=0; - - - - - - - - ac_fn_c_check_type "$LINENO" "sigset_t" "ac_cv_type_sigset_t" " - #include - /* Mingw defines sigset_t not in , but in . */ - #include - -" -if test "x$ac_cv_type_sigset_t" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_SIGSET_T 1 -_ACEOF - -gl_cv_type_sigset_t=yes -else - gl_cv_type_sigset_t=no -fi - - if test $gl_cv_type_sigset_t != yes; then - HAVE_SIGSET_T=0 - fi - - - - if test $ac_cv_header_sys_socket_h = no; then - for ac_header in ws2tcpip.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ws2tcpip.h" "ac_cv_header_ws2tcpip_h" "$ac_includes_default" -if test "x$ac_cv_header_ws2tcpip_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_WS2TCPIP_H 1 -_ACEOF - -fi - -done - - fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for stdbool.h that conforms to C99" >&5 -$as_echo_n "checking for stdbool.h that conforms to C99... " >&6; } -if test "${ac_cv_header_stdbool_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #ifndef bool - "error: bool is not defined" - #endif - #ifndef false - "error: false is not defined" - #endif - #if false - "error: false is not 0" - #endif - #ifndef true - "error: true is not defined" - #endif - #if true != 1 - "error: true is not 1" - #endif - #ifndef __bool_true_false_are_defined - "error: __bool_true_false_are_defined is not defined" - #endif - - struct s { _Bool s: 1; _Bool t; } s; - - char a[true == 1 ? 1 : -1]; - char b[false == 0 ? 1 : -1]; - char c[__bool_true_false_are_defined == 1 ? 1 : -1]; - char d[(bool) 0.5 == true ? 1 : -1]; - /* See body of main program for 'e'. */ - char f[(_Bool) 0.0 == false ? 1 : -1]; - char g[true]; - char h[sizeof (_Bool)]; - char i[sizeof s.t]; - enum { j = false, k = true, l = false * true, m = true * 256 }; - /* The following fails for - HP aC++/ANSI C B3910B A.05.55 [Dec 04 2003]. */ - _Bool n[m]; - char o[sizeof n == m * sizeof n[0] ? 1 : -1]; - char p[-1 - (_Bool) 0 < 0 && -1 - (bool) 0 < 0 ? 1 : -1]; - /* Catch a bug in an HP-UX C compiler. See - http://gcc.gnu.org/ml/gcc-patches/2003-12/msg02303.html - http://lists.gnu.org/archive/html/bug-coreutils/2005-11/msg00161.html - */ - _Bool q = true; - _Bool *pq = &q; - -int -main () -{ - - bool e = &s; - *pq |= q; - *pq |= ! q; - /* Refer to every declared value, to avoid compiler optimizations. */ - return (!a + !b + !c + !d + !e + !f + !g + !h + !i + !!j + !k + !!l - + !m + !n + !o + !p + !q + !pq); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_stdbool_h=yes -else - ac_cv_header_stdbool_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdbool_h" >&5 -$as_echo "$ac_cv_header_stdbool_h" >&6; } - ac_fn_c_check_type "$LINENO" "_Bool" "ac_cv_type__Bool" "$ac_includes_default" -if test "x$ac_cv_type__Bool" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE__BOOL 1 -_ACEOF - - -fi - - - - REPLACE_NULL=0; - HAVE_WCHAR_T=1; - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wchar_t" >&5 -$as_echo_n "checking for wchar_t... " >&6; } -if test "${gt_cv_c_wchar_t+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - wchar_t foo = (wchar_t)'\0'; -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gt_cv_c_wchar_t=yes -else - gt_cv_c_wchar_t=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_c_wchar_t" >&5 -$as_echo "$gt_cv_c_wchar_t" >&6; } - if test $gt_cv_c_wchar_t = yes; then - -$as_echo "#define HAVE_WCHAR_T 1" >>confdefs.h - - fi - - - GNULIB_DPRINTF=0; - GNULIB_FCLOSE=0; - GNULIB_FDOPEN=0; - GNULIB_FFLUSH=0; - GNULIB_FGETC=0; - GNULIB_FGETS=0; - GNULIB_FOPEN=0; - GNULIB_FPRINTF=0; - GNULIB_FPRINTF_POSIX=0; - GNULIB_FPURGE=0; - GNULIB_FPUTC=0; - GNULIB_FPUTS=0; - GNULIB_FREAD=0; - GNULIB_FREOPEN=0; - GNULIB_FSCANF=0; - GNULIB_FSEEK=0; - GNULIB_FSEEKO=0; - GNULIB_FTELL=0; - GNULIB_FTELLO=0; - GNULIB_FWRITE=0; - GNULIB_GETC=0; - GNULIB_GETCHAR=0; - GNULIB_GETDELIM=0; - GNULIB_GETLINE=0; - GNULIB_OBSTACK_PRINTF=0; - GNULIB_OBSTACK_PRINTF_POSIX=0; - GNULIB_PCLOSE=0; - GNULIB_PERROR=0; - GNULIB_POPEN=0; - GNULIB_PRINTF=0; - GNULIB_PRINTF_POSIX=0; - GNULIB_PUTC=0; - GNULIB_PUTCHAR=0; - GNULIB_PUTS=0; - GNULIB_REMOVE=0; - GNULIB_RENAME=0; - GNULIB_RENAMEAT=0; - GNULIB_SCANF=0; - GNULIB_SNPRINTF=0; - GNULIB_SPRINTF_POSIX=0; - GNULIB_STDIO_H_NONBLOCKING=0; - GNULIB_STDIO_H_SIGPIPE=0; - GNULIB_TMPFILE=0; - GNULIB_VASPRINTF=0; - GNULIB_VFSCANF=0; - GNULIB_VSCANF=0; - GNULIB_VDPRINTF=0; - GNULIB_VFPRINTF=0; - GNULIB_VFPRINTF_POSIX=0; - GNULIB_VPRINTF=0; - GNULIB_VPRINTF_POSIX=0; - GNULIB_VSNPRINTF=0; - GNULIB_VSPRINTF_POSIX=0; - HAVE_DECL_FPURGE=1; - HAVE_DECL_FSEEKO=1; - HAVE_DECL_FTELLO=1; - HAVE_DECL_GETDELIM=1; - HAVE_DECL_GETLINE=1; - HAVE_DECL_OBSTACK_PRINTF=1; - HAVE_DECL_SNPRINTF=1; - HAVE_DECL_VSNPRINTF=1; - HAVE_DPRINTF=1; - HAVE_FSEEKO=1; - HAVE_FTELLO=1; - HAVE_PCLOSE=1; - HAVE_POPEN=1; - HAVE_RENAMEAT=1; - HAVE_VASPRINTF=1; - HAVE_VDPRINTF=1; - REPLACE_DPRINTF=0; - REPLACE_FCLOSE=0; - REPLACE_FDOPEN=0; - REPLACE_FFLUSH=0; - REPLACE_FOPEN=0; - REPLACE_FPRINTF=0; - REPLACE_FPURGE=0; - REPLACE_FREOPEN=0; - REPLACE_FSEEK=0; - REPLACE_FSEEKO=0; - REPLACE_FTELL=0; - REPLACE_FTELLO=0; - REPLACE_GETDELIM=0; - REPLACE_GETLINE=0; - REPLACE_OBSTACK_PRINTF=0; - REPLACE_PERROR=0; - REPLACE_POPEN=0; - REPLACE_PRINTF=0; - REPLACE_REMOVE=0; - REPLACE_RENAME=0; - REPLACE_RENAMEAT=0; - REPLACE_SNPRINTF=0; - REPLACE_SPRINTF=0; - REPLACE_STDIO_READ_FUNCS=0; - REPLACE_STDIO_WRITE_FUNCS=0; - REPLACE_TMPFILE=0; - REPLACE_VASPRINTF=0; - REPLACE_VDPRINTF=0; - REPLACE_VFPRINTF=0; - REPLACE_VPRINTF=0; - REPLACE_VSNPRINTF=0; - REPLACE_VSPRINTF=0; - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 -$as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } -if test "${ac_cv_struct_tm+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include - -int -main () -{ -struct tm tm; - int *p = &tm.tm_sec; - return !p; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_struct_tm=time.h -else - ac_cv_struct_tm=sys/time.h -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_tm" >&5 -$as_echo "$ac_cv_struct_tm" >&6; } -if test $ac_cv_struct_tm = sys/time.h; then - -$as_echo "#define TM_IN_SYS_TIME 1" >>confdefs.h - -fi - -ac_fn_c_check_member "$LINENO" "struct tm" "tm_zone" "ac_cv_member_struct_tm_tm_zone" "#include -#include <$ac_cv_struct_tm> - -" -if test "x$ac_cv_member_struct_tm_tm_zone" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_TM_TM_ZONE 1 -_ACEOF - - -fi - -if test "$ac_cv_member_struct_tm_tm_zone" = yes; then - -$as_echo "#define HAVE_TM_ZONE 1" >>confdefs.h - -else - ac_fn_c_check_decl "$LINENO" "tzname" "ac_cv_have_decl_tzname" "#include -" -if test "x$ac_cv_have_decl_tzname" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_TZNAME $ac_have_decl -_ACEOF - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tzname" >&5 -$as_echo_n "checking for tzname... " >&6; } -if test "${ac_cv_var_tzname+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#if !HAVE_DECL_TZNAME -extern char *tzname[]; -#endif - -int -main () -{ -return tzname[0][0]; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_var_tzname=yes -else - ac_cv_var_tzname=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_var_tzname" >&5 -$as_echo "$ac_cv_var_tzname" >&6; } - if test $ac_cv_var_tzname = yes; then - -$as_echo "#define HAVE_TZNAME 1" >>confdefs.h - - fi -fi - - - ac_fn_c_check_member "$LINENO" "struct tm" "tm_gmtoff" "ac_cv_member_struct_tm_tm_gmtoff" "#include -" -if test "x$ac_cv_member_struct_tm_tm_gmtoff" = x""yes; then : - -$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h - -fi - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_string_h='<'string.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_string_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'string.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_string_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_string_h" >&5 -$as_echo "$gl_cv_next_string_h" >&6; } - fi - NEXT_STRING_H=$gl_cv_next_string_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='<'string.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_string_h - fi - NEXT_AS_FIRST_DIRECTIVE_STRING_H=$gl_next_as_first_directive - - - - - - - - - -ac_fn_c_check_decl "$LINENO" "strtoimax" "ac_cv_have_decl_strtoimax" "$ac_includes_default" -if test "x$ac_cv_have_decl_strtoimax" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_STRTOIMAX $ac_have_decl -_ACEOF - - - -ac_fn_c_check_decl "$LINENO" "strtoumax" "ac_cv_have_decl_strtoumax" "$ac_includes_default" -if test "x$ac_cv_have_decl_strtoumax" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_STRTOUMAX $ac_have_decl -_ACEOF - - - -{ $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 -#include - -#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 struct timespec in " >&5 -$as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_time_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -static struct timespec x; x.tv_sec = x.tv_nsec; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_timespec_in_time_h=yes -else - gl_cv_sys_struct_timespec_in_time_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timespec_in_time_h" >&5 -$as_echo "$gl_cv_sys_struct_timespec_in_time_h" >&6; } - - TIME_H_DEFINES_STRUCT_TIMESPEC=0 - SYS_TIME_H_DEFINES_STRUCT_TIMESPEC=0 - PTHREAD_H_DEFINES_STRUCT_TIMESPEC=0 - if test $gl_cv_sys_struct_timespec_in_time_h = yes; then - TIME_H_DEFINES_STRUCT_TIMESPEC=1 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 -$as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_sys_time_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -static struct timespec x; x.tv_sec = x.tv_nsec; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_timespec_in_sys_time_h=yes -else - gl_cv_sys_struct_timespec_in_sys_time_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timespec_in_sys_time_h" >&5 -$as_echo "$gl_cv_sys_struct_timespec_in_sys_time_h" >&6; } - if test $gl_cv_sys_struct_timespec_in_sys_time_h = yes; then - SYS_TIME_H_DEFINES_STRUCT_TIMESPEC=1 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 -$as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_pthread_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -static struct timespec x; x.tv_sec = x.tv_nsec; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_timespec_in_pthread_h=yes -else - gl_cv_sys_struct_timespec_in_pthread_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timespec_in_pthread_h" >&5 -$as_echo "$gl_cv_sys_struct_timespec_in_pthread_h" >&6; } - if test $gl_cv_sys_struct_timespec_in_pthread_h = yes; then - PTHREAD_H_DEFINES_STRUCT_TIMESPEC=1 - fi - fi - fi - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_time_h='<'time.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_time_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'time.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_time_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_time_h" >&5 -$as_echo "$gl_cv_next_time_h" >&6; } - fi - NEXT_TIME_H=$gl_cv_next_time_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='<'time.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_time_h - fi - NEXT_AS_FIRST_DIRECTIVE_TIME_H=$gl_next_as_first_directive - - - - - - - - - - - - - - -ac_fn_c_check_decl "$LINENO" "unsetenv" "ac_cv_have_decl_unsetenv" "$ac_includes_default" -if test "x$ac_cv_have_decl_unsetenv" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_UNSETENV $ac_have_decl -_ACEOF - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the utimes function works" >&5 -$as_echo_n "checking whether the utimes function works... " >&6; } -if test "${gl_cv_func_working_utimes+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test "$cross_compiling" = yes; then : - gl_cv_func_working_utimes=no -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -static int -inorder (time_t a, time_t b, time_t c) -{ - return a <= b && b <= c; -} - -int -main () -{ - int result = 0; - char const *file = "conftest.utimes"; - static struct timeval timeval[2] = {{9, 10}, {999999, 999999}}; - - /* Test whether utimes() essentially works. */ - { - struct stat sbuf; - FILE *f = fopen (file, "w"); - if (f == NULL) - result |= 1; - else if (fclose (f) != 0) - result |= 1; - else if (utimes (file, timeval) != 0) - result |= 2; - else if (lstat (file, &sbuf) != 0) - result |= 1; - else if (!(sbuf.st_atime == timeval[0].tv_sec - && sbuf.st_mtime == timeval[1].tv_sec)) - result |= 4; - if (unlink (file) != 0) - result |= 1; - } - - /* Test whether utimes() with a NULL argument sets the file's timestamp - to the current time. Use 'fstat' as well as 'time' to - determine the "current" time, to accommodate NFS file systems - if there is a time skew between the host and the NFS server. */ - { - int fd = open (file, O_WRONLY|O_CREAT, 0644); - if (fd < 0) - result |= 1; - else - { - time_t t0, t2; - struct stat st0, st1, st2; - if (time (&t0) == (time_t) -1) - result |= 1; - else if (fstat (fd, &st0) != 0) - result |= 1; - else if (utimes (file, timeval) != 0) - result |= 2; - else if (utimes (file, NULL) != 0) - result |= 8; - else if (fstat (fd, &st1) != 0) - result |= 1; - else if (write (fd, "\n", 1) != 1) - result |= 1; - else if (fstat (fd, &st2) != 0) - result |= 1; - else if (time (&t2) == (time_t) -1) - result |= 1; - else - { - int m_ok_POSIX = inorder (t0, st1.st_mtime, t2); - int m_ok_NFS = inorder (st0.st_mtime, st1.st_mtime, st2.st_mtime); - if (! (st1.st_atime == st1.st_mtime)) - result |= 16; - if (! (m_ok_POSIX || m_ok_NFS)) - result |= 32; - } - if (close (fd) != 0) - result |= 1; - } - if (unlink (file) != 0) - result |= 1; - } - - /* Test whether utimes() with a NULL argument works on read-only files. */ - { - int fd = open (file, O_WRONLY|O_CREAT, 0444); - if (fd < 0) - result |= 1; - else if (close (fd) != 0) - result |= 1; - else if (utimes (file, NULL) != 0) - result |= 64; - if (unlink (file) != 0) - result |= 1; - } - - return result; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_working_utimes=yes -else - gl_cv_func_working_utimes=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_utimes" >&5 -$as_echo "$gl_cv_func_working_utimes" >&6; } - - if test $gl_cv_func_working_utimes = yes; then - -$as_echo "#define HAVE_WORKING_UTIMES 1" >>confdefs.h - - fi - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5 -$as_echo_n "checking for struct utimbuf... " >&6; } -if test "${gl_cv_sys_struct_utimbuf+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if HAVE_SYS_TIME_H - #include - #endif - #include - #ifdef HAVE_UTIME_H - #include - #endif - -int -main () -{ -static struct utimbuf x; x.actime = x.modtime; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_sys_struct_utimbuf=yes -else - gl_cv_sys_struct_utimbuf=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_utimbuf" >&5 -$as_echo "$gl_cv_sys_struct_utimbuf" >&6; } - - if test $gl_cv_sys_struct_utimbuf = yes; then - -$as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h - - fi - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking type of array argument to getgroups" >&5 -$as_echo_n "checking type of array argument to getgroups... " >&6; } -if test "${ac_cv_type_getgroups+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - ac_cv_type_getgroups=cross -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Thanks to Mike Rendell for this test. */ -$ac_includes_default -#define NGID 256 -#undef MAX -#define MAX(x, y) ((x) > (y) ? (x) : (y)) - -int -main () -{ - gid_t gidset[NGID]; - int i, n; - union { gid_t gval; long int lval; } val; - - val.lval = -1; - for (i = 0; i < NGID; i++) - gidset[i] = val.gval; - n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1, - gidset); - /* Exit non-zero if getgroups seems to require an array of ints. This - happens when gid_t is short int but getgroups modifies an array - of ints. */ - return n > 0 && gidset[n] != val.gval; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_type_getgroups=gid_t -else - ac_cv_type_getgroups=int -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -if test $ac_cv_type_getgroups = cross; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "getgroups.*int.*gid_t" >/dev/null 2>&1; then : - ac_cv_type_getgroups=gid_t -else - ac_cv_type_getgroups=int -fi -rm -f conftest* - -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_getgroups" >&5 -$as_echo "$ac_cv_type_getgroups" >&6; } - -cat >>confdefs.h <<_ACEOF -#define GETGROUPS_T $ac_cv_type_getgroups -_ACEOF - - - - - if false; then - GL_COND_LIBTOOL_TRUE= - GL_COND_LIBTOOL_FALSE='#' -else - GL_COND_LIBTOOL_TRUE='#' - GL_COND_LIBTOOL_FALSE= -fi - - gl_cond_libtool=false - gl_libdeps= - gl_ltlibdeps= - gl_m4_base='m4' - - - - - - - - - - gl_source_base='lib' - - - if test $ac_cv_func_alloca_works = no; then - : - fi - - # Define an additional variable used in the Makefile substitution. - if test $ac_cv_working_alloca_h = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca as a compiler built-in" >&5 -$as_echo_n "checking for alloca as a compiler built-in... " >&6; } -if test "${gl_cv_rpl_alloca+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#if defined __GNUC__ || defined _AIX || defined _MSC_VER - Need own alloca -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "Need own alloca" >/dev/null 2>&1; then : - gl_cv_rpl_alloca=yes -else - gl_cv_rpl_alloca=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_rpl_alloca" >&5 -$as_echo "$gl_cv_rpl_alloca" >&6; } - if test $gl_cv_rpl_alloca = yes; then - -$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h - - ALLOCA_H=alloca.h - else - ALLOCA_H= - fi - else - ALLOCA_H=alloca.h - fi - - if test -n "$ALLOCA_H"; then - GL_GENERATE_ALLOCA_H_TRUE= - GL_GENERATE_ALLOCA_H_FALSE='#' -else - GL_GENERATE_ALLOCA_H_TRUE='#' - GL_GENERATE_ALLOCA_H_FALSE= -fi - - - - - - - # Solaris 2.5.1 needs -lposix4 to get the clock_gettime function. - # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4. - - # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all* - # programs in the package would end up linked with that potentially-shared - # library, inducing unnecessary run-time overhead. - LIB_CLOCK_GETTIME= - - gl_saved_libs=$LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5 -$as_echo_n "checking for library containing clock_gettime... " >&6; } -if test "${ac_cv_search_clock_gettime+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$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 clock_gettime (); -int -main () -{ -return clock_gettime (); - ; - return 0; -} -_ACEOF -for ac_lib in '' rt posix4; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_clock_gettime=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if test "${ac_cv_search_clock_gettime+set}" = set; then : - break -fi -done -if test "${ac_cv_search_clock_gettime+set}" = set; then : - -else - ac_cv_search_clock_gettime=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5 -$as_echo "$ac_cv_search_clock_gettime" >&6; } -ac_res=$ac_cv_search_clock_gettime -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - test "$ac_cv_search_clock_gettime" = "none required" || - LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime -fi - - for ac_func in clock_gettime clock_settime -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - LIBS=$gl_saved_libs - - - : - - - -cat >>confdefs.h <<_ACEOF -#define GNULIB_CLOSE_STREAM 1 -_ACEOF - - - - - : - - - - : - - - - - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_dirent_h='<'dirent.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_dirent_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_dirent_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'dirent.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_dirent_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_dirent_h='<'dirent.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_dirent_h" >&5 -$as_echo "$gl_cv_next_dirent_h" >&6; } - fi - NEXT_DIRENT_H=$gl_cv_next_dirent_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='<'dirent.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_dirent_h - fi - NEXT_AS_FIRST_DIRECTIVE_DIRENT_H=$gl_next_as_first_directive - - - - - if test $ac_cv_header_dirent_h = yes; then - HAVE_DIRENT_H=1 - else - HAVE_DIRENT_H=0 - fi - - - - - - - - - - -$as_echo "#define HAVE_DUP2 1" >>confdefs.h - - - if test $HAVE_DUP2 = 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether dup2 works" >&5 -$as_echo_n "checking whether dup2 works... " >&6; } -if test "${gl_cv_func_dup2_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - mingw*) # on this platform, dup2 always returns 0 for success - gl_cv_func_dup2_works="guessing no" ;; - cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 - gl_cv_func_dup2_works="guessing no" ;; - linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a - # closed fd may yield -EBADF instead of -1 / errno=EBADF. - gl_cv_func_dup2_works="guessing no" ;; - freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF. - gl_cv_func_dup2_works="guessing no" ;; - haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC. - gl_cv_func_dup2_works="guessing no" ;; - *) gl_cv_func_dup2_works="guessing yes" ;; - esac -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include -#include -#include -int -main () -{ -int result = 0; -#ifdef FD_CLOEXEC - if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1) - result |= 1; -#endif - if (dup2 (1, 1) == 0) - result |= 2; -#ifdef FD_CLOEXEC - if (fcntl (1, F_GETFD) != FD_CLOEXEC) - result |= 4; -#endif - close (0); - if (dup2 (0, 0) != -1) - result |= 8; - /* Many gnulib modules require POSIX conformance of EBADF. */ - if (dup2 (2, 1000000) == -1 && errno != EBADF) - result |= 16; - /* Flush out a cygwin core dump. */ - if (dup2 (2, -1) != -1 || errno != EBADF) - result |= 32; - return result; - - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_dup2_works=yes -else - gl_cv_func_dup2_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_dup2_works" >&5 -$as_echo "$gl_cv_func_dup2_works" >&6; } - case "$gl_cv_func_dup2_works" in - *yes) ;; - *) - REPLACE_DUP2=1 - ;; - esac - fi - - - if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext" - - - fi - - - - - - GNULIB_DUP2=1 - - - - - - - - - - - - GNULIB_ENVIRON=1 - - - - - - - - - LIB_EXECINFO='' - EXECINFO_H='execinfo.h' - - if test $ac_cv_header_execinfo_h = yes; then - gl_saved_libs=$LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing backtrace_symbols_fd" >&5 -$as_echo_n "checking for library containing backtrace_symbols_fd... " >&6; } -if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$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 backtrace_symbols_fd (); -int -main () -{ -return backtrace_symbols_fd (); - ; - return 0; -} -_ACEOF -for ac_lib in '' execinfo; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_backtrace_symbols_fd=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then : - break -fi -done -if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then : - -else - ac_cv_search_backtrace_symbols_fd=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_backtrace_symbols_fd" >&5 -$as_echo "$ac_cv_search_backtrace_symbols_fd" >&6; } -ac_res=$ac_cv_search_backtrace_symbols_fd -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - test "$ac_cv_search_backtrace_symbols_fd" = "none required" || - LIB_EXECINFO=$ac_cv_search_backtrace_symbols_fd -fi - - LIBS=$gl_saved_libs - test "$ac_cv_search_backtrace_symbols_fd" = no || EXECINFO_H='' - fi - - if test -n "$EXECINFO_H"; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS execinfo.$ac_objext" - - fi - - - - if test -n "$EXECINFO_H"; then - GL_GENERATE_EXECINFO_H_TRUE= - GL_GENERATE_EXECINFO_H_FALSE='#' -else - GL_GENERATE_EXECINFO_H_TRUE='#' - GL_GENERATE_EXECINFO_H_FALSE= -fi - - - - - - - - - - if test $ac_cv_func_faccessat = no; then - HAVE_FACCESSAT=0 - fi - - if test $HAVE_FACCESSAT = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS faccessat.$ac_objext" - - - for ac_func in access -do : - ac_fn_c_check_func "$LINENO" "access" "ac_cv_func_access" -if test "x$ac_cv_func_access" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_ACCESS 1 -_ACEOF - -fi -done - - - fi - - -cat >>confdefs.h <<_ACEOF -#define GNULIB_FACCESSAT 1 -_ACEOF - - - - - - - - GNULIB_FACCESSAT=1 - - - - - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_fcntl_h='<'fcntl.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_fcntl_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'fcntl.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_fcntl_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_fcntl_h" >&5 -$as_echo "$gl_cv_next_fcntl_h" >&6; } - fi - NEXT_FCNTL_H=$gl_cv_next_fcntl_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='<'fcntl.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_fcntl_h - fi - NEXT_AS_FIRST_DIRECTIVE_FCNTL_H=$gl_next_as_first_directive - - - - - - - - - - - - - - - - - ac_fn_c_check_decl "$LINENO" "fdopendir" "ac_cv_have_decl_fdopendir" " -#include - -" -if test "x$ac_cv_have_decl_fdopendir" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_FDOPENDIR $ac_have_decl -_ACEOF -if test $ac_have_decl = 1; then : - -else - HAVE_DECL_FDOPENDIR=0 -fi - - - if test $ac_cv_func_fdopendir = no; then - HAVE_FDOPENDIR=0 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fdopendir works" >&5 -$as_echo_n "checking whether fdopendir works... " >&6; } -if test "${gl_cv_func_fdopendir_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_fdopendir_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_fdopendir_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -#if !HAVE_DECL_FDOPENDIR -extern -# ifdef __cplusplus -"C" -# endif -DIR *fdopendir (int); -#endif - -int -main () -{ -int result = 0; - int fd = open ("conftest.c", O_RDONLY); - if (fd < 0) result |= 1; - if (fdopendir (fd)) result |= 2; - if (close (fd)) result |= 4; - return result; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_fdopendir_works=yes -else - gl_cv_func_fdopendir_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_fdopendir_works" >&5 -$as_echo "$gl_cv_func_fdopendir_works" >&6; } - case "$gl_cv_func_fdopendir_works" in - *yes) ;; - *) - REPLACE_FDOPENDIR=1 - ;; - esac - fi - - if test $HAVE_FDOPENDIR = 0 || test $REPLACE_FDOPENDIR = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS fdopendir.$ac_objext" - - fi - - - - - - GNULIB_FDOPENDIR=1 - - - - - - - -cat >>confdefs.h <<_ACEOF -#define GNULIB_FDOPENDIR 1 -_ACEOF - - - - - - - - - - fp_headers=' -# include -# if HAVE_STDIO_EXT_H -# include -# endif -' - ac_fn_c_check_decl "$LINENO" "__fpending" "ac_cv_have_decl___fpending" "$fp_headers -" -if test "x$ac_cv_have_decl___fpending" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL___FPENDING $ac_have_decl -_ACEOF - - - if test $ac_cv_func___fpending = no; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS fpending.$ac_objext" - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to determine the number of pending output bytes on a stream" >&5 -$as_echo_n "checking how to determine the number of pending output bytes on a stream... " >&6; } -if test "${ac_cv_sys_pending_output_n_bytes+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - for ac_expr in \ - \ - '# glibc2' \ - 'fp->_IO_write_ptr - fp->_IO_write_base' \ - \ - '# traditional Unix' \ - 'fp->_ptr - fp->_base' \ - \ - '# BSD' \ - 'fp->_p - fp->_bf._base' \ - \ - '# SCO, Unixware' \ - '(fp->__ptr ? fp->__ptr - fp->__base : 0)' \ - \ - '# QNX' \ - '(fp->_Mode & 0x2000 /*_MWRITE*/ ? fp->_Next - fp->_Buf : 0)' \ - \ - '# old glibc?' \ - 'fp->__bufp - fp->__buffer' \ - \ - '# old glibc iostream?' \ - 'fp->_pptr - fp->_pbase' \ - \ - '# emx+gcc' \ - 'fp->_ptr - fp->_buffer' \ - \ - '# Minix' \ - 'fp->_ptr - fp->_buf' \ - \ - '# Plan9' \ - 'fp->wp - fp->buf' \ - \ - '# VMS' \ - '(*fp)->_ptr - (*fp)->_base' \ - \ - '# e.g., DGUX R4.11; the info is not available' \ - 1 \ - ; do - - # Skip each embedded comment. - case "$ac_expr" in '#'*) continue;; esac - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -FILE *fp = stdin; (void) ($ac_expr); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - fp_done=yes - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$fp_done" = yes && break - done - - ac_cv_sys_pending_output_n_bytes=$ac_expr - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_pending_output_n_bytes" >&5 -$as_echo "$ac_cv_sys_pending_output_n_bytes" >&6; } - -cat >>confdefs.h <<_ACEOF -#define PENDING_OUTPUT_N_BYTES $ac_cv_sys_pending_output_n_bytes -_ACEOF - - - fi - - - - - - - if test $ac_cv_func_fstatat = no; then - HAVE_FSTATAT=0 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fstatat (..., 0) works" >&5 -$as_echo_n "checking whether fstatat (..., 0) works... " >&6; } -if test "${gl_cv_func_fstatat_zero_flag+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - aix*) gl_cv_func_fstatat_zero_flag="guessing no";; - *) gl_cv_func_fstatat_zero_flag="guessing yes";; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - int - main (void) - { - struct stat a; - return fstatat (AT_FDCWD, ".", &a, 0) != 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_fstatat_zero_flag=yes -else - gl_cv_func_fstatat_zero_flag=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_fstatat_zero_flag" >&5 -$as_echo "$gl_cv_func_fstatat_zero_flag" >&6; } - - case $gl_cv_func_fstatat_zero_flag+$gl_cv_func_lstat_dereferences_slashed_symlink in - *yes+*yes) ;; - *) REPLACE_FSTATAT=1 - case $gl_cv_func_fstatat_zero_flag in - *yes) - -$as_echo "#define HAVE_WORKING_FSTATAT_ZERO_FLAG 1" >>confdefs.h - - ;; - esac - ;; - esac - fi - - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS fstatat.$ac_objext" - - fi - - - - - - GNULIB_FSTATAT=1 - - - - - - - -# Persuade glibc to declare getloadavg(). - - -gl_save_LIBS=$LIBS - -# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0, -# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. -HAVE_GETLOADAVG=1 -ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : - -else - gl_func_getloadavg_done=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_func_getloadavg_done = 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_func_getloadavg_done=yes -fi - - fi - - if test $gl_func_getloadavg_done = 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_func_getloadavg_done=yes -else - LIBS=$gl_getloadavg_LIBS -fi - - fi - - # Set up the replacement function if necessary. - if test $gl_func_getloadavg_done = no; then - HAVE_GETLOADAVG=0 - - # 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_func_getloadavg_done=yes - - # AIX has libperfstat which does not require root - if test $gl_func_getloadavg_done = 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_func_getloadavg_done=yes - fi - - if test $gl_func_getloadavg_done = 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_func_getloadavg_done=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 - 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 , not . -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 - #endif - #include -" -if test "x$ac_cv_have_decl_getloadavg" = x""yes; then : - -else - HAVE_DECL_GETLOADAVG=0 -fi - - - if test $HAVE_GETLOADAVG = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext" - - -# Figure out what our getloadavg.c needs. - - - -# On HPUX9, an unprivileged user can get load averages this way. -if test $gl_func_getloadavg_done = 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_func_getloadavg_done=yes -fi -done - -fi - -# We cannot check for , because Solaris 2 does not use dwarf (it -# uses stabs), but it is still SVR4. We cannot check for because -# Irix 4.0.5F has the header but not the library. -if test $gl_func_getloadavg_done = no && test "$ac_cv_lib_elf_elf_begin" = yes \ - && test "$ac_cv_lib_kvm_kvm_open" = yes; then - gl_func_getloadavg_done=yes - -$as_echo "#define SVR4 1" >>confdefs.h - -fi - -if test $gl_func_getloadavg_done = 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_func_getloadavg_done=yes - -$as_echo "#define UMAX 1" >>confdefs.h - - -$as_echo "#define UMAX4_3 1" >>confdefs.h - -fi - - -fi - -if test $gl_func_getloadavg_done = 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_func_getloadavg_done=yes; $as_echo "#define UMAX 1" >>confdefs.h - -fi - - -fi - -if test $gl_func_getloadavg_done = 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 -" -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 -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 - - - - - - GNULIB_GETLOADAVG=1 - - - - - - - - - - - if test $REPLACE_GETOPT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext" - - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext" - - - - - GNULIB_GL_UNISTD_H_GETOPT=1 - fi - - - - - - - - REPLACE_GETOPT=0 - if test -n "$gl_replace_getopt"; then - REPLACE_GETOPT=1 - fi - - if test $REPLACE_GETOPT = 1; then - - GETOPT_H=getopt.h - -$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h - - - - fi - - if test $REPLACE_GETOPT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getopt.$ac_objext" - - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getopt1.$ac_objext" - - - - - GNULIB_GL_UNISTD_H_GETOPT=1 - fi - - - - - - - - - - - - - gl_gettimeofday_timezone=void - if test $ac_cv_func_gettimeofday != yes; then - HAVE_GETTIMEOFDAY=0 - else - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday clobbers localtime buffer" >&5 -$as_echo_n "checking whether gettimeofday clobbers localtime buffer... " >&6; } -if test "${gl_cv_func_gettimeofday_clobber+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - # When cross-compiling: - case "$host_os" in - # Guess all is fine on glibc systems. - *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;; - # If we don't know, assume the worst. - *) gl_cv_func_gettimeofday_clobber="guessing yes" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - #include - #include - -int -main () -{ - - time_t t = 0; - struct tm *lt; - struct tm saved_lt; - struct timeval tv; - lt = localtime (&t); - saved_lt = *lt; - gettimeofday (&tv, NULL); - return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_gettimeofday_clobber=no -else - gl_cv_func_gettimeofday_clobber=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_clobber" >&5 -$as_echo "$gl_cv_func_gettimeofday_clobber" >&6; } - - case "$gl_cv_func_gettimeofday_clobber" in - *yes) - REPLACE_GETTIMEOFDAY=1 - - -$as_echo "#define gmtime rpl_gmtime" >>confdefs.h - - -$as_echo "#define localtime rpl_localtime" >>confdefs.h - - - -$as_echo "#define GETTIMEOFDAY_CLOBBERS_LOCALTIME 1" >>confdefs.h - - ;; - esac - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday with POSIX signature" >&5 -$as_echo_n "checking for gettimeofday with POSIX signature... " >&6; } -if test "${gl_cv_func_gettimeofday_posix_signature+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - struct timeval c; - int gettimeofday (struct timeval *restrict, void *restrict); - -int -main () -{ -/* glibc uses struct timezone * rather than the POSIX void * - if _GNU_SOURCE is defined. However, since the only portable - use of gettimeofday uses NULL as the second parameter, and - since the glibc definition is actually more typesafe, it is - not worth wrapping this to get a compliant signature. */ - int (*f) (struct timeval *restrict, void *restrict) - = gettimeofday; - int x = f (&c, 0); - return !(x | c.tv_sec | c.tv_usec); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_func_gettimeofday_posix_signature=yes -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int gettimeofday (struct timeval *restrict, struct timezone *restrict); - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_func_gettimeofday_posix_signature=almost -else - gl_cv_func_gettimeofday_posix_signature=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_posix_signature" >&5 -$as_echo "$gl_cv_func_gettimeofday_posix_signature" >&6; } - if test $gl_cv_func_gettimeofday_posix_signature = almost; then - gl_gettimeofday_timezone='struct timezone' - elif test $gl_cv_func_gettimeofday_posix_signature != yes; then - REPLACE_GETTIMEOFDAY=1 - fi - if test $REPLACE_STRUCT_TIMEVAL = 1; then - REPLACE_GETTIMEOFDAY=1 - fi - - fi - -cat >>confdefs.h <<_ACEOF -#define GETTIMEOFDAY_TIMEZONE $gl_gettimeofday_timezone -_ACEOF - - - if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS gettimeofday.$ac_objext" - - - for ac_header in sys/timeb.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "sys/timeb.h" "ac_cv_header_sys_timeb_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_timeb_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_TIMEB_H 1 -_ACEOF - -fi - -done - - for ac_func in _ftime -do : - ac_fn_c_check_func "$LINENO" "_ftime" "ac_cv_func__ftime" -if test "x$ac_cv_func__ftime" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE__FTIME 1 -_ACEOF - -fi -done - - - fi - - - - - - GNULIB_GETTIMEOFDAY=1 - - - - - - - - - - - if test $ac_cv_func_lstat = yes; then - - case "$gl_cv_func_lstat_dereferences_slashed_symlink" in - *no) - REPLACE_LSTAT=1 - ;; - esac - else - HAVE_LSTAT=0 - fi - - if test $REPLACE_LSTAT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS lstat.$ac_objext" - - : - fi - - - - - - GNULIB_LSTAT=1 - - - - - - - - - - - if test $ac_cv_have_decl_memrchr = no; then - HAVE_DECL_MEMRCHR=0 - fi - - for ac_func in memrchr -do : - ac_fn_c_check_func "$LINENO" "memrchr" "ac_cv_func_memrchr" -if test "x$ac_cv_func_memrchr" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_MEMRCHR 1 -_ACEOF - -fi -done - - - if test $ac_cv_func_memrchr = no; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS memrchr.$ac_objext" - - : - fi - - - - - - GNULIB_MEMRCHR=1 - - - - - - - - - - - - if test $APPLE_UNIVERSAL_BUILD = 1; then - # A universal build on Apple Mac OS X platforms. - # The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode. - # But we need a configuration result that is valid in both modes. - gl_cv_func_working_mktime=no - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5 -$as_echo_n "checking for working mktime... " >&6; } -if test "${gl_cv_func_working_mktime+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - gl_cv_func_working_mktime=no -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Test program from Paul Eggert and Tony Leneis. */ -#include -#include -#include - -#ifdef HAVE_UNISTD_H -# include -#endif - -#ifndef HAVE_ALARM -# define alarm(X) /* empty */ -#endif - -/* Work around redefinition to rpl_putenv by other config tests. */ -#undef putenv - -static time_t time_t_max; -static time_t time_t_min; - -/* Values we'll use to set the TZ environment variable. */ -static char *tz_strings[] = { - (char *) 0, "TZ=GMT0", "TZ=JST-9", - "TZ=EST+3EDT+2,M10.1.0/00:00:00,M2.3.0/00:00:00" -}; -#define N_STRINGS (sizeof (tz_strings) / sizeof (tz_strings[0])) - -/* Return 0 if mktime fails to convert a date in the spring-forward gap. - Based on a problem report from Andreas Jaeger. */ -static int -spring_forward_gap () -{ - /* glibc (up to about 1998-10-07) failed this test. */ - struct tm tm; - - /* Use the portable POSIX.1 specification "TZ=PST8PDT,M4.1.0,M10.5.0" - instead of "TZ=America/Vancouver" in order to detect the bug even - on systems that don't support the Olson extension, or don't have the - full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); - - tm.tm_year = 98; - tm.tm_mon = 3; - tm.tm_mday = 5; - tm.tm_hour = 2; - tm.tm_min = 0; - tm.tm_sec = 0; - tm.tm_isdst = -1; - return mktime (&tm) != (time_t) -1; -} - -static int -mktime_test1 (time_t now) -{ - struct tm *lt; - return ! (lt = localtime (&now)) || mktime (lt) == now; -} - -static int -mktime_test (time_t now) -{ - return (mktime_test1 (now) - && mktime_test1 ((time_t) (time_t_max - now)) - && mktime_test1 ((time_t) (time_t_min + now))); -} - -static int -irix_6_4_bug () -{ - /* Based on code from Ariel Faigon. */ - struct tm tm; - tm.tm_year = 96; - tm.tm_mon = 3; - tm.tm_mday = 0; - tm.tm_hour = 0; - tm.tm_min = 0; - tm.tm_sec = 0; - tm.tm_isdst = -1; - mktime (&tm); - return tm.tm_mon == 2 && tm.tm_mday == 31; -} - -static int -bigtime_test (int j) -{ - struct tm tm; - time_t now; - tm.tm_year = tm.tm_mon = tm.tm_mday = tm.tm_hour = tm.tm_min = tm.tm_sec = j; - now = mktime (&tm); - if (now != (time_t) -1) - { - struct tm *lt = localtime (&now); - if (! (lt - && lt->tm_year == tm.tm_year - && lt->tm_mon == tm.tm_mon - && lt->tm_mday == tm.tm_mday - && lt->tm_hour == tm.tm_hour - && lt->tm_min == tm.tm_min - && lt->tm_sec == tm.tm_sec - && lt->tm_yday == tm.tm_yday - && lt->tm_wday == tm.tm_wday - && ((lt->tm_isdst < 0 ? -1 : 0 < lt->tm_isdst) - == (tm.tm_isdst < 0 ? -1 : 0 < tm.tm_isdst)))) - return 0; - } - return 1; -} - -static int -year_2050_test () -{ - /* The correct answer for 2050-02-01 00:00:00 in Pacific time, - ignoring leap seconds. */ - unsigned long int answer = 2527315200UL; - - struct tm tm; - time_t t; - tm.tm_year = 2050 - 1900; - tm.tm_mon = 2 - 1; - tm.tm_mday = 1; - tm.tm_hour = tm.tm_min = tm.tm_sec = 0; - tm.tm_isdst = -1; - - /* Use the portable POSIX.1 specification "TZ=PST8PDT,M4.1.0,M10.5.0" - instead of "TZ=America/Vancouver" in order to detect the bug even - on systems that don't support the Olson extension, or don't have the - full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); - - t = mktime (&tm); - - /* Check that the result is either a failure, or close enough - to the correct answer that we can assume the discrepancy is - due to leap seconds. */ - return (t == (time_t) -1 - || (0 < t && answer - 120 <= t && t <= answer + 120)); -} - -int -main () -{ - int result = 0; - time_t t, delta; - int i, j; - int time_t_signed_magnitude = (time_t) ~ (time_t) 0 < (time_t) -1; - int time_t_signed = ! ((time_t) 0 < (time_t) -1); - - /* This test makes some buggy mktime implementations loop. - Give up after 60 seconds; a mktime slower than that - isn't worth using anyway. */ - alarm (60); - - time_t_max = (! time_t_signed - ? (time_t) -1 - : ((((time_t) 1 << (sizeof (time_t) * CHAR_BIT - 2)) - 1) - * 2 + 1)); - time_t_min = (! time_t_signed - ? (time_t) 0 - : time_t_signed_magnitude - ? ~ (time_t) 0 - : ~ time_t_max); - - delta = time_t_max / 997; /* a suitable prime number */ - for (i = 0; i < N_STRINGS; i++) - { - if (tz_strings[i]) - putenv (tz_strings[i]); - - for (t = 0; t <= time_t_max - delta && (result & 1) == 0; t += delta) - if (! mktime_test (t)) - result |= 1; - if ((result & 2) == 0 - && ! (mktime_test ((time_t) 1) - && mktime_test ((time_t) (60 * 60)) - && mktime_test ((time_t) (60 * 60 * 24)))) - result |= 2; - - for (j = 1; (result & 4) == 0; j <<= 1) - { - if (! bigtime_test (j)) - result |= 4; - if (INT_MAX / 2 < j) - break; - } - if ((result & 8) == 0 && ! bigtime_test (INT_MAX)) - result |= 8; - } - if (! irix_6_4_bug ()) - result |= 16; - if (! spring_forward_gap ()) - result |= 32; - if (! year_2050_test ()) - result |= 64; - return result; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_working_mktime=yes -else - gl_cv_func_working_mktime=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_mktime" >&5 -$as_echo "$gl_cv_func_working_mktime" >&6; } - - if test $gl_cv_func_working_mktime = no; then - REPLACE_MKTIME=1 - else - REPLACE_MKTIME=0 - fi - - if test $REPLACE_MKTIME = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext" - - : - fi - - - - - - GNULIB_MKTIME=1 - - - - - - - - - - - - if test $ac_cv_func_pselect = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether signature of pselect conforms to POSIX" >&5 -$as_echo_n "checking whether signature of pselect conforms to POSIX... " >&6; } -if test "${gl_cv_sig_pselect+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -int (*p) (int, fd_set *, fd_set *, fd_set *restrict, - struct timespec const *restrict, - sigset_t const *restrict) = pselect; - return !p; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - gl_cv_sig_pselect=yes -else - gl_cv_sig_pselect=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sig_pselect" >&5 -$as_echo "$gl_cv_sig_pselect" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pselect detects invalid fds" >&5 -$as_echo_n "checking whether pselect detects invalid fds... " >&6; } -if test "${gl_cv_func_pselect_detects_ebadf+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test "$cross_compiling" = yes; then : - - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_pselect_detects_ebadf="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_pselect_detects_ebadf="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#if HAVE_SYS_SELECT_H -# include -#endif -#include -#include - -int -main () -{ - - fd_set set; - dup2(0, 16); - FD_ZERO(&set); - FD_SET(16, &set); - close(16); - struct timespec timeout; - timeout.tv_sec = 0; - timeout.tv_nsec = 5000; - return pselect (17, &set, NULL, NULL, &timeout, NULL) != -1 || errno != EBADF; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_pselect_detects_ebadf=yes -else - gl_cv_func_pselect_detects_ebadf=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pselect_detects_ebadf" >&5 -$as_echo "$gl_cv_func_pselect_detects_ebadf" >&6; } - case $gl_cv_func_pselect_detects_ebadf in - *yes) ;; - *) REPLACE_PSELECT=1 ;; - esac - fi - - if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then - REPLACE_PSELECT=1 - fi - - if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS pselect.$ac_objext" - - fi - - - - - - GNULIB_PSELECT=1 - - - - - - - - - - LIB_PTHREAD_SIGMASK= - - - - - if test "$gl_threads_api" = posix; then - if test $ac_cv_func_pthread_sigmask = yes; then - : - else - if test -n "$LIBMULTITHREAD"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_sigmask in $LIBMULTITHREAD" >&5 -$as_echo_n "checking for pthread_sigmask in $LIBMULTITHREAD... " >&6; } -if test "${gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - gl_save_LIBS="$LIBS" - LIBS="$LIBS $LIBMULTITHREAD" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -return pthread_sigmask (0, (sigset_t *) 0, (sigset_t *) 0); - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes -else - gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LIBS="$gl_save_LIBS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&5 -$as_echo "$gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&6; } - if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then - LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD" - else - HAVE_PTHREAD_SIGMASK=0 - fi - else - HAVE_PTHREAD_SIGMASK=0 - fi - fi - else - if test $ac_cv_func_pthread_sigmask = yes; then - REPLACE_PTHREAD_SIGMASK=1 - else - HAVE_PTHREAD_SIGMASK=0 - fi - fi - - - - - if test $HAVE_PTHREAD_SIGMASK = 1; then - - - if test -z "$LIB_PTHREAD_SIGMASK"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthread_sigmask works without -lpthread" >&5 -$as_echo_n "checking whether pthread_sigmask works without -lpthread... " >&6; } -if test "${gl_cv_func_pthread_sigmask_in_libc_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test "$cross_compiling" = yes; then : - - case "$host_os" in - freebsd* | hpux* | solaris | solaris2.[2-9]*) - gl_cv_func_pthread_sigmask_in_libc_works="guessing no";; - *) - gl_cv_func_pthread_sigmask_in_libc_works="guessing yes";; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -int main () -{ - sigset_t set; - sigemptyset (&set); - return pthread_sigmask (1729, &set, NULL) != 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_pthread_sigmask_in_libc_works=no -else - gl_cv_func_pthread_sigmask_in_libc_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_in_libc_works" >&5 -$as_echo "$gl_cv_func_pthread_sigmask_in_libc_works" >&6; } - case "$gl_cv_func_pthread_sigmask_in_libc_works" in - *no) - REPLACE_PTHREAD_SIGMASK=1 - -$as_echo "#define PTHREAD_SIGMASK_INEFFECTIVE 1" >>confdefs.h - - ;; - esac - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthread_sigmask returns error numbers" >&5 -$as_echo_n "checking whether pthread_sigmask returns error numbers... " >&6; } -if test "${gl_cv_func_pthread_sigmask_return_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - gl_save_LIBS="$LIBS" - LIBS="$LIBS $LIB_PTHREAD_SIGMASK" - if test "$cross_compiling" = yes; then : - case "$host_os" in - cygwin*) - gl_cv_func_pthread_sigmask_return_works="guessing no";; - *) - gl_cv_func_pthread_sigmask_return_works="guessing yes";; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -int main () -{ - sigset_t set; - sigemptyset (&set); - if (pthread_sigmask (1729, &set, NULL) == -1) - return 1; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_pthread_sigmask_return_works=yes -else - gl_cv_func_pthread_sigmask_return_works=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - LIBS="$gl_save_LIBS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_return_works" >&5 -$as_echo "$gl_cv_func_pthread_sigmask_return_works" >&6; } - case "$gl_cv_func_pthread_sigmask_return_works" in - *no) - REPLACE_PTHREAD_SIGMASK=1 - -$as_echo "#define PTHREAD_SIGMASK_FAILS_WITH_ERRNO 1" >>confdefs.h - - ;; - esac - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthread_sigmask unblocks signals correctly" >&5 -$as_echo_n "checking whether pthread_sigmask unblocks signals correctly... " >&6; } -if test "${gl_cv_func_pthread_sigmask_unblock_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - case "$host_os" in - irix*) - gl_cv_func_pthread_sigmask_unblock_works="guessing no";; - *) - gl_cv_func_pthread_sigmask_unblock_works="guessing yes";; - esac - gl_save_LIBS="$LIBS" - LIBS="$LIBS $LIBMULTITHREAD" - if test "$cross_compiling" = yes; then : - : -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -#include -#include -static volatile int sigint_occurred; -static void -sigint_handler (int sig) -{ - sigint_occurred++; -} -int main () -{ - sigset_t set; - int pid = getpid (); - char command[80]; - signal (SIGINT, sigint_handler); - sigemptyset (&set); - sigaddset (&set, SIGINT); - if (!(pthread_sigmask (SIG_BLOCK, &set, NULL) == 0)) - return 1; - sprintf (command, "sh -c 'sleep 1; kill -%d %d' &", SIGINT, pid); - if (!(system (command) == 0)) - return 2; - sleep (2); - if (!(sigint_occurred == 0)) - return 3; - if (!(pthread_sigmask (SIG_UNBLOCK, &set, NULL) == 0)) - return 4; - if (!(sigint_occurred == 1)) /* This fails on IRIX. */ - return 5; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - : -else - gl_cv_func_pthread_sigmask_unblock_works=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - LIBS="$gl_save_LIBS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_unblock_works" >&5 -$as_echo "$gl_cv_func_pthread_sigmask_unblock_works" >&6; } - case "$gl_cv_func_pthread_sigmask_unblock_works" in - *no) - REPLACE_PTHREAD_SIGMASK=1 - -$as_echo "#define PTHREAD_SIGMASK_UNBLOCK_BUG 1" >>confdefs.h - - ;; - esac - fi - - if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS pthread_sigmask.$ac_objext" - - - if test $HAVE_PTHREAD_SIGMASK = 1; then - -$as_echo "#define HAVE_PTHREAD_SIGMASK 1" >>confdefs.h - - fi - - fi - - - - - - GNULIB_PTHREAD_SIGMASK=1 - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for putenv compatible with GNU and SVID" >&5 -$as_echo_n "checking for putenv compatible with GNU and SVID... " >&6; } -if test "${gl_cv_func_svid_putenv+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_svid_putenv="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_svid_putenv="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* Put it in env. */ - if (putenv ("CONFTEST_putenv=val")) - return 1; - - /* Try to remove it. */ - if (putenv ("CONFTEST_putenv")) - return 2; - - /* Make sure it was deleted. */ - if (getenv ("CONFTEST_putenv") != 0) - return 3; - - return 0; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_svid_putenv=yes -else - gl_cv_func_svid_putenv=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_svid_putenv" >&5 -$as_echo "$gl_cv_func_svid_putenv" >&6; } - case "$gl_cv_func_svid_putenv" in - *yes) ;; - *) - REPLACE_PUTENV=1 - ;; - esac - - if test $REPLACE_PUTENV = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS putenv.$ac_objext" - - - for ac_func in _putenv -do : - ac_fn_c_check_func "$LINENO" "_putenv" "ac_cv_func__putenv" -if test "x$ac_cv_func__putenv" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE__PUTENV 1 -_ACEOF - -fi -done - - - fi - - - - - - GNULIB_PUTENV=1 - - - - - - - - - if test $ac_cv_func_readlink = no; then - HAVE_READLINK=0 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether readlink signature is correct" >&5 -$as_echo_n "checking whether readlink signature is correct... " >&6; } -if test "${gl_cv_decl_readlink_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - /* Cause compilation failure if original declaration has wrong type. */ - ssize_t readlink (const char *, char *, size_t); -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_decl_readlink_works=yes -else - gl_cv_decl_readlink_works=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_decl_readlink_works" >&5 -$as_echo "$gl_cv_decl_readlink_works" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether readlink handles trailing slash correctly" >&5 -$as_echo_n "checking whether readlink handles trailing slash correctly... " >&6; } -if test "${gl_cv_func_readlink_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # We have readlink, so assume ln -s works. - ln -s conftest.no-such conftest.link - ln -s conftest.link conftest.lnk2 - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_readlink_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_readlink_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -char buf[20]; - return readlink ("conftest.lnk2/", buf, sizeof buf) != -1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_readlink_works=yes -else - gl_cv_func_readlink_works=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - rm -f conftest.link conftest.lnk2 -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_readlink_works" >&5 -$as_echo "$gl_cv_func_readlink_works" >&6; } - case "$gl_cv_func_readlink_works" in - *yes) - if test "$gl_cv_decl_readlink_works" != yes; then - REPLACE_READLINK=1 - fi - ;; - *) - -$as_echo "#define READLINK_TRAILING_SLASH_BUG 1" >>confdefs.h - - REPLACE_READLINK=1 - ;; - esac - fi - - if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS readlink.$ac_objext" - - - : - - fi - - - - - - GNULIB_READLINK=1 - - - - - - - - - - if test $ac_cv_func_readlinkat = no; then - HAVE_READLINKAT=0 - fi - - if test $HAVE_READLINKAT = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS readlinkat.$ac_objext" - - fi - - - - - - GNULIB_READLINKAT=1 - - - - - - - for ac_func in sig2str -do : - ac_fn_c_check_func "$LINENO" "sig2str" "ac_cv_func_sig2str" -if test "x$ac_cv_func_sig2str" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SIG2STR 1 -_ACEOF - -fi -done - - - if test $ac_cv_func_sig2str = no; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS sig2str.$ac_objext" - - - : - - fi - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_signal_h='<'signal.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_signal_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'signal.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_signal_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_signal_h" >&5 -$as_echo "$gl_cv_next_signal_h" >&6; } - fi - NEXT_SIGNAL_H=$gl_cv_next_signal_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='<'signal.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_signal_h - fi - NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H=$gl_next_as_first_directive - - - - - -# AIX declares sig_atomic_t to already include volatile, and C89 compilers -# then choke on 'volatile sig_atomic_t'. C99 requires that it compile. - ac_fn_c_check_type "$LINENO" "volatile sig_atomic_t" "ac_cv_type_volatile_sig_atomic_t" " -#include - -" -if test "x$ac_cv_type_volatile_sig_atomic_t" = x""yes; then : - -else - HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=0 -fi - - - - - - - - ac_fn_c_check_type "$LINENO" "sighandler_t" "ac_cv_type_sighandler_t" " -#include - -" -if test "x$ac_cv_type_sighandler_t" = x""yes; then : - -else - HAVE_SIGHANDLER_T=0 -fi - - - - - ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" " -/* is not needed according to POSIX, but the - in i386-unknown-freebsd4.10 and - powerpc-apple-darwin5.5 required it. */ -#include -#if HAVE_SYS_SOCKET_H -# include -#elif HAVE_WS2TCPIP_H -# include -#endif - -" -if test "x$ac_cv_type_socklen_t" = x""yes; then : - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t equivalent" >&5 -$as_echo_n "checking for socklen_t equivalent... " >&6; } - if test "${gl_cv_socklen_t_equiv+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - # Systems have either "struct sockaddr *" or - # "void *" as the second argument to getpeername - gl_cv_socklen_t_equiv= - for arg2 in "struct sockaddr" void; do - for t in int size_t "unsigned int" "long int" "unsigned long int"; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - - int getpeername (int, $arg2 *, $t *); -int -main () -{ -$t len; - getpeername (0, 0, &len); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_socklen_t_equiv="$t" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$gl_cv_socklen_t_equiv" != "" && break - done - test "$gl_cv_socklen_t_equiv" != "" && break - done - -fi - - if test "$gl_cv_socklen_t_equiv" = ""; then - as_fn_error "Cannot find a type to use in place of socklen_t" "$LINENO" 5 - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_socklen_t_equiv" >&5 -$as_echo "$gl_cv_socklen_t_equiv" >&6; } - -cat >>confdefs.h <<_ACEOF -#define socklen_t $gl_cv_socklen_t_equiv -_ACEOF - -fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ssize_t" >&5 -$as_echo_n "checking for ssize_t... " >&6; } -if test "${gt_cv_ssize_t+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -int x = sizeof (ssize_t *) + sizeof (ssize_t); - return !x; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gt_cv_ssize_t=yes -else - gt_cv_ssize_t=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_ssize_t" >&5 -$as_echo "$gt_cv_ssize_t" >&6; } - if test $gt_cv_ssize_t = no; then - -$as_echo "#define ssize_t int" >>confdefs.h - - fi - - - - - - ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC 1 -_ACEOF - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct stat.st_atim is of type struct timespec" >&5 -$as_echo_n "checking whether struct stat.st_atim is of type struct timespec... " >&6; } -if test "${ac_cv_typeof_struct_stat_st_atim_is_struct_timespec+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - #if HAVE_SYS_TIME_H - # include - #endif - #include - struct timespec ts; - struct stat st; - -int -main () -{ - - st.st_atim = ts; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes -else - ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&5 -$as_echo "$ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&6; } - if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then - -$as_echo "#define TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC 1" >>confdefs.h - - fi -else - ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC 1 -_ACEOF - - -else - ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_atimensec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_ATIMENSEC 1 -_ACEOF - - -else - ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.st__tim.tv_nsec" "ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC 1 -_ACEOF - - -fi - -fi - -fi - -fi - - - - - - ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimespec.tv_nsec" "ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC 1 -_ACEOF - - -else - ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimensec" "ac_cv_member_struct_stat_st_birthtimensec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_birthtimensec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC 1 -_ACEOF - - -else - ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtim.tv_nsec" "ac_cv_member_struct_stat_st_birthtim_tv_nsec" "#include - #include -" -if test "x$ac_cv_member_struct_stat_st_birthtim_tv_nsec" = x""yes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC 1 -_ACEOF - - -fi - -fi - -fi - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working stdalign.h" >&5 -$as_echo_n "checking for working stdalign.h... " >&6; } -if test "${gl_cv_header_working_stdalign_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - - /* Test that alignof yields a result consistent with offsetof. - This catches GCC bug 52023 - . */ - #ifdef __cplusplus - template struct alignof_helper { char a; t b; }; - # define ao(type) offsetof (alignof_helper, b) - #else - # define ao(type) offsetof (struct { char a; type b; }, b) - #endif - char test_double[ao (double) % _Alignof (double) == 0 ? 1 : -1]; - char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1]; - char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1]; - - /* Test _Alignas only on platforms where gnulib can help. */ - #if \ - (__GNUC__ || __IBMC__ || __IBMCPP__ \ - || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER) - int alignas (8) alignas_int = 1; - char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1]; - #endif - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_header_working_stdalign_h=yes -else - gl_cv_header_working_stdalign_h=no -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_stdalign_h" >&5 -$as_echo "$gl_cv_header_working_stdalign_h" >&6; } - - if test $gl_cv_header_working_stdalign_h = yes; then - STDALIGN_H='' - else - STDALIGN_H='stdalign.h' - fi - - - if test -n "$STDALIGN_H"; then - GL_GENERATE_STDALIGN_H_TRUE= - GL_GENERATE_STDALIGN_H_FALSE='#' -else - GL_GENERATE_STDALIGN_H_TRUE='#' - GL_GENERATE_STDALIGN_H_FALSE= -fi - - - - STDARG_H='' - NEXT_STDARG_H='' - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for va_copy" >&5 -$as_echo_n "checking for va_copy... " >&6; } - if test "${gl_cv_func_va_copy+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - -#ifndef va_copy -void (*func) (va_list, va_list) = va_copy; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_func_va_copy=yes -else - gl_cv_func_va_copy=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_va_copy" >&5 -$as_echo "$gl_cv_func_va_copy" >&6; } - if test $gl_cv_func_va_copy = no; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#if defined _AIX && !defined __GNUC__ - AIX vaccine - #endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "vaccine" >/dev/null 2>&1; then : - gl_aixcc=yes -else - gl_aixcc=no -fi -rm -f conftest* - - if test $gl_aixcc = yes; then - STDARG_H=stdarg.h - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_stdarg_h='<'stdarg.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stdarg_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'stdarg.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_stdarg_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdarg_h" >&5 -$as_echo "$gl_cv_next_stdarg_h" >&6; } - fi - NEXT_STDARG_H=$gl_cv_next_stdarg_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='<'stdarg.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_stdarg_h - fi - NEXT_AS_FIRST_DIRECTIVE_STDARG_H=$gl_next_as_first_directive - - - - - if test "$gl_cv_next_stdarg_h" = '""'; then - gl_cv_next_stdarg_h='"///usr/include/stdarg.h"' - NEXT_STDARG_H="$gl_cv_next_stdarg_h" - fi - else - - saved_as_echo_n="$as_echo_n" - as_echo_n=':' - if test "${gl_cv_func___va_copy+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - -#ifndef __va_copy -error, bail out -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_func___va_copy=yes -else - gl_cv_func___va_copy=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi - - as_echo_n="$saved_as_echo_n" - - if test $gl_cv_func___va_copy = yes; then - -$as_echo "#define va_copy __va_copy" >>confdefs.h - - else - - -$as_echo "#define va_copy gl_va_copy" >>confdefs.h - - fi - fi - fi - - if test -n "$STDARG_H"; then - GL_GENERATE_STDARG_H_TRUE= - GL_GENERATE_STDARG_H_FALSE='#' -else - GL_GENERATE_STDARG_H_TRUE='#' - GL_GENERATE_STDARG_H_FALSE= -fi - - - - - - - # Define two additional variables used in the Makefile substitution. - - if test "$ac_cv_header_stdbool_h" = yes; then - STDBOOL_H='' - else - STDBOOL_H='stdbool.h' - fi - - if test -n "$STDBOOL_H"; then - GL_GENERATE_STDBOOL_H_TRUE= - GL_GENERATE_STDBOOL_H_FALSE='#' -else - GL_GENERATE_STDBOOL_H_TRUE='#' - GL_GENERATE_STDBOOL_H_FALSE= -fi - - - if test "$ac_cv_type__Bool" = yes; then - HAVE__BOOL=1 - else - HAVE__BOOL=0 - fi - - - - - - STDDEF_H= - if test $gt_cv_c_wchar_t = no; then - HAVE_WCHAR_T=0 - STDDEF_H=stddef.h - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether NULL can be used in arbitrary expressions" >&5 -$as_echo_n "checking whether NULL can be used in arbitrary expressions... " >&6; } -if test "${gl_cv_decl_null_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - int test[2 * (sizeof NULL == sizeof (void *)) -1]; - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_decl_null_works=yes -else - gl_cv_decl_null_works=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_decl_null_works" >&5 -$as_echo "$gl_cv_decl_null_works" >&6; } - if test $gl_cv_decl_null_works = no; then - REPLACE_NULL=1 - STDDEF_H=stddef.h - fi - - if test -n "$STDDEF_H"; then - GL_GENERATE_STDDEF_H_TRUE= - GL_GENERATE_STDDEF_H_FALSE='#' -else - GL_GENERATE_STDDEF_H_TRUE='#' - GL_GENERATE_STDDEF_H_FALSE= -fi - - if test -n "$STDDEF_H"; then - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_stddef_h='<'stddef.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stddef_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'stddef.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_stddef_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stddef_h" >&5 -$as_echo "$gl_cv_next_stddef_h" >&6; } - fi - NEXT_STDDEF_H=$gl_cv_next_stddef_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='<'stddef.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_stddef_h - fi - NEXT_AS_FIRST_DIRECTIVE_STDDEF_H=$gl_next_as_first_directive - - - - - fi - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_stdio_h='<'stdio.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stdio_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'stdio.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_stdio_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdio_h" >&5 -$as_echo "$gl_cv_next_stdio_h" >&6; } - fi - NEXT_STDIO_H=$gl_cv_next_stdio_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='<'stdio.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_stdio_h - fi - NEXT_AS_FIRST_DIRECTIVE_STDIO_H=$gl_next_as_first_directive - - - - - - GNULIB_FSCANF=1 - - -cat >>confdefs.h <<_ACEOF -#define GNULIB_FSCANF 1 -_ACEOF - - - GNULIB_SCANF=1 - - -cat >>confdefs.h <<_ACEOF -#define GNULIB_SCANF 1 -_ACEOF - - - GNULIB_FGETC=1 - GNULIB_GETC=1 - GNULIB_GETCHAR=1 - GNULIB_FGETS=1 - GNULIB_FREAD=1 - - - GNULIB_FPRINTF=1 - GNULIB_PRINTF=1 - GNULIB_VFPRINTF=1 - GNULIB_VPRINTF=1 - GNULIB_FPUTC=1 - GNULIB_PUTC=1 - GNULIB_PUTCHAR=1 - GNULIB_FPUTS=1 - GNULIB_PUTS=1 - GNULIB_FWRITE=1 - - - - - - - - - - - - - - - - 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 " >&5 -$as_echo_n "checking absolute name of ... " >&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 - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'stdlib.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_stdlib_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - - -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 - - - - - - - - - - # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE. - - - - - - - -$as_echo "#define my_strftime nstrftime" >>confdefs.h - - - - - - - - - - - - if test "$ac_cv_have_decl_strtoimax" != yes; then - HAVE_DECL_STRTOIMAX=0 - fi - - if test $ac_cv_func_strtoimax = yes; then - HAVE_STRTOIMAX=1 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtoimax works" >&5 -$as_echo_n "checking whether strtoimax works... " >&6; } -if test "${gl_cv_func_strtoimax+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess no on AIX 5. - aix5*) gl_cv_func_strtoimax="guessing no" ;; - # Guess yes otherwise. - *) gl_cv_func_strtoimax="guessing yes" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include -int main () -{ - if (sizeof (intmax_t) > sizeof (int)) - { - const char *s = "4294967295"; - char *p; - intmax_t res; - errno = 0; - res = strtoimax (s, &p, 10); - if (p != s + strlen (s)) - return 1; - if (errno != 0) - return 2; - if (res != (intmax_t) 65535 * (intmax_t) 65537) - return 3; - } - else - { - const char *s = "2147483647"; - char *p; - intmax_t res; - errno = 0; - res = strtoimax (s, &p, 10); - if (p != s + strlen (s)) - return 1; - if (errno != 0) - return 2; - if (res != 2147483647) - return 3; - } - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_strtoimax=yes -else - gl_cv_func_strtoimax=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_strtoimax" >&5 -$as_echo "$gl_cv_func_strtoimax" >&6; } - case "$gl_cv_func_strtoimax" in - *no) REPLACE_STRTOIMAX=1 ;; - esac - else - HAVE_STRTOIMAX=0 - fi - - if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS strtoimax.$ac_objext" - - - ac_fn_c_check_decl "$LINENO" "strtoll" "ac_cv_have_decl_strtoll" "$ac_includes_default" -if test "x$ac_cv_have_decl_strtoll" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_STRTOLL $ac_have_decl -_ACEOF - - - - fi - - - - - - GNULIB_STRTOIMAX=1 - - - - - - - - - - if test "$ac_cv_have_decl_strtoumax" != yes; then - HAVE_DECL_STRTOUMAX=0 - fi - - if test $ac_cv_func_strtoumax = no; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS strtoumax.$ac_objext" - - - ac_fn_c_check_decl "$LINENO" "strtoull" "ac_cv_have_decl_strtoull" "$ac_includes_default" -if test "x$ac_cv_have_decl_strtoull" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_STRTOULL $ac_have_decl -_ACEOF - - - - fi - - - - - - GNULIB_STRTOUMAX=1 - - - - - - - - if test $ac_cv_func_symlink = no; then - HAVE_SYMLINK=0 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether symlink handles trailing slash correctly" >&5 -$as_echo_n "checking whether symlink handles trailing slash correctly... " >&6; } -if test "${gl_cv_func_symlink_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_symlink_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_symlink_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -int result = 0; - if (!symlink ("a", "conftest.link/")) - result |= 1; - if (symlink ("conftest.f", "conftest.lnk2")) - result |= 2; - else if (!symlink ("a", "conftest.lnk2/")) - result |= 4; - return result; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_symlink_works=yes -else - gl_cv_func_symlink_works=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - rm -f conftest.f conftest.link conftest.lnk2 -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_symlink_works" >&5 -$as_echo "$gl_cv_func_symlink_works" >&6; } - case "$gl_cv_func_symlink_works" in - *yes) ;; - *) - REPLACE_SYMLINK=1 - ;; - esac - fi - - if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext" - - fi - - - - - - GNULIB_SYMLINK=1 - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether is self-contained" >&5 -$as_echo_n "checking whether is self-contained... " >&6; } -if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -struct timeval b; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_header_sys_select_h_selfcontained=yes -else - gl_cv_header_sys_select_h_selfcontained=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $gl_cv_header_sys_select_h_selfcontained = yes; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -int memset; int bzero; - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - - #undef memset - #define memset nonexistent_memset - extern - #ifdef __cplusplus - "C" - #endif - void *memset (void *, int, unsigned long); - #undef bzero - #define bzero nonexistent_bzero - extern - #ifdef __cplusplus - "C" - #endif - void bzero (void *, unsigned long); - fd_set fds; - FD_ZERO (&fds); - - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - -else - gl_cv_header_sys_select_h_selfcontained=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5 -$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; } - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_sys_select_h='<'sys/select.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_sys_select_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_sys_select_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'sys/select.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_sys_select_h='<'sys/select.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5 -$as_echo "$gl_cv_next_sys_select_h" >&6; } - fi - NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_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/select.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_sys_select_h - fi - NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive - - - - - if test $ac_cv_header_sys_select_h = yes; then - HAVE_SYS_SELECT_H=1 - else - HAVE_SYS_SELECT_H=0 - fi - - - - - - if test $ac_cv_header_sys_socket_h != yes; then - for ac_header in winsock2.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default" -if test "x$ac_cv_header_winsock2_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_WINSOCK2_H 1 -_ACEOF - -fi - -done - - fi - if test "$ac_cv_header_winsock2_h" = yes; then - HAVE_WINSOCK2_H=1 - UNISTD_H_HAVE_WINSOCK2_H=1 - SYS_IOCTL_H_HAVE_WINSOCK2_H=1 - else - HAVE_WINSOCK2_H=0 - fi - - - - - - - - - - - - - - - - - - - - - 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 " >&5 -$as_echo_n "checking absolute name of ... " >&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 - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'sys/stat.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_sys_stat_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - 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 - - - - - - - - - - - - if test $WINDOWS_64_BIT_ST_SIZE = 1; then - -$as_echo "#define _GL_WINDOWS_64_BIT_ST_SIZE 1" >>confdefs.h - - fi - - ac_fn_c_check_type "$LINENO" "nlink_t" "ac_cv_type_nlink_t" "#include - #include -" -if test "x$ac_cv_type_nlink_t" = x""yes; then : - -else - -$as_echo "#define nlink_t int" >>confdefs.h - -fi - - - - - - - - - - - - - - - - - - - ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "#include -" -if test "x$ac_cv_have_decl_localtime_r" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_LOCALTIME_R $ac_have_decl -_ACEOF - - if test $ac_cv_have_decl_localtime_r = no; then - HAVE_DECL_LOCALTIME_R=0 - fi - - - if test $ac_cv_func_localtime_r = yes; then - HAVE_LOCALTIME_R=1 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime_r is compatible with its POSIX signature" >&5 -$as_echo_n "checking whether localtime_r is compatible with its POSIX signature... " >&6; } -if test "${gl_cv_time_r_posix+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -/* We don't need to append 'restrict's to the argument types, - even though the POSIX signature has the 'restrict's, - since C99 says they can't affect type compatibility. */ - struct tm * (*ptr) (time_t const *, struct tm *) = localtime_r; - if (ptr) return 0; - /* Check the return type is a pointer. - On HP-UX 10 it is 'int'. */ - *localtime_r (0, 0); - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_time_r_posix=yes -else - gl_cv_time_r_posix=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_time_r_posix" >&5 -$as_echo "$gl_cv_time_r_posix" >&6; } - if test $gl_cv_time_r_posix = yes; then - REPLACE_LOCALTIME_R=0 - else - REPLACE_LOCALTIME_R=1 - fi - else - HAVE_LOCALTIME_R=0 - fi - - if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS time_r.$ac_objext" - - - : - - fi - - - - - - GNULIB_TIME_R=1 - - - - - - - - - - - LIB_TIMER_TIME= - - gl_saved_libs=$LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing timer_settime" >&5 -$as_echo_n "checking for library containing timer_settime... " >&6; } -if test "${ac_cv_search_timer_settime+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$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 timer_settime (); -int -main () -{ -return timer_settime (); - ; - return 0; -} -_ACEOF -for ac_lib in '' rt posix4; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_timer_settime=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if test "${ac_cv_search_timer_settime+set}" = set; then : - break -fi -done -if test "${ac_cv_search_timer_settime+set}" = set; then : - -else - ac_cv_search_timer_settime=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_timer_settime" >&5 -$as_echo "$ac_cv_search_timer_settime" >&6; } -ac_res=$ac_cv_search_timer_settime -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - test "$ac_cv_search_timer_settime" = "none required" || - LIB_TIMER_TIME=$ac_cv_search_timer_settime -fi - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#ifdef __GNU_LIBRARY__ - #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \ - && !defined __UCLIBC__ - Thread emulation available - #endif -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "Thread" >/dev/null 2>&1; then : - LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD" -fi -rm -f conftest* - - for ac_func in timer_settime -do : - ac_fn_c_check_func "$LINENO" "timer_settime" "ac_cv_func_timer_settime" -if test "x$ac_cv_func_timer_settime" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_TIMER_SETTIME 1 -_ACEOF - -fi -done - - LIBS=$gl_saved_libs - - : - - - - - - - - - - - - - if test $gl_cv_have_include_next = yes; then - gl_cv_next_unistd_h='<'unistd.h'>' - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 -$as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_unistd_h+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - - if test $ac_cv_header_unistd_h = yes; then - - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF - case "$host_os" in - aix*) gl_absname_cpp="$ac_cpp -C" ;; - *) gl_absname_cpp="$ac_cpp" ;; - esac - - case "$host_os" in - mingw*) - gl_dirsep_regex='[/\\]' - ;; - *) - gl_dirsep_regex='\/' - ;; - esac - gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' - - gl_header_literal_regex=`echo 'unistd.h' \ - | sed -e "$gl_make_literal_regex_sed"` - gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ - s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ - s|^/[^/]|//&| - p - q - }' - gl_cv_next_unistd_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | - sed -n "$gl_absolute_header_sed"`'"' - else - gl_cv_next_unistd_h='<'unistd.h'>' - fi - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_unistd_h" >&5 -$as_echo "$gl_cv_next_unistd_h" >&6; } - fi - NEXT_UNISTD_H=$gl_cv_next_unistd_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='<'unistd.h'>' - else - # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=$gl_cv_next_unistd_h - fi - NEXT_AS_FIRST_DIRECTIVE_UNISTD_H=$gl_next_as_first_directive - - - - - if test $ac_cv_header_unistd_h = yes; then - HAVE_UNISTD_H=1 - else - HAVE_UNISTD_H=0 - fi - - - - - - - - - - - - if test $ac_cv_have_decl_unsetenv = no; then - HAVE_DECL_UNSETENV=0 - fi - for ac_func in unsetenv -do : - ac_fn_c_check_func "$LINENO" "unsetenv" "ac_cv_func_unsetenv" -if test "x$ac_cv_func_unsetenv" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_UNSETENV 1 -_ACEOF - -fi -done - - if test $ac_cv_func_unsetenv = no; then - HAVE_UNSETENV=0 - else - HAVE_UNSETENV=1 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsetenv() return type" >&5 -$as_echo_n "checking for unsetenv() return type... " >&6; } -if test "${gt_cv_func_unsetenv_ret+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#undef _BSD -#define _BSD 1 /* unhide unsetenv declaration in OSF/1 5.1 */ -#include -extern -#ifdef __cplusplus -"C" -#endif -int unsetenv (const char *name); - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gt_cv_func_unsetenv_ret='int' -else - gt_cv_func_unsetenv_ret='void' -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_unsetenv_ret" >&5 -$as_echo "$gt_cv_func_unsetenv_ret" >&6; } - if test $gt_cv_func_unsetenv_ret = 'void'; then - -$as_echo "#define VOID_UNSETENV 1" >>confdefs.h - - REPLACE_UNSETENV=1 - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether unsetenv obeys POSIX" >&5 -$as_echo_n "checking whether unsetenv obeys POSIX... " >&6; } -if test "${gl_cv_func_unsetenv_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_unsetenv_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_unsetenv_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - extern char **environ; - -int -main () -{ - - char entry1[] = "a=1"; - char entry2[] = "b=2"; - char *env[] = { entry1, entry2, NULL }; - if (putenv ((char *) "a=1")) return 1; - if (putenv (entry2)) return 2; - entry2[0] = 'a'; - unsetenv ("a"); - if (getenv ("a")) return 3; - if (!unsetenv ("") || errno != EINVAL) return 4; - entry2[0] = 'b'; - environ = env; - if (!getenv ("a")) return 5; - entry2[0] = 'a'; - unsetenv ("a"); - if (getenv ("a")) return 6; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_unsetenv_works=yes -else - gl_cv_func_unsetenv_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_unsetenv_works" >&5 -$as_echo "$gl_cv_func_unsetenv_works" >&6; } - case "$gl_cv_func_unsetenv_works" in - *yes) ;; - *) - REPLACE_UNSETENV=1 - ;; - esac - fi - - if test $HAVE_UNSETENV = 0 || test $REPLACE_UNSETENV = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS unsetenv.$ac_objext" - - - - - - fi - - - - - - GNULIB_UNSETENV=1 - - - - - - - - - - - - if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether futimesat handles NULL file" >&5 -$as_echo_n "checking whether futimesat handles NULL file... " >&6; } -if test "${gl_cv_func_futimesat_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - touch conftest.file - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_futimesat_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include -#include - -int -main () -{ - int fd = open ("conftest.file", O_RDWR); - if (fd < 0) return 1; - if (futimesat (fd, NULL, NULL)) return 2; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_futimesat_works=yes -else - gl_cv_func_futimesat_works=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - rm -f conftest.file -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_futimesat_works" >&5 -$as_echo "$gl_cv_func_futimesat_works" >&6; } - case "$gl_cv_func_futimesat_works" in - *yes) ;; - *) - -$as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h - - ;; - esac - fi - - gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false - gl_gnulib_enabled_dosname=false - gl_gnulib_enabled_euidaccess=false - gl_gnulib_enabled_getgroups=false - gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false - gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false - gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false - gl_gnulib_enabled_pathmax=false - gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false - gl_gnulib_enabled_stat=false - gl_gnulib_enabled_strtoll=false - gl_gnulib_enabled_strtoull=false - gl_gnulib_enabled_verify=false - gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false - func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b () - { - if ! $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS openat-proc.$ac_objext" - - gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true - fi - } - func_gl_gnulib_m4code_dosname () - { - if ! $gl_gnulib_enabled_dosname; then - gl_gnulib_enabled_dosname=true - fi - } - func_gl_gnulib_m4code_euidaccess () - { - if ! $gl_gnulib_enabled_euidaccess; then - - - - - - for ac_func in euidaccess -do : - ac_fn_c_check_func "$LINENO" "euidaccess" "ac_cv_func_euidaccess" -if test "x$ac_cv_func_euidaccess" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_EUIDACCESS 1 -_ACEOF - -fi -done - - if test $ac_cv_func_euidaccess = no; then - HAVE_EUIDACCESS=0 - fi - - if test $HAVE_EUIDACCESS = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS euidaccess.$ac_objext" - - - - for ac_header in libgen.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "libgen.h" "ac_cv_header_libgen_h" "$ac_includes_default" -if test "x$ac_cv_header_libgen_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBGEN_H 1 -_ACEOF - -fi - -done - - - ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups" -if test "x$ac_cv_func_getgroups" = x""yes; then : - -fi - - - # If we don't yet have getgroups, see if it's in -lbsd. - # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. - ac_save_LIBS=$LIBS - if test $ac_cv_func_getgroups = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5 -$as_echo_n "checking for getgroups in -lbsd... " >&6; } -if test "${ac_cv_lib_bsd_getgroups+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lbsd $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 getgroups (); -int -main () -{ -return getgroups (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_bsd_getgroups=yes -else - ac_cv_lib_bsd_getgroups=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_bsd_getgroups" >&5 -$as_echo "$ac_cv_lib_bsd_getgroups" >&6; } -if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then : - GETGROUPS_LIB=-lbsd -fi - - fi - - # Run the program to test the functionality of the system-supplied - # getgroups function only if there is such a function. - if test $ac_cv_func_getgroups = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5 -$as_echo_n "checking for working getgroups... " >&6; } -if test "${ac_cv_func_getgroups_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in # (( - # Guess yes on glibc systems. - *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;; - # If we don't know, assume the worst. - *) ac_cv_func_getgroups_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -/* On Ultrix 4.3, getgroups (0, 0) always fails. */ - return getgroups (0, 0) == -1; - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_getgroups_works=yes -else - ac_cv_func_getgroups_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5 -$as_echo "$ac_cv_func_getgroups_works" >&6; } - else - ac_cv_func_getgroups_works=no - fi - case "$ac_cv_func_getgroups_works" in - *yes) - -$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h - - ;; - esac - LIBS=$ac_save_LIBS - - - # Solaris 9 and 10 need -lgen to get the eaccess function. - # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all* - # programs in the package would end up linked with that potentially-shared - # library, inducing unnecessary run-time overhead. - LIB_EACCESS= - - gl_saved_libs=$LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing eaccess" >&5 -$as_echo_n "checking for library containing eaccess... " >&6; } -if test "${ac_cv_search_eaccess+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_func_search_save_LIBS=$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 eaccess (); -int -main () -{ -return eaccess (); - ; - return 0; -} -_ACEOF -for ac_lib in '' gen; do - if test -z "$ac_lib"; then - ac_res="none required" - else - ac_res=-l$ac_lib - LIBS="-l$ac_lib $ac_func_search_save_LIBS" - fi - if ac_fn_c_try_link "$LINENO"; then : - ac_cv_search_eaccess=$ac_res -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext - if test "${ac_cv_search_eaccess+set}" = set; then : - break -fi -done -if test "${ac_cv_search_eaccess+set}" = set; then : - -else - ac_cv_search_eaccess=no -fi -rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_eaccess" >&5 -$as_echo "$ac_cv_search_eaccess" >&6; } -ac_res=$ac_cv_search_eaccess -if test "$ac_res" != no; then : - test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" - test "$ac_cv_search_eaccess" = "none required" || - LIB_EACCESS=$ac_cv_search_eaccess -fi - - for ac_func in eaccess -do : - ac_fn_c_check_func "$LINENO" "eaccess" "ac_cv_func_eaccess" -if test "x$ac_cv_func_eaccess" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_EACCESS 1 -_ACEOF - -fi -done - - LIBS=$gl_saved_libs - - fi - - - - - - GNULIB_EUIDACCESS=1 - - - - - - gl_gnulib_enabled_euidaccess=true - if test $HAVE_EUIDACCESS = 0; then - func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 - fi - func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c - if test $HAVE_EUIDACCESS = 0; then - func_gl_gnulib_m4code_stat - fi - fi - } - func_gl_gnulib_m4code_getgroups () - { - if ! $gl_gnulib_enabled_getgroups; then - - - - - - ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups" -if test "x$ac_cv_func_getgroups" = x""yes; then : - -fi - - - # If we don't yet have getgroups, see if it's in -lbsd. - # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. - ac_save_LIBS=$LIBS - if test $ac_cv_func_getgroups = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5 -$as_echo_n "checking for getgroups in -lbsd... " >&6; } -if test "${ac_cv_lib_bsd_getgroups+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lbsd $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 getgroups (); -int -main () -{ -return getgroups (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_bsd_getgroups=yes -else - ac_cv_lib_bsd_getgroups=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_bsd_getgroups" >&5 -$as_echo "$ac_cv_lib_bsd_getgroups" >&6; } -if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then : - GETGROUPS_LIB=-lbsd -fi - - fi - - # Run the program to test the functionality of the system-supplied - # getgroups function only if there is such a function. - if test $ac_cv_func_getgroups = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5 -$as_echo_n "checking for working getgroups... " >&6; } -if test "${ac_cv_func_getgroups_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in # (( - # Guess yes on glibc systems. - *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;; - # If we don't know, assume the worst. - *) ac_cv_func_getgroups_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -/* On Ultrix 4.3, getgroups (0, 0) always fails. */ - return getgroups (0, 0) == -1; - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_func_getgroups_works=yes -else - ac_cv_func_getgroups_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5 -$as_echo "$ac_cv_func_getgroups_works" >&6; } - else - ac_cv_func_getgroups_works=no - fi - case "$ac_cv_func_getgroups_works" in - *yes) - -$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h - - ;; - esac - LIBS=$ac_save_LIBS - - if test $ac_cv_func_getgroups != yes; then - HAVE_GETGROUPS=0 - else - if test "$ac_cv_type_getgroups" != gid_t \ - || { case "$ac_cv_func_getgroups_works" in - *yes) false;; - *) true;; - esac - }; then - REPLACE_GETGROUPS=1 - -$as_echo "#define GETGROUPS_ZERO_BUG 1" >>confdefs.h - - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getgroups handles negative values" >&5 -$as_echo_n "checking whether getgroups handles negative values... " >&6; } -if test "${gl_cv_func_getgroups_works+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_getgroups_works="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ -int size = getgroups (0, 0); - gid_t *list = malloc (size * sizeof *list); - return getgroups (-1, list) != -1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_getgroups_works=yes -else - gl_cv_func_getgroups_works=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getgroups_works" >&5 -$as_echo "$gl_cv_func_getgroups_works" >&6; } - case "$gl_cv_func_getgroups_works" in - *yes) ;; - *) REPLACE_GETGROUPS=1 ;; - esac - fi - fi - test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS" - - if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS getgroups.$ac_objext" - - fi - - - - - - GNULIB_GETGROUPS=1 - - - - - - gl_gnulib_enabled_getgroups=true - fi - } - func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 () - { - if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then - - - gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true - fi - } - func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 () - { - if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then - - - - - - ac_fn_c_check_func "$LINENO" "group_member" "ac_cv_func_group_member" -if test "x$ac_cv_func_group_member" = x""yes; then : - -else - - HAVE_GROUP_MEMBER=0 - -fi - - - if test $HAVE_GROUP_MEMBER = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS group-member.$ac_objext" - - - - - fi - - - - - - GNULIB_GROUP_MEMBER=1 - - - - - - gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true - if test $HAVE_GROUP_MEMBER = 0; then - func_gl_gnulib_m4code_getgroups - fi - if test $HAVE_GROUP_MEMBER = 0; then - func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec - fi - fi - } - func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 () - { - if ! $gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7; then - gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=true - fi - } - func_gl_gnulib_m4code_pathmax () - { - if ! $gl_gnulib_enabled_pathmax; then - - - - gl_gnulib_enabled_pathmax=true - fi - } - func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c () - { - if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then - gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true - fi - } - func_gl_gnulib_m4code_stat () - { - if ! $gl_gnulib_enabled_stat; then - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on directories" >&5 -$as_echo_n "checking whether stat handles trailing slashes on directories... " >&6; } -if test "${gl_cv_func_stat_dir_slash+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - if test "$cross_compiling" = yes; then : - case $host_os in - mingw*) gl_cv_func_stat_dir_slash="guessing no";; - *) gl_cv_func_stat_dir_slash="guessing yes";; - esac -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -struct stat st; return stat (".", &st) != stat ("./", &st); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_stat_dir_slash=yes -else - gl_cv_func_stat_dir_slash=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 -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_dir_slash" >&5 -$as_echo "$gl_cv_func_stat_dir_slash" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5 -$as_echo_n "checking whether stat handles trailing slashes on files... " >&6; } -if test "${gl_cv_func_stat_file_slash+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - touch conftest.tmp - # Assume that if we have lstat, we can also check symlinks. - if test $ac_cv_func_lstat = yes; then - ln -s conftest.tmp conftest.lnk - fi - if test "$cross_compiling" = yes; then : - case "$host_os" in - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;; - # If we don't know, assume the worst. - *) gl_cv_func_stat_file_slash="guessing no" ;; - esac - -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -int result = 0; - struct stat st; - if (!stat ("conftest.tmp/", &st)) - result |= 1; -#if HAVE_LSTAT - if (!stat ("conftest.lnk/", &st)) - result |= 2; -#endif - return result; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_stat_file_slash=yes -else - gl_cv_func_stat_file_slash=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - rm -f conftest.tmp conftest.lnk -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_file_slash" >&5 -$as_echo "$gl_cv_func_stat_file_slash" >&6; } - case $gl_cv_func_stat_dir_slash in - *no) REPLACE_STAT=1 - -$as_echo "#define REPLACE_FUNC_STAT_DIR 1" >>confdefs.h -;; - esac - case $gl_cv_func_stat_file_slash in - *no) REPLACE_STAT=1 - -$as_echo "#define REPLACE_FUNC_STAT_FILE 1" >>confdefs.h -;; - esac - - if test $REPLACE_STAT = 1; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS stat.$ac_objext" - - : - fi - - - - - - GNULIB_STAT=1 - - - - - - gl_gnulib_enabled_stat=true - if test $REPLACE_STAT = 1; then - func_gl_gnulib_m4code_dosname - fi - if test $REPLACE_STAT = 1; then - func_gl_gnulib_m4code_pathmax - fi - if test $REPLACE_STAT = 1; then - func_gl_gnulib_m4code_verify - fi - fi - } - func_gl_gnulib_m4code_strtoll () - { - if ! $gl_gnulib_enabled_strtoll; then - - - - if test "$ac_cv_type_long_long_int" = yes; then - for ac_func in strtoll -do : - ac_fn_c_check_func "$LINENO" "strtoll" "ac_cv_func_strtoll" -if test "x$ac_cv_func_strtoll" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_STRTOLL 1 -_ACEOF - -fi -done - - if test $ac_cv_func_strtoll = no; then - HAVE_STRTOLL=0 - fi - fi - - if test $HAVE_STRTOLL = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS strtoll.$ac_objext" - - - : - - fi - - - - - - GNULIB_STRTOLL=1 - - - - - - gl_gnulib_enabled_strtoll=true - fi - } - func_gl_gnulib_m4code_strtoull () - { - if ! $gl_gnulib_enabled_strtoull; then - - - - if test "$ac_cv_type_unsigned_long_long_int" = yes; then - for ac_func in strtoull -do : - ac_fn_c_check_func "$LINENO" "strtoull" "ac_cv_func_strtoull" -if test "x$ac_cv_func_strtoull" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_STRTOULL 1 -_ACEOF - -fi -done - - if test $ac_cv_func_strtoull = no; then - HAVE_STRTOULL=0 - fi - fi - - if test $HAVE_STRTOULL = 0; then - - - - - - - - - gl_LIBOBJS="$gl_LIBOBJS strtoull.$ac_objext" - - - : - - fi - - - - - - GNULIB_STRTOULL=1 - - - - - - gl_gnulib_enabled_strtoull=true - fi - } - func_gl_gnulib_m4code_verify () - { - if ! $gl_gnulib_enabled_verify; then - gl_gnulib_enabled_verify=true - fi - } - func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () - { - if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then - gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true - fi - } - if test $HAVE_FACCESSAT = 0; then - func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b - fi - if test $HAVE_FACCESSAT = 0; then - func_gl_gnulib_m4code_dosname - fi - if test $HAVE_FACCESSAT = 0; then - func_gl_gnulib_m4code_euidaccess - fi - if test $HAVE_FACCESSAT = 0; then - func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 - fi - if test $HAVE_FDOPENDIR = 0; then - func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b - fi - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b - fi - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - func_gl_gnulib_m4code_dosname - fi - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 - fi - if test $REPLACE_GETOPT = 1; then - func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 - fi - if test $REPLACE_LSTAT = 1; then - func_gl_gnulib_m4code_dosname - fi - if test $REPLACE_LSTAT = 1; then - func_gl_gnulib_m4code_stat - fi - if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then - func_gl_gnulib_m4code_stat - fi - if test $HAVE_READLINKAT = 0; then - func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b - fi - if test $HAVE_READLINKAT = 0; then - func_gl_gnulib_m4code_dosname - fi - if test $HAVE_READLINKAT = 0; then - func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 - fi - if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then - func_gl_gnulib_m4code_strtoll - fi - if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then - func_gl_gnulib_m4code_verify - fi - if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then - func_gl_gnulib_m4code_strtoull - fi - if test $ac_cv_func_strtoumax = no; then - func_gl_gnulib_m4code_verify - fi - - if $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then - gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_TRUE= - gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_FALSE='#' -else - gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_TRUE='#' - gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_FALSE= -fi - - if $gl_gnulib_enabled_dosname; then - gl_GNULIB_ENABLED_dosname_TRUE= - gl_GNULIB_ENABLED_dosname_FALSE='#' -else - gl_GNULIB_ENABLED_dosname_TRUE='#' - gl_GNULIB_ENABLED_dosname_FALSE= -fi - - if $gl_gnulib_enabled_euidaccess; then - gl_GNULIB_ENABLED_euidaccess_TRUE= - gl_GNULIB_ENABLED_euidaccess_FALSE='#' -else - gl_GNULIB_ENABLED_euidaccess_TRUE='#' - gl_GNULIB_ENABLED_euidaccess_FALSE= -fi - - if $gl_gnulib_enabled_getgroups; then - gl_GNULIB_ENABLED_getgroups_TRUE= - gl_GNULIB_ENABLED_getgroups_FALSE='#' -else - gl_GNULIB_ENABLED_getgroups_TRUE='#' - gl_GNULIB_ENABLED_getgroups_FALSE= -fi - - if $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then - gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE= - gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE='#' -else - gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE='#' - gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE= -fi - - if $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then - gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE= - gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE='#' -else - gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE='#' - gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE= -fi - - if $gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7; then - gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_TRUE= - gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_FALSE='#' -else - gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_TRUE='#' - gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_FALSE= -fi - - if $gl_gnulib_enabled_pathmax; then - gl_GNULIB_ENABLED_pathmax_TRUE= - gl_GNULIB_ENABLED_pathmax_FALSE='#' -else - gl_GNULIB_ENABLED_pathmax_TRUE='#' - gl_GNULIB_ENABLED_pathmax_FALSE= -fi - - if $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then - gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE= - gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE='#' -else - gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE='#' - gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE= -fi - - if $gl_gnulib_enabled_stat; then - gl_GNULIB_ENABLED_stat_TRUE= - gl_GNULIB_ENABLED_stat_FALSE='#' -else - gl_GNULIB_ENABLED_stat_TRUE='#' - gl_GNULIB_ENABLED_stat_FALSE= -fi - - if $gl_gnulib_enabled_strtoll; then - gl_GNULIB_ENABLED_strtoll_TRUE= - gl_GNULIB_ENABLED_strtoll_FALSE='#' -else - gl_GNULIB_ENABLED_strtoll_TRUE='#' - gl_GNULIB_ENABLED_strtoll_FALSE= -fi - - if $gl_gnulib_enabled_strtoull; then - gl_GNULIB_ENABLED_strtoull_TRUE= - gl_GNULIB_ENABLED_strtoull_FALSE='#' -else - gl_GNULIB_ENABLED_strtoull_TRUE='#' - gl_GNULIB_ENABLED_strtoull_FALSE= -fi - - if $gl_gnulib_enabled_verify; then - gl_GNULIB_ENABLED_verify_TRUE= - gl_GNULIB_ENABLED_verify_FALSE='#' -else - gl_GNULIB_ENABLED_verify_TRUE='#' - gl_GNULIB_ENABLED_verify_FALSE= -fi - - if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then - gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE= - gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE='#' -else - gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE='#' - gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE= -fi - - # End of code from modules - - - - - - - - - - gltests_libdeps= - gltests_ltlibdeps= - - - - - - - - - - gl_source_base='tests' - gltests_WITNESS=IN_`echo "${PACKAGE-$PACKAGE_TARNAME}" | LC_ALL=C tr abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ | LC_ALL=C sed -e 's/[^A-Z0-9_]/_/g'`_GNULIB_TESTS - - gl_module_indicator_condition=$gltests_WITNESS - - - - - - - - - - - LIBGNU_LIBDEPS="$gl_libdeps" - - LIBGNU_LTLIBDEPS="$gl_ltlibdeps" - - -CFLAGS=$SAVE_CFLAGS -LIBS=$SAVE_LIBS - -case "$opsys" in - aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;; - - darwin) - ## The -headerpad option tells ld (see man page) to leave room at the - ## end of the header for adding load commands. Needed for dumping. - ## 0x690 is the total size of 30 segment load commands (at 56 - ## each); under Cocoa 31 commands are required. - if test "$HAVE_NS" = "yes"; then - libs_nsgui="-framework AppKit" - headerpad_extra=6C8 - else - libs_nsgui= - headerpad_extra=690 - fi - LD_SWITCH_SYSTEM_TEMACS="-fno-pie -prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra" - - ## This is here because src/Makefile.in did some extra fiddling around - ## with LD_SWITCH_SYSTEM. The cpp logic was: - ## #ifndef LD_SWITCH_SYSTEM - ## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF))) - ## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to: - ## not using gcc, darwin. - ## Because this was done in src/Makefile.in, the resulting part of - ## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link). - ## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS, - ## rather than LD_SWITCH_SYSTEM. - test "x$LD_SWITCH_SYSTEM" = "x" && test "x$GCC" != "xyes" && \ - LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS" - ;; - - ## LD_SWITCH_X_SITE_RPATH is a -rpath option saying where to - ## find X at run-time. - ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at the - ## point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_RPATH - ## had not yet been defined and was expanded to null. Hence LD_SWITCH_SYSTEM - ## had different values in configure (in ac_link) and src/Makefile.in. - ## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS. - gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;; - - *) LD_SWITCH_SYSTEM_TEMACS= ;; -esac - - - -## Common for all window systems -if test "$window_system" != "none"; then - -$as_echo "#define HAVE_WINDOW_SYSTEM 1" >>confdefs.h - - WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o" -fi - - - - - -#### Report on what we decided to do. -#### Report GTK as a toolkit, even if it doesn't use Xt. -#### It makes printing result more understandable as using GTK sets -#### toolkit_scroll_bars to yes by default. -if test "${HAVE_GTK}" = "yes"; then - USE_X_TOOLKIT="$USE_GTK_TOOLKIT" -fi - -echo " -Configured for \`${canonical}'. - - Where should the build process find the source code? ${srcdir} - What compiler should emacs be built with? ${CC} ${CFLAGS} - Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} - Should Emacs use a relocating allocator for buffers? ${REL_ALLOC} - Should Emacs use mmap(2) for buffer allocation? $use_mmap_for_buffers - What window system should Emacs use? ${window_system} - What toolkit should Emacs use? ${USE_X_TOOLKIT}" - -if test -n "${x_includes}"; then -echo " Where do we find X Windows header files? ${x_includes}" -else -echo " Where do we find X Windows header files? Standard dirs" -fi -if test -n "${x_libraries}"; then -echo " Where do we find X Windows libraries? ${x_libraries}" -else -echo " Where do we find X Windows libraries? Standard dirs" -fi - -echo " Does Emacs use -lXaw3d? ${HAVE_XAW3D}" -echo " Does Emacs use -lXpm? ${HAVE_XPM}" -echo " Does Emacs use -ljpeg? ${HAVE_JPEG}" -echo " Does Emacs use -ltiff? ${HAVE_TIFF}" -echo " Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF" -echo " Does Emacs use -lpng? ${HAVE_PNG}" -echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" -echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" - -echo " Does Emacs use -lgpm? ${HAVE_GPM}" -echo " Does Emacs use -ldbus? ${HAVE_DBUS}" -echo " Does Emacs use -lgconf? ${HAVE_GCONF}" -echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}" -echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" -echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}" -echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" - -echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" -echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" -echo " Does Emacs use -lotf? ${HAVE_LIBOTF}" -echo " Does Emacs use -lxft? ${HAVE_XFT}" - -echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" -echo - -if test -n "${EMACSDATA}"; then - echo " Environment variable EMACSDATA set to: $EMACSDATA" -fi -if test -n "${EMACSDOC}"; then - echo " Environment variable EMACSDOC set to: $EMACSDOC" -fi - -echo - -if test "$HAVE_NS" = "yes"; then - echo - echo "You must run \"${MAKE-make} install\" in order to test the built application. -The installed application will go to nextstep/Emacs.app and can be -run or moved from there." - if test "$EN_NS_SELF_CONTAINED" = "yes"; then - echo "The application will be fully self-contained." - else - echo "The lisp resources for the application will be installed under ${prefix}. -You may need to run \"${MAKE-make} install\" with sudo. The application will fail -to run if these resources are not installed." - fi - echo -fi - -if test "${opsys}" = "cygwin"; then - case `uname -r` in - 1.5.*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: building Emacs on Cygwin 1.5 is not supported." >&5 -$as_echo "$as_me: WARNING: building Emacs on Cygwin 1.5 is not supported." >&2;} - echo - ;; - esac -fi - -# Remove any trailing slashes in these variables. -test "${prefix}" != NONE && - prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` -test "${exec_prefix}" != NONE && - exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` - -if test "$HAVE_NS" = "yes"; then - if test "$NS_IMPL_GNUSTEP" = yes; then - ac_config_files="$ac_config_files nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in" - - else - ac_config_files="$ac_config_files nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in" - - fi -fi - -SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile" - -ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile" - - -opt_makefile=test/automated/Makefile - -if test -f "$srcdir/$opt_makefile.in"; then - SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile" - ac_config_files="$ac_config_files test/automated/Makefile" - -fi - - -opt_makefile=admin/unidata/Makefile - -if test -f "$srcdir/$opt_makefile.in"; then - SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile" - ac_config_files="$ac_config_files admin/unidata/Makefile" - -fi - - -SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'` - - - -ac_config_commands="$ac_config_commands mkdirs" - - -ac_config_commands="$ac_config_commands epaths" - - -ac_config_commands="$ac_config_commands gdbinit" - - -cat >confcache <<\_ACEOF -# This file is a shell script that caches the results of configure -# tests run on this system so they can be shared between configure -# scripts and configure runs, see configure's option --config-cache. -# It is not useful on other systems. If it contains results you don't -# want to keep, you may remove or edit it. -# -# config.status only pays attention to the cache file if you give it -# the --recheck option to rerun configure. -# -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the -# following values. - -_ACEOF - -# The following way of writing the cache mishandles newlines in values, -# but we know of no workaround that is simple, portable, and efficient. -# So, we kill variables containing newlines. -# Ultrix sh set writes to stderr and can't be redirected directly, -# and sets the high bit in the cache file unless we assign to the vars. -( - for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - - (set) 2>&1 | - case $as_nl`(ac_space=' '; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \. - sed -n \ - "s/'/'\\\\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; #( - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) | - sed ' - /^ac_cv_env_/b end - t clear - :clear - s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ - t end - s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - :end' >>confcache -if diff "$cache_file" confcache >/dev/null 2>&1; then :; else - if test -w "$cache_file"; then - test "x$cache_file" != "x/dev/null" && - { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 -$as_echo "$as_me: updating cache $cache_file" >&6;} - cat confcache >$cache_file - else - { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 -$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} - fi -fi -rm -f confcache - -test "x$prefix" = xNONE && prefix=$ac_default_prefix -# Let make expand exec_prefix. -test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' - -DEFS=-DHAVE_CONFIG_H - -ac_libobjs= -ac_ltlibobjs= -for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue - # 1. Remove the extension, and $U if already installed. - ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' - ac_i=`$as_echo "$ac_i" | sed "$ac_script"` - # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR - # will be set to the directory where LIBOBJS objects are built. - as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" - as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' -done -LIBOBJS=$ac_libobjs - -LTLIBOBJS=$ac_ltlibobjs - - - if test -n "$EXEEXT"; then - am__EXEEXT_TRUE= - am__EXEEXT_FALSE='#' -else - am__EXEEXT_TRUE='#' - am__EXEEXT_FALSE= -fi - -if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then - as_fn_error "conditional \"AMDEP\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then - as_fn_error "conditional \"am__fastdepCC\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_COND_LIBTOOL_TRUE}" && test -z "${GL_COND_LIBTOOL_FALSE}"; then - as_fn_error "conditional \"GL_COND_LIBTOOL\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_ALLOCA_H_TRUE}" && test -z "${GL_GENERATE_ALLOCA_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_ALLOCA_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi - -if test -z "${GL_GENERATE_EXECINFO_H_TRUE}" && test -z "${GL_GENERATE_EXECINFO_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_EXECINFO_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_STDINT_H_TRUE}" && test -z "${GL_GENERATE_STDINT_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_STDINT_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_STDALIGN_H_TRUE}" && test -z "${GL_GENERATE_STDALIGN_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_STDALIGN_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_STDARG_H_TRUE}" && test -z "${GL_GENERATE_STDARG_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_STDARG_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_STDBOOL_H_TRUE}" && test -z "${GL_GENERATE_STDBOOL_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_STDBOOL_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${GL_GENERATE_STDDEF_H_TRUE}" && test -z "${GL_GENERATE_STDDEF_H_FALSE}"; then - as_fn_error "conditional \"GL_GENERATE_STDDEF_H\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_TRUE}" && test -z "${gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_dosname_TRUE}" && test -z "${gl_GNULIB_ENABLED_dosname_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_dosname\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_euidaccess_TRUE}" && test -z "${gl_GNULIB_ENABLED_euidaccess_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_euidaccess\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_getgroups_TRUE}" && test -z "${gl_GNULIB_ENABLED_getgroups_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_getgroups\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE}" && test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE}" && test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_TRUE}" && test -z "${gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_pathmax_TRUE}" && test -z "${gl_GNULIB_ENABLED_pathmax_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_pathmax\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE}" && test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_stat_TRUE}" && test -z "${gl_GNULIB_ENABLED_stat_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_stat\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_strtoll_TRUE}" && test -z "${gl_GNULIB_ENABLED_strtoll_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_strtoll\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_strtoull_TRUE}" && test -z "${gl_GNULIB_ENABLED_strtoull_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_strtoull\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_verify_TRUE}" && test -z "${gl_GNULIB_ENABLED_verify_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_verify\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE}" && test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE}"; then - as_fn_error "conditional \"gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi - - gl_libobjs= - gl_ltlibobjs= - if test -n "$gl_LIBOBJS"; then - # Remove the extension. - sed_drop_objext='s/\.o$//;s/\.obj$//' - for i in `for i in $gl_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do - gl_libobjs="$gl_libobjs $i.$ac_objext" - gl_ltlibobjs="$gl_ltlibobjs $i.lo" - done - fi - gl_LIBOBJS=$gl_libobjs - - gl_LTLIBOBJS=$gl_ltlibobjs - - - - gltests_libobjs= - gltests_ltlibobjs= - if test -n "$gltests_LIBOBJS"; then - # Remove the extension. - sed_drop_objext='s/\.o$//;s/\.obj$//' - for i in `for i in $gltests_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do - gltests_libobjs="$gltests_libobjs $i.$ac_objext" - gltests_ltlibobjs="$gltests_ltlibobjs $i.lo" - done - fi - gltests_LIBOBJS=$gltests_libobjs - - gltests_LTLIBOBJS=$gltests_ltlibobjs - - - -: ${CONFIG_STATUS=./config.status} -ac_write_fail=0 -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 -$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} -as_write_fail=0 -cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 -#! $SHELL -# Generated by $as_me. -# Run this file to recreate the current configuration. -# Compiler output produced by configure, useful for debugging -# configure, is in config.log if it exists. - -debug=false -ac_cs_recheck=false -ac_cs_silent=false - -SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - - -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. -as_fn_error () -{ - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 - fi - $as_echo "$as_me: error: $1" >&2 - as_fn_exit $as_status -} # as_fn_error - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -p'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -p' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -p' - fi -else - as_ln_s='cp -p' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" - - -} # as_fn_mkdir_p -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -if test -x / >/dev/null 2>&1; then - as_test_x='test -x' -else - if ls -dL / >/dev/null 2>&1; then - as_ls_L_option=L - else - as_ls_L_option= - fi - as_test_x=' - eval sh -c '\'' - if test -d "$1"; then - test -d "$1/."; - else - case $1 in #( - -*)set "./$1";; - esac; - case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( - ???[sx]*):;;*)false;;esac;fi - '\'' sh - ' -fi -as_executable_p=$as_test_x - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -exec 6>&1 -## ----------------------------------- ## -## Main body of $CONFIG_STATUS script. ## -## ----------------------------------- ## -_ASEOF -test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Save the log message, to keep $0 and so on meaningful, and to -# report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. -ac_log=" -This file was extended by emacs $as_me 24.3.50, which was -generated by GNU Autoconf 2.65. Invocation command line was - - CONFIG_FILES = $CONFIG_FILES - CONFIG_HEADERS = $CONFIG_HEADERS - CONFIG_LINKS = $CONFIG_LINKS - CONFIG_COMMANDS = $CONFIG_COMMANDS - $ $0 $@ - -on `(hostname || uname -n) 2>/dev/null | sed 1q` -" - -_ACEOF - -case $ac_config_files in *" -"*) set x $ac_config_files; shift; ac_config_files=$*;; -esac - -case $ac_config_headers in *" -"*) set x $ac_config_headers; shift; ac_config_headers=$*;; -esac - - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# Files that config.status was made for. -config_files="$ac_config_files" -config_headers="$ac_config_headers" -config_commands="$ac_config_commands" - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions -from templates according to the current configuration. Unless the files -and actions are specified as TAGs, all are instantiated by default. - -Usage: $0 [OPTION]... [TAG]... - - -h, --help print this help, then exit - -V, --version print version number and configuration settings, then exit - --config print configuration, then exit - -q, --quiet, --silent - do not print progress messages - -d, --debug don't remove temporary files - --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE - --header=FILE[:TEMPLATE] - instantiate the configuration header FILE - -Configuration files: -$config_files - -Configuration headers: -$config_headers - -Configuration commands: -$config_commands - -Report bugs to the package provider." - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" -ac_cs_version="\\ -emacs config.status 24.3.50 -configured by $0, generated by GNU Autoconf 2.65, - with options \\"\$ac_cs_config\\" - -Copyright (C) 2009 Free Software Foundation, Inc. -This config.status script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it." - -ac_pwd='$ac_pwd' -srcdir='$srcdir' -INSTALL='$INSTALL' -MKDIR_P='$MKDIR_P' -AWK='$AWK' -test -n "\$AWK" || AWK=awk -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# The default lists apply if the user does not specify any file. -ac_need_defaults=: -while test $# != 0 -do - case $1 in - --*=*) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` - ac_shift=: - ;; - *) - ac_option=$1 - ac_optarg=$2 - ac_shift=shift - ;; - esac - - case $ac_option in - # Handling of the options. - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - ac_cs_recheck=: ;; - --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) - $as_echo "$ac_cs_version"; exit ;; - --config | --confi | --conf | --con | --co | --c ) - $as_echo "$ac_cs_config"; exit ;; - --debug | --debu | --deb | --de | --d | -d ) - debug=: ;; - --file | --fil | --fi | --f ) - $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - as_fn_append CONFIG_FILES " '$ac_optarg'" - ac_need_defaults=false;; - --header | --heade | --head | --hea ) - $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - as_fn_append CONFIG_HEADERS " '$ac_optarg'" - ac_need_defaults=false;; - --he | --h) - # Conflict between --help and --header - as_fn_error "ambiguous option: \`$1' -Try \`$0 --help' for more information.";; - --help | --hel | -h ) - $as_echo "$ac_cs_usage"; exit ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil | --si | --s) - ac_cs_silent=: ;; - - # This is an error. - -*) as_fn_error "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; - - *) as_fn_append ac_config_targets " $1" - ac_need_defaults=false ;; - - esac - shift -done - -ac_configure_extra_args= - -if $ac_cs_silent; then - exec 6>/dev/null - ac_configure_extra_args="$ac_configure_extra_args --silent" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -if \$ac_cs_recheck; then - set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion - shift - \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 - CONFIG_SHELL='$SHELL' - export CONFIG_SHELL - exec "\$@" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX - $as_echo "$ac_log" -} >&5 - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# -# INIT-COMMANDS -# -AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" -GCC="$GCC" CPPFLAGS="$CPPFLAGS" - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - -# Handling of arguments. -for ac_config_target in $ac_config_targets -do - case $ac_config_target in - "src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h:src/config.in" ;; - "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; - "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in" ;; - "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in" ;; - "nextstep/Cocoa/Emacs.base/Contents/Info.plist") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in" ;; - "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in" ;; - "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; - "lib/Makefile") CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;; - "lib-src/Makefile") CONFIG_FILES="$CONFIG_FILES lib-src/Makefile" ;; - "oldXMenu/Makefile") CONFIG_FILES="$CONFIG_FILES oldXMenu/Makefile" ;; - "doc/emacs/Makefile") CONFIG_FILES="$CONFIG_FILES doc/emacs/Makefile" ;; - "doc/misc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/misc/Makefile" ;; - "doc/lispintro/Makefile") CONFIG_FILES="$CONFIG_FILES doc/lispintro/Makefile" ;; - "doc/lispref/Makefile") CONFIG_FILES="$CONFIG_FILES doc/lispref/Makefile" ;; - "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;; - "lwlib/Makefile") CONFIG_FILES="$CONFIG_FILES lwlib/Makefile" ;; - "lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;; - "leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;; - "nextstep/Makefile") CONFIG_FILES="$CONFIG_FILES nextstep/Makefile" ;; - "test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;; - "admin/unidata/Makefile") CONFIG_FILES="$CONFIG_FILES admin/unidata/Makefile" ;; - "mkdirs") CONFIG_COMMANDS="$CONFIG_COMMANDS mkdirs" ;; - "epaths") CONFIG_COMMANDS="$CONFIG_COMMANDS epaths" ;; - "gdbinit") CONFIG_COMMANDS="$CONFIG_COMMANDS gdbinit" ;; - - *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; - esac -done - - -# If the user did not use the arguments to specify the items to instantiate, -# then the envvar interface is used. Set only those that are not. -# We use the long form for the default assignment because of an extremely -# bizarre bug on SunOS 4.1.3. -if $ac_need_defaults; then - test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files - test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers - test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands -fi - -# Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason against having it here, and in addition, -# creating and moving files from /tmp can sometimes cause problems. -# Hook for its removal unless debugging. -# Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. -$debug || -{ - tmp= - trap 'exit_status=$? - { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status -' 0 - trap 'as_fn_exit 1' 1 2 13 15 -} -# Create a (secure) tmp directory for tmp files. - -{ - tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" -} || -{ - tmp=./conf$$-$RANDOM - (umask 077 && mkdir "$tmp") -} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 - -# Set up the scripts for CONFIG_FILES section. -# No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. -if test -n "$CONFIG_FILES"; then - -if $AWK 'BEGIN { getline <"/dev/null" }' /dev/null; then - ac_cs_awk_getline=: - ac_cs_awk_pipe_init= - ac_cs_awk_read_file=' - while ((getline aline < (F[key])) > 0) - print(aline) - close(F[key])' - ac_cs_awk_pipe_fini= -else - ac_cs_awk_getline=false - ac_cs_awk_pipe_init="print \"cat <<'|#_!!_#|' &&\"" - ac_cs_awk_read_file=' - print "|#_!!_#|" - print "cat " F[key] " &&" - '$ac_cs_awk_pipe_init - # The final `:' finishes the AND list. - ac_cs_awk_pipe_fini='END { print "|#_!!_#|"; print ":" }' -fi -ac_cr=`echo X | tr X '\015'` -# On cygwin, bash can eat \r inside `` if the user requested igncr. -# But we know of no other shell where ac_cr would be empty at this -# point, so we can use a bashism as a fallback. -if test "x$ac_cr" = x; then - eval ac_cr=\$\'\\r\' -fi -ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` -if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\r' -else - ac_cs_awk_cr=$ac_cr -fi - -echo 'BEGIN {' >"$tmp/subs1.awk" && -_ACEOF - -# Create commands to substitute file output variables. -{ - echo "cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1" && - echo 'cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&' && - echo "$ac_subst_files" | sed 's/.*/F["&"]="$&"/' && - echo "_ACAWK" && - echo "_ACEOF" -} >conf$$files.sh && -. ./conf$$files.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 -rm -f conf$$files.sh - -{ - echo "cat >conf$$subs.awk <<_ACEOF" && - echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && - echo "_ACEOF" -} >conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - . ./conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 - - ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` - if test $ac_delim_n = $ac_delim_num; then - break - elif $ac_last_try; then - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done -rm -f conf$$subs.sh - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$tmp/subs1.awk" <<\\_ACAWK && -_ACEOF -sed -n ' -h -s/^/S["/; s/!.*/"]=/ -p -g -s/^[^!]*!// -:repl -t repl -s/'"$ac_delim"'$// -t delim -:nl -h -s/\(.\{148\}\)..*/\1/ -t more1 -s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ -p -n -b repl -:more1 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t nl -:delim -h -s/\(.\{148\}\)..*/\1/ -t more2 -s/["\\]/\\&/g; s/^/"/; s/$/"/ -p -b -:more2 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t delim -' >$CONFIG_STATUS || ac_write_fail=1 -rm -f conf$$subs.awk -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACAWK -cat >>"\$tmp/subs1.awk" <<_ACAWK && - for (key in S) S_is_set[key] = 1 - FS = "" - \$ac_cs_awk_pipe_init -} -{ - line = $ 0 - nfields = split(line, field, "@") - substed = 0 - len = length(field[1]) - for (i = 2; i < nfields; i++) { - key = field[i] - keylen = length(key) - if (S_is_set[key]) { - value = S[key] - line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) - len += length(value) + length(field[++i]) - substed = 1 - } else - len += 1 + keylen - } - if (nfields == 3 && !substed) { - key = field[2] - if (F[key] != "" && line ~ /^[ ]*@.*@[ ]*$/) { - \$ac_cs_awk_read_file - next - } - } - print line -} -\$ac_cs_awk_pipe_fini -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then - sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" -else - cat -fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ - || as_fn_error "could not setup config files machinery" "$LINENO" 5 -_ACEOF - -# VPATH may cause trouble with some makes, so we remove $(srcdir), -# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ -s/:*\$(srcdir):*/:/ -s/:*\${srcdir}:*/:/ -s/:*@srcdir@:*/:/ -s/^\([^=]*=[ ]*\):*/\1/ -s/:*$// -s/^[^=]*=[ ]*$// -}' -fi - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -fi # test -n "$CONFIG_FILES" - -# Set up the scripts for CONFIG_HEADERS section. -# No need to generate them if there are no CONFIG_HEADERS. -# This happens for instance with `./config.status Makefile'. -if test -n "$CONFIG_HEADERS"; then -cat >"$tmp/defines.awk" <<\_ACAWK || -BEGIN { -_ACEOF - -# Transform confdefs.h into an awk script `defines.awk', embedded as -# here-document in config.status, that substitutes the proper values into -# config.h.in to produce config.h. - -# Create a delimiter string that does not exist in confdefs.h, to ease -# handling of long lines. -ac_delim='%!_!# ' -for ac_last_try in false false :; do - ac_t=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_t"; then - break - elif $ac_last_try; then - as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done - -# For the awk script, D is an array of macro values keyed by name, -# likewise P contains macro parameters if any. Preserve backslash -# newline sequences. - -ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* -sed -n ' -s/.\{148\}/&'"$ac_delim"'/g -t rset -:rset -s/^[ ]*#[ ]*define[ ][ ]*/ / -t def -d -:def -s/\\$// -t bsnl -s/["\\]/\\&/g -s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ -D["\1"]=" \3"/p -s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p -d -:bsnl -s/["\\]/\\&/g -s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ -D["\1"]=" \3\\\\\\n"\\/p -t cont -s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p -t cont -d -:cont -n -s/.\{148\}/&'"$ac_delim"'/g -t clear -:clear -s/\\$// -t bsnlc -s/["\\]/\\&/g; s/^/"/; s/$/"/p -d -:bsnlc -s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p -b cont -' >$CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - for (key in D) D_is_set[key] = 1 - FS = "" -} -/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { - line = \$ 0 - split(line, arg, " ") - if (arg[1] == "#") { - defundef = arg[2] - mac1 = arg[3] - } else { - defundef = substr(arg[1], 2) - mac1 = arg[2] - } - split(mac1, mac2, "(") #) - macro = mac2[1] - prefix = substr(line, 1, index(line, defundef) - 1) - if (D_is_set[macro]) { - # Preserve the white space surrounding the "#". - print prefix "define", macro P[macro] D[macro] - next - } else { - # Replace #undef with comments. This is necessary, for example, - # in the case of _POSIX_SOURCE, which is predefined and required - # on some systems where configure will not decide to define it. - if (defundef == "undef") { - print "/*", prefix defundef, macro, "*/" - next - } - } -} -{ print } -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - as_fn_error "could not setup config headers machinery" "$LINENO" 5 -fi # test -n "$CONFIG_HEADERS" - - -eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" -shift -for ac_tag -do - case $ac_tag in - :[FHLC]) ac_mode=$ac_tag; continue;; - esac - case $ac_mode$ac_tag in - :[FHL]*:*);; - :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;; - :[FH]-) ac_tag=-:-;; - :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; - esac - ac_save_IFS=$IFS - IFS=: - set x $ac_tag - IFS=$ac_save_IFS - shift - ac_file=$1 - shift - - case $ac_mode in - :L) ac_source=$1;; - :[FH]) - ac_file_inputs= - for ac_f - do - case $ac_f in - -) ac_f="$tmp/stdin";; - *) # Look for the file first in the build tree, then in the source tree - # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. - test -f "$ac_f" || - case $ac_f in - [\\/$]*) false;; - *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; - esac || - as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;; - esac - case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac - as_fn_append ac_file_inputs " '$ac_f'" - done - - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - configure_input='Generated from '` - $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' - `' by configure.' - if test x"$ac_file" != x-; then - configure_input="$ac_file. $configure_input" - { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 -$as_echo "$as_me: creating $ac_file" >&6;} - fi - # Neutralize special characters interpreted by sed in replacement strings. - case $configure_input in #( - *\&* | *\|* | *\\* ) - ac_sed_conf_input=`$as_echo "$configure_input" | - sed 's/[\\\\&|]/\\\\&/g'`;; #( - *) ac_sed_conf_input=$configure_input;; - esac - - case $ac_tag in - *:-:* | *:-) cat >"$tmp/stdin" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; - esac - ;; - esac - - ac_dir=`$as_dirname -- "$ac_file" || -$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_file" : 'X\(//\)[^/]' \| \ - X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir="$ac_dir"; as_fn_mkdir_p - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - - case $ac_mode in - :F) - # - # CONFIG_FILE - # - - case $INSTALL in - [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; - *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; - esac - ac_MKDIR_P=$MKDIR_P - case $MKDIR_P in - [\\/$]* | ?:[\\/]* ) ;; - */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; - esac -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# If the template does not know about datarootdir, expand it. -# FIXME: This hack should be removed a few years after 2.60. -ac_datarootdir_hack=; ac_datarootdir_seen= -ac_sed_dataroot=' -/datarootdir/ { - p - q -} -/@datadir@/p -/@docdir@/p -/@infodir@/p -/@localedir@/p -/@mandir@/p' -case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in -*datarootdir*) ac_datarootdir_seen=yes;; -*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - ac_datarootdir_hack=' - s&@datadir@&$datadir&g - s&@docdir@&$docdir&g - s&@infodir@&$infodir&g - s&@localedir@&$localedir&g - s&@mandir@&$mandir&g - s&\\\${datarootdir}&$datarootdir&g' ;; -esac -_ACEOF - -# Neutralize VPATH when `$srcdir' = `.'. -# Shell code in configure.ac might set extrasub. -# FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_sed_extra="$ac_vpsub -$extrasub -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -:t -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s|@configure_input@|$ac_sed_conf_input|;t t -s&@top_builddir@&$ac_top_builddir_sub&;t t -s&@top_build_prefix@&$ac_top_build_prefix&;t t -s&@srcdir@&$ac_srcdir&;t t -s&@abs_srcdir@&$ac_abs_srcdir&;t t -s&@top_srcdir@&$ac_top_srcdir&;t t -s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t -s&@builddir@&$ac_builddir&;t t -s&@abs_builddir@&$ac_abs_builddir&;t t -s&@abs_top_builddir@&$ac_abs_top_builddir&;t t -s&@INSTALL@&$ac_INSTALL&;t t -s&@MKDIR_P@&$ac_MKDIR_P&;t t -$ac_datarootdir_hack -" -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | -if $ac_cs_awk_getline; then - $AWK -f "$tmp/subs.awk" -else - $AWK -f "$tmp/subs.awk" | $SHELL -fi >$tmp/out \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 - -test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined." >&5 -$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined." >&2;} - - rm -f "$tmp/stdin" - case $ac_file in - -) cat "$tmp/out" && rm -f "$tmp/out";; - *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; - esac \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 - ;; - :H) - # - # CONFIG_HEADER - # - if test x"$ac_file" != x-; then - { - $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" - } >"$tmp/config.h" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 - if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 -$as_echo "$as_me: $ac_file is unchanged" >&6;} - else - rm -f "$ac_file" - mv "$tmp/config.h" "$ac_file" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 - fi - else - $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ - || as_fn_error "could not create -" "$LINENO" 5 - fi -# Compute "$ac_file"'s index in $config_headers. -_am_arg="$ac_file" -_am_stamp_count=1 -for _am_header in $config_headers :; do - case $_am_header in - $_am_arg | $_am_arg:* ) - break ;; - * ) - _am_stamp_count=`expr $_am_stamp_count + 1` ;; - esac -done -echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || -$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$_am_arg" : 'X\(//\)[^/]' \| \ - X"$_am_arg" : 'X\(//\)$' \| \ - X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$_am_arg" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'`/stamp-h$_am_stamp_count - ;; - - :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 -$as_echo "$as_me: executing $ac_file commands" >&6;} - ;; - esac - - - case $ac_file$ac_mode in - "depfiles":C) test x"$AMDEP_TRUE" != x"" || { - # Autoconf 2.62 quotes --file arguments for eval, but not when files - # are listed without --file. Let's play safe and only enable the eval - # if we detect the quoting. - case $CONFIG_FILES in - *\'*) eval set x "$CONFIG_FILES" ;; - *) set x $CONFIG_FILES ;; - esac - shift - for mf - do - # Strip MF so we end up with the name of the file. - mf=`echo "$mf" | sed -e 's/:.*$//'` - # Check whether this is an Automake generated Makefile or not. - # We used to match only the files named `Makefile.in', but - # some people rename them; so instead we look at the file content. - # Grep'ing the first line is not enough: some people post-process - # each Makefile.in and add a new line on top of each file to say so. - # Grep'ing the whole file is not good either: AIX grep has a line - # limit of 2048, but all sed's we know have understand at least 4000. - if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then - dirpart=`$as_dirname -- "$mf" || -$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$mf" : 'X\(//\)[^/]' \| \ - X"$mf" : 'X\(//\)$' \| \ - X"$mf" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$mf" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - else - continue - fi - # Extract the definition of DEPDIR, am__include, and am__quote - # from the Makefile without running `make'. - DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` - test -z "$DEPDIR" && continue - am__include=`sed -n 's/^am__include = //p' < "$mf"` - test -z "am__include" && continue - am__quote=`sed -n 's/^am__quote = //p' < "$mf"` - # When using ansi2knr, U may be empty or an underscore; expand it - U=`sed -n 's/^U = //p' < "$mf"` - # Find all dependency output files, they are included files with - # $(DEPDIR) in their names. We invoke sed twice because it is the - # simplest approach to changing $(DEPDIR) to its actual value in the - # expansion. - for file in `sed -n " - s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ - sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do - # Make sure the directory exists. - test -f "$dirpart/$file" && continue - fdir=`$as_dirname -- "$file" || -$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$file" : 'X\(//\)[^/]' \| \ - X"$file" : 'X\(//\)$' \| \ - X"$file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir=$dirpart/$fdir; as_fn_mkdir_p - # echo "creating $dirpart/$file" - echo '# dummy' > "$dirpart/$file" - done - done -} - ;; - "mkdirs":C) -for dir in etc lisp ; do - test -d ${dir} || mkdir ${dir} -done - ;; - "epaths":C) -echo creating src/epaths.h -${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force - ;; - "gdbinit":C) -if test ! -f src/.gdbinit && test -f "$srcdir/src/.gdbinit"; then - echo creating src/.gdbinit - echo "source $srcdir/src/.gdbinit" > src/.gdbinit -fi - ;; - - esac -done # for ac_tag - - -as_fn_exit 0 -_ACEOF -ac_clean_files=$ac_clean_files_save - -test $ac_write_fail = 0 || - as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5 - - -# configure is writing to config.log, and then calls config.status. -# config.status does its own redirection, appending to config.log. -# Unfortunately, on DOS this fails, as config.log is still kept open -# by configure, so config.status won't be able to write to it; its -# output is simply discarded. So we exec the FD to /dev/null, -# effectively closing config.log, so it can be properly (re)opened and -# appended to by config.status. When coming back to configure, we -# need to make the FD available again. -if test "$no_create" != yes; then - ac_cs_success=: - ac_config_status_args= - test "$silent" = yes && - ac_config_status_args="$ac_config_status_args --quiet" - exec 5>/dev/null - $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false - exec 5>>config.log - # Use ||, not &&, to avoid exiting from the if with $? = 1, which - # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit $? -fi -if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 -$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - diff --git a/autogen/copy_autogen b/autogen/copy_autogen deleted file mode 100755 index 8aacd4d399a..00000000000 --- a/autogen/copy_autogen +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/sh - -## Helper script for those building Emacs from bzr without autoconf etc. -## This installs some pre-generated versions of the automatically -## generated files. It is highly recommended to install the necessary -## tools instead of using this. Note that if eg configure.ac -## is updated, the next time you run make it will attempt to -## regenerate configure and will fail if you do not have the required -## tools. You will have to run this script again. - -test ! -d autogen || cd autogen || exit - -if test ! -e config.in; then - echo "Cannot find autogen/ directory." - exit 1 -fi - -## Order implied by top-level Makefile's rules, for time-stamps. -cp -f compile config.guess config.sub depcomp install-sh missing \ - ../build-aux && -cp aclocal.m4 ../ && -cp configure ../ && -touch ../src/stamp-h.in && -cp config.in ../src/ && -cp Makefile.in ../lib/ && - -echo "You can now run configure" diff --git a/autogen/depcomp b/autogen/depcomp deleted file mode 100755 index df8eea7e4ce..00000000000 --- a/autogen/depcomp +++ /dev/null @@ -1,630 +0,0 @@ -#! /bin/sh -# depcomp - compile a program generating dependencies as side-effects - -scriptversion=2009-04-28.21; # UTC - -# Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2009 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 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Originally written by Alexandre Oliva . - -case $1 in - '') - echo "$0: No command. Try \`$0 --help' for more information." 1>&2 - exit 1; - ;; - -h | --h*) - cat <<\EOF -Usage: depcomp [--help] [--version] PROGRAM [ARGS] - -Run PROGRAMS ARGS to compile a file, generating dependencies -as side-effects. - -Environment variables: - depmode Dependency tracking mode. - source Source file read by `PROGRAMS ARGS'. - object Object file output by `PROGRAMS ARGS'. - DEPDIR directory where to store dependencies. - depfile Dependency file to output. - tmpdepfile Temporary file to use when outputing dependencies. - libtool Whether libtool is used (yes/no). - -Report bugs to . -EOF - exit $? - ;; - -v | --v*) - echo "depcomp $scriptversion" - exit $? - ;; -esac - -if test -z "$depmode" || test -z "$source" || test -z "$object"; then - echo "depcomp: Variables source, object and depmode must be set" 1>&2 - exit 1 -fi - -# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po. -depfile=${depfile-`echo "$object" | - sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`} -tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`} - -rm -f "$tmpdepfile" - -# Some modes work just like other modes, but use different flags. We -# parameterize here, but still list the modes in the big case below, -# to make depend.m4 easier to write. Note that we *cannot* use a case -# here, because this file can only contain one case statement. -if test "$depmode" = hp; then - # HP compiler uses -M and no extra arg. - gccflag=-M - depmode=gcc -fi - -if test "$depmode" = dashXmstdout; then - # This is just like dashmstdout with a different argument. - dashmflag=-xM - depmode=dashmstdout -fi - -cygpath_u="cygpath -u -f -" -if test "$depmode" = msvcmsys; then - # This is just like msvisualcpp but w/o cygpath translation. - # Just convert the backslash-escaped backslashes to single forward - # slashes to satisfy depend.m4 - cygpath_u="sed s,\\\\\\\\,/,g" - depmode=msvisualcpp -fi - -case "$depmode" in -gcc3) -## gcc 3 implements dependency tracking that does exactly what -## we want. Yay! Note: for some reason libtool 1.4 doesn't like -## it if -MD -MP comes after the -MF stuff. Hmm. -## Unfortunately, FreeBSD c89 acceptance of flags depends upon -## the command line argument order; so add the flags where they -## appear in depend2.am. Note that the slowdown incurred here -## affects only configure: in makefiles, %FASTDEP% shortcuts this. - for arg - do - case $arg in - -c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;; - *) set fnord "$@" "$arg" ;; - esac - shift # fnord - shift # $arg - done - "$@" - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile" - exit $stat - fi - mv "$tmpdepfile" "$depfile" - ;; - -gcc) -## There are various ways to get dependency output from gcc. Here's -## why we pick this rather obscure method: -## - Don't want to use -MD because we'd like the dependencies to end -## up in a subdir. Having to rename by hand is ugly. -## (We might end up doing this anyway to support other compilers.) -## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like -## -MM, not -M (despite what the docs say). -## - Using -M directly means running the compiler twice (even worse -## than renaming). - if test -z "$gccflag"; then - gccflag=-MD, - fi - "$@" -Wp,"$gccflag$tmpdepfile" - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - echo "$object : \\" > "$depfile" - alpha=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz -## The second -e expression handles DOS-style file names with drive letters. - sed -e 's/^[^:]*: / /' \ - -e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile" -## This next piece of magic avoids the `deleted header file' problem. -## The problem is that when a header file which appears in a .P file -## is deleted, the dependency causes make to die (because there is -## typically no way to rebuild the header). We avoid this by adding -## dummy dependencies for each header file. Too bad gcc doesn't do -## this for us directly. - tr ' ' ' -' < "$tmpdepfile" | -## Some versions of gcc put a space before the `:'. On the theory -## that the space means something, we add a space to the output as -## well. -## Some versions of the HPUX 10.20 sed can't process this invocation -## correctly. Breaking it into two sed invocations is a workaround. - sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -hp) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -sgi) - if test "$libtool" = yes; then - "$@" "-Wp,-MDupdate,$tmpdepfile" - else - "$@" -MDupdate "$tmpdepfile" - fi - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - - if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files - echo "$object : \\" > "$depfile" - - # Clip off the initial element (the dependent). Don't try to be - # clever and replace this with sed code, as IRIX sed won't handle - # lines with more than a fixed number of characters (4096 in - # IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines; - # the IRIX cc adds comments like `#:fec' to the end of the - # dependency line. - tr ' ' ' -' < "$tmpdepfile" \ - | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' | \ - tr ' -' ' ' >> "$depfile" - echo >> "$depfile" - - # The second pass generates a dummy entry for each header file. - tr ' ' ' -' < "$tmpdepfile" \ - | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \ - >> "$depfile" - else - # The sourcefile does not contain any dependencies, so just - # store a dummy comment line, to avoid errors with the Makefile - # "include basename.Plo" scheme. - echo "#dummy" > "$depfile" - fi - rm -f "$tmpdepfile" - ;; - -aix) - # The C for AIX Compiler uses -M and outputs the dependencies - # in a .u file. In older versions, this file always lives in the - # current directory. Also, the AIX compiler puts `$object:' at the - # start of each line; $object doesn't have directory information. - # Version 6 uses the directory in both cases. - dir=`echo "$object" | sed -e 's|/[^/]*$|/|'` - test "x$dir" = "x$object" && dir= - base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'` - if test "$libtool" = yes; then - tmpdepfile1=$dir$base.u - tmpdepfile2=$base.u - tmpdepfile3=$dir.libs/$base.u - "$@" -Wc,-M - else - tmpdepfile1=$dir$base.u - tmpdepfile2=$dir$base.u - tmpdepfile3=$dir$base.u - "$@" -M - fi - stat=$? - - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - do - test -f "$tmpdepfile" && break - done - if test -f "$tmpdepfile"; then - # Each line is of the form `foo.o: dependent.h'. - # Do two passes, one to just change these to - # `$object: dependent.h' and one to simply `dependent.h:'. - sed -e "s,^.*\.[a-z]*:,$object:," < "$tmpdepfile" > "$depfile" - # That's a tab and a space in the []. - sed -e 's,^.*\.[a-z]*:[ ]*,,' -e 's,$,:,' < "$tmpdepfile" >> "$depfile" - else - # The sourcefile does not contain any dependencies, so just - # store a dummy comment line, to avoid errors with the Makefile - # "include basename.Plo" scheme. - echo "#dummy" > "$depfile" - fi - rm -f "$tmpdepfile" - ;; - -icc) - # Intel's C compiler understands `-MD -MF file'. However on - # icc -MD -MF foo.d -c -o sub/foo.o sub/foo.c - # ICC 7.0 will fill foo.d with something like - # foo.o: sub/foo.c - # foo.o: sub/foo.h - # which is wrong. We want: - # sub/foo.o: sub/foo.c - # sub/foo.o: sub/foo.h - # sub/foo.c: - # sub/foo.h: - # ICC 7.1 will output - # foo.o: sub/foo.c sub/foo.h - # and will wrap long lines using \ : - # foo.o: sub/foo.c ... \ - # sub/foo.h ... \ - # ... - - "$@" -MD -MF "$tmpdepfile" - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - # Each line is of the form `foo.o: dependent.h', - # or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'. - # Do two passes, one to just change these to - # `$object: dependent.h' and one to simply `dependent.h:'. - sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile" - # Some versions of the HPUX 10.20 sed can't process this invocation - # correctly. Breaking it into two sed invocations is a workaround. - sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" | - sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -hp2) - # The "hp" stanza above does not work with aCC (C++) and HP's ia64 - # compilers, which have integrated preprocessors. The correct option - # to use with these is +Maked; it writes dependencies to a file named - # 'foo.d', which lands next to the object file, wherever that - # happens to be. - # Much of this is similar to the tru64 case; see comments there. - dir=`echo "$object" | sed -e 's|/[^/]*$|/|'` - test "x$dir" = "x$object" && dir= - base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'` - if test "$libtool" = yes; then - tmpdepfile1=$dir$base.d - tmpdepfile2=$dir.libs/$base.d - "$@" -Wc,+Maked - else - tmpdepfile1=$dir$base.d - tmpdepfile2=$dir$base.d - "$@" +Maked - fi - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile1" "$tmpdepfile2" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" - do - test -f "$tmpdepfile" && break - done - if test -f "$tmpdepfile"; then - sed -e "s,^.*\.[a-z]*:,$object:," "$tmpdepfile" > "$depfile" - # Add `dependent.h:' lines. - sed -ne '2,${ - s/^ *// - s/ \\*$// - s/$/:/ - p - }' "$tmpdepfile" >> "$depfile" - else - echo "#dummy" > "$depfile" - fi - rm -f "$tmpdepfile" "$tmpdepfile2" - ;; - -tru64) - # The Tru64 compiler uses -MD to generate dependencies as a side - # effect. `cc -MD -o foo.o ...' puts the dependencies into `foo.o.d'. - # At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put - # dependencies in `foo.d' instead, so we check for that too. - # Subdirectories are respected. - dir=`echo "$object" | sed -e 's|/[^/]*$|/|'` - test "x$dir" = "x$object" && dir= - base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'` - - if test "$libtool" = yes; then - # With Tru64 cc, shared objects can also be used to make a - # static library. This mechanism is used in libtool 1.4 series to - # handle both shared and static libraries in a single compilation. - # With libtool 1.4, dependencies were output in $dir.libs/$base.lo.d. - # - # With libtool 1.5 this exception was removed, and libtool now - # generates 2 separate objects for the 2 libraries. These two - # compilations output dependencies in $dir.libs/$base.o.d and - # in $dir$base.o.d. We have to check for both files, because - # one of the two compilations can be disabled. We should prefer - # $dir$base.o.d over $dir.libs/$base.o.d because the latter is - # automatically cleaned when .libs/ is deleted, while ignoring - # the former would cause a distcleancheck panic. - tmpdepfile1=$dir.libs/$base.lo.d # libtool 1.4 - tmpdepfile2=$dir$base.o.d # libtool 1.5 - tmpdepfile3=$dir.libs/$base.o.d # libtool 1.5 - tmpdepfile4=$dir.libs/$base.d # Compaq CCC V6.2-504 - "$@" -Wc,-MD - else - tmpdepfile1=$dir$base.o.d - tmpdepfile2=$dir$base.d - tmpdepfile3=$dir$base.d - tmpdepfile4=$dir$base.d - "$@" -MD - fi - - stat=$? - if test $stat -eq 0; then : - else - rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" "$tmpdepfile4" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" "$tmpdepfile4" - do - test -f "$tmpdepfile" && break - done - if test -f "$tmpdepfile"; then - sed -e "s,^.*\.[a-z]*:,$object:," < "$tmpdepfile" > "$depfile" - # That's a tab and a space in the []. - sed -e 's,^.*\.[a-z]*:[ ]*,,' -e 's,$,:,' < "$tmpdepfile" >> "$depfile" - else - echo "#dummy" > "$depfile" - fi - rm -f "$tmpdepfile" - ;; - -#nosideeffect) - # This comment above is used by automake to tell side-effect - # dependency tracking mechanisms from slower ones. - -dashmstdout) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout, regardless of -o. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - # Remove `-o $object'. - IFS=" " - for arg - do - case $arg in - -o) - shift - ;; - $object) - shift - ;; - *) - set fnord "$@" "$arg" - shift # fnord - shift # $arg - ;; - esac - done - - test -z "$dashmflag" && dashmflag=-M - # Require at least two characters before searching for `:' - # in the target name. This is to cope with DOS-style filenames: - # a dependency such as `c:/foo/bar' could be seen as target `c' otherwise. - "$@" $dashmflag | - sed 's:^[ ]*[^: ][^:][^:]*\:[ ]*:'"$object"'\: :' > "$tmpdepfile" - rm -f "$depfile" - cat < "$tmpdepfile" > "$depfile" - tr ' ' ' -' < "$tmpdepfile" | \ -## Some versions of the HPUX 10.20 sed can't process this invocation -## correctly. Breaking it into two sed invocations is a workaround. - sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -dashXmstdout) - # This case only exists to satisfy depend.m4. It is never actually - # run, as this mode is specially recognized in the preamble. - exit 1 - ;; - -makedepend) - "$@" || exit $? - # Remove any Libtool call - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - # X makedepend - shift - cleared=no eat=no - for arg - do - case $cleared in - no) - set ""; shift - cleared=yes ;; - esac - if test $eat = yes; then - eat=no - continue - fi - case "$arg" in - -D*|-I*) - set fnord "$@" "$arg"; shift ;; - # Strip any option that makedepend may not understand. Remove - # the object too, otherwise makedepend will parse it as a source file. - -arch) - eat=yes ;; - -*|$object) - ;; - *) - set fnord "$@" "$arg"; shift ;; - esac - done - obj_suffix=`echo "$object" | sed 's/^.*\././'` - touch "$tmpdepfile" - ${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@" - rm -f "$depfile" - cat < "$tmpdepfile" > "$depfile" - sed '1,2d' "$tmpdepfile" | tr ' ' ' -' | \ -## Some versions of the HPUX 10.20 sed can't process this invocation -## correctly. Breaking it into two sed invocations is a workaround. - sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" "$tmpdepfile".bak - ;; - -cpp) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - # Remove `-o $object'. - IFS=" " - for arg - do - case $arg in - -o) - shift - ;; - $object) - shift - ;; - *) - set fnord "$@" "$arg" - shift # fnord - shift # $arg - ;; - esac - done - - "$@" -E | - sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ - -e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' | - sed '$ s: \\$::' > "$tmpdepfile" - rm -f "$depfile" - echo "$object : \\" > "$depfile" - cat < "$tmpdepfile" >> "$depfile" - sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -msvisualcpp) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - IFS=" " - for arg - do - case "$arg" in - -o) - shift - ;; - $object) - shift - ;; - "-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI") - set fnord "$@" - shift - shift - ;; - *) - set fnord "$@" "$arg" - shift - shift - ;; - esac - done - "$@" -E 2>/dev/null | - sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile" - rm -f "$depfile" - echo "$object : \\" > "$depfile" - sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s:: \1 \\:p' >> "$depfile" - echo " " >> "$depfile" - sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -msvcmsys) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -none) - exec "$@" - ;; - -*) - echo "Unknown depmode $depmode" 1>&2 - exit 1 - ;; -esac - -exit 0 - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff --git a/autogen/install-sh b/autogen/install-sh deleted file mode 100755 index 6781b987bdb..00000000000 --- a/autogen/install-sh +++ /dev/null @@ -1,520 +0,0 @@ -#!/bin/sh -# install - install a program, script, or datafile - -scriptversion=2009-04-28.21; # UTC - -# This originates from X11R5 (mit/util/scripts/install.sh), which was -# later released in X11R6 (xc/config/util/install.sh) with the -# following copyright and license. -# -# Copyright (C) 1994 X Consortium -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to -# deal in the Software without restriction, including without limitation the -# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -# sell copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in -# all copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- -# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -# -# Except as contained in this notice, the name of the X Consortium shall not -# be used in advertising or otherwise to promote the sale, use or other deal- -# ings in this Software without prior written authorization from the X Consor- -# tium. -# -# -# FSF changes to this file are in the public domain. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# `make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. - -nl=' -' -IFS=" "" $nl" - -# set DOITPROG to echo to test this script - -# Don't use :- since 4.3BSD and earlier shells don't like it. -doit=${DOITPROG-} -if test -z "$doit"; then - doit_exec=exec -else - doit_exec=$doit -fi - -# Put in absolute file names if you don't have them in your path; -# or use environment vars. - -chgrpprog=${CHGRPPROG-chgrp} -chmodprog=${CHMODPROG-chmod} -chownprog=${CHOWNPROG-chown} -cmpprog=${CMPPROG-cmp} -cpprog=${CPPROG-cp} -mkdirprog=${MKDIRPROG-mkdir} -mvprog=${MVPROG-mv} -rmprog=${RMPROG-rm} -stripprog=${STRIPPROG-strip} - -posix_glob='?' -initialize_posix_glob=' - test "$posix_glob" != "?" || { - if (set -f) 2>/dev/null; then - posix_glob= - else - posix_glob=: - fi - } -' - -posix_mkdir= - -# Desired mode of installed file. -mode=0755 - -chgrpcmd= -chmodcmd=$chmodprog -chowncmd= -mvcmd=$mvprog -rmcmd="$rmprog -f" -stripcmd= - -src= -dst= -dir_arg= -dst_arg= - -copy_on_change=false -no_target_directory= - -usage="\ -Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE - or: $0 [OPTION]... SRCFILES... DIRECTORY - or: $0 [OPTION]... -t DIRECTORY SRCFILES... - or: $0 [OPTION]... -d DIRECTORIES... - -In the 1st form, copy SRCFILE to DSTFILE. -In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. -In the 4th, create DIRECTORIES. - -Options: - --help display this help and exit. - --version display version info and exit. - - -c (ignored) - -C install only if different (preserve the last data modification time) - -d create directories instead of installing files. - -g GROUP $chgrpprog installed files to GROUP. - -m MODE $chmodprog installed files to MODE. - -o USER $chownprog installed files to USER. - -s $stripprog installed files. - -t DIRECTORY install into DIRECTORY. - -T report an error if DSTFILE is a directory. - -Environment variables override the default commands: - CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG - RMPROG STRIPPROG -" - -while test $# -ne 0; do - case $1 in - -c) ;; - - -C) copy_on_change=true;; - - -d) dir_arg=true;; - - -g) chgrpcmd="$chgrpprog $2" - shift;; - - --help) echo "$usage"; exit $?;; - - -m) mode=$2 - case $mode in - *' '* | *' '* | *' -'* | *'*'* | *'?'* | *'['*) - echo "$0: invalid mode: $mode" >&2 - exit 1;; - esac - shift;; - - -o) chowncmd="$chownprog $2" - shift;; - - -s) stripcmd=$stripprog;; - - -t) dst_arg=$2 - shift;; - - -T) no_target_directory=true;; - - --version) echo "$0 $scriptversion"; exit $?;; - - --) shift - break;; - - -*) echo "$0: invalid option: $1" >&2 - exit 1;; - - *) break;; - esac - shift -done - -if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then - # When -d is used, all remaining arguments are directories to create. - # When -t is used, the destination is already specified. - # Otherwise, the last argument is the destination. Remove it from $@. - for arg - do - if test -n "$dst_arg"; then - # $@ is not empty: it contains at least $arg. - set fnord "$@" "$dst_arg" - shift # fnord - fi - shift # arg - dst_arg=$arg - done -fi - -if test $# -eq 0; then - if test -z "$dir_arg"; then - echo "$0: no input file specified." >&2 - exit 1 - fi - # It's OK to call `install-sh -d' without argument. - # This can happen when creating conditional directories. - exit 0 -fi - -if test -z "$dir_arg"; then - trap '(exit $?); exit' 1 2 13 15 - - # Set umask so as not to create temps with too-generous modes. - # However, 'strip' requires both read and write access to temps. - case $mode in - # Optimize common cases. - *644) cp_umask=133;; - *755) cp_umask=22;; - - *[0-7]) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw='% 200' - fi - cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; - *) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw=,u+rw - fi - cp_umask=$mode$u_plus_rw;; - esac -fi - -for src -do - # Protect names starting with `-'. - case $src in - -*) src=./$src;; - esac - - if test -n "$dir_arg"; then - dst=$src - dstdir=$dst - test -d "$dstdir" - dstdir_status=$? - else - - # Waiting for this to be detected by the "$cpprog $src $dsttmp" command - # might cause directories to be created, which would be especially bad - # if $src (and thus $dsttmp) contains '*'. - if test ! -f "$src" && test ! -d "$src"; then - echo "$0: $src does not exist." >&2 - exit 1 - fi - - if test -z "$dst_arg"; then - 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. - if test -d "$dst"; then - if test -n "$no_target_directory"; then - echo "$0: $dst_arg: Is a directory" >&2 - exit 1 - fi - dstdir=$dst - dst=$dstdir/`basename "$src"` - dstdir_status=0 - else - # Prefer dirname, but fall back on a substitute if dirname fails. - dstdir=` - (dirname "$dst") 2>/dev/null || - expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$dst" : 'X\(//\)[^/]' \| \ - X"$dst" : 'X\(//\)$' \| \ - X"$dst" : 'X\(/\)' \| . 2>/dev/null || - echo X"$dst" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q' - ` - - test -d "$dstdir" - dstdir_status=$? - fi - fi - - obsolete_mkdir_used=false - - if test $dstdir_status != 0; then - case $posix_mkdir in - '') - # Create intermediate dirs using mode 755 as modified by the umask. - # This is like FreeBSD 'install' as of 1997-10-28. - umask=`umask` - case $stripcmd.$umask in - # Optimize common cases. - *[2367][2367]) mkdir_umask=$umask;; - .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; - - *[0-7]) - mkdir_umask=`expr $umask + 22 \ - - $umask % 100 % 40 + $umask % 20 \ - - $umask % 10 % 4 + $umask % 2 - `;; - *) mkdir_umask=$umask,go-w;; - esac - - # With -d, create the new directory with the user-specified mode. - # Otherwise, rely on $mkdir_umask. - if test -n "$dir_arg"; then - mkdir_mode=-m$mode - else - mkdir_mode= - fi - - posix_mkdir=false - case $umask in - *[123567][0-7][0-7]) - # POSIX mkdir -p sets u+wx bits regardless of umask, which - # is incompatible with FreeBSD 'install' when (umask & 300) != 0. - ;; - *) - tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ - trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 - - if (umask $mkdir_umask && - exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 - then - if test -z "$dir_arg" || { - # Check for POSIX incompatibilities with -m. - # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or - # other-writeable bit of parent directory when it shouldn't. - # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. - ls_ld_tmpdir=`ls -ld "$tmpdir"` - case $ls_ld_tmpdir in - d????-?r-*) different_mode=700;; - d????-?--*) different_mode=755;; - *) false;; - esac && - $mkdirprog -m$different_mode -p -- "$tmpdir" && { - ls_ld_tmpdir_1=`ls -ld "$tmpdir"` - test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" - } - } - then posix_mkdir=: - fi - rmdir "$tmpdir/d" "$tmpdir" - else - # Remove any dirs left behind by ancient mkdir implementations. - rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null - fi - trap '' 0;; - esac;; - esac - - if - $posix_mkdir && ( - umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" - ) - then : - else - - # The umask is ridiculous, or mkdir does not conform to POSIX, - # or it failed possibly due to a race condition. Create the - # directory the slow way, step by step, checking for races as we go. - - case $dstdir in - /*) prefix='/';; - -*) prefix='./';; - *) prefix='';; - esac - - eval "$initialize_posix_glob" - - oIFS=$IFS - IFS=/ - $posix_glob set -f - set fnord $dstdir - shift - $posix_glob set +f - IFS=$oIFS - - prefixes= - - for d - do - test -z "$d" && continue - - prefix=$prefix$d - if test -d "$prefix"; then - prefixes= - else - if $posix_mkdir; then - (umask=$mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break - # Don't fail if two instances are running concurrently. - test -d "$prefix" || exit 1 - else - case $prefix in - *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; - *) qprefix=$prefix;; - esac - prefixes="$prefixes '$qprefix'" - fi - fi - prefix=$prefix/ - done - - if test -n "$prefixes"; then - # Don't fail if two instances are running concurrently. - (umask $mkdir_umask && - eval "\$doit_exec \$mkdirprog $prefixes") || - test -d "$dstdir" || exit 1 - obsolete_mkdir_used=true - fi - fi - fi - - if test -n "$dir_arg"; then - { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && - { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || - test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 - else - - # Make a couple of temp file names in the proper directory. - dsttmp=$dstdir/_inst.$$_ - rmtmp=$dstdir/_rm.$$_ - - # Trap to clean up those temp files at exit. - trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 - - # Copy the file name to the temp name. - (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && - - # and set any options; do chmod last to preserve setuid bits. - # - # If any of these fail, we abort the whole thing. If we want to - # ignore errors from any of these, just make sure not to ignore - # errors from the above "$doit $cpprog $src $dsttmp" command. - # - { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && - { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && - { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && - - # If -C, don't bother to copy if it wouldn't change the file. - if $copy_on_change && - old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && - new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && - - eval "$initialize_posix_glob" && - $posix_glob set -f && - set X $old && old=:$2:$4:$5:$6 && - set X $new && new=:$2:$4:$5:$6 && - $posix_glob set +f && - - test "$old" = "$new" && - $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 - then - rm -f "$dsttmp" - else - # Rename the file to the real destination. - $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || - - # The rename failed, perhaps because mv can't rename something else - # to itself, or perhaps because mv is so ancient that it does not - # support -f. - { - # Now remove or move aside any old file at destination location. - # We try this two ways since rm can't unlink itself on some - # systems and the destination file might be busy for other - # reasons. In this case, the final cleanup might fail but the new - # file should still install successfully. - { - test ! -f "$dst" || - $doit $rmcmd -f "$dst" 2>/dev/null || - { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && - { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } - } || - { echo "$0: cannot unlink or rename $dst" >&2 - (exit 1); exit 1 - } - } && - - # Now rename the file to the real destination. - $doit $mvcmd "$dsttmp" "$dst" - } - fi || exit 1 - - trap '' 0 - fi -done - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff --git a/autogen/missing b/autogen/missing deleted file mode 100755 index 28055d2ae6f..00000000000 --- a/autogen/missing +++ /dev/null @@ -1,376 +0,0 @@ -#! /bin/sh -# Common stub for a few missing GNU programs while installing. - -scriptversion=2009-04-28.21; # UTC - -# Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006, -# 2008, 2009 Free Software Foundation, Inc. -# Originally by Fran,cois Pinard , 1996. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -if test $# -eq 0; then - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 -fi - -run=: -sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p' -sed_minuso='s/.* -o \([^ ]*\).*/\1/p' - -# In the cases where this matters, `missing' is being run in the -# srcdir already. -if test -f configure.ac; then - configure_ac=configure.ac -else - configure_ac=configure.in -fi - -msg="missing on your system" - -case $1 in ---run) - # Try to run requested program, and just exit if it succeeds. - run= - shift - "$@" && exit 0 - # Exit code 63 means version mismatch. This often happens - # when the user try to use an ancient version of a tool on - # a file that requires a minimum version. In this case we - # we should proceed has if the program had been absent, or - # if --run hadn't been passed. - if test $? = 63; then - run=: - msg="probably too old" - fi - ;; - - -h|--h|--he|--hel|--help) - echo "\ -$0 [OPTION]... PROGRAM [ARGUMENT]... - -Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an -error status if there is no known handling for PROGRAM. - -Options: - -h, --help display this help and exit - -v, --version output version information and exit - --run try to run the given command, and emulate it if it fails - -Supported PROGRAM values: - aclocal touch file \`aclocal.m4' - autoconf touch file \`configure' - autoheader touch file \`config.h.in' - autom4te touch the output file, or create a stub one - automake touch all \`Makefile.in' files - bison create \`y.tab.[ch]', if possible, from existing .[ch] - flex create \`lex.yy.c', if possible, from existing .c - help2man touch the output file - lex create \`lex.yy.c', if possible, from existing .c - makeinfo touch the output file - tar try tar, gnutar, gtar, then tar without non-portable flags - yacc create \`y.tab.[ch]', if possible, from existing .[ch] - -Version suffixes to PROGRAM as well as the prefixes \`gnu-', \`gnu', and -\`g' are ignored when checking the name. - -Send bug reports to ." - exit $? - ;; - - -v|--v|--ve|--ver|--vers|--versi|--versio|--version) - echo "missing $scriptversion (GNU Automake)" - exit $? - ;; - - -*) - echo 1>&2 "$0: Unknown \`$1' option" - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 - ;; - -esac - -# normalize program name to check for. -program=`echo "$1" | sed ' - s/^gnu-//; t - s/^gnu//; t - s/^g//; t'` - -# Now exit if we have it, but it failed. Also exit now if we -# don't have it and --version was passed (most likely to detect -# the program). This is about non-GNU programs, so use $1 not -# $program. -case $1 in - lex*|yacc*) - # Not GNU programs, they don't have --version. - ;; - - tar*) - if test -n "$run"; then - echo 1>&2 "ERROR: \`tar' requires --run" - exit 1 - elif test "x$2" = "x--version" || test "x$2" = "x--help"; then - exit 1 - fi - ;; - - *) - if test -z "$run" && ($1 --version) > /dev/null 2>&1; then - # We have it, but it failed. - exit 1 - elif test "x$2" = "x--version" || test "x$2" = "x--help"; then - # Could not run --version or --help. This is probably someone - # running `$TOOL --version' or `$TOOL --help' to check whether - # $TOOL exists and not knowing $TOOL uses missing. - exit 1 - fi - ;; -esac - -# If it does not exist, or fails to run (possibly an outdated version), -# try to emulate it. -case $program in - aclocal*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`acinclude.m4' or \`${configure_ac}'. You might want - to install the \`Automake' and \`Perl' packages. Grab them from - any GNU archive site." - touch aclocal.m4 - ;; - - autoconf*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`${configure_ac}'. You might want to install the - \`Autoconf' and \`GNU m4' packages. Grab them from any GNU - archive site." - touch configure - ;; - - autoheader*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`acconfig.h' or \`${configure_ac}'. You might want - to install the \`Autoconf' and \`GNU m4' packages. Grab them - from any GNU archive site." - files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` - test -z "$files" && files="config.h" - touch_files= - for f in $files; do - case $f in - *:*) touch_files="$touch_files "`echo "$f" | - sed -e 's/^[^:]*://' -e 's/:.*//'`;; - *) touch_files="$touch_files $f.in";; - esac - done - touch $touch_files - ;; - - automake*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. - You might want to install the \`Automake' and \`Perl' packages. - Grab them from any GNU archive site." - find . -type f -name Makefile.am -print | - sed 's/\.am$/.in/' | - while read f; do touch "$f"; done - ;; - - autom4te*) - echo 1>&2 "\ -WARNING: \`$1' is needed, but is $msg. - You might have modified some files without having the - proper tools for further handling them. - You can get \`$1' as part of \`Autoconf' from any GNU - archive site." - - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -f "$file"; then - touch $file - else - test -z "$file" || exec >$file - echo "#! /bin/sh" - echo "# Created by GNU Automake missing as a replacement of" - echo "# $ $@" - echo "exit 0" - chmod +x $file - exit 1 - fi - ;; - - bison*|yacc*) - echo 1>&2 "\ -WARNING: \`$1' $msg. You should only need it if - you modified a \`.y' file. You may need the \`Bison' package - in order for those modifications to take effect. You can get - \`Bison' from any GNU archive site." - rm -f y.tab.c y.tab.h - if test $# -ne 1; then - eval LASTARG="\${$#}" - case $LASTARG in - *.y) - SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" y.tab.c - fi - SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" y.tab.h - fi - ;; - esac - fi - if test ! -f y.tab.h; then - echo >y.tab.h - fi - if test ! -f y.tab.c; then - echo 'main() { return 0; }' >y.tab.c - fi - ;; - - lex*|flex*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a \`.l' file. You may need the \`Flex' package - in order for those modifications to take effect. You can get - \`Flex' from any GNU archive site." - rm -f lex.yy.c - if test $# -ne 1; then - eval LASTARG="\${$#}" - case $LASTARG in - *.l) - SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` - if test -f "$SRCFILE"; then - cp "$SRCFILE" lex.yy.c - fi - ;; - esac - fi - if test ! -f lex.yy.c; then - echo 'main() { return 0; }' >lex.yy.c - fi - ;; - - help2man*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a dependency of a manual page. You may need the - \`Help2man' package in order for those modifications to take - effect. You can get \`Help2man' from any GNU archive site." - - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -f "$file"; then - touch $file - else - test -z "$file" || exec >$file - echo ".ab help2man is required to generate this page" - exit $? - fi - ;; - - makeinfo*) - echo 1>&2 "\ -WARNING: \`$1' is $msg. You should only need it if - you modified a \`.texi' or \`.texinfo' file, or any other file - indirectly affecting the aspect of the manual. The spurious - call might also be the consequence of using a buggy \`make' (AIX, - DU, IRIX). You might want to install the \`Texinfo' package or - the \`GNU make' package. Grab either from any GNU archive site." - # The file to touch is that specified with -o ... - file=`echo "$*" | sed -n "$sed_output"` - test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` - if test -z "$file"; then - # ... or it is the one specified with @setfilename ... - infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` - file=`sed -n ' - /^@setfilename/{ - s/.* \([^ ]*\) *$/\1/ - p - q - }' $infile` - # ... or it is derived from the source name (dir/f.texi becomes f.info) - test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info - fi - # If the file does not exist, the user really needs makeinfo; - # let's fail without touching anything. - test -f $file || exit 1 - touch $file - ;; - - tar*) - shift - - # We have already tried tar in the generic part. - # Look for gnutar/gtar before invocation to avoid ugly error - # messages. - if (gnutar --version > /dev/null 2>&1); then - gnutar "$@" && exit 0 - fi - if (gtar --version > /dev/null 2>&1); then - gtar "$@" && exit 0 - fi - firstarg="$1" - if shift; then - case $firstarg in - *o*) - firstarg=`echo "$firstarg" | sed s/o//` - tar "$firstarg" "$@" && exit 0 - ;; - esac - case $firstarg in - *h*) - firstarg=`echo "$firstarg" | sed s/h//` - tar "$firstarg" "$@" && exit 0 - ;; - esac - fi - - echo 1>&2 "\ -WARNING: I can't seem to be able to run \`tar' with the given arguments. - You may want to install GNU tar or Free paxutils, or check the - command line arguments." - exit 1 - ;; - - *) - echo 1>&2 "\ -WARNING: \`$1' is needed, and is $msg. - You might have modified some files without having the - proper tools for further handling them. Check the \`README' file, - it often tells you about the needed prerequisites for installing - this package. You may also peek at any GNU archive site, in case - some other package would contain this missing \`$1' program." - exit 1 - ;; -esac - -exit 0 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff --git a/build-aux/dir_top b/build-aux/dir_top new file mode 100644 index 00000000000..321a39dc35e --- /dev/null +++ b/build-aux/dir_top @@ -0,0 +1,20 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + +The Info Directory +****************** + + The Info Directory is the top-level menu of major Info topics. + Type "d" in Info to return to the Info Directory. Type "q" to exit Info. + Type "?" for a list of Info commands, or "h" to visit an Info tutorial. + Type "m" to choose a menu item--for instance, + "mEmacs" visits the Emacs manual. + In Emacs Info, you can click mouse button 2 on a menu item + or cross reference to follow it to its target. + Each menu line that starts with a * is a topic you can select with "m". + Every third topic has a red * to help pick the right number to type. + +* Menu: diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir new file mode 100755 index 00000000000..3f927382ded --- /dev/null +++ b/build-aux/make-info-dir @@ -0,0 +1,106 @@ +#!/bin/sh + +### make-info-dir - create info/dir, for systems without install-info + +## Copyright (C) 2013-2014 Free Software Foundation, Inc. + +## Author: Glenn Morris +## Maintainer: emacs-devel@gnu.org + +## This file is part of GNU Emacs. + +## GNU Emacs is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. + +## GNU Emacs is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## You should have received a copy of the GNU General Public License +## along with GNU Emacs. If not, see . + +### Commentary: + +## Generate info/dir, for systems without install-info. +## Expects to be called from top-level Emacs source directory. + +## It only handles the case where info/dir is missing from the +## installation directory. It does not handle info/dir being present +## but missing some entries. + +### Code: + +if test $# -ne 1; then + echo "Specify destination file" + exit 1 +fi + +outfile=$1 + +echo "Creating $outfile..." + +if test -f "$outfile"; then + echo "$outfile already present" + exit 1 +fi + +## Header contains non-printing characters, so this is more +## reliable than using echo. +basefile=build-aux/dir_top + +if test ! -f "$basefile"; then + echo "$basefile not found" + exit 1 +fi + + +cp $basefile $outfile + + +## FIXME inefficient looping. +## What we should do is loop once over files, collecting topic and +## direntry information for each. Then loop over topics and write +## out the results. But that seems to require associative arrays, +## and I do not know how to do that with portable sh. +## Could use Emacs instead of sh, but till now info generation does +## not require Emacs to have been built. +for topic in "Texinfo documentation system" "Emacs" "Emacs lisp" \ + "Emacs editing modes" "Emacs network features" "Emacs misc features" \ + "Emacs lisp libraries"; do + + cat - <> $outfile + +$topic +EOF + ## Bit faster than doc/*/*.texi. + for file in doc/emacs/emacs.texi doc/lispintro/emacs-lisp-intro.texi \ + doc/lispref/elisp.texi doc/misc/*.texi; do + + ## FIXME do not ignore w32 if OS is w32. + case $file in + *-xtra.texi|*efaq-w32.texi|*doclicense.texi) continue ;; + esac + + dircat=`sed -n -e 's/@value{emacsname}/Emacs/' -e 's/^@dircategory //p' $file` + + ## TODO warn about unknown topics. + ## (check-info in top-level Makefile does that.) + test "$dircat" = "$topic" || continue + + + sed -n -e 's/@value{emacsname}/Emacs/' \ + -e 's/@acronym{\([A-Z]*\)}/\1/' \ + -e '/^@direntry/,/^@end direntry/ s/^\([^@]\)/\1/p' \ + $file >> $outfile + + done +done + +echo "Created $outfile" + +exit 0 + +### make-info-dir ends here diff --git a/build-aux/move-if-change b/build-aux/move-if-change index f45cbea3bf7..88d95745649 100755 --- a/build-aux/move-if-change +++ b/build-aux/move-if-change @@ -8,7 +8,7 @@ VERSION='2012-01-06 07:23'; # UTC # If you change this file with Emacs, please let the write hook # do its job. Otherwise, update this string manually. -# Copyright (C) 2002-2013 Free Software Foundation, Inc. +# Copyright (C) 2002-2014 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 diff --git a/build-aux/msys-to-w32 b/build-aux/msys-to-w32 new file mode 100755 index 00000000000..4c92cc91a3d --- /dev/null +++ b/build-aux/msys-to-w32 @@ -0,0 +1,170 @@ +#!/bin/sh +# Take a list of MSYS-compatible paths and convert them to native +# MS-Windows format. +# Status is zero if successful, nonzero otherwise. + +# Copyright (C) 2013-2014 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 . + +# Take only the basename from the full pathname +me=${0//*\//} + +usage="usage: ${me} PATHLIST [MUSTEXIST] [SEPARATOR [SEPARATOR2]]" + +help="$usage + or: ${me} OPTION + +Convert MSYS-compatible paths to MS-Windows native format. + +PATHLIST should be a list of paths separated by SEPARATOR. This list +will be written to the standard output after performing the following +transformations: +1. Discard empty paths. +2. Replace backslashes with forward slashes. +3. Replace two consecutive slashes with single ones. +4. Translate to Windows-native format those paths that are not in such + format already. The translated paths will not end with a slash, + except for root directories (e.g. 'c:/' or 'c:/foo'). Paths + starting with '%emacs_dir%' will not be translated. +5. Escape with backslashes every occurrence of SEPARATOR2 within the paths. +6. Concatenate the translated paths with SEPARATOR2. + +If MUSTEXIST is 'Y' or not supplied, then each path in PATHLIST must +exist. Otherwise, only some part of each path is required to exist +(the deepest existing subpath will be translated and the remainder +concatenated to the translation). + +If SEPARATOR is not supplied, PATHLIST will be regarded as a single +path. + +If SEPARATOR2 is not supplied, it will take the same value as +SEPARATOR. + +Options: + --help display this help and exit + +Report bugs to ." + +for arg +do + case $arg in + --help | --hel | --he | --h) + exec echo "$help" ;; + --) + shift + break ;; + -*) + echo "${me}: invalid option: $arg" >&2 + exit 1 ;; + *) + break ;; + esac +done + +{ test $# -ge 1 && test $# -le 4; } || +{ echo "${me}: $usage" >&2; exit 1; } + +# Arguments +pathlist="$1" +mustexist="${2:-Y}" +separator="$3" +separator2="${4:-${separator}}" + +# Split pathlist into its path components +if test -n "$separator" +then + IFS=${separator} patharray=( $pathlist ) +else + patharray=( "$pathlist" ) +fi + +w32pathlist="" + +for p in "${patharray[@]}" +do + # Skip empty paths + test "$p" = "" && continue + + # Replace '\' with '/' and '//' with '/' + p="${p//\\//}" + p="${p//\/\///}" + + if test "${p:0:11}" = "%emacs_dir%" + then + # Paths starting with "%emacs_dir%" will not be translated + w32p=$p + elif test -d "$p" + then + # The path exists, so just translate it + w32p=`cd "$p" && pwd -W` + else + # The path does not exist. So, try to guess the + # Windows-native translation, by looking for the deepest + # existing directory in this path, and then translating the + # existing part and concatenating the remainder. + + test "${mustexist}" = "Y" && + { echo "${me}: invalid path: $p" >&2; exit 1; } + + p1=$p + IFS=/ pcomponents=( $p ) + + for (( i=${#pcomponents[@]}-1 ; i>=0 ; i-- )) + do + + if test "${pcomponents[i]}" = "" + then + # The path component is empty. This can only mean + # that the path starts with "/" and all components + # have been stripped out already. So in this case we + # want to test with the MSYS root directory + p1="/" + else + p1="${p1%/}" + p1="${p1%${pcomponents[i]}}" + fi + + if test -d "${p1}" + then + + # Existing path found + + # Translate the existing part and concatenate the + # remainder (ensuring that only one slash is used in + # the join, and no trailing slash is left) + w32p1=`cd "${p1}" && pwd -W` + remainder="${p#${p1}}" + remainder="${remainder#/}" + remainder="${remainder%/}" + w32p="${w32p1%/}/${remainder}" + + break + fi + + done + + # If no existing directory was found, error out + test -e "${p1}" || + { echo "${me}: invalid path: ${p}" >&2; exit 1; } + fi + + # Concatenate the translated path to the translated pathlist + test "${w32pathlist}" = "" || w32pathlist="${w32pathlist}${separator2}" + w32pathlist="${w32pathlist}${w32p//${separator2}/\\${separator2}}" + +done + +# Write the translated pathlist to the standard output +printf "%s" "${w32pathlist}" diff --git a/build-aux/snippet/arg-nonnull.h b/build-aux/snippet/arg-nonnull.h index 8ea2a4747e8..9ee8b155508 100644 --- a/build-aux/snippet/arg-nonnull.h +++ b/build-aux/snippet/arg-nonnull.h @@ -1,5 +1,5 @@ /* A C macro for declaring that specific arguments must not be NULL. - Copyright (C) 2009-2013 Free Software Foundation, Inc. + Copyright (C) 2009-2014 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 diff --git a/build-aux/snippet/c++defs.h b/build-aux/snippet/c++defs.h index b35b933cd67..67b12335d0f 100644 --- a/build-aux/snippet/c++defs.h +++ b/build-aux/snippet/c++defs.h @@ -1,5 +1,5 @@ /* C++ compatible function declaration macros. - Copyright (C) 2010-2013 Free Software Foundation, Inc. + Copyright (C) 2010-2014 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 diff --git a/build-aux/snippet/warn-on-use.h b/build-aux/snippet/warn-on-use.h index 1736a1bd7a4..1c4d7bd4ed5 100644 --- a/build-aux/snippet/warn-on-use.h +++ b/build-aux/snippet/warn-on-use.h @@ -1,5 +1,5 @@ /* A C macro for emitting warnings if a function is used. - Copyright (C) 2010-2013 Free Software Foundation, Inc. + Copyright (C) 2010-2014 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 diff --git a/build-aux/update-copyright b/build-aux/update-copyright new file mode 100755 index 00000000000..90624e9004c --- /dev/null +++ b/build-aux/update-copyright @@ -0,0 +1,274 @@ +eval '(exit $?0)' && eval 'exec perl -wS -0777 -pi "$0" ${1+"$@"}' + & eval 'exec perl -wS -0777 -pi "$0" $argv:q' + if 0; +# Update an FSF copyright year list to include the current year. + +my $VERSION = '2013-01-03.09:41'; # UTC + +# Copyright (C) 2009-2014 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, see . + +# Written by Jim Meyering and Joel E. Denny + +# The arguments to this script should be names of files that contain +# copyright statements to be updated. The copyright holder's name +# defaults to "Free Software Foundation, Inc." but may be changed to +# any other name by using the "UPDATE_COPYRIGHT_HOLDER" environment +# variable. +# +# For example, you might wish to use the update-copyright target rule +# in maint.mk from gnulib's maintainer-makefile module. +# +# Iff a copyright statement is recognized in a file and the final +# year is not the current year, then the statement is updated for the +# new year and it is reformatted to: +# +# 1. Fit within 72 columns. +# 2. Convert 2-digit years to 4-digit years by prepending "19". +# 3. Expand copyright year intervals. (See "Environment variables" +# below.) +# +# A warning is printed for every file for which no copyright +# statement is recognized. +# +# Each file's copyright statement must be formatted correctly in +# order to be recognized. For example, each of these is fine: +# +# Copyright @copyright{} 1990-2005, 2007-2009 Free Software +# Foundation, Inc. +# +# # Copyright (C) 1990-2005, 2007-2009 Free Software +# # Foundation, Inc. +# +# /* +# * Copyright © 90,2005,2007-2009 +# * Free Software Foundation, Inc. +# */ +# +# However, the following format is not recognized because the line +# prefix changes after the first line: +# +# ## Copyright (C) 1990-2005, 2007-2009 Free Software +# # Foundation, Inc. +# +# However, any correctly formatted copyright statement following +# a non-matching copyright statements would be recognized. +# +# The exact conditions that a file's copyright statement must meet +# to be recognized are: +# +# 1. It is the first copyright statement that meets all of the +# following conditions. Subsequent copyright statements are +# ignored. +# 2. Its format is "Copyright (C)", then a list of copyright years, +# and then the name of the copyright holder. +# 3. The "(C)" takes one of the following forms or is omitted +# entirely: +# +# A. (C) +# B. (c) +# C. @copyright{} +# D. © +# +# 4. The "Copyright" appears at the beginning of a line, except that it +# may be prefixed by any sequence (e.g., a comment) of no more than +# 5 characters -- including white space. +# 5. Iff such a prefix is present, the same prefix appears at the +# beginning of each remaining line within the FSF copyright +# statement. There is one exception in order to support C-style +# comments: if the first line's prefix contains nothing but +# whitespace surrounding a "/*", then the prefix for all subsequent +# lines is the same as the first line's prefix except with each of +# "/" and possibly "*" replaced by a " ". The replacement of "*" +# by " " is consistent throughout all subsequent lines. +# 6. Blank lines, even if preceded by the prefix, do not appear +# within the FSF copyright statement. +# 7. Each copyright year is 2 or 4 digits, and years are separated by +# commas or dashes. Whitespace may appear after commas. +# +# Environment variables: +# +# 1. If UPDATE_COPYRIGHT_FORCE=1, a recognized FSF copyright statement +# is reformatted even if it does not need updating for the new +# year. If unset or set to 0, only updated FSF copyright +# statements are reformatted. +# 2. If UPDATE_COPYRIGHT_USE_INTERVALS=1, every series of consecutive +# copyright years (such as 90, 1991, 1992-2007, 2008) in a +# reformatted FSF copyright statement is collapsed to a single +# interval (such as 1990-2008). If unset or set to 0, all existing +# copyright year intervals in a reformatted FSF copyright statement +# are expanded instead. +# If UPDATE_COPYRIGHT_USE_INTERVALS=2, convert a sequence with gaps +# to the minimal containing range. For example, convert +# 2000, 2004-2007, 2009 to 2000-2009. +# 3. For testing purposes, you can set the assumed current year in +# UPDATE_COPYRIGHT_YEAR. +# 4. The default maximum line length for a copyright line is 72. +# Set UPDATE_COPYRIGHT_MAX_LINE_LENGTH to use a different length. +# 5. Set UPDATE_COPYRIGHT_HOLDER if the copyright holder is other +# than "Free Software Foundation, Inc.". + +use strict; +use warnings; + +my $copyright_re = 'Copyright'; +my $circle_c_re = '(?:\([cC]\)|@copyright{}|©)'; +my $holder = $ENV{UPDATE_COPYRIGHT_HOLDER}; +$holder ||= 'Free Software Foundation, Inc.'; +my $prefix_max = 5; +my $margin = $ENV{UPDATE_COPYRIGHT_MAX_LINE_LENGTH}; +!$margin || $margin !~ m/^\d+$/ + and $margin = 72; + +my $tab_width = 8; + +my $this_year = $ENV{UPDATE_COPYRIGHT_YEAR}; +if (!$this_year || $this_year !~ m/^\d{4}$/) + { + my ($sec, $min, $hour, $mday, $month, $year) = localtime (time ()); + $this_year = $year + 1900; + } + +# Unless the file consistently uses "\r\n" as the EOL, use "\n" instead. +my $eol = /(?:^|[^\r])\n/ ? "\n" : "\r\n"; + +my $leading; +my $prefix; +my $ws_re; +my $stmt_re; +while (/(^|\n)(.{0,$prefix_max})$copyright_re/g) + { + $leading = "$1$2"; + $prefix = $2; + if ($prefix =~ /^(\s*\/)\*(\s*)$/) + { + $prefix =~ s,/, ,; + my $prefix_ws = $prefix; + $prefix_ws =~ s/\*/ /; # Only whitespace. + if (/\G(?:[^*\n]|\*[^\/\n])*\*?\n$prefix_ws/) + { + $prefix = $prefix_ws; + } + } + $ws_re = '[ \t\r\f]'; # \s without \n + $ws_re = + "(?:$ws_re*(?:$ws_re|\\n" . quotemeta($prefix) . ")$ws_re*)"; + my $holder_re = $holder; + $holder_re =~ s/\s/$ws_re/g; + my $stmt_remainder_re = + "(?:$ws_re$circle_c_re)?" + . "$ws_re(?:(?:\\d\\d)?\\d\\d(?:,$ws_re?|-))*" + . "((?:\\d\\d)?\\d\\d)$ws_re$holder_re"; + if (/\G$stmt_remainder_re/) + { + $stmt_re = + quotemeta($leading) . "($copyright_re$stmt_remainder_re)"; + last; + } + } +if (defined $stmt_re) + { + /$stmt_re/ or die; # Should never die. + my $stmt = $1; + my $final_year_orig = $2; + + # Handle two-digit year numbers like "98" and "99". + my $final_year = $final_year_orig; + $final_year <= 99 + and $final_year += 1900; + + if ($final_year != $this_year) + { + # Update the year. + $stmt =~ s/\b$final_year_orig\b/$final_year, $this_year/; + } + if ($final_year != $this_year || $ENV{'UPDATE_COPYRIGHT_FORCE'}) + { + # Normalize all whitespace including newline-prefix sequences. + $stmt =~ s/$ws_re/ /g; + + # Put spaces after commas. + $stmt =~ s/, ?/, /g; + + # Convert 2-digit to 4-digit years. + $stmt =~ s/(\b\d\d\b)/19$1/g; + + # Make the use of intervals consistent. + if (!$ENV{UPDATE_COPYRIGHT_USE_INTERVALS}) + { + $stmt =~ s/(\d{4})-(\d{4})/join(', ', $1..$2)/eg; + } + else + { + $stmt =~ + s/ + (\d{4}) + (?: + (,\ |-) + ((??{ + if ($2 eq '-') { '\d{4}'; } + elsif (!$3) { $1 + 1; } + else { $3 + 1; } + })) + )+ + /$1-$3/gx; + + # When it's 2, emit a single range encompassing all year numbers. + $ENV{UPDATE_COPYRIGHT_USE_INTERVALS} == 2 + and $stmt =~ s/\b(\d{4})\b.*\b(\d{4})\b/$1-$2/; + } + + # Format within margin. + my $stmt_wrapped; + my $text_margin = $margin - length($prefix); + if ($prefix =~ /^(\t+)/) + { + $text_margin -= length($1) * ($tab_width - 1); + } + while (length $stmt) + { + if (($stmt =~ s/^(.{1,$text_margin})(?: |$)//) + || ($stmt =~ s/^([\S]+)(?: |$)//)) + { + my $line = $1; + $stmt_wrapped .= $stmt_wrapped ? "$eol$prefix" : $leading; + $stmt_wrapped .= $line; + } + else + { + # Should be unreachable, but we don't want an infinite + # loop if it can be reached. + die; + } + } + + # Replace the old copyright statement. + s/$stmt_re/$stmt_wrapped/; + } + } +else + { + print STDERR "$ARGV: warning: copyright statement not found\n"; + } + +# Local variables: +# mode: perl +# indent-tabs-mode: nil +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "my $VERSION = '" +# time-stamp-format: "%:y-%02m-%02d.%02H:%02M" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "'; # UTC" +# End: diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs index 8fdf1609e6f..3117113cc47 100755 --- a/build-aux/update-subdirs +++ b/build-aux/update-subdirs @@ -1,7 +1,7 @@ #!/bin/sh # Write into $1/subdirs.el a list of subdirs of directory $1. -# Copyright (C) 1994-1995, 1997, 1999, 2001-2013 Free Software +# Copyright (C) 1994-1995, 1997, 1999, 2001-2014 Free Software # Foundation, Inc. # This file is part of GNU Emacs. @@ -20,7 +20,7 @@ # along with GNU Emacs. If not, see . -cd $1 +cd "$1" || exit 1 for file in *; do case $file in *.elc | *.el | term | RCS | CVS | Old | . | .. | =* | *~ | *.orig | *.rej) @@ -49,8 +49,8 @@ else ;; no-byte-compile: t ;; End:" > subdirs.el~ if cmp "subdirs.el" "subdirs.el~" >/dev/null 2>&1; then - :; # echo "subdirs.el unchanged"; + rm subdirs.el~ else - mv subdirs.el~ subdirs.el + mv subdirs.el~ subdirs.el fi fi diff --git a/config.bat b/config.bat index 683bb7062cf..8af3756222b 100644 --- a/config.bat +++ b/config.bat @@ -1,7 +1,7 @@ @echo off rem ---------------------------------------------------------------------- rem Configuration script for MSDOS -rem Copyright (C) 1994-1999, 2001-2013 Free Software Foundation, Inc. +rem Copyright (C) 1994-1999, 2001-2014 Free Software Foundation, Inc. rem This file is part of GNU Emacs. @@ -155,10 +155,10 @@ rm -f epaths.tmp rem Create "config.h" rm -f config.h2 config.tmp if exist config.in sed -e '' config.in > config.tmp -if exist ..\autogen\config.in sed -e '' ../autogen/config.in > config.tmp +if exist ..\msdos\autogen\config.in sed -e '' ../msdos/autogen/config.in > config.tmp if "%X11%" == "" goto src4 if exist config.in sed -f ../msdos/sed2x.inp < config.in > config.tmp -if exist ..\autogen\config.in sed -f ../msdos/sed2x.inp < ..\autogen\config.in > config.tmp +if exist ..\msdos\autogen\config.in sed -f ../msdos/sed2x.inp < ..\msdos\autogen\config.in > config.tmp :src4 sed -f ../msdos/sed2v2.inp config.h2 Rem See if they have libxml2 later than v2.2.0 installed @@ -279,7 +279,7 @@ If Exist sys_types.in.h update sys_types.in.h sys_types.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 If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp -If Exist ..\autogen\Makefile.in sed -f ../msdos/sedlibcf.inp < ..\autogen\Makefile.in > makefile.tmp +If Exist ..\msdos\autogen\Makefile.in sed -f ../msdos/sedlibcf.inp < ..\msdos\autogen\Makefile.in > makefile.tmp sed -f ../msdos/sedlibmk.inp < makefile.tmp > Makefile rm -f makefile.tmp Rem Create .Po files for new files in lib/ diff --git a/configure.ac b/configure.ac index cf930e7dee3..2d41488f0b5 100644 --- a/configure.ac +++ b/configure.ac @@ -4,7 +4,7 @@ dnl autoconf dnl in the directory containing this script. dnl If you changed any AC_DEFINES, also run autoheader. dnl -dnl Copyright (C) 1994-1996, 1999-2013 Free Software Foundation, Inc. +dnl Copyright (C) 1994-1996, 1999-2014 Free Software Foundation, Inc. dnl dnl This file is part of GNU Emacs. dnl @@ -24,23 +24,80 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) AC_INIT(emacs, 24.3.50) +dnl We get MINGW64 with MSYS2 +if test "x$MSYSTEM" = "xMINGW32" -o "x$MSYSTEM" = "xMINGW64" +then + . $srcdir/nt/mingw-cfg.site + + case $srcdir in + /* | ?:*) + # srcdir is an absolute path. In this case, force the format + # "/c/foo/bar", to simplify later conversions to native Windows + # format ("c:/foo/bar") + srcdir=`cd "${srcdir}" && pwd -W` + srcdir="/${srcdir:0:1}${srcdir:2}" + ;; + esac +fi + +dnl Set emacs_config_options to the options of 'configure', quoted for the shell, +dnl and then quoted again for a C string. Separate options with spaces. +dnl Add some environment variables, if they were passed via the environment +dnl rather than on the command-line. +emacs_config_options= +optsep= dnl This is the documented way to record the args passed to configure, dnl rather than $ac_configure_args. -emacs_config_options="$@" -## Add some environment variables, if they were passed via the environment -## rather than on the command-line. -for var in CFLAGS CPPFLAGS LDFLAGS; do - case "$emacs_config_options" in - *$var=*) continue ;; - esac - eval val="\$${var}" - test x"$val" = x && continue - emacs_config_options="${emacs_config_options}${emacs_config_options:+ }$var=\"$val\"" +for opt in ${1+"$@"} CFLAGS CPPFLAGS LDFLAGS; do + case $opt in + -n | --no-create | --no-recursion) + continue ;; + CFLAGS | CPPFLAGS | LDFLAGS) + eval 'test "${'$opt'+set}" = set' || continue + case " $*" in + *" $opt="*) continue ;; + esac + eval opt=$opt=\$$opt ;; + esac + + emacs_shell_specials=$IFS\''"#$&()*;<>?@<:@\\`{|~' + case $opt in + *[["$emacs_shell_specials"]]*) + case $opt in + *\'*) + emacs_quote_apostrophes="s/'/'\\\\''/g" + opt=`AS_ECHO(["$opt"]) | sed "$emacs_quote_apostrophes"` ;; + esac + opt="'$opt'" + case $opt in + *[['"\\']]*) + emacs_quote_for_c='s/[["\\]]/\\&/g; $!s/$/\\n\\/' + opt=`AS_ECHO(["$opt"]) | sed "$emacs_quote_for_c"` ;; + esac ;; + esac + AS_VAR_APPEND([emacs_config_options], ["$optsep$opt"]) + optsep=' ' done -AC_CONFIG_HEADER(src/config.h:src/config.in) +AC_CONFIG_HEADERS(src/config.h:src/config.in) AC_CONFIG_SRCDIR(src/lisp.h) AC_CONFIG_AUX_DIR(build-aux) + +xcsdkdir= +AC_CHECK_PROGS(XCRUN, [xcrun]) +if test -n "$XCRUN"; then + if test -z "$MAKE"; then + dnl Call the variable MAKE_PROG, not MAKE, to avoid confusion with + dnl SET_MAKE and with the usual MAKE variable that 'make' itself uses. + AC_CHECK_PROG([MAKE_PROG], [make], [yes]) + if test -z "$MAKE_PROG"; then + MAKE="$XCRUN MAKE" + export MAKE + xcsdkdir=`$XCRUN --show-sdk-path 2>/dev/null` + fi + fi +fi + dnl Fairly arbitrary, older versions might work too. AM_INIT_AUTOMAKE(1.11) @@ -53,14 +110,13 @@ dnl hence the single quotes. This is per the GNU coding standards, see dnl (autoconf) Installation Directory Variables dnl See also epaths.h below. lispdir='${datadir}/emacs/${version}/lisp' -leimdir='${datadir}/emacs/${version}/leim' -standardlisppath='${lispdir}:${leimdir}' +standardlisppath='${lispdir}' locallisppath='${datadir}/emacs/${version}/site-lisp:'\ '${datadir}/emacs/site-lisp' lisppath='${locallisppath}:${standardlisppath}' etcdir='${datadir}/emacs/${version}/etc' archlibdir='${libexecdir}/emacs/${version}/${configuration}' -docdir='${datadir}/emacs/${version}/etc' +etcdocdir='${datadir}/emacs/${version}/etc' gamedir='${localstatedir}/games/emacs' dnl Special option to disable the most of other options. @@ -68,8 +124,8 @@ AC_ARG_WITH(all, [AS_HELP_STRING([--without-all], [omit almost all features and build small executable with minimal dependencies])], - with_features=$withval, - with_features=yes) + [with_features=$withval], + [with_features=yes]) dnl OPTION_DEFAULT_OFF(NAME, HELP-STRING) dnl Create a new --with option that defaults to being disabled. @@ -86,7 +142,7 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl ])dnl dnl OPTION_DEFAULT_ON(NAME, HELP-STRING) -dnl Create a new --with option that defaults to $enable_features. +dnl Create a new --with option that defaults to $with_features. dnl NAME is the base name of the option. The shell variable with_NAME dnl will be set either to 'no' (for a plain --without-NAME) or to dnl 'yes' (if the option is not specified). Note that the shell @@ -141,7 +197,18 @@ AC_ARG_WITH([mailhost],[AS_HELP_STRING([--with-mailhost=HOSTNAME], [string giving default POP mail host])], AC_DEFINE_UNQUOTED(MAILHOST, ["$withval"], [String giving fallback POP mail host.])) -OPTION_DEFAULT_ON([sound],[don't compile with sound support]) +AC_ARG_WITH([sound],[AS_HELP_STRING([--with-sound=VALUE], + [compile with sound support (VALUE one of: yes, alsa, oss, bsd-ossaudio, no; +default yes). Only for GNU/Linux, FreeBSD, NetBSD, MinGW.])], + [ case "${withval}" in + yes|no|alsa|oss|bsd-ossaudio) val=$withval ;; + *) AC_MSG_ERROR([`--with-sound=$withval' is invalid; +this option's value should be `yes', `no', `alsa', `oss', or `bsd-ossaudio'.]) + ;; + esac + with_sound=$val + ], + [with_sound=$with_features]) dnl FIXME currently it is not the last. dnl This should be the last --with option, because --with-x is @@ -192,16 +259,33 @@ OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) OPTION_DEFAULT_ON([xim],[don't use X11 XIM]) OPTION_DEFAULT_OFF([ns],[use NeXTstep (Cocoa or GNUstep) windowing system]) -OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI]) +OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI in a Cygwin build]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) -OPTION_DEFAULT_ON([acl],[don't compile with ACL support]) OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) -OPTION_DEFAULT_ON([inotify],[don't compile with inotify (file-watch) support]) +OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) + +AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], + [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])], + [ case "${withval}" in + y | ye | yes ) val=yes ;; + n | no ) val=no ;; + g | gf | gfi | gfil | gfile ) val=gfile ;; + i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; + w | w3 | w32 ) val=w32 ;; + * ) AC_MSG_ERROR([`--with-file-notification=$withval' is invalid; +this option's value should be `yes', `no', `gfile', `inotify' or `w32'. +`yes' is a synonym for `w32' on MS-Windows, for `no' on Nextstep, +otherwise for the first of `gfile' or `inotify' that is usable.]) + ;; + esac + with_file_notification=$val + ], + [with_file_notification=$with_features]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -213,13 +297,9 @@ AC_SUBST(cache_file) ## This is an option because I do not know if all info/man support ## compressed files, nor how to test if they do so. -OPTION_DEFAULT_ON([compress-info],[don't compress the installed Info pages]) -if test $with_compress_info = yes; then - GZIP_INFO=yes -else - GZIP_INFO= -fi -AC_SUBST(GZIP_INFO) +OPTION_DEFAULT_ON([compress-install], + [don't compress some files (.el, .info, etc.) when installing. Equivalent to: +make GZIP_PROG= install]) AC_ARG_WITH([pkg-config-prog],dnl [AS_HELP_STRING([--with-pkg-config-prog=FILENAME], @@ -370,30 +450,6 @@ AC_ARG_ENABLE(gtk-deprecation-warnings, [Show Gtk+/Gdk deprecation warnings for Gtk+ >= 3.0])], [ac_enable_gtk_deprecation_warnings="${enableval}"],[]) -#### Make srcdir absolute, if it isn't already. It's important to -#### avoid running the file name through pwd unnecessarily, since pwd can -#### give you automounter prefixes, which can go away. We do all this -#### so Emacs can find its files when run uninstalled. -## Make sure CDPATH doesn't affect cd (in case PWD is relative). -unset CDPATH -case "${srcdir}" in - /* ) ;; - . ) - ## We may be able to use the $PWD environment variable to make this - ## absolute. But sometimes PWD is inaccurate. - ## Note: we used to use $PWD at the end instead of `pwd`, - ## but that tested only for a well-formed and valid PWD, - ## it did not object when PWD was well-formed and valid but just wrong. - if test ".$PWD" != "." && test ".`(cd "$PWD" ; sh -c pwd)`" = ".`pwd`" ; - then - srcdir="$PWD" - else - srcdir=`(cd "$srcdir"; pwd)` - fi - ;; - * ) srcdir=`(cd "$srcdir"; pwd)` ;; -esac - ### Canonicalize the configuration name. AC_CANONICAL_HOST @@ -439,6 +495,11 @@ case "${canonical}" in opsys=freebsd ;; + ## DragonFly ports + *-*-dragonfly* ) + opsys=dragonfly + ;; + ## FreeBSD kernel + glibc based userland *-*-kfreebsd*gnu* ) opsys=gnu-kfreebsd @@ -471,6 +532,11 @@ case "${canonical}" in ## fi ;; + ## Cygwin ports + *-*-cygwin ) + opsys=cygwin + ;; + ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux10.2* ) opsys=hpux10-20 @@ -544,8 +610,12 @@ case "${canonical}" in ## Intel 386 machines where we don't care about the manufacturer. i[3456]86-*-* ) case "${canonical}" in - *-cygwin ) opsys=cygwin ;; *-darwin* ) opsys=darwin ;; + *-mingw32 ) + opsys=mingw32 + # MinGW overrides and adds some system headers in nt/inc. + GCC_TEST_OPTIONS="-I $srcdir/nt/inc" + ;; *-sysv4.2uw* ) opsys=unixware ;; *-sysv5uw* ) opsys=unixware ;; *-sysv5OpenUNIX* ) opsys=unixware ;; @@ -553,6 +623,18 @@ case "${canonical}" in esac ;; + # MinGW64 + x86_64-*-* ) + case "${canonical}" in + *-mingw32 ) + opsys=mingw32 + # MinGW overrides and adds some system headers in nt/inc. + GCC_TEST_OPTIONS="-I $srcdir/nt/inc" + ;; + ## Otherwise, we'll fall through to the generic opsys code at the bottom. + esac + ;; + * ) unported=yes ;; @@ -585,7 +667,12 @@ fi #### Choose a compiler. dnl Sets GCC=yes if using gcc. -AC_PROG_CC +AC_PROG_CC([gcc cc cl clang "$XCRUN gcc" "$XCRUN clang"]) +if test -n "$XCRUN"; then + AC_CHECK_PROGS(AR, [ar "$XCRUN ar"]) + test -n "$AR" && export AR +fi + AM_PROG_CC_C_O if test x$GCC = xyes; then @@ -594,7 +681,15 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi -# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them. +dnl This is used in lib/Makefile.am to use nt/gnulib.mk, the +dnl alternative to lib/gnulib.mk, so as to avoid generating header files +dnl that clash with MinGW. +AM_CONDITIONAL([BUILDING_FOR_WINDOWSNT], [test "x$opsys" = "xmingw32"]) + +# Avoid gnulib's tests for -lcrypto, so that there's no static dependency on it. +AC_DEFUN([gl_CRYPTO_CHECK]) +# Avoid gnulib's tests for HAVE_WORKING_O_NOATIME and HAVE_WORKING_O_NOFOLLOW, +# as we don't use them. AC_DEFUN([gl_FCNTL_O_FLAGS]) # Avoid gnulib's threadlib module, as we do threads our own way. AC_DEFUN([gl_THREADLIB]) @@ -603,10 +698,10 @@ AC_DEFUN([gl_THREADLIB]) dnl Amongst other things, this sets AR and ARFLAGS. gl_EARLY -# It's helpful to have C macros available to GDB, so prefer -g3 to -g -# if -g3 works and the user does not specify CFLAGS. -# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains. if test "$ac_test_CFLAGS" != set; then + # It's helpful to have C macros available to GDB, so prefer -g3 to -g + # if -g3 works and the user does not specify CFLAGS. + # This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains. case $CFLAGS in '-g') emacs_g3_CFLAGS='-g3';; @@ -622,13 +717,32 @@ if test "$ac_test_CFLAGS" != set; then [emacs_cv_prog_cc_g3], [AC_LINK_IFELSE([AC_LANG_PROGRAM()], [emacs_cv_prog_cc_g3=yes], - [emacs_cv_prog_cc_g3=no])]) - if test $emacs_cv_prog_cc_g3 = yes; then - CFLAGS=$emacs_g3_CFLAGS - else + [emacs_cv_prog_cc_g3=no])]) + if test $emacs_cv_prog_cc_g3 != yes; then CFLAGS=$emacs_save_CFLAGS fi + if test $opsys = mingw32; then + CFLAGS="$CFLAGS -gdwarf-2" + fi fi + + case $CFLAGS in + *-O*) ;; + *) + # No optimization flag was inferred for this non-GCC compiler. + # Try -O. This is needed for xlc on AIX; see Bug#14258. + emacs_save_CFLAGS=$CFLAGS + test -z "$CFLAGS" || CFLAGS="$CFLAGS " + CFLAGS=${CFLAGS}-O + AC_CACHE_CHECK([whether $CC accepts -O], + [emacs_cv_prog_cc_o], + [AC_LINK_IFELSE([AC_LANG_PROGRAM()], + [emacs_cv_prog_cc_o=yes], + [emacs_cv_prog_cc_o=no])]) + if test $emacs_cv_prog_cc_o != yes; then + CFLAGS=$emacs_save_CFLAGS + fi ;; + esac fi AC_ARG_ENABLE([gcc-warnings], @@ -688,10 +802,28 @@ AC_DEFUN([gl_GCC_VERSION_IFELSE], ] ) +# clang is unduly picky about some things. +AC_CACHE_CHECK([whether the compiler is clang], [emacs_cv_clang], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #ifndef __clang__ + #error "not clang" + #endif + ]])], + [emacs_cv_clang=yes], + [emacs_cv_clang=no])]) + # When compiling with GCC, prefer -isystem to -I when including system # include files, to avoid generating useless diagnostics for the files. if test "$gl_gcc_warnings" != yes; then isystem='-I' + if test "$emacs_cv_clang" = yes + then + # Turn off some warnings if supported. + gl_WARN_ADD([-Wno-switch]) + gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare]) + gl_WARN_ADD([-Wno-pointer-sign]) + fi else isystem='-isystem ' @@ -709,33 +841,20 @@ else esac AC_SUBST([WERROR_CFLAGS]) - nw="$nw -Waggregate-return" # anachronistic - nw="$nw -Wlong-long" # C90 is anachronistic - nw="$nw -Wc++-compat" # We don't care about C++ compilers - nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib - nw="$nw -Wtraditional" # Warns on #elif which we use often - nw="$nw -Wcast-qual" # Too many warnings for now - nw="$nw -Wconversion" # Too many warnings for now nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings - nw="$nw -Wsign-conversion" # Too many warnings for now nw="$nw -Woverlength-strings" # Not a problem these days - nw="$nw -Wtraditional-conversion" # Too many warnings for now - nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored - nw="$nw -Wpadded" # Our structs are not padded - nw="$nw -Wredundant-decls" # we regularly (re)declare functions nw="$nw -Wlogical-op" # any use of fwrite provokes this nw="$nw -Wformat-nonliteral" # we do this a lot nw="$nw -Wvla" # warnings in gettext.h nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__ - nw="$nw -Wswitch-enum" # Too many warnings for now nw="$nw -Wswitch-default" # Too many warnings for now - nw="$nw -Wfloat-equal" # warns about high-quality code nw="$nw -Winline" # OK to ignore 'inline' nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. nw="$nw -Wstrict-overflow" # OK to optimize assuming that # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations + nw="$nw -Wbad-function-cast" # These casts are no worse than others. # Emacs doesn't care about shadowing; see # . @@ -747,6 +866,17 @@ else # The following line should be removable at some point. nw="$nw -Wsuggest-attribute=pure" + # This part is merely for shortening the command line, + # since -Wno-FOO needs to be added below regardless. + nw="$nw -Wmissing-field-initializers" + nw="$nw -Wswitch" + nw="$nw -Wtype-limits" + nw="$nw -Wunused-parameter" + + if test $emacs_cv_clang = yes; then + nw="$nw -Wcast-align" + fi + gl_MANYWARN_ALL_GCC([ws]) gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw]) for w in $ws; do @@ -763,8 +893,13 @@ else # gcc 4.5.0 20090517. gl_WARN_ADD([-Wno-logical-op]) - gl_WARN_ADD([-fdiagnostics-show-option]) - gl_WARN_ADD([-funit-at-a-time]) + # More things that clang is unduly picky about. + if test $emacs_cv_clang = yes; then + gl_WARN_ADD([-Wno-format-extra-args]) + gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare]) + gl_WARN_ADD([-Wno-unused-command-line-argument]) + gl_WARN_ADD([-Wno-unused-value]) + fi AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.]) AH_VERBATIM([FORTIFY_SOURCE], @@ -794,13 +929,57 @@ dnl AC_PROG_MKDIR_P dnl if test "x$RANLIB" = x; then dnl AC_PROG_RANLIB dnl fi -AC_PROG_LN_S + + +dnl Sadly, AC_PROG_LN_S is too restrictive. It also tests whether links +dnl can be made to directories. This is not relevant for our usage, and +dnl excludes some cases that work fine for us. Eg MS Windows or files +dnl hosted on AFS, both examples where simple links work, but links to +dnl directories fail. We use a cut-down version instead. +dnl AC_PROG_LN_S + +AC_MSG_CHECKING([whether ln -s works for files in the same directory]) +rm -f conf$$ conf$$.file + +LN_S_FILEONLY='cp -p' + +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + LN_S_FILEONLY='ln -s' + elif ln conf$$.file conf$$ 2>/dev/null; then + LN_S_FILEONLY=ln + fi +fi + +rm -f conf$$ conf$$.file + +if test "$LN_S_FILEONLY" = "ln -s"; then + AC_MSG_RESULT([yes]) +else + AC_MSG_RESULT([no, using $LN_S_FILEONLY]) +fi + +AC_SUBST(LN_S_FILEONLY) + + +dnl AC_PROG_LN_S sets LN_S to 'cp -pR' for MinGW, on the premise that 'ln' +dnl doesn't support links to directories, as in "ln file dir". But that +dnl use is non-portable, and OTOH MinGW wants to use hard links for Emacs +dnl executables at "make install" time. +dnl See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00475.html +dnl for more details. +if test "$opsys" = "mingw32"; then + LN_S="ln" +fi AC_PATH_PROG(INSTALL_INFO, install-info, :, $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin) dnl Don't use GZIP, which is used by gzip for additional parameters. AC_PATH_PROG(GZIP_PROG, gzip) +test $with_compress_install != yes && test -n "$GZIP_PROG" && \ + GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)" + if test $opsys = gnu-linux; then AC_PATH_PROG(PAXCTL, paxctl,, [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) @@ -810,6 +989,24 @@ if test $opsys = gnu-linux; then [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no); PAXCTL=""; fi]) fi + + if test "${SETFATTR+set}" != set; then + AC_CACHE_CHECK([for setfattr], + [emacs_cv_prog_setfattr], + [touch conftest.tmp + if (setfattr -n user.pax.flags conftest.tmp) >/dev/null 2>&1; then + emacs_cv_prog_setfattr=yes + else + emacs_cv_prog_setfattr=no + fi]) + if test "$emacs_cv_prog_setfattr" = yes; then + SETFATTR=setfattr + else + SETFATTR= + fi + rm -f conftest.tmp + AC_SUBST([SETFATTR]) + fi fi ## Need makeinfo >= 4.7 (?) to build the manuals. @@ -829,11 +1026,11 @@ fi ## pre-built, and not deleted by the normal clean rules. makeinfo is ## therefore in the category of "special tools" not normally required, which ## configure does not have to check for (eg autoconf itself). -## In a Bazaar checkout on the other hand, the manuals are not included. -## So makeinfo is a requirement to build from Bazaar, and configure +## In a repository checkout on the other hand, the manuals are not included. +## So makeinfo is a requirement to build from the repository, and configure ## should test for it as it does for any other build requirement. ## We use the presence of $srcdir/info/emacs to distinguish a release, -## with pre-built manuals, from a Bazaar checkout. +## with pre-built manuals, from a repository checkout. HAVE_MAKEINFO=yes if test "$MAKEINFO" = "no"; then @@ -855,6 +1052,13 @@ INFO_OPTS=--no-split AC_SUBST(INFO_EXT) AC_SUBST(INFO_OPTS) +if test $opsys = mingw32; then + DOCMISC_W32=efaq-w32 +else + DOCMISC_W32= +fi +AC_SUBST(DOCMISC_W32) + dnl Add our options to ac_link now, after it is set up. if test x$GCC = xyes; then @@ -871,19 +1075,45 @@ dnl (Don't use `-z nocombreloc' as -z takes no arg on Irix.) dnl Treat GCC specially since it just gives a non-fatal `unrecognized option' dnl if not built to support GNU ld. -late_LDFLAGS=$LDFLAGS +dnl For a long time, -znocombreloc was added to LDFLAGS rather than +dnl LD_SWITCH_SYSTEM_TEMACS. That is: +dnl * inappropriate, as LDFLAGS is a user option but this is essential. +dnl Eg "make LDFLAGS=... all" could run into problems, +dnl http://bugs.debian.org/684788 +dnl * unnecessary, since temacs is the only thing that actually needs it. +dnl Indeed this is where it was originally, prior to: +dnl http://lists.gnu.org/archive/html/emacs-pretest-bug/2004-03/msg00170.html +late_LDFLAGS="$LDFLAGS" if test x$GCC = xyes; then - LDFLAGS="$LDFLAGS -Wl,-znocombreloc" + LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" else - LDFLAGS="$LDFLAGS -znocombreloc" + LDFLAGS_NOCOMBRELOC="-znocombreloc" fi +LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" + AC_MSG_CHECKING([for -znocombreloc]) AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [AC_MSG_RESULT(yes)], - LDFLAGS=$late_LDFLAGS + LDFLAGS_NOCOMBRELOC= [AC_MSG_RESULT(no)]) +LDFLAGS="$late_LDFLAGS" + +AC_CACHE_CHECK([whether addresses are sanitized], + [emacs_cv_sanitize_address], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#ifndef __has_feature + #define __has_feature(f) 0 + #endif + #if defined __SANITIZE_ADDRESS__ || __has_feature (address_sanitizer) + #else + #error "Addresses are not sanitized." + #endif + ]])], + [emacs_cv_sanitize_address=yes], + [emacs_cv_sanitize_address=no])]) dnl The function dump-emacs will not be defined and temacs will do dnl (load "loadup") automatically unless told otherwise. @@ -892,8 +1122,11 @@ case "$opsys" in your-opsys-here) CANNOT_DUMP=yes ;; esac -test "$CANNOT_DUMP" = "yes" && \ +if test "$CANNOT_DUMP" = "yes"; then AC_DEFINE(CANNOT_DUMP, 1, [Define if Emacs cannot be dumped on your system.]) +elif test "$emacs_cv_sanitize_address" = yes; then + AC_MSG_WARN([[Addresses are sanitized; suggest CANNOT_DUMP=yes]]) +fi AC_SUBST(CANNOT_DUMP) @@ -901,7 +1134,6 @@ AC_SUBST(CANNOT_DUMP) UNEXEC_OBJ=unexelf.o case "$opsys" in # MSDOS uses unexcoff.o - # MSWindows uses unexw32.o aix4-2) UNEXEC_OBJ=unexaix.o ;; @@ -914,6 +1146,9 @@ case "$opsys" in hpux10-20 | hpux11) UNEXEC_OBJ=unexhp9k800.o ;; + mingw32) + UNEXEC_OBJ=unexw32.o + ;; sol2-10) # Use the Solaris dldump() function, called from unexsol.c, to dump # emacs, instead of the generic ELF dump code found in unexelf.c. @@ -932,7 +1167,7 @@ esac LD_SWITCH_SYSTEM= case "$opsys" in - freebsd) + freebsd|dragonfly) ## Let `ld' find image libs and similar things in /usr/local/lib. ## The system compiler, GCC, has apparently been modified to not ## look there, contrary to what a stock GCC would do. @@ -953,7 +1188,7 @@ case "$opsys" in ;; openbsd) - ## Han Boetes says this is necessary, + ## Han Boetes says this is necessary, ## otherwise Emacs dumps core on elf systems. LD_SWITCH_SYSTEM="-Z" ;; @@ -991,10 +1226,13 @@ case $canonical in if test "x$GCC" = "xyes"; then C_SWITCH_MACHINE="-fno-common" else - AC_MSG_ERROR([What gives? Fix me if DEC Unix supports ELF now.]) + AC_MSG_ERROR([Non-GCC compilers are not supported.]) fi else - UNEXEC_OBJ=unexalpha.o + dnl This was the unexalpha.c case. Removed in 24.1, 2010-07-24, + dnl albeit under the mistaken assumption that said file + dnl was no longer used. + AC_MSG_ERROR([Non-ELF systems are not supported since Emacs 24.1.]) fi ;; esac @@ -1008,6 +1246,12 @@ C_SWITCH_SYSTEM= ## additional optimization. --nils@exp-math.uni-essen.de test "$opsys" = "aix4.2" && test "x$GCC" != "xyes" && \ C_SWITCH_SYSTEM="-ma -qmaxmem=4000" +if test "$opsys" = "mingw32"; then + case "$canonical" in + x86_64-*-mingw32) C_SWITCH_SYSTEM="-mtune=generic" ;; + *) C_SWITCH_SYSTEM="-mtune=pentium4" ;; + esac +fi ## gnu-linux might need -D_BSD_SOURCE on old libc5 systems. ## It is redundant in glibc2, since we define _GNU_SOURCE. AC_SUBST(C_SWITCH_SYSTEM) @@ -1018,7 +1262,7 @@ case "$opsys" in ## IBM's X11R5 uses -lIM and -liconv in AIX 3.2.2. aix4-2) LIBS_SYSTEM="-lrts -lIM -liconv" ;; - freebsd) LIBS_SYSTEM="-lutil" ;; + freebsd|dragonfly) LIBS_SYSTEM="-lutil" ;; hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; @@ -1027,8 +1271,8 @@ case "$opsys" in ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; esac -AC_SUBST(LIBS_SYSTEM) +AC_SUBST(LIBS_SYSTEM) ### Make sure subsequent tests use flags consistent with the build flags. @@ -1059,13 +1303,17 @@ case $opsys in ## Adding -lm confuses the dynamic linker, so omit it. LIB_MATH= ;; - freebsd ) + freebsd | dragonfly ) SYSTEM_TYPE=berkeley-unix ;; gnu-linux | gnu-kfreebsd ) ;; hpux10-20 | hpux11 ) ;; + mingw32 ) + LIB_MATH= + SYSTEM_TYPE=windows-nt + ;; dnl NB this may be adjusted below. netbsd | openbsd ) SYSTEM_TYPE=berkeley-unix @@ -1141,52 +1389,74 @@ AC_DEFUN([PKG_CHECK_MODULES], [ fi ]) - +HAVE_SOUND=no if test "${with_sound}" != "no"; then - # Sound support for GNU/Linux and the free BSDs. - AC_CHECK_HEADERS(machine/soundcard.h sys/soundcard.h soundcard.h, - have_sound_header=yes) - # Emulation library used on NetBSD. - AC_CHECK_LIB(ossaudio, _oss_ioctl, LIBSOUND=-lossaudio, LIBSOUND=) + # Sound support for GNU/Linux, the free BSDs, and MinGW. + AC_CHECK_HEADERS([machine/soundcard.h sys/soundcard.h soundcard.h], + have_sound_header=yes, [], [ + #ifdef __MINGW32__ + #define WIN32_LEAN_AND_MEAN + #include + #endif + ]) + test "${with_sound}" = "oss" && test "${have_sound_header}" != "yes" && \ + AC_MSG_ERROR([OSS sound support requested but not found.]) + + if test "${with_sound}" = "bsd-ossaudio" || test "${with_sound}" = "yes"; then + # Emulation library used on NetBSD. + AC_CHECK_LIB(ossaudio, _oss_ioctl, LIBSOUND=-lossaudio, LIBSOUND=) + test "${with_sound}" = "bsd-ossaudio" && test -z "$LIBSOUND" && \ + AC_MSG_ERROR([bsd-ossaudio sound support requested but not found.]) + dnl FIXME? If we did find ossaudio, should we set with_sound=bsd-ossaudio? + dnl Traditionally, we go on to check for alsa too. Does that make sense? + fi AC_SUBST(LIBSOUND) - ALSA_REQUIRED=1.0.0 - ALSA_MODULES="alsa >= $ALSA_REQUIRED" - PKG_CHECK_MODULES(ALSA, $ALSA_MODULES, HAVE_ALSA=yes, HAVE_ALSA=no) - if test $HAVE_ALSA = yes; then - SAVE_CFLAGS="$CFLAGS" - SAVE_LIBS="$LIBS" - CFLAGS="$ALSA_CFLAGS $CFLAGS" - LIBS="$ALSA_LIBS $LIBS" - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[snd_lib_error_set_handler (0);]])], - emacs_alsa_normal=yes, - emacs_alsa_normal=no) - if test "$emacs_alsa_normal" != yes; then - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[snd_lib_error_set_handler (0);]])], - emacs_alsa_subdir=yes, - emacs_alsa_subdir=no) - if test "$emacs_alsa_subdir" != yes; then - AC_MSG_ERROR([pkg-config found alsa, but it does not compile. See config.log for error messages.]) + if test "${with_sound}" = "alsa" || test "${with_sound}" = "yes"; then + ALSA_REQUIRED=1.0.0 + ALSA_MODULES="alsa >= $ALSA_REQUIRED" + PKG_CHECK_MODULES(ALSA, $ALSA_MODULES, HAVE_ALSA=yes, HAVE_ALSA=no) + if test $HAVE_ALSA = yes; then + SAVE_CFLAGS="$CFLAGS" + SAVE_LIBS="$LIBS" + CFLAGS="$ALSA_CFLAGS $CFLAGS" + LIBS="$ALSA_LIBS $LIBS" + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[snd_lib_error_set_handler (0);]])], + emacs_alsa_normal=yes, + emacs_alsa_normal=no) + if test "$emacs_alsa_normal" != yes; then + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[snd_lib_error_set_handler (0);]])], + emacs_alsa_subdir=yes, + emacs_alsa_subdir=no) + if test "$emacs_alsa_subdir" != yes; then + AC_MSG_ERROR([pkg-config found alsa, but it does not compile. See config.log for error messages.]) + fi + ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE" fi - ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE" - fi - CFLAGS="$SAVE_CFLAGS" - LIBS="$SAVE_LIBS" - LIBSOUND="$LIBSOUND $ALSA_LIBS" - CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS" - AC_DEFINE(HAVE_ALSA, 1, [Define to 1 if ALSA is available.]) - fi + CFLAGS="$SAVE_CFLAGS" + LIBS="$SAVE_LIBS" + LIBSOUND="$LIBSOUND $ALSA_LIBS" + CFLAGS_SOUND="$CFLAGS_SOUND $ALSA_CFLAGS" + AC_DEFINE(HAVE_ALSA, 1, [Define to 1 if ALSA is available.]) + elif test "${with_sound}" = "alsa"; then + AC_MSG_ERROR([ALSA sound support requested but not found.]) + fi + fi dnl with_sound = alsa|yes dnl Define HAVE_SOUND if we have sound support. We know it works and dnl compiles only on the specified platforms. For others, it dnl probably doesn't make sense to try. + dnl FIXME So surely we should bypass this whole section if not using + dnl one of these platforms? if test x$have_sound_header = xyes || test $HAVE_ALSA = yes; then case "$opsys" in dnl defined __FreeBSD__ || defined __NetBSD__ || defined __linux__ - gnu-linux|freebsd|netbsd) + dnl Adjust the --with-sound help text if you change this. + gnu-linux|freebsd|netbsd|mingw32) AC_DEFINE(HAVE_SOUND, 1, [Define to 1 if you have sound support.]) + HAVE_SOUND=yes ;; esac fi @@ -1196,7 +1466,7 @@ fi dnl checks for header files AC_CHECK_HEADERS_ONCE( - linux/version.h sys/systeminfo.h + sys/systeminfo.h coff.h pty.h sys/resource.h sys/utsname.h pwd.h utmp.h util.h) @@ -1222,22 +1492,9 @@ if test $ac_cv_have_decl_sys_siglist != yes; then # For Tru64, at least: AC_CHECK_DECLS([__sys_siglist], [], [], [[#include ]]) - if test $ac_cv_have_decl___sys_siglist = yes; then - AC_DEFINE(sys_siglist, __sys_siglist, - [Define to any substitute for sys_siglist.]) - fi fi AC_HEADER_SYS_WAIT -dnl Check for speed_t typedef. -AC_CACHE_CHECK(for speed_t, emacs_cv_speed_t, - [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[speed_t x = 1;]])], - emacs_cv_speed_t=yes, emacs_cv_speed_t=no)]) -if test $emacs_cv_speed_t = yes; then - AC_DEFINE(HAVE_SPEED_T, 1, - [Define to 1 if `speed_t' is declared by .]) -fi - AC_CHECK_HEADERS_ONCE(sys/socket.h) AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT #if HAVE_SYS_SOCKET_H @@ -1441,7 +1698,10 @@ fail; [AC_MSG_ERROR([`--with-ns' was specified, but the include files are missing or cannot be compiled.])]) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ], + macfont_file="" + if test "${NS_IMPL_COCOA}" = "yes"; then + AC_MSG_CHECKING([for OSX 10.4 or newer]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ], [ #ifdef MAC_OS_X_VERSION_MAX_ALLOWED #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1040 @@ -1453,13 +1713,33 @@ fail; ])], ns_osx_have_104=yes, ns_osx_have_104=no) + AC_MSG_RESULT([$ns_osx_have_104]) + + if test $ns_osx_have_104 = no; then + AC_MSG_ERROR([`OSX 10.4 or newer is required']); + fi + AC_MSG_CHECKING([for OSX 10.5 or newer]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ], + [ +#ifdef MAC_OS_X_VERSION_MAX_ALLOWED +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 + ; /* OK */ +#else +#error "OSX 10.5 not found" +#endif +#endif + ])], + ns_osx_have_105=yes, + ns_osx_have_105=no) + AC_MSG_RESULT([$ns_osx_have_105]) + if test $ns_osx_have_105 = yes; then + macfont_file="macfont.o" + fi + fi AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include ], [NSInteger i;])], ns_have_nsinteger=yes, ns_have_nsinteger=no) - if test $ns_osx_have_104 = no; then - AC_MSG_ERROR([`OSX 10.4 or newer is required']); - fi if test $ns_have_nsinteger = yes; then AC_DEFINE(NS_HAVE_NSINTEGER, 1, [Define to 1 if `NSInteger' is defined.]) fi @@ -1485,17 +1765,17 @@ if test "${HAVE_NS}" = yes; then dnl This one isn't really used, only archlibdir is. libexecdir="\${ns_appbindir}/libexec" archlibdir="\${ns_appbindir}/libexec" - docdir="\${ns_appresdir}/etc" + etcdocdir="\${ns_appresdir}/etc" etcdir="\${ns_appresdir}/etc" dnl FIXME maybe set datarootdir instead. dnl That would also get applications, icons, man. infodir="\${ns_appresdir}/info" mandir="\${ns_appresdir}/man" lispdir="\${ns_appresdir}/lisp" - leimdir="\${ns_appresdir}/leim" INSTALL_ARCH_INDEP_EXTRA= fi - NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o" + + NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o $macfont_file" fi CFLAGS="$tmp_CFLAGS" CPPFLAGS="$tmp_CPPFLAGS" @@ -1507,31 +1787,100 @@ AC_SUBST(NS_OBJC_OBJ) HAVE_W32=no W32_OBJ= W32_LIBS= -W32_RES= +EMACSRES= +CLIENTRES= +CLIENTW= W32_RES_LINK= +EMACS_MANIFEST= +UPDATE_MANIFEST= if test "${with_w32}" != no; then - if test "${opsys}" != "cygwin"; then - AC_MSG_ERROR([Using w32 with an autotools build is only supported for Cygwin.]) + case "${opsys}" in + cygwin) + AC_CHECK_HEADER([windows.h], [HAVE_W32=yes], + [AC_MSG_ERROR([`--with-w32' was specified, but windows.h + cannot be found.])]) + ;; + mingw32) + ## Using --with-w32 with MinGW is a no-op, but we allow it. + ;; + *) + AC_MSG_ERROR([Using w32 with an autotools build is only supported for Cygwin and MinGW32.]) + ;; + esac +fi + +if test "${opsys}" = "mingw32"; then + AC_MSG_CHECKING([whether Windows API headers are recent enough]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + #include + #include ]], + [[PIMAGE_NT_HEADERS pHeader; + PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader)]])], + [emacs_cv_w32api=yes + HAVE_W32=yes], + emacs_cv_w32api=no) + AC_MSG_RESULT($emacs_cv_w32api) + if test "${emacs_cv_w32api}" = "no"; then + AC_MSG_ERROR([the Windows API headers are too old to support this build.]) fi - AC_CHECK_HEADER([windows.h], [HAVE_W32=yes], - [AC_MSG_ERROR([`--with-w32' was specified, but windows.h - cannot be found.])]) +fi + +FIRSTFILE_OBJ= +NTDIR= +LIBS_ECLIENT= +LIB_WSOCK32= +NTLIB= +CM_OBJ="cm.o" +XARGS_LIMIT= +if test "${HAVE_W32}" = "yes"; then AC_DEFINE(HAVE_NTGUI, 1, [Define to use native MS Windows GUI.]) AC_CHECK_TOOL(WINDRES, [windres], [AC_MSG_ERROR([No resource compiler found.])]) W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o" W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o" - W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" - W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool" - W32_RES="emacs.res" - # Tell the linker that emacs.res is an object (which we compile from - # the rc file), not a linker script. - W32_RES_LINK="-Wl,-bpe-i386 -Wl,emacs.res" + EMACSRES="emacs.res" + case "$canonical" in + x86_64-*-*) EMACS_MANIFEST="emacs-x64.manifest" ;; + *) EMACS_MANIFEST="emacs-x86.manifest" ;; + esac + UPDATE_MANIFEST=update-game-score.exe.manifest + if test "${opsys}" = "cygwin"; then + W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" + W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool" + # Tell the linker that emacs.res is an object (which we compile from + # the rc file), not a linker script. + W32_RES_LINK="-Wl,emacs.res" + else + W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o" + W32_LIBS="$W32_LIBS -lwinmm -lgdi32 -lcomdlg32" + W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32 -lusp10" + W32_RES_LINK="\$(EMACSRES)" + CLIENTRES="emacsclient.res" + CLIENTW="emacsclientw\$(EXEEXT)" + FIRSTFILE_OBJ=firstfile.o + NTDIR=nt + CM_OBJ= + LIBS_ECLIENT="-lcomctl32" + LIB_WSOCK32="-lwsock32" + NTLIB="ntlib.$ac_objext" + XARGS_LIMIT="-s 10000" + fi fi AC_SUBST(W32_OBJ) AC_SUBST(W32_LIBS) -AC_SUBST(W32_RES) +AC_SUBST(EMACSRES) +AC_SUBST(EMACS_MANIFEST) +AC_SUBST(UPDATE_MANIFEST) +AC_SUBST(CLIENTRES) +AC_SUBST(CLIENTW) AC_SUBST(W32_RES_LINK) +AC_SUBST(FIRSTFILE_OBJ) +AC_SUBST(NTDIR) +AC_SUBST(CM_OBJ) +AC_SUBST(LIBS_ECLIENT) +AC_SUBST(LIB_WSOCK32) +AC_SUBST(NTLIB) +AC_SUBST(XARGS_LIMIT) if test "${HAVE_W32}" = "yes"; then window_system=w32 @@ -1541,6 +1890,18 @@ fi ## $window_system is now set to the window system we will ## ultimately use. +if test "$window_system" = none && test "$gl_gcc_warnings" = yes; then + # Too many warnings for now. + nw= + nw="$nw -Wsuggest-attribute=const" + nw="$nw -Wsuggest-attribute=noreturn" + gl_MANYWARN_COMPLEMENT([WARN_CFLAGS], [$WARN_CFLAGS], [$nw]) + + gl_WARN_ADD([-Wno-unused-variable]) + gl_WARN_ADD([-Wno-unused-but-set-variable]) + gl_WARN_ADD([-Wno-unused-but-set-parameter]) +fi + term_header= HAVE_X_WINDOWS=no HAVE_X11=no @@ -1579,11 +1940,6 @@ dnl use the toolkit if we have gtk, or X11R5 or newer. ;; esac -if test -n "${term_header}"; then - AC_DEFINE_UNQUOTED(TERM_HEADER, "${term_header}", - [Define to the header for the built-in window system.]) -fi - if test "$window_system" = none && test "X$with_x" != "Xno"; then AC_CHECK_PROG(HAVE_XSERVER, X, true, false) if test "$HAVE_XSERVER" = true || @@ -1591,7 +1947,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then AC_MSG_ERROR([You seem to be running X, but no X development libraries were found. You should install the relevant development files for X -and for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make +and for the toolkit you want, such as Gtk+ or Motif. Also make sure you have development files for image handling, i.e. tiff, gif, jpeg, png and xpm. If you are sure you want Emacs compiled without X window support, pass @@ -1600,12 +1956,6 @@ to configure.]) fi fi -### If we're using X11, we should use the X menu package. -HAVE_MENUS=no -case ${HAVE_X11} in - yes ) HAVE_MENUS=yes ;; -esac - # Does the opsystem file prohibit the use of the GNU malloc? # Assume not, until told otherwise. GNU_MALLOC=yes @@ -1613,31 +1963,34 @@ GNU_MALLOC=yes AC_CACHE_CHECK( [whether malloc is Doug Lea style], [emacs_cv_var_doug_lea_malloc], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include - static void hook (void) {}]], - [[malloc_set_state (malloc_get_state ()); - __after_morecore_hook = hook; - __malloc_initialize_hook = hook;]])], - [emacs_cv_var_doug_lea_malloc=yes], - [emacs_cv_var_doug_lea_malloc=no])]) + [emacs_cv_var_doug_lea_malloc=no + dnl Hooks do not work with address sanitization. + if test "$emacs_cv_sanitize_address" != yes; then + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + static void hook (void) {}]], + [[malloc_set_state (malloc_get_state ()); + __after_morecore_hook = hook; + __malloc_initialize_hook = hook;]])], + [emacs_cv_var_doug_lea_malloc=yes])]) + fi doug_lea_malloc=$emacs_cv_var_doug_lea_malloc - -dnl See comments in aix4-2.h about maybe using system malloc there. -system_malloc=no +system_malloc=$emacs_cv_sanitize_address case "$opsys" in ## darwin ld insists on the use of malloc routines in the System framework. darwin|sol2-10) system_malloc=yes ;; esac +GMALLOC_OBJ= if test "${system_malloc}" = "yes"; then - AC_DEFINE(SYSTEM_MALLOC, 1, [Define to use system malloc.]) + AC_DEFINE([SYSTEM_MALLOC], 1, + [Define to 1 to use the system memory allocator, even if it is not + Doug Lea style.]) GNU_MALLOC=no GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" - GMALLOC_OBJ= VMLIMIT_OBJ= else test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o @@ -1666,7 +2019,8 @@ if test "$doug_lea_malloc" = "yes" ; then (Using Doug Lea's new malloc from the GNU C Library.)" fi AC_DEFINE(DOUG_LEA_MALLOC, 1, - [Define to 1 if you are using the GNU C Library.]) + [Define to 1 if the system memory allocator is Doug Lea style, + with malloc hooks and malloc_set_state.]) ## Use mmap directly for allocating larger buffers. ## FIXME this comes from src/s/{gnu,gnu-linux}.h: @@ -1694,8 +2048,7 @@ fi LIBS="$LIBS_SYSTEM $LIBS" -dnl If found, this defines HAVE_LIBDNET, which m/pmax.h checks, -dnl and also adds -ldnet to LIBS, which Autoconf uses for checks. +dnl If found, this adds -ldnet to LIBS, which Autoconf uses for checks. AC_CHECK_LIB(dnet, dnet_ntoa) dnl This causes -lresolv to get used in subsequent tests, dnl which causes failures on some systems such as HPUX 9. @@ -1825,7 +2178,7 @@ if test "${HAVE_X11}" = "yes"; then emacs_xkb=yes, emacs_xkb=no) AC_MSG_RESULT($emacs_xkb) if test $emacs_xkb = yes; then - AC_DEFINE(HAVE_XKBGETKEYBOARD, 1, [Define to 1 if you have the XkbGetKeyboard function.]) + AC_DEFINE(HAVE_XKB, 1, [Define to 1 if you have the Xkb extension.]) fi AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \ @@ -1861,7 +2214,7 @@ fi ### Use -lrsvg-2 if available, unless `--with-rsvg=no' is specified. HAVE_RSVG=no -if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${opsys}" = "mingw32"; then if test "${with_rsvg}" != "no"; then RSVG_REQUIRED=2.11.0 RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED" @@ -1873,18 +2226,23 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then if test $HAVE_RSVG = yes; then AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.]) CFLAGS="$CFLAGS $RSVG_CFLAGS" + # Windows loads librsvg dynamically + if test "${opsys}" = "mingw32"; then + RSVG_LIBS= + fi LIBS="$RSVG_LIBS $LIBS" fi fi fi HAVE_IMAGEMAGICK=no -if test "${HAVE_X11}" = "yes"; then +if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes"; then if test "${with_imagemagick}" != "no"; then ## 6.2.8 is the earliest version known to work, but earlier versions ## might work - let us know if you find one. ## 6.0.7 does not work. See bug#7955. - IMAGEMAGICK_MODULE="Wand >= 6.2.8" + ## 6.8.2 makes Emacs crash; see Bug#13867. + IMAGEMAGICK_MODULE="Wand >= 6.2.8 Wand != 6.8.2" PKG_CHECK_MODULES(IMAGEMAGICK, $IMAGEMAGICK_MODULE, HAVE_IMAGEMAGICK=yes, :) AC_SUBST(IMAGEMAGICK_CFLAGS) AC_SUBST(IMAGEMAGICK_LIBS) @@ -1901,58 +2259,84 @@ fi HAVE_GTK=no GTK_OBJ= +gtk_term_header=$term_header check_gtk2=no gtk3_pkg_errors= -if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then - GLIB_REQUIRED=2.28 - GTK_REQUIRED=3.0 - GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" +if test "${opsys}" != "mingw32"; then + if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then + GLIB_REQUIRED=2.28 + GTK_REQUIRED=3.0 + GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" - dnl Checks for libraries. - PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no) - if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then - AC_MSG_ERROR($GTK_PKG_ERRORS) + dnl Checks for libraries. + PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no) + if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then + AC_MSG_ERROR($GTK_PKG_ERRORS) + fi + if test "$pkg_check_gtk" = "yes"; then + AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.]) + GTK_OBJ=emacsgtkfixed.o + gtk_term_header=gtkutil.h + USE_GTK_TOOLKIT="GTK3" + if test "x$ac_enable_gtk_deprecation_warnings" = x; then + AC_DEFINE([GDK_DISABLE_DEPRECATION_WARNINGS], [1], + [Define to 1 to disable GTK+/GDK deprecation warnings.]) + AC_DEFINE([GLIB_DISABLE_DEPRECATION_WARNINGS], [1], + [Define to 1 to disable Glib deprecation warnings.]) + fi + else + check_gtk2=yes + gtk3_pkg_errors="$GTK_PKG_ERRORS " + fi fi - if test "$pkg_check_gtk" = "yes"; then - AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.]) - GTK_OBJ=emacsgtkfixed.o - term_header=gtkutil.h - USE_GTK_TOOLKIT="GTK3" - if test "x$ac_enable_gtk_deprecation_warnings" = x; then - GTK_CFLAGS="$GTK_CFLAGS -DGDK_DISABLE_DEPRECATION_WARNINGS" - fi - else - check_gtk2=yes - gtk3_pkg_errors="$GTK_PKG_ERRORS " - fi -fi -if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then - GLIB_REQUIRED=2.10 - GTK_REQUIRED=2.10 - GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" + if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then + GLIB_REQUIRED=2.10 + GTK_REQUIRED=2.10 + GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" - dnl Checks for libraries. - PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no) - if test "$pkg_check_gtk" = "no" && - { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; } - then - AC_MSG_ERROR($gtk3_pkg_errors$GTK_PKG_ERRORS) + dnl Checks for libraries. + PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no) + if test "$pkg_check_gtk" = "no" && + { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; } + then + AC_MSG_ERROR($gtk3_pkg_errors$GTK_PKG_ERRORS) + fi + test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2" fi - test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2" fi if test x"$pkg_check_gtk" = xyes; then - AC_SUBST(GTK_CFLAGS) AC_SUBST(GTK_LIBS) C_SWITCH_X_SITE="$C_SWITCH_X_SITE $GTK_CFLAGS" CFLAGS="$CFLAGS $GTK_CFLAGS" LIBS="$GTK_LIBS $LIBS" dnl Try to compile a simple GTK program. + AC_MSG_CHECKING([whether GTK compiles]) GTK_COMPILES=no - AC_CHECK_FUNCS(gtk_main, GTK_COMPILES=yes) + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[/* Check the Gtk and Glib APIs. */ + #include + #include + static void + callback (GObject *go, GParamSpec *spec, gpointer user_data) + {} + ]], + [[ + GtkSettings *gs = 0; + /* Use G_CALLBACK to make sure function pointers can be cast to void *; + strict C prohibits this. Use gtk_main_iteration to test that the + libraries are there. */ + if (g_signal_handler_find (G_OBJECT (gs), G_SIGNAL_MATCH_FUNC, + 0, 0, 0, G_CALLBACK (callback), 0)) + gtk_main_iteration (); + ]])], + [GTK_COMPILES=yes]) + AC_MSG_RESULT([$GTK_COMPILES]) if test "${GTK_COMPILES}" != "yes"; then + GTK_OBJ= if test "$USE_X_TOOLKIT" != "maybe"; then AC_MSG_ERROR([Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?]); fi @@ -1960,6 +2344,7 @@ if test x"$pkg_check_gtk" = xyes; then HAVE_GTK=yes AC_DEFINE(USE_GTK, 1, [Define to 1 if using GTK.]) GTK_OBJ="gtkutil.o $GTK_OBJ" + term_header=$gtk_term_header USE_X_TOOLKIT=none if "$PKG_CONFIG" --atleast-version=2.10 gtk+-2.0; then : @@ -2081,7 +2466,6 @@ if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then SAVE_LIBS="$LIBS" CFLAGS="$SETTINGS_CFLAGS $CFLAGS" LIBS="$SETTINGS_LIBS $LIBS" - AC_CHECK_FUNCS([g_type_init]) CFLAGS="$SAVE_CFLAGS" LIBS="$SAVE_LIBS" fi @@ -2102,52 +2486,91 @@ fi AC_SUBST(LIBSELINUX_LIBS) HAVE_GNUTLS=no -HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no +HAVE_GNUTLS3=no if test "${with_gnutls}" = "yes" ; then - PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.6.6], HAVE_GNUTLS=yes, HAVE_GNUTLS=no) + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 3.0.0], HAVE_GNUTLS3=yes, HAVE_GNUTLS3=no) + if test "${HAVE_GNUTLS3}" = "yes"; then + AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.]) + HAVE_GNUTLS="yes" + else + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.6.6], HAVE_GNUTLS=yes, HAVE_GNUTLS=no) + fi if test "${HAVE_GNUTLS}" = "yes"; then AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) fi - CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS" - LIBS="$LIBGNUTLS_LIBS $LIBS" - AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes) - - if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then - AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.]) + # Windows loads GnuTLS dynamically + if test "${opsys}" = "mingw32"; then + LIBGNUTLS_LIBS= + else + CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS" + LIBS="$LIBGNUTLS_LIBS $LIBS" fi fi AC_SUBST(LIBGNUTLS_LIBS) AC_SUBST(LIBGNUTLS_CFLAGS) -dnl inotify is only available on GNU/Linux. -if test "${with_inotify}" = "yes"; then - AC_CHECK_HEADERS(sys/inotify.h) - if test "$ac_cv_header_sys_inotify_h" = yes ; then - AC_CHECK_FUNC(inotify_init1) - fi -fi -if test "$ac_cv_func_inotify_init1" = yes; then - AC_DEFINE(HAVE_INOTIFY, 1, [Define to 1 to use inotify.]) +NOTIFY_OBJ= +NOTIFY_SUMMARY=no + +dnl FIXME? Don't auto-detect on NS, but do allow someone to specify +dnl a particular library. This doesn't make much sense? +if test "${with_ns}" = yes && test ${with_file_notification} = yes; then + with_file_notification=no fi -dnl POSIX ACL support: provided by libacl on GNU/Linux, by libc on FreeBSD. -HAVE_POSIX_ACL=no -LIBACL_LIBS= -if test "${with_acl}" = "yes"; then - AC_CHECK_LIB([acl], [acl_set_file], HAVE_POSIX_ACL=yes, HAVE_POSIX_ACL=no) - if test "$HAVE_POSIX_ACL" = yes; then - AC_DEFINE(HAVE_POSIX_ACL, 1, [Define to 1 if using POSIX ACL support.]) - LIBACL_LIBS=-lacl - else - AC_CHECK_FUNC(acl_set_file, HAVE_POSIX_ACL=yes, HAVE_POSIX_ACL=no) - if test "$HAVE_POSIX_ACL" = yes; then - AC_DEFINE(HAVE_POSIX_ACL, 1, [Define to 1 if using POSIX ACL support.]) - fi - fi +dnl MS Windows native file monitor is available for mingw32 only. +case $with_file_notification,$opsys in + w32,* | yes,mingw32) + AC_CHECK_HEADER(windows.h) + if test "$ac_cv_header_windows_h" = yes ; then + AC_DEFINE(HAVE_W32NOTIFY, 1, [Define to 1 to use w32notify.]) + NOTIFY_OBJ=w32notify.o + NOTIFY_SUMMARY="yes (w32)" + fi ;; +esac + +dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED +dnl has been added in glib 2.24. It has been tested under +dnl GNU/Linux only. We take precedence over inotify, but this makes +dnl only sense when glib has been compiled with inotify support. How +dnl to check? +case $with_file_notification,$NOTIFY_OBJ in + gfile, | yes,) + PKG_CHECK_MODULES(GFILENOTIFY, gio-2.0 >= 2.24, HAVE_GFILENOTIFY=yes, HAVE_GFILENOTIFY=no) + if test "$HAVE_GFILENOTIFY" = "yes"; then + AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) + NOTIFY_OBJ=gfilenotify.o + NOTIFY_SUMMARY="yes -lgio (gfile)" + fi ;; +esac + +dnl inotify is only available on GNU/Linux. +case $with_file_notification,$NOTIFY_OBJ in + inotify, | yes,) + AC_CHECK_HEADER(sys/inotify.h) + if test "$ac_cv_header_sys_inotify_h" = yes ; then + AC_CHECK_FUNC(inotify_init1) + if test "$ac_cv_func_inotify_init1" = yes; then + AC_DEFINE(HAVE_INOTIFY, 1, [Define to 1 to use inotify.]) + NOTIFY_OBJ=inotify.o + NOTIFY_SUMMARY="yes -lglibc (inotify)" + fi + fi ;; +esac + +case $with_file_notification,$NOTIFY_OBJ in + yes,* | no,* | *,?*) ;; + *) AC_MSG_ERROR([File notification `$with_file_notification' requested but requirements not found.]) ;; +esac + +if test -n "$NOTIFY_OBJ"; then + AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.]) fi -AC_SUBST(LIBACL_LIBS) +AC_SUBST(NOTIFY_OBJ) +AC_SUBST(GFILENOTIFY_CFLAGS) +AC_SUBST(GFILENOTIFY_LIBS) dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. @@ -2248,6 +2671,9 @@ case $opsys in hpux* | aix4-2 ) test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU= ;; + mingw32 ) + LIBXMU= + ;; esac AC_SUBST(LIBXMU) @@ -2425,7 +2851,8 @@ if test "${HAVE_X11}" = "yes"; then XFT_LIBS="-lXrender $XFT_LIBS" LIBS="$XFT_LIBS $LIBS" AC_CHECK_HEADER(X11/Xft/Xft.h, - AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS)) + AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS) , , + [[#include ]]) if test "${HAVE_XFT}" = "yes"; then AC_DEFINE(HAVE_XFT, 1, [Define to 1 if you have the Xft library.]) @@ -2506,10 +2933,10 @@ AC_SUBST(M17N_FLT_CFLAGS) AC_SUBST(M17N_FLT_LIBS) ### Use -lXpm if available, unless `--with-xpm=no'. +### mingw32 doesn't use -lXpm, since it loads the library dynamically. HAVE_XPM=no LIBXPM= - -if test "${HAVE_W32}" = "yes"; then +if test "${HAVE_W32}" = "yes" && test "${opsys}" = "cygwin"; then if test "${with_xpm}" != "no"; then SAVE_CPPFLAGS="$CPPFLAGS" SAVE_LDFLAGS="$LDFLAGS" @@ -2570,19 +2997,33 @@ no_return_alloc_pixels fi fi +### FIXME: Perhaps regroup to minimize code duplication due to MinGW's +### slightly different requirements wrt image libraries (it doesn't +### use -lXpm because it loads the xpm shared library dynamically at +### run time). +if test "${opsys}" = "mingw32"; then + if test "${with_xpm}" != "no"; then + AC_CHECK_HEADER(X11/xpm.h, HAVE_XPM=yes, HAVE_XPM=no, [ +#define FOR_MSW 1]) + fi + + if test "${HAVE_XPM}" = "yes"; then + AC_DEFINE(HAVE_XPM, 1, [Define to 1 if you have the Xpm library (-lXpm).]) + fi +fi + AC_SUBST(LIBXPM) ### Use -ljpeg if available, unless `--with-jpeg=no'. +### mingw32 doesn't use -ljpeg, since it loads the library dynamically. HAVE_JPEG=no LIBJPEG= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then +if test "${opsys}" = "mingw32"; then if test "${with_jpeg}" != "no"; then dnl Checking for jpeglib.h can lose because of a redefinition of - dnl HAVE_STDLIB_H. - AC_CHECK_HEADER(jerror.h, - [AC_CHECK_LIB(jpeg, jpeg_destroy_compress, HAVE_JPEG=yes)]) + dnl HAVE_STDLIB_H. + AC_CHECK_HEADER(jerror.h, HAVE_JPEG=yes, HAVE_JPEG=no) fi - AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library (-ljpeg).])dnl if test "${HAVE_JPEG}" = "yes"; then AC_DEFINE(HAVE_JPEG) @@ -2594,6 +3035,25 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then [AC_MSG_WARN([libjpeg found, but not version 6b or later]) HAVE_JPEG=no]) fi +elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then + if test "${with_jpeg}" != "no"; then + dnl Checking for jpeglib.h can lose because of a redefinition of + dnl HAVE_STDLIB_H. + AC_CHECK_HEADER(jerror.h, + [AC_CHECK_LIB(jpeg, jpeg_destroy_compress, HAVE_JPEG=yes)]) + fi + + AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library (-ljpeg).])dnl + if test "${HAVE_JPEG}" = "yes"; then + AC_DEFINE(HAVE_JPEG) + AC_EGREP_CPP([version= *(6[2-9]|[7-9][0-9])], + [#include + version=JPEG_LIB_VERSION +], + [AC_DEFINE(HAVE_JPEG)], + [AC_MSG_WARN([libjpeg found, but not version 6b or later]) + HAVE_JPEG=no]) + fi if test "${HAVE_JPEG}" = "yes"; then LIBJPEG=-ljpeg fi @@ -2601,9 +3061,30 @@ fi AC_SUBST(LIBJPEG) ### Use -lpng if available, unless `--with-png=no'. +### mingw32 doesn't use -lpng, since it loads the library dynamically. HAVE_PNG=no LIBPNG= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then +if test "${opsys}" = "mingw32"; then + if test "${with_png}" != "no"; then + AC_CHECK_HEADER(png.h, HAVE_PNG=yes, HAVE_PNG=no) + fi + if test "${HAVE_PNG}" = "yes"; then + AC_DEFINE(HAVE_PNG, 1, [Define to 1 if you have the png library (-lpng).]) + + AC_CHECK_DECL(png_longjmp, + [], + [AC_DEFINE(PNG_DEPSTRUCT, [], + [Define to empty to suppress deprecation warnings when building + with --enable-gcc-warnings and with libpng versions before 1.5, + which lack png_longjmp.])], + [[#ifdef HAVE_LIBPNG_PNG_H + # include + #else + # include + #endif + ]]) + fi +elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then if test "${with_png}" != "no"; then # Debian unstable as of July 2003 has multiple libpngs, and puts png.h # in /usr/include/libpng. @@ -2633,10 +3114,38 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then fi AC_SUBST(LIBPNG) +HAVE_ZLIB=no +LIBZ= +if test "${with_zlib}" != "no"; then + OLIBS=$LIBS + AC_SEARCH_LIBS([inflateEnd], [z], [HAVE_ZLIB=yes]) + LIBS=$OLIBS + case $ac_cv_search_inflateEnd in + -*) LIBZ=$ac_cv_search_inflateEnd ;; + esac +fi +if test "${HAVE_ZLIB}" = "yes"; then + AC_DEFINE([HAVE_ZLIB], 1, [Define to 1 if you have the zlib library (-lz).]) + ### mingw32 doesn't use -lz, since it loads the library dynamically. + if test "${opsys}" = "mingw32"; then + LIBZ= + fi +fi +AC_SUBST(LIBZ) + + ### Use -ltiff if available, unless `--with-tiff=no'. +### mingw32 doesn't use -ltiff, since it loads the library dynamically. HAVE_TIFF=no LIBTIFF= -if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then +if test "${opsys}" = "mingw32"; then + if test "${with_tiff}" != "no"; then + AC_CHECK_HEADER(tiffio.h, HAVE_TIFF=yes, HAVE_TIFF=no) + fi + if test "${HAVE_TIFF}" = "yes"; then + AC_DEFINE(HAVE_TIFF, 1, [Define to 1 if you have the tiff library (-ltiff).]) + fi +elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then if test "${with_tiff}" != "no"; then AC_CHECK_HEADER(tiffio.h, [tifflibs="-lz -lm" @@ -2654,14 +3163,23 @@ fi AC_SUBST(LIBTIFF) ### Use -lgif or -lungif if available, unless `--with-gif=no'. +### mingw32 doesn't use -lgif/-lungif, since it loads the library dynamically. HAVE_GIF=no LIBGIF= -if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \ +if test "${opsys}" = "mingw32"; then + if test "${with_gif}" != "no"; then + AC_CHECK_HEADER(gif_lib.h, HAVE_GIF=yes, HAVE_GIF=no) + fi + if test "${HAVE_GIF}" = "yes"; then + AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif (or ungif) library.]) + fi +elif test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \ || test "${HAVE_W32}" = "yes"; then AC_CHECK_HEADER(gif_lib.h, # EGifPutExtensionLast only exists from version libungif-4.1.0b1. -# Earlier versions can crash Emacs. - [AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes, HAVE_GIF=maybe)]) +# Earlier versions can crash Emacs, but version 5.0 removes EGifPutExtensionLast. + [AC_CHECK_LIB(gif, GifMakeMapObject, HAVE_GIF=yes, + [AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes, HAVE_GIF=maybe)])]) if test "$HAVE_GIF" = yes; then LIBGIF=-lgif @@ -2734,15 +3252,9 @@ if test "${HAVE_NS}" = "yes"; then ## Extra CFLAGS applied to src/*.m files. GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE" fi - # We also have mouse menus. - HAVE_MENUS=yes OTHER_FILES=ns-app fi -if test "${HAVE_W32}" = "yes"; then - HAVE_MENUS=yes -fi - ### Use session management (-lSM -lICE) if available HAVE_X_SM=no LIBXSM= @@ -2761,14 +3273,82 @@ if test "${HAVE_X11}" = "yes"; then fi AC_SUBST(LIBXSM) +### Use XRandr (-lXrandr) if available +HAVE_XRANDR=no +if test "${HAVE_X11}" = "yes"; then + XRANDR_REQUIRED=1.2.2 + XRANDR_MODULES="xrandr >= $XRANDR_REQUIRED" + PKG_CHECK_MODULES(XRANDR, $XRANDR_MODULES, HAVE_XRANDR=yes, HAVE_XRANDR=no) + if test $HAVE_XRANDR = no; then + # Test old way in case pkg-config doesn't have it (older machines). + AC_CHECK_HEADER(X11/extensions/Xrandr.h, + [AC_CHECK_LIB(Xrandr, XRRGetScreenResources, HAVE_XRANDR=yes)]) + if test $HAVE_XRANDR = yes; then + XRANDR_LIBS=-lXrandr + AC_SUBST(XRANDR_LIBS) + fi + fi + if test $HAVE_XRANDR = yes; then + SAVE_CFLAGS="$CFLAGS" + SAVE_LIBS="$LIBS" + CFLAGS="$XRANDR_CFLAGS $CFLAGS" + LIBS="$XRANDR_LIBS $LIBS" + AC_CHECK_FUNCS(XRRGetOutputPrimary XRRGetScreenResourcesCurrent) + CFLAGS="$SAVE_CFLAGS" + LIBS="$SAVE_LIBS" + + AC_DEFINE(HAVE_XRANDR, 1, [Define to 1 if you have the XRandr extension.]) + fi +fi + +### Use Xinerama (-lXinerama) if available +HAVE_XINERAMA=no +if test "${HAVE_X11}" = "yes"; then + XINERAMA_REQUIRED=1.0.2 + XINERAMA_MODULES="xinerama >= $XINERAMA_REQUIRED" + PKG_CHECK_MODULES(XINERAMA, $XINERAMA_MODULES, HAVE_XINERAMA=yes, + HAVE_XINERAMA=no) + if test $HAVE_XINERAMA = no; then + # Test old way in case pkg-config doesn't have it (older machines). + AC_CHECK_HEADER(X11/extensions/Xinerama.h, + [AC_CHECK_LIB(Xinerama, XineramaQueryExtension, HAVE_XINERAMA=yes)]) + if test $HAVE_XINERAMA = yes; then + XINERAMA_LIBS=-lXinerama + AC_SUBST(XINERAMA_LIBS) + fi + fi + if test $HAVE_XINERAMA = yes; then + AC_DEFINE(HAVE_XINERAMA, 1, [Define to 1 if you have the Xinerama extension.]) + fi +fi + + ### Use libxml (-lxml2) if available +### mingw32 doesn't use -lxml2, since it loads the library dynamically. HAVE_LIBXML2=no if test "${with_xml2}" != "no"; then ### I'm not sure what the version number should be, so I just guessed. PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.6.17, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + # Built-in libxml2 on OS X 10.8 lacks libxml-2.0.pc. + if test "${HAVE_LIBXML2}" != "yes" -a "$opsys" = "darwin"; then + SAVE_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS -I$xcsdkdir/usr/include/libxml2" + AC_CHECK_HEADER(libxml/HTMLparser.h, + [AC_CHECK_DECL(HTML_PARSE_RECOVER, HAVE_LIBXML2=yes, , + [#include ])]) + CPPFLAGS="$SAVE_CPPFLAGS" + if test "${HAVE_LIBXML2}" = "yes"; then + LIBXML2_CFLAGS="-I'$xcsdkdir/usr/include/libxml2'" + LIBXML2_LIBS="-lxml2" + fi + fi if test "${HAVE_LIBXML2}" = "yes"; then - LIBS="$LIBXML2_LIBS $LIBS" - AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + if test "${opsys}" != "mingw32"; then + LIBS="$LIBXML2_LIBS $LIBS" + AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + else + LIBXML2_LIBS="" + fi if test "${HAVE_LIBXML2}" = "yes"; then AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).]) else @@ -2781,6 +3361,10 @@ AC_SUBST(LIBXML2_LIBS) AC_SUBST(LIBXML2_CFLAGS) # If netdb.h doesn't declare h_errno, we must declare it by hand. +# On MinGW, that is provided by nt/inc/sys/socket.h and w32.c. +if test "${opsys}" = "mingw32"; then + emacs_cv_netdb_declares_h_errno=yes +fi AC_CACHE_CHECK(whether netdb declares h_errno, emacs_cv_netdb_declares_h_errno, [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], @@ -2791,8 +3375,10 @@ if test $emacs_cv_netdb_declares_h_errno = yes; then fi # sqrt and other floating-point functions such as fmod and frexp -# are found in -lm on most systems. -AC_CHECK_LIB(m, sqrt) +# are found in -lm on most systems, but mingw32 doesn't use -lm. +if test "${opsys}" != "mingw32"; then + AC_CHECK_LIB(m, sqrt) +fi # Check for mail-locking functions in a "mail" library. Probably this should # have the same check as for liblockfile below. @@ -2834,7 +3420,7 @@ mail_lock=no case "$opsys" in aix4-2) mail_lock="lockf" ;; - gnu|freebsd|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;; + gnu|freebsd|dragonfly|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;; ## On GNU/Linux systems, both methods are used by various mail programs. ## I assume most people are using newer mailers that have heard of flock. @@ -2856,6 +3442,9 @@ case "$opsys" in test $ac_cv_header_maillock_h = yes && mail_lock=no fi ;; + + mingw32) + mail_lock="none-needed" ;; esac BLESSMAIL_TARGET= @@ -2864,23 +3453,31 @@ case "$mail_lock" in lockf) AC_DEFINE(MAIL_USE_LOCKF, 1, [Define if the mailer uses lockf to interlock the mail spool.]) ;; + none-needed) ;; + *) BLESSMAIL_TARGET="need-blessmail" ;; esac AC_SUBST(BLESSMAIL_TARGET) -AC_CHECK_FUNCS(gethostname \ +AC_CHECK_FUNCS(accept4 gethostname \ getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ -utimes getrlimit setrlimit shutdown getaddrinfo \ +getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -gai_strerror mkstemp getline getdelim fsync sync \ -difftime posix_memalign \ +gai_strerror getline getdelim sync \ getpwent endpwent getgrent endgrent \ touchlock \ -cfmakeraw cfsetspeed copysign __executable_start) +cfmakeraw cfsetspeed copysign __executable_start log2) + +dnl No need to check for aligned_alloc and posix_memalign if using +dnl gmalloc.o, as it supplies them. Don't use these functions on +dnl Darwin as they are incompatible with unexmacosx.c. +if test -z "$GMALLOC_OBJ" && test "$opsys" != darwin; then + AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break]) +fi ## Eric Backus says, HP-UX 9.x on HP 700 machines ## has a broken `rint' in some library versions including math library @@ -2935,25 +3532,29 @@ AC_DEFUN([tputs_link_source], [ return 0; }]]) ]) -# Maybe curses should be tried earlier? -# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35 -for tputs_library in '' tinfo ncurses terminfo termcap curses; do - OLIBS=$LIBS - if test -z "$tputs_library"; then - LIBS_TERMCAP= - msg='none required' - else - LIBS_TERMCAP=-l$tputs_library - msg=$LIBS_TERMCAP - LIBS="$LIBS_TERMCAP $LIBS" - fi - AC_RUN_IFELSE([tputs_link_source], [], [msg=no], - [AC_LINK_IFELSE([tputs_link_source], [], [msg=no])]) - LIBS=$OLIBS - if test "X$msg" != Xno; then - break - fi -done +if test "${opsys}" = "mingw32"; then + msg='none required' +else + # Maybe curses should be tried earlier? + # See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35 + for tputs_library in '' tinfo ncurses terminfo termcap curses; do + OLIBS=$LIBS + if test -z "$tputs_library"; then + LIBS_TERMCAP= + msg='none required' + else + LIBS_TERMCAP=-l$tputs_library + msg=$LIBS_TERMCAP + LIBS="$LIBS_TERMCAP $LIBS" + fi + AC_RUN_IFELSE([tputs_link_source], [], [msg=no], + [AC_LINK_IFELSE([tputs_link_source], [], [msg=no])]) + LIBS=$OLIBS + if test "X$msg" != Xno; then + break + fi + done +fi AC_MSG_RESULT([$msg]) if test "X$msg" = Xno; then AC_MSG_ERROR([The required function `tputs' was not found in any library. @@ -2999,6 +3600,11 @@ fail; fi ;; + mingw32) + TERMINFO=no + LIBS_TERMCAP= + ;; + netbsd) if test "x$LIBS_TERMCAP" != "x-lterminfo"; then TERMINFO=no @@ -3006,7 +3612,7 @@ fail; fi ;; - openbsd) LIBS_TERMCAP="-lncurses" ;; + openbsd | dragonfly) LIBS_TERMCAP="-lncurses" ;; ## hpux: Make sure we get select from libc rather than from libcurses ## because libcurses on HPUX 10.10 has a broken version of select. @@ -3022,6 +3628,9 @@ if test $TERMINFO = yes; then AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.]) TERMCAP_OBJ=terminfo.o fi +if test "X$LIBS_TERMCAP" = "X-lncurses"; then + AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.]) +fi AC_SUBST(LIBS_TERMCAP) AC_SUBST(TERMCAP_OBJ) @@ -3076,8 +3685,6 @@ if test "$with_hesiod" != no ; then hesiod=yes, :, $RESOLVLIB)]) if test x"$hesiod" = xyes; then - AC_DEFINE(HAVE_LIBHESIOD, 1, - [Define to 1 if you have the hesiod library (-lhesiod).]) LIBHESIOD=-lhesiod fi fi @@ -3085,8 +3692,6 @@ AC_SUBST(LIBHESIOD) # Do we need libresolv (due to res_init or Hesiod)? if test "$resolv" = yes && test $opsys != darwin; then - AC_DEFINE(HAVE_LIBRESOLV, 1, - [Define to 1 if you have the resolv library (-lresolv).]) LIBRESOLV=-lresolv else LIBRESOLV= @@ -3105,25 +3710,21 @@ if test "${with_kerberos}" != no; then if test $have_com_err = yes; then COM_ERRLIB=-lcom_err LIBS="$COM_ERRLIB $LIBS" - AC_DEFINE(HAVE_LIBCOM_ERR, 1, [Define to 1 if you have the `com_err' library (-lcom_err).]) fi AC_CHECK_LIB(crypto, mit_des_cbc_encrypt, have_crypto=yes, have_crypto=no) if test $have_crypto = yes; then CRYPTOLIB=-lcrypto LIBS="$CRYPTOLIB $LIBS" - AC_DEFINE(HAVE_LIBCRYPTO, 1, [Define to 1 if you have the `crypto' library (-lcrypto).]) fi AC_CHECK_LIB(k5crypto, mit_des_cbc_encrypt, have_k5crypto=yes, have_k5crypto=no) if test $have_k5crypto = yes; then CRYPTOLIB=-lk5crypto LIBS="$CRYPTOLIB $LIBS" - AC_DEFINE(HAVE_LIBK5CRYPTO, 1, [Define to 1 if you have the `k5crypto' library (-lk5crypto).]) fi AC_CHECK_LIB(krb5, krb5_init_context, have_krb5=yes, have_krb5=no) if test $have_krb5=yes; then KRB5LIB=-lkrb5 LIBS="$KRB5LIB $LIBS" - AC_DEFINE(HAVE_LIBKRB5, 1, [Define to 1 if you have the `krb5' library (-lkrb5).]) fi dnl FIXME Simplify. Does not match 22 logic, thanks to default_off? if test "${with_kerberos5}" = no; then @@ -3131,26 +3732,22 @@ if test "${with_kerberos}" != no; then if test $have_des425 = yes; then DESLIB=-ldes425 LIBS="$DESLIB $LIBS" - AC_DEFINE(HAVE_LIBDES425, 1, [Define to 1 if you have the `des425' library (-ldes425).]) else AC_CHECK_LIB(des, des_cbc_encrypt, have_des=yes, have_des=no) if test $have_des = yes; then DESLIB=-ldes LIBS="$DESLIB $LIBS" - AC_DEFINE(HAVE_LIBDES, 1, [Define to 1 if you have the `des' library (-ldes).]) fi fi AC_CHECK_LIB(krb4, krb_get_cred, have_krb4=yes, have_krb4=no) if test $have_krb4 = yes; then KRB4LIB=-lkrb4 LIBS="$KRB4LIB $LIBS" - AC_DEFINE(HAVE_LIBKRB4, 1, [Define to 1 if you have the `krb4' library (-lkrb4).]) else AC_CHECK_LIB(krb, krb_get_cred, have_krb=yes, have_krb=no) if test $have_krb = yes; then KRB4LIB=-lkrb LIBS="$KRB4LIB $LIBS" - AC_DEFINE(HAVE_LIBKRB, 1, [Define to 1 if you have the `krb' library (-lkrb).]) fi fi fi @@ -3160,9 +3757,6 @@ if test "${with_kerberos}" != no; then [AC_CHECK_MEMBERS([krb5_error.text, krb5_error.e_text],,, [#include ])]) else - AC_CHECK_HEADERS(des.h,, - [AC_CHECK_HEADERS(kerberosIV/des.h,, - [AC_CHECK_HEADERS(kerberos/des.h)])]) AC_CHECK_HEADERS(krb.h,, [AC_CHECK_HEADERS(kerberosIV/krb.h,, [AC_CHECK_HEADERS(kerberos/krb.h)])]) @@ -3176,6 +3770,8 @@ AC_SUBST(KRB5LIB) AC_SUBST(DESLIB) AC_SUBST(KRB4LIB) +AC_CHECK_HEADERS(valgrind/valgrind.h) + AC_CHECK_FUNCS_ONCE(tzset) AC_MSG_CHECKING(whether localtime caches TZ) AC_CACHE_VAL(emacs_cv_localtime_cache, @@ -3228,19 +3824,6 @@ dnl Fixme: Not used. Should this be HAVE_SOCKETS? [Define to 1 if you have inet sockets.]) fi -if test -f /usr/lpp/X11/bin/smt.exp; then - AC_DEFINE(HAVE_AIX_SMT_EXP, 1, - [Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists.]) -fi - -AC_MSG_CHECKING(whether system supports dynamic ptys) -if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then - AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_DEV_PTMX, 1, [Define to 1 if dynamic ptys are supported.]) -else - AC_MSG_RESULT(no) -fi - dnl Check for a Solaris 2.4 vfork bug that Autoconf misses (through 2.69). dnl This can be removed once we assume Autoconf 2.70. case $canonical in @@ -3253,6 +3836,25 @@ AC_FUNC_FORK AC_CHECK_FUNCS(snprintf) +dnl Check this late. It depends on what other libraries (lrsvg, Gtk+ etc) +dnl Emacs uses. +XGSELOBJ= +AC_MSG_CHECKING([whether GLib is linked in]) +AC_LINK_IFELSE([AC_LANG_PROGRAM( + [[#include + ]], + [[g_print ("Hello world");]])], + [links_glib=yes], + [links_glib=no]) +AC_MSG_RESULT([$links_glib]) +if test "${links_glib}" = "yes"; then + AC_DEFINE(HAVE_GLIB, 1, [Define to 1 if GLib is linked in.]) + if test "$HAVE_NS" = no;then + XGSELOBJ=xgselect.o + fi +fi +AC_SUBST(XGSELOBJ) + dnl Adapted from Haible's version. AC_CACHE_CHECK([for nl_langinfo and CODESET], emacs_cv_langinfo_codeset, [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], @@ -3288,11 +3890,14 @@ dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetatt dnl fi dnl Turned on June 1996 supposing nobody will mind it. -AC_DEFINE(AMPERSAND_FULL_NAME, 1, [Define to use the convention that & - in the full name stands for the login id.]) +dnl MinGW emulates passwd database, so this feature doesn't make sense there. +if test "${opsys}" != "mingw32"; then + AC_DEFINE(AMPERSAND_FULL_NAME, 1, [Define to use the convention that & + in the full name stands for the login id.]) +fi -dnl Every platform that uses configure (ie every non-MS platform) -dnl supports this. There is a create-lockfiles option you can +dnl Every platform that uses configure supports this. +dnl There is a create-lockfiles option you can dnl customize if you do not want the lock files to be written. dnl So it is not clear that this #define still needs to exist. AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written, @@ -3302,7 +3907,9 @@ AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written, dnl Everybody supports this, except MS. dnl Seems like the kind of thing we should be testing for, though. ## Note: PTYs are broken on darwin <6. Use at your own risk. -AC_DEFINE(HAVE_PTYS, 1, [Define if the system supports pty devices.]) +if test "${opsys}" != "mingw32"; then + AC_DEFINE(HAVE_PTYS, 1, [Define if the system supports pty devices.]) +fi dnl Everybody supports this, except MS-DOS. dnl Seems like the kind of thing we should be testing for, though. @@ -3312,10 +3919,30 @@ AC_DEFINE(HAVE_SOCKETS, 1, [Define if the system supports AH_TEMPLATE(INTERNAL_TERMINAL, [This is substituted when $TERM is "internal".]) -AC_DEFINE(NULL_DEVICE, ["/dev/null"], [Name of the file to open to get +AH_TEMPLATE(NULL_DEVICE, [Name of the file to open to get a null file, or a data sink.]) +if test "${opsys}" = "mingw32"; then + AC_DEFINE(NULL_DEVICE, ["NUL:"]) +else + AC_DEFINE(NULL_DEVICE, ["/dev/null"]) +fi -AC_DEFINE(SEPCHAR, [':'], [Character that separates PATH elements.]) +if test "${opsys}" = "mingw32"; then + SEPCHAR=';' +else + SEPCHAR=':' +fi +AC_DEFINE_UNQUOTED(SEPCHAR, ['$SEPCHAR'], [Character that separates PATH elements.]) +dnl This is for MinGW, and is used in test/automated/Makefile.in. +dnl The MSYS Bash has heuristics for replacing ':' with ';' when it +dnl decides that a command-line argument to be passed to a MinGW program +dnl is a PATH-style list of directories. But that heuristics plays it +dnl safe, and only does the replacement when it is _absolutely_ sure it +dnl sees a colon-separated list of file names; e.g. ":." is left alone, +dnl which breaks in-tree builds. So we do this manually instead. +dnl Note that we cannot rely on PATH_SEPARATOR, as that one will always +dnl be computed as ':' in MSYS Bash. +AC_SUBST(SEPCHAR) dnl Everybody supports this, except MS-DOS. AC_DEFINE(subprocesses, 1, [Define to enable asynchronous subprocesses.]) @@ -3326,19 +3953,25 @@ AC_DEFINE(USER_FULL_NAME, [pw->pw_gecos], [How to get a user's full name.]) AC_DEFINE(DIRECTORY_SEP, ['/'], [Character that separates directories in a file name.]) -dnl Only used on MS platforms. -AH_TEMPLATE(DEVICE_SEP, [Character that separates a device in a file name.]) +if test "${opsys}" = "mingw32"; then + AC_DEFINE(IS_DEVICE_SEP(_c_), [((_c_) == ':')], + [Returns true if character is a device separator.]) -AC_DEFINE(IS_DEVICE_SEP(_c_), 0, - [Returns true if character is a device separator.]) + AC_DEFINE(IS_DIRECTORY_SEP(_c_), [((_c_) == '/' || (_c_) == '\\')], + [Returns true if character is a directory separator.]) -AC_DEFINE(IS_DIRECTORY_SEP(_c_), [((_c_) == DIRECTORY_SEP)], - [Returns true if character is a directory separator.]) + AC_DEFINE(IS_ANY_SEP(_c_), [(IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP(_c_))], + [Returns true if character is any form of separator.]) +else + AC_DEFINE(IS_DEVICE_SEP(_c_), 0, + [Returns true if character is a device separator.]) -dnl On MS, this also accepts IS_DEVICE_SEP. -AC_DEFINE(IS_ANY_SEP(_c_), [(IS_DIRECTORY_SEP (_c_))], - [Returns true if character is any form of separator.]) + AC_DEFINE(IS_DIRECTORY_SEP(_c_), [((_c_) == DIRECTORY_SEP)], + [Returns true if character is a directory separator.]) + AC_DEFINE(IS_ANY_SEP(_c_), [(IS_DIRECTORY_SEP (_c_))], + [Returns true if character is any form of separator.]) +fi AH_TEMPLATE(NO_EDITRES, [Define if XEditRes should not be used.]) @@ -3429,7 +4062,7 @@ case $opsys in esac case $opsys in - darwin | freebsd | netbsd | openbsd ) + darwin | dragonfly | freebsd | netbsd | openbsd ) AC_DEFINE(DONT_REOPEN_PTY, 1, [Define if process.c does not need to close a pty to make it a controlling terminal (it is already a controlling terminal of the subprocess, because we did ioctl TIOCSCTTY).]) @@ -3513,7 +4146,7 @@ case $opsys in cygwin ) AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl multi-line AC_DEFINEs are hard. :( - AC_DEFINE(PTY_OPEN, [ do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)]) + AC_DEFINE(PTY_OPEN, [ do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (false)]) AC_DEFINE(PTY_NAME_SPRINTF, []) AC_DEFINE(PTY_TTY_NAME_SPRINTF, []) ;; @@ -3526,7 +4159,7 @@ case $opsys in dnl Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8. dnl But we don't have to block SIGCHLD because it is blocked in the dnl implementation of grantpt. - AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)]) + AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (false)]) AC_DEFINE(PTY_NAME_SPRINTF, []) AC_DEFINE(PTY_TTY_NAME_SPRINTF, []) ;; @@ -3535,17 +4168,17 @@ case $opsys in AC_DEFINE(FIRST_PTY_LETTER, ['p']) ;; - gnu-linux | gnu-kfreebsd | freebsd | netbsd ) + gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd ) dnl if HAVE_GRANTPT if test "x$ac_cv_func_grantpt" = xyes; then AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.]) AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD dnl to prevent sigchld_handler from intercepting the child's death. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) dnl if HAVE_POSIX_OPENPT if test "x$ac_cv_func_posix_openpt" = xyes; then - AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NOCTTY)]) + AC_DEFINE(PTY_OPEN, [do { fd = posix_openpt (O_RDWR | O_CLOEXEC | O_NOCTTY); if (fd < 0 && errno == EINVAL) fd = posix_openpt (O_RDWR | O_NOCTTY); } while (false)]) AC_DEFINE(PTY_NAME_SPRINTF, []) dnl if HAVE_GETPT elif test "x$ac_cv_func_getpt" = xyes; then @@ -3590,12 +4223,12 @@ case $opsys in dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() dnl from intercepting that death. If any child but grantpt's should die dnl within, it should be caught after sigrelse(2). - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; unixware ) dnl Comments are as per sol2*. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; esac @@ -3618,7 +4251,7 @@ AH_TEMPLATE(SIGNALS_VIA_CHARACTERS, [Make process_send_signal work by case $opsys in dnl Perry Smith says this is correct for AIX. dnl thomas@mathematik.uni-bremen.de says this is needed for IRIX. - aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd | darwin ) + aix4-2 | cygwin | gnu | irix6-5 | dragonfly | freebsd | netbsd | openbsd | darwin ) AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1) ;; @@ -3667,7 +4300,7 @@ AH_TEMPLATE(TAB3, [Undocumented.]) case $opsys in darwin) AC_DEFINE(TAB3, OXTABS) ;; - gnu | freebsd | netbsd | openbsd ) + gnu | dragonfly | freebsd | netbsd | openbsd ) AC_DEFINE(TABDLY, OXTABS, [Undocumented.]) AC_DEFINE(TAB3, OXTABS) ;; @@ -3678,7 +4311,7 @@ case $opsys in # error "not ia64" #endif ]], [[]])], AC_DEFINE(GC_MARK_SECONDARY_STACK(), - [do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)], + [do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (false)], [Mark a secondary stack, like the register stack on the ia64.]), []) ;; @@ -3721,16 +4354,20 @@ if test x$GCC = xyes; then else case $opsys in dnl irix: Tested on Irix 6.5. SCM worked on earlier versions. - freebsd | netbsd | openbsd | irix6-5 | sol2* ) + dragonfly | freebsd | netbsd | openbsd | irix6-5 | sol2* ) AC_DEFINE(GC_SETJMP_WORKS, 1) ;; esac fi dnl GCC? +dnl In a weird quirk, MS runtime uses _setjmp and longjmp. AC_CACHE_CHECK([for _setjmp], [emacs_cv_func__setjmp], [AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[#include + #ifdef __MINGW32__ + # define _longjmp longjmp + #endif ]], [[jmp_buf j; if (! _setjmp (j)) @@ -3778,17 +4415,14 @@ esac dnl Define symbols to identify the version of Unix this is. dnl Define all the symbols that apply correctly. -AH_TEMPLATE(BSD_SYSTEM, [Define if the system is compatible with BSD 4.2.]) AH_TEMPLATE(DOS_NT, [Define if the system is MS DOS or MS Windows.]) AH_TEMPLATE(MSDOS, [Define if the system is MS DOS.]) AH_TEMPLATE(USG, [Define if the system is compatible with System III.]) -AH_TEMPLATE(USG5, [Define if the system is compatible with System V.]) AH_TEMPLATE(USG5_4, [Define if the system is compatible with System V Release 4.]) case $opsys in aix4-2) AC_DEFINE(USG, []) - AC_DEFINE(USG5, []) dnl This symbol should be defined on AIX Version 3 ??????? AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ #ifndef _AIX @@ -3802,30 +4436,12 @@ case $opsys in ;; darwin) - dnl BSD4_3 and BSD4_4 are already defined in sys/param.h. - AC_DEFINE(BSD_SYSTEM, []) - dnl More specific than the above two. We cannot use __APPLE__ as this - dnl may not be defined on non-OSX Darwin, and we cannot define DARWIN - dnl here because Panther and lower CoreFoundation.h uses DARWIN to + dnl Not __APPLE__, as this may not be defined on non-OSX Darwin. + dnl Not DARWIN, because Panther and lower CoreFoundation.h use DARWIN to dnl distinguish OS X from pure Darwin. AC_DEFINE(DARWIN_OS, [], [Define if the system is Darwin.]) ;; - freebsd) - dnl Hack to avoid calling AC_PREPROC_IFELSE multiple times. - dnl Would not be needed with autoconf >= 2.67, where the - dnl preprocessed output is accessible in "conftest.i". - AC_DEFINE(BSD_SYSTEM_AHB, 1, [Define if AH_BOTTOM should change BSD_SYSTEM.]) - ;; - - gnu | netbsd | openbsd ) - AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ -#ifndef BSD_SYSTEM -# error "BSD_SYSTEM not defined" -#endif - ]], [[]])], [], AC_DEFINE(BSD_SYSTEM, 43) ) - ;; - gnu-linux | gnu-kfreebsd ) AC_DEFINE(USG, []) AC_DEFINE(GNU_LINUX, [], [Define if ths system is compatible with GNU/Linux.]) @@ -3833,27 +4449,31 @@ case $opsys in hpux*) AC_DEFINE(USG, []) - AC_DEFINE(USG5, []) AC_DEFINE(HPUX, [], [Define if the system is HPUX.]) ;; irix6-5) AC_DEFINE(USG, []) - AC_DEFINE(USG5, []) AC_DEFINE(USG5_4, []) AC_DEFINE(IRIX6_5, [], [Define if the system is IRIX.]) ;; + mingw32) + AC_DEFINE(DOS_NT, []) + AC_DEFINE(WINDOWSNT, 1, [Define if compiling for native MS Windows.]) + if test "x$ac_enable_checking" != "x" ; then + AC_DEFINE(EMACSDEBUG, 1, [Define to 1 to enable w32 debug facilities.]) + fi + ;; + sol2*) AC_DEFINE(USG, []) - AC_DEFINE(USG5, []) AC_DEFINE(USG5_4, []) AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.]) ;; unixware) AC_DEFINE(USG, []) - AC_DEFINE(USG5, []) AC_DEFINE(USG5_4, []) ;; esac @@ -3865,6 +4485,10 @@ AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD], emacs_cv_usable_FIONREAD=no ;; + mingw32) + emacs_cv_usable_FIONREAD=yes + ;; + *) AC_COMPILE_IFELSE( [AC_LANG_PROGRAM([[#include @@ -3900,14 +4524,16 @@ fi case $opsys in - dnl Emacs supplies its own malloc, but glib (part of Gtk+) calls - dnl memalign and on Cygwin, that becomes the Cygwin-supplied memalign. - dnl As malloc is not the Cygwin malloc, the Cygwin memalign always - dnl returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */ + dnl Emacs supplies its own malloc, but glib calls posix_memalign, + dnl and on Cygwin prior to version 1.7.24 that becomes the + dnl Cygwin-supplied posix_memalign. As malloc is not the Cygwin + dnl malloc, the Cygwin posix_memalign always returns ENOSYS. A + dnl workaround is to set G_SLICE=always-malloc. This is no longer + dnl needed starting with cygwin-1.7.24, and it is no longer + dnl effective starting with glib-2.36. */ cygwin) AC_DEFINE(G_SLICE_ALWAYS_MALLOC, 1, [Define to set the - G_SLICE environment variable to "always-malloc" at startup, if - using GTK.]) + G_SLICE environment variable to "always-malloc" at startup.]) ;; hpux11) @@ -3943,7 +4569,7 @@ fi version=$PACKAGE_VERSION -copyright="Copyright (C) 2013 Free Software Foundation, Inc." +copyright="Copyright (C) 2014 Free Software Foundation, Inc." AC_DEFINE_UNQUOTED(COPYRIGHT, ["$copyright"], [Short copyright string for this version of Emacs.]) AC_SUBST(copyright) @@ -3964,14 +4590,13 @@ AC_SUBST(libexecdir) AC_SUBST(mandir) AC_SUBST(infodir) AC_SUBST(lispdir) -AC_SUBST(leimdir) AC_SUBST(standardlisppath) AC_SUBST(locallisppath) AC_SUBST(lisppath) AC_SUBST(x_default_search_path) AC_SUBST(etcdir) AC_SUBST(archlibdir) -AC_SUBST(docdir) +AC_SUBST(etcdocdir) AC_SUBST(bitmapdir) AC_SUBST(gamedir) AC_SUBST(gameuser) @@ -3998,13 +4623,17 @@ fi AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "${canonical}", [Define to the canonical Emacs configuration name.]) -dnl Replace any embedded " characters (bug#13274). -emacs_config_options=`echo "$emacs_config_options " | sed -e 's/--no-create //' -e 's/--no-recursion //' -e 's/ *$//' -e "s/\"/'/g"` AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${emacs_config_options}", [Define to the options passed to configure.]) AH_TEMPLATE(config_opsysfile, [Some platforms that do not use configure define this to include extra configuration information.]) +case $opsys in + mingw32) + AC_DEFINE(config_opsysfile, , []) + ;; +esac + XMENU_OBJ= XOBJ= FONT_OBJ= @@ -4012,7 +4641,7 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then AC_DEFINE(HAVE_X_WINDOWS, 1, [Define to 1 if you want to use the X window system.]) XMENU_OBJ=xmenu.o - XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o" + XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o" FONT_OBJ=xfont.o if test "$HAVE_XFT" = "yes"; then FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o" @@ -4065,64 +4694,32 @@ case "$USE_X_TOOLKIT" in esac AC_SUBST(TOOLKIT_LIBW) -if test "$USE_X_TOOLKIT" = "none"; then - LIBXT_OTHER="\$(LIBXSM)" - OLDXMENU_TARGET="really-oldXMenu" -else - LIBXT_OTHER="\$(LIBXMU) -lXt \$(LIBXTR6) -lXext" - OLDXMENU_TARGET="really-lwlib" +if test "${opsys}" != "mingw32"; then + if test "$USE_X_TOOLKIT" = "none"; then + LIBXT_OTHER="\$(LIBXSM)" + else + LIBXT_OTHER="\$(LIBXMU) -lXt \$(LIBXTR6) -lXext" + fi fi AC_SUBST(LIBXT_OTHER) -## The X Menu stuff is present in the X10 distribution, but missing -## from X11. If we have X10, just use the installed library; -## otherwise, use our own copy. if test "${HAVE_X11}" = "yes" ; then AC_DEFINE(HAVE_X11, 1, - [Define to 1 if you want to use version 11 of X windows. - Otherwise, Emacs expects to use version 10.]) - - if test "$USE_X_TOOLKIT" = "none"; then - OLDXMENU="\${oldXMenudir}/libXMenu11.a" - else - OLDXMENU="\${lwlibdir}/liblw.a" - fi - LIBXMENU="\$(OLDXMENU)" + [Define to 1 if you want to use version 11 of X windows.]) LIBX_OTHER="\$(LIBXT) \$(LIBX_EXTRA)" - OLDXMENU_DEPS="\${OLDXMENU} ../src/\${OLDXMENU}" else - ## For a syntactically valid Makefile; not actually used for anything. - ## See comments in src/Makefile.in. - OLDXMENU=nothing - ## FIXME This case (!HAVE_X11 && HAVE_X_WINDOWS) is no longer possible(?). - if test "${HAVE_X_WINDOWS}" = "yes"; then - LIBXMENU="-lXMenu" - else - LIBXMENU= - fi LIBX_OTHER= - OLDXMENU_DEPS= fi - -if test "$HAVE_GTK" = "yes" || test "$HAVE_MENUS" != "yes"; then - OLDXMENU_TARGET= - OLDXMENU=nothing - LIBXMENU= - OLDXMENU_DEPS= -fi - -AC_SUBST(OLDXMENU_TARGET) -AC_SUBST(OLDXMENU) -AC_SUBST(LIBXMENU) AC_SUBST(LIBX_OTHER) -AC_SUBST(OLDXMENU_DEPS) -if test "${HAVE_MENUS}" = "yes" ; then - AC_DEFINE(HAVE_MENUS, 1, - [Define to 1 if you have mouse menus. - (This is automatic if you use X, but the option to specify it remains.) - It is also defined with other window systems that support xmenu.c.]) +if test "$HAVE_GTK" = yes || test "$HAVE_X11" != yes; then + LIBXMENU= +elif test "$USE_X_TOOLKIT" = none; then + LIBXMENU='$(oldXMenudir)/libXMenu11.a' +else + LIBXMENU='$(lwlibdir)/liblw.a' fi +AC_SUBST(LIBXMENU) if test "${GNU_MALLOC}" = "yes" ; then AC_DEFINE(GNU_MALLOC, 1, @@ -4144,6 +4741,10 @@ if test "$opsys" = "cygwin"; then ## Cygwin differs because of its unexec(). PRE_ALLOC_OBJ= POST_ALLOC_OBJ=lastfile.o +elif test "$opsys" = "mingw32"; then + CYGWIN_OBJ= + PRE_ALLOC_OBJ= + POST_ALLOC_OBJ=lastfile.o else CYGWIN_OBJ= PRE_ALLOC_OBJ=lastfile.o @@ -4153,6 +4754,24 @@ AC_SUBST(CYGWIN_OBJ) AC_SUBST(PRE_ALLOC_OBJ) AC_SUBST(POST_ALLOC_OBJ) +dnl Call this 'FORTIFY_SOUR' so that it sorts before the 'FORTIFY_SOURCE' +dnl verbatim defined above. The tricky name is apropos, as this hack +dnl makes Fortify go sour! +AH_VERBATIM([FORTIFY_SOUR], +[/* Without the following workaround, Emacs runs slowly on OS X 10.8. + The workaround disables some useful run-time checking, so it + should be conditional to the platforms with the performance bug. + Perhaps Apple will fix this some day; also see m4/extern-inline.m4. */ +#if defined __APPLE__ && defined __GNUC__ +# ifndef _DONT_USE_CTYPE_INLINE_ +# define _DONT_USE_CTYPE_INLINE_ +# endif +# ifndef _FORTIFY_SOURCE +# define _FORTIFY_SOURCE 0 +# endif +#endif +]) + # Configure gnulib. Although this does not affect CFLAGS or LIBS permanently. # it temporarily reverts them to their pre-pkg-config values, # because gnulib needs to work with both src (which uses the @@ -4171,6 +4790,12 @@ gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS +if test "${opsys}" = "mingw32"; then + CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc" + # Remove unneeded switches from the value of CC that goes to Makefiles + CC=`echo $CC | sed -e "s,$GCC_TEST_OPTIONS,,"` +fi + case "$opsys" in aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;; @@ -4181,6 +4806,9 @@ case "$opsys" in ## each); under Cocoa 31 commands are required. if test "$HAVE_NS" = "yes"; then libs_nsgui="-framework AppKit" + if test "$NS_IMPL_COCOA" = "yes"; then + libs_nsgui="$libs_nsgui -framework IOKit" + fi headerpad_extra=6C8 else libs_nsgui= @@ -4189,15 +4817,8 @@ case "$opsys" in LD_SWITCH_SYSTEM_TEMACS="-fno-pie -prebind $libs_nsgui -Xlinker -headerpad -Xlinker $headerpad_extra" ## This is here because src/Makefile.in did some extra fiddling around - ## with LD_SWITCH_SYSTEM. The cpp logic was: - ## #ifndef LD_SWITCH_SYSTEM - ## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF))) - ## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to: - ## not using gcc, darwin. - ## Because this was done in src/Makefile.in, the resulting part of - ## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link). - ## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS, - ## rather than LD_SWITCH_SYSTEM. + ## with LD_SWITCH_SYSTEM. It seems cleaner to put this in + ## LD_SWITCH_SYSTEM_TEMACS instead, test "x$LD_SWITCH_SYSTEM" = "x" && test "x$GCC" != "xyes" && \ LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS" ;; @@ -4211,11 +4832,50 @@ case "$opsys" in ## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS. gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;; + mingw32) + ## MinGW64 does not prepend an underscore to symbols, so we must + ## pass a different -entry switch to linker. FIXME: It is better + ## to make the entry points the same by changing unexw32.c. + case "$canonical" in + x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; + *) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; + esac + ;; + + openbsd) LD_SWITCH_SYSTEM_TEMACS='-nopie' ;; + *) LD_SWITCH_SYSTEM_TEMACS= ;; esac +if test x$ac_enable_profiling != x ; then + case $opsys in + *freebsd | gnu-linux) ;; + *) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -pg" ;; + esac +fi + +LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS" + AC_SUBST(LD_SWITCH_SYSTEM_TEMACS) +## MinGW-specific post-link processing of temacs. +TEMACS_POST_LINK=":" +ADDSECTION= +EMACS_HEAPSIZE= +if test "${opsys}" = "mingw32"; then + TEMACS_POST_LINK="\$(MINGW_TEMACS_POST_LINK)" + ADDSECTION="../nt/addsection\$(EXEEXT)" + ## Preload heap size of temacs.exe in MB. + case "$canonical" in + x86_64-*-*) EMACS_HEAPSIZE=42 ;; + *) EMACS_HEAPSIZE=27 ;; + esac +fi + +AC_SUBST(ADDSECTION) +AC_SUBST(TEMACS_POST_LINK) +AC_SUBST(EMACS_HEAPSIZE) + ## Common for all window systems if test "$window_system" != "none"; then AC_DEFINE(HAVE_WINDOW_SYSTEM, 1, [Define if you have a window system.]) @@ -4226,7 +4886,7 @@ AC_SUBST(WINDOW_SYSTEM_OBJ) AH_TOP([/* GNU Emacs site configuration template file. -Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2013 +Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -4271,6 +4931,12 @@ if test "${HAVE_GTK}" = "yes"; then USE_X_TOOLKIT="$USE_GTK_TOOLKIT" fi +if test $USE_ACL -ne 0; then + acl_summary="yes $LIB_ACL" +else + acl_summary=no +fi + echo " Configured for \`${canonical}'. @@ -4302,10 +4968,14 @@ echo " Does Emacs use -lpng? ${HAVE_PNG}" echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" +echo " Does Emacs support sound? ${HAVE_SOUND}" + echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}" +echo " Does Emacs use a file notification library? ${NOTIFY_SUMMARY}" +echo " Does Emacs use access control lists? ${acl_summary}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}" echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" @@ -4314,6 +4984,7 @@ echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE} echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" echo " Does Emacs use -lotf? ${HAVE_LIBOTF}" echo " Does Emacs use -lxft? ${HAVE_XFT}" +echo " Does Emacs directly use zlib? ${HAVE_ZLIB}" echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" echo @@ -4360,10 +5031,13 @@ if test "$HAVE_NS" = "yes"; then if test "$NS_IMPL_GNUSTEP" = yes; then AC_CONFIG_FILES([nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in \ nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in]) + ns_check_file=Resources/Info-gnustep.plist else AC_CONFIG_FILES([nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in \ nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in]) + ns_check_file=Contents/Info.plist fi + AC_SUBST(ns_check_file) fi dnl Obviously there is duplication here wrt $SUBDIR_MAKEFILES. @@ -4374,12 +5048,12 @@ dnl This will work, but you get a config.status that is not quite right dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html). dnl That doesn't have any obvious consequences for Emacs, but on the whole dnl it seems better to just live with the duplication. -SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile" +SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile nt/Makefile" AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \ doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \ doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \ - leim/Makefile nextstep/Makefile]) + leim/Makefile nextstep/Makefile nt/Makefile]) dnl test/ is not present in release tarfiles. opt_makefile=test/automated/Makefile @@ -4392,26 +5066,18 @@ if test -f "$srcdir/$opt_makefile.in"; then fi -dnl admin/ may or may not be present. -opt_makefile=admin/unidata/Makefile - -if test -f "$srcdir/$opt_makefile.in"; then - SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile" +dnl The admin/ directory used to be excluded from tarfiles. +if test -d $srcdir/admin; then + SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES admin/unidata/Makefile admin/grammars/Makefile" AC_CONFIG_FILES([admin/unidata/Makefile]) -fi + AC_CONFIG_FILES([admin/grammars/Makefile]) +fi dnl -d admin SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'` AC_SUBST(SUBDIR_MAKEFILES_IN) -dnl Make the necessary directories, if they don't exist. -AC_CONFIG_COMMANDS([mkdirs], [ -for dir in etc lisp ; do - test -d ${dir} || mkdir ${dir} -done -]) - dnl You might wonder (I did) why epaths.h is generated by running make, dnl rather than just letting configure generate it from epaths.in. dnl One reason is that the various paths are not fully expanded (see above); @@ -4420,15 +5086,20 @@ dnl Secondly, the GNU Coding standards require that one should be able dnl to run `make prefix=/some/where/else' and override the values set dnl by configure. This also explains the `move-if-change' test and dnl the use of force in the `epaths-force' rule in Makefile.in. -AC_CONFIG_COMMANDS([epaths], [ -echo creating src/epaths.h -${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force -], [GCC="$GCC" CPPFLAGS="$CPPFLAGS"]) +AC_CONFIG_COMMANDS([src/epaths.h], [ +if test "${opsys}" = "mingw32"; then + ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 +else + ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force +fi +], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys"]) -AC_CONFIG_COMMANDS([gdbinit], [ +dnl NB we have to cheat and use the ac_... version because abs_top_srcdir +dnl is not yet set, sigh. Or we could use ../$srcdir/src/.gdbinit, +dnl or a symlink? +AC_CONFIG_COMMANDS([src/.gdbinit], [ if test ! -f src/.gdbinit && test -f "$srcdir/src/.gdbinit"; then - echo creating src/.gdbinit - echo "source $srcdir/src/.gdbinit" > src/.gdbinit + echo "source $ac_abs_top_srcdir/src/.gdbinit" > src/.gdbinit fi ]) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index bd70b1fdebf..9fba16f4126 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,596 @@ +2014-02-23 Glenn Morris + + * rmail.texi (Rmail Inbox): Mention rmail-mbox-format. + +2014-02-20 Glenn Morris + + * search.texi (Special Isearch): Mention invisible text. + * text.texi (Outline Visibility): Mention `M-s i' in isearch. + +2014-02-18 Glenn Morris + + * trouble.texi (Contributing) [WWW_GNU_ORG]: Link to + gnu.org version of etc/CONTRIBUTE in html output. + + * misc.texi (Saving Emacs Sessions): Mention desktop-auto-save-timeout. + +2014-02-17 Stefan Monnier + + * programs.texi (Matching): Fix typo. + + * killing.texi (CUA Bindings): Document the new relationship between + cua-mode and delete-selection mode. + (CUA Bindings): Mention that rectangle mode can be used on its own. + +2014-02-14 Glenn Morris + + * regs.texi (Configuration Registers): Update C-x r f binding. + +2014-02-12 Glenn Morris + + * mini.texi (Completion Options): No longer mention icomplete, + which has its own section now. + * modes.texi (Minor Modes): Update Icomplete xref. + + * help.texi (Package Keywords): Mention describe-package buttons. + + * package.texi (Package Menu): Mention package-menu-filter. + +2014-02-11 Lars Ingebrigtsen + + * text.texi (Editing Format Info): Use @samp for menus (bug#13736). + +2014-02-09 Lars Ingebrigtsen + + * dired.texi (Hiding Subdirectories): Mention the node for + deleting subdirectories (bug#11743). + +2014-02-09 Glenn Morris + + * programs.texi (MixedCase Words): Rename node from "Glasses". + Move Subword mode here from "Other C Commands" node. + (Misc for Programs): Mention Superword mode. + * emacs.texi: Update menu. + +2014-02-08 Lars Ingebrigtsen + + * regs.texi (File Registers): Clarify metasyntactical variables + (bug#13565). + + * search.texi (Search Case): Rearrange text slightly to make it + obvious that `M-c' also toggles sensitivity if `case-fold-search' + is nil (bug#14726). + + * frames.texi (Mouse Commands): Clarify `mouse-yank-at-click' + (bug#16376). + +2014-02-07 Glenn Morris + + * display.texi (Highlight Interactively): + Mention hi-lock-auto-select-face. + + * anti.texi (Antinews): Fix typo. + + * ack.texi (Acknowledgments): No longer mention obsolete files. + +2014-02-02 Glenn Morris + + * regs.texi (Registers): Mention previewing. + +2014-01-29 Glenn Morris + + * killing.texi (Deletion): Mention cycle-spacing. + +2014-01-28 Glenn Morris + + * text.texi (Fill Commands): Mention fill-single-char-nobreak-p. + + * indent.texi (Tab Stops): Updates for new tab-stop behavior. + +2014-01-27 Glenn Morris + + * dired.texi (Misc Dired Features): Copyedits for hide-details. + + * buffers.texi (List Buffers): Tiny edit. + + * calendar.texi (Time Intervals): Update for files in ~/.emacs.d/. + +2014-01-26 Glenn Morris + + * ack.texi (Acknowledgments): + * programs.texi (Program Modes): + Update for delphi.el -> opascal.el renaming. + + * misc.texi (Sorting): Add findex for reverse-region. + + * killing.texi (Deletion): Mention delete-duplicate-lines. + +2014-01-24 Glenn Morris + + * ack.texi (Acknowledgments): No longer mention obsolete xesam.el, + terminal.el. + + * files.texi (Interlocking): Copyedit. + +2014-01-23 Glenn Morris + + * building.texi (Lisp Eval): Update prefix argument behavior + of eval-expression, eval-last-sexp. + +2014-01-17 Bastien Guerry + + * building.texi (Commands of GUD): Fix keybinding for `gud-break'. + +2014-01-15 Glenn Morris + + * files.texi (File Conveniences): + * misc.texi (EWW): Copyedits. + +2014-01-10 Glenn Morris + + * emacs.texi (Distrib): Add donate URL. Add anchor. + +2014-01-10 Rüdiger Sonderfeld + + * dired.texi (Misc Dired Features): Document `dired-hide-details-mode', + `dired-hide-details-hide-symlink-targets', and + `dired-hide-details-hide-information-lines'. + +2014-01-09 Rüdiger Sonderfeld + + * emacs.texi: Add EWW. + * misc.texi (EWW): Document EWW. + +2014-01-09 Glenn Morris + + * trouble.texi (Service): Refer to online service directory + rather than etc/SERVICE. + +2014-01-09 Rüdiger Sonderfeld + + * building.texi (Lisp Libraries): Document `load-prefer-newer'. + + * files.texi (File Conveniences): Document `image-next-frame', + `image-previous-frame', `image-goto-frame', + `image-increase-speed', `image-decrease-speed', + `image-reverse-speed', and `image-reset-speed'. + +2014-01-07 Bastien Guerry + + * buffers.texi (Buffers): Fix display of @math content by using + nested braces. (Bug#16389) + +2014-01-07 Chong Yidong + + * search.texi (Special Isearch): Document C-x 8 RET in isearch. + (Word Search): Document incremental word search changes. + (Isearch Yank): Document M-s C-e with a prefix argument. + +2014-01-07 Glenn Morris + + * cal-xtra.texi (Calendar Customizing): + Mention calendar-day-header-array. + +2013-12-28 Glenn Morris + + * trouble.texi (Understanding Bug Reporting): Brevity. + +2013-12-27 Jarek Czekalski + + * mini.texi (Completion Options): Add a link to Shell Options. + * misc.texi (Shell Mode): Move documentation of + shell-completion-fignore from Shell Mode to Shell Options. + +2013-12-26 João Távora + + * emacs.texi (Matching): Describe new features of Electric Pair mode. + +2013-12-25 Chong Yidong + + * glossary.texi (Glossary): Define MULE in modern terms. + +2013-12-25 Xue Fuqiao + + * files.texi (Diff Mode): Add an index. + +2013-12-24 Xue Fuqiao + + * trouble.texi (Understanding Bug Reporting): Minor update. + (Checklist): Fix a cross-reference. + +2013-12-23 Xue Fuqiao + + * regs.texi (Bookmarks): Document `bookmark-default-file'. + + * misc.texi (Shell Mode): Add a cross-reference. + + * building.texi (Lisp Eval): Add an index. + +2013-12-22 Glenn Morris + + * entering.texi (Entering Emacs): Typo fix. + + * calendar.texi (General Calendar): + * rmail.texi (Rmail Scrolling): Use itemx where appropriate. + +2013-12-22 Eli Zaretskii + + * regs.texi (Keyboard Macro Registers): Fix last change. + +2013-12-22 Xue Fuqiao + + * search.texi (Special Isearch): + (Query Replace): Document negative argument of replacement commands. + (Symbol Search): Document `isearch-forward-symbol-at-point'. + + * files.texi (File Conveniences): Document `image-next-file' and + `image-previous-file'. + + * display.texi (Optional Mode Line): Fix an index. + + * regs.texi (File Registers): Document `kmacro-to-register'. + + * indent.texi (Tab Stops): Mention recent changes about `tab-stop-list'. + + * frames.texi (Scroll Bars): Document + `scroll-bar-adjust-thumb-portion'. + +2013-12-21 Chong Yidong + + * indent.texi (Indentation Commands): Document C-x TAB changes. + +2013-12-20 Tassilo Horn + + * calendar.texi, display.texi, help.texi, rmail.texi: + Document `S-SPC' as alternative to scrolling down with `DEL'. + + * frames.texi: Document `toggle-frame-maximized' and + `toggle-frame-fullscreen' with their respective keys. + + * buffers.texi: Document buffer name uniquification changes. + + * indent.texi: Document that `electric-indent-mode' is enabled by + default. + + * display.texi (Cursor Display): Document `blink-cursor-blinks'. + + * buffers.texi: Update list-buffers "screeshot" to show Messages + as major-mode. + + * entering.texi: Document `initial-buffer-choice' changes. + + * misc.texi (emacsclient Options): Document + `initial-buffer-choice' changes. + + * help.texi: Document that `?' now also shows subcommands of + prefix keys. + +2013-12-17 Chong Yidong + + * killing.texi (Appending Kills): Note that append-next-kill can + prepend the kill. + +2013-12-12 Eli Zaretskii + + * mule.texi (File Name Coding): Document file-name encoding + peculiarities on MS-Windows. + +2013-12-12 Glenn Morris + + * emacs.texi: Sync direntry with info/dir version. + +2013-12-08 Juanma Barranquero + + * msdog.texi (Windows Keyboard): Fix typo. + +2013-11-30 Glenn Morris + + * Makefile.in (distclean): Remove Makefile. + +2013-11-29 Stefan Monnier + + * buffers.texi (Icomplete): Rename from Iswitchb and + rewrite accordingly. + +2013-11-23 Glenn Morris + + * cmdargs.texi (General Variables): + Empty elements in EMACSLOADPATH now mean the default load-path. + +2013-11-21 Glenn Morris + + * cmdargs.texi (Action Arguments): Use path-separator with -L. + +2013-11-04 Glenn Morris + + * cmdargs.texi (Action Arguments): Mention that `-L :...' appends. + +2013-11-02 Glenn Morris + + * cmdargs.texi (Action Arguments): Clarify `-L' a bit. + +2013-10-23 Glenn Morris + + * files.texi, glossary.texi, killing.texi, search.texi, sending.texi: + Nuke @refill. + + * Makefile.in (install-dvi, install-html, install-pdf) + (install-ps, uninstall-dvi, uninstall-html, uninstall-ps) + (uninstall-pdf): Quote entities that might contain whitespace. + +2013-10-20 Xue Fuqiao + + * custom.texi (Init Syntax, Terminal Init, Terminal Init): + Remove @refill. + +2013-10-13 Glenn Morris + + * ack.texi (Acknowledgments): Comment out old alpha stuff. + +2013-10-13 Xue Fuqiao + + * calendar.texi (Special Diary Entries): Remove @refill. + +2013-10-13 Glenn Morris + + * display.texi (Text Scale): Update text-scale-adjust details. + + * ack.texi (Acknowledgments): + * emacs.texi (Acknowledgments): Use accented form of some names. + +2013-10-08 Eli Zaretskii + + * ack.texi (Acknowledgments): Fix spelling of Hrvoje Nikšić's + name. (Bug#15557) + + Support menus on text-mode terminals. + * screen.texi (Menu Bar): Adapt to TTY menus. + + * frames.texi (Frames): Mention menu support on text terminals. + + * files.texi (Visiting): Mention the "File" menu-bar menu. + + * display.texi (Standard Faces): Mention TTY faces for menus. + +2013-10-06 Xue Fuqiao + + * cal-xtra.texi (Calendar Customizing, Diary Display): Remove @refill. + +2013-09-29 Xue Fuqiao + + * fortran-xtra.texi (Fortran Abbrev): Remove @refill. + +2013-09-26 Xue Fuqiao + + * dired.texi (Flagging Many Files): Use @emph instead of @strong. + + * emacs.texi (Intro): Minor cleanup. + +2013-09-22 Xue Fuqiao + + * fixit.texi (Transpose): + (Fixing Case): Remove @refill. + +2013-09-21 Xue Fuqiao + + * maintaining.texi (VC Directory Commands): Add keybinding for + vc-log-incoming in vc-dir. + (Log Buffer): Use @emph instead of @strong. + +2013-09-12 Xue Fuqiao + + * text.texi (Enriched Justification): Explain values of default-justification. + +2013-09-04 Xue Fuqiao + + * maintaining.texi (VC Ignore): Mention `vc-ignore' with prefix argument. + +2013-08-31 Ulrich Müller + + * xresources.texi (Motif Resources): + Rename from LessTif Resources. Update xrefs. (Bug#15145) + * emacs.texi: Update menu. + +2013-08-28 Paul Eggert + + * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-17 Xue Fuqiao + + * text.texi (Enriched Justification): Minor fixes. + +2013-08-14 Xue Fuqiao + + * files.texi (Filesets): Add an index. + +2013-08-12 Glenn Morris + + * macos.texi (GNUstep Support): + * trouble.texi (Checklist, Contributing, Service): + Avoid mailto: in html output. + + * Makefile.in (prefix, datarootdir, datadir, PACKAGE_TARNAME) + (docdir, dvidir, htmldir, pdfdir, psdir, GZIP_PROG, INSTALL) + (INSTALL_DATA): New, set by configure. + (HTML_OPTS, DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): + New variables. + (.SUFFIXES): Add .ps and .dvi. + (.dvi.ps): New suffix rule. + (dvi, html, pdf, ps): Use *_TARGETS variables. + (emacs.ps, emacs-xtra.ps): Remove explicit rules. + (emacs.html): Use HTML_OPTS. + (clean): Use DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS. + (.PHONY): install-dvi, install-html, install-pdf, install-ps + ,install-doc, uninstall-dvi, uninstall-html, uninstall-pdf, + uninstall-ps, and uninstall-doc. + (install-dvi, install-html, install-pdf, install-ps, install-doc) + (uninstall-dvi, uninstall-html, uninstall-ps, uninstall-pdf) + (uninstall-doc): New rules. + +2013-07-31 Eli Zaretskii + + * emacs.texi (Top): Remove menu item for the removed "Disabling + Multibyte" node. + +2013-07-31 Xue Fuqiao + + * rmail.texi (Rmail Coding): Move here from mule.texi. + + * custom.texi (Specifying File Variables): Fix cross-references. + + * mule.texi (Unibyte Mode): Fix cross-references. + (Disabling Multibyte): Remove. + + * macos.texi (Mac / GNUstep Basics): Mention `ns-alternate-modifier'. + + * cal-xtra.texi (Advanced Calendar/Diary Usage): Update menu. + (Mayan Calendar): Move here from calendar.texi. + * emacs.texi (Top): Update menu. + +2013-07-30 Xue Fuqiao + + * emacs.texi (Top): Add menu entry. + + * maintaining.texi (VC Ignore): New node. Document vc-ignore. + (VC Directory Commands): Add vc-dir-ignore. + +2013-07-28 Xue Fuqiao + + * glossary.texi (Glossary): Add some entries. + +2013-07-27 Xue Fuqiao + + * maintaining.texi (VC Directory Commands): Mention `D' and `L' in + vc-dir. (Bug#14948) + +2013-07-26 Eli Zaretskii + + * display.texi (Fringes): Document the variable fringe-mode. + (Bug#14946) + +2013-07-03 Glenn Morris + + * maintaining.texi (EDE): Fix cross-reference. + + * programs.texi (Program Modes): Fix emacs-xtra reference. + + * help.texi (Misc Help): Index describe-syntax. + +2013-06-29 Eli Zaretskii + + * basic.texi (Moving Point): Document visual-order-cursor-movement + and its effect on right-char and left-char. + +2013-06-28 Glenn Morris + + * ack.texi (Acknowledgments): Small update. + +2013-06-19 Glenn Morris + + * Makefile.in (dist): Edit more configure variables. + Try to check that we do not miss any in future. + +2013-06-12 Xue Fuqiao + + * vc1-xtra.texi (Revision Tags): Add a cross reference. + (CVS Options): Fix the default value of `vc-cvs-stay-local'. + +2013-06-11 Glenn Morris + + * maintaining.texi (VC Directory Commands): Copyedit. + (Branches): Put back milder version of pre 2013-06-07 text. + +2013-06-07 Xue Fuqiao + + * maintaining.texi (Branches): Remove text copied from other sources. + +2013-06-05 Alan Mackenzie + + * search.texi (Isearch Scroll): Rename to "Not Exiting Isearch". + (Not Exiting Isearch): Document new user option + `isearch-allow-prefix'. (Bug#9706) + +2013-06-03 Juri Linkov + + * display.texi (Highlight Interactively): Add global keybindings + with the key prefix `M-s h'. Document old command `highlight-phrase'. + Document new command `highlight-symbol-at-point'. + +2013-06-02 Xue Fuqiao + + * maintaining.texi (Branches): Add motivations for branching. + (VC Mode Line): Fix typo. + (VC Directory Commands): Mention `vc-dir-hide-up-to-date' with + prefix argument. + +2013-06-02 Michael Albinus + + * cmdargs.texi (General Variables): Use "unix:path=/dev/null" as + dummy value for $DBUS_SESSION_BUS_ADDRESS. It also suppresses + autolaunching of the D-Bus session bus. + +2013-06-01 Glenn Morris + + * programs.texi (Semantic): Fix typo. + +2013-05-30 Xue Fuqiao + + * maintaining.texi (Types of Log File): Supplement some + information of change log files. + +2013-05-15 Juri Linkov + + * search.texi (Repeat Isearch): Mention key `RET' to finish + editing the string. (Bug#13348) + +2013-05-14 Glenn Morris + + * ack.texi (Acknowledgments): Don't mention obsolete sup-mouse.el. + +2013-05-09 Glenn Morris + + * sending.texi (Mail Sending): Fix typo. + + * windows.texi (Change Window): Fix typo. + + * custom.texi (Changing a Variable): Fix typo. + + * trouble.texi (Contributing): Remove obsolete info re pretesters. + +2013-05-05 Paul Eggert + + `write-region-inhibit-fsync' defaults to noninteractive (Bug#14273). + * cmdargs.texi (Initial Options): + * files.texi (Customize Save): Document this. + +2013-05-04 Glenn Morris + + * calendar.texi (Importing Diary): Mention diary-from-outlook-function. + +2013-03-17 Paul Eggert + + doc: convert some TeX accents to UTF-8 + * ack.texi (Acknowledgments): + * emacs.texi (Acknowledgments): + Convert some TeX accents (e.g., '@l{}') to UTF-8 (e.g., 'ł'). + Apparently the TeX accents cause problems when generating gnu.org + web pages, e.g., @l{} is rendered as '/l' on + . + +2013-03-16 Glenn Morris + + * emacs.texi (Top): Add some stuff specific to www.gnu.org. + +2013-03-04 Paul Eggert + + Prefer UTF-8 for documentation. + With GNU Texinfo 5.0, this generates nicer-looking info files, + since they can use curly quotes. With older Texinfo it doesn't matter. + * ack.texi, cal-xtra.texi, calendar.texi, emacs-xtra.texi, emacs.texi: + Switch from Latin-1 to UTF-8. + 2013-02-28 Bastien Guerry * xresources.texi (GTK resources): Fix broken link. @@ -329,6 +922,11 @@ * trouble.texi (Crashing): Document addr2line. +2012-09-19 Tassilo Horn + + * misc.texi (DocView Slicing): Document new slice from + BoundingBox feature. + 2012-09-19 Chong Yidong * killing.texi (Yanking): Minor clarification (Bug#12469). @@ -816,7 +1414,7 @@ \\`info- no longer handled specially. Update for rmail-enable-mime-composing. Don't mention 'm' for replies. - Don't mention rmail-mail-new-frame and cancelling, since it does + Don't mention rmail-mail-new-frame and canceling, since it does not work for Message at the moment. * cal-xtra.texi: Copyedits. @@ -2686,9 +3284,9 @@ 2010-03-27 Nick Roberts - doc/emacs/building.texi: Describe restored GDB/MI functionality + * building.texi: Describe restored GDB/MI functionality removed by 2009-12-29T07:15:34Z!nickrob@snap.net.nz. - doc/emacs/emacs.texi: Update node names for building.texi. + * emacs.texi: Update node names for building.texi. 2010-03-24 Glenn Morris @@ -4505,7 +5103,7 @@ 2008-05-02 Eric S. Raymond - * emacs/buffers.texi, emacs/files.texi (Version-control): + * buffers.texi, files.texi (Version-control): vc-toggle-read-only is no longer a good idea... 2008-04-29 Glenn Morris @@ -4652,10 +5250,6 @@ * maintaining.texi (Tags): Fix last change. -2008-02-02 Michael Albinus - - * tramp.texi: Use new FSF's Back-Cover Text. - 2008-01-31 Nick Roberts * trouble.texi (Checklist): Direct users to emacs-devel@gnu.org. @@ -4698,8 +5292,6 @@ * search.texi (Query Replace): Make exp of query-replace more self-contained, and clarify. - * cc-mode.texi (Getting Started): Change @ref to @pxref. - 2007-12-15 Richard Stallman * files.texi (Auto Save): Clarify definition of auto-saving. @@ -5251,6 +5843,11 @@ * frames.texi (Secondary Selection): Window clicked does not matter when mouse-yank-at-point is non-nil. +2007-01-27 Eli Zaretskii + + * msdog.texi (ls in Lisp): Document ls-lisp-format-time-list and + ls-lisp-use-localized-time-format. + 2007-01-16 Glenn Morris * abbrevs.texi (Editing Abbrevs): Describe how to disable a @@ -5578,6 +6175,11 @@ Change "Library Public License" to "Lesser Public License" throughout. Use "yyyy" to represent year. +2006-09-12 Paul Eggert + + * misc.texi (Interactive Shell): EMACS is now set + to Emacs's absolute file name, not to "t". + 2006-09-12 Reiner Steib * files.texi (Visiting): Add index entry "open file". @@ -6339,8 +6941,6 @@ * sending.texi (Mail Sending): pxref to Top needs five args. - * texinfo.tex: Update to current version (2006-03-21.13). - 2006-03-31 Richard Stallman * emacs.texi (Top): Update subnode menu. @@ -9214,13 +9814,13 @@ 2003-11-02 Jesper Harder (tiny change) - * man/ack.texi, man/basic.texi, man/cmdargs.texi: - * man/commands.texi, man/custom.texi, man/display.texi: - * man/emacs.texi, man/files.texi: - * man/frames.texi, man/glossary.texi, man/killing.texi: - * man/macos.texi, man/mark.texi, man/misc.texi, man/msdog.texi: - * man/mule.texi, man/rmail.texi, man/search.texi: - * man/sending.texi, man/text.texi, man/trouble.texi: + * ack.texi, basic.texi, cmdargs.texi: + * commands.texi, custom.texi, display.texi: + * emacs.texi, files.texi: + * frames.texi, glossary.texi, killing.texi: + * macos.texi, mark.texi, misc.texi, msdog.texi: + * mule.texi, rmail.texi, search.texi: + * sending.texi, text.texi, trouble.texi: Replace @sc{ascii} and ASCII with @acronym{ASCII}. 2003-11-01 Alan Mackenzie @@ -9754,7 +10354,7 @@ 1990-05-25 Richard Stallman (rms@sugar-bombs.ai.mit.edu) - * texindex.tex: If USG, include sys/types.h and sys/fcntl.h. + * texindex.c: If USG, include sys/types.h and sys/fcntl.h. 1990-03-21 Jim Kingdon (kingdon@pogo.ai.mit.edu) @@ -9774,7 +10374,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2013 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index 43de825ea70..4a59ebed521 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -1,6 +1,6 @@ -#### Makefile for the Emacs Manual +### @configure_input@ -# Copyright (C) 1994, 1996-2013 Free Software Foundation, Inc. +# Copyright (C) 1994, 1996-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -17,7 +17,10 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -SHELL = /bin/sh +SHELL = @SHELL@ + +# NB If you add any more configure variables, +# update the sed rules in the dist target below. # Where to find the source code. $(srcdir) will be the doc/emacs subdirectory # of the source tree. This is set by configure's `--srcdir' option. @@ -35,8 +38,22 @@ buildinfodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc +prefix = @prefix@ +datarootdir = @datarootdir@ +datadir = @datadir@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +docdir = @docdir@ +dvidir = @dvidir@ +htmldir = @htmldir@ +pdfdir = @pdfdir@ +psdir = @psdir@ + MKDIR_P = @MKDIR_P@ +GZIP_PROG = @GZIP_PROG@ + +HTML_OPTS = --no-split --html + INFO_EXT=@INFO_EXT@ # Options used only when making info output. # --no-split is only needed because of MS-DOS. @@ -44,6 +61,9 @@ INFO_EXT=@INFO_EXT@ # http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01182.html INFO_OPTS=@INFO_OPTS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + # The makeinfo program is part of the Texinfo distribution. # Use --force so that it generates output even if there are errors. MAKEINFO = @MAKEINFO@ @@ -57,6 +77,10 @@ DVIPS = dvips ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" +DVI_TARGETS = emacs.dvi emacs-xtra.dvi +HTML_TARGETS = emacs.html +PDF_TARGETS = emacs.pdf emacs-xtra.pdf +PS_TARGETS = emacs.ps emacs-xtra.ps EMACS_XTRA= \ ${srcdir}/emacs-xtra.texi \ @@ -119,17 +143,21 @@ EMACSSOURCES= \ ${srcdir}/kmacro.texi \ $(EMACS_XTRA) -## This seems pointless. The info/ directory exists in both the -## repository and the release tarfiles. +## The info/ directory exists in release tarfiles but not the repository. mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi html pdf ps +.SUFFIXES: .ps .dvi + +.dvi.ps: + $(DVIPS) -o $@ $< + info: $(buildinfodir)/emacs$(INFO_EXT) -dvi: emacs.dvi -html: emacs.html -pdf: emacs.pdf -ps: emacs.ps +dvi: $(DVI_TARGETS) +html: $(HTML_TARGETS) +pdf: $(PDF_TARGETS) +ps: $(PS_TARGETS) # Note that all the Info targets build the Info files in srcdir. # There is no provision for Info files to exist in the build directory. @@ -142,21 +170,15 @@ $(buildinfodir)/emacs$(INFO_EXT): ${EMACSSOURCES} emacs.dvi: ${EMACSSOURCES} $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs.texi -emacs.ps: emacs.dvi - $(DVIPS) -o $@ emacs.dvi - emacs.pdf: ${EMACSSOURCES} $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs.texi emacs.html: ${EMACSSOURCES} - $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ ${srcdir}/emacs.texi + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/emacs.texi emacs-xtra.dvi: $(EMACS_XTRA) $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-xtra.texi -emacs-xtra.ps: emacs-xtra.dvi - $(DVIPS) -o $@ emacs-xtra.dvi - emacs-xtra.pdf: $(EMACS_XTRA) $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-xtra.texi @@ -169,12 +191,11 @@ mostlyclean: ## Products not in the release tarfiles. clean: mostlyclean - rm -f emacs.dvi emacs-xtra.dvi emacs.pdf emacs-xtra.pdf \ - emacs.ps emacs-xtra.ps - rm -rf emacs.html/ + rm -f $(DVI_TARGETS) $(HTML_TARGETS) $(PDF_TARGETS) $(PS_TARGETS) rm -f emacs-manual-${version}.tar* distclean: clean + rm -f Makefile ## In the standalone tarfile, the clean rule runs this. infoclean: @@ -195,8 +216,61 @@ dist: -e 's/^\(buildinfodir *=\).*/\1 ./' \ -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ + -e 's/@MAKE[I]NFO@/makeinfo/' -e 's/@MK[D]IR_P@/mkdir -p/' \ + -e 's/@IN[F]O_EXT@/.info/' -e 's/@IN[F]O_OPTS@//' \ ${srcdir}/Makefile.in > emacs-manual-${version}/Makefile + @if grep '@[a-zA-Z_]*@' emacs-manual-${version}/Makefile; then \ + echo "Unexpanded configure variables in Makefile?" 1>&2; exit 1; \ + fi tar -cf emacs-manual-${version}.tar emacs-manual-${version} rm -rf emacs-manual-${version} + +.PHONY: install-dvi install-html install-pdf install-ps install-doc + +install-dvi: dvi + umask 022; $(MKDIR_P) "$(DESTDIR)$(dvidir)" + $(INSTALL_DATA) $(DVI_TARGETS) "$(DESTDIR)$(dvidir)" +install-html: html + umask 022; $(MKDIR_P) "$(DESTDIR)$(htmldir)" + $(INSTALL_DATA) $(HTML_TARGETS) "$(DESTDIR)$(htmldir)" +install-pdf: pdf + umask 022;$(MKDIR_P) "$(DESTDIR)$(pdfdir)" + $(INSTALL_DATA) $(PDF_TARGETS) "$(DESTDIR)$(pdfdir)" +install-ps: ps + umask 022; $(MKDIR_P) "$(DESTDIR)$(psdir)" + for file in $(PS_TARGETS); do \ + $(INSTALL_DATA) $${file} "$(DESTDIR)$(psdir)"; \ + [ -n "${GZIP_PROG}" ] || continue; \ + rm -f "$(DESTDIR)$(psdir)/$${file}.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)$(psdir)/$${file}"; \ + done + +## Top-level Makefile installs the info pages. +install-doc: install-dvi install-html install-pdf install-ps + + +.PHONY: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps uninstall-doc + +uninstall-dvi: + for file in $(DVI_TARGETS); do \ + rm -f "$(DESTDIR)$(dvidir)/$${file}"; \ + done +uninstall-html: + for file in $(HTML_TARGETS); do \ + rm -f "$(DESTDIR)$(htmldir)/$${file}"; \ + done +uninstall-ps: + ext= ; [ -n "${GZIP_PROG}" ] && ext=.gz; \ + for file in $(PS_TARGETS); do \ + rm -f "$(DESTDIR)$(psdir)/$${file}$${ext}"; \ + done +uninstall-pdf: + for file in $(PDF_TARGETS); do \ + rm -f "$(DESTDIR)$(pdfdir)/$${file}"; \ + done + +uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps + + ### Makefile ends here diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi index cc16a5f7762..80a98ac3169 100644 --- a/doc/emacs/abbrevs.texi +++ b/doc/emacs/abbrevs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Abbrevs diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 17309f74408..0ec2cf8624a 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -1,6 +1,6 @@ -@c -*- coding: iso-latin-1 -*- +@c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1994-1997, 1999-2013 Free Software Foundation, Inc. +@c Copyright (C) 1994-1997, 1999-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @node Acknowledgments @@ -51,9 +51,9 @@ files. @item Michael Albinus wrote @file{dbus.el}, a package that implements the D-Bus message bus protocol; @file{zeroconf.el}, a mode for browsing -Avahi services; @file{xesam.el}, a Xesam-based search engine -interface; and @file{secrets.el}, an interface to keyring daemons for -storing confidential data. He and Kai Grojohann wrote the Tramp package, which +Avahi services; +and @file{secrets.el}, an interface to keyring daemons for +storing confidential data. He and Kai Großjohann wrote the Tramp package, which provides transparent remote file editing using rcp, ssh, ftp, and other network protocols. He and Daniel Pittman wrote @file{tramp-cache.el}. @@ -68,7 +68,7 @@ Joe Arceneaux wrote the original text property implementation, and implemented support for X11. @item -Emil strm, Milan Zamaza, and Stefan Bruda wrote @file{prolog.el}, +Emil Åström, Milan Zamaza, and Stefan Bruda wrote @file{prolog.el}, a mode for editing Prolog (and Mercury) code. @item @@ -104,7 +104,7 @@ footnotes in email messages; and @file{gnus-audio.el} and @item Alexander L. Belikoff, Sergey Berezin, Sacha Chua, David Edmondson, Noah Friedman, Andreas Fuchs, Mario Lang, Ben Mesander, Lawrence -Mitchell, Gergely Nagy, Michael Olson, Per Persson, Jorgen Schaefer, +Mitchell, Gergely Nagy, Michael Olson, Per Persson, Jorgen Schäfer, Alex Schroeder, and Tom Tromey wrote ERC, an advanced Internet Relay Chat client (for more information, see the file @file{CREDITS} in the ERC distribution). @@ -114,12 +114,16 @@ Scott Bender, Michael Brouwer, Christophe de Dinechin, Carl Edman, Christian Limpach and Adrian Robert developed and maintained the NeXTstep port of Emacs. +@item +Stephen Berman wrote @file{todo-mode.el} (based on the original version +by Oliver Seidel), a package for maintaining @file{TODO} list files. + @item Anna M. Bigatti wrote @file{cal-html.el}, which produces HTML calendars. @item -Ray Blaak and Simon South wrote @file{delphi.el}, a mode for editing -Delphi (Object Pascal) source code. +Ray Blaak and Simon South wrote @file{opascal.el}, a mode for editing +Object Pascal source code. @item Martin Blais, Stefan Merten, and David Goodger wrote @file{rst.el}, a @@ -166,7 +170,7 @@ David M. Brown wrote @file{array.el}, for editing arrays and other tabular data. @item -W@l{}odek Bzyl and Ryszard Kubiak wrote @file{ogonek.el}, a package for +Włodek Bzyl and Ryszard Kubiak wrote @file{ogonek.el}, a package for changing the encoding of Polish characters. @item @@ -260,7 +264,7 @@ text replace the current selection. Eric Ding wrote @file{goto-addr.el}, @item -Jan Djrv added support for the GTK+ toolkit and X drag-and-drop. +Jan Djärv added support for the GTK+ toolkit and X drag-and-drop. He also wrote @file{dynamic-setting.el}. @item @@ -268,11 +272,11 @@ Carsten Dominik wrote Ref@TeX{}, a package for setting up labels and cross-references in @LaTeX{} documents; and co-wrote IDLWAVE mode (q.v.). He was the original author of Org mode, for maintaining notes, todo lists, and project planning. Bastien Guerry subsequently took -over maintainership. Benjamin Andresen, Thomas Baumann, Joel Boehland, Jan Bcker, Lennart +over maintainership. Benjamin Andresen, Thomas Baumann, Joel Boehland, Jan Böcker, Lennart Borgman, Baoqiu Cui, Dan Davison, Christian Egli, Eric S. Fraga, Daniel German, Chris Gray, Konrad Hinsen, Tassilo Horn, Philip Jackson, Martyn Jago, Thorsten Jolitz, Jambunathan K, Tokuya Kameshima, Sergey Litvinov, David Maus, Ross Patterson, Juan Pechiar, Sebastian Rose, Eric Schulte, Paul Sexton, Ulf Stegemann, Andy Stewart, Christopher Suckling, David O'Toole, John Wiegley, Zhang Weize, -Piotr Zielinski, and others also wrote various Org mode components. +Piotr Zieliński, and others also wrote various Org mode components. For more information, @pxref{History and Acknowledgments,,, org, The Org Manual}. @item @@ -299,11 +303,10 @@ to VC and the calendar. @item Stephen Eglen wrote @file{mspools.el}, which tells you which Procmail -folders have mail waiting in them; and @file{iswitchb.el}, a feature -for incremental reading and completion of buffer names. +folders have mail waiting in them. @item -Torbjrn Einarsson wrote @file{f90.el}, a mode for Fortran 90 files. +Torbjörn Einarsson wrote @file{f90.el}, a mode for Fortran 90 files. @item Tsugutomo Enami co-wrote the support for international character sets. @@ -365,7 +368,7 @@ Kevin Gallagher rewrote and enhanced the EDT emulation, and wrote flow control. @item -Fabin E. Gallina rewrote @file{python.el}, the major mode for the +Fabián E. Gallina rewrote @file{python.el}, the major mode for the Python programming language used in Emacs 24.3 onwards. @item @@ -373,7 +376,7 @@ Kevin Gallo added multiple-frame support for Windows NT and wrote @file{w32-win.el}, support functions for the MS-Windows window system. @item -Juan Len Lahoz Garca wrote @file{wdired.el}, a package for +Juan León Lahoz García wrote @file{wdired.el}, a package for performing file operations by directly editing Dired buffers. @item @@ -510,9 +513,9 @@ He also wrote @file{network-stream.el}, for opening network processes; @file{url-queue.el}, for controlling parallel downloads of URLs; and implemented libxml2 support. Components of Gnus have also been written by: Nagy Andras, David -Blacka, Scott Byer, Ludovic Courts, Julien Danjou, Kevin Greiner, Kai -Grojohann, Joe Hildebrand, Paul Jarc, Simon Josefsson, Sascha -Ldecke, David Moore, Jim Radford, Benjamin Rutt, Raymond Scholz, +Blacka, Scott Byer, Ludovic Courtès, Julien Danjou, Kevin Greiner, Kai +Großjohann, Joe Hildebrand, Paul Jarc, Simon Josefsson, Sascha +Lüdecke, David Moore, Jim Radford, Benjamin Rutt, Raymond Scholz, Thomas Steffen, Reiner Steib, Didier Verna, Ilja Weis, Katsumi Yamaoka, Teodor Zlatanov, and others (@pxref{Contributors,,,gnus, the Gnus Manual}). @@ -553,7 +556,7 @@ S/MIME and Sieve components; and @file{tls.el} and @file{starttls.el} for the Transport Layer Security protocol. @item -Arne Jrgensen wrote @file{latexenc.el}, a package to +Arne Jørgensen wrote @file{latexenc.el}, a package to automatically guess the correct coding system in @LaTeX{} files. @item @@ -605,7 +608,7 @@ files and running a PostScript interpreter interactively from within Emacs. @item -Karel Kl@v{c} contributed SELinux support, for preserving the +Karel Klíč contributed SELinux support, for preserving the Security-Enhanced Linux context of files on backup and copy. @item @@ -635,7 +638,7 @@ R. Dodd. He also wrote @file{ls-lisp.el}, a Lisp emulation of the program. @item -David K@ringaccent{a}gedal wrote @file{tempo.el}, providing support for +David Kågedal wrote @file{tempo.el}, providing support for easy insertion of boilerplate text and other common constructions. @item @@ -694,7 +697,7 @@ directory-local variables; and the @code{info-finder} feature that creates a virtual Info manual of package keywords. @item -Kroly L@H{o}rentey wrote the ``multi-terminal'' code, which allows +Károly Lőrentey wrote the ``multi-terminal'' code, which allows Emacs to run on graphical and text terminals simultaneously. @item @@ -810,12 +813,11 @@ command with its arguments. Richard Mlynarik wrote @file{cl-indent.el}, a package for indenting Common Lisp code; @file{ebuff-menu.el}, an ``electric'' browser for buffer listings; @file{ehelp.el}, bindings for browsing help screens; -@file{rfc822.el}, a parser for E-mail addresses in the RFC-822 format, -used in mail messages and news articles; and @file{terminal.el}, a -terminal emulator for Emacs subprocesses. +and @file{rfc822.el}, a parser for E-mail addresses in the RFC-822 format, +used in mail messages and news articles. @item -Gerd Moellmann was the Emacs maintainer from the beginning of Emacs 21 +Gerd Möllmann was the Emacs maintainer from the beginning of Emacs 21 development until the release of 21.1. He wrote the new display engine used from Emacs 21 onwards, and the asynchronous timers facility. He also wrote @code{ebrowse}, the C@t{++} browser; @@ -880,7 +882,7 @@ and @code{winterm} terminal emulators; and @file{vc-dir.el}, displaying the status of version-controlled directories. @item -Hrvoje Niksic wrote @file{savehist.el}, for saving the minibuffer +Hrvoje Nikšić wrote @file{savehist.el}, for saving the minibuffer history between Emacs sessions. @item @@ -960,7 +962,7 @@ Fred Pierresteguy and Paul Reilly made Emacs work with X Toolkit widgets. @item -Franois Pinard, Greg McGary, and Bruno Haible wrote @file{po.el}, +François Pinard, Greg McGary, and Bruno Haible wrote @file{po.el}, support for PO translation files. @item @@ -975,7 +977,7 @@ minor mode for displaying a ruler in the header line; and structures. @item -Francesco A. Potorti wrote @file{cmacexp.el}, providing a command which +Francesco A. Potortì wrote @file{cmacexp.el}, providing a command which runs the C preprocessor on a region of a file and displays the results. He also expanded and redesigned the @code{etags} program. @@ -1058,8 +1060,7 @@ contributed extensively to the MS-Windows port of Emacs. @item Wolfgang Rupprecht wrote Emacs 19's floating-point support (including -@file{float-sup.el} and @file{floatfns.c}), and @file{sup-mouse.el}, -support for the Supdup mouse on lisp machines. +@file{float-sup.el} and @file{floatfns.c}). @item Kevin Ryde wrote @file{info-xref.el}, a library for checking @@ -1096,9 +1097,6 @@ Ronald S. Schnell wrote @file{dunnet.el}, a text adventure game. Philippe Schnoebelen wrote @file{gomoku.el}, a Go Moku game played against Emacs; and @file{mpuz.el}, a multiplication puzzle. -@item -Rainer Schoepf contributed to Alpha and OSF1 support. - @item Jan Schormann wrote @file{solitaire.el}, an implementation of the Solitaire game. @@ -1115,10 +1113,6 @@ wrote parts of the IRC client ERC (q.v.). @item Randal Schwartz wrote @file{pp.el}, a pretty-printer for lisp objects. -@item -Oliver Seidel wrote @file{todo-mode.el}, a package for maintaining -@file{TODO} list files. - @item Manuel Serrano wrote the Flyspell package, which does spell checking as you type. @@ -1224,7 +1218,7 @@ Olaf Sylvester wrote @file{bs.el}, a package for manipulating Emacs buffers. @item -Tibor @v{S}imko and Milan Zamazal wrote @file{slovak.el}, support for +Tibor Šimko and Milan Zamazal wrote @file{slovak.el}, support for editing text in Slovak language. @item @@ -1345,7 +1339,7 @@ mode for editing VHDL source code. John Wiegley wrote @file{align.el}, a set of commands for aligning text according to regular-expression based rules; @file{isearchb.el} for fast buffer switching; @file{timeclock.el}, a package for keeping track of -time spent on projects; the Bah' calendar support; +time spent on projects; the Bahá'í calendar support; @file{pcomplete.el}, a programmable completion facility; @file{remember.el}, a mode for jotting down things to remember; @file{eudcb-mab.el}, an address book backend for the Emacs Unified diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi index 7e2b1324ac9..dcab8b57aef 100644 --- a/doc/emacs/anti.texi +++ b/doc/emacs/anti.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2005-2013 Free Software Foundation, Inc. +@c Copyright (C) 2005-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Antinews @@ -89,7 +89,7 @@ scroll bars. Emacs no longer refers to GTK+ to set the default @item Setting the option @code{delete-by-moving-to-trash} to a -non-@code{nil} now causes all file deletions to use the system trash, +non-@code{nil} value now causes all file deletions to use the system trash, even temporary files created by Lisp programs; furthermore, the @kbd{M-x delete-file} and @kbd{M-x delete-directory} commands no longer accept prefix arguments to force true deletion. diff --git a/doc/emacs/arevert-xtra.texi b/doc/emacs/arevert-xtra.texi index f3b21c491d2..a13f59b69bd 100644 --- a/doc/emacs/arevert-xtra.texi +++ b/doc/emacs/arevert-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index b9bc391d1cf..27a8ba9438e 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Basic @@ -153,10 +153,17 @@ Move forward one character (@code{forward-char}). @item @key{right} @kindex RIGHT @findex right-char +@vindex visual-order-cursor-movement +@cindex cursor, visual-order motion This command (@code{right-char}) behaves like @kbd{C-f}, with one exception: when editing right-to-left scripts such as Arabic, it instead moves @emph{backward} if the current paragraph is a -right-to-left paragraph. @xref{Bidirectional Editing}. +right-to-left paragraph. @xref{Bidirectional Editing}. If +@code{visual-order-cursor-movement} is non-@code{nil}, this command +moves to the character that is to the right of the current screen +position, moving to the next or previous screen line as appropriate. +Note that this might potentially move point many buffer positions +away, depending on the surrounding bidirectional context. @item C-b @kindex C-b @@ -168,7 +175,10 @@ Move backward one character (@code{backward-char}). @findex left-char This command (@code{left-char}) behaves like @kbd{C-b}, except it moves @emph{forward} if the current paragraph is right-to-left. -@xref{Bidirectional Editing}. +@xref{Bidirectional Editing}. If @code{visual-order-cursor-movement} +is non-@code{nil}, this command moves to the character that is to the +left of the current screen position, moving to the previous or next +screen line as appropriate. @item C-n @itemx @key{down} @@ -225,7 +235,7 @@ Move backward one word (@code{backward-word}). @kindex C-LEFT @kindex M-LEFT @findex left-word -This command (@code{left-word}) behaves like @kbd{M-f}, except it +This command (@code{left-word}) behaves like @kbd{M-b}, except it moves @emph{forward} by one word if the current paragraph is right-to-left. @xref{Bidirectional Editing}. diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 2d3ff5b05d8..c96b657b481 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Buffers @@ -43,15 +43,15 @@ variables}---variables that can have a different value in each buffer. A buffer's size cannot be larger than some maximum, which is defined by the largest buffer position representable by @dfn{Emacs integers}. This is because Emacs tracks buffer positions using that data type. -For typical 64-bit machines, this maximum buffer size is @math{2^61 - -2} bytes, or about 2 EiB@. For typical 32-bit machines, the maximum is -usually @math{2^29 - 2} bytes, or about 512 MiB@. Buffer sizes are +For typical 64-bit machines, this maximum buffer size is @math{2^{61} - 2} +bytes, or about 2 EiB@. For typical 32-bit machines, the maximum is +usually @math{2^{29} - 2} bytes, or about 512 MiB@. Buffer sizes are also limited by the amount of memory in the system. @menu * Select Buffer:: Creating a new buffer or reselecting an old one. * List Buffers:: Getting a list of buffers that exist. -* Misc Buffer:: Renaming; changing read-onlyness; copying text. +* Misc Buffer:: Renaming; changing read-only status; copying text. * Kill Buffer:: Killing buffers you no longer need. * Several Buffers:: How to go through the list of all buffers and operate variously on several of them. @@ -174,7 +174,7 @@ List the existing buffers (@code{list-buffers}). @kindex C-x C-b @findex list-buffers To display a list of existing buffers, type @kbd{C-x C-b}. Each -line in the list shows one buffer's name, major mode and visited file. +line in the list shows one buffer's name, size, major mode and visited file. The buffers are listed in the order that they were current; the buffers that were current most recently come first. @@ -194,7 +194,7 @@ CRM Buffer Size Mode File % HELLO 1607 Fundamental ~/cvs/emacs/etc/HELLO % NEWS 481184 Outline ~/cvs/emacs/etc/NEWS *scratch* 191 Lisp Interaction - * *Messages* 1554 Fundamental + * *Messages* 1554 Messages @end smallexample @noindent @@ -598,7 +598,7 @@ convenient to switch between buffers. @menu * Uniquify:: Making buffer names unique with directory parts. -* Iswitchb:: Switching between buffers with substrings. +* Icomplete:: Fast minibuffer selection. * Buffer Menus:: Configurable buffer menu. @end menu @@ -608,32 +608,37 @@ convenient to switch between buffers. @cindex unique buffer names @cindex directories in buffer names When several buffers visit identically-named files, Emacs must give -the buffers distinct names. The usual method for making buffer names -unique adds @samp{<2>}, @samp{<3>}, etc. to the end of the buffer -names (all but one of them). +the buffers distinct names. The default method +(@code{uniquify-buffer-name-style} set to +@code{post-forward-angle-brackets}) for making buffer names unique +adds @samp{}, @samp{}, etc. to the end of the buffer +names. @vindex uniquify-buffer-name-style - Other methods work by adding parts of each file's directory to the -buffer name. To select one, load the library @file{uniquify} (e.g., -using @code{(require 'uniquify)}), and customize the variable -@code{uniquify-buffer-name-style} (@pxref{Easy Customization}). + There are several styles to make buffer names unique. To select +one, customize the variable @code{uniquify-buffer-name-style} +(@pxref{Easy Customization}). - To begin with, the @code{forward} naming method includes part of the -file's directory name at the beginning of the buffer name; using this -method, buffers visiting the files @file{/u/rms/tmp/Makefile} and + The @code{forward} naming method includes part of the file's +directory name at the beginning of the buffer name; using this method, +buffers visiting the files @file{/u/rms/tmp/Makefile} and @file{/usr/projects/zaphod/Makefile} would be named -@samp{tmp/Makefile} and @samp{zaphod/Makefile}, respectively (instead -of @samp{Makefile} and @samp{Makefile<2>}). +@samp{tmp/Makefile} and @samp{zaphod/Makefile}. In contrast, the @code{post-forward} naming method would call the -buffers @samp{Makefile|tmp} and @samp{Makefile|zaphod}, and the +buffers @samp{Makefile|tmp} and @samp{Makefile|zaphod}. The default +method @code{post-forward-angle-brackets} is like @code{post-forward} +except that it prepends the unique path in angle brackets. The @code{reverse} naming method would call them @samp{Makefile\tmp} and @samp{Makefile\zaphod}. The nontrivial difference between @code{post-forward} and @code{reverse} occurs when just one directory name is not enough to distinguish two files; then @code{reverse} puts the directory names in reverse order, so that @file{/top/middle/file} becomes @samp{file\middle\top}, while @code{post-forward} puts them in -forward order after the file name, as in @samp{file|top/middle}. +forward order after the file name, as in @samp{file|top/middle}. If +@code{uniquify-buffer-name-style} is set to @code{nil}, the buffer +names simply get a @samp{<2>} etc. prepended. This used to be the +default behavior in Emacs versions up to 24.4. Which rule to follow for putting the directory names in the buffer name is not very important if you are going to @emph{look} at the @@ -641,39 +646,31 @@ buffer names before you type one. But as an experienced user, if you know the rule, you won't have to look. And then you may find that one rule or another is easier for you to remember and apply quickly. -@node Iswitchb -@subsection Switching Between Buffers using Substrings +@node Icomplete +@subsection Fast minibuffer selection -@findex iswitchb-mode -@cindex Iswitchb mode -@cindex mode, Iswitchb -@kindex C-x b @r{(Iswitchb mode)} -@kindex C-x 4 b @r{(Iswitchb mode)} -@kindex C-x 5 b @r{(Iswitchb mode)} -@kindex C-x 4 C-o @r{(Iswitchb mode)} +@findex icomplete-mode +@cindex Icomplete mode - Iswitchb global minor mode provides convenient switching between -buffers using substrings of their names. It replaces the normal -definitions of @kbd{C-x b}, @kbd{C-x 4 b}, @kbd{C-x 5 b}, and @kbd{C-x -4 C-o} with alternative commands that are somewhat ``smarter''. + Icomplete global minor mode provides a convenient way to quickly select an +element among the possible completions in a minibuffer. When enabled, typing +in the minibuffer continuously displays a list of possible completions that +match the string you have typed. - When one of these commands prompts you for a buffer name, you can -type in just a substring of the name you want to choose. As you enter -the substring, Iswitchb mode continuously displays a list of buffers -that match the substring you have typed. - - At any time, you can type @key{RET} to select the first buffer in -the list. So the way to select a particular buffer is to make it the + At any time, you can type @key{C-j} to select the first completion in +the list. So the way to select a particular completion is to make it the first in the list. There are two ways to do this. You can type more -of the buffer name and thus narrow down the list, excluding unwanted -buffers above the desired one. Alternatively, you can use @kbd{C-s} -and @kbd{C-r} to rotate the list until the desired buffer is first. +of the completion name and thus narrow down the list, excluding unwanted +completions above the desired one. Alternatively, you can use @kbd{C-.} +and @kbd{C-,} to rotate the list until the desired buffer is first. - @key{TAB} while entering the buffer name performs completion on the -string you have entered, based on the displayed list of buffers. + @key{M-TAB} will select the first completion in the list, like @key{C-j} but +without exiting the minibuffer, so you can edit it further. This is typically +used when entering a file name, where @key{M-TAB} can be used a few times to +descend in the hierarchy of directories. - To enable Iswitchb mode, type @kbd{M-x iswitchb-mode}, or customize -the variable @code{iswitchb-mode} to @code{t} (@pxref{Easy + To enable Icomplete mode, type @kbd{M-x icomplete-mode}, or customize +the variable @code{icomplete-mode} to @code{t} (@pxref{Easy Customization}). @node Buffer Menus diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 1072d49ea20..a0ef9e80c8d 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Building @@ -618,12 +618,12 @@ associated with an identifier when the program is not executing. selecting stack frames, and stepping through the program. @table @kbd -@item C-x @key{SPC} -@kindex C-x SPC +@item C-x C-a C-b +@kindex C-x C-a C-b Set a breakpoint on the source line that point is on. @end table - @kbd{C-x @key{SPC}} (@code{gud-break}), when called in a source + @kbd{C-x C-a C-b} (@code{gud-break}), when called in a source buffer, sets a debugger breakpoint on the current source line. This command is available only after starting GUD@. If you call it in a buffer that is not associated with any debugger subprocess, it signals @@ -1348,6 +1348,7 @@ not from an existing Emacs buffer. @findex load @findex load-library +@vindex load-prefer-newer @cindex load path for Emacs Lisp If an Emacs Lisp file is installed in the Emacs Lisp @dfn{load path} (defined below), you can load it by typing @kbd{M-x load-library}, @@ -1356,15 +1357,18 @@ command prompts for a @dfn{library name} rather than a file name; it searches through each directory in the Emacs Lisp load path, trying to find a file matching that library name. If the library name is @samp{@var{foo}}, it tries looking for files named -@file{@var{foo}.elc}, @file{@var{foo}.el}, and lastly just -@file{@var{foo}}; the first one found is loaded. This command prefers -@file{.elc} files over @file{.el} files because compiled files load -and run faster. If it finds that @file{@var{lib}.el} is newer than -@file{@var{lib}.elc}, it issues a warning, in case someone made +@file{@var{foo}.elc}, @file{@var{foo}.el}, and @file{@var{foo}}. The +default behaviour is to load the first file found. This command +prefers @file{.elc} files over @file{.el} files because compiled files +load and run faster. If it finds that @file{@var{lib}.el} is newer +than @file{@var{lib}.elc}, it issues a warning, in case someone made changes to the @file{.el} file and forgot to recompile it, but loads the @file{.elc} file anyway. (Due to this behavior, you can save unfinished edits to Emacs Lisp source files, and not recompile until -your changes are ready for use.) +your changes are ready for use.) If you set the option +@code{load-prefer-newer} to a non-@code{nil} value, however, then +rather than the procedure described above, Emacs loads whichever +version of the file is newest. Emacs Lisp programs usually load Emacs Lisp files using the @code{load} function. This is similar to @code{load-library}, but is @@ -1422,6 +1426,7 @@ Emacs to crash. Set the variable @code{load-dangerous-libraries} to @section Evaluating Emacs Lisp Expressions @cindex Emacs Lisp mode @cindex mode, Emacs Lisp +@cindex evaluation, Emacs Lisp @findex emacs-lisp-mode Emacs Lisp mode is the major mode for editing Emacs Lisp. Its mode @@ -1471,13 +1476,17 @@ expression.) The command @kbd{C-x C-e} (@code{eval-last-sexp}) evaluates the Emacs Lisp expression preceding point in the buffer, and displays the value in the echo area. When the result of an evaluation is an -integer, you can type @kbd{C-x C-e} a second time to display the value -of the integer result in additional formats (octal, hexadecimal, and -character). +integer, it is displayed together with the value in other formats +(octal, hexadecimal, and character). If @kbd{M-:} or @kbd{C-x C-e} is given a prefix argument, it inserts the value into the current buffer at point, rather than displaying it -in the echo area. The argument's value does not matter. +in the echo area. If the prefix argument is zero, any integer output +is inserted together with its value in other formats (octal, +hexadecimal, and character). Such a prefix argument also prevents +abbreviation of the output according to the variables +@code{eval-expression-print-level} and @code{eval-expression-print-length} +(see below). @kindex C-M-x @r{(Emacs Lisp mode)} @findex eval-defun @@ -1511,9 +1520,11 @@ eval-buffer} is similar but evaluates the entire buffer. The options @code{eval-expression-print-level} and @code{eval-expression-print-length} control the maximum depth and length of lists to print in the result of the evaluation commands -before abbreviating them. @code{eval-expression-debug-on-error} -controls whether evaluation errors invoke the debugger when these -commands are used; its default is @code{t}. +before abbreviating them. Supplying a zero prefix argument to +@code{eval-expression} or @code{eval-last-sexp} causes lists to be +printed in full. @code{eval-expression-debug-on-error} controls +whether evaluation errors invoke the debugger when these commands are +used; its default is @code{t}. @node Lisp Interaction @section Lisp Interaction Buffers diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi index 023e4a2926c..82864859473 100644 --- a/doc/emacs/cal-xtra.texi +++ b/doc/emacs/cal-xtra.texi @@ -1,5 +1,5 @@ -@c This is part of the Emacs manual. -*- coding: iso-latin-1 -*- -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c This is part of the Emacs manual. -*- coding: utf-8 -*- +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the @@ -17,6 +17,7 @@ your personal tastes. @menu * Calendar Customizing:: Calendar layout and hooks. * Holiday Customizing:: Defining your own holidays. +* Mayan Calendar:: Moving to a date specified in a Mayan calendar. * Date Display Format:: Changing the format. * Time Display Format:: Changing the format. * Diary Customizing:: Defaults you can set. @@ -42,9 +43,12 @@ customize the variables @code{calendar-intermonth-header} and @code{calendar-intermonth-text} as described in their documentation. @vindex calendar-month-header +@vindex calendar-day-header-array The variable @code{calendar-month-header} controls the text that appears above each month in the calendar. By default, it shows the -month and year. +month and year. The variable @code{calendar-day-header-array} +controls the text that appears above each day's column in every month. +By default, it shows the first two letters of each day's name. @vindex calendar-holiday-marker @vindex diary-entry-marker @@ -67,7 +71,7 @@ the calendar). Starting the calendar runs the normal hook @code{calendar-initial-window-hook}. Recomputation of the calendar display does not run this hook. But if you leave the calendar with the -@kbd{q} command and reenter it, the hook runs again.@refill +@kbd{q} command and reenter it, the hook runs again. @vindex calendar-today-visible-hook @findex calendar-star-date @@ -203,7 +207,7 @@ the month (1 specifies the first occurrence, 2 the second occurrence, @minus{}1 the last occurrence, @minus{}2 the second-to-last occurrence, and so on). - You can specify holidays that occur on fixed days of the Bah', + You can specify holidays that occur on fixed days of the Bahá'í, Chinese, Hebrew, Islamic, and Julian calendars too. For example, @smallexample @@ -260,6 +264,99 @@ visible in the calendar window, with descriptive strings, like this: (((6 4 2012) "Lunar Eclipse") ((11 13 2012) "Solar Eclipse") ... ) @end smallexample +@node Mayan Calendar +@subsection Converting from the Mayan Calendar +@cindex Mayan calendar + + Here are the commands to select dates based on the Mayan calendar: + +@table @kbd +@item g m l +Move to a date specified by the long count calendar +(@code{calendar-mayan-goto-long-count-date}). +@item g m n t +Move to the next occurrence of a place in the +tzolkin calendar (@code{calendar-mayan-next-tzolkin-date}). +@item g m p t +Move to the previous occurrence of a place in the +tzolkin calendar (@code{calendar-mayan-previous-tzolkin-date}). +@item g m n h +Move to the next occurrence of a place in the +haab calendar (@code{calendar-mayan-next-haab-date}). +@item g m p h +Move to the previous occurrence of a place in the +haab calendar (@code{calendar-mayan-previous-haab-date}). +@item g m n c +Move to the next occurrence of a place in the +calendar round (@code{calendar-mayan-next-calendar-round-date}). +@item g m p c +Move to the previous occurrence of a place in the +calendar round (@code{calendar-mayan-previous-calendar-round-date}). +@end table + +@cindex Mayan long count + To understand these commands, you need to understand the Mayan calendars. +The @dfn{long count} is a counting of days with these units: + +@display +1 kin = 1 day@ @ @ 1 uinal = 20 kin@ @ @ 1 tun = 18 uinal +1 katun = 20 tun@ @ @ 1 baktun = 20 katun +@end display + +@kindex g m @r{(Calendar mode)} +@findex calendar-mayan-goto-long-count-date +@noindent +Thus, the long count date 12.16.11.16.6 means 12 baktun, 16 katun, 11 +tun, 16 uinal, and 6 kin. The Emacs calendar can handle Mayan long +count dates as early as 7.17.18.13.3, but no earlier. When you use the +@kbd{g m l} command, type the Mayan long count date with the baktun, +katun, tun, uinal, and kin separated by periods. + +@findex calendar-mayan-previous-tzolkin-date +@findex calendar-mayan-next-tzolkin-date +@cindex Mayan tzolkin calendar + The Mayan tzolkin calendar is a cycle of 260 days formed by a pair of +independent cycles of 13 and 20 days. Since this cycle repeats +endlessly, Emacs provides commands to move backward and forward to the +previous or next point in the cycle. Type @kbd{g m p t} to go to the +previous tzolkin date; Emacs asks you for a tzolkin date and moves point +to the previous occurrence of that date. Similarly, type @kbd{g m n t} +to go to the next occurrence of a tzolkin date. + +@findex calendar-mayan-previous-haab-date +@findex calendar-mayan-next-haab-date +@cindex Mayan haab calendar + The Mayan haab calendar is a cycle of 365 days arranged as 18 months +of 20 days each, followed by a 5-day monthless period. Like the tzolkin +cycle, this cycle repeats endlessly, and there are commands to move +backward and forward to the previous or next point in the cycle. Type +@kbd{g m p h} to go to the previous haab date; Emacs asks you for a haab +date and moves point to the previous occurrence of that date. +Similarly, type @kbd{g m n h} to go to the next occurrence of a haab +date. + +@c This is omitted because it is too long for smallbook format. +@c @findex calendar-mayan-previous-calendar-round-date +@findex calendar-mayan-next-calendar-round-date +@cindex Mayan calendar round + The Maya also used the combination of the tzolkin date and the haab +date. This combination is a cycle of about 52 years called a +@emph{calendar round}. If you type @kbd{g m p c}, Emacs asks you for +both a haab and a tzolkin date and then moves point to the previous +occurrence of that combination. Use @kbd{g m n c} to move point to the +next occurrence of a combination. These commands signal an error if the +haab/tzolkin date combination you have typed is impossible. + + Emacs uses strict completion +@iftex +(@pxref{Completion Exit,,, emacs, the Emacs Manual}) +@end iftex +@ifnottex +(@pxref{Completion Exit}) +@end ifnottex +whenever it asks you to type a Mayan name, so you don't have to worry +about spelling. + @node Date Display Format @subsection Date Display Format @vindex calendar-date-display-form @@ -420,7 +517,7 @@ the fourth pattern. @subsection Diary Entries Using non-Gregorian Calendars As well as entries based on the standard Gregorian calendar, your -diary can have entries based on Bah', Hebrew, or Islamic dates. +diary can have entries based on Bahá'í, Hebrew, or Islamic dates. Recognition of such entries can be time-consuming, however, and since most people don't use them, you must explicitly enable their use. If you want the diary to recognize Hebrew-date diary entries, for example, @@ -440,7 +537,7 @@ you must do this: @end smallexample @noindent -Similarly, for Islamic and Bah' entries, add +Similarly, for Islamic and Bahá'í entries, add @code{diary-islamic-list-entries} and @code{diary-islamic-mark-entries}, or @code{diary-bahai-list-entries} and @code{diary-bahai-mark-entries}. @@ -449,7 +546,7 @@ Similarly, for Islamic and Bah @vindex diary-islamic-entry-symbol These diary entries have the same formats as Gregorian-date diary entries; except that @code{diary-bahai-entry-symbol} (default @samp{B}) -must precede a Bah' date, @code{diary-hebrew-entry-symbol} (default +must precede a Bahá'í date, @code{diary-hebrew-entry-symbol} (default @samp{H}) a Hebrew date, and @code{diary-islamic-entry-symbol} (default @samp{I}) an Islamic date. Moreover, non-Gregorian month names may not be abbreviated (because the first three letters are often not unique). @@ -476,7 +573,7 @@ nonmarking if preceded by @code{diary-nonmarking-symbol} (default Here is a table of commands used in the calendar to create diary entries that match the selected date and other dates that are similar in -the Bah', Hebrew, or Islamic calendars: +the Bahá'í, Hebrew, or Islamic calendars: @table @kbd @item i h d @@ -537,7 +634,7 @@ example, to sort the entries by the dates they apply to. Ordinarily, the fancy diary buffer does not show days for which there are no diary entries, even if that day is a holiday. If you want such days to be shown in the fancy diary buffer, set the variable -@code{diary-list-include-blanks} to @code{t}.@refill +@code{diary-list-include-blanks} to @code{t}. The fancy diary buffer enables View mode @iftex @@ -851,7 +948,7 @@ Make a diary entry with today's equivalent Julian calendar date. @item %%(diary-astro-day-number) Make a diary entry with today's equivalent astronomical (Julian) day number. @item %%(diary-bahai-date) -Make a diary entry with today's equivalent Bah' calendar date. +Make a diary entry with today's equivalent Bahá'í calendar date. @item %%(diary-chinese-date) Make a diary entry with today's equivalent Chinese calendar date. @item %%(diary-coptic-date) diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index 4f4ec036ef9..ef6d44a968f 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi @@ -1,5 +1,5 @@ -@c This is part of the Emacs manual. -*- coding: iso-latin-1 -*- -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c This is part of the Emacs manual. -*- coding: utf-8 -*- +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Calendar/Diary @@ -304,6 +304,7 @@ Regenerate the calendar window (@code{calendar-redraw}). @item SPC Scroll the next window up (@code{scroll-other-window}). @item DEL +@itemx S-SPC Scroll the next window down (@code{scroll-other-window-down}). @item q Exit from calendar (@code{calendar-exit}). @@ -522,7 +523,7 @@ holidays centered around a different month, use @kbd{C-u M-x holidays}, which prompts for the month and year. The holidays known to Emacs include United States holidays and the -major Bah', Chinese, Christian, Islamic, and Jewish holidays; also the +major Bahá'í, Chinese, Christian, Islamic, and Jewish holidays; also the solstices and equinoxes. @findex list-holidays @@ -678,7 +679,6 @@ and from several other calendars. (aside from Gregorian). * To Other Calendar:: Converting the selected date to various calendars. * From Other Calendar:: Moving to a date specified in another calendar. -* Mayan Calendar:: Moving to a date specified in a Mayan calendar. @end menu @c FIXME perhaps most of the details should be moved to cal-xtra. @@ -760,8 +760,8 @@ days are named by combining one of ten ``celestial stems'' with one of twelve ``terrestrial branches'' for a total of sixty names that are repeated in a cycle of sixty. -@cindex Bah' calendar - The Bah' calendar system is based on a solar cycle of 19 months with +@cindex Bahá'í calendar + The Bahá'í calendar system is based on a solar cycle of 19 months with 19 days each. The four remaining ``intercalary'' days are placed between the 18th and 19th months. @@ -801,7 +801,7 @@ Display French Revolutionary date for selected day (@code{calendar-french-print-date}). @findex calendar-bahai-print-date @item p b -Display Bah' date for selected day +Display Bahá'í date for selected day (@code{calendar-bahai-print-date}). @findex calendar-chinese-print-date @item p C @@ -869,7 +869,7 @@ Move to a date specified in the Julian calendar Move to a date specified with an astronomical (Julian) day number (@code{calendar-astro-goto-day-number}). @item g b -Move to a date specified in the Bah' calendar +Move to a date specified in the Bahá'í calendar (@code{calendar-bahai-goto-date}). @item g h Move to a date specified in the Hebrew calendar @@ -913,93 +913,6 @@ years for the date given by point. If you are not in the calendar, this command first asks you for the date of death and the range of years, and then displays the list of yahrzeit dates. -@c FIXME move to emacs-xtra. -@node Mayan Calendar -@subsection Converting from the Mayan Calendar - - Here are the commands to select dates based on the Mayan calendar: - -@table @kbd -@item g m l -Move to a date specified by the long count calendar -(@code{calendar-mayan-goto-long-count-date}). -@item g m n t -Move to the next occurrence of a place in the -tzolkin calendar (@code{calendar-mayan-next-tzolkin-date}). -@item g m p t -Move to the previous occurrence of a place in the -tzolkin calendar (@code{calendar-mayan-previous-tzolkin-date}). -@item g m n h -Move to the next occurrence of a place in the -haab calendar (@code{calendar-mayan-next-haab-date}). -@item g m p h -Move to the previous occurrence of a place in the -haab calendar (@code{calendar-mayan-previous-haab-date}). -@item g m n c -Move to the next occurrence of a place in the -calendar round (@code{calendar-mayan-next-calendar-round-date}). -@item g m p c -Move to the previous occurrence of a place in the -calendar round (@code{calendar-mayan-previous-calendar-round-date}). -@end table - -@cindex Mayan long count - To understand these commands, you need to understand the Mayan calendars. -The @dfn{long count} is a counting of days with these units: - -@display -1 kin = 1 day@ @ @ 1 uinal = 20 kin@ @ @ 1 tun = 18 uinal -1 katun = 20 tun@ @ @ 1 baktun = 20 katun -@end display - -@kindex g m @r{(Calendar mode)} -@findex calendar-mayan-goto-long-count-date -@noindent -Thus, the long count date 12.16.11.16.6 means 12 baktun, 16 katun, 11 -tun, 16 uinal, and 6 kin. The Emacs calendar can handle Mayan long -count dates as early as 7.17.18.13.3, but no earlier. When you use the -@kbd{g m l} command, type the Mayan long count date with the baktun, -katun, tun, uinal, and kin separated by periods. - -@findex calendar-mayan-previous-tzolkin-date -@findex calendar-mayan-next-tzolkin-date -@cindex Mayan tzolkin calendar - The Mayan tzolkin calendar is a cycle of 260 days formed by a pair of -independent cycles of 13 and 20 days. Since this cycle repeats -endlessly, Emacs provides commands to move backward and forward to the -previous or next point in the cycle. Type @kbd{g m p t} to go to the -previous tzolkin date; Emacs asks you for a tzolkin date and moves point -to the previous occurrence of that date. Similarly, type @kbd{g m n t} -to go to the next occurrence of a tzolkin date. - -@findex calendar-mayan-previous-haab-date -@findex calendar-mayan-next-haab-date -@cindex Mayan haab calendar - The Mayan haab calendar is a cycle of 365 days arranged as 18 months -of 20 days each, followed by a 5-day monthless period. Like the tzolkin -cycle, this cycle repeats endlessly, and there are commands to move -backward and forward to the previous or next point in the cycle. Type -@kbd{g m p h} to go to the previous haab date; Emacs asks you for a haab -date and moves point to the previous occurrence of that date. -Similarly, type @kbd{g m n h} to go to the next occurrence of a haab -date. - -@c This is omitted because it is too long for smallbook format. -@c @findex calendar-mayan-previous-calendar-round-date -@findex calendar-mayan-next-calendar-round-date -@cindex Mayan calendar round - The Maya also used the combination of the tzolkin date and the haab -date. This combination is a cycle of about 52 years called a -@emph{calendar round}. If you type @kbd{g m p c}, Emacs asks you for -both a haab and a tzolkin date and then moves point to the previous -occurrence of that combination. Use @kbd{g m n c} to move point to the -next occurrence of a combination. These commands signal an error if the -haab/tzolkin date combination you have typed is impossible. - - Emacs uses strict completion (@pxref{Completion Exit}) whenever it -asks you to type a Mayan name, so you don't have to worry about -spelling. - @node Diary @section The Diary @cindex diary @@ -1435,7 +1348,7 @@ mean ``second'', @minus{}2 would mean ``second-to-last'', and so on). The month can be a single month or a list of months. Thus you could change the 11 above to @samp{'(1 2 3)} and have the entry apply to the last Thursday of January, February, and March. If the month is @code{t}, the -entry applies to all months of the year.@refill +entry applies to all months of the year. Each of the standard sexp diary entries takes an optional parameter specifying the name of a face or a single-character string to use when @@ -1542,7 +1455,8 @@ variety of other formats. messages. While viewing such a message in Rmail or Gnus, do @kbd{M-x diary-from-outlook} to import the entry. You can make this command recognize additional appointment message formats by customizing the -variable @code{diary-outlook-formats}. +variable @code{diary-outlook-formats}. Other mail clients can set +@code{diary-from-outlook-function} to an appropriate value. @c FIXME the name of the RFC is hardly very relevant. @cindex iCalendar support @@ -1702,11 +1616,11 @@ you. You can, however, customize the value of the variable then, only an explicit @kbd{M-x timeclock-out} or @kbd{M-x timeclock-change} will tell Emacs that the current interval is over. -@cindex @file{.timelog} file +@cindex @file{timelog} file @vindex timeclock-file @findex timeclock-reread-log The timeclock functions work by accumulating the data in a file -called @file{.timelog} in your home directory. You can specify a +called @file{~/.emacs.d/timelog}. You can specify a different name for this file by customizing the variable @code{timeclock-file}. If you edit the timeclock file manually, or if you change the value of any of timeclock's customizable variables, you diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 19b439afc7f..613d4e1836d 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Emacs Invocation @@ -10,6 +10,7 @@ @cindex switches (command line) @cindex startup (command line arguments) @cindex invocation (command line arguments) +@c FIXME: Document `--smid'? --xfq Emacs supports command line arguments to request various actions when invoking Emacs. These are for compatibility with other editors @@ -135,7 +136,14 @@ visited. @opindex -L @itemx --directory=@var{dir} @opindex --directory -Add directory @var{dir} to the variable @code{load-path}. +Prepend directory @var{dir} to the variable @code{load-path}. +If you specify multiple @samp{-L} options, Emacs preserves the +relative order; i.e., using @samp{-L /foo -L /bar} results in +a @code{load-path} of the form @code{("/foo" "/bar" @dots{})}. +If @var{dir} begins with @samp{:}, Emacs removes the @samp{:} and +appends (rather than prepends) the remainder to @code{load-path}. +(On MS Windows, use @samp{;} instead of @samp{:}; i.e., use +the value of @code{path-separator}.) @item -f @var{function} @opindex -f @@ -251,7 +259,8 @@ terminal's standard input stream (@code{stdin}) instead. but @file{site-start.el} is loaded nonetheless. It also causes Emacs to exit after processing all the command options. In addition, it disables auto-saving except in buffers for which auto-saving is -explicitly requested. +explicitly requested, and when saving files it omits the @code{fsync} +system call unless otherwise requested. @item --script @var{file} @opindex --script @@ -437,8 +446,8 @@ when you specify a relative directory name. @item DBUS_SESSION_BUS_ADDRESS Used by D-Bus when Emacs is compiled with it. Usually, there is no need to change it. Setting it to a dummy address, like -@samp{unix:path=/tmp/foo}, suppresses connections to the D-Bus session -bus. +@samp{unix:path=/dev/null}, suppresses connections to the D-Bus session +bus as well as autolaunching the D-Bus session bus if not running yet. @item EMACSDATA Directory for the architecture-independent files that come with Emacs. This is used to initialize the variable @code{data-directory}. @@ -446,13 +455,16 @@ This is used to initialize the variable @code{data-directory}. Directory for the documentation string file, which is used to initialize the Lisp variable @code{doc-directory}. @item EMACSLOADPATH -A colon-separated list of directories@footnote{ Here and below, +A colon-separated list of directories@footnote{Here and below, whenever we say ``colon-separated list of directories'', it pertains to Unix and GNU/Linux systems. On MS-DOS and MS-Windows, the directories are separated by semi-colons instead, since DOS/Windows -file names might include a colon after a drive letter.} to search for -Emacs Lisp files. If set, it overrides the usual initial value of the -@code{load-path} variable (@pxref{Lisp Libraries}). +file names might include a colon after a drive letter.} to search for +Emacs Lisp files. If set, it modifies the usual initial value of the +@code{load-path} variable (@pxref{Lisp Libraries}). An empty element +stands for the default value of @code{load-path}; e.g., using +@samp{EMACSLOADPATH="/tmp:"} adds @file{/tmp} to the front of +the default @code{load-path}. @item EMACSPATH A colon-separated list of directories to search for executable files. If set, Emacs uses this in addition to @env{PATH} (see below) when diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi index 1c0746a9dd0..1c9b7fc220d 100644 --- a/doc/emacs/commands.texi +++ b/doc/emacs/commands.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index fae61252724..781d58f193d 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Customization @@ -345,7 +345,7 @@ hidden, nor on subgroups that are hidden or not visible in the buffer. @kindex C-x C-c @r{(customization buffer)} @findex Custom-set @findex Custom-save - The command @kbd{C-c C-c} (@code{Custom-set}) is equivalent using to + The command @kbd{C-c C-c} (@code{Custom-set}) is equivalent to using the @samp{[Set for Current Session]} button. The command @kbd{C-x C-s} (@code{Custom-save}) is like using the @samp{[Save for Future Sessions]} button. @@ -1166,7 +1166,10 @@ conversion of this file. @xref{Coding Systems}. @item @code{unibyte} says to load or compile a file of Emacs Lisp in unibyte -mode, if the value is @code{t}. @xref{Disabling Multibyte}. +mode, if the value is @code{t}. @xref{Disabling Multibyte, , +Disabling Multibyte Characters, elisp, GNU Emacs Lisp Reference +Manual}. + @end itemize @noindent @@ -2185,7 +2188,7 @@ sequences are mandatory. @samp{\C-} can be used as a prefix for a control character, as in @samp{\C-s} for @acronym{ASCII} control-S, and @samp{\M-} can be used as a prefix for a Meta character, as in @samp{\M-a} for @kbd{Meta-A} or @samp{\M-\C-a} for -@kbd{Control-Meta-A}.@refill +@kbd{Control-Meta-A}. @xref{Init Non-ASCII}, for information about including non-@acronym{ASCII} in your init file. @@ -2448,7 +2451,7 @@ it is run on that type of terminal. For a terminal type named found by searching the directories @code{load-path} as usual and trying the suffixes @samp{.elc} and @samp{.el}. Normally it appears in the subdirectory @file{term} of the directory where most Emacs libraries are -kept.@refill +kept. The usual purpose of the terminal-specific library is to map the escape sequences used by the terminal's function keys onto more @@ -2463,7 +2466,7 @@ function keys that Termcap does not specify. before the first hyphen is significant in choosing the library name. Thus, terminal types @samp{aaa-48} and @samp{aaa-30-rv} both use the library @file{term/aaa}. The code in the library can use -@code{(getenv "TERM")} to find the full terminal type name.@refill +@code{(getenv "TERM")} to find the full terminal type name. @vindex term-file-prefix The library's name is constructed by concatenating the value of the diff --git a/doc/emacs/dired-xtra.texi b/doc/emacs/dired-xtra.texi index e0fec06ab1a..f8719e84de0 100644 --- a/doc/emacs/dired-xtra.texi +++ b/doc/emacs/dired-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index f4ca6c30a5a..f0db7b69205 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Dired @@ -281,9 +281,9 @@ say they are backup files---that is, files whose names end in the backup files for deletion: all but the oldest few and newest few backups of any one file. Normally, the number of newest versions kept for each file is given by the variable @code{dired-kept-versions} -(@strong{not} @code{kept-new-versions}; that applies only when -saving). The number of oldest versions to keep is given by the -variable @code{kept-old-versions}. +(@emph{not} @code{kept-new-versions}; that applies only when saving). +The number of oldest versions to keep is given by the variable +@code{kept-old-versions}. Period with a positive numeric argument, as in @kbd{C-u 3 .}, specifies the number of newest versions to keep, overriding @@ -1108,7 +1108,8 @@ can use hiding to temporarily exclude subdirectories from operations without having to remove the Dired marks on files in those subdirectories. -@xref{Dired Updating}, for how to insert or delete a subdirectory listing. +@xref{Subdirectories in Dired}, for how to insert a subdirectory +listing, and @pxref{Dired Updating} for how delete it. @node Dired Updating @section Updating the Dired Buffer @@ -1382,7 +1383,7 @@ file, the search wraps around to the first marked file. The command a regular expression search. @xref{Repeat Isearch}, for information about search repetition. -@cindex Adding to the kill ring in Dired. +@cindex adding to the kill ring in Dired @kindex w @r{(Dired)} @findex dired-copy-filename-as-kill The command @kbd{w} (@code{dired-copy-filename-as-kill}) puts the @@ -1403,6 +1404,19 @@ names into arguments for other Emacs commands. It also displays what it added to the kill ring, so you can use it to display the list of currently marked files in the echo area. +@kindex ( @r{(Dired)} +@findex dired-hide-details-mode +@vindex dired-hide-details-hide-symlink-targets +@vindex dired-hide-details-hide-information-lines +@cindex hiding details in Dired + The command @kbd{(} (@code{dired-hide-details-mode}) toggles whether +details, such as ownership or file permissions, are visible in the +current Dired buffer. By default, it also hides the targets of +symbolic links, and all lines other than the header line and +file/directory listings. To change this, customize the options +@code{dired-hide-details-hide-symlink-targets} and +@code{dired-hide-details-hide-information-lines}, respectively. + @cindex Dired and version control If the directory you are visiting is under version control (@pxref{Version Control}), then the normal VC diff and log commands diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index f5ec8946e1b..d53c80acafd 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @@ -428,8 +428,8 @@ it. @xref{Disabling}. screenfuls. It provides commands for scrolling through the buffer conveniently but not for changing it. Apart from the usual Emacs cursor motion commands, you can type @key{SPC} to scroll forward one -windowful, @key{DEL} to scroll backward, and @kbd{s} to start an -incremental search. +windowful, @key{S-SPC} or @key{DEL} to scroll backward, and @kbd{s} to +start an incremental search. @kindex q @r{(View mode)} @kindex e @r{(View mode)} @@ -710,6 +710,17 @@ This face determines the color of tool bar icons. @xref{Tool Bars}. @cindex customization of @code{menu} face This face determines the colors and font of Emacs's menus. @xref{Menu Bars}. +@item tty-menu-enabled-face +@cindex faces for text-mode menus +@cindex TTY menu faces +This face is used to display enabled menu items on text-mode +terminals. +@item tty-menu-disabled-face +This face is used to display disabled menu items on text-mode +terminals. +@item tty-menu-selected-face +This face is used to display on text-mode terminals the menu item that +would be selected if you click a mouse or press @key{RET}. @end table @node Text Scale @@ -732,9 +743,9 @@ determine which action to take. @kbd{C-x}. For instance, @kbd{C-x C-= C-= C-=} increases the face height by three steps. Each step scales the text height by a factor of 1.2; to change this factor, customize the variable -@code{text-scale-mode-step}. As an exception, a numeric argument of 0 +@code{text-scale-mode-step}. A numeric argument of 0 to the @code{text-scale-adjust} command restores the default height, -similar to typing @kbd{C-x C-0}. +the same as typing @kbd{C-x C-0}. @cindex increase buffer face height @findex text-scale-increase @@ -903,22 +914,32 @@ that you specify explicitly the regular expressions to highlight. You control them with these commands: @table @kbd -@item C-x w h @var{regexp} @key{RET} @var{face} @key{RET} +@item M-s h r @var{regexp} @key{RET} @var{face} @key{RET} +@itemx C-x w h @var{regexp} @key{RET} @var{face} @key{RET} +@kindex M-s h r @kindex C-x w h @findex highlight-regexp Highlight text that matches @var{regexp} using face @var{face} (@code{highlight-regexp}). The highlighting will remain as long as the buffer is loaded. For example, to highlight all occurrences of the word ``whim'' using the default face (a yellow background) -@kbd{C-x w h whim @key{RET} @key{RET}}. Any face can be used for +@kbd{M-s h r whim @key{RET} @key{RET}}. Any face can be used for highlighting, Hi Lock provides several of its own and these are pre-loaded into a list of default values. While being prompted for a face use @kbd{M-n} and @kbd{M-p} to cycle through them. +@vindex hi-lock-auto-select-face +Setting the option @code{hi-lock-auto-select-face} to a non-@code{nil} +value causes this command (and other Hi Lock commands that read faces) +to automatically choose the next face from the default list without +prompting. + You can use this command multiple times, specifying various regular expressions to highlight in different ways. -@item C-x w r @var{regexp} @key{RET} +@item M-s h u @var{regexp} @key{RET} +@itemx C-x w r @var{regexp} @key{RET} +@kindex M-s h u @kindex C-x w r @findex unhighlight-regexp Unhighlight @var{regexp} (@code{unhighlight-regexp}). @@ -926,13 +947,15 @@ Unhighlight @var{regexp} (@code{unhighlight-regexp}). If you invoke this from the menu, you select the expression to unhighlight from a list. If you invoke this from the keyboard, you use the minibuffer. It will show the most recently added regular -expression; use @kbd{M-p} to show the next older expression and -@kbd{M-n} to select the next newer expression. (You can also type the +expression; use @kbd{M-n} to show the next older expression and +@kbd{M-p} to select the next newer expression. (You can also type the expression by hand, with completion.) When the expression you want to unhighlight appears in the minibuffer, press @kbd{@key{RET}} to exit the minibuffer and unhighlight it. -@item C-x w l @var{regexp} @key{RET} @var{face} @key{RET} +@item M-s h l @var{regexp} @key{RET} @var{face} @key{RET} +@itemx C-x w l @var{regexp} @key{RET} @var{face} @key{RET} +@kindex M-s h l @kindex C-x w l @findex highlight-lines-matching-regexp @cindex lines, highlighting @@ -940,7 +963,31 @@ the minibuffer and unhighlight it. Highlight entire lines containing a match for @var{regexp}, using face @var{face} (@code{highlight-lines-matching-regexp}). -@item C-x w b +@item M-s h p @var{phrase} @key{RET} @var{face} @key{RET} +@itemx C-x w p @var{phrase} @key{RET} @var{face} @key{RET} +@kindex M-s h p +@kindex C-x w p +@findex highlight-phrase +@cindex phrase, highlighting +@cindex highlighting phrase +Highlight matches of @var{phrase}, using face @var{face} +(@code{highlight-phrase}). @var{phrase} can be any regexp, +but spaces will be replaced by matches to whitespace and +initial lower-case letters will become case insensitive. + +@item M-s h . +@itemx C-x w . +@kindex M-s h . +@kindex C-x w . +@findex highlight-symbol-at-point +@cindex symbol, highlighting +@cindex highlighting symbol at point +Highlight the symbol found near point, using the next available face +(@code{highlight-symbol-at-point}). + +@item M-s h w +@itemx C-x w b +@kindex M-s h w @kindex C-x w b @findex hi-lock-write-interactive-patterns Insert all the current highlighting regexp/face pairs into the buffer @@ -952,7 +999,9 @@ These patterns are extracted from the comments, if appropriate, if you invoke @kbd{M-x hi-lock-find-patterns}, or if you visit the file while Hi Lock mode is enabled (since that runs @code{hi-lock-find-patterns}). -@item C-x w i +@item M-s h f +@itemx C-x w i +@kindex M-s h f @kindex C-x w i @findex hi-lock-find-patterns Extract regexp/face pairs from comments in the current buffer @@ -985,12 +1034,15 @@ mode's symbol is a member of the list @code{hi-lock-exclude-modes}. @findex set-fringe-style @findex fringe-mode +@vindex fringe-mode @r{(variable)} On graphical displays, each Emacs window normally has narrow @dfn{fringes} on the left and right edges. The fringes are used to display symbols that provide information about the text in the window. You can type @kbd{M-x fringe-mode} to disable the fringes, or modify their width. This command affects fringes in all frames; to modify fringes on the selected frame only, use @kbd{M-x set-fringe-style}. +You can make your changes to the fringes permanent by customizing the +variable @code{fringe-mode}. The most common use of the fringes is to indicate a continuation line (@pxref{Continuation Lines}). When one line of text is split @@ -1279,7 +1331,7 @@ specify the mail file to check, or set for incoming mail (any nonempty regular file in the directory is considered as ``newly arrived mail''). -@cindex mail (on mode line) +@cindex battery status (on mode line) @findex display-battery-mode @vindex display-battery-mode @vindex battery-mode-line-format @@ -1427,8 +1479,12 @@ pixels tall), or @code{nil} (no cursor at all). @findex blink-cursor-mode @cindex cursor, blinking @cindex blinking cursor +@vindex blink-cursor-mode +@vindex blink-cursor-blinks @vindex blink-cursor-alist - To disable cursor blinking, change the variable + By default, the cursor stops blinking after 10 blinks. This can be +changed by customizing the variable @code{blink-cursor-blinks}. To +disable cursor blinking altogether, change the variable @code{blink-cursor-mode} to @code{nil} (@pxref{Easy Customization}), or add the line @code{(blink-cursor-mode 0)} to your init file. Alternatively, you can change how the cursor looks when it ``blinks diff --git a/doc/emacs/emacs-xtra.texi b/doc/emacs/emacs-xtra.texi index 40519e7e318..aa0683c1c32 100644 --- a/doc/emacs/emacs-xtra.texi +++ b/doc/emacs/emacs-xtra.texi @@ -11,7 +11,7 @@ @copying This manual describes specialized features of Emacs. -Copyright @copyright{} 2004--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -26,7 +26,7 @@ modify this GNU manual.'' @end quotation @end copying -@documentencoding ISO-8859-1 +@documentencoding UTF-8 @dircategory Emacs @direntry diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index bda7c0821c0..ee612643fea 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1,4 +1,4 @@ -\input texinfo @c -*- coding: iso-latin-1 -*- +\input texinfo @c -*- coding: utf-8 -*- @setfilename ../../info/emacs @settitle GNU Emacs Manual @@ -26,7 +26,7 @@ This is the @cite{GNU Emacs Manual}, @end ifnottex updated for Emacs version @value{EMACSVER}. -Copyright @copyright{} 1985--1987, 1993--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1985--1987, 1993--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -44,11 +44,11 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@documentencoding ISO-8859-1 +@documentencoding UTF-8 @dircategory Emacs @direntry -* Emacs: (emacs). The extensible self-documenting text editor. +* Emacs: (emacs). The extensible self-documenting text editor. @end direntry @c in general, keep the following line commented out, unless doing a @@ -111,10 +111,22 @@ Cover art by Etienne Suvasa; cover design by Matt Lee. @top The Emacs Editor Emacs is the extensible, customizable, self-documenting real-time -display editor. This Info file describes how to edit with Emacs and +display editor. This manual describes how to edit with Emacs and some of the ways to customize it; it corresponds to GNU Emacs version @value{EMACSVER}. +@c See `manual-html-mono' and `manual-html-node' in admin/admin.el. +@ifset WWW_GNU_ORG +@html +The homepage for GNU Emacs is at +http://www.gnu.org/software/emacs/.
          +To view this manual in other formats, click +here.
          +You can also purchase a printed copy from the +FSF store. +@end html +@end ifset + @ifinfo If you are reading this in Emacs, type @kbd{h} to read a basic introduction to the Info documentation system. @@ -178,6 +190,7 @@ Advanced Features * Rmail:: Reading mail in Emacs. * Gnus:: A flexible mail and news reader. * Document View:: Viewing PDF, PS and DVI files. +* EWW:: A web browser in Emacs. * Shell:: Executing shell commands from Emacs. * Emacs Server:: Using Emacs as an editing server. * Printing:: Printing hardcopies of buffers or regions. @@ -333,13 +346,14 @@ Yanking Registers -* Position Registers:: Saving positions in registers. -* Text Registers:: Saving text in registers. -* Rectangle Registers:: Saving rectangles in registers. -* Configuration Registers:: Saving window configurations in registers. -* Number Registers:: Numbers in registers. -* File Registers:: File names in registers. -* Bookmarks:: Bookmarks are like registers, but persistent. +* Position Registers:: Saving positions in registers. +* Text Registers:: Saving text in registers. +* Rectangle Registers:: Saving rectangles in registers. +* Configuration Registers:: Saving window configurations in registers. +* Number Registers:: Numbers in registers. +* File Registers:: File names in registers. +* Keyboard Macro Registers:: Keyboard macros in registers. +* Bookmarks:: Bookmarks are like registers, but persistent. Controlling the Display @@ -385,14 +399,14 @@ Searching and Replacement Incremental Search -* Basic Isearch:: Basic incremental search commands. -* Repeat Isearch:: Searching for the same string again. -* Error in Isearch:: When your string is not found. -* Special Isearch:: Special input in incremental search. -* Isearch Yank:: Commands that grab text into the search string - or else edit the search string. -* Isearch Scroll:: Scrolling during an incremental search. -* Isearch Minibuffer:: Incremental search of the minibuffer history. +* Basic Isearch:: Basic incremental search commands. +* Repeat Isearch:: Searching for the same string again. +* Error in Isearch:: When your string is not found. +* Special Isearch:: Special input in incremental search. +* Isearch Yank:: Commands that grab text into the search string + or else edit the search string. +* Not Exiting Isearch:: Prefix argument and scrolling commands. +* Isearch Minibuffer:: Incremental search of the minibuffer history. Replacement Commands @@ -479,7 +493,7 @@ Using Multiple Buffers * Select Buffer:: Creating a new buffer or reselecting an old one. * List Buffers:: Getting a list of buffers that exist. -* Misc Buffer:: Renaming; changing read-onlyness; copying text. +* Misc Buffer:: Renaming; changing read-only status; copying text. * Kill Buffer:: Killing buffers you no longer need. * Several Buffers:: How to go through the list of all buffers and operate variously on several of them. @@ -490,7 +504,7 @@ Using Multiple Buffers Convenience Features and Customization of Buffer Handling * Uniquify:: Making buffer names unique with directory parts. -* Iswitchb:: Switching between buffers with substrings. +* Icomplete:: Fast minibuffer selection. * Buffer Menus:: Configurable buffer menu. Multiple Windows @@ -533,7 +547,6 @@ Frames and Graphical Displays International Character Set Support * International Chars:: Basic concepts of multibyte characters. -* Disabling Multibyte:: Controlling whether to use multibyte characters. * Language Environments:: Setting things up for the language you use. * Input Methods:: Entering text characters not on your keyboard. * Select Input Method:: Specifying your choice of input methods. @@ -655,7 +668,7 @@ Editing Programs * Documentation:: Getting documentation of functions you plan to call. * Hideshow:: Displaying blocks selectively. * Symbol Completion:: Completion on symbol names of your program or language. -* Glasses:: Making identifiersLikeThis more readable. +* MixedCase Words:: Dealing with identifiersLikeThis. * Semantic:: Suite of editing tools based on source code parsing. * Misc for Programs:: Other Emacs features useful for editing programs. * C Modes:: Special commands of C, C++, Objective-C, @@ -787,6 +800,7 @@ Version Control * Old Revisions:: Examining and comparing old versions. * VC Change Log:: Viewing the VC Change Log. * VC Undo:: Canceling changes before or after committing. +* VC Ignore:: Ignore files under version control system. * VC Directory Mode:: Listing files managed by version control. * Branches:: Multiple lines of development. @ifnottex @@ -945,7 +959,6 @@ Conversion To and From Other Calendars (aside from Gregorian). * To Other Calendar:: Converting the selected date to various calendars. * From Other Calendar:: Moving to a date specified in another calendar. -* Mayan Calendar:: Moving to a date specified in a Mayan calendar. The Diary @@ -960,6 +973,7 @@ More advanced features of the Calendar and Diary * Calendar Customizing:: Calendar layout and hooks. * Holiday Customizing:: Defining your own holidays. +* Mayan Calendar:: Moving to a date specified in a Mayan calendar. * Date Display Format:: Changing the format. * Time Display Format:: Changing the format. * Diary Customizing:: Defaults you can set. @@ -1178,7 +1192,7 @@ X Options and Resources * Resources:: Using X resources with Emacs (in general). * Table of Resources:: Table of specific X resources that affect Emacs. * Lucid Resources:: X resources for Lucid menus. -* LessTif Resources:: X resources for LessTif and Motif menus. +* Motif Resources:: X resources for Motif and LessTif menus. * GTK resources:: Resources for GTK widgets. GTK resources @@ -1325,9 +1339,12 @@ If you find GNU Emacs useful, please @strong{send a donation} to the Free Software Foundation to support our work. Donations to the Free Software Foundation are tax deductible in the US@. If you use GNU Emacs at your workplace, please suggest that the company make a donation. -For more information on how you can help, see +To donate, see @url{https://my.fsf.org/donate/}. +For other ways in which you can help, see @url{http://www.gnu.org/help/help.html}. +@c The command view-order-manuals uses this anchor. +@anchor{Printed Books} We also sell hardcopy versions of this manual and @cite{An Introduction to Programming in Emacs Lisp}, by Robert J. Chassell. You can visit our online store at @url{http://shop.fsf.org/}. @@ -1351,35 +1368,35 @@ USA Contributors to GNU Emacs include Jari Aalto, Per Abrahamsen, Tomas Abrahamsson, Jay K. Adams, Alon Albert, Michael Albinus, Nagy -Andras, Benjamin Andresen, Ralf Angeli, Dmitry Antipov, Joe Arceneaux, Emil strm, +Andras, Benjamin Andresen, Ralf Angeli, Dmitry Antipov, Joe Arceneaux, Emil Åström, Miles Bader, David Bakhash, Juanma Barranquero, Eli Barzilay, Thomas Baumann, Steven L. Baur, Jay Belanger, Alexander L. Belikoff, Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Karl Berry, Anna M. Bigatti, Ray Blaak, Martin Blais, Jim Blandy, Johan -Bockgrd, Jan Bcker, Joel Boehland, Lennart Borgman, Per Bothner, +Bockgård, Jan Böcker, Joel Boehland, Lennart Borgman, Per Bothner, Terrence Brannon, Frank Bresz, Peter Breton, Emmanuel Briot, Kevin Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Stefan Bruda, -Georges Brun-Cottan, Joe Buehler, Scott Byer, W@l{}odek Bzyl, +Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl, Bill Carpenter, Per Cederqvist, Hans Chalupsky, Chris Chase, Bob Chassell, Andrew Choi, Chong Yidong, Sacha Chua, Stewart Clamen, James Clark, Mike Clarkson, Glynn Clements, Andrew Cohen, Daniel Colascione, -Edward O'Connor, Christoph Conrad, Ludovic Courts, Andrew Csillag, +Christoph Conrad, Ludovic Courtès, Andrew Csillag, Toby Cubitt, Baoqiu Cui, Doug Cutting, Mathias Dahl, Julien Danjou, Satyaki Das, Vivek Dasmohapatra, Dan Davison, Michael DeCorte, Gary Delp, Nachum Dershowitz, Dave Detlefs, Matthieu Devin, Christophe de Dinechin, Eri -Ding, Jan Djrv, Lawrence R. Dodd, Carsten Dominik, Scott Draves, +Ding, Jan Djärv, Lawrence R. Dodd, Carsten Dominik, Scott Draves, Benjamin Drieu, Viktor Dukhovni, Jacques Duthen, Dmitry Dzhus, John Eaton, Rolf Ebert, Carl Edman, David Edmondson, Paul Eggert, Stephen -Eglen, Christian Egli, Torbjrn Einarsson, Tsugutomo Enami, David +Eglen, Christian Egli, Torbjörn Einarsson, Tsugutomo Enami, David Engster, Hans Henrik Eriksen, Michael Ernst, Ata Etemadi, Frederick Farnbach, Oscar Figueiredo, Fred Fish, Steve Fisk, Karl Fogel, Gary Foster, Eric S. Fraga, Romain Francoise, Noah Friedman, Andreas Fuchs, Shigeru Fukaya, Hallvard Furuseth, Keith Gabryelski, Peter S. -Galbraith, Kevin Gallagher, Fabin E. Gallina, Kevin Gallo, Juan Len Lahoz Garca, +Galbraith, Kevin Gallagher, Fabián E. Gallina, Kevin Gallo, Juan León Lahoz García, Howard Gayle, Daniel German, Stephen Gildea, Julien Gilles, David Gillespie, Bob Glickstein, Deepak Goel, David De La Harpe Golden, Boris Goldowsky, David Goodger, Chris Gray, Kevin Greiner, Michelangelo Grigni, Odd -Gripenstam, Kai Grojohann, Michael Gschwind, Bastien Guerry, Henry +Gripenstam, Kai Großjohann, Michael Gschwind, Bastien Guerry, Henry Guillaume, Doug Gwyn, Bruno Haible, Ken'ichi Handa, Lars Hansen, Chris Hanson, Jesper Harder, Alexandru Harsanyi, K. Shane Hartman, John Heidemann, Jon K. Hellan, Magnus Henoch, Markus Heritsch, Dirk @@ -1388,35 +1405,35 @@ Jeffrey C. Honig, Tassilo Horn, Kurt Hornik, Tom Houlder, Joakim Hove, Denis Howe, Lars Ingebrigtsen, Andrew Innes, Seiichiro Inoue, Philip Jackson, Martyn Jago, Pavel Janik, Paul Jarc, Ulf Jasper, Thorsten Jolitz, Michael K. Johnson, Kyle Jones, Terry Jones, Simon -Josefsson, Alexandre Julliard, Arne Jrgensen, Tomoji Kagatani, +Josefsson, Alexandre Julliard, Arne Jørgensen, Tomoji Kagatani, Brewster Kahle, Tokuya Kameshima, Lute Kamstra, Ivan Kanis, David Kastrup, David Kaufman, Henry Kautz, Taichi Kawabata, Taro Kawagishi, Howard Kaye, Michael Kifer, Richard King, Peter Kleiweg, Karel -Kl@v{c}, Shuhei Kobayashi, Pavel Kobyakov, Larry K. Kolodney, David +Klíč, Shuhei Kobayashi, Pavel Kobyakov, Larry K. Kolodney, David M. Koppelman, Koseki Yoshinori, Robert Krawitz, Sebastian Kremer, -Ryszard Kubiak, Igor Kuzmin, David Kgedal, Daniel LaLiberte, Karl +Ryszard Kubiak, Igor Kuzmin, David Kågedal, Daniel LaLiberte, Karl Landstrom, Mario Lang, Aaron Larson, James R. Larus, Vinicius Jose Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Christian Limpach, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov, Francis Litterio, Sergey Litvinov, Emilio C. Lopes, -Martin Lorentzon, Dave Love, Eric Ludlam, Kroly L@H{o}rentey, Sascha -Ldecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie, +Martin Lorentzon, Dave Love, Eric Ludlam, Károly Lőrentey, Sascha +Lüdecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie, Christopher J. Madsen, Neil M. Mager, Ken Manheimer, Bill Mann, Brian Marick, Simon Marshall, Bengt Martensson, Charlie Martin, Yukihiro Matsumoto, Tomohiro Matsuyama, David Maus, Thomas May, Will Mengarini, David Megginson, Stefan Merten, Ben A. Mesander, Wayne Mesard, Brad -Miller, Lawrence Mitchell, Richard Mlynarik, Gerd Moellmann, Stefan +Miller, Lawrence Mitchell, Richard Mlynarik, Gerd Möllmann, Stefan Monnier, Keith Moore, Jan Moringen, Morioka Tomohiko, Glenn Morris, Don Morrison, Diane Murray, Riccardo Murri, Sen Nagata, Erik Naggum, Gergely Nagy, Nobuyoshi Nakada, Thomas Neumann, Mike Newton, Thien-Thi Nguyen, -Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Niksic, Jeff Norden, -Andrew Norman, Kentaro Ohkouchi, Christian Ohler, +Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Nikšić, Jeff Norden, +Andrew Norman, Edward O'Connor, Kentaro Ohkouchi, Christian Ohler, Kenichi Okada, Alexandre Oliva, Bob Olson, Michael Olson, Takaaki Ota, Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar, Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per Persson, Jens Petersen, Daniel Pfeiffer, Justus Piater, Richard L. -Pieri, Fred Pierresteguy, Franois Pinard, Daniel Pittman, Christian -Plaunt, Alexander Pohoyda, David Ponce, Francesco A. Potorti, +Pieri, Fred Pierresteguy, François Pinard, Daniel Pittman, Christian +Plaunt, Alexander Pohoyda, David Ponce, Francesco A. Potortì, Michael D. Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa, Ashwin Ram, Eric S. Raymond, Paul Reilly, Edward M. Reingold, David Reitter, Alex Rezinsky, Rob Riepel, Lara Rios, Adrian Robert, Nick @@ -1424,13 +1441,13 @@ Roberts, Roland B. Roberts, John Robinson, Denis B. Roegel, Danny Roozendaal, Sebastian Rose, William Rosenblatt, Markus Rost, Guillermo J. Rozas, Martin Rudalics, Ivar Rummelhoff, Jason Rumney, Wolfgang Rupprecht, Benjamin Rutt, Kevin Ryde, James B. Salem, Masahiko Sato, -Timo Savola, Jorgen Schaefer, Holger Schauer, William Schelter, Ralph +Timo Savola, Jorgen Schäfer, Holger Schauer, William Schelter, Ralph Schleicher, Gregor Schmid, Michael Schmidt, Ronald S. Schnell, Philippe Schnoebelen, Jan Schormann, Alex Schroeder, Stefan Schoef, -Rainer Schoepf, Raymond Scholz, Eric Schulte, Andreas Schwab, Randal +Rainer Schöpf, Raymond Scholz, Eric Schulte, Andreas Schwab, Randal Schwartz, Oliver Seidel, Manuel Serrano, Paul Sexton, Hovav Shacham, Stanislav Shalunov, Marc Shapiro, Richard Sharman, Olin Shivers, Tibor -@v{S}imko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith, +Šimko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith, David Smith, Paul D. Smith, Wilson Snyder, William Sommerfeld, Simon South, Andre Spiegel, Michael Staats, Thomas Steffen, Ulf Stegemann, Reiner Steib, Sam Steingold, Ake Stenhoff, Peter Stephenson, Ken @@ -1449,7 +1466,7 @@ Wohler, Steven A. Wood, Dale R. Worley, Francis J. Wright, Felix S. T. Wu, Tom Wurgler, Yamamoto Mitsuharu, Katsumi Yamaoka, Masatake Yamato, Jonathan Yavner, Ryan Yeske, Ilya Zakharevich, Milan Zamazal, Victor Zandy, Eli Zaretskii, Jamie Zawinski, Andrew Zhilin, -Shenghuo Zhu, Piotr Zielinski, Ian T. Zimmermann, Reto Zimmermann, +Shenghuo Zhu, Piotr Zieliński, Ian T. Zimmermann, Reto Zimmermann, Neal Ziring, Teodor Zlatanov, and Detlev Zundel. @end iftex @@ -1458,7 +1475,7 @@ Neal Ziring, Teodor Zlatanov, and Detlev Zundel. You are reading about GNU Emacs, the GNU incarnation of the advanced, self-documenting, customizable, extensible editor Emacs. -(The `G' in `GNU' is not silent.) +(The @samp{G} in @acronym{GNU, @acronym{GNU}'s Not Unix} is not silent.) We call Emacs @dfn{advanced} because it can do much more than simple insertion and deletion of text. It can control subprocesses, indent diff --git a/doc/emacs/emerge-xtra.texi b/doc/emacs/emerge-xtra.texi index 74775e51261..bb39136d067 100644 --- a/doc/emacs/emerge-xtra.texi +++ b/doc/emacs/emerge-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/entering.texi b/doc/emacs/entering.texi index bb89e6ffd8b..71b1fc839ac 100644 --- a/doc/emacs/entering.texi +++ b/doc/emacs/entering.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex @@ -74,11 +74,14 @@ up before reading @file{site-start.el}. @xref{Init File}, for information about @file{site-start.el}.} You can also force Emacs to display a file or directory at startup -by setting the variable @code{initial-buffer-choice} to a -non-@code{nil} value. (In that case, even if you specify one or more -files on the command line, Emacs opens but does not display them.) -The value of @code{initial-buffer-choice} should be the name of -the desired file or directory. +by setting the variable @code{initial-buffer-choice} to a string +naming that file or directory. The value of +@code{initial-buffer-choice} may also be a function which should +return a buffer which is then displayed. @code{initial-buffer-choice} +may also be @code{t} in which case the @file{*scratch*} buffer will be +shown. In any case, even if you specify one or more files on the +command line, Emacs opens but does not display them if +@code{initial-buffer-choice} is non-nil. @node Exiting @section Exiting Emacs diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 1f78747eaa6..3b9aefa332b 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Files @@ -286,6 +286,10 @@ exception, dropping a file into a window displaying a Dired buffer moves or copies the file into the displayed directory. For details, see @ref{Drag and Drop}, and @ref{Misc Dired Features}. + On text-mode terminals and on graphical displays when Emacs was +built without a GUI toolkit, you can visit files via the menu-bar +``File'' menu, which has a ``Visit New File'' item. + Each time you visit a file, Emacs automatically scans its contents to detect what character encoding and end-of-line convention it uses, and converts these to Emacs's internal encoding and end-of-line @@ -705,13 +709,27 @@ setting the latter variable, you can control how these modes handle final newlines. @vindex write-region-inhibit-fsync - When Emacs saves a file, it invokes the @code{fsync} system call to -force the data immediately out to disk. This is important for safety -if the system crashes or in case of power outage. However, it can be -disruptive on laptops using power saving, as it may force a disk -spin-up each time you save a file. If you accept an increased risk of -data loss, you can set @code{write-region-inhibit-fsync} to a -non-@code{nil} value to disable the synchronization. + Normally, when a program writes a file, the operating system briefly +caches the file's data in main memory before committing the data to +disk. This can greatly improve performance; for example, when running +on laptops, it can avoid a disk spin-up each time a file is written. +However, it risks data loss if the operating system crashes before +committing the cache to disk. + + To lessen this risk, Emacs can invoke the @code{fsync} system call +after saving a file. Using @code{fsync} does not eliminate the risk +of data loss, partly because many systems do not implement +@code{fsync} properly, and partly because Emacs's file-saving +procedure typically relies also on directory updates that might not +survive a crash even if @code{fsync} works properly. + + The @code{write-region-inhibit-fsync} variable controls whether +Emacs invokes @code{fsync} after saving a file. The variable's +default value is @code{nil} when Emacs is interactive, and @code{t} +when Emacs runs in batch mode. + + Emacs never uses @code{fsync} when writing auto-save files, as these +files might lose data anyway. @node Interlocking @subsection Protection against Simultaneous Editing @@ -734,9 +752,10 @@ file. @cindex locking files When you make the first modification in an Emacs buffer that is visiting a file, Emacs records that the file is @dfn{locked} by you. -(It does this by creating a specially-named symbolic link or regular -file with special contents in the same directory.) Emacs removes the -lock when you save the changes. The idea is that the file is locked +(It does this by creating a specially-named symbolic link@footnote{If +your file system does not support symbolic links, a regular file is +used.} with special contents in the same directory.) Emacs removes the lock +when you save the changes. The idea is that the file is locked whenever an Emacs buffer visiting it has unsaved changes. @vindex create-lockfiles @@ -1071,7 +1090,7 @@ of data with the command @kbd{M-x recover-file @key{RET} @var{file} restores the contents from its auto-save file @file{#@var{file}#}. You can then save with @kbd{C-x C-s} to put the recovered text into @var{file} itself. For example, to recover file @file{foo.c} from its -auto-save file @file{#foo.c#}, do:@refill +auto-save file @file{#foo.c#}, do: @example M-x recover-file @key{RET} foo.c @key{RET} @@ -1253,9 +1272,12 @@ minibuffer, and displays the differences between the two files in a buffer named @file{*diff*}. This works by running the @command{diff} program, using options taken from the variable @code{diff-switches}. The value of @code{diff-switches} should be a string; the default is -@code{"-c"} to specify a context diff. @xref{Top,, Diff, diff, -Comparing and Merging Files}, for more information about the -@command{diff} program. +@code{"-c"} to specify a context diff. +@c Note that the actual name of the info file is diffutils.info, +@c but it adds a dir entry for diff too. +@c On older systems, only "info diff" works, not "info diffutils". +@xref{Top,, Diff, diff, Comparing and Merging Files}, for more +information about the @command{diff} program. The output of the @code{diff} command is shown using a major mode called Diff mode. @xref{Diff Mode}. @@ -1398,6 +1420,7 @@ In a multi-file patch, kill the current file part. @item C-c C-a @findex diff-apply-hunk +@cindex patches, applying Apply this hunk to its target file (@code{diff-apply-hunk}). With a prefix argument of @kbd{C-u}, revert this hunk. @@ -1922,10 +1945,9 @@ point. Partial Completion mode offers other features extending @findex image-mode @findex image-toggle-display -@findex image-toggle-animation +@findex image-next-file +@findex image-previous-file @cindex images, viewing -@cindex image animation -@cindex animated images Visiting image files automatically selects Image mode. In this major mode, you can type @kbd{C-c C-c} (@code{image-toggle-display}) to toggle between displaying the file as an image in the Emacs buffer, @@ -1934,10 +1956,33 @@ Displaying the file as an image works only if Emacs is compiled with support for displaying such images. If the displayed image is wider or taller than the frame, the usual point motion keys (@kbd{C-f}, @kbd{C-p}, and so forth) cause different parts of the image to be -displayed. If the image can be animated, the command @kbd{RET} +displayed. You can press @kbd{n} (@code{image-next-file}) and @kbd{p} +(@code{image-previous-file}) to visit the next image file and the +previous image file in the same directory, respectively. + +@findex image-toggle-animation +@findex image-next-frame +@findex image-previous-frame +@findex image-goto-frame +@findex image-increase-speed +@findex image-decrease-speed +@findex image-reset-speed +@findex image-reverse-speed +@vindex image-animate-loop +@cindex image animation +@cindex animated images + If the image can be animated, the command @kbd{RET} (@code{image-toggle-animation}) starts or stops the animation. Animation plays once, unless the option @code{image-animate-loop} is -non-@code{nil}. +non-@code{nil}. With @kbd{f} (@code{image-next-frame}) and @kbd{b} +(@code{image-previous-frame}) you can step through the individual +frames. Both commands accept a numeric prefix to step through several +frames at once. You can go to a specific frame with @kbd{F} +(@code{image-goto-frame}). Typing @kbd{a +} +(@code{image-increase-speed}) increases the speed of the animation, +@kbd{a -} (@code{image-decrease-speed}) decreases it, and @kbd{a r} +(@code{image-reverse-speed}) reverses it. The command @kbd{a 0} +(@code{image-reset-speed}) resets the speed to the original value. @cindex ImageMagick support @vindex imagemagick-enabled-types @@ -1965,6 +2010,7 @@ thumbnails. @xref{Image-Dired}. @node Filesets @section Filesets @cindex filesets +@cindex sets of files @findex filesets-init If you regularly edit a certain group of files, you can define them diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index b6eb1ed11a2..a5b571d2088 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Fixit @@ -190,7 +190,7 @@ point forward across three other characters. It would change @samp{f@point{}oobar} into @samp{oobf@point{}ar}. This is equivalent to repeating @kbd{C-t} three times. @kbd{C-u - 4 M-t} moves the word before point backward across four words. @kbd{C-u - C-M-t} would cancel -the effect of plain @kbd{C-M-t}.@refill +the effect of plain @kbd{C-M-t}. A numeric argument of zero is assigned a special meaning (because otherwise a command with a repeat count of zero would do nothing): to @@ -216,7 +216,7 @@ Convert last word to lower case with capital initial. the word case-conversion commands @kbd{M-l}, @kbd{M-u} and @kbd{M-c} have a special feature when used with a negative argument: they do not move the cursor. As soon as you see you have mistyped the last word, you can simply -case-convert it and go on typing. @xref{Case}.@refill +case-convert it and go on typing. @xref{Case}. @node Spelling @section Checking and Correcting Spelling diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi index da618fc4841..79ea410038a 100644 --- a/doc/emacs/fortran-xtra.texi +++ b/doc/emacs/fortran-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the @@ -575,7 +575,7 @@ yourself. To use them, you must turn on Abbrev mode. semicolon. For example, one built-in Fortran abbrev is @samp{;c} for @samp{continue}. If you insert @samp{;c} and then insert a punctuation character such as a space or a newline, the @samp{;c} expands automatically -to @samp{continue}, provided Abbrev mode is enabled.@refill +to @samp{continue}, provided Abbrev mode is enabled. Type @samp{;?} or @samp{;C-h} to display a list of all the built-in Fortran abbrevs and what they stand for. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 5365bdc6e03..b9925e57f4a 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Frames @@ -39,7 +39,7 @@ doing so on GNU and Unix systems; and @ifnottex @pxref{MS-DOS Mouse}, @end ifnottex -for doing so on MS-DOS). +for doing so on MS-DOS). Menus are supported on all text terminals. @menu * Mouse Commands:: Moving, cutting, and pasting, with the mouse. @@ -136,7 +136,7 @@ the position where you clicked and inserts the contents of the primary selection (@code{mouse-yank-primary}). @xref{Primary Selection}. This behavior is consistent with other X applications. Alternatively, you can rebind @kbd{Mouse-2} to @code{mouse-yank-at-click}, which -performs a yank at point. +performs a yank at the position you click. @vindex mouse-yank-at-point If you change the variable @code{mouse-yank-at-point} to a @@ -453,6 +453,16 @@ cycles through all the frames on your terminal. @kindex C-x 5 1 @findex delete-other-frames Delete all frames on the current terminal, except the selected one. + +@item M- +@kindex M- +@findex toggle-frame-maximized +Toggle maximization state of the current frame. + +@item +@kindex +@findex toggle-frame-fullscreen +Toggle fullscreen mode of the current frame. @end table The @kbd{C-x 5 0} (@code{delete-frame}) command deletes the selected @@ -920,6 +930,17 @@ or disable the scroll bars (@pxref{Resources}). To control the scroll bar width, change the @code{scroll-bar-width} frame parameter (@pxref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}). +@vindex scroll-bar-adjust-thumb-portion +@cindex overscrolling +If you're using Emacs on X (with GTK+ or Motif), you can customize the +variable @code{scroll-bar-adjust-thumb-portion} to control +@dfn{overscrolling} of the scroll bar, i.e. dragging the thumb down even +when the end of the buffer is visible. If its value is +non-@code{nil}, the scroll bar can be dragged downwards even if the +end of the buffer is shown; if @code{nil}, the thumb will be at the +bottom when the end of the buffer is shown. You can not over-scroll +when the entire buffer is visible. + @node Drag and Drop @section Drag and Drop @cindex drag and drop diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi index ee41313c10f..4384a02cd6f 100644 --- a/doc/emacs/glossary.texi +++ b/doc/emacs/glossary.texi @@ -1,9 +1,10 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Glossary @unnumbered Glossary +@cindex glossary @table @asis @anchor{Glossary---Abbrev} @@ -18,7 +19,10 @@ Aborting means getting out of a recursive edit (q.v.). The commands @kbd{C-]} and @kbd{M-x top-level} are used for this. @xref{Quitting}. -@c FIXME? Active Region +@item Active Region +Setting the mark (q.v.@:) at a position in the text also activates it. +When the mark is active, we call the region an active region. +@xref{Mark}. @item Alt Alt is the name of a modifier bit that a keyboard input character may @@ -252,7 +256,7 @@ abbreviation for a name into the entire name. Completion is done for minibuffer (q.v.@:) arguments when the set of possible valid inputs is known; for example, on command names, buffer names, and file names. Completion usually occurs when @key{TAB}, @key{SPC} or -@key{RET} is typed. @xref{Completion}.@refill +@key{RET} is typed. @xref{Completion}. @anchor{Glossary---Continuation Line} @item Continuation Line @@ -869,6 +873,7 @@ The Emacs major modes are a mutually exclusive set of options, each of which configures Emacs for editing a certain sort of text. Ideally, each programming language has its own major mode. @xref{Major Modes}. +@c FIXME: Mention margins for filling? @item Margin The space between the usable part of a window (including the fringe) and the window edge. @@ -948,9 +953,15 @@ another. The usual way to move text is by killing (q.v.@:) it and then yanking (q.v.@:) it. @xref{Killing}. @item MULE -MULE refers to the Emacs features for editing multilingual -non-@acronym{ASCII} text using multibyte characters (q.v.). -@xref{International}. +@cindex MULE +Prior to Emacs 23, @acronym{MULE} was the name of a software package +which provided a @dfn{MULtilingual Enhancement} to Emacs, by adding +support for multiple character sets (q.v.). @acronym{MULE} was later +integrated into Emacs, and much of it was replaced when Emacs gained +internal Unicode support in version 23. + +Some parts of Emacs that deal with character set support still use the +@acronym{MULE} name. @xref{International}. @item Multibyte Character A multibyte character is a character that takes up several bytes in a @@ -1365,7 +1376,11 @@ are not in a recursive editing level (q.v.@:) or the minibuffer (q.v.), and not in the middle of a command. You can get back to top level by aborting (q.v.@:) and quitting (q.v.). @xref{Quitting}. -@c FIXME? Transient Mark Mode +@item Transient Mark Mode +The default behavior of the mark (q.v.@:) and region (q.v.), in which +setting the mark activates it and highlights the region, is called +Transient Mark mode. In GNU Emacs 23 and onwards, it is enabled by +default. @xref{Disabled Transient Mark}. @item Transposition Transposing two units of text means putting each one into the place diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi index 1e829a3244f..4eb3672bfde 100644 --- a/doc/emacs/gnu.texi +++ b/doc/emacs/gnu.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1985-1987, 1993, 1995, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993, 1995, 2001-2014 Free Software @c Foundation, Inc. @c @c Permission is granted to anyone to make or distribute verbatim copies diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 75b250d0f40..11694191f9c 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Help @@ -55,11 +55,12 @@ This displays the available Emacs packages based on keywords. @xref{Package Keywords}. @end table - @kbd{C-h} or @key{F1} means ``help'' in various other contexts as -well. For instance, you can type them after a prefix key to view a -list of the keys that can follow the prefix key. (A few prefix keys -don't support @kbd{C-h} in this way, because they define other -meanings for it, but they all support @key{F1} for help.) + @kbd{C-h}, @key{F1}, or @kbd{?} means ``help'' in various other +contexts as well. For instance, you can type them after a prefix key +to view a list of the keys that can follow the prefix key. (A few +prefix keys don't support @kbd{C-h} or @kbd{?} in this way, because +they define other meanings for it, but they all support @key{F1} for +help.) @menu * Help Summary:: Brief list of all Help commands. @@ -376,8 +377,9 @@ alphabetical order, change the variable @section Help Mode Commands Help buffers provide the same commands as View mode (@pxref{View -Mode}); for instance, @key{SPC} scrolls forward, and @key{DEL} scrolls -backward. A few special commands are also provided: +Mode}); for instance, @key{SPC} scrolls forward, and @key{DEL} or +@kbd{S-SPC} scrolls backward. A few special commands are also +provided: @table @kbd @item @key{RET} @@ -456,7 +458,9 @@ buffer (@pxref{Package Menu}). @kindex C-h P @kbd{C-h P} (@code{describe-package}) prompts for the name of a package, and displays a help buffer describing the attributes of the -package and the features that it implements. +package and the features that it implements. The buffer lists the +keywords that relate to the package in the form of buttons. Click on +a button to see other packages related to that keyword. @node Language Help @section Help for International Language Support @@ -535,6 +539,8 @@ describes the commands and features that are changed in this mode. @kindex C-h b @findex describe-bindings +@kindex C-h s +@findex describe-syntax @kbd{C-h b} (@code{describe-bindings}) and @kbd{C-h s} (@code{describe-syntax}) show other information about the current environment within Emacs. @kbd{C-h b} displays a list of all the key @@ -547,11 +553,13 @@ Emacs Lisp Reference Manual}). @findex describe-prefix-bindings You can get a list of subcommands for a particular prefix key by -typing @kbd{C-h} (@code{describe-prefix-bindings}) after the prefix -key. (There are a few prefix keys for which this does not -work---those that provide their own bindings for @kbd{C-h}. One of -these is @key{ESC}, because @kbd{@key{ESC} C-h} is actually -@kbd{C-M-h}, which marks a defun.) +typing @kbd{C-h}, @kbd{?}, or @kbd{F1} +(@code{describe-prefix-bindings}) after the prefix key. (There are a +few prefix keys for which not all of these keys work---those that +provide their own bindings for one of them. One of these prefix keys +is @key{ESC} in combination with @kbd{C-h}, because @kbd{ESC C-h} is +actually @kbd{C-M-h}, which marks a defun. However, @kbd{ESC F1} and +@kbd{ESC ?} work fine.) @node Help Files @section Help Files diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index 72ec68812ce..9aec6202de6 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Indentation @@ -127,14 +127,26 @@ that column number. @kindex C-x TAB @findex indent-rigidly @cindex remove indentation -Shift each line in the region by a fixed distance, to the right or -left (@code{indent-rigidly}). The distance to move is determined by -the numeric argument (positive to move rightward, negative to move -leftward). +This command is used to change the indentation of all lines that begin +in the region, moving the affected lines as a ``rigid'' unit. -This command can be used to remove all indentation from the lines in -the region, by invoking it with a large negative argument, -e.g., @kbd{C-u -1000 C-x @key{TAB}}. +If called with no argument, the command activates a transient mode for +adjusting the indentation of the affected lines interactively. While +this transient mode is active, typing @key{LEFT} or @key{RIGHT} +indents leftward and rightward, respectively, by one space. You can +also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to indent leftward +or rightward to the next tab stop (@pxref{Tab Stops}). Typing any +other key disables the transient mode, and resumes normal editing. + +If called with a prefix argument @var{n}, this command indents the +lines forward by @var{n} spaces (without enabling the transient mode). +Negative values of @var{n} indent backward, so you can remove all +indentation from the lines in the region using a large negative +argument, like this: + +@smallexample +C-u -999 C-x @key{TAB} +@end smallexample @end table @node Tab Stops @@ -145,10 +157,12 @@ e.g., @kbd{C-u -1000 C-x @key{TAB}}. Emacs defines certain column numbers to be @dfn{tab stops}. These are used as stopping points by @key{TAB} when inserting whitespace in Text mode and related modes (@pxref{Indentation}), and by commands -like @kbd{M-i} (@pxref{Indentation Commands}). By default, tab stops -are located every 8 columns. These positions are stored in the -variable @code{tab-stop-list}, whose value is a list of column numbers -in increasing order. +like @kbd{M-i} (@pxref{Indentation Commands}). The variable +@code{tab-stop-list} controls these positions. The default value +is @code{nil}, which means a tab stop every 8 columns. The value +can also be a list of column numbers (in increasing order) at which to +place tab stops. Emacs extends the list forever by repeating the +difference between the last and next-to-last elements. @findex edit-tab-stops @kindex C-c C-c @r{(Edit Tab Stops)} @@ -167,10 +181,14 @@ To install changes, type C-c C-c @noindent The first line contains a colon at each tab stop. The numbers on the next two lines are present just to indicate where the colons are. +If the value of @code{tab-stop-list} is @code{nil}, as it is by default, +no colons are displayed initially. You can edit this buffer to specify different tab stops by placing colons on the desired columns. The buffer uses Overwrite mode -(@pxref{Minor Modes}). When you are done, type @kbd{C-c C-c} to make +(@pxref{Minor Modes}). Remember that Emacs will extend the list of +tab stops forever by repeating the difference between the last two +explicit stops that you place. When you are done, type @kbd{C-c C-c} to make the new tab stops take effect. Normally, the new tab stop settings apply to all buffers. However, if you have made the @code{tab-stop-list} variable local to the buffer where you called @@ -236,5 +254,6 @@ indentation; otherwise, it inserts a tab character. @cindex mode, Electric Indent @findex electric-indent-mode Electric Indent mode is a global minor mode that automatically -indents the line after every @key{RET} you type. To toggle this minor -mode, type @kbd{M-x electric-indent-mode}. +indents the line after every @key{RET} you type. This mode is enabled +by default. To toggle this minor mode, type @kbd{M-x +electric-indent-mode}. diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 051bfe3eae8..1826c668aa5 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @@ -113,6 +113,7 @@ Region}). @findex delete-horizontal-space @kindex M-SPC @findex just-one-space +@findex cycle-spacing The other delete commands are those that delete only whitespace characters: spaces, tabs and newlines. @kbd{M-\} (@code{delete-horizontal-space}) deletes all the spaces and tab @@ -123,7 +124,11 @@ point, regardless of the number of spaces that existed previously (even if there were none before). With a numeric argument @var{n}, it leaves @var{n} spaces before point if @var{n} is positive; if @var{n} is negative, it deletes newlines in addition to spaces and tabs, -leaving @var{-n} spaces before point. +leaving @var{-n} spaces before point. The command @code{cycle-spacing} +acts like a more flexible version of @code{just-one-space}. It +does different things if you call it repeatedly in succession. +The first call acts like @code{just-one-space}, the next removes +all whitespace, and a third call restores the original whitespace. @kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines after the current line. If the current line is blank, it deletes all @@ -134,6 +139,17 @@ the current line). On a solitary blank line, it deletes that line. previous line, by deleting a newline and all surrounding spaces, usually leaving a single space. @xref{Indentation,M-^}. +@c Not really sure where to put this... +@findex delete-duplicate-lines + The command @code{delete-duplicate-lines} searches the region for +identical lines, and removes all but one copy of each. Normally it +keeps the first instance of each repeated line, but with a @kbd{C-u} +prefix argument it keeps the last. With a @kbd{C-u C-u} prefix +argument, it only searches for adjacent identical lines. This is a +more efficient mode of operation, useful when the lines have already +been sorted. With a @kbd{C-u C-u C-u} prefix argument, it retains +repeated blank lines. + @node Killing by Lines @subsection Killing by Lines @@ -415,13 +431,15 @@ killed it. @kindex C-M-w @findex append-next-kill If a kill command is separated from the last kill command by other -commands (not just numeric arguments), it starts a new entry on the kill -ring. But you can force it to append by first typing the command -@kbd{C-M-w} (@code{append-next-kill}) right before it. The @kbd{C-M-w} -tells the following command, if it is a kill command, to append the text -it kills to the last killed text, instead of starting a new entry. With -@kbd{C-M-w}, you can kill several separated pieces of text and -accumulate them to be yanked back in one place.@refill +commands (not just numeric arguments), it starts a new entry on the +kill ring. But you can force it to combine with the last killed text, +by typing @kbd{C-M-w} (@code{append-next-kill}) right beforehand. The +@kbd{C-M-w} tells its following command, if it is a kill command, to +treat the kill as part of the sequence of previous kills. As usual, +the kill is appended to the previous killed text if the command kills +forward, and prepended if the command kills backward. In this way, +you can kill several separated pieces of text and accumulate them to +be yanked back in one place. A kill command following @kbd{M-w} (@code{kill-ring-save}) does not append to the text that @kbd{M-w} copied into the kill ring. @@ -848,8 +866,9 @@ the prefix key twice, e.g., @kbd{C-x C-x C-f}. while retaining the other features of CUA mode described below, set the variable @code{cua-enable-cua-keys} to @code{nil}. - In CUA mode, typed text replaces the active region as in -Delete-Selection mode (@pxref{Mouse Commands}). + CUA mode by default activates Delete-Selection mode (@pxref{Mouse Commands}) +so that typed text replaces the active region. To use CUA without this +behavior, set the variable @code{cua-delete-selection} to @code{nil}. @cindex rectangle highlighting CUA mode provides enhanced rectangle support with visible @@ -860,6 +879,9 @@ extend it using the movement commands, and cut or copy it using any direction. Normal text you type is inserted to the left or right of each line in the rectangle (on the same side as the cursor). + You can use this rectangle support without activating CUA by calling the +@code{cua-rectangle-mark-mode} command. + With CUA you can easily copy text and rectangles into and out of registers by providing a one-digit numeric prefix to the kill, copy, and yank commands, e.g., @kbd{C-1 C-c} copies the region into register diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index aa4d10ef324..bc62faf7694 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Keyboard Macros diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index 3faa2c88b2d..b4385cb61bc 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node M-x diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index 4483c91802d..eb2d96e9af7 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2000-2013 Free Software Foundation, Inc. +@c Copyright (C) 2000-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Mac OS / GNUstep @appendix Emacs and Mac OS / GNUstep @@ -40,13 +40,16 @@ Emacs provides a set of key bindings using this modifier key that mimic other Mac / GNUstep applications (@pxref{Mac / GNUstep Events}). You can change these bindings in the usual way (@pxref{Key Bindings}). -@c FIXME mention ns-alternate-modifier? +@vindex ns-alternate-modifier +@vindex ns-right-alternate-modifier The variable @code{ns-right-alternate-modifier} controls the behavior of the right @key{alt} and @key{option} keys. These keys behave like the left-hand keys if the value is @code{left} (the default). A value of @code{control}, @code{meta}, @code{alt}, @code{super}, or @code{hyper} makes them behave like the corresponding -modifier keys; a value of @code{none} tells Emacs to ignore them. +modifier keys; a value to @code{left} means be the same key as +@code{ns-alternate-modifier}; a value of @code{none} tells Emacs to +ignore them. @kbd{S-Mouse-1} adjusts the region to the click position, just like @kbd{Mouse-3} (@code{mouse-save-then-kill}); it does not pop @@ -207,4 +210,10 @@ restart Emacs to access newly-available services. Emacs can be built and run under GNUstep, but there are still issues to be addressed. Interested developers should contact +@ifnothtml @email{emacs-devel@@gnu.org}. +@end ifnothtml +@ifhtml +@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, the +emacs-devel mailing list}. +@end ifhtml diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index c8d9e9f2087..e066c491ac5 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1,5 +1,5 @@ -@c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2013 Free Software +@c This is part of the Emacs manual., Abbrevs, This is part of the Emacs manual., Top +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Maintaining @@ -56,6 +56,7 @@ variable @code{vc-handled-backends} to @code{nil} * Old Revisions:: Examining and comparing old versions. * VC Change Log:: Viewing the VC Change Log. * VC Undo:: Canceling changes before or after committing. +* VC Ignore:: Ignore files under version control system. * VC Directory Mode:: Listing files managed by version control. * Branches:: Multiple lines of development. @ifnottex @@ -342,7 +343,9 @@ before version control systems. modification log for the entire system, which makes change log files somewhat redundant. One advantage that they retain is that it is sometimes useful to be able to view the transaction history of a -single directory separately from those of other directories. +single directory separately from those of other directories. Another +advantage is that commit logs can't be fixed in many version control +systems. A project maintained with version control can use just the version control log, or it can use both kinds of logs. It can handle some @@ -377,7 +380,7 @@ merge-based version control system, a @samp{-} character indicates that the work file is unmodified, and @samp{:} indicates that it has been modified. @samp{!} indicates that the file contains conflicts as result of a recent merge operation (@pxref{Merging}), or that the file -was removed from the version control. Finally, @samp{?} means that +was removed from the version control. Finally, @samp{?} means that the file is under version control, but is missing from the working tree. @@ -596,6 +599,7 @@ the buffer and commit the change, together with your log entry. @cindex Log Edit mode @cindex mode, Log Edit @vindex vc-log-mode-hook +@c FIXME: Mention log-edit-mode-hook here? --xfq The major mode for the @file{*vc-log*} buffer is Log Edit mode, a variant of Text mode (@pxref{Text Mode}). On entering Log Edit mode, Emacs runs the hooks @code{text-mode-hook} and @code{vc-log-mode-hook} @@ -649,7 +653,7 @@ opposite way of working---generating ChangeLog entries from the Log Edit buffer. @end ifnottex - To abort a commit, just @strong{don't} type @kbd{C-c C-c} in that + To abort a commit, just @emph{don't} type @kbd{C-c C-c} in that buffer. You can switch buffers and do other editing. As long as you don't try to make another commit, the entry you were editing remains in the @file{*vc-log*} buffer, and you can go back to that buffer at @@ -1030,6 +1034,25 @@ unlocked; you must lock again to resume editing. You can also use @kbd{C-x v u} to unlock a file if you lock it and then decide not to change it. +@node VC Ignore +@subsection Ignore Version Control Files + +@table @kbd +@item C-x v G +Ignore a file under current version control system. (@code{vc-ignore}). +@end table + +@kindex C-x v G +@findex vc-ignore + Many source trees contain some files that do not need to be +versioned, such as editor backups, object or bytecode files, and built +programs. You can simply not add them, but then they'll always crop +up as unknown files. You can also tell the version control system to +ignore these files by adding them to the ignore file at the top of the +tree. @kbd{C-x v G} (@code{vc-ignore}) can help you do this. When +called with a prefix argument, you can remove a file from the ignored +file list. + @node VC Directory Mode @subsection VC Directory Mode @@ -1201,7 +1224,8 @@ files and directories. @item x Hide files with @samp{up-to-date} status -(@code{vc-dir-hide-up-to-date}). +(@code{vc-dir-hide-up-to-date}). With a prefix argument, hide items +whose state is that of the item at point. @end table @findex vc-dir-mark @@ -1219,7 +1243,7 @@ Revisions}), and @w{@kbd{C-x v u}} (@pxref{VC Undo}). The VC Directory buffer also defines some single-key shortcuts for VC commands with the @kbd{C-x v} prefix: @kbd{=}, @kbd{+}, @kbd{l}, -@kbd{i}, and @kbd{v}. +@kbd{i}, @kbd{D}, @kbd{L}, @kbd{G}, @kbd{I} and @kbd{v}. For example, you can commit a set of edited files by opening a VC Directory buffer, where the files are listed with the @samp{edited} @@ -1264,10 +1288,10 @@ bring them back at a later time). @cindex branch (version control) One use of version control is to support multiple independent lines -of development, which are called @dfn{branches}. Branches are used -for maintaining separate ``stable'' and ``development'' versions of a -program, and for developing unrelated features in isolation from one -another. +of development, which are called @dfn{branches}. Amongst other +things, branches can be used for maintaining separate ``stable'' and +``development'' versions of a program, and for developing unrelated +features in isolation from one another. VC's support for branch operations is currently fairly limited. For decentralized version control systems, it provides commands for @@ -2343,7 +2367,7 @@ directory trees. The @dfn{project root} is the topmost directory of a project. To define a new project, visit a file in the desired project root and type @kbd{M-x ede-new}. This command prompts for a @dfn{project type}, which refers to the underlying method that EDE -will use to manage the project (@pxref{Creating a Project, EDE,, ede, +will use to manage the project (@pxref{Creating a project, EDE,, ede, Emacs Development Environment}). The most common project types are @samp{Make}, which uses Makefiles, and @samp{Automake}, which uses GNU Automake (@pxref{Top, Automake,, automake, Automake}). In both cases, diff --git a/doc/emacs/makefile.w32-in b/doc/emacs/makefile.w32-in index e289c46784d..297ec496fe6 100644 --- a/doc/emacs/makefile.w32-in +++ b/doc/emacs/makefile.w32-in @@ -1,6 +1,6 @@ #### -*- Makefile -*- for the Emacs Manual -# Copyright (C) 2003-2013 Free Software Foundation, Inc. +# Copyright (C) 2003-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 05b2a5be3a4..7c3a9a43811 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Mark diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index f3fab686ed9..b575e4adbd3 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Minibuffer @@ -37,7 +37,7 @@ how it will be used. The prompt is highlighted using the The simplest way to enter a minibuffer argument is to type the text, then @key{RET} to submit the argument and exit the minibuffer. Alternatively, you can type @kbd{C-g} to exit the minibuffer by -cancelling the command asking for the argument (@pxref{Quitting}). +canceling the command asking for the argument (@pxref{Quitting}). @cindex default argument Sometimes, the prompt shows a @dfn{default argument}, inside @@ -550,6 +550,9 @@ previous example, @samp{foo.e} completes to @samp{foo.elc}. Emacs disregards @code{completion-ignored-extensions} when showing completion alternatives in the completion list. + Shell completion is an extended version of filename completion, +@pxref{Shell Options}. + @vindex completion-auto-help If @code{completion-auto-help} is set to @code{nil}, the completion commands never display the completion list buffer; you must type @@ -572,13 +575,6 @@ in a cyclic manner. If you give @code{completion-cycle-threshold} a numeric value @var{n}, completion commands switch to this cycling behavior only when there are @var{n} or fewer alternatives. -@cindex Icomplete mode -@findex icomplete-mode - Icomplete mode presents a constantly-updated display that tells you -what completions are available for the text you've entered so far. The -command to enable or disable this minor mode is @kbd{M-x -icomplete-mode}. - @node Minibuffer History @section Minibuffer History @cindex minibuffer history diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 73c1c85e2f8..d9bfcca3ca3 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex @@ -439,6 +439,18 @@ associated with the current buffer, type @kbd{K} (@code{doc-view-kill-proc-and-buffer}) kills the converter process and the DocView buffer. +@node EWW +@section Web Browsing with EWW + +@findex eww +@findex eww-open-file + @dfn{EWW}, the Emacs Web Wowser, is a web browser package for Emacs. +It allows browsing URLs within an Emacs buffer. The command @kbd{M-x +eww} will open a URL or search the web. You can open a file +using the command @kbd{M-x eww-open-file}. You can use EWW as the +web browser for @code{browse-url}, @pxref{Browse-URL}. For full +details, @pxref{Top, EWW,, eww, The Emacs Web Wowser Manual}. + @node Shell @section Running Shell Commands from Emacs @cindex subshell @@ -677,20 +689,13 @@ in the shell buffer to submit the current line as input. @item @key{TAB} @kindex TAB @r{(Shell mode)} @findex completion-at-point +@cindex shell completion Complete the command name or file name before point in the shell buffer (@code{completion-at-point}). This uses the usual Emacs completion rules (@pxref{Completion}), with the completion alternatives being file names, environment variable names, the shell command history, and history references (@pxref{History References}). - -@vindex shell-completion-fignore -@vindex comint-completion-fignore -The variable @code{shell-completion-fignore} specifies a list of file -name extensions to ignore in Shell mode completion. The default -setting is @code{nil}, but some users prefer @code{("~" "#" "%")} to -ignore file names ending in @samp{~}, @samp{#} or @samp{%}. Other -related Comint modes use the variable @code{comint-completion-fignore} -instead. +For options controlling the completion, @pxref{Shell Options}. @item M-? @kindex M-? @r{(Shell mode)} @@ -810,8 +815,8 @@ echoing. This is useful when a shell command runs a program that asks for a password. Please note that Emacs will not echo passwords by default. If you -really want them to be echoed, evaluate the following Lisp -expression: +really want them to be echoed, evaluate (@pxref{Lisp Eval}) the +following Lisp expression: @example (remove-hook 'comint-output-filter-functions @@ -1179,6 +1184,20 @@ the possible completions whenever completion is not exact. If you set @code{shell-completion-execonly} to @code{nil}, it considers nonexecutable files as well. +@vindex shell-completion-fignore +@vindex comint-completion-fignore +The variable @code{shell-completion-fignore} specifies a list of file +name extensions to ignore in Shell mode completion. The default +setting is @code{nil}, but some users prefer @code{("~" "#" "%")} to +ignore file names ending in @samp{~}, @samp{#} or @samp{%}. Other +related Comint modes use the variable @code{comint-completion-fignore} +instead. + +@findex shell-dynamic-complete-command +Some implementation details of the shell command completion may also be found +in the lisp documentation of the @code{shell-dynamic-complete-command} +function. + @findex shell-pushd-tohome @findex shell-pushd-dextract @findex shell-pushd-dunique @@ -1542,9 +1561,9 @@ option, like the @samp{-t} option, creates a new frame in the server's current text terminal. @xref{Windows Startup}. If you omit a filename argument while supplying the @samp{-c} option, -the new frame displays the @file{*scratch*} buffer by default. If -@code{initial-buffer-choice} is a string (@pxref{Entering Emacs}), the -new frame displays that file or directory instead. +the new frame displays the @file{*scratch*} buffer by default. This +behavior can be customized using the variable +@code{initial-buffer-choice} (@pxref{Entering Emacs}). @item -F @var{alist} @itemx --frame-parameters=@var{alist} @@ -1975,6 +1994,7 @@ Like @kbd{M-x sort-fields} except that the text within each line used for comparison comes from a fixed range of columns. See below for an explanation. +@findex reverse-region @item M-x reverse-region Reverse the order of the lines in the region. This is useful for sorting into descending order by fields or columns, since those sort @@ -2130,6 +2150,12 @@ sessions, or add this line in your init file (@pxref{Init File}): (desktop-save-mode 1) @end example +@vindex desktop-auto-save-timeout +@noindent +When @code{desktop-save-mode} is active and the desktop file exists, +Emacs auto-saves it every @code{desktop-auto-save-timeout} +seconds, if that is non-@code{nil} and non-zero. + @findex desktop-change-dir @findex desktop-revert @vindex desktop-path diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index 6b7073e3f0a..b21be99e16c 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Modes @@ -263,8 +263,7 @@ in the region, if the region is active. @xref{Using Region}. @item Icomplete mode displays an indication of available completions when -you are in the minibuffer and completion is active. @xref{Completion -Options}. +you are in the minibuffer and completion is active. @xref{Icomplete}. @item Line Number mode enables display of the current line number in the diff --git a/doc/emacs/msdog-xtra.texi b/doc/emacs/msdog-xtra.texi index cb19f89dd91..5543926fafd 100644 --- a/doc/emacs/msdog-xtra.texi +++ b/doc/emacs/msdog-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/msdog.texi b/doc/emacs/msdog.texi index 0f01958b51c..7708b8fe860 100644 --- a/doc/emacs/msdog.texi +++ b/doc/emacs/msdog.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Microsoft Windows @@ -482,7 +482,7 @@ the variable @code{w32-alt-is-meta} to a @code{nil} value. @kbd{Alt-@key{TAB}}, for its own use. These key combinations are intercepted by the system before Emacs can see them. You can use the @code{w32-register-hot-key} function to allow a key sequence to be -seen by Emacs instead of being grabbed by Windows. This functions +seen by Emacs instead of being grabbed by Windows. This function registers a key sequence as a @dfn{hot key}, overriding the special meaning of that key sequence for Windows. (MS-Windows is told that the key sequence is a hot key only when one of the Emacs windows has diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index de3e05777cd..1600f19499c 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1,11 +1,10 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1997, 1999-2013 Free Software Foundation, Inc. +@c Copyright (C) 1997, 1999-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node International @chapter International Character Set Support @c This node is referenced in the tutorial. When renaming or deleting @c it, the tutorial needs to be adjusted. (TUTORIAL.de) -@cindex MULE @cindex international scripts @cindex multibyte characters @cindex encoding of characters @@ -90,7 +89,6 @@ value to make sure Emacs interprets keyboard input correctly; see @menu * International Chars:: Basic concepts of multibyte characters. -* Disabling Multibyte:: Controlling whether to use multibyte characters. * Language Environments:: Setting things up for the language you use. * Input Methods:: Entering text characters not on your keyboard. * Select Input Method:: Specifying your choice of input methods. @@ -244,79 +242,6 @@ Character code properties: customize what to show decomposition: (65 768) ('A' '`') @end smallexample -@c FIXME? Does this section even belong in the user manual? -@c Seems more appropriate to the lispref? -@node Disabling Multibyte -@section Disabling Multibyte Characters - - By default, Emacs starts in multibyte mode: it stores the contents -of buffers and strings using an internal encoding that represents -non-@acronym{ASCII} characters using multi-byte sequences. Multibyte -mode allows you to use all the supported languages and scripts without -limitations. - -@cindex turn multibyte support on or off - Under very special circumstances, you may want to disable multibyte -character support, for a specific buffer. -When multibyte characters are disabled in a buffer, we call -that @dfn{unibyte mode}. In unibyte mode, each character in the -buffer has a character code ranging from 0 through 255 (0377 octal); 0 -through 127 (0177 octal) represent @acronym{ASCII} characters, and 128 -(0200 octal) through 255 (0377 octal) represent non-@acronym{ASCII} -characters. - - To edit a particular file in unibyte representation, visit it using -@code{find-file-literally}. @xref{Visiting}. You can convert a -multibyte buffer to unibyte by saving it to a file, killing the -buffer, and visiting the file again with @code{find-file-literally}. -Alternatively, you can use @kbd{C-x @key{RET} c} -(@code{universal-coding-system-argument}) and specify @samp{raw-text} -as the coding system with which to visit or save a file. @xref{Text -Coding}. Unlike @code{find-file-literally}, finding a file as -@samp{raw-text} doesn't disable format conversion, uncompression, or -auto mode selection. - -@c Not a single file in Emacs uses this feature. Is it really worth -@c mentioning in the _user_ manual? Also, this duplicates somewhat -@c "Loading Non-ASCII" from the lispref. -@cindex Lisp files, and multibyte operation -@cindex multibyte operation, and Lisp files -@cindex unibyte operation, and Lisp files -@cindex init file, and non-@acronym{ASCII} characters - Emacs normally loads Lisp files as multibyte. -This includes the Emacs initialization -file, @file{.emacs}, and the initialization files of packages -such as Gnus. However, you can specify unibyte loading for a -particular Lisp file, by adding an entry @samp{coding: raw-text} in a file -local variables section. @xref{Specify Coding}. -Then that file is always loaded as unibyte text. -@ignore -@c I don't see the point of this statement: -The motivation for these conventions is that it is more reliable to -always load any particular Lisp file in the same way. -@end ignore -You can also load a Lisp file as unibyte, on any one occasion, by -typing @kbd{C-x @key{RET} c raw-text @key{RET}} immediately before -loading it. - -@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip. -@vindex enable-multibyte-characters -The buffer-local variable @code{enable-multibyte-characters} is -non-@code{nil} in multibyte buffers, and @code{nil} in unibyte ones. -The mode line also indicates whether a buffer is multibyte or not. -@xref{Mode Line}. With a graphical display, in a multibyte buffer, -the portion of the mode line that indicates the character set has a -tooltip that (amongst other things) says that the buffer is multibyte. -In a unibyte buffer, the character set indicator is absent. Thus, in -a unibyte buffer (when using a graphical display) there is normally -nothing before the indication of the visited file's end-of-line -convention (colon, backslash, etc.), unless you are using an input -method. - -@findex toggle-enable-multibyte-characters -You can turn off multibyte support in a specific buffer by invoking the -command @code{toggle-enable-multibyte-characters} in that buffer. - @node Language Environments @section Language Environments @cindex language environments @@ -919,18 +844,6 @@ pattern, are decoded correctly. Unlike the previous two, this variable does not override any @samp{-*-coding:-*-} tag. -@c FIXME? This seems somewhat out of place. Move to the Rmail section? -@vindex rmail-file-coding-system - When you get new mail in Rmail, each message is translated -automatically from the coding system it is written in, as if it were a -separate file. This uses the priority list of coding systems that you -have specified. If a MIME message specifies a character set, Rmail -obeys that specification. For reading and saving Rmail files -themselves, Emacs uses the coding system specified by the variable -@code{rmail-file-coding-system}. The default value is @code{nil}, -which means that Rmail files are not translated (they are read and -written in the Emacs internal character code). - @node Specify Coding @section Specifying a File's Coding System @@ -1216,6 +1129,21 @@ In the default language environment, non-@acronym{ASCII} characters in file names are not encoded specially; they appear in the file system using the internal Emacs representation. +@cindex file-name encoding, MS-Windows +@vindex w32-unicode-filenames + When Emacs runs on MS-Windows versions that are descendants of the +NT family (Windows 2000, XP, Vista, Windows 7, and Windows 8), the +value of @code{file-name-coding-system} is largely ignored, as Emacs +by default uses APIs that allow to pass Unicode file names directly. +By contrast, on Windows 9X, file names are encoded using +@code{file-name-coding-system}, which should be set to the codepage +(@pxref{Coding Systems, codepage}) pertinent for the current system +locale. The value of the variable @code{w32-unicode-filenames} +controls whether Emacs uses the Unicode APIs when it calls OS +functions that accept file names. This variable is set by the startup +code to @code{nil} on Windows 9X, and to @code{t} on newer versions of +MS-Windows. + @strong{Warning:} if you change @code{file-name-coding-system} (or the language environment) in the middle of an Emacs session, problems can result if you have already visited files whose names were encoded using @@ -1591,15 +1519,13 @@ the range 0240 to 0377 octal (160 to 255 decimal) to handle the accented letters and punctuation needed by various European languages (and some non-European ones). Note that Emacs considers bytes with codes in this range as raw bytes, not as characters, even in a unibyte -buffer, i.e., if you disable multibyte characters. However, Emacs -can still handle these character codes as if they belonged to -@emph{one} of the single-byte character sets at a time. To specify -@emph{which} of these codes to use, invoke @kbd{M-x -set-language-environment} and specify a suitable language environment -such as @samp{Latin-@var{n}}. - - For more information about unibyte operation, see -@ref{Disabling Multibyte}. +buffer, i.e., if you disable multibyte characters. However, Emacs can +still handle these character codes as if they belonged to @emph{one} +of the single-byte character sets at a time. To specify @emph{which} +of these codes to use, invoke @kbd{M-x set-language-environment} and +specify a suitable language environment such as @samp{Latin-@var{n}}. +@xref{Disabling Multibyte, , Disabling Multibyte Characters, elisp, +GNU Emacs Lisp Reference Manual}. @vindex unibyte-display-via-language-environment Emacs can also display bytes in the range 160 to 255 as readable @@ -1804,4 +1730,6 @@ jump when point traverses reordered bidirectional text. Similarly, a highlighted region covering a contiguous range of character positions may look discontinuous if the region spans reordered text. This is normal and similar to the behavior of other programs that support -bidirectional text. +bidirectional text. If you set @code{visual-order-cursor-movement} to +a non-@code{nil} value, cursor motion by the arrow keys follows the +visual order on screen (@pxref{Moving Point, visual-order movement}). diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 6a7111fa296..dee1210086c 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Packages @@ -126,6 +126,12 @@ dependencies; also, delete all packages marked with @kbd{d} Refresh the package list (@code{package-menu-refresh}). This fetches the list of available packages from the package archive again, and recomputes the package list. + +@item f +Filter the package list (@code{package-menu-filter}). This prompts +for a keyword (e.g., @samp{games}), then shows only the packages +that relate to that keyword. To restore the full package list, +type @kbd{q}. @end table @noindent diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi index ae631ff3a1f..ba36faad709 100644 --- a/doc/emacs/picture-xtra.texi +++ b/doc/emacs/picture-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 459221a9088..26e9539d750 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1,5 +1,6 @@ +@c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Programs @@ -35,7 +36,7 @@ Highlight program syntax (@pxref{Font Lock}). * Documentation:: Getting documentation of functions you plan to call. * Hideshow:: Displaying blocks selectively. * Symbol Completion:: Completion on symbol names of your program or language. -* Glasses:: Making identifiersLikeThis more readable. +* MixedCase Words:: Dealing with identifiersLikeThis. * Semantic:: Suite of editing tools based on source code parsing. * Misc for Programs:: Other Emacs features useful for editing programs. * C Modes:: Special commands of C, C++, Objective-C, Java, @@ -75,17 +76,17 @@ mode for the C programming language is @code{c-mode}. @cindex VHDL mode @cindex M4 mode @cindex Shell-script mode -@cindex Delphi mode +@cindex OPascal mode @cindex PostScript mode @cindex Conf mode @cindex DNS mode @cindex Javascript mode Emacs has programming language modes for Lisp, Scheme, the -Scheme-based DSSSL expression language, Ada, ASM, AWK, C, C++, Delphi, +Scheme-based DSSSL expression language, Ada, ASM, AWK, C, C++, Fortran, Icon, IDL (CORBA), IDLWAVE, Java, Javascript, Metafont -(@TeX{}'s companion for font creation), Modula2, Objective-C, Octave, -Pascal, Perl, Pike, PostScript, Prolog, Python, Ruby, Simula, Tcl, and -VHDL@. An alternative mode for Perl is called CPerl mode. Modes are +(@TeX{}'s companion for font creation), Modula2, Object Pascal, Objective-C, +Octave, Pascal, Perl, Pike, PostScript, Prolog, Python, Ruby, Simula, Tcl, +and VHDL@. An alternative mode for Perl is called CPerl mode. Modes are also available for the scripting languages of the common GNU and Unix shells, VMS DCL, and MS-DOS/MS-Windows @samp{BAT} files, and for makefiles, DNS master files, and various sorts of configuration files. @@ -119,17 +120,17 @@ those specified in the mode's own mode hook (@pxref{Major Modes}). For instance, entering C mode runs the hooks @code{prog-mode-hook} and @code{c-mode-hook}. @xref{Hooks}, for information about hooks. -@ifinfo +@ifnottex Separate manuals are available for the modes for Ada (@pxref{Top,, Ada Mode, ada-mode, Ada Mode}), C/C++/Objective C/Java/Corba IDL/Pike/AWK (@pxref{Top, , CC Mode, ccmode, CC Mode}), and IDLWAVE (@pxref{Top,, IDLWAVE, idlwave, IDLWAVE User Manual}). -@end ifinfo -@ifnotinfo +@end ifnottex +@iftex The Emacs distribution contains Info manuals for the major modes for Ada, C/C++/Objective C/Java/Corba IDL/Pike/AWK, and IDLWAVE@. For Fortran mode, @pxref{Fortran,,, emacs-xtra, Specialized Emacs Features}. -@end ifnotinfo +@end iftex @node Defuns @section Top-Level Definitions, or Defuns @@ -844,8 +845,34 @@ show-paren-mode}. Electric Pair mode, a global minor mode, provides a way to easily insert matching delimiters. Whenever you insert an opening delimiter, the matching closing delimiter is automatically inserted as well, -leaving point between the two. To toggle Electric Pair mode, type -@kbd{M-x electric-pair-mode}. +leaving point between the two. Conversely, when you insert a closing +delimiter over an existing one, no inserting takes places and that +position is simply skipped over. These variables control additional +features of Electric Pair mode: + +@itemize @bullet +@item +@code{electric-pair-preserve-balance}, when non-@code{nil}, makes the +default pairing logic balance out the number of opening and closing +delimiters. + +@item +@code{electric-pair-delete-adjacent-pairs}, when non-@code{nil}, makes +backspacing between two adjacent delimiters also automatically delete +the closing delimiter. + +@item +@code{electric-pair-open-newline-between-pairs}, when non-@code{nil}, +makes inserting inserting a newline between two adjacent pairs also +automatically open and extra newline after point. + +@item +@code{electric-pair-skip-whitespace}, when non-@code{nil}, causes the minor +mode to skip whitespace forward before deciding whether to skip over +the closing delimiter. +@end itemize + +To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}. @node Comments @section Manipulating Comments @@ -1194,7 +1221,7 @@ variables that you want to use. @xref{Name Help}. @cindex Eldoc mode @findex eldoc-mode Eldoc is a buffer-local minor mode that helps with looking up Lisp -documention. When it is enabled, the echo area displays some useful +documentation. When it is enabled, the echo area displays some useful information whenever there is a Lisp function or variable at point; for a function, it shows the argument list, and for a variable it shows the first line of the variable's documentation string. To @@ -1309,24 +1336,37 @@ another window. @xref{Completion}. In Text mode and related modes, @kbd{M-@key{TAB}} completes words based on the spell-checker's dictionary. @xref{Spelling}. -@node Glasses -@section Glasses minor mode -@cindex Glasses mode +@node MixedCase Words +@section MixedCase Words @cindex camel case -@findex mode, Glasses - Glasses mode is a buffer-local minor mode that makes it easier to -read mixed-case (or ``CamelCase'') symbols like -@samp{unReadableSymbol}, by altering how they are displayed. By -default, it displays extra underscores between each lower-case letter -and the following capital letter. This does not alter the buffer -text, only how it is displayed. + Some programming styles make use of mixed-case (or ``CamelCase'') +symbols like @samp{unReadableSymbol}. (In the GNU project, we recommend +using underscores to separate words within an identifier, rather than +using case distinctions.) Emacs has various features to make it easier +to deal with such symbols. + +@cindex Glasses mode +@findex mode, Glasses + Glasses mode is a buffer-local minor mode that makes it easier to read +such symbols, by altering how they are displayed. By default, it +displays extra underscores between each lower-case letter and the +following capital letter. This does not alter the buffer text, only how +it is displayed. To toggle Glasses mode, type @kbd{M-x glasses-mode} (@pxref{Minor Modes}). When Glasses mode is enabled, the minor mode indicator @samp{o^o} appears in the mode line. For more information about Glasses mode, type @kbd{C-h P glasses @key{RET}}. +@cindex Subword mode +@findex subword-mode + Subword mode is another buffer-local minor mode. In subword mode, +Emacs's word commands recognize upper case letters in +@samp{StudlyCapsIdentifiers} as word boundaries. When Subword mode is +enabled, the minor mode indicator @samp{,} appears in the mode line. +See also the similar @code{superword-mode} (@pxref{Misc for Programs}). + @node Semantic @section Semantic @cindex Semantic package @@ -1356,7 +1396,7 @@ the menu item named @samp{Source Code Parsers (Semantic)} in the @samp{Tools} menu. This enables Semantic mode, a global minor mode. When Semantic mode is enabled, Emacs automatically attempts to -parses each file you visit. Currently, Semantic understands C, C++, +parse each file you visit. Currently, Semantic understands C, C++, Scheme, Javascript, Java, HTML, and Make. Within each parsed buffer, the following commands are available: @@ -1412,6 +1452,19 @@ paragraph commands to work on. Auto Fill mode, if enabled in a programming language major mode, indents the new lines which it creates. +@findex superword-mode + Superword mode is a buffer-local minor mode that causes editing and +motion commands to treat symbols (e.g., @samp{this_is_a_symbol}) as words. +When Subword mode is enabled, the minor mode indicator +@iftex +@samp{@math{^2}} +@end iftex +@ifnottex +@samp{²} +@end ifnottex +appears in the mode line. See also the similar @code{subword-mode} +(@pxref{MixedCase Words}). + @findex electric-layout-mode Electric Layout mode (@kbd{M-x electric-layout-mode}) is a global minor mode that automatically inserts newlines when you type certain @@ -1624,19 +1677,6 @@ hungry-delete feature is enabled. @subsection Other Commands for C Mode @table @kbd -@item C-c C-w -@itemx M-x subword-mode -@findex subword-mode -Enable (or disable) @dfn{subword mode}. In subword mode, Emacs's word -commands recognize upper case letters in -@samp{StudlyCapsIdentifiers} as word boundaries. This is indicated by -the flag @samp{/w} on the mode line after the mode name -(e.g., @samp{C/law}). You can even use @kbd{M-x subword-mode} in -non-CC Mode buffers. - -In the GNU project, we recommend using underscores to separate words -within an identifier in C or C++, rather than using case distinctions. - @item M-x c-context-line-break @findex c-context-line-break This command inserts a line break and indents the new line in a manner diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 77545dff5b2..a0ff7079388 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Registers @@ -29,6 +29,15 @@ you store something else in that register. To see what register Display a description of what register @var{r} contains. @end table +@vindex register-preview-delay +@cindex preview of registers + All of the commands that prompt for a register will display a +``preview'' window that lists the existing registers (if there are +any) after a short delay. To change the length of the delay, +customize @code{register-preview-delay}. To prevent this display, set +that option to @code{nil}. You can explicitly request a preview +window by pressing @kbd{C-h} or @key{F1}. + @dfn{Bookmarks} record files and positions in them, so you can return to those positions when you look at the file again. Bookmarks are similar in spirit to registers, so they are also documented in @@ -41,6 +50,7 @@ this chapter. * Configuration Registers:: Saving window configurations in registers. * Number Registers:: Numbers in registers. * File Registers:: File names in registers. +* Keyboard Macro Registers:: Keyboard macros in registers. * Bookmarks:: Bookmarks are like registers, but persistent. @end menu @@ -172,7 +182,7 @@ rather than a text string, if the register contains a rectangle. @cindex saving window configuration in a register @findex window-configuration-to-register -@findex frame-configuration-to-register +@findex frameset-to-register @kindex C-x r w @kindex C-x r f You can save the window configuration of the selected frame in a @@ -186,7 +196,7 @@ Save the state of the selected frame's windows in register @var{r} (@code{window-configuration-to-register}). @item C-x r f @var{r} Save the state of all frames, including all their windows, in register -@var{r} (@code{frame-configuration-to-register}). +@var{r} (@code{frameset-to-register}). @end table Use @kbd{C-x r j @var{r}} to restore a window or frame configuration. @@ -230,10 +240,10 @@ numeric argument stores zero in the register. If you visit certain file names frequently, you can visit them more conveniently if you put their names in registers. Here's the Lisp code -used to put a file name in a register: +used to put a file @var{name} into register @var{r}: @smallexample -(set-register ?@var{r} '(file . @var{name})) +(set-register @var{r} '(file . @var{name})) @end smallexample @need 3000 @@ -251,6 +261,23 @@ puts the file name shown in register @samp{z}. @var{r}}. (This is the same command used to jump to a position or restore a frame configuration.) +@node Keyboard Macro Registers +@section Keyboard Macro Registers +@cindex saving keyboard macro in a register +@cindex keyboard macros, in registers + +@kindex C-x C-k x +@findex kmacro-to-register + If you need to execute a keyboard macro (@pxref{Keyboard Macros}) +frequently, it is more convenient to put it in a register or save it +(@pxref{Save Keyboard Macro}). @kbd{C-x C-k x @var{r}} +(@code{kmacro-to-register}) stores the last keyboard macro in register +@var{r}. + + To execute the keyboard macro in register @var{r}, type @kbd{C-x r j +@var{r}}. (This is the same command used to jump to a position or +restore a frameset.) + @node Bookmarks @section Bookmarks @cindex bookmarks @@ -317,6 +344,10 @@ a number, says how many bookmark modifications should go by between saving. If you set this variable to @code{nil}, Emacs only saves bookmarks if you explicitly use @kbd{M-x bookmark-save}. +@vindex bookmark-default-file + The variable @code{bookmark-default-file} specifies the file in +which to save bookmarks by default. + @vindex bookmark-search-size Bookmark position values are saved with surrounding context, so that @code{bookmark-jump} can find the proper position even if the file is diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index f80f9e175fa..2f823a757fe 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Rmail @@ -101,6 +101,7 @@ frequent that it deserves to be easier. @item @key{SPC} Scroll forward (@code{scroll-up-command}). @item @key{DEL} +@itemx @key{S-SPC} Scroll backward (@code{scroll-down-command}). @item . Scroll to start of message (@code{rmail-beginning-of-message}). @@ -110,10 +111,11 @@ Scroll to end of message (@code{rmail-end-of-message}). @kindex SPC @r{(Rmail)} @kindex DEL @r{(Rmail)} +@kindex S-SPC @r{(Rmail)} Since the most common thing to do while reading a message is to scroll through it by screenfuls, Rmail makes @key{SPC} and @key{DEL} -do the same as @kbd{C-v} (@code{scroll-up-command}) and @kbd{M-v} -(@code{scroll-down-command}) respectively. +(or @key{S-SPC}) do the same as @kbd{C-v} (@code{scroll-up-command}) +and @kbd{M-v} (@code{scroll-down-command}) respectively. @kindex . @r{(Rmail)} @kindex / @r{(Rmail)} @@ -367,12 +369,20 @@ the rest of Rmail, since only Rmail operates on the Rmail file. @end enumerate @c FIXME remove this in Emacs 25; won't be relevant any more. +@cindex Babyl files +@cindex mbox files Rmail was originally written to use the Babyl format as its internal format. Since then, we have recognized that the usual inbox format (@samp{mbox}) on Unix and GNU systems is adequate for the job, and so since Emacs 23 Rmail uses that as its internal format. The Rmail file is still separate from the inbox file, even though their format is the same. +@c But this bit should stay in some form. +@vindex rmail-mbox-format +(In fact, there are a few slightly different mbox formats. +The differences are not very important, but you can set the variable +@code{rmail-mbox-format} to tell Rmail which form your system uses. +See that variable's documentation for more details.) @vindex rmail-preserve-inbox When getting new mail, Rmail first copies the new mail from the @@ -1274,6 +1284,17 @@ It reads the name of a coding system, and then redecodes the message using the coding system you specified. If you specified the right coding system, the result should be readable. +@vindex rmail-file-coding-system + When you get new mail in Rmail, each message is translated +automatically from the coding system it is written in, as if it were a +separate file. This uses the priority list of coding systems that you +have specified. If a MIME message specifies a character set, Rmail +obeys that specification. For reading and saving Rmail files +themselves, Emacs uses the coding system specified by the variable +@code{rmail-file-coding-system}. The default value is @code{nil}, +which means that Rmail files are not translated (they are read and +written in the Emacs internal character code). + @node Rmail Editing @section Editing Within a Message @@ -1370,6 +1391,7 @@ mailboxes, etc. It is able to access remote mailboxes using the POP3 or IMAP4 protocol, and can retrieve mail from them using a TLS encrypted channel. It also accepts mailbox arguments in @acronym{URL} form. The detailed description of mailbox @acronym{URL}s can be found +@c Note this node seems to be missing in some versions of mailutils.info? in @ref{URL,,,mailutils,Mailbox URL Formats}. In short, a @acronym{URL} is: diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi index 39077921a88..13a4c922c4d 100644 --- a/doc/emacs/screen.texi +++ b/doc/emacs/screen.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Screen @@ -287,13 +287,12 @@ here, as you can more easily see them yourself. @kindex M-` @kindex F10 -@findex tmm-menubar @findex menu-bar-open - On a graphical display, you can use the mouse to choose a command -from the menu bar. An arrow on the right edge of a menu item means it -leads to a subsidiary menu, or @dfn{submenu}. A @samp{...} at the end -of a menu item means that the command will prompt you for further -input before it actually does anything. + On a display that support a mouse, you can use the mouse to choose a +command from the menu bar. An arrow on the right edge of a menu item +means it leads to a subsidiary menu, or @dfn{submenu}. A @samp{...} +at the end of a menu item means that the command will prompt you for +further input before it actually does anything. Some of the commands in the menu bar have ordinary key bindings as well; if so, a key binding is shown in parentheses after the item @@ -305,14 +304,20 @@ the usual way (@pxref{Key Help}). item by pressing @key{F10} (to run the command @code{menu-bar-open}). You can then navigate the menus with the arrow keys. To activate a selected menu item, press @key{RET}; to cancel menu navigation, press -@key{ESC}. +@kbd{C-g} or @kbd{ESC ESC ESC}. - On a text terminal, you can use the menu bar by typing @kbd{M-`} or -@key{F10} (these run the command @code{tmm-menubar}). This lets you -select a menu item with the keyboard. A provisional choice appears in -the echo area. You can use the up and down arrow keys to move through -the menu to different items, and then you can type @key{RET} to select -the item. Each menu item is also designated by a letter or digit -(usually the initial of some word in the item's name). This letter or -digit is separated from the item name by @samp{==>}. You can type the -item's letter or digit to select the item. +@findex tmm-menubar +@vindex tty-menu-open-use-tmm + On a text terminal, you can optionally access the menu-bar menus in +the echo area. To this end, customize the variable +@code{tty-menu-open-use-tmm} to a non-@code{nil} value. Then typing +@key{F10} will run the command @code{tmm-menubar} instead of dropping +down the menu. (You can also type @kbd{M-`}, which always invokes +@code{tmm-menubar}.) @code{tmm-menubar} lets you select a menu item +with the keyboard. A provisional choice appears in the echo area. +You can use the up and down arrow keys to move through the menu to +different items, and then you can type @key{RET} to select the item. +Each menu item is also designated by a letter or digit (usually the +initial of some word in the item's name). This letter or digit is +separated from the item name by @samp{==>}. You can type the item's +letter or digit to select the item. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 377264223a5..6fa9a33692a 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Search @@ -52,14 +52,14 @@ Incremental search backward (@code{isearch-backward}). @end table @menu -* Basic Isearch:: Basic incremental search commands. -* Repeat Isearch:: Searching for the same string again. -* Error in Isearch:: When your string is not found. -* Special Isearch:: Special input in incremental search. -* Isearch Yank:: Commands that grab text into the search string - or else edit the search string. -* Isearch Scroll:: Scrolling during an incremental search. -* Isearch Minibuffer:: Incremental search of the minibuffer history. +* Basic Isearch:: Basic incremental search commands. +* Repeat Isearch:: Searching for the same string again. +* Error in Isearch:: When your string is not found. +* Special Isearch:: Special input in incremental search. +* Isearch Yank:: Commands that grab text into the search string + or else edit the search string. +* Not Exiting Isearch:: Prefix argument and scrolling commands. +* Isearch Minibuffer:: Incremental search of the minibuffer history. @end menu @node Basic Isearch @@ -175,7 +175,7 @@ element in the minibuffer, where you can edit it. @kindex M-e @r{(Incremental search)} To edit the current search string in the minibuffer without -replacing it with items from the search ring, type @kbd{M-e}. Type +replacing it with items from the search ring, type @kbd{M-e}. Type @key{RET}, @kbd{C-s} or @kbd{C-r} to finish editing the string and search for it. @node Error in Isearch @@ -229,12 +229,14 @@ spaces in the text. Hence, @samp{foo bar} matches @samp{foo bar}, @samp{foo bar}, @samp{foo bar}, and so on (but not @samp{foobar}). More precisely, Emacs matches each sequence of space characters in the search string to a regular expression specified by the variable -@code{search-whitespace-regexp}. For example, set it to -@samp{"[[:space:]\n]+"} to make spaces match sequences of newlines as -well as spaces. To toggle lax space matching, type @kbd{M-s SPC} +@code{search-whitespace-regexp}. For example, to make spaces match +sequences of newlines as well as spaces, set it to +@samp{"[[:space:]\n]+"}. + + To toggle lax space matching, type @kbd{M-s SPC} (@code{isearch-toggle-lax-whitespace}). To disable this feature entirely, change @code{search-whitespace-regexp} to @code{nil}; then -each space in the search string matches exactly one space +each space in the search string matches exactly one space. If the search string you entered contains only lower-case letters, the search is case-insensitive; as long as an upper-case letter exists @@ -242,17 +244,37 @@ in the search string, the search becomes case-sensitive. If you delete the upper-case character from the search string, it ceases to have this effect. @xref{Search Case}. +@cindex invisible text, searching for +@kindex M-s i @r{(Incremental search)} +@findex isearch-toggle-invisible + To toggle whether or not invisible text is searched, type +@kbd{M-s i} (@code{isearch-toggle-invisible}). @xref{Outline Search}. + To search for a newline character, type @kbd{C-j}. - To search for other control characters, such as @key{control-S}, -quote it by typing @kbd{C-q} first (@pxref{Inserting Text}). To -search for non-@acronym{ASCII} characters, you can either use -@kbd{C-q} and enter its octal code, or use an input method -(@pxref{Input Methods}). If an input method is enabled in the current -buffer when you start the search, you can use it in the search string -also. While typing the search string, you can toggle the input method -with the command @kbd{C-\} (@code{isearch-toggle-input-method}). You -can also turn on a non-default input method with @kbd{C-^} + To search for non-@acronym{ASCII} characters, use one of the +following methods: + +@itemize @bullet +@item +Type @kbd{C-q}, followed by a non-graphic character or a sequence of +octal digits. This adds a character to the search string, similar to +inserting into a buffer using @kbd{C-q} (@pxref{Inserting Text}). For +example, @kbd{C-q C-s} during incremental search adds the +@key{control-S} character to the search string. + +@item +Type @kbd{C-x 8 @key{RET}}, followed by a Unicode name or code-point. +This adds the specified character into the search string, similar to +the usual @code{insert-char} command (@pxref{Inserting Text}). + +@item +Use an input method (@pxref{Input Methods}). If an input method is +enabled in the current buffer when you start the search, you can use +it in the search string also. While typing the search string, you can +toggle the input method with @kbd{C-\} +(@code{isearch-toggle-input-method}). You can also turn on a +non-default input method with @kbd{C-^} (@code{isearch-toggle-specified-input-method}), which prompts for the name of the input method. When an input method is active during incremental search, the search prompt includes the input method @@ -268,12 +290,13 @@ I-search [@var{im}]: where @var{im} is the mnemonic of the active input method. Any input method you enable during incremental search remains enabled in the current buffer afterwards. +@end itemize @kindex M-% @r{(Incremental search)} Typing @kbd{M-%} in incremental search invokes @code{query-replace} or @code{query-replace-regexp} (depending on search mode) with the -current search string used as the string to replace. @xref{Query -Replace}. +current search string used as the string to replace. A negative +prefix argument means to replace backward. @xref{Query Replace}. @kindex M-TAB @r{(Incremental search)} Typing @kbd{M-@key{TAB}} in incremental search invokes @@ -315,7 +338,8 @@ of whether to copy a character or a word is heuristic.) @findex isearch-yank-line Similarly, @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest of the current line to the search string. If point is already at the -end of a line, it appends the next line. +end of a line, it appends the next line. With a prefix argument +@var{n}, it appends the next @var{n} lines. If the search is currently case-insensitive, both @kbd{C-w} and @kbd{M-s C-e} convert the text they copy to lower case, so that the @@ -332,9 +356,28 @@ alternative method to add the character after point is to enter the minibuffer with @kbd{M-e} (@pxref{Repeat Isearch}) and type @kbd{C-f} at the end of the search string in the minibuffer. -@node Isearch Scroll -@subsection Scrolling During Incremental Search +@node Not Exiting Isearch +@subsection Not Exiting Incremental Search +This subsection describes two categories of commands which you can +type without exiting the current incremental search, even though they +are not themselves part of incremental search. + +@table @asis +@item Prefix Arguments +@vindex isearch-allow-prefix + In incremental search, when you enter a prefix argument +(@pxref{Arguments}), by default it will apply either to the next +action in the search or to the command that exits the search. + + In previous versions of Emacs, entering a prefix argument always +terminated the search. You can revert to this behavior by setting the +variable @code{isearch-allow-prefix} to @code{nil}. + + When @code{isearch-allow-scroll} is non-@code{nil} (see below), +prefix arguments always have the default behavior described above. + +@item Scrolling Commands @vindex isearch-allow-scroll Normally, scrolling commands exit incremental search. If you change the variable @code{isearch-allow-scroll} to a non-@code{nil} value, @@ -366,6 +409,7 @@ This feature can be applied to any command that doesn't permanently change point, the buffer contents, the match data, the current buffer, or the selected window and frame. The command must not itself attempt an incremental search. +@end table @node Isearch Minibuffer @subsection Searching the Minibuffer @@ -461,12 +505,13 @@ These run the commands @code{word-search-forward} and @code{word-search-backward} respectively. Incremental and nonincremental word searches differ slightly in the -way they find a match. In a nonincremental word search, the last word -in the search string must exactly match a whole word. In an -incremental word search, the matching is more lax: the last word in -the search string can match part of a word, so that the matching -proceeds incrementally as you type. This additional laxity does not -apply to the lazy highlight, which always matches whole words. +way they find a match. In a nonincremental word search, each word in +the search string must exactly match a whole word. In an incremental +word search, the matching is more lax: while you are typing the search +string, its first and last words need not match whole words. This is +so that the matching can proceed incrementally as you type. This +additional laxity does not apply to the lazy highlight, which always +matches whole words. @node Symbol Search @section Symbol Search @@ -486,6 +531,9 @@ searching source code. If incremental search is active, toggle symbol search mode (@code{isearch-toggle-symbol}); otherwise, begin an incremental forward symbol search (@code{isearch-forward-symbol}). +@item M-s . +Start a symbol incremental search forward with the symbol found near +point added to the search string initially. @item M-s _ @key{RET} @var{symbol} @key{RET} Search forward for @var{symbol}, nonincrementally. @item M-s _ C-r @key{RET} @var{symbol} @key{RET} @@ -493,9 +541,12 @@ Search backward for @var{symbol}, nonincrementally. @end table @kindex M-s _ +@kindex M-s . @findex isearch-forward-symbol - To begin a forward incremental symbol search, type @kbd{M-s _}. If -incremental search is not already active, this runs the command +@findex isearch-forward-symbol-at-point + To begin a forward incremental symbol search, type @kbd{M-s _} (or +@kbd{M-s .} if the symbol to search is near point). If incremental +search is not already active, this runs the command @code{isearch-forward-symbol}. If incremental search is already active, @kbd{M-s _} switches to a symbol search, preserving the direction of the search and the current search string; you can disable @@ -648,7 +699,7 @@ it possible to match the rest of the pattern. For example, in matching tries to match all three @samp{a}s; but the rest of the pattern is @samp{ar} and there is only @samp{r} left to match, so this try fails. The next alternative is for @samp{a*} to match only two @samp{a}s. -With this choice, the rest of the regexp matches successfully.@refill +With this choice, the rest of the regexp matches successfully. @item @kbd{+} is a postfix operator, similar to @samp{*} except that it must match @@ -810,11 +861,11 @@ either @var{a} matches it or @var{b} matches it. It works by trying to match @var{a}, and if that fails, by trying to match @var{b}. Thus, @samp{foo\|bar} matches either @samp{foo} or @samp{bar} -but no other string.@refill +but no other string. @samp{\|} applies to the largest possible surrounding expressions. Only a surrounding @samp{\( @dots{} \)} grouping can limit the grouping power of -@samp{\|}.@refill +@samp{\|}. Full backtracking capability exists to handle multiple uses of @samp{\|}. @@ -830,7 +881,7 @@ Thus, @samp{\(foo\|bar\)x} matches either @samp{foox} or @samp{barx}. To enclose a complicated expression for the postfix operators @samp{*}, @samp{+} and @samp{?} to operate on. Thus, @samp{ba\(na\)*} matches @samp{bananana}, etc., with any (zero or more) number of @samp{na} -strings.@refill +strings. @item To record a matched substring for future reference. @@ -892,7 +943,7 @@ matches the empty string, but only at point. matches the empty string, but only at the beginning or end of a word. Thus, @samp{\bfoo\b} matches any occurrence of @samp{foo} as a separate word. @samp{\bballs?\b} matches -@samp{ball} or @samp{balls} as a separate word.@refill +@samp{ball} or @samp{balls} as a separate word. @samp{\b} matches at the beginning or end of the buffer regardless of what text appears next to it. @@ -985,7 +1036,7 @@ searching through, if you specify the text in lower case. Thus, if you specify searching for @samp{foo}, then @samp{Foo} and @samp{foo} also match. Regexps, and in particular character sets, behave likewise: @samp{[ab]} matches @samp{a} or @samp{A} or @samp{b} or -@samp{B}.@refill +@samp{B}. An upper-case letter anywhere in the incremental search string makes the search case-sensitive. Thus, searching for @samp{Foo} does not find @@ -993,12 +1044,6 @@ the search case-sensitive. Thus, searching for @samp{Foo} does not find well as to string search. The effect ceases if you delete the upper-case letter from the search string. - Typing @kbd{M-c} within an incremental search toggles the case -sensitivity of that search. The effect does not extend beyond the -current incremental search to the next one, but it does override the -effect of adding or removing an upper-case letter in the current -search. - @vindex case-fold-search If you set the variable @code{case-fold-search} to @code{nil}, then all letters must match exactly, including case. This is a per-buffer @@ -1008,6 +1053,13 @@ This variable applies to nonincremental searches also, including those performed by the replace commands (@pxref{Replace}) and the minibuffer history matching commands (@pxref{Minibuffer History}). +@c isearch-toggle-case-fold + Typing @kbd{M-c} within an incremental search toggles the case +sensitivity of that search. The effect does not extend beyond the +current incremental search to the next one, but it does override the +effect of adding or removing an upper-case letter in the current +search. + Several related variables control case-sensitivity of searching and matching for specific commands or activities. For instance, @code{tags-case-fold-search} controls case sensitivity for @@ -1217,7 +1269,8 @@ occurrence and asks you whether to replace it. Aside from querying, (@pxref{Unconditional Replace}). In particular, it preserves case provided @code{case-replace} is non-@code{nil}, as it normally is (@pxref{Replacement and Case}). A numeric argument means to consider -only occurrences that are bounded by word-delimiter characters. +only occurrences that are bounded by word-delimiter characters. A +negative prefix argument replaces backward. @kindex C-M-% @findex query-replace-regexp diff --git a/doc/emacs/sending.texi b/doc/emacs/sending.texi index 4c8af7e650e..95f3c6b661b 100644 --- a/doc/emacs/sending.texi +++ b/doc/emacs/sending.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Sending Mail @@ -256,7 +256,7 @@ This means that @var{nick} should expand into @var{fulladdresses}, where @var{fulladdresses} can be either a single address, or multiple addresses separated with spaces. For instance, to make @code{maingnu} stand for @code{gnu@@gnu.org} plus a local address of your own, put in -this line:@refill +this line: @example alias maingnu gnu@@gnu.org local-gnu @@ -374,7 +374,7 @@ This is the default, unless you have already set the variables for sending mail via @code{smtpmail-send-it} (see below). @item smtpmail-send-it -Send mail using the through an external mail host, such as your +Send mail through an external mail host, such as your Internet service provider's outgoing SMTP mail server. If you have not told Emacs how to contact the SMTP server, it prompts for this information, which is saved in the @code{smtpmail-smtp-server} variable diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index d50a841d509..68523888f6d 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Text @@ -562,10 +562,11 @@ customize the abnormal hook variable @code{fill-nobreak-predicate} (@pxref{Hooks}). Each function in this hook is called with no arguments, with point positioned where Emacs is considering breaking a line. If a function returns a non-@code{nil} value, Emacs will not -break the line there. Two functions you can use are +break the line there. Functions you can use there include: @code{fill-single-word-nobreak-p} (don't break after the first word of -a sentence or before the last) and @code{fill-french-nobreak-p} (don't -break after @samp{(} or before @samp{)}, @samp{:} or @samp{?}). +a sentence or before the last); @code{fill-single-char-nobreak-p} +(don't break after a one-letter word); and @code{fill-french-nobreak-p} +(don't break after @samp{(} or before @samp{)}, @samp{:} or @samp{?}). @node Fill Prefix @subsection The Fill Prefix @@ -1123,12 +1124,17 @@ though these are technically body lines). @kbd{C-c C-a} numeric argument @var{n}, it hides everything except the top @var{n} levels of heading lines. +@anchor{Outline Search} @findex reveal-mode +@vindex search-invisible When incremental search finds text that is hidden by Outline mode, it makes that part of the buffer visible. If you exit the search at -that position, the text remains visible. You can also automatically -make text visible as you navigate in it by using Reveal mode (@kbd{M-x -reveal-mode}), a buffer-local minor mode. +that position, the text remains visible. To toggle whether or not +an active incremental search can match hidden text, type @kbd{M-s i}. +To change the default for future searches, customize the option +@code{search-invisible}. You can also automatically make text visible +as you navigate in it by using Reveal mode (@kbd{M-x reveal-mode}), a +buffer-local minor mode. @node Outline Views @subsection Viewing One Outline in Multiple Views @@ -2011,8 +2017,8 @@ highlighting (@pxref{Font Lock}). Unlike Enriched mode, Font Lock mode assigns text properties automatically, based on the current buffer contents; those properties are not saved to disk. - The file @file{etc/enriched.doc} in the Emacs distribution serves as -an example of the features of Enriched mode. + The file @file{enriched.txt} in Emacs's @code{data-directory} +serves as an example of the features of Enriched mode. @menu * Enriched Mode:: Entering and exiting Enriched mode. @@ -2086,6 +2092,7 @@ newlines are used for filling. The @key{RET} (@code{newline}) and commands, including Auto Fill (@pxref{Auto Fill}), insert only soft newlines and delete only soft newlines, leaving hard newlines alone. +@c FIXME: I don't see 'unfilled' in that node. --xfq Thus, when editing with Enriched mode, you should not use @key{RET} or @kbd{C-o} to break lines in the middle of filled paragraphs. Use Auto Fill mode or explicit fill commands (@pxref{Fill Commands}) @@ -2097,11 +2104,12 @@ want to set the justification style to @code{unfilled} @node Editing Format Info @subsection Editing Format Information - The easiest way to alter properties is with the Text Properties -menu. You can get to this menu from the Edit menu in the menu bar -(@pxref{Menu Bar}), or with @kbd{C-Mouse-2} (@pxref{Menu Mouse -Clicks}). Some of the commands in the Text Properties menu are listed -below (you can also invoke them with @kbd{M-x}): + The easiest way to alter properties is with the @samp{Text +Properties} menu. You can get to this menu from the @samp{Edit} menu +in the menu bar (@pxref{Menu Bar}), or with @kbd{C-Mouse-2} +(@pxref{Menu Mouse Clicks}). Some of the commands in the @samp{Text +Properties} menu are listed below (you can also invoke them with +@kbd{M-x}): @table @code @findex facemenu-remove-face-props @@ -2255,6 +2263,7 @@ Prefix}. @node Enriched Justification @subsection Justification in Enriched Text +@cindex justification style In Enriched mode, you can use the following commands to specify various @dfn{justification styles} for filling. These commands apply @@ -2295,11 +2304,11 @@ still indent the left margin. @vindex default-justification You can also specify justification styles using the Justification -submenu in the Text Properties menu. - The default justification style is specified by the per-buffer -variable @code{default-justification}. Its value should be one of the -symbols @code{left}, @code{right}, @code{full}, @code{center}, or -@code{none}. +submenu in the Text Properties menu. The default justification style +is specified by the per-buffer variable @code{default-justification}. +Its value should be one of the symbols @code{left}, @code{right}, +@code{full}, @code{center}, or @code{none}; their meanings correspond +to the commands above. @node Enriched Properties @subsection Setting Other Text Properties diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 1c667bc56cb..e7bff6c28a4 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex @@ -631,6 +631,9 @@ easily reproducible at all. In that case, you should report what you have---but, as before, please stick to the raw facts about what you did to trigger the bug the first time. + If you have multiple issues that you want to report, please make a +separate bug report for each. + @node Checklist @subsection Checklist for Bug Reports @@ -658,7 +661,13 @@ absolutely sure it is best to leave it, so that the developers can decide for themselves. When you have finished writing your report, type @kbd{C-c C-c} and it -will be sent to the Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}. +will be sent to the Emacs maintainers at +@ifnothtml +@email{bug-gnu-emacs@@gnu.org}. +@end ifnothtml +@ifhtml +@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}. +@end ifhtml (If you want to suggest an improvement or new feature, use the same address.) If you cannot send mail from inside Emacs, you can copy the text of your report to your normal mail client (if your system @@ -839,9 +848,9 @@ To make a backtrace for the error, use @kbd{M-x toggle-debug-on-error} before the error happens (that is to say, you must give that command and then make the bug happen). This causes the error to start the Lisp debugger, which shows you a backtrace. Copy the text of the -debugger's backtrace into the bug report. @xref{Debugger,, The Lisp -Debugger, elisp, the Emacs Lisp Reference Manual}, for information on -debugging Emacs Lisp programs with the Edebug package. +debugger's backtrace into the bug report. @xref{Edebug,, Edebug, +elisp, the Emacs Lisp Reference Manual}, for information on debugging +Emacs Lisp programs with the Edebug package. This use of the debugger is possible only if you know how to make the bug happen again. If you can't make it happen again, at least copy @@ -1134,29 +1143,49 @@ Please help us keep up with the workload by designing the patch in a form that is clearly safe to install. @end itemize +@c FIXME: Include the node above? @node Contributing @section Contributing to Emacs Development @cindex contributing to Emacs -If you would like to help pretest Emacs releases to assure they work -well, or if you would like to work on improving Emacs, please contact -the maintainers at @email{emacs-devel@@gnu.org}. A pretester -should be prepared to investigate bugs as well as report them. If you'd -like to work on improving Emacs, please ask for suggested projects or -suggest your own ideas. +If you would like to work on improving Emacs, please contact the maintainers at +@ifnothtml +@email{emacs-devel@@gnu.org}. +@end ifnothtml +@ifhtml +@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, the +emacs-devel mailing list}. +@end ifhtml +You can ask for suggested projects or suggest your own ideas. If you have already written an improvement, please tell us about it. If you have not yet started work, it is useful to contact -@email{emacs-devel@@gnu.org} before you start; it might be -possible to suggest ways to make your extension fit in better with the -rest of Emacs. +@ifnothtml +@email{emacs-devel@@gnu.org} +@end ifnothtml +@ifhtml +@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, emacs-devel} +@end ifhtml +before you start; it might be possible to suggest ways to make your +extension fit in better with the rest of Emacs. The development version of Emacs can be downloaded from the repository where it is actively maintained by a group of developers. See the Emacs project page @url{http://savannah.gnu.org/projects/emacs/} for details. -For more information on how to contribute, see the @file{etc/CONTRIBUTE} +For more information on how to contribute, see the +@ifset WWW_GNU_ORG +@ifhtml +@url{http://gnu.org/software/emacs/CONTRIBUTE, etc/CONTRIBUTE} +@end ifhtml +@ifnothtml +@file{etc/CONTRIBUTE} +@end ifnothtml +@end ifset +@ifclear WWW_GNU_ORG +@file{etc/CONTRIBUTE} +@end ifclear file in the Emacs distribution. @node Service @@ -1167,15 +1196,21 @@ ways to find it: @itemize @bullet @item -Send a message to the mailing list -@email{help-gnu-emacs@@gnu.org}, or post your request on -newsgroup @code{gnu.emacs.help}. (This mailing list and newsgroup -interconnect, so it does not matter which one you use.) +Send a message to +@ifnothtml +the mailing list @email{help-gnu-emacs@@gnu.org}, +@end ifnothtml +@ifhtml +@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, the +help-gnu-emacs mailing list}, +@end ifhtml +or post your request on newsgroup @code{gnu.emacs.help}. (This +mailing list and newsgroup interconnect, so it does not matter which +one you use.) @item -Look in the service directory for someone who might help you for a fee. -The service directory is found in the file named @file{etc/SERVICE} in the -Emacs distribution. +Look in the @uref{http://www.fsf.org/resources/service/, service +directory} for someone who might help you for a fee. @end itemize @ifnottex diff --git a/doc/emacs/vc-xtra.texi b/doc/emacs/vc-xtra.texi index 41a10bc2ace..52fee145b42 100644 --- a/doc/emacs/vc-xtra.texi +++ b/doc/emacs/vc-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included in emacs-xtra.texi when producing the printed diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 4e701a580a8..07f956c488d 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in vc-xtra.texi (when producing the @@ -199,21 +199,28 @@ through VC@. Most later systems (including CVS, Subversion, bzr, git, and hg) have a native tag facility, and VC uses it where available; those tags will be visible even when you bypass VC. - In a file-oriented VCS, when you rename a registered file you need -to rename its master along with it; the command @code{vc-rename-file} -will do this automatically. If you are using SCCS, you must also -update the records of the tag, to mention the file by its new name -(@code{vc-rename-file} does this, too). An old tag that refers to a -master file that no longer exists under the recorded name is invalid; -VC can no longer retrieve it. It would be beyond the scope of this -manual to explain enough about RCS and SCCS to explain how to update -the tags by hand. Using @code{vc-rename-file} makes the tag remain -valid for retrieval, but it does not solve all problems. For example, -some of the files in your program probably refer to others by name. -At the very least, the makefile probably mentions the file that you -renamed. If you retrieve an old tag, the renamed file is retrieved -under its new name, which is not the name that the makefile expects. -So the program won't really work as retrieved. + In file-based version control systems, when you rename a registered +file you need to rename its master along with it; the command +@code{vc-rename-file} will do this automatically +@iftex +(@pxref{VC Delete/Rename,,,emacs, the Emacs Manual}). +@end iftex +@ifnottex +(@pxref{VC Delete/Rename}). +@end ifnottex +If you are using SCCS, you must also update the records of the tag, to +mention the file by its new name (@code{vc-rename-file} does this, +too). An old tag that refers to a master file that no longer exists +under the recorded name is invalid; VC can no longer retrieve it. It +would be beyond the scope of this manual to explain enough about RCS +and SCCS to explain how to update the tags by hand. Using +@code{vc-rename-file} makes the tag remain valid for retrieval, but it +does not solve all problems. For example, some of the files in your +program probably refer to others by name. At the very least, the +makefile probably mentions the file that you renamed. If you retrieve +an old tag, the renamed file is retrieved under its new name, which is +not the name that the makefile expects. So the program won't really +work as retrieved. @node Version Headers @subsubsection Inserting Version Control Headers @@ -377,12 +384,12 @@ ends that support it, including CVS@. In the following, we will talk only about @code{vc-cvs-stay-local}, but everything applies to @code{vc-stay-local} as well. - If @code{vc-cvs-stay-local} is @code{t} (the default), VC determines -the version control status of each file using only the entry in the -local CVS subdirectory and the information returned by previous CVS -commands. As a consequence, if you have modified a file and somebody -else has checked in other changes, you will not be notified of the -conflict until you try to commit. + If @code{vc-cvs-stay-local} is @code{only-file} (the default), VC +determines the version control status of each file using only the +entry in the local CVS subdirectory and the information returned by +previous CVS commands. As a consequence, if you have modified a file +and somebody else has checked in other changes, you will not be +notified of the conflict until you try to commit. If you change @code{vc-cvs-stay-local} to @code{nil}, VC queries the remote repository @emph{before} it decides what to do in diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 7ed0c682296..4a5f24c13fb 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2013 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Windows @@ -258,7 +258,7 @@ Make all windows the same height (@code{balance-windows}). the space that it occupied is given to an adjacent window (but not the minibuffer window, even if that is active at the time). Deleting the window has no effect on the buffer it used to display; the buffer -continues to exist, and you can still switch to with @kbd{C-x b}. +continues to exist, and you can still switch to it with @kbd{C-x b}. @findex kill-buffer-and-window @kindex C-x 4 0 diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 3723c8e5e1d..b372708d022 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1987, 1993-1995, 1997, 2001-2013 Free Software +@c Copyright (C) 1987, 1993-1995, 1997, 2001-2014 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node X Resources @@ -27,7 +27,7 @@ system registry (@pxref{MS-Windows Registry}). * Resources:: Using X resources with Emacs (in general). * Table of Resources:: Table of specific X resources that affect Emacs. * Lucid Resources:: X resources for Lucid menus. -* LessTif Resources:: X resources for LessTif and Motif menus. +* Motif Resources:: X resources for Motif and LessTif menus. * GTK resources:: Resources for GTK widgets. @end menu @@ -260,7 +260,7 @@ compiled with GTK+ support. @ifnottex @item @code{selectionFont} (class @code{SelectionFont}) Font name for pop-up menu items, in non-toolkit versions of Emacs. (For -toolkit versions, see @ref{Lucid Resources}, also see @ref{LessTif +toolkit versions, see @ref{Lucid Resources}, also see @ref{Motif Resources}.) @item @code{selectionTimeout} (class @code{SelectionTimeout}) @@ -370,15 +370,15 @@ elements. Default is 1. Margin of the menu bar, in characters. Default is 1. @end table -@node LessTif Resources -@appendixsec LessTif Menu X Resources -@cindex Menu X Resources (LessTif widgets) -@cindex LessTif Widget X Resources +@node Motif Resources +@appendixsec Motif Menu X Resources +@cindex Menu X Resources (Motif widgets) +@cindex Motif Widget X Resources - If Emacs is compiled with the X toolkit support using LessTif or -Motif widgets, you can use X resources to customize the appearance of -the menu bar, pop-up menus, and dialog boxes. However, the resources -are organized differently from Lucid widgets. + If Emacs is compiled with the X toolkit support using Motif or +LessTif widgets, you can use X resources to customize the appearance +of the menu bar, pop-up menus, and dialog boxes. However, the +resources are organized differently from Lucid widgets. The resource names for the menu bar are in the @samp{pane.menubar} class, and they must be specified in this form: diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog index 993d0d051e8..6646637c642 100644 --- a/doc/lispintro/ChangeLog +++ b/doc/lispintro/ChangeLog @@ -1,3 +1,148 @@ +2014-02-06 Glenn Morris + + * emacs-lisp-intro.texi (Recursive Patterns): + Do not use colons in index entries. + +2014-01-23 Glenn Morris + + * emacs-lisp-intro.texi (lengths-list-file): Fix textual parentheses. + +2013-12-30 Paul Eggert + + Specify .texi encoding (Bug#16292). + * emacs-lisp-intro.texi: Add @documentencoding. + +2013-12-30 Glenn Morris + + * emacs-lisp-intro.texi: Use @quotation for license notice. + +2013-12-12 Glenn Morris + + * emacs-lisp-intro.texi: Tweak dircategory. + + * emacs-lisp-intro.texi: Sync direntry with info/dir version. + +2013-12-02 Paul Eggert + + * emacs-lisp-intro.texi (Counting Words): Don't use ':' in xref + titles, as this isn't supported by Texinfo. + +2013-11-30 Glenn Morris + + * Makefile.in (distclean): Remove Makefile. + +2013-10-23 Glenn Morris + + * Makefile.in (install-dvi, install-html, install-pdf) + (install-ps, uninstall-dvi, uninstall-html, uninstall-ps) + (uninstall-pdf): Quote entities that might contain whitespace. + +2013-09-01 Glenn Morris + + * emacs-lisp-intro.texi (beginning-of-buffer complete): + Put back a version of the removed paragraph about raw prefix arg. + +2013-09-01 Dani Moncayo + + * emacs-lisp-intro.texi (beginning-of-buffer complete): + Update function details. (Bug#15085) + +2013-08-28 Paul Eggert + + * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-12 Glenn Morris + + * emacs-lisp-intro.texi (Complete copy-region-as-kill): Fix typo. + + * emacs-lisp-intro.texi (Thank You): Avoid mailto: in html output. + + * Makefile.in (prefix, datarootdir, datadir, PACKAGE_TARNAME) + (docdir, dvidir, htmldir, pdfdir, psdir, GZIP_PROG, INSTALL) + (INSTALL_DATA): New, set by configure. + (HTML_OPTS, DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): + New variables. + (.SUFFIXES): Add .ps and .dvi. + (.dvi.ps): New suffix rule. + (dvi, html, pdf, ps): Use *_TARGETS variables. + (emacs-lisp-intro.ps): Remove explicit rule. + (emacs-lisp-intro.html): Use HTML_OPTS. + (clean): Use DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS. + (.PHONY): install-dvi, install-html, install-pdf, install-ps, + install-doc, uninstall-dvi, uninstall-html, uninstall-pdf, + uninstall-ps, and uninstall-doc. + (install-dvi, install-html, install-pdf, install-ps, install-doc) + (uninstall-dvi, uninstall-html, uninstall-ps, uninstall-pdf) + (uninstall-doc): New rules. + +2013-08-07 Eli Zaretskii + + * emacs-lisp-intro.texi (Beginning init File): Rename from + "Beginning a .emacs File", since a node name cannot include a + period. + (Top, Emacs Initialization, Change a defun): All references + changed. (Bug#15038) + +2013-08-02 Xue Fuqiao + + * emacs-lisp-intro.texi (zap-to-char): Remove obsolete stuff. + +2013-07-06 Glenn Morris + + * emacs-lisp-intro.texi (Top): + Move WWW_GNU_ORG section outside @copying, update URL. + +2013-07-03 Glenn Morris + + * emacs-lisp-intro.texi (edebug): Fix cross-references. + +2013-06-19 Glenn Morris + + * Makefile.in (dist): Edit more configure variables. (Bug#14660) + Try to check that we do not miss any in future. + +2013-04-24 Eli Zaretskii + + * makefile.w32-in (INFO_OPTS): Add "-I$(emacsdir)" to fix last + commit. + +2013-04-24 Glenn Morris + + * emacs-lisp-intro.texi (emacsver.texi): Include it. + (copying): For non-printed versions, uses Emacs version rather + than that of the printed book. + (Complications, Lisp macro, defvar and asterisk, defcustom): Copyedits. + * Makefile.in (emacsdir): New variable.. + (MAKEINFO_OPTS, ENVADD): Add $emacsdir. + (srcs): Add emacsver.texi. + (dist): Include emacsver.texi. Edit emacsdir. + * makefile.w32-in (emacsdir): New variable. + (INFO_SOURCES): Add emacsver.texi. + (ENVADD): Add $emacsdir (and $texinfodir). + +2013-04-23 Xue Fuqiao + + * emacs-lisp-intro.texi (Complications, defvar, Writing Defuns) + (Prevent confusion, Determining the Element, lambda): Refine the + doc about Lisp macros, reported by Glenn Morris. + +2013-04-21 Xue Fuqiao + + * emacs-lisp-intro.texi (defcustom, defun) + (simplified-beginning-of-buffer, defvar, Building Robots, Review) + (save-excursion): `defun' and `defcustom' are now macros rather + than special forms. (Bug#13853) + +2013-03-16 Glenn Morris + + * emacs-lisp-intro.texi: Add some stuff specific to www.gnu.org. + +2013-03-03 Glenn Morris + + * emacs-lisp-intro.texi (Digression into C): Update example. + (defcustom, Simple Extension): Fix typos. + 2012-12-22 Glenn Morris * Makefile.in (srcs): New variable, adding doclicense.texi. @@ -7,7 +152,7 @@ 2012-12-14 Paul Eggert - Fix permissions bugs with setgid directories etc. (Bug#13125) + Fix permissions bugs with setgid directories etc. (Bug#13125) * emacs-lisp-intro.texi (Files List): directory-files-and-attributes now outputs t for attribute that's now a placeholder. @@ -568,7 +713,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2001-2013 Free Software Foundation, Inc. + Copyright (C) 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index a6b50b88ad9..c041cd17e02 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -1,6 +1,6 @@ -#### Makefile for the Emacs Lisp Introduction manual +### @configure_input@ -# Copyright (C) 1994-1999, 2001-2013 Free Software Foundation, Inc. +# Copyright (C) 1994-1999, 2001-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -17,42 +17,74 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -SHELL = /bin/sh +SHELL = @SHELL@ +# NB If you add any more configure variables, +# update the sed rules in the dist target below. srcdir = @srcdir@ version=@version@ buildinfodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc +# Directory with emacsver.texi. +emacsdir = $(srcdir)/../emacs + +prefix = @prefix@ +datarootdir = @datarootdir@ +datadir = @datadir@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +docdir = @docdir@ +dvidir = @dvidir@ +htmldir = @htmldir@ +pdfdir = @pdfdir@ +psdir = @psdir@ MKDIR_P = @MKDIR_P@ +GZIP_PROG = @GZIP_PROG@ + +HTML_OPTS = --no-split --html + INFO_EXT=@INFO_EXT@ # Options used only when making info output. INFO_OPTS=@INFO_OPTS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + MAKEINFO = @MAKEINFO@ -MAKEINFO_OPTS = --force -I $(srcdir) +MAKEINFO_OPTS = --force -I $(emacsdir) -I $(srcdir) TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf DVIPS = dvips -ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \ +ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" +DVI_TARGETS = emacs-lisp-intro.dvi +HTML_TARGETS = emacs-lisp-intro.html +PDF_TARGETS = emacs-lisp-intro.pdf +PS_TARGETS = emacs-lisp-intro.ps + mkinfodir = @${MKDIR_P} ${buildinfodir} -srcs = ${srcdir}/emacs-lisp-intro.texi ${srcdir}/doclicense.texi +srcs = ${srcdir}/emacs-lisp-intro.texi ${srcdir}/doclicense.texi \ + ${emacsdir}/emacsver.texi .PHONY: info dvi html pdf ps +.SUFFIXES: .ps .dvi + +.dvi.ps: + $(DVIPS) -o $@ $< + info: ${buildinfodir}/eintr$(INFO_EXT) -dvi: emacs-lisp-intro.dvi -html: emacs-lisp-intro.html -pdf: emacs-lisp-intro.pdf -ps: emacs-lisp-intro.ps +dvi: $(DVI_TARGETS) +html: $(HTML_TARGETS) +pdf: $(PDF_TARGETS) +ps: $(PS_TARGETS) # The file name eintr must fit within 5 characters, to allow for # -NN extensions to fit into DOS 8+3 limits without clashing. @@ -64,14 +96,11 @@ ${buildinfodir}/eintr$(INFO_EXT): ${srcs} emacs-lisp-intro.dvi: ${srcs} $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-lisp-intro.texi -emacs-lisp-intro.ps: emacs-lisp-intro.dvi - $(DVIPS) -o $@ emacs-lisp-intro.dvi - emacs-lisp-intro.pdf: ${srcs} $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-lisp-intro.texi emacs-lisp-intro.html: ${srcs} - $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ ${srcdir}/emacs-lisp-intro.texi + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/emacs-lisp-intro.texi .PHONY: mostlyclean clean distclean maintainer-clean infoclean @@ -80,11 +109,11 @@ mostlyclean: *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs clean: mostlyclean - rm -f emacs-lisp-intro.dvi emacs-lisp-intro.pdf emacs-lisp-intro.ps - rm -rf emacs-lisp-intro.html/ + rm -f $(DVI_TARGETS) $(HTML_TARGETS) $(PDF_TARGETS) $(PS_TARGETS) rm -f emacs-lispintro-${version}.tar* distclean: clean + rm -f Makefile infoclean: -cd $(buildinfodir) && rm -f eintr$(INFO_EXT) eintr$(INFO_EXT)-[1-9] @@ -97,14 +126,68 @@ dist: rm -rf emacs-lispintro-${version} mkdir emacs-lispintro-${version} cp ${srcdir}/*.texi ${srcdir}/*.eps ${srcdir}/*.pdf \ - ${texinfodir}/texinfo.tex \ + ${texinfodir}/texinfo.tex ${emacsdir}/emacsver.texi \ ${srcdir}/ChangeLog* ${srcdir}/README emacs-lispintro-${version}/ sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \ + -e 's/^\(emacsdir *=\).*/\1 ./' \ -e 's/^\(buildinfodir *=\).*/\1 ./' \ -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ + -e 's/@MAKE[I]NFO@/makeinfo/' -e 's/@MK[D]IR_P@/mkdir -p/' \ + -e 's/@IN[F]O_EXT@/.info/' -e 's/@IN[F]O_OPTS@//' \ ${srcdir}/Makefile.in > emacs-lispintro-${version}/Makefile + @if grep '@[a-zA-Z_]*@' emacs-lispintro-${version}/Makefile; then \ + echo "Unexpanded configure variables in Makefile?" 1>&2; exit 1; \ + fi tar -cf emacs-lispintro-${version}.tar emacs-lispintro-${version} rm -rf emacs-lispintro-${version} + +.PHONY: install-dvi install-html install-pdf install-ps install-doc + +install-dvi: dvi + umask 022; $(MKDIR_P) "$(DESTDIR)$(dvidir)" + $(INSTALL_DATA) $(DVI_TARGETS) "$(DESTDIR)$(dvidir)" +install-html: html + umask 022; $(MKDIR_P) "$(DESTDIR)$(htmldir)" + $(INSTALL_DATA) $(HTML_TARGETS) "$(DESTDIR)$(htmldir)" +install-pdf: pdf + umask 022;$(MKDIR_P) "$(DESTDIR)$(pdfdir)" + $(INSTALL_DATA) $(PDF_TARGETS) "$(DESTDIR)$(pdfdir)" +install-ps: ps + umask 022; $(MKDIR_P) "$(DESTDIR)$(psdir)" + for file in $(PS_TARGETS); do \ + $(INSTALL_DATA) $${file} "$(DESTDIR)$(psdir)"; \ + [ -n "${GZIP_PROG}" ] || continue; \ + rm -f "$(DESTDIR)$(psdir)/$${file}.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)$(psdir)/$${file}"; \ + done + +## Top-level Makefile installs the info pages. +install-doc: install-dvi install-html install-pdf install-ps + + +.PHONY: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps uninstall-doc + +uninstall-dvi: + for file in $(DVI_TARGETS); do \ + rm -f "$(DESTDIR)$(dvidir)/$${file}"; \ + done +uninstall-html: + for file in $(HTML_TARGETS); do \ + rm -f "$(DESTDIR)$(htmldir)/$${file}"; \ + done +uninstall-ps: + ext= ; [ -n "${GZIP_PROG}" ] && ext=.gz; \ + for file in $(PS_TARGETS); do \ + rm -f "$(DESTDIR)$(psdir)/$${file}$${ext}"; \ + done +uninstall-pdf: + for file in $(PDF_TARGETS); do \ + rm -f "$(DESTDIR)$(pdfdir)/$${file}"; \ + done + +uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps + + ### Makefile ends here diff --git a/doc/lispintro/README b/doc/lispintro/README index 360d6296b70..872813e6d2b 100644 --- a/doc/lispintro/README +++ b/doc/lispintro/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. @@ -12,43 +12,6 @@ environment. This third edition of 2006 Oct 31 updates the previous editions to GNU Emacs 22. -The Texinfo source file `emacs-lisp-intro.texi', formats without -reported error using `pdfeTeXk', Version 3.141592-1.21a-2.2 (Web2C -7.5.4) and texinfo.tex version 2006-08-26.17 started by `texi2dvi' -version 4.8, and with `makeinfo' version 4.8. - -This directory contains the following Encapsulated PostScript figures: - - cons-1.eps, cons-2.eps, cons-2a.eps, cons-3.eps, cons-4.eps, cons-5.eps - drawers.eps, lambda-1.eps, lambda-2.eps, lambda-3.eps - -See the beginning of the `emacs-lisp-intro.texi' file for appropriate -settings. These figures are not necessary; they are merely nice to -look at --- without them you get the same figures printed with ASCII -characters. - -Whether and how you print PostScript depends on your site. You not -only need to set 'print-postscript-figures' before creating the .dvi -file, but then must convert the .dvi file to .ps with a 'dvips' or -equivalent command. - -On some systems you will see an error message when `psfig.tex' is -loaded for the last two .eps files: - - ! No room for a new \write . - -If this happens, try `epsf.tex' instead of `psfig.tex', or try typing -RET at the error; the formatting may continue successfully. - -Or else find the section that says: - - @c !!! Clear print-postscript-figures if the computer formatting this - @c document is too small and cannot handle all the diagrams and figures. - @c clear print-postscript-figures - -and change the file so it reads: @clear print-postscript-figures -This will prevent TeX from attempting to load the last few .eps files. - You will find additional instructions on formatting in the beginning of the Texinfo file 'emacs-lisp-intro.texi'. Best Wishes! diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps index 77d24cbddcc..06cc7cc5e64 100644 --- a/doc/lispintro/cons-1.eps +++ b/doc/lispintro/cons-1.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:26:58 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps index 961b00a13ec..e942b6264e7 100644 --- a/doc/lispintro/cons-2.eps +++ b/doc/lispintro/cons-2.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:26:39 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps index 993609638a1..847d02ba960 100644 --- a/doc/lispintro/cons-2a.eps +++ b/doc/lispintro/cons-2a.eps @@ -4,7 +4,7 @@ %%CreationDate: Tue Mar 14 15:09:30 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps index e37dad0de60..b81dc4faa1a 100644 --- a/doc/lispintro/cons-3.eps +++ b/doc/lispintro/cons-3.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:25:41 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps index 9af4c2afd75..750878daa68 100644 --- a/doc/lispintro/cons-4.eps +++ b/doc/lispintro/cons-4.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:25:06 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps index 8a400f320de..14edd8432a4 100644 --- a/doc/lispintro/cons-5.eps +++ b/doc/lispintro/cons-5.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:27:28 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps index abfec2a7362..ce96e7b964e 100644 --- a/doc/lispintro/drawers.eps +++ b/doc/lispintro/drawers.eps @@ -9,7 +9,7 @@ %%EndComments %%BeginProlog -% Copyright (C) 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 3f9208c3c27..74ea8e26e63 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -4,141 +4,17 @@ @c setfilename emacs-lisp-intro.info @c sethtmlfilename emacs-lisp-intro.html @settitle Programming in Emacs Lisp +@documentencoding UTF-8 @syncodeindex vr cp @syncodeindex fn cp @finalout -@c --------- -@c <<<< For hard copy printing, this file is now -@c set for smallbook, which works for all sizes -@c of paper, and with PostScript figures >>>> -@set smallbook -@ifset smallbook -@smallbook -@clear largebook -@end ifset -@set print-postscript-figures -@c set largebook -@c clear print-postscript-figures -@c --------- - -@comment %**end of header - -@c per rms and peterb, use 10pt fonts for the main text, mostly to -@c save on paper cost. -@c Do this inside @tex for now, so current makeinfo does not complain. -@tex -@ifset smallbook -@fonttextsize 10 - -@end ifset -\global\hbadness=6666 % don't worry about not-too-underfull boxes -@end tex - -@set edition-number 3.10 -@set update-date 28 October 2009 - -@ignore - ## Summary of shell commands to create various output formats: - - pushd /usr/local/src/emacs/lispintro/ - ## pushd /u/intro/ - - ## Info output - makeinfo --paragraph-indent=0 --verbose emacs-lisp-intro.texi - - ## ;; (progn (when (bufferp (get-buffer "*info*")) (kill-buffer "*info*")) (info "/usr/local/src/emacs/info/eintr")) - - ## DVI output - texi2dvi emacs-lisp-intro.texi - - ## xdvi -margins 24pt -topmargin 4pt -offsets 24pt -geometry 760x1140 -s 5 -useTeXpages -mousemode 1 emacs-lisp-intro.dvi & - - ## HTML output - makeinfo --html --no-split --verbose emacs-lisp-intro.texi - - ## galeon emacs-lisp-intro.html - - ## Plain text output - makeinfo --fill-column=70 --no-split --paragraph-indent=0 \ - --verbose --no-headers --output=emacs-lisp-intro.txt emacs-lisp-intro.texi - - popd - -# as user `root' -# insert thumbdrive - mtusb # mount -v -t ext3 /dev/sda /mnt - cp -v /u/intro/emacs-lisp-intro.texi /mnt/backup/intro/emacs-lisp-intro.texi - umtusb # umount -v /mnt -# remove thumbdrive - - ## Other shell commands - - pushd /usr/local/src/emacs/lispintro/ - ## pushd /u/intro/ - - ## PDF - texi2dvi --pdf emacs-lisp-intro.texi - # xpdf emacs-lisp-intro.pdf & - - ## DocBook -- note file extension - makeinfo --docbook --no-split --paragraph-indent=0 \ - --verbose --output=emacs-lisp-intro.docbook emacs-lisp-intro.texi - - ## XML with a Texinfo DTD -- note file extension - makeinfo --xml --no-split --paragraph-indent=0 \ - --verbose --output=emacs-lisp-intro.texinfoxml emacs-lisp-intro.texi - - ## PostScript (needs DVI) - # gv emacs-lisp-intro.ps & - # Create DVI if we lack it - # texi2dvi emacs-lisp-intro.texi - dvips emacs-lisp-intro.dvi -o emacs-lisp-intro.ps - - ## RTF (needs HTML) - # Use OpenOffice to view RTF - # Create HTML if we lack it - # makeinfo --no-split --html emacs-lisp-intro.texi - /usr/local/src/html2rtf.pl emacs-lisp-intro.html - - ## LaTeX (needs RTF) - /usr/bin/rtf2latex emacs-lisp-intro.rtf - - popd - -@end ignore - -@c ================ Included Figures ================ - -@c Set print-postscript-figures if you print PostScript figures. -@c If you clear this, the ten figures will be printed as ASCII diagrams. -@c (This is not relevant to Info, since Info only handles ASCII.) -@c Your site may require editing changes to print PostScript; in this -@c case, search for `print-postscript-figures' and make appropriate changes. - -@c ================ How to Create an Info file ================ - -@c If you have `makeinfo' installed, run the following command - -@c makeinfo emacs-lisp-intro.texi - -@c or, if you want a single, large Info file, and no paragraph indents: -@c makeinfo --no-split --paragraph-indent=0 --verbose emacs-lisp-intro.texi - -@c After creating the Info file, edit your Info `dir' file, if the -@c `dircategory' section below does not enable your system to -@c install the manual automatically. -@c (The `dir' file is often in the `/usr/local/share/info/' directory.) - -@c ================ How to Create an HTML file ================ - -@c To convert to HTML format -@c makeinfo --html --no-split --verbose emacs-lisp-intro.texi +@include emacsver.texi @c ================ How to Print a Book in Various Sizes ================ @c This book can be printed in any of three different sizes. -@c In the above header, set @-commands appropriately. +@c Set the following @-commands appropriately. @c 7 by 9.25 inches: @c @smallbook @@ -153,38 +29,43 @@ @c @afourpaper @c @set largebook -@c ================ How to Typeset and Print ================ - -@c If you do not include PostScript figures, run either of the -@c following command sequences, or similar commands suited to your -@c system: - -@c texi2dvi emacs-lisp-intro.texi -@c lpr -d emacs-lisp-intro.dvi - -@c or else: - -@c tex emacs-lisp-intro.texi -@c texindex emacs-lisp-intro.?? -@c tex emacs-lisp-intro.texi -@c lpr -d emacs-lisp-intro.dvi - -@c If you include the PostScript figures, and you have old software, -@c you may need to convert the .dvi file to a .ps file before -@c printing. Run either of the following command sequences, or one -@c similar: -@c -@c dvips -f < emacs-lisp-intro.dvi > emacs-lisp-intro.ps -@c -@c or else: -@c -@c postscript -p < emacs-lisp-intro.dvi > emacs-lisp-intro.ps -@c - @c (Note: if you edit the book so as to change the length of the @c table of contents, you may have to change the value of `pageno' below.) -@c ================ End of Formatting Sections ================ +@c <<<< For hard copy printing, this file is now +@c set for smallbook, which works for all sizes +@c of paper, and with PostScript figures >>>> + +@set smallbook +@ifset smallbook +@smallbook +@clear largebook +@end ifset + +@c ================ Included Figures ================ + +@c If you clear this, the figures will be printed as ASCII diagrams +@c rather than PostScript/PDF. +@c (This is not relevant to Info, since Info only handles ASCII.) +@set print-postscript-figures +@c clear print-postscript-figures + +@comment %**end of header + +@c per rms and peterb, use 10pt fonts for the main text, mostly to +@c save on paper cost. +@c Do this inside @tex for now, so current makeinfo does not complain. +@tex +@ifset smallbook +@fonttextsize 10 + +@end ifset +\global\hbadness=6666 % don't worry about not-too-underfull boxes +@end tex + +@c These refer to the printed book sold by the FSF. +@set edition-number 3.10 +@set update-date 28 October 2009 @c For next or subsequent edition: @c create function using with-output-to-temp-buffer @@ -216,26 +97,30 @@ @c ---------------------------------------------------- -@dircategory GNU Emacs Lisp +@dircategory Emacs lisp @direntry -* Emacs Lisp Intro: (eintr). - A simple introduction to Emacs Lisp programming. +* Emacs Lisp Intro: (eintr). A simple introduction to Emacs Lisp programming. @end direntry @copying This is an @cite{Introduction to Programming in Emacs Lisp}, for people who are not programmers. @sp 1 +@iftex Edition @value{edition-number}, @value{update-date} +@end iftex +@ifnottex +Distributed with Emacs version @value{EMACSVER}. +@end ifnottex @sp 1 -Copyright @copyright{} 1990--1995, 1997, 2001--2013 Free Software +Copyright @copyright{} 1990--1995, 1997, 2001--2014 Free Software Foundation, Inc. @sp 1 @iftex Published by the:@* -GNU Press, @hfill @uref{http://www.fsf.org/campaigns/gnu-press/}@* +GNU Press, @hfill @uref{http://www.fsf.org/licensing/gnu-press/}@* a division of the @hfill email: @email{sales@@fsf.org}@* Free Software Foundation, Inc. @hfill Tel: +1 (617) 542-5942@* 51 Franklin Street, Fifth Floor @hfill Fax: +1 (617) 542-2652@* @@ -243,10 +128,10 @@ Boston, MA 02110-1301 USA @end iftex @ifnottex -Published by the: +Printed copies available from @uref{http://shop.fsf.org/}. Published by: @example -GNU Press, http://www.fsf.org/campaigns/gnu-press/ +GNU Press, http://www.fsf.org/licensing/gnu-press/ a division of the email: sales@@fsf.org Free Software Foundation, Inc. Tel: +1 (617) 542-5942 51 Franklin Street, Fifth Floor Fax: +1 (617) 542-2652 @@ -255,9 +140,9 @@ Boston, MA 02110-1301 USA @end ifnottex @sp 1 -@c Printed copies are available from @uref{http://shop.fsf.org/} for $35 each.@* ISBN 1-882114-43-4 +@quotation Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; there @@ -269,6 +154,7 @@ Documentation License''. (a) The FSF's Back-Cover Text is: ``You have the freedom to copy and modify this GNU manual. Buying copies from the FSF supports it in developing GNU and promoting software freedom.'' +@end quotation @end copying @c half title; two lines here, so do not use `shorttitlepage' @@ -319,6 +205,15 @@ supports it in developing GNU and promoting software freedom.'' @node Top @top An Introduction to Programming in Emacs Lisp +@ifset WWW_GNU_ORG +@html +

          The homepage for GNU Emacs is at +http://www.gnu.org/software/emacs/.
          +To view this manual in other formats, click +here. +@end html +@end ifset + @insertcopying This master menu first lists each chapter and index; then it lists @@ -448,7 +343,7 @@ Practicing Evaluation How To Write Function Definitions * Primitive Functions:: -* defun:: The @code{defun} special form. +* defun:: The @code{defun} macro. * Install:: Install a function definition. * Interactive:: Making a function interactive. * Interactive Options:: Different options for @code{interactive}. @@ -755,7 +650,7 @@ Your @file{.emacs} File * Default Configuration:: * Site-wide Init:: You can write site-wide init files. * defcustom:: Emacs will write code for you. -* Beginning a .emacs File:: How to write a @code{.emacs file}. +* Beginning init File:: How to write a @file{.emacs} init file. * Text and Auto-fill:: Automatically wrap lines. * Mail Aliases:: Use abbreviations for email addresses. * Indent Tabs Mode:: Don't use tabs with @TeX{} @@ -1061,7 +956,12 @@ encouragement. My mistakes are my own. @flushright Robert J. Chassell +@ifnothtml @email{bob@@gnu.org} +@end ifnothtml +@ifhtml +bob@@gnu.org +@end ifhtml @end flushright @c ================ Beginning of main text ================ @@ -1609,13 +1509,25 @@ the symbol's value as a @dfn{variable}. This situation is described in the section on variables. (@xref{Variables}.) @cindex Special form -The second complication occurs because some functions are unusual and do -not work in the usual manner. Those that don't are called @dfn{special -forms}. They are used for special jobs, like defining a function, and -there are not many of them. In the next few chapters, you will be -introduced to several of the more important special forms. +The second complication occurs because some functions are unusual and +do not work in the usual manner. Those that don't are called +@dfn{special forms}. They are used for special jobs, like defining a +function, and there are not many of them. In the next few chapters, +you will be introduced to several of the more important special forms. -The third and final complication is this: if the function that the +As well as special forms, there are also @dfn{macros}. A macro +is a construct defined in Lisp, which differs from a function in that it +translates a Lisp expression into another expression that is to be +evaluated in place of the original expression. (@xref{Lisp macro}.) + +For the purposes of this introduction, you do not need to worry too much +about whether something is a special form, macro, or ordinary function. +For example, @code{if} is a special form (@pxref{if}), but @code{when} +is a macro (@pxref{Lisp macro}). In earlier versions of Emacs, +@code{defun} was a special form, but now it is a macro (@pxref{defun}). +It still behaves in the same way. + +The final complication is this: if the function that the Lisp interpreter is looking at is not a special form, and if it is part of a list, the Lisp interpreter looks to see whether the list has a list inside of it. If there is an inner list, the Lisp interpreter first @@ -3045,7 +2957,7 @@ symbol refers to it.) @menu * Primitive Functions:: -* defun:: The @code{defun} special form. +* defun:: The @code{defun} macro. * Install:: Install a function definition. * Interactive:: Making a function interactive. * Interactive Options:: Different options for @code{interactive}. @@ -3086,18 +2998,15 @@ unless you investigate, you won't know whether an already-written function is written in Emacs Lisp or C. @node defun -@section The @code{defun} Special Form +@section The @code{defun} Macro @findex defun -@cindex Special form of @code{defun} @cindex @samp{function definition} defined In Lisp, a symbol such as @code{mark-whole-buffer} has code attached to it that tells the computer what to do when the function is called. This code is called the @dfn{function definition} and is created by evaluating a Lisp expression that starts with the symbol @code{defun} -(which is an abbreviation for @emph{define function}). Because -@code{defun} does not evaluate its arguments in the usual way, it is -called a @dfn{special form}. +(which is an abbreviation for @emph{define function}). In subsequent sections, we will look at function definitions from the Emacs source code, such as @code{mark-whole-buffer}. In this section, @@ -3358,7 +3267,7 @@ line that follows a semicolon is a comment. The end of the line is the end of the comment. To stretch a comment over two or more lines, begin each line with a semicolon. -@xref{Beginning a .emacs File, , Beginning a @file{.emacs} +@xref{Beginning init File, , Beginning a @file{.emacs} File}, and @ref{Comments, , Comments, elisp, The GNU Emacs Lisp Reference Manual}, for more about comments. @@ -3689,7 +3598,7 @@ name for a @dfn{local variable} that overshadows any use of the same name outside the @code{let} expression. This is like understanding that whenever your host refers to `the house', he means his house, not yours. (Symbols used in argument lists work the same way. -@xref{defun, , The @code{defun} Special Form}.) +@xref{defun, , The @code{defun} Macro}.) Local variables created by a @code{let} expression retain their value @emph{only} within the @code{let} expression itself (and within @@ -4246,7 +4155,7 @@ On the other hand, this function returns @code{nil} if the test is false. @findex point @findex mark -The @code{save-excursion} function is the fourth and final special form +The @code{save-excursion} function is the third and final special form that we will discuss in this chapter. In Emacs Lisp programs used for editing, the @code{save-excursion} @@ -4373,9 +4282,9 @@ within the body of a @code{let} expression. It looks like this: @node Review @section Review -In the last few chapters we have introduced a fair number of functions -and special forms. Here they are described in brief, along with a few -similar functions that have not been mentioned yet. +In the last few chapters we have introduced a macro and a fair number +of functions and special forms. Here they are described in brief, +along with a few similar functions that have not been mentioned yet. @table @code @item eval-last-sexp @@ -4385,10 +4294,10 @@ invoked with an argument; in that case, the output is printed in the current buffer. This command is normally bound to @kbd{C-x C-e}. @item defun -Define function. This special form has up to five parts: the name, -a template for the arguments that will be passed to the function, -documentation, an optional interactive declaration, and the body of the -definition. +Define function. This macro has up to five parts: the name, a +template for the arguments that will be passed to the function, +documentation, an optional interactive declaration, and the body of +the definition. @need 1250 For example, in an early version of Emacs, the function definition was @@ -4795,7 +4704,7 @@ leave mark at previous position." @end smallexample Like all function definitions, this definition has five parts following -the special form @code{defun}: +the macro @code{defun}: @enumerate @item @@ -6416,7 +6325,7 @@ and avoids clobbering the mark." (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) - (if arg (forward-line 1))) + (if (and arg (not (consp arg))) (forward-line 1))) @end group @end smallexample @@ -6483,7 +6392,7 @@ to move point to the beginning of the next line if the command is invoked with an argument: @smallexample -(if arg (forward-line 1))) +(if (and arg (not (consp arg))) (forward-line 1)) @end smallexample @noindent @@ -6492,14 +6401,10 @@ appropriate tenths position in the buffer. This is a flourish that means that the cursor is always located @emph{at least} the requested tenths of the way through the buffer, which is a nicety that is, perhaps, not necessary, but which, if it did not occur, would be sure -to draw complaints. - -On the other hand, it also means that if you specify the command with -a @kbd{C-u}, but without a number, that is to say, if the `raw prefix -argument' is simply a cons cell, then the command puts you at the -beginning of the second line @dots{} I don't know whether this is -intended or whether no one has dealt with the code to avoid this -happening. +to draw complaints. (The @code{(not (consp arg))} portion is so that +if you specify the command with a @kbd{C-u}, but without a number, +that is to say, if the `raw prefix argument' is simply a cons cell, +the command does not put you at the beginning of the second line.) @node Second Buffer Related Review @section Review @@ -7635,20 +7540,7 @@ retrieved. @xref{Yanking, , Yanking Text Back}. @section @code{zap-to-char} @findex zap-to-char -@c FIXME remove obsolete stuff -The @code{zap-to-char} function changed little between GNU Emacs -version 19 and GNU Emacs version 22. However, @code{zap-to-char} -calls another function, @code{kill-region}, which enjoyed a major -rewrite. - -The @code{kill-region} function in Emacs 19 is complex, but does not -use code that is important at this time. We will skip it. - -The @code{kill-region} function in Emacs 22 is easier to read than the -same function in Emacs 19 and introduces a very important concept, -that of error handling. We will walk through the function. - -But first, let us look at the interactive @code{zap-to-char} function. +Let us look at the interactive @code{zap-to-char} function. @menu * Complete zap-to-char:: The complete implementation. @@ -8302,7 +8194,7 @@ an @code{if} without the possibility of an else clause. In your mind, you can replace @code{when} with @code{if} and understand what goes on. That is what the Lisp interpreter does. -Technically speaking, @code{when} is a Lisp macro. A Lisp @dfn{macro} +Technically speaking, @code{when} is a Lisp macro. A Lisp macro enables you to define new control constructs and other language features. It tells the interpreter how to compute another Lisp expression which will in turn compute the value. In this case, the @@ -8423,7 +8315,7 @@ As usual, this function can be divided into its component parts: The arguments are @code{beg} and @code{end} and the function is interactive with @code{"r"}, so the two arguments must refer to the -beginning and end of the region. If you have been reading though this +beginning and end of the region. If you have been reading through this document from the beginning, understanding these parts of a function is almost becoming routine. @@ -9116,8 +9008,8 @@ Lisp; it is written in C and is one of the primitives of the GNU Emacs system. Since it is very simple, I will digress briefly from Lisp and describe it here. -@c GNU Emacs 22 in /usr/local/src/emacs/src/editfns.c -@c the DEFUN for buffer-substring-no-properties +@c GNU Emacs 24 in src/editfns.c +@c the DEFUN for delete-and-extract-region @need 1500 Like many of the other Emacs primitives, @@ -9127,22 +9019,15 @@ like this: @smallexample @group -DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, - Sbuffer_substring_no_properties, 2, 2, 0, - doc: /* Return the characters of part of the buffer, -without the text properties. -The two arguments START and END are character positions; -they can be in either order. */) - (start, end) - Lisp_Object start, end; +DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, + Sdelete_and_extract_region, 2, 2, 0, + doc: /* Delete the text between START and END and return it. */) + (Lisp_Object start, Lisp_Object end) @{ - register int b, e; - validate_region (&start, &end); - b = XINT (start); - e = XINT (end); - - return make_buffer_string (b, e, 0); + if (XINT (start) == XINT (end)) + return empty_unibyte_string; + return del_range_1 (XINT (start), XINT (end), 1, 1); @} @end group @end smallexample @@ -9192,20 +9077,9 @@ and provides a prompt. @item The seventh part is a documentation string, just like the one for a -function written in Emacs Lisp, except that every newline must be -written explicitly as @samp{\n} followed by a backslash and carriage -return. - -@need 1000 -Thus, the first two lines of documentation for @code{goto-char} are -written like this: - -@smallexample -@group - "Set point to POSITION, a number or marker.\n\ -Beginning of buffer is position (point-min), end is (point-max)." -@end group -@end smallexample +function written in Emacs Lisp. This is written as a C comment. (When +you build Emacs, the program @command{lib-src/make-docfile} extracts +these comments and uses them to make the ``real'' documentation.) @end itemize @need 1200 @@ -9218,15 +9092,15 @@ consists of the following four lines: @group validate_region (&start, &end); if (XINT (start) == XINT (end)) - return build_string (""); + return empty_unibyte_string; return del_range_1 (XINT (start), XINT (end), 1, 1); @end group @end smallexample -The @code{validate_region} function checks whether the values +The @code{validate_region} function checks whether the values passed as the beginning and end of the region are the proper type and are within range. If the beginning and end positions are the same, -then return and empty string. +then return an empty string. The @code{del_range_1} function actually deletes the text. It is a complex function we will not look into. It updates the buffer and @@ -9303,7 +9177,7 @@ have a value. If the variable already has a value, @code{defvar} does not override the existing value. Second, @code{defvar} has a documentation string. -(Another special form, @code{defcustom}, is designed for variables +(There is a related macro, @code{defcustom}, designed for variables that people customize. It has more features than @code{defvar}. (@xref{defcustom, , Setting Variables with @code{defcustom}}.) @@ -9373,7 +9247,7 @@ In the past, Emacs used the @code{defvar} special form both for internal variables that you would not expect a user to change and for variables that you do expect a user to change. Although you can still use @code{defvar} for user customizable variables, please use -@code{defcustom} instead, since that special form provides a path into +@code{defcustom} instead, since it provides a path into the Customization commands. (@xref{defcustom, , Specifying Variables using @code{defcustom}}.) @@ -9634,10 +9508,6 @@ This sounds more complicated than it is and is easier seen in a diagram: @sp 1 @tex @center @image{cons-1} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-1.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -9697,10 +9567,6 @@ bouquet @sp 1 @tex @center @image{cons-2} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-2.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -9746,10 +9612,6 @@ bouquet @sp 1 @tex @center @image{cons-2a} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-2a.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -9813,10 +9675,6 @@ bouquet flowers @sp 1 @tex @center @image{cons-3} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-3.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -9885,10 +9743,6 @@ bouquet flowers @sp 1 @tex @center @image{cons-4} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-4.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -10002,10 +9856,6 @@ Here is a fanciful representation: @sp 1 @tex @center @image{drawers} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/drawers.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -10178,10 +10028,6 @@ kill-ring kill-ring-yank-pointer @sp 1 @tex @center @image{cons-5} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/cons-5.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -11310,11 +11156,11 @@ Let's expand on the metaphor in which a computer program is a robot. A function definition provides the blueprints for a robot. When you install a function definition, that is, when you evaluate a -@code{defun} special form, you install the necessary equipment to -build robots. It is as if you were in a factory, setting up an -assembly line. Robots with the same name are built according to the -same blueprints. So they have, as it were, the same `model number', -but a different `serial number'. +@code{defun} macro, you install the necessary equipment to build +robots. It is as if you were in a factory, setting up an assembly +line. Robots with the same name are built according to the same +blueprints. So they have, as it were, the same `model number', but a +different `serial number'. We often say that a recursive function `calls itself'. What we mean is that the instructions in a recursive function cause the Lisp @@ -11764,7 +11610,7 @@ and this provides a sense of its primal capabilities. @node Every @unnumberedsubsubsec Recursive Pattern: @emph{every} @cindex Every, type of recursive pattern -@cindex Recursive pattern: every +@cindex Recursive pattern - every In the @code{every} recursive pattern, an action is performed on every element of a list. @@ -11863,7 +11709,7 @@ But when the list has at least one element, @node Accumulate @unnumberedsubsubsec Recursive Pattern: @emph{accumulate} @cindex Accumulate, type of recursive pattern -@cindex Recursive pattern: accumulate +@cindex Recursive pattern - accumulate Another recursive pattern is called the @code{accumulate} pattern. In the @code{accumulate} recursive pattern, an action is performed on @@ -11914,7 +11760,7 @@ accumulate pattern. @node Keep @unnumberedsubsubsec Recursive Pattern: @emph{keep} @cindex Keep, type of recursive pattern -@cindex Recursive pattern: keep +@cindex Recursive pattern - keep A third recursive pattern is called the @code{keep} pattern. In the @code{keep} recursive pattern, each element of a list is tested; @@ -12066,7 +11912,6 @@ more steps. @node No deferment solution @subsection No Deferment Solution @cindex No deferment solution -@cindex Defermentless solution @cindex Solution without deferment The solution to the problem of deferred operations is to write in a @@ -13700,7 +13545,7 @@ regexps. @xref{the-the, , @code{the-the} Duplicated Words Function}. @end itemize @node Counting Words -@chapter Counting: Repetition and Regexps +@chapter Counting via Repetition and Regexps @cindex Repetition for word counting @cindex Regular expressions for word counting @@ -14584,7 +14429,7 @@ exclamation mark, and question mark. Do the same using recursion. Our next project is to count the number of words in a function definition. Clearly, this can be done using some variant of -@code{@value{COUNT-WORDS}}. @xref{Counting Words, , Counting Words: +@code{@value{COUNT-WORDS}}. @xref{Counting Words, , Counting via Repetition and Regexps}. If we are just going to count the words in one definition, it is easy enough to mark the definition with the @kbd{C-M-h} (@code{mark-defun}) command, and then call @@ -15216,18 +15061,19 @@ C-e} (@code{eval-last-sexp}). @c !!! 22.1.1 lisp sources location here @smallexample (lengths-list-file - "/usr/local/share/emacs/22.1.1/lisp/emacs-lisp/debug.el") + "/usr/local/share/emacs/22.1/lisp/emacs-lisp/debug.el") @end smallexample @noindent -(You may need to change the pathname of the file; the one here is for -GNU Emacs version 22.1.1. To change the expression, copy it to +You may need to change the pathname of the file; the one here is for +GNU Emacs version 22.1. To change the expression, copy it to the @file{*scratch*} buffer and edit it. @need 1200 @noindent -(Also, to see the full length of the list, rather than a truncated +Also, to see the full length of the list, rather than a truncated version, you may have to evaluate the following: +@c We do not want to insert, so do not mention the zero prefix argument. @smallexample (custom-set-variables '(eval-expression-print-length nil)) @@ -15253,7 +15099,8 @@ took seven seconds to produce and looked like this: (75 41 80 62 20 45 44 68 45 12 34 235) @end smallexample -(The newer version of @file{debug.el} contains more defuns than the +@noindent +The newer version of @file{debug.el} contains more defuns than the earlier one; and my new machine is much faster than the old one.) Note that the length of the last definition in the file is first in @@ -15758,7 +15605,7 @@ Let's write a function definition to do these tasks. We will use a directory, checking what needs to be done; and we will use a recursive call to repeat the actions on each sub-directory. The recursive pattern is `accumulate' -(@pxref{Accumulate, , Recursive Pattern: @emph{accumulate}}), +(@pxref{Accumulate}), using @code{append} as the combiner. @ignore @@ -16863,7 +16710,7 @@ expressions in Emacs Lisp you can change or extend Emacs. * Default Configuration:: * Site-wide Init:: You can write site-wide init files. * defcustom:: Emacs will write code for you. -* Beginning a .emacs File:: How to write a @code{.emacs file}. +* Beginning init File:: How to write a @file{.emacs} init file. * Text and Auto-fill:: Automatically wrap lines. * Mail Aliases:: Use abbreviations for email addresses. * Indent Tabs Mode:: Don't use tabs with @TeX{} @@ -16981,10 +16828,9 @@ definitions; but you can write @code{defuns} in your @file{.emacs} file. Indeed, you can write any Lisp expression in your @file{.emacs} file.) -The @code{customize} feature depends on the @code{defcustom} special -form. Although you can use @code{defvar} or @code{setq} for variables -that users set, the @code{defcustom} special form is designed for the -job. +The @code{customize} feature depends on the @code{defcustom} macro. +Although you can use @code{defvar} or @code{setq} for variables that +users set, the @code{defcustom} macro is designed for the job. You can use your knowledge of @code{defvar} for writing the first three arguments for @code{defcustom}. The first argument to @@ -17010,7 +16856,7 @@ For example, the customizable user option variable "Normal hook run when entering Text mode and many related modes." :type 'hook :options '(turn-on-auto-fill flyspell-mode) - :group 'data) + :group 'wp) @end group @end smallexample @@ -17033,7 +16879,7 @@ Finally, the @code{:group} keyword tells the Emacs Customization command in which group the variable is located. This tells where to find it. -The @code{defcustom} function recognizes more than a dozen keywords. +The @code{defcustom} macro recognizes more than a dozen keywords. For more information, see @ref{Customization, , Writing Customization Definitions, elisp, The GNU Emacs Lisp Reference Manual}. @@ -17135,7 +16981,7 @@ intent is that neither programs nor users should ever change a value set by @code{defconst}. (You can change it; the value set is a variable; but please do not.) -@node Beginning a .emacs File +@node Beginning init File @section Beginning a @file{.emacs} File @cindex @file{.emacs} file, beginning of @@ -17829,7 +17675,7 @@ emacs -q --no-site-file -eval '(blink-cursor-mode nil)' @exdent Or nowadays, using an even more sophisticated set of options, -emacs -Q - D +emacs -Q -D @end smallexample }: @@ -18629,7 +18475,7 @@ shows which line you are currently executing. You can walk through the execution of a function, line by line, or run quickly until reaching a @dfn{breakpoint} where execution stops. -Edebug is described in @ref{edebug, , Edebug, elisp, The GNU Emacs +Edebug is described in @ref{Edebug, , , elisp, The GNU Emacs Lisp Reference Manual}. @need 1250 @@ -18756,7 +18602,7 @@ error or at specified stopping points; you can cause it to display the changing values of various expressions; you can find out how many times a function is called, and more. -Edebug is described in @ref{edebug, , Edebug, elisp, The GNU Emacs +Edebug is described in @ref{Edebug, , , elisp, The GNU Emacs Lisp Reference Manual}. @need 1500 @@ -19464,7 +19310,7 @@ them in an argument list (and within expressions called by them). @ignore @c texi2dvi fails when the name of the section is within ifnottex ... (@xref{Prevent confusion, , @code{let} Prevents Confusion}, and -@ref{defun, , The @code{defun} Special Form}.) +@ref{defun, , The @code{defun} Macro}.) @end ignore @node yank @@ -20984,16 +20830,13 @@ equivalent of @code{multiply-by-seven} is: @end smallexample @noindent -(@xref{defun, , The @code{defun} Special Form}.) +(@xref{defun, , The @code{defun} Macro}.) @need 1250 @noindent If we want to multiply 3 by 7, we can write: -@c !!! Clear print-postscript-figures if the computer formatting this -@c document is too small and cannot handle all the diagrams and figures. @c clear print-postscript-figures -@c set print-postscript-figures @c lambda example diagram #1 @ifnottex @smallexample @@ -21009,10 +20852,6 @@ If we want to multiply 3 by 7, we can write: @sp 1 @tex @center @image{lambda-1} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/lambda-1.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -21051,10 +20890,6 @@ Similarly, we can write: @sp 1 @tex @center @image{lambda-2} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/lambda-2.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset @@ -21090,10 +20925,6 @@ If we want to divide 100 by 50, we can write: @sp 1 @tex @center @image{lambda-3} -%%%% old method of including an image -% \input /usr/local/lib/tex/inputs/psfig.tex -% \centerline{\psfig{figure=/usr/local/lib/emacs/man/lambda-3.eps}} -% \catcode`\@=0 % @end tex @sp 1 @end ifset diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps index 11f3318037c..62025bd7018 100644 --- a/doc/lispintro/lambda-1.eps +++ b/doc/lispintro/lambda-1.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:31:53 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps index 3022ce9bb6c..c4c2b90a962 100644 --- a/doc/lispintro/lambda-2.eps +++ b/doc/lispintro/lambda-2.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:33:09 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps index 0d66eb73332..8103195a5c0 100644 --- a/doc/lispintro/lambda-3.eps +++ b/doc/lispintro/lambda-3.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:33:49 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/makefile.w32-in b/doc/lispintro/makefile.w32-in index 377112a80d2..1767825dfea 100644 --- a/doc/lispintro/makefile.w32-in +++ b/doc/lispintro/makefile.w32-in @@ -1,6 +1,6 @@ #### -*- Makefile -*- for the Emacs Lisp Introduction manual. -# Copyright (C) 2003-2013 Free Software Foundation, Inc. +# Copyright (C) 2003-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -23,10 +23,13 @@ srcdir = . infodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc +# Directory with emacsver.texi. +emacsdir = $(srcdir)/../emacs INFO_EXT=.info -INFO_OPTS=--no-split -INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi $(srcdir)/doclicense.texi +INFO_OPTS=--no-split -I$(emacsdir) +INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi $(emacsdir)/emacsver.texi \ + $(srcdir)/doclicense.texi # The file name eintr must fit within 5 characters, to allow for # -NN extensions to fit into DOS 8+3 limits without clashing INFO_TARGETS = $(infodir)/eintr$(INFO_EXT) @@ -37,8 +40,9 @@ INSTALL_INFO = install-info TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf DVIPS = dvips -ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \ - "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(texinfodir)" /C +ENVADD = $(srcdir)\..\..\nt\envadd.bat \ + "TEXINPUTS=$(srcdir);$(texinfodir);$(emacsdir);$(TEXINPUTS)" \ + "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(emacsdir) -I$(texinfodir)" /C .SUFFIXES: .dvi .ps .texi diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 42f5b5f5536..fe00e5a7b53 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,942 @@ +2014-02-22 Stefan Monnier + + * functions.texi (Declare Form): Document gv-expander, gv-setter, and + compiler-macro (bug#16829). + +2014-02-21 Juanma Barranquero + + * windows.texi (Window Configurations): Doc fix. + (Windows and Frames): Fix typo. + +2014-02-21 Glenn Morris + + * internals.texi (Process Internals): + * processes.texi (Subprocess Creation, Deleting Processes) + (Output from Processes, Process Buffers, Filter Functions) + (Accepting Output, Sentinels, Network, Network Servers): + Filters and sentinels can no longer be nil. + * elisp.texi (Top): Menu update. + +2014-02-20 Glenn Morris + + * functions.texi (Defining Functions): Mention defalias-fset-function. + +2014-02-17 Stefan Monnier + + * minibuf.texi (Completion Commands): Don't document obsolete + `common-substring' arg of display-completion-list. + +2014-02-17 Glenn Morris + + * minibuf.texi (Text from Minibuffer): Update read-regexp details. + Mention read-regexp-defaults-function. + +2014-02-13 Glenn Morris + + * debugging.texi (Debugger Commands): Tiny edits. + +2014-02-12 Glenn Morris + + * package.texi (Simple Packages): Describe URL and Keywords headers. + +2014-02-10 Lars Ingebrigtsen + + * text.texi (User-Level Deletion): + Document `delete-trailing-whitespace' (bug#15309). + +2014-02-09 Lars Ingebrigtsen + + * text.texi (Changing Properties): Clarify `propertize' (bug#9825). + + * display.texi (Blinking): Clarify doc string in example (bug#10658). + + * commands.texi (Accessing Mouse): Mention that these function + also work on keyboard events (bug#14228). + (Quitting): Refer to the right node for `set-input-mode' (bug#11458). + +2014-02-08 Lars Ingebrigtsen + + * display.texi (Face Attributes): Add an index (bug#14924). + + * keymaps.texi (Menu Bar): Minor clarification (bug#15657). + +2014-02-06 Glenn Morris + + * display.texi (Truncation): + * positions.texi (Screen Lines): Do not mention cache-long-scans. + +2014-01-31 Juri Linkov + + * searching.texi (String Search): Incremental word search fixes. + +2014-01-28 Glenn Morris + + * text.texi (Indent Tabs): Update related to tab-stops. + +2014-01-24 Glenn Morris + + * control.texi (Handling Errors): Update with-demoted-errors. + + * files.texi (File Locks): Every platform supports locking now. + +2014-01-22 Glenn Morris + + * display.texi (ImageMagick Images): Expand on image-format-suffixes. + +2014-01-20 Glenn Morris + + * hash.texi (Other Hash): Do not mention subr-x.el functions; + reverts 2013-12-22 change. + +2014-01-10 Stefan Monnier + + * functions.texi (Advising Functions): New section. + * modes.texi (Running Hooks): Don't document with-wrapper-hook and + run-hook-wrapped any more. + (Hooks): Link to the new Advising Functions node. + * elisp.texi (Top): Don't include advice.texi. + * advice.texi: Remove. + * makefile.w32-in (srcs): + * Makefile.in (srcs): Adjust accordingly. + +2014-01-09 Rüdiger Sonderfeld + + * text.texi (Parsing HTML/XML): Document `shr-insert-document'. + + * strings.texi (Text Comparison): Document `string-suffix-p'. + +2014-01-07 Glenn Morris + + * files.texi (File Attributes): Fix superscipt typo. + +2014-01-07 Chong Yidong + + * files.texi (Changing Files): Document copy-file changes. + +2014-01-07 Glenn Morris + + * display.texi (Logging Messages): Copyedits re messages-buffer. + +2014-01-06 Paul Eggert + + Specify .texi encoding (Bug#16292). + * back.texi, book-spine.texi, lay-flat.texi: + Add @documentencoding. + +2014-01-05 Chong Yidong + + * backups.texi (Making Backups): Document backup-buffer change. + + * files.texi (Visiting Files): Copyedits. + (Testing Accessibility): Mention ACLs. Move file-modes here from + File Attributes. + (Truenames): Move file-equal-p here from Kinds of Files. + (File Attributes): Move file-newer-than-file-p here from Testing + Accessibility. + (Extended Attributes): New node. Add file-extended-attributes. + (Changing Files): Document set-file-extended-attributes. + + * commands.texi (Defining Commands): Document the interactive-form + property more carefully. Document interactive-only. + + * compile.texi (Compiler Errors): Copyedits. Note that the + details for byte-compile-warnings are in its docstring. + + * minibuf.texi (Minibuffer Contents): Remove obsolete function + minibuffer-completion-contents. + + * variables.texi (Defining Variables): Note that defvar acts + always on the dynamic value. + + * customize.texi (Variable Definitions): Likewise. + +2014-01-05 Paul Eggert + + Document vconcat and the empty vector (Bug#16246). + * sequences.texi (Vector Functions): + Document behavior better when the result is empty. + + Document behavior of (string-to-number "+@") (Bug#16293). + * strings.texi (String Conversion): Document behavior of + string-to-number on invalid strings that begin with "+", too. + +2014-01-03 Chong Yidong + + * help.texi (Documentation, Accessing Documentation): Copyedits. + (Documentation Basics): Rewrite, avoiding a repeat discussion of + docstring conventions. + + * tips.texi (Documentation Tips): Move discussion of + emacs-lisp-docstring-fill-column here from Documentation Basics. + + * compile.texi (Docs and Compilation): Copyedits. + +2014-01-02 Glenn Morris + + * numbers.texi (Numeric Conversions): Fix a typo. + +2013-12-29 Paul Eggert + + Plain copy-file no longer chmods an existing destination (Bug#16133). + * files.texi (Changing Files): Document this. + +2013-12-28 Chong Yidong + + * modes.texi (Auto Major Mode): Document interpreter-mode-alist + change. + + * buffers.texi (Modification Time): Document visited-file-modtime + change. + +2013-12-28 Glenn Morris + + * control.texi (Pattern matching case statement): Brevity. + +2013-12-27 Chong Yidong + + * functions.texi (Function Cells): + * eval.texi (Function Indirection): Update for the fact that + symbol-function no longer signals an error. + + * commands.texi (Reading One Event): Mention keyboard coding. + + * keymaps.texi (Translation Keymaps, Translation Keymaps): + * nonascii.texi (Terminal I/O Encoding): Copyedits. + +2013-12-26 Chong Yidong + + * advice.texi (Advising Functions, Defining Advice): Special forms + can no longer be advised. + +2013-12-25 Chong Yidong + + * keymaps.texi (Active Keymaps): Re-organize the text. + (Searching Keymaps): Rewrite the pseudo-code for 24.4 changes. + (Controlling Active Maps): Note that set-transient-map uses + overriding-terminal-local-map. + + * tips.texi (Coding Conventions): Tweak the coding system tip; + Emacs now uses utf-8 by default for Emacs Lisp source files. + + * display.texi (Font Selection): Tweak example. + + * commands.texi (Event Input Misc): Document new arg to + input-pending-p. + + * nonascii.texi (Specifying Coding Systems): Don't refer to + emacs-mule-dos. + (Lisp and Coding Systems): Describe emacs-mule return value in + modern terms. + +2013-12-25 Tassilo Horn + + * control.texi (Pattern matching case statement): Rephrase lexical + binding requirement: the example needs it, not `pcase' itself. + +2013-12-25 Chong Yidong + + * eval.texi (Eval): Document the LEXICAL arg to eval. + + * variables.texi (Variables, Void Variables): Use "scoping rule" + terminology consistently. + (Variable Scoping): Add index entries, and use "dynamic scope" + terminology in place of "indefinite scope" to reduce confusion. + (Lexical Binding): Document lexical environment format. + (Using Lexical Binding): Add index entries for error messages. + +2013-12-24 Tassilo Horn + + * control.texi (Pattern matching case statement): Fix missing + argument in simple expression language sample (Bug#16238). + Add some sample programs written in that language. Mention that + `pcase' requires lexical binding. + +2013-12-23 Xue Fuqiao + + * eval.texi (Special Forms): Document `special-form-p'. + + * macros.texi (Simple Macro): Document `macrop'. + + * files.texi (Changing Files): Fix an argument of `copy-file'. + + * strings.texi (Creating Strings): Document TRIM in `split-string'. + +2013-12-23 Chong Yidong + + * keymaps.texi (Controlling Active Maps): + Rename set-temporary-overlay-map to set-transient map. Doc fixes. + (Searching Keymaps): The transient keymap takes precedence. + +2013-12-23 Glenn Morris + + * loading.texi (How Programs Do Loading, Load Suffixes): + Mention `load-prefer-newer'. + +2013-12-22 Xue Fuqiao + + * hash.texi (Other Hash): Document `hash-table-keys' + and `hash-table-values'. + +2013-12-22 Eli Zaretskii + + * nonascii.texi (Character Properties): NAME or OLD-NAME + properties can be nil (there's no empty string). + (Character Properties): Update the reference to the UCD. + +2013-12-22 Xue Fuqiao + + * sequences.texi (Bool-Vectors): Document new bool-vector set + operation functions. + + * text.texi (Examining Properties): Document `get-pos-property'. + + * variables.texi (Directory Local Variables): + Document `enable-dir-local-variables'. + + * debugging.texi (Debugger Commands): + Document `debugger-toggle-locals'. + +2013-12-21 Chong Yidong + + * text.texi (Region Indent): Note the new interactive behavior of + indent-rigidly. + +2013-12-20 Tassilo Horn + + * numbers.texi (numbers): Document that =, <, <=, >, >= now accept + one or many arguments. + + * display.texi: Document `messages-buffer'. + + * os.texi: Document `initial-buffer-choice' changes. + +2013-12-20 Chong Yidong + + * text.texi (Changing Properties): Improve documentation for + add-face-text-property. + (Special Properties): Mention add-face-text-property. + +2013-12-18 Chong Yidong + + * customize.texi (Custom Themes): Document custom-known-themes + (Bug#15717). + + * modes.texi (Defining Minor Modes): Fix typo (Bug#14874). + (Keymaps and Minor Modes): Fix binding convention (Bug#11522). + +2013-12-13 Glenn Morris + + * internals.texi (Building Emacs): + * loading.texi (Library Search): Mention that site-load, + site-init cannot change load-path. + +2013-12-12 Glenn Morris + + * elisp.texi: Tweak dircategory. + +2013-12-12 Eli Zaretskii + + * nonascii.texi (Encoding and I/O): Document file-name encoding + peculiarities on MS-Windows. + +2013-12-12 Glenn Morris + + * elisp.texi: Sync direntry with info/dir version. + +2013-12-08 Juanma Barranquero + + * display.texi (Progress, Face Remapping): + * processes.texi (Serial Ports): + * windows.texi (Recombining Windows): Fix typos. (Bug#16089) + +2013-12-04 Juri Linkov + + * searching.texi (Search and Replace): Fix `unread-command-events' + and add ref. + +2013-12-03 Juri Linkov + + * windows.texi (Choosing Window): Rename `no-display-ok' to + `allow-no-window'. (Bug#13594) + +2013-11-30 Glenn Morris + + * Makefile.in (distclean): Remove Makefile. + +2013-11-29 Andreas Politz + + * modes.texi (Imenu): Make it clear that sub-alist is the cdr + (Bug#14029). + +2013-11-27 Glenn Morris + + * loading.texi (Library Search): + * os.texi (Startup Summary): No more leim directory. + +2013-11-26 Glenn Morris + + * os.texi (Startup Summary): Update for leim-list being preloaded. + +2013-11-23 Brian Jenkins (tiny change) + + * frames.texi (Input Focus): + * hooks.texi (Standard Hooks): Mention focus-in-hook, focus-out-hook. + +2013-11-23 Glenn Morris + + * loading.texi (Library Search): + Empty elements in EMACSLOADPATH now mean the default load-path. + +2013-11-22 Glenn Morris + + * loading.texi (Library Search): Minor clarification. + +2013-11-20 Leo Liu + + * windows.texi (Choosing Window): Mention `no-display-ok'. (Bug#13594) + +2013-11-19 Xue Fuqiao + + * os.texi (File Notifications): Add an index. + + * loading.texi (Loading): Add an cross-reference. + +2013-11-18 Xue Fuqiao + + * os.texi (Session Management, Desktop Notifications): Add some + indexes and a cross-reference. + +2013-11-17 Xue Fuqiao + + * os.texi (Time Parsing): + (Processor Run Time, Input Modes, Terminal Output): Minor fixes. + +2013-11-14 Glenn Morris + + * loading.texi (Library Search): Update section. + +2013-11-11 Xue Fuqiao + + * os.texi (User Identification, Time of Day, Time Conversion): + Minor fixes. + +2013-11-10 Jan Djärv + + * keymaps.texi (Tool Bar): Mention that Gtk+/NS ignores item 1 to 3. + +2013-11-09 Xue Fuqiao + + * os.texi (Startup Summary): Add an index about startup screen. + Typo fix. + (Command-Line Arguments): Add cross-reference for `dump-emacs'. + +2013-11-08 Eli Zaretskii + + * display.texi (Truncation): Document that cache-long-scans is now + non-nil by default. (Bug#15797) + +2013-11-05 Eli Zaretskii + + * lists.texi (Rearrangement): Fix indexing. + + * display.texi (Bidirectional Display): Fix indexing. + +2013-11-05 Xue Fuqiao + + * lists.texi (Rearrangement): Improve indexing. + + * display.texi (Glyphs): Add an index for glyph code. + (Bidirectional Display): Improve indexing. + +2013-11-01 Jan Djärv + + * display.texi (Face Attributes): Document :distant-foreground. + +2013-10-30 Xue Fuqiao + + * display.texi (Abstract Display): Improve indexing. + +2013-10-29 Stefan Monnier + + * display.texi (Selective Display): Discourage the use of explicit + selective display. + +2013-10-29 Xue Fuqiao + + * display.texi (Showing Images): Add an index for image-size. + Use @code instead of @var for a normal variable. + (Multi-Frame Images): Improve indexing. + (Button Buffer Commands): Use @code instead of @var for a normal variable. + (Abstract Display): Explain the meaning of Ewoc. + +2013-10-27 Xue Fuqiao + + * display.texi (Image Descriptors): Improve indexing. + +2013-10-26 Xue Fuqiao + + * display.texi (Fringe Indicators): Add indexes for fringe indicators. + (Customizing Bitmaps): Add an index for customizing fringe bitmaps. + +2013-10-25 Xue Fuqiao + + * display.texi (Fontsets): Minor wording fix. + (Low-Level Font): Improve indexing. + + * nonascii.texi (Character Properties): Add an index for script symbols. + +2013-10-24 Xue Fuqiao + + * display.texi (Face Remapping): Add indexes for face remapping. + (Font Selection): Add indexes. + (Low-Level Font): Add an index for font registry. + +2013-10-23 Glenn Morris + + * eval.texi, files.texi, intro.texi, objects.texi, searching.texi: + Nuke @refill. + + * Makefile.in (install-dvi, install-html, install-pdf) + (install-ps, uninstall-dvi, uninstall-html, uninstall-ps) + (uninstall-pdf): Quote entities that might contain whitespace. + +2013-10-19 Xue Fuqiao + + * display.texi (Face Attributes): Add indexes for the ‘:box’ + face attribute. + +2013-10-18 Xue Fuqiao + + * display.texi (Line Height): Add indexes for line height. + +2013-10-17 Xue Fuqiao + + * display.texi (Width): Fix arguments of ‘truncate-string-to-width’. + +2013-10-16 Xue Fuqiao + + * display.texi (Selective Display): Add an index for explicit + selective display. + +2013-10-15 Xue Fuqiao + + * display.texi (Warning Basics): Mention the ‘*Warnings*’ buffer. + +2013-10-13 Glenn Morris + + * intro.texi (Acknowledgments): Use accented form of some names. + +2013-10-09 Glenn Morris + + * control.texi (Conditionals): Copyedits. (Bug#15558) + +2013-10-08 Eli Zaretskii + + Support menus on text-mode terminals. + * keymaps.texi (Defining Menus, Mouse Menus, Menu Bar): + Modify wording to the effect that menus are supported on TTYs. + + * frames.texi (Pop-Up Menus, Dialog Boxes) + (Display Feature Testing): Update for menu support on TTYs. + +2013-10-07 Stefan Monnier + + * tips.texi (Comment Tips): Discourage use of triple semi-colons for + non-headings. + +2013-10-05 Xue Fuqiao + + * syntax.texi (Categories): Add an index for category sets. + +2013-10-03 Xue Fuqiao + + * syntax.texi (Syntax Flags): + (Syntax Table Functions): Add indexes. + +2013-10-02 Xue Fuqiao + + * syntax.texi (Syntax Class Table): Add an index for syntax class table. + +2013-09-29 Xue Fuqiao + + * searching.texi (Regexp Search): Refine. + +2013-09-22 Xue Fuqiao + + * nonascii.texi (Default Coding Systems): Typo fix. + +2013-09-21 Xue Fuqiao + + * nonascii.texi (Coding System Basics): Add information about carriage-return. + +2013-09-14 Eli Zaretskii + + * display.texi (Display Margins): State the units of measuring + margin width. (Bug#15375) + +2013-09-13 Eli Zaretskii + + * text.texi (Not Intervals): Minor wording fix. + +2013-09-12 Xue Fuqiao + + * functions.texi (Obsolete Functions): Add an index for obsolete + functions. + +2013-09-11 Xue Fuqiao + + * nonascii.texi (Character Properties): Character properties fix + for decimal-digit-value and digit-value. + +2013-09-08 Stefan Monnier + + * macros.texi (Defining Macros): Prefer "function" to "lambda + expression" (bug#15296). + +2013-08-28 Paul Eggert + + * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-26 Stefan Monnier + + * variables.texi (File Local Variables): Don't recommend quoting! Ever! + +2013-08-20 Eli Zaretskii + + * files.texi (Information about Files): Mention file names with + trailing blanks on MS-Windows. (Bug#15130) + +2013-08-18 Xue Fuqiao + + * positions.texi (Positions): Improve indexing. + +2013-08-18 Eli Zaretskii + + * markers.texi (The Region): Improve indexing. + +2013-08-17 Xue Fuqiao + + * modes.texi (SMIE, SMIE Grammar, SMIE Indentation): Add some indexes. + + * text.texi (Maintaining Undo): Mention interactive call of + buffer-disable-undo. + (Filling): Add cross-reference for hard newlines. + (Sorting): Fix indentation. + (Columns): Comment out undefined behavior. + (Case Changes): Fix an `args-out-of-range' error in the example. + +2013-08-16 Xue Fuqiao + + * text.texi (Insertion): Refine. + (Margins): Add an index. + (Undo): Doc fix for `buffer-undo-list'. + + * positions.texi (Character Motion): + * markers.texi (Moving Markers): + (Creating Markers): Comment out undefined behavior. + +2013-08-15 Xue Fuqiao + + * markers.texi (The Region): Add/move indexes. + +2013-08-13 Lars Magne Ingebrigtsen + + * display.texi (ImageMagick Images): Mention :content-type and + `image-content-type-suffixes'. + +2013-08-13 Xue Fuqiao + + * positions.texi (Word Motion): Remove redundant sentence. + +2013-08-13 Glenn Morris + + * lists.texi (List Elements): + Undocument behavior of nth and nthcdr with n < 0. (Bug#15059) + +2013-08-13 Xue Fuqiao + + * frames.texi (Display Feature Testing): Add indexes. + +2013-08-12 Glenn Morris + + * Makefile.in (prefix, datarootdir, datadir, PACKAGE_TARNAME) + (docdir, dvidir, htmldir, pdfdir, psdir, GZIP_PROG, INSTALL) + (INSTALL_DATA): New, set by configure. + (HTML_OPTS, DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): + New variables. + (.SUFFIXES): Add .ps and .dvi. + (.dvi.ps): New suffix rule. + (dvi, html, pdf, ps): Use *_TARGETS variables. + (elisp.html): Use HTML_OPTS. + (elisp.ps): Remove explicit rule. + (.PHONY): install-dvi, install-html, install-pdf, install-ps, + install-doc, uninstall-dvi, uninstall-html, uninstall-pdf, + uninstall-ps, and uninstall-doc. + (install-dvi, install-html, install-pdf, install-ps, install-doc) + (uninstall-dvi, uninstall-html, uninstall-ps, uninstall-pdf) + (uninstall-doc): New rules. + (clean): Use DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS. + +2013-08-10 Xue Fuqiao + + * edebug.texi (Instrumenting Macro Calls): Use @defmac for macros. + +2013-08-09 Xue Fuqiao + + * control.texi (Error Symbols): Minor fix for previous change. + +2013-08-09 Stefan Monnier + + * errors.texi (Standard Errors): Don't refer to `error-conditions'. + + * control.texi (Signaling Errors): Refer to define-error. + (Error Symbols): Add `define-error'. + +2013-08-06 Dmitry Antipov + + * positions.texi (Motion by Screen Lines): + * display.texi (Truncation): Rename `cache-long-line-scans' + to `cache-long-scans'. + +2013-08-05 Xue Fuqiao + + * windows.texi (Window Start and End): Add an index. + +2013-08-02 Xue Fuqiao + + * display.texi (Face Functions): Add an index. + + * variables.texi (Variable Aliases): Add an index. + + * functions.texi (Defining Functions): Add an index. + + * nonascii.texi (Coding System Basics): Add an index. + +2013-07-31 Xue Fuqiao + + * nonascii.texi (Non-ASCII Characters): Update menu. + (Disabling Multibyte): Move here from doc/emacs/mule.texi. Fix cross-references. + + * elisp.texi (Top): Update menu. + +2013-07-30 Xue Fuqiao + + * windows.texi (Window History): Mention the default value of + switch-to-visible-buffer. Add cross-references. + +2013-07-24 Michael Albinus + + * errors.texi (Standard Errors): Fix typo. + + * files.texi (Magic File Names): + * os.texi (File Notifications): Remove file-notify-supported-p. + +2013-07-24 Paul Eggert + + * eval.texi (Special Forms): Mention 'lambda'. Also, say that + non-well-formed expressions result in unspecified behavior, though + Emacs will not crash. + +2013-07-22 Michael Albinus + + * files.texi (Magic File Names): Add file-notify-add-watch, + file-notify-rm-watch and file-notify-supported-p. + Move file-remote-p down. + + * errors.texi (Standard Errors): Add file-notify-error. + + * os.texi (Desktop Notifications): Rename from Notifications. + (File Notifications): New node. + + * elisp.texi (Top): Update menu for these changes. + +2013-07-19 Xue Fuqiao + + * windows.texi (Display Action Functions): Mention next-window. + +2013-07-16 Xue Fuqiao + + * windows.texi (Selecting Windows): Fix the introduction of + `set-frame-selected-window''s arguments. + +2013-07-10 Paul Eggert + + Timestamp fixes for undo (Bug#14824). + * text.texi (Undo): Document (t . 0) and (t . -1) in buffer-undo-list. + +2013-07-06 Eli Zaretskii + + * nonascii.texi (Text Representations): Document that + multibyte-string-p returns nil for non-string objects. + +2013-07-06 Glenn Morris + + * elisp.texi (Top): Move WWW_GNU_ORG section outside @copying. + +2013-07-03 Glenn Morris + + * debugging.texi (Debugging): + * files.texi (File Attributes, Changing Files): Fix cross-references. + + * package.texi (Package Archives): Fix @url call. + + * syntax.texi (Syntax Table Functions): Mention describe-syntax. + +2013-06-29 Eli Zaretskii + + * display.texi (Bidirectional Display): Document move-point-visually. + +2013-06-29 Xue Fuqiao + + * buffers.texi (Buffer File Name): Fix typo. + +2013-06-26 Christopher Schmidt + + * tips.texi (Coding Conventions): Improve wording. + +2013-06-24 Glenn Morris + + * loading.texi (Autoload): Fix typo. + + * variables.texi (Lexical Binding): Fix typo. + + * functions.texi (Anonymous Functions): Put back ' removed 2012-10-23. + +2013-06-23 Lars Magne Ingebrigtsen + + * display.texi (ImageMagick Images): Mention :max-width and + :max-height. + +2013-06-20 Paul Eggert + + * numbers.texi (Math Functions): Remove obsolete function log10. + +2013-06-19 Stefan Monnier + + * modes.texi (Mode Line Data, Properties in Mode): Advertise `keymap' + rather than `local-map'. + + * keymaps.texi (Active Keymaps): Fix documentation of + set-temporary-overlay-map and overriding-terminal-local-map. + +2013-06-19 Glenn Morris + + * Makefile.in (dist): Edit more configure variables. + Try to check that we do not miss any in future. + +2013-06-17 Juanma Barranquero + + * text.texi (Undo, Changing Properties): Fix typos. + +2013-06-17 Lars Magne Ingebrigtsen + + * text.texi (Changing Properties): Document `add-face-text-property'. + +2013-06-17 Kenichi Handa + + * display.texi (Face Attributes): Refer to "Low-Level font" (not + "Font Selection") in the explanation of :font attribute (bug#14629). + +2013-06-13 Stefan Monnier + + * loading.texi (Hooks for Loading): Don't document after-load-alist. + Document with-eval-after-load instead of eval-after-load. + +2013-06-11 Xue Fuqiao + + * files.texi (File Name Expansion): Make the example more + intuitive. + +2013-06-10 Paul Eggert + + Documentation fix for 'ls' and hard links. + * compile.texi (Compilation Functions): + * files.texi (File Attributes, Changing Files): + Use current format for GNU 'ls' output. + (File Attributes): Fix problem introduced in previous change: + the link count is the number of hard links, not the number + of hard links + 1. + +2013-06-10 Xue Fuqiao + + * files.texi (File Attributes): Fix typo. + +2013-05-29 Stefan Monnier + + * functions.texi (Lambda Expressions): Lambda expressions don't + evaluate to themselves in general (bug#11782). + +2013-05-15 Stefan Monnier + + * loading.texi (Autoload): + * help.texi (Documentation Basics, Accessing Documentation) + (Accessing Documentation, Accessing Documentation): DOC-* is now DOC. + +2013-04-23 Glenn Morris + + * internals.texi (Writing Emacs Primitives): Remove obvious example. + Tweak other to avoid overly long line. + +2013-04-21 Xue Fuqiao + + * internals.texi (Writing Emacs Primitives): Remove unnecessary + references to the sources. (Bug#13800) + + * searching.texi (Regexp Backslash): Doc fix for backslash + constructs in regular expressions. + +2013-04-15 Christopher Schmidt + + * tips.texi (Coding Conventions): Mention separation of package + descriptor and name of internal symbols by two hyphens. + +2013-04-13 Stephen Berman + + * windows.texi (Splitting Windows): Change category of + split-window from a command to a function. + +2013-04-06 Chong Yidong + + * display.texi (Faces): Minor clarifications. + (Defining Faces): Clarify default vs custom face specs. + Document face-spec-set. + + * display.texi (Overlay Properties): + * text.texi (Special Properties): Use the "anonymous face" + terminology. Describe foreground-color and background-color forms + as compatibility-only. + +2013-03-24 Eli Zaretskii + + * compile.texi (Byte-Code Objects): Add index entry. + (Disassembly): Add cross-references. + +2013-03-23 Eli Zaretskii + + * frames.texi (Size Parameters): More accurate description of the + difference between 'fullboth' and 'maximized'. (Bug#13935) + +2013-03-17 Christopher Schmidt + + * symbols.texi (Standard Properties): Document pure. (Bug#13823) + +2013-03-16 Glenn Morris + + * elisp.texi: Add some stuff specific to www.gnu.org. + +2013-03-11 Teodor Zlatanov + + * control.texi (Pattern matching case statement): Fix typo. + +2013-03-04 Paul Eggert + + * elisp.texi, intro.texi: Switch from Latin-1 to UTF-8. + +2013-03-03 Glenn Morris + + * objects.texi (Symbol Type): Fix typo. + 2013-02-28 Bastien Guerry * variables.texi (File Local Variables): Fix reference. @@ -593,14 +1532,16 @@ Tweak markup. Remove domain-error and friends, which seem to be unused after the floating-point code revamp. - * functions.texi (Obsolete Functions): Obsolescence also affects + * functions.texi (Defining Functions): defun is now a macro. + (Obsolete Functions): Obsolescence also affects documentation commands. Various clarifications. (Declare Form): New node. * strings.texi (String Basics): Copyedits. - * os.texi (Idle Timers): Minor clarifications. + * os.texi (Startup Summary): Document leim-list.el change. (User Identification): Add system-users and system-groups. + (Idle Timers): Minor clarifications. * macros.texi (Defining Macros): Move description of `declare' to Declare Form node. @@ -616,14 +1557,6 @@ the machine-independence of negative division since it does not happen in practice. -2012-09-28 Chong Yidong - - * os.texi (Startup Summary): Document leim-list.el change. - -2012-09-25 Chong Yidong - - * functions.texi (Defining Functions): defun is now a macro. - 2012-09-28 Leo Liu * files.texi (Files): Fix typo. @@ -868,7 +1801,7 @@ * display.texi (Face Attributes): Copyedits. Add a few cindex entries. Overlining no longer behaves exactly like underlining. -2012-06-16 Aurelien Aptel +2012-06-16 Aurélien Aptel * display.texi (Face Attributes): Document wave-style underline face attribute. @@ -1986,8 +2919,8 @@ 2012-02-04 Chong Yidong - * functions.texi (What Is a Function): Add closures. Mention - "return value" terminology. Add xref for command-execute. + * functions.texi (What Is a Function): Add closures. + Mention "return value" terminology. Add xref for command-execute. Remove unused "keystroke command" terminology. (Lambda Expressions): Give a different example than in the following subsection. Add xref to Anonymous Functions. @@ -8552,7 +9485,7 @@ * variables.texi (Variable Aliases): Simplify. - * anti.texi, backups.texi, compile.texi, customization.texi: + * anti.texi, backups.texi, compile.texi, customize.texi: * debugging.texi, display.texi, edebug.texi, errors.texi, frames.texi: * functions.texi, help.texi, keymaps.texi, modes.texi, nonascii.texi: * os.texi, processes.texi, searching.texi, strings.texi, text.texi: @@ -10916,15 +11849,12 @@ 2003-11-02 Jesper Harder (tiny change) - * lispref/anti.texi, lispref/backups.texi, lispref/commands.texi - lispref/customize.texi, lispref/display.texi, lispref/files.texi, - lispref/internals.texi, lispref/keymaps.texi, lispref/loading.texi, - lispref/modes.texi, lispref/nonascii.texi, lispref/numbers.texi, - lispref/objects.texi, lispref/os.texi, lispref/positions.texi, - lispref/processes.texi, lispref/searching.texi, - lispref/sequences.texi, lispref/streams.texi, lispref/strings.texi, - lispref/syntax.texi, lispref/text.texi: Replace @sc{foo} with - @acronym{FOO}. + * anti.texi, backups.texi, commands.texi, customize.texi: + * display.texi, files.texi, internals.texi, keymaps.texi: + * loading.texi, modes.texi, nonascii.texi, numbers.texi: + * objects.texi, os.texi, positions.texi, processes.texi: + * searching.texi, sequences.texi, streams.texi, strings.texi: + * syntax.texi, text.texi: Replace @sc{foo} with @acronym{FOO}. 2003-10-27 Luc Teirlinck @@ -11534,7 +12464,7 @@ 2002-05-13 Kim F. Storm - * variables.texi (Intro to Buffer-Local): Updated warning and + * variables.texi (Intro to Buffer-Local): Update warning and example relating to changing buffer inside let. 2002-03-10 Jan Djärv @@ -12033,7 +12963,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1998-2013 Free Software Foundation, Inc. + Copyright (C) 1998-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 8e04d085c60..bb8d4f82884 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -1,6 +1,6 @@ -# Makefile for the GNU Emacs Lisp Reference Manual. +### @configure_input@ -# Copyright (C) 1990-1996, 1998-2013 Free Software Foundation, Inc. +# Copyright (C) 1990-1996, 1998-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -17,7 +17,10 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -SHELL = /bin/sh +SHELL = @SHELL@ + +# NB If you add any more configure variables, +# update the sed rules in the dist target below. # Standard configure variables. srcdir = @srcdir@ @@ -30,12 +33,29 @@ texinfodir = $(srcdir)/../misc # Directory with emacsver.texi. emacsdir = $(srcdir)/../emacs +prefix = @prefix@ +datarootdir = @datarootdir@ +datadir = @datadir@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +docdir = @docdir@ +dvidir = @dvidir@ +htmldir = @htmldir@ +pdfdir = @pdfdir@ +psdir = @psdir@ + MKDIR_P = @MKDIR_P@ +GZIP_PROG = @GZIP_PROG@ + +HTML_OPTS = --no-split --html + INFO_EXT=@INFO_EXT@ # Options used only when making info output. INFO_OPTS=@INFO_OPTS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + MAKEINFO = @MAKEINFO@ MAKEINFO_OPTS = --force --enable-encoding -I $(emacsdir) -I $(srcdir) TEXI2DVI = texi2dvi @@ -45,13 +65,17 @@ DVIPS = dvips ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" +DVI_TARGETS = elisp.dvi +HTML_TARGETS = elisp.html +PDF_TARGETS = elisp.pdf +PS_TARGETS = elisp.ps + # List of all the texinfo files in the manual: srcs = \ $(srcdir)/elisp.texi \ $(emacsdir)/emacsver.texi \ $(srcdir)/abbrevs.texi \ - $(srcdir)/advice.texi \ $(srcdir)/anti.texi \ $(srcdir)/backups.texi \ $(srcdir)/buffers.texi \ @@ -105,11 +129,16 @@ mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi pdf ps +.SUFFIXES: .ps .dvi + +.dvi.ps: + $(DVIPS) -o $@ $< + info: $(buildinfodir)/elisp$(INFO_EXT) -dvi: elisp.dvi -html: elisp.html -pdf: elisp.pdf -ps: elisp.ps +dvi: $(DVI_TARGETS) +html: $(HTML_TARGETS) +pdf: $(PDF_TARGETS) +ps: $(PS_TARGETS) ## Note: "<" is not portable in ordinary make rules. $(buildinfodir)/elisp$(INFO_EXT): $(srcs) @@ -120,10 +149,7 @@ elisp.dvi: $(srcs) $(ENVADD) $(TEXI2DVI) $(srcdir)/elisp.texi elisp.html: $(srcs) - $(MAKEINFO) $(MAKEINFO_OPTS) --html -o $@ $(srcdir)/elisp.texi - -elisp.ps: elisp.dvi - $(DVIPS) -o $@ elisp.dvi + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ $(srcdir)/elisp.texi elisp.pdf: $(srcs) $(ENVADD) $(TEXI2PDF) $(srcdir)/elisp.texi @@ -137,12 +163,12 @@ mostlyclean: rm -f elisp[12]* vol[12].tmp clean: mostlyclean - rm -f elisp.dvi elisp.pdf elisp.ps + rm -f $(DVI_TARGETS) $(HTML_TARGETS) $(PDF_TARGETS) $(PS_TARGETS) rm -f vol[12].dvi vol[12].pdf vol[12].ps - rm -rf elisp.html rm -f emacs-lispref-${version}.tar* distclean: clean + rm -f Makefile infoclean: -cd $(buildinfodir) && rm -f elisp$(INFO_EXT) elisp$(INFO_EXT)-[1-9] elisp$(INFO_EXT)-[1-9][0-9] @@ -163,8 +189,60 @@ dist: -e 's/^\(buildinfodir *=\).*/\1 ./' \ -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ + -e 's/@MAKE[I]NFO@/makeinfo/' -e 's/@MK[D]IR_P@/mkdir -p/' \ + -e 's/@IN[F]O_EXT@/.info/' -e 's/@IN[F]O_OPTS@//' \ ${srcdir}/Makefile.in > emacs-lispref-${version}/Makefile + @if grep '@[a-zA-Z_]*@' emacs-lispref-${version}/Makefile; then \ + echo "Unexpanded configure variables in Makefile?" 1>&2; exit 1; \ + fi tar -cf emacs-lispref-${version}.tar emacs-lispref-${version} rm -rf emacs-lispref-${version} +.PHONY: install-dvi install-html install-pdf install-ps install-doc + +install-dvi: dvi + umask 022; $(MKDIR_P) "$(DESTDIR)$(dvidir)" + $(INSTALL_DATA) $(DVI_TARGETS) "$(DESTDIR)$(dvidir)" +install-html: html + umask 022; $(MKDIR_P) "$(DESTDIR)$(htmldir)" + $(INSTALL_DATA) $(HTML_TARGETS) "$(DESTDIR)$(htmldir)" +install-pdf: pdf + umask 022;$(MKDIR_P) "$(DESTDIR)$(pdfdir)" + $(INSTALL_DATA) $(PDF_TARGETS) "$(DESTDIR)$(pdfdir)" +install-ps: ps + umask 022; $(MKDIR_P) "$(DESTDIR)$(psdir)" + for file in $(PS_TARGETS); do \ + $(INSTALL_DATA) $${file} "$(DESTDIR)$(psdir)"; \ + [ -n "${GZIP_PROG}" ] || continue; \ + rm -f "$(DESTDIR)$(psdir)/$${file}.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)$(psdir)/$${file}"; \ + done + +## Top-level Makefile installs the info pages. +install-doc: install-dvi install-html install-pdf install-ps + + +.PHONY: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps uninstall-doc + +uninstall-dvi: + for file in $(DVI_TARGETS); do \ + rm -f "$(DESTDIR)$(dvidir)/$${file}"; \ + done +uninstall-html: + for file in $(HTML_TARGETS); do \ + rm -f "$(DESTDIR)$(htmldir)/$${file}"; \ + done +uninstall-ps: + ext= ; [ -n "${GZIP_PROG}" ] && ext=.gz; \ + for file in $(PS_TARGETS); do \ + rm -f "$(DESTDIR)$(psdir)/$${file}$${ext}"; \ + done +uninstall-pdf: + for file in $(PDF_TARGETS); do \ + rm -f "$(DESTDIR)$(pdfdir)/$${file}"; \ + done + +uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps + + ### Makefile ends here diff --git a/doc/lispref/README b/doc/lispref/README index b94bd10789c..e8dbaddde56 100644 --- a/doc/lispref/README +++ b/doc/lispref/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. -*- outline -*- +Copyright (C) 2001-2014 Free Software Foundation, Inc. -*- outline -*- See the end of the file for license conditions. diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 7cc558f9391..45c2c4c17fb 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1999, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1994, 1999, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Abbrevs diff --git a/doc/lispref/advice.texi b/doc/lispref/advice.texi deleted file mode 100644 index e8d1bd3cdbc..00000000000 --- a/doc/lispref/advice.texi +++ /dev/null @@ -1,748 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc. -@c See the file elisp.texi for copying conditions. -@node Advising Functions -@chapter Advising Emacs Lisp Functions -@cindex advising functions - - The @dfn{advice} feature lets you add to the existing definition of -a function, by @dfn{advising the function}. This is a cleaner method -for a library to customize functions defined within Emacs---cleaner -than redefining the whole function. - -@cindex piece of advice - Each function can have multiple @dfn{pieces of advice}, each of -which can be separately defined and then @dfn{enabled} or -@dfn{disabled}. All the enabled pieces of advice for any given -function actually take effect when you @dfn{activate advice} for that -function, or when you define or redefine the function. Note that -enabling a piece of advice and activating advice for a function are -not the same thing. - - Advice is useful for altering the behavior of existing calls to an -existing function. If you want the new behavior for new function -calls or new key bindings, you should define a new function or -command, and have it use the existing function as a subroutine. - - Advising a function can cause confusion in debugging, since people -who debug calls to the original function may not notice that it has -been modified with advice. Therefore, if you have the possibility to -change the code of that function to run a hook, please solve the -problem that way. Advice should be reserved for the cases where you -cannot get the function changed. In particular, Emacs's own source -files should not put advice on functions in Emacs. There are -currently a few exceptions to this convention, but we aim to correct -them. - - Unless you know what you are doing, do @emph{not} advise a primitive -(@pxref{What Is a Function}). Some primitives are used by the advice -mechanism; advising them could cause an infinite recursion. Also, -many primitives are called directly from C code. Calls to the -primitive from Lisp code will take note of the advice, but calls from -C code will ignore the advice. - -@menu -* Simple Advice:: A simple example to explain the basics of advice. -* Defining Advice:: Detailed description of @code{defadvice}. -* Around-Advice:: Wrapping advice around a function's definition. -* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}. -* Activation of Advice:: Advice doesn't do anything until you activate it. -* Enabling Advice:: You can enable or disable each piece of advice. -* Preactivation:: Preactivation is a way of speeding up the - loading of compiled advice. -* Argument Access in Advice:: How advice can access the function's arguments. -* Combined Definition:: How advice is implemented. -@end menu - -@node Simple Advice -@section A Simple Advice Example - - The command @code{next-line} moves point down vertically one or more -lines; it is the standard binding of @kbd{C-n}. When used on the last -line of the buffer, this command inserts a newline to create a line to -move to if @code{next-line-add-newlines} is non-@code{nil} (its default -is @code{nil}.) - - Suppose you wanted to add a similar feature to @code{previous-line}, -which would insert a new line at the beginning of the buffer for the -command to move to (when @code{next-line-add-newlines} is -non-@code{nil}). How could you do this? - - You could do it by redefining the whole function, but that is not -modular. The advice feature provides a cleaner alternative: you can -effectively add your code to the existing function definition, without -actually changing or even seeing that definition. Here is how to do -this: - -@example -(defadvice previous-line (before next-line-at-end - (&optional arg try-vscroll)) - "Insert an empty line when moving up from the top line." - (if (and next-line-add-newlines (= arg 1) - (save-excursion (beginning-of-line) (bobp))) - (progn - (beginning-of-line) - (newline)))) -@end example - - This expression defines a @dfn{piece of advice} for the function -@code{previous-line}. This piece of advice is named -@code{next-line-at-end}, and the symbol @code{before} says that it is -@dfn{before-advice} which should run before the regular definition of -@code{previous-line}. @code{(&optional arg try-vscroll)} specifies -how the advice code can refer to the function's arguments. - - When this piece of advice runs, it creates an additional line, in the -situation where that is appropriate, but does not move point to that -line. This is the correct way to write the advice, because the normal -definition will run afterward and will move back to the newly inserted -line. - - Defining the advice doesn't immediately change the function -@code{previous-line}. That happens when you @dfn{activate} the advice, -like this: - -@example -(ad-activate 'previous-line) -@end example - -@noindent -This is what actually begins to use the advice that has been defined so -far for the function @code{previous-line}. Henceforth, whenever that -function is run, whether invoked by the user with @kbd{C-p} or -@kbd{M-x}, or called from Lisp, it runs the advice first, and its -regular definition second. - - This example illustrates before-advice, which is one @dfn{class} of -advice: it runs before the function's base definition. There are two -other advice classes: @dfn{after-advice}, which runs after the base -definition, and @dfn{around-advice}, which lets you specify an -expression to wrap around the invocation of the base definition. - -@node Defining Advice -@section Defining Advice -@cindex defining advice -@cindex advice, defining - - To define a piece of advice, use the macro @code{defadvice}. A call -to @code{defadvice} has the following syntax, which is based on the -syntax of @code{defun} and @code{defmacro}, but adds more: - -@findex defadvice -@example -(defadvice @var{function} (@var{class} @var{name} - @r{[}@var{position}@r{]} @r{[}@var{arglist}@r{]} - @var{flags}...) - @r{[}@var{documentation-string}@r{]} - @r{[}@var{interactive-form}@r{]} - @var{body-forms}...) -@end example - -@noindent -Here, @var{function} is the name of the function (or macro or special -form) to be advised. From now on, we will write just ``function'' when -describing the entity being advised, but this always includes macros and -special forms. - - In place of the argument list in an ordinary definition, an advice -definition calls for several different pieces of information. - -@cindex class of advice -@cindex before-advice -@cindex after-advice -@cindex around-advice -@var{class} specifies the @dfn{class} of the advice---one of @code{before}, -@code{after}, or @code{around}. Before-advice runs before the function -itself; after-advice runs after the function itself; around-advice is -wrapped around the execution of the function itself. After-advice and -around-advice can override the return value by setting -@code{ad-return-value}. - -@defvar ad-return-value -While advice is executing, after the function's original definition has -been executed, this variable holds its return value, which will -ultimately be returned to the caller after finishing all the advice. -After-advice and around-advice can arrange to return some other value -by storing it in this variable. -@end defvar - -The argument @var{name} is the name of the advice, a non-@code{nil} -symbol. The advice name uniquely identifies one piece of advice, within all -the pieces of advice in a particular class for a particular -@var{function}. The name allows you to refer to the piece of -advice---to redefine it, or to enable or disable it. - -The optional @var{position} specifies where, in the current list of -advice of the specified @var{class}, this new advice should be placed. -It should be either @code{first}, @code{last} or a number that specifies -a zero-based position (@code{first} is equivalent to 0). If no position -is specified, the default is @code{first}. Position values outside the -range of existing positions in this class are mapped to the beginning or -the end of the range, whichever is closer. The @var{position} value is -ignored when redefining an existing piece of advice. - -The optional @var{arglist} can be used to define the argument list for -the sake of advice. This becomes the argument list of the combined -definition that is generated in order to run the advice (@pxref{Combined -Definition}). Therefore, the advice expressions can use the argument -variables in this list to access argument values. - -The argument list used in advice need not be the same as the argument -list used in the original function, but must be compatible with it, so -that it can handle the ways the function is actually called. If two -pieces of advice for a function both specify an argument list, they must -specify the same argument list. - -@xref{Argument Access in Advice}, for more information about argument -lists and advice, and a more flexible way for advice to access the -arguments. - -The remaining elements, @var{flags}, are symbols that specify further -information about how to use this piece of advice. Here are the valid -symbols and their meanings: - -@table @code -@item activate -Activate the advice for @var{function} now. Changes in a function's -advice always take effect the next time you activate advice for the -function; this flag says to do so, for @var{function}, immediately after -defining this piece of advice. - -@cindex forward advice -This flag has no immediate effect if @var{function} itself is not defined yet (a -situation known as @dfn{forward advice}), because it is impossible to -activate an undefined function's advice. However, defining -@var{function} will automatically activate its advice. - -@item protect -Protect this piece of advice against non-local exits and errors in -preceding code and advice. Protecting advice places it as a cleanup in -an @code{unwind-protect} form, so that it will execute even if the -previous code gets an error or uses @code{throw}. @xref{Cleanups}. - -@item compile -Compile the combined definition that is used to run the advice. This -flag is ignored unless @code{activate} is also specified. -@xref{Combined Definition}. - -@item disable -Initially disable this piece of advice, so that it will not be used -unless subsequently explicitly enabled. @xref{Enabling Advice}. - -@item preactivate -Activate advice for @var{function} when this @code{defadvice} is -compiled or macroexpanded. This generates a compiled advised definition -according to the current advice state, which will be used during -activation if appropriate. @xref{Preactivation}. - -This is useful only if this @code{defadvice} is byte-compiled. -@end table - -The optional @var{documentation-string} serves to document this piece of -advice. When advice is active for @var{function}, the documentation for -@var{function} (as returned by @code{documentation}) combines the -documentation strings of all the advice for @var{function} with the -documentation string of its original function definition. - -The optional @var{interactive-form} form can be supplied to change the -interactive behavior of the original function. If more than one piece -of advice has an @var{interactive-form}, then the first one (the one -with the smallest position) found among all the advice takes precedence. - -The possibly empty list of @var{body-forms} specifies the body of the -advice. The body of an advice can access or change the arguments, the -return value, the binding environment, and perform any other kind of -side effect. - -@strong{Warning:} When you advise a macro, keep in mind that macros are -expanded when a program is compiled, not when a compiled program is run. -All subroutines used by the advice need to be available when the byte -compiler expands the macro. - -@deffn Command ad-unadvise function -This command deletes all pieces of advice from @var{function}. -@end deffn - -@deffn Command ad-unadvise-all -This command deletes all pieces of advice from all functions. -@end deffn - -@node Around-Advice -@section Around-Advice - - Around-advice lets you ``wrap'' a Lisp expression ``around'' the -original function definition. You specify where the original function -definition should go by means of the special symbol @code{ad-do-it}. -Where this symbol occurs inside the around-advice body, it is replaced -with a @code{progn} containing the forms of the surrounded code. Here -is an example: - -@example -(defadvice foo (around foo-around) - "Ignore case in `foo'." - (let ((case-fold-search t)) - ad-do-it)) -@end example - -@noindent -Its effect is to make sure that case is ignored in -searches when the original definition of @code{foo} is run. - -@defvar ad-do-it -This is not really a variable, rather a place-holder that looks like a -variable. You use it in around-advice to specify the place to run the -function's original definition and other ``earlier'' around-advice. -@end defvar - -If the around-advice does not use @code{ad-do-it}, then it does not run -the original function definition. This provides a way to override the -original definition completely. (It also overrides lower-positioned -pieces of around-advice). - -If the around-advice uses @code{ad-do-it} more than once, the original -definition is run at each place. In this way, around-advice can execute -the original definition (and lower-positioned pieces of around-advice) -several times. Another way to do that is by using @code{ad-do-it} -inside of a loop. - -@node Computed Advice -@section Computed Advice - -The macro @code{defadvice} resembles @code{defun} in that the code for -the advice, and all other information about it, are explicitly stated in -the source code. You can also create advice whose details are computed, -using the function @code{ad-add-advice}. - -@defun ad-add-advice function advice class position -Calling @code{ad-add-advice} adds @var{advice} as a piece of advice to -@var{function} in class @var{class}. The argument @var{advice} has -this form: - -@example -(@var{name} @var{protected} @var{enabled} @var{definition}) -@end example - -@noindent -Here, @var{protected} and @var{enabled} are flags; if @var{protected} -is non-@code{nil}, the advice is protected against non-local exits -(@pxref{Defining Advice}), and if @var{enabled} is @code{nil} the -advice is initially disabled (@pxref{Enabling Advice}). -@var{definition} should have the form - -@example -(advice . @var{lambda}) -@end example - -@noindent -where @var{lambda} is a lambda expression; this lambda expression is -called in order to perform the advice. @xref{Lambda Expressions}. - -If the @var{function} argument to @code{ad-add-advice} already has one -or more pieces of advice in the specified @var{class}, then -@var{position} specifies where in the list to put the new piece of -advice. The value of @var{position} can either be @code{first}, -@code{last}, or a number (counting from 0 at the beginning of the -list). Numbers outside the range are mapped to the beginning or the -end of the range, whichever is closer. The @var{position} value is -ignored when redefining an existing piece of advice. - -If @var{function} already has a piece of @var{advice} with the same -name, then the position argument is ignored and the old advice is -replaced with the new one. -@end defun - -@node Activation of Advice -@section Activation of Advice -@cindex activating advice -@cindex advice, activating - -By default, advice does not take effect when you define it---only when -you @dfn{activate} advice for the function. However, the advice will -be activated automatically if you define or redefine the function -later. You can request the activation of advice for a function when -you define the advice, by specifying the @code{activate} flag in the -@code{defadvice}; or you can activate the advice separately by calling -the function @code{ad-activate} or one of the other activation -commands listed below. - -Separating the activation of advice from the act of defining it permits -you to add several pieces of advice to one function efficiently, without -redefining the function over and over as each advice is added. More -importantly, it permits defining advice for a function before that -function is actually defined. - -When a function's advice is first activated, the function's original -definition is saved, and all enabled pieces of advice for that function -are combined with the original definition to make a new definition. -(Pieces of advice that are currently disabled are not used; see -@ref{Enabling Advice}.) This definition is installed, and optionally -byte-compiled as well, depending on conditions described below. - -In all of the commands to activate advice, if @var{compile} is -@code{t} (or anything but @code{nil} or a negative number), the -command also compiles the combined definition which implements the -advice. If it is @code{nil} or a negative number, what happens -depends on @code{ad-default-compilation-action} as described below. - -@deffn Command ad-activate function &optional compile -This command activates all the advice defined for @var{function}. -@end deffn - - Activating advice does nothing if @var{function}'s advice is already -active. But if there is new advice, added since the previous time you -activated advice for @var{function}, it activates the new advice. - -@deffn Command ad-deactivate function -This command deactivates the advice for @var{function}. -@cindex deactivating advice -@c @cindex advice, deactivating "advice, activating" is just above -@end deffn - -@deffn Command ad-update function &optional compile -This command activates the advice for @var{function} -if its advice is already activated. This is useful -if you change the advice. -@end deffn - -@deffn Command ad-activate-all &optional compile -This command activates the advice for all functions. -@end deffn - -@deffn Command ad-deactivate-all -This command deactivates the advice for all functions. -@end deffn - -@deffn Command ad-update-all &optional compile -This command activates the advice for all functions -whose advice is already activated. This is useful -if you change the advice of some functions. -@end deffn - -@deffn Command ad-activate-regexp regexp &optional compile -This command activates all pieces of advice whose names match -@var{regexp}. More precisely, it activates all advice for any function -which has at least one piece of advice that matches @var{regexp}. -@end deffn - -@deffn Command ad-deactivate-regexp regexp -This command deactivates all pieces of advice whose names match -@var{regexp}. More precisely, it deactivates all advice for any -function which has at least one piece of advice that matches -@var{regexp}. -@end deffn - -@deffn Command ad-update-regexp regexp &optional compile -This command activates pieces of advice whose names match @var{regexp}, -but only those for functions whose advice is already activated. -@cindex reactivating advice - -Reactivating a function's advice is useful for putting into effect all -the changes that have been made in its advice (including enabling and -disabling specific pieces of advice; @pxref{Enabling Advice}) since the -last time it was activated. -@end deffn - -@deffn Command ad-start-advice -Turn on automatic advice activation when a function is defined or -redefined. This is the default mode. -@end deffn - -@deffn Command ad-stop-advice -Turn off automatic advice activation when a function is defined or -redefined. -@end deffn - -@defopt ad-default-compilation-action -This variable controls whether to compile the combined definition -that results from activating advice for a function. - -A value of @code{always} specifies to compile unconditionally. -A value of @code{never} specifies never compile the advice. - -A value of @code{maybe} specifies to compile if the byte compiler is -already loaded. A value of @code{like-original} specifies to compile -the advice if the original definition of the advised function is -compiled or a built-in function. - -This variable takes effect only if the @var{compile} argument of -@code{ad-activate} (or any of the above functions) did not force -compilation. -@end defopt - - If the advised definition was constructed during ``preactivation'' -(@pxref{Preactivation}), then that definition must already be compiled, -because it was constructed during byte-compilation of the file that -contained the @code{defadvice} with the @code{preactivate} flag. - -@node Enabling Advice -@section Enabling and Disabling Advice -@cindex enabling advice -@cindex advice, enabling and disabling -@cindex disabling advice - - Each piece of advice has a flag that says whether it is enabled or -not. By enabling or disabling a piece of advice, you can turn it on -and off without having to undefine and redefine it. For example, here is -how to disable a particular piece of advice named @code{my-advice} for -the function @code{foo}: - -@example -(ad-disable-advice 'foo 'before 'my-advice) -@end example - - This function by itself only changes the enable flag for a piece of -advice. To make the change take effect in the advised definition, you -must activate the advice for @code{foo} again: - -@example -(ad-activate 'foo) -@end example - -@deffn Command ad-disable-advice function class name -This command disables the piece of advice named @var{name} in class -@var{class} on @var{function}. -@end deffn - -@deffn Command ad-enable-advice function class name -This command enables the piece of advice named @var{name} in class -@var{class} on @var{function}. -@end deffn - - You can also disable many pieces of advice at once, for various -functions, using a regular expression. As always, the changes take real -effect only when you next reactivate advice for the functions in -question. - -@deffn Command ad-disable-regexp regexp -This command disables all pieces of advice whose names match -@var{regexp}, in all classes, on all functions. -@end deffn - -@deffn Command ad-enable-regexp regexp -This command enables all pieces of advice whose names match -@var{regexp}, in all classes, on all functions. -@end deffn - -@node Preactivation -@section Preactivation -@cindex preactivating advice -@cindex advice, preactivating - - Constructing a combined definition to execute advice is moderately -expensive. When a library advises many functions, this can make loading -the library slow. In that case, you can use @dfn{preactivation} to -construct suitable combined definitions in advance. - - To use preactivation, specify the @code{preactivate} flag when you -define the advice with @code{defadvice}. This @code{defadvice} call -creates a combined definition which embodies this piece of advice -(whether enabled or not) plus any other currently enabled advice for the -same function, and the function's own definition. If the -@code{defadvice} is compiled, that compiles the combined definition -also. - - When the function's advice is subsequently activated, if the enabled -advice for the function matches what was used to make this combined -definition, then the existing combined definition is used, thus avoiding -the need to construct one. Thus, preactivation never causes wrong -results---but it may fail to do any good, if the enabled advice at the -time of activation doesn't match what was used for preactivation. - - Here are some symptoms that can indicate that a preactivation did not -work properly, because of a mismatch. - -@itemize @bullet -@item -Activation of the advised -function takes longer than usual. -@item -The byte compiler gets -loaded while an advised function gets activated. -@item -@code{byte-compile} is included in the value of @code{features} even -though you did not ever explicitly use the byte compiler. -@end itemize - -Compiled preactivated advice works properly even if the function itself -is not defined until later; however, the function needs to be defined -when you @emph{compile} the preactivated advice. - -There is no elegant way to find out why preactivated advice is not being -used. What you can do is to trace the function -@code{ad-cache-id-verification-code} (with the function -@code{trace-function-background}) before the advised function's advice -is activated. After activation, check the value returned by -@code{ad-cache-id-verification-code} for that function: @code{verified} -means that the preactivated advice was used, while other values give -some information about why they were considered inappropriate. - - @strong{Warning:} There is one known case that can make preactivation -fail, in that a preconstructed combined definition is used even though -it fails to match the current state of advice. This can happen when two -packages define different pieces of advice with the same name, in the -same class, for the same function. But you should avoid that anyway. - -@node Argument Access in Advice -@section Argument Access in Advice - - The simplest way to access the arguments of an advised function in the -body of a piece of advice is to use the same names that the function -definition uses. To do this, you need to know the names of the argument -variables of the original function. - - While this simple method is sufficient in many cases, it has a -disadvantage: it is not robust, because it hard-codes the argument names -into the advice. If the definition of the original function changes, -the advice might break. - - Another method is to specify an argument list in the advice itself. -This avoids the need to know the original function definition's argument -names, but it has a limitation: all the advice on any particular -function must use the same argument list, because the argument list -actually used for all the advice comes from the first piece of advice -for that function. - - A more robust method is to use macros that are translated into the -proper access forms at activation time, i.e., when constructing the -advised definition. Access macros access actual arguments by their -(zero-based) position, regardless of how these actual arguments get -distributed onto the argument variables of a function. This is robust -because in Emacs Lisp the meaning of an argument is strictly -determined by its position in the argument list. - -@defmac ad-get-arg position -This returns the actual argument that was supplied at @var{position}. -@end defmac - -@defmac ad-get-args position -This returns the list of actual arguments supplied starting at -@var{position}. -@end defmac - -@defmac ad-set-arg position value -This sets the value of the actual argument at @var{position} to -@var{value} -@end defmac - -@defmac ad-set-args position value-list -This sets the list of actual arguments starting at @var{position} to -@var{value-list}. -@end defmac - - Now an example. Suppose the function @code{foo} is defined as - -@example -(defun foo (x y &optional z &rest r) ...) -@end example - -@noindent -and is then called with - -@example -(foo 0 1 2 3 4 5 6) -@end example - -@noindent -which means that @var{x} is 0, @var{y} is 1, @var{z} is 2 and @var{r} is -@code{(3 4 5 6)} within the body of @code{foo}. Here is what -@code{ad-get-arg} and @code{ad-get-args} return in this case: - -@example -(ad-get-arg 0) @result{} 0 -(ad-get-arg 1) @result{} 1 -(ad-get-arg 2) @result{} 2 -(ad-get-arg 3) @result{} 3 -(ad-get-args 2) @result{} (2 3 4 5 6) -(ad-get-args 4) @result{} (4 5 6) -@end example - - Setting arguments also makes sense in this example: - -@example -(ad-set-arg 5 "five") -@end example - -@noindent -has the effect of changing the sixth argument to @code{"five"}. If this -happens in advice executed before the body of @code{foo} is run, then -@var{r} will be @code{(3 4 "five" 6)} within that body. - - Here is an example of setting a tail of the argument list: - -@example -(ad-set-args 0 '(5 4 3 2 1 0)) -@end example - -@noindent -If this happens in advice executed before the body of @code{foo} is run, -then within that body, @var{x} will be 5, @var{y} will be 4, @var{z} -will be 3, and @var{r} will be @code{(2 1 0)} inside the body of -@code{foo}. - - These argument constructs are not really implemented as Lisp macros. -Instead they are implemented specially by the advice mechanism. - -@node Combined Definition -@section The Combined Definition - - Suppose that a function has @var{n} pieces of before-advice -(numbered from 0 through @var{n}@minus{}1), @var{m} pieces of -around-advice and @var{k} pieces of after-advice. Assuming no piece -of advice is protected, the combined definition produced to implement -the advice for a function looks like this: - -@example -(lambda @var{arglist} - @r{[} @r{[}@var{advised-docstring}@r{]} @r{[}(interactive ...)@r{]} @r{]} - (let (ad-return-value) - @r{before-0-body-form}... - .... - @r{before-@var{n}@minus{}1-body-form}... - @r{around-0-body-form}... - @r{around-1-body-form}... - .... - @r{around-@var{m}@minus{}1-body-form}... - (setq ad-return-value - @r{apply original definition to @var{arglist}}) - @r{end-of-around-@var{m}@minus{}1-body-form}... - .... - @r{end-of-around-1-body-form}... - @r{end-of-around-0-body-form}... - @r{after-0-body-form}... - .... - @r{after-@var{k}@minus{}1-body-form}... - ad-return-value)) -@end example - -Macros are redefined as macros, which means adding @code{macro} to -the beginning of the combined definition. - -The interactive form is present if the original function or some piece -of advice specifies one. When an interactive primitive function is -advised, advice uses a special method: it calls the primitive with -@code{call-interactively} so that it will read its own arguments. -In this case, the advice cannot access the arguments. - -The body forms of the various advice in each class are assembled -according to their specified order. The forms of around-advice @var{l} -are included in one of the forms of around-advice @var{l} @minus{} 1. - -The innermost part of the around advice onion is - -@display -apply original definition to @var{arglist} -@end display - -@noindent -whose form depends on the type of the original function. The variable -@code{ad-return-value} is set to whatever this returns. The variable is -visible to all pieces of advice, which can access and modify it before -it is actually returned from the advised function. - -The semantic structure of advised functions that contain protected -pieces of advice is the same. The only difference is that -@code{unwind-protect} forms ensure that the protected advice gets -executed even if some previous piece of advice had an error or a -non-local exit. If any around-advice is protected, then the whole -around-advice onion is protected as a result. diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi index 577411ba9df..3de9f4ab9d1 100644 --- a/doc/lispref/anti.texi +++ b/doc/lispref/anti.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1999, 2002-2013 Free Software Foundation, Inc. +@c Copyright (C) 1999, 2002-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c This node must have no pointers. diff --git a/doc/lispref/back.texi b/doc/lispref/back.texi index ef20f8b79e0..177522e7b20 100644 --- a/doc/lispref/back.texi +++ b/doc/lispref/back.texi @@ -1,11 +1,12 @@ \input texinfo @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c @c %**start of header @setfilename back-cover @settitle GNU Emacs Lisp Reference Manual +@documentencoding UTF-8 @c %**end of header . @sp 7 diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index f2599c773ea..83ffb2f95e4 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1999, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1995, 1999, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Backups and Auto-Saving @@ -57,13 +57,15 @@ buffer, if appropriate. It is called by @code{save-buffer} before saving the buffer the first time. If a backup was made by renaming, the return value is a cons cell of -the form (@var{modes} @var{context} @var{backupname}), where +the form (@var{modes} @var{extra-alist} @var{backupname}), where @var{modes} are the mode bits of the original file, as returned by -@code{file-modes} (@pxref{File Attributes,, Other Information about -Files}), @var{context} is a list describing the original file's -SELinux context (@pxref{File Attributes}), and @var{backupname} is the -name of the backup. In all other cases, that is, if a backup was made -by copying or if no backup was made, this function returns @code{nil}. +@code{file-modes} (@pxref{Testing Accessibility}), @var{extra-alist} +is an alist describing the original file's extended attributes, as +returned by @code{file-extended-attributes} (@pxref{Extended +Attributes}), and @var{backupname} is the name of the backup. + +In all other cases (i.e., if a backup was made by copying or if no +backup was made), this function returns @code{nil}. @end defun @defvar buffer-backed-up diff --git a/doc/lispref/book-spine.texi b/doc/lispref/book-spine.texi index 721416316d2..f58fb77dcc1 100644 --- a/doc/lispref/book-spine.texi +++ b/doc/lispref/book-spine.texi @@ -2,6 +2,7 @@ @c %**start of header @setfilename book-spine @settitle book-spine +@documentencoding UTF-8 @c %**end of header @include emacsver.texi diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 7ed1876e4b1..fbb6c4009af 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Buffers @@ -488,8 +488,9 @@ Normally, this function asks the user for confirmation if there already is a buffer visiting @var{filename}. If @var{no-query} is non-@code{nil}, that prevents asking this question. If there already is a buffer visiting @var{filename}, and the user confirms or -@var{query} is non-@code{nil}, this function makes the new buffer name -unique by appending a number inside of @samp{<@dots{}>} to @var{filename}. +@var{no-query} is non-@code{nil}, this function makes the new +buffer name unique by appending a number inside of @samp{<@dots{}>} to +@var{filename}. If @var{along-with-file} is non-@code{nil}, that means to assume that the former visited file has been renamed to @var{filename}. In this @@ -631,13 +632,12 @@ exceptional places where the usual test to avoid overwriting a changed file should not be done. @end defun -@c Emacs 19 feature @defun visited-file-modtime This function returns the current buffer's recorded last file modification time, as a list of the form @code{(@var{high} @var{low} -@var{microsec} @var{picosec})}. -(This is the same format that @code{file-attributes} uses to return -time values; see @ref{File Attributes}.) +@var{microsec} @var{picosec})}. (This is the same format that +@code{file-attributes} uses to return time values; @pxref{File +Attributes}.) If the buffer has no recorded last modification time, this function returns zero. This case occurs, for instance, if the buffer is not @@ -647,17 +647,9 @@ visiting a file or if the time has been explicitly cleared by too. For instance, in a Dired buffer listing a directory, it returns the last modification time of that directory, as recorded by Dired. -For a new buffer visiting a not yet existing file, @var{high} is -@minus{}1 and @var{low} is 65535, that is, -@ifnottex -@w{2**16 @minus{} 1.} -@end ifnottex -@tex -@math{2^{16}-1}. -@end tex +If the buffer is not visiting a file, this function returns -1. @end defun -@c Emacs 19 feature @defun set-visited-file-modtime &optional time This function updates the buffer's record of the last modification time of the visited file, to the value specified by @var{time} if @var{time} @@ -1064,7 +1056,7 @@ Buffer foo.changed modified; kill anyway? (yes or no) @kbd{yes} @end deffn @defvar kill-buffer-query-functions -After confirming unsaved changes, @code{kill-buffer} calls the functions +Before confirming unsaved changes, @code{kill-buffer} calls the functions in the list @code{kill-buffer-query-functions}, in order of appearance, with no arguments. The buffer being killed is the current buffer when they are called. The idea of this feature is that these functions will diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 846d6f3a4a9..1df7a856a5d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Command Loop @@ -108,13 +108,26 @@ command does. The special form @code{interactive} turns a Lisp function into a command. The @code{interactive} form must be located at top-level in -the function body (usually as the first form in the body), or in the -@code{interactive-form} property of the function symbol. When the -@code{interactive} form is located in the function body, it does -nothing when actually executed. Its presence serves as a flag, which -tells the Emacs command loop that the function can be called -interactively. The argument of the @code{interactive} form controls -the reading of arguments for an interactive call. +the function body, usually as the first form in the body; this applies +to both lambda expressions (@pxref{Lambda Expressions}) and +@code{defun} forms (@pxref{Defining Functions}). This form does +nothing during the actual execution of the function; its presence +serves as a flag, telling the Emacs command loop that the function can +be called interactively. The argument of the @code{interactive} form +specifies how the arguments for an interactive call should be read. + +@cindex @code{interactive-form} property + Alternatively, an @code{interactive} form may be specified in a +function symbol's @code{interactive-form} property. A non-@code{nil} +value for this property takes precedence over any @code{interactive} +form in the function body itself. This feature is seldom used. + +@cindex @code{interactive-only} property + Sometimes, a named command is only intended to be called +interactively, never directly from Lisp. In that case, give it a +non-@code{nil} @code{interactive-only} property. In that case, the +byte compiler will print a warning message if the command is called +from Lisp. @menu * Using Interactive:: General rules for @code{interactive}. @@ -1921,9 +1934,12 @@ must be the last element of the list. For example, @node Accessing Mouse @subsection Accessing Mouse Events @cindex mouse events, data in +@cindex keyboard events, data in This section describes convenient functions for accessing the data in -a mouse button or motion event. +a mouse button or motion event. Keyboard event data can be accessed +using the same functions, but data elements that aren't applicable to +keyboard events are zero or @code{nil}. The following two functions return a mouse position list (@pxref{Click Events}), specifying the position of a mouse event. @@ -2395,9 +2411,12 @@ and key sequences read from keyboard macros being executed. @code{read-char}, and @code{read-char-exclusive}. @defun read-event &optional prompt inherit-input-method seconds -This function reads and returns the next event of command input, waiting -if necessary until an event is available. Events can come directly from -the user or from a keyboard macro. +This function reads and returns the next event of command input, +waiting if necessary until an event is available. + +The returned event may come directly from the user, or from a keyboard +macro. It is not decoded by the keyboard's input coding system +(@pxref{Terminal I/O Encoding}). If the optional argument @var{prompt} is non-@code{nil}, it should be a string to display in the echo area as a prompt. Otherwise, @@ -2739,12 +2758,16 @@ This function converts the string or vector @var{key} to a list of individual events, which you can put in @code{unread-command-events}. @end defun -@defun input-pending-p +@defun input-pending-p &optional check-timers @cindex waiting for command key input This function determines whether any command input is currently available to be read. It returns immediately, with value @code{t} if there is available input, @code{nil} otherwise. On rare occasions it may return @code{t} when no input is available. + +If the optional argument @var{check-timers} is non-@code{nil}, then if +no input is available, Emacs runs any timers which are ready. +@xref{Timers}. @end defun @defvar last-input-event @@ -3024,7 +3047,7 @@ in @ref{Errors}.) @end deffn You can specify a character other than @kbd{C-g} to use for quitting. -See the function @code{set-input-mode} in @ref{Terminal Input}. +See the function @code{set-input-mode} in @ref{Input Modes}. @node Prefix Command Arguments @section Prefix Command Arguments diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index d60ffebae70..fe492df1d94 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Byte Compilation @chapter Byte Compilation @@ -181,8 +181,8 @@ after compiling it. Interactively, @var{load} is the prefix argument. @example @group -% ls -l push* --rw-r--r-- 1 lewis 791 Oct 5 20:31 push.el +$ ls -l push* +-rw-r--r-- 1 lewis lewis 791 Oct 5 20:31 push.el @end group @group @@ -191,9 +191,9 @@ after compiling it. Interactively, @var{load} is the prefix argument. @end group @group -% ls -l push* --rw-r--r-- 1 lewis 791 Oct 5 20:31 push.el --rw-rw-rw- 1 lewis 638 Oct 8 20:25 push.elc +$ ls -l push* +-rw-r--r-- 1 lewis lewis 791 Oct 5 20:31 push.el +-rw-rw-rw- 1 lewis lewis 638 Oct 8 20:25 push.elc @end group @end example @end deffn @@ -232,7 +232,7 @@ If @var{noforce} is non-@code{nil}, this function does not recompile files that have an up-to-date @samp{.elc} file. @example -% emacs -batch -f batch-byte-compile *.el +$ emacs -batch -f batch-byte-compile *.el @end example @end defun @@ -240,60 +240,50 @@ files that have an up-to-date @samp{.elc} file. @section Documentation Strings and Compilation @cindex dynamic loading of documentation - Functions and variables loaded from a byte-compiled file access their -documentation strings dynamically from the file whenever needed. This -saves space within Emacs, and makes loading faster because the -documentation strings themselves need not be processed while loading the -file. Actual access to the documentation strings becomes slower as a -result, but this normally is not enough to bother users. + When Emacs loads functions and variables from a byte-compiled file, +it normally does not load their documentation strings into memory. +Each documentation string is ``dynamically'' loaded from the +byte-compiled file only when needed. This saves memory, and speeds up +loading by skipping the processing of the documentation strings. - Dynamic access to documentation strings does have drawbacks: + This feature has a drawback: if you delete, move, or alter the +compiled file (such as by compiling a new version), Emacs may no +longer be able to access the documentation string of previously-loaded +functions or variables. Such a problem normally only occurs if you +build Emacs yourself, and happen to edit and/or recompile the Lisp +source files. To solve it, just reload each file after recompilation. -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer access the documentation strings for the functions and variables -in the file. - -@item -If you alter the compiled file (such as by compiling a new version), -then further access to documentation strings in this file will -probably give nonsense results. -@end itemize - -@noindent -These problems normally occur only if you build Emacs yourself and use -it from the directory where you built it, and you happen to edit -and/or recompile the Lisp source files. They can be easily cured by -reloading each file after recompiling it. - -@cindex @samp{#@@@var{count}} -@cindex @samp{#$} - The dynamic documentation string feature writes compiled files that -use a special Lisp reader construct, @samp{#@@@var{count}}. This -construct skips the next @var{count} characters. It also uses the -@samp{#$} construct, which stands for ``the name of this file, as a -string''. It is usually best not to use these constructs in Lisp source -files, since they are not designed to be clear to humans reading the -file. - - You can disable the dynamic documentation string feature at compile -time by setting @code{byte-compile-dynamic-docstrings} to @code{nil}; -this is useful mainly if you expect to change the file, and you want -Emacs processes that have already loaded it to keep working when the -file changes. You can do this globally, or for one source file by -specifying a file-local binding for the variable. One way to do that -is by adding this string to the file's first line: - -@example --*-byte-compile-dynamic-docstrings: nil;-*- -@end example + Dynamic loading of documentation strings from byte-compiled files is +determined, at compile time, for each byte-compiled file. It can be +disabled via the option @code{byte-compile-dynamic-docstrings}. @defopt byte-compile-dynamic-docstrings If this is non-@code{nil}, the byte compiler generates compiled files that are set up for dynamic loading of documentation strings. + +To disable the dynamic loading feature for a specific file, set this +option to @code{nil} in its header line (@pxref{File Variables, , +Local Variables in Files, emacs, The GNU Emacs Manual}), like this: + +@smallexample +-*-byte-compile-dynamic-docstrings: nil;-*- +@end smallexample + +This is useful mainly if you expect to change the file, and you want +Emacs sessions that have already loaded it to keep working when the +file changes. @end defopt +@cindex @samp{#@@@var{count}} +@cindex @samp{#$} +Internally, the dynamic loading of documentation strings is +accomplished by writing compiled files with a special Lisp reader +construct, @samp{#@@@var{count}}. This construct skips the next +@var{count} characters. It also uses the @samp{#$} construct, which +stands for ``the name of this file, as a string''. Do not use these +constructs in Lisp source files; they are not designed to be clear to +humans reading the file. + @node Dynamic Loading @section Dynamic Loading of Individual Functions @@ -440,29 +430,35 @@ to what @code{eval-when-compile} does. @section Compiler Errors @cindex compiler errors - Byte compilation outputs all errors and warnings into the buffer -@file{*Compile-Log*}. The messages include file names and line -numbers that identify the location of the problem. The usual Emacs -commands for operating on compiler diagnostics work properly on these + Error and warning messages from byte compilation are printed in a +buffer named @file{*Compile-Log*}. These messages include file names +and line numbers identifying the location of the problem. The usual +Emacs commands for operating on compiler output can be used on these messages. When an error is due to invalid syntax in the program, the byte compiler might get confused about the errors' exact location. One way -to investigate is to switch to the buffer @w{@file{ *Compiler Input*}}. -(This buffer name starts with a space, so it does not show up in -@kbd{M-x list-buffers}.) This buffer contains the program being +to investigate is to switch to the buffer @w{@file{ *Compiler +Input*}}. (This buffer name starts with a space, so it does not show +up in the Buffer Menu.) This buffer contains the program being compiled, and point shows how far the byte compiler was able to read; the cause of the error might be nearby. @xref{Syntax Errors}, for some tips for locating syntax errors. - When the byte compiler warns about functions that were used but not -defined, it always reports the line number for the end of the file, -not the locations where the missing functions were called. To find -the latter, you must search for the function names. + A common type of warning issued by the byte compiler is for +functions and variables that were used but not defined. Such warnings +report the line number for the end of the file, not the locations +where the missing functions or variables were used; to find these, you +must search the file manually. - You can suppress the compiler warning for calling an undefined -function @var{func} by conditionalizing the function call on an -@code{fboundp} test, like this: + If you are sure that a warning message about a missing function or +variable is unjustified, there are several ways to suppress it: + +@itemize @bullet +@item +You can suppress the warning for a specific call to a function +@var{func} by conditionalizing it on an @code{fboundp} test, like +this: @example (if (fboundp '@var{func}) ...(@var{func} ...)...) @@ -473,14 +469,10 @@ The call to @var{func} must be in the @var{then-form} of the @code{if}, and @var{func} must appear quoted in the call to @code{fboundp}. (This feature operates for @code{cond} as well.) - You can tell the compiler that a function is defined using -@code{declare-function} (@pxref{Declaring Functions}). Likewise, you -can tell the compiler that a variable is defined using @code{defvar} -with no initial value. - - You can suppress the compiler warning for a specific use of an -undefined variable @var{variable} by conditionalizing its use on a -@code{boundp} test, like this: +@item +Likewise, you can suppress the warning for a specific use of a +variable @var{variable} by conditionalizing it on a @code{boundp} +test: @example (if (boundp '@var{variable}) ...@var{variable}...) @@ -491,7 +483,17 @@ The reference to @var{variable} must be in the @var{then-form} of the @code{if}, and @var{variable} must appear quoted in the call to @code{boundp}. - You can suppress any and all compiler warnings within a certain +@item +You can tell the compiler that a function is defined using +@code{declare-function}. @xref{Declaring Functions}. + +@item +Likewise, you can tell the compiler that a variable is defined using +@code{defvar} with no initial value. (Note that this marks the +variable as special.) @xref{Defining Variables}. +@end itemize + + You can also suppress any and all compiler warnings within a certain expression using the construct @code{with-no-warnings}: @c This is implemented with a defun, but conceptually it is @@ -507,13 +509,15 @@ possible piece of code, to avoid missing possible warnings other than one you intend to suppress. @end defspec - More precise control of warnings is possible by setting the variable -@code{byte-compile-warnings}. + Byte compiler warnings can be controlled more precisely by setting +the variable @code{byte-compile-warnings}. See its documentation +string for details. @node Byte-Code Objects @section Byte-Code Function Objects @cindex compiled function @cindex byte-code function +@cindex byte-code object Byte-compiled functions have a special data type: they are @dfn{byte-code function objects}. Whenever such an object appears as @@ -606,8 +610,9 @@ name of an existing buffer. Then the output goes there, at point, and point is left before the output. The argument @var{object} can be a function name, a lambda expression -or a byte-code object. If it is a lambda expression, @code{disassemble} -compiles it and disassembles the resulting compiled code. +(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Byte-Code +Objects}). If it is a lambda expression, @code{disassemble} compiles +it and disassembles the resulting compiled code. @end deffn Here are two examples of using the @code{disassemble} function. We diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 76a2f464792..edf60dd5cc8 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Control Structures @@ -218,15 +218,11 @@ list is the @var{condition}; the remaining elements, if any, the @code{cond} tries the clauses in textual order, by evaluating the @var{condition} of each clause. If the value of @var{condition} is non-@code{nil}, the clause ``succeeds''; then @code{cond} evaluates its -@var{body-forms}, and the value of the last of @var{body-forms} becomes -the value of the @code{cond}. The remaining clauses are ignored. +@var{body-forms}, and returns the value of the last of @var{body-forms}. +Any remaining clauses are ignored. If the value of @var{condition} is @code{nil}, the clause ``fails'', so -the @code{cond} moves on to the following clause, trying its -@var{condition}. - -If every @var{condition} evaluates to @code{nil}, so that every clause -fails, @code{cond} returns @code{nil}. +the @code{cond} moves on to the following clause, trying its @var{condition}. A clause may also look like this: @@ -235,8 +231,11 @@ A clause may also look like this: @end example @noindent -Then, if @var{condition} is non-@code{nil} when tested, the value of -@var{condition} becomes the value of the @code{cond} form. +Then, if @var{condition} is non-@code{nil} when tested, the @code{cond} +form returns the value of @var{condition}. + +If every @var{condition} evaluates to @code{nil}, so that every clause +fails, @code{cond} returns @code{nil}. The following example has four clauses, which test for the cases where the value of @code{x} is a number, string, buffer and symbol, @@ -323,13 +322,14 @@ In the last clause, @code{code} is a variable that gets bound to the value that was returned by @code{(get-return-code x)}. To give a more complex example, a simple interpreter for a little -expression language could look like: +expression language could look like (note that this example requires +lexical binding): @example (defun evaluate (exp env) (pcase exp (`(add ,x ,y) (+ (evaluate x env) (evaluate y env))) - (`(call ,fun ,arg) (funcall (evaluate fun) (evaluate arg env))) + (`(call ,fun ,arg) (funcall (evaluate fun env) (evaluate arg env))) (`(fn ,arg ,body) (lambda (val) (evaluate body (cons (cons arg val) env)))) ((pred numberp) exp) @@ -343,6 +343,15 @@ third elements and binds them to the variables @code{x} and @code{y}. @code{(pred numberp)} is a pattern that simply checks that @code{exp} is a number, and @code{_} is the catch-all pattern that matches anything. +Here are some sample programs including their evaluation results: + +@example +(evaluate '(add 1 2) nil) ;=> 3 +(evaluate '(add x y) '((x . 1) (y . 2))) ;=> 3 +(evaluate '(call (fn x (add 1 x)) 2) nil) ;=> 3 +(evaluate '(sub 1 2) nil) ;=> error +@end example + There are two kinds of patterns involved in @code{pcase}, called @emph{U-patterns} and @emph{Q-patterns}. The @var{upattern} mentioned above are U-patterns and can take the following forms: @@ -373,7 +382,7 @@ symbol to the value that it matched, so that you can later refer to it, either in the @var{body-forms} or also later in the pattern. @item _ This so-called @emph{don't care} pattern matches anything, like the previous -one, but unless symbol patterns it does not bind any variable. +one, but unlike symbol patterns it does not bind any variable. @item (pred @var{pred}) This pattern matches if the function @var{pred} returns non-@code{nil} when called with the object being matched. @@ -890,9 +899,8 @@ argument @var{data} is a list of additional Lisp objects relevant to the circumstances of the error. The argument @var{error-symbol} must be an @dfn{error symbol}---a symbol -bearing a property @code{error-conditions} whose value is a list of -condition names. This is how Emacs Lisp classifies different sorts of -errors. @xref{Error Symbols}, for a description of error symbols, +defined with @code{define-error}. This is how Emacs Lisp classifies different +sorts of errors. @xref{Error Symbols}, for a description of error symbols, error conditions and condition names. If the error is not handled, the two arguments are used in printing @@ -1118,8 +1126,8 @@ Here are examples of handlers: @end example Each error that occurs has an @dfn{error symbol} that describes what -kind of error it is. The @code{error-conditions} property of this -symbol is a list of condition names (@pxref{Error Symbols}). Emacs +kind of error it is, and which describes also a list of condition names +(@pxref{Error Symbols}). Emacs searches all the active @code{condition-case} forms for a handler that specifies one or more of these condition names; the innermost matching @code{condition-case} handles the error. Within this @@ -1244,10 +1252,13 @@ Here's the example at the beginning of this subsection rewritten using @end example @end defmac -@defmac with-demoted-errors body@dots{} +@defmac with-demoted-errors format body@dots{} This macro is like a milder version of @code{ignore-errors}. Rather than suppressing errors altogether, it converts them into messages. -Use this form around code that is not expected to signal errors, but +It uses the string @var{format} to format the message. +@var{format} should contain a single @samp{%}-sequence; e.g., +@code{"Error: %S"}. Use @code{with-demoted-errors} around code +that is not expected to signal errors, but should be robust if one does occur. Note that this macro uses @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac @@ -1259,6 +1270,7 @@ should be robust if one does occur. Note that this macro uses @cindex condition name @cindex user-defined error @kindex error-conditions +@kindex define-error When you signal an error, you specify an @dfn{error symbol} to specify the kind of error you have in mind. Each error has one and only one @@ -1275,42 +1287,38 @@ Thus, each error has one or more condition names: @code{error}, the error symbol if that is distinct from @code{error}, and perhaps some intermediate classifications. - In order for a symbol to be an error symbol, it must have an -@code{error-conditions} property which gives a list of condition names. -This list defines the conditions that this kind of error belongs to. -(The error symbol itself, and the symbol @code{error}, should always be -members of this list.) Thus, the hierarchy of condition names is -defined by the @code{error-conditions} properties of the error symbols. -Because quitting is not considered an error, the value of the -@code{error-conditions} property of @code{quit} is just @code{(quit)}. +@defun define-error name message &optional parent + In order for a symbol to be an error symbol, it must be defined with +@code{define-error} which takes a parent condition (defaults to @code{error}). +This parent defines the conditions that this kind of error belongs to. +The transitive set of parents always includes the error symbol itself, and the +symbol @code{error}. Because quitting is not considered an error, the set of +parents of @code{quit} is just @code{(quit)}. +@end defun @cindex peculiar error - In addition to the @code{error-conditions} list, the error symbol -should have an @code{error-message} property whose value is a string to -be printed when that error is signaled but not handled. If the -error symbol has no @code{error-message} property or if the -@code{error-message} property exists, but is not a string, the error -message @samp{peculiar error} is used. @xref{Definition of signal}. + In addition to its parents, the error symbol has a @var{message} which +is a string to be printed when that error is signaled but not handled. If that +message is not valid, the error message @samp{peculiar error} is used. +@xref{Definition of signal}. + +Internally, the set of parents is stored in the @code{error-conditions} +property of the error symbol and the message is stored in the +@code{error-message} property of the error symbol. Here is how we define a new error symbol, @code{new-error}: @example @group -(put 'new-error - 'error-conditions - '(error my-own-errors new-error)) -@result{} (error my-own-errors new-error) -@end group -@group -(put 'new-error 'error-message "A new error") -@result{} "A new error" +(define-error 'new-error "A new error" 'my-own-errors) @end group @end example @noindent -This error has three condition names: @code{new-error}, the narrowest +This error has several condition names: @code{new-error}, the narrowest classification; @code{my-own-errors}, which we imagine is a wider -classification; and @code{error}, which is the widest of all. +classification; and all the conditions of @code{my-own-errors} which should +include @code{error}, which is the widest of all. The error string should start with a capital letter but it should not end with a period. This is for consistency with the rest of Emacs. @@ -1326,7 +1334,7 @@ your code can do this: @end group @end example - This error can be handled through any of the three condition names. + This error can be handled through any of its condition names. This example handles @code{new-error} and any other errors in the class @code{my-own-errors}: diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index e9260309057..4b0a0a9ba2c 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1997-2013 Free Software Foundation, Inc. +@c Copyright (C) 1997-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Customization @chapter Customization Settings @@ -287,13 +287,17 @@ customizable variable). You should not quote @var{option}. The argument @var{standard} is an expression that specifies the standard value for @var{option}. Evaluating the @code{defcustom} form -evaluates @var{standard}, but does not necessarily install the -standard value. If @var{option} already has a default value, -@code{defcustom} does not change it. If the user has saved a -customization for @var{option}, @code{defcustom} installs the user's -customized value as @var{option}'s default value. If neither of those -cases applies, @code{defcustom} installs the result of evaluating -@var{standard} as the default value. +evaluates @var{standard}, but does not necessarily bind the option to +that value. If @var{option} already has a default value, it is left +unchanged. If the user has already saved a customization for +@var{option}, the user's customized value is installed as the default +value. Otherwise, the result of evaluating @var{standard} is +installed as the default value. + +Like @code{defvar}, this macro marks @code{option} as a special +variable, meaning that it should always be dynamically bound. If +@var{option} is already lexically bound, that lexical binding remains +in effect until the binding construct exits. @xref{Variable Scoping}. The expression @var{standard} can be evaluated at various other times, too---whenever the customization facility needs to know @var{option}'s @@ -1428,6 +1432,17 @@ loaded into Emacs, whether or not the theme is enabled). Otherwise, it returns @code{nil}. @end defun +@defvar custom-known-themes +The value of this variable is a list of themes loaded into Emacs. +Each theme is represented by a Lisp symbol (the theme name). The +default value of this variable is a list containing two ``dummy'' +themes: @code{(user changed)}. The @code{changed} theme stores +settings made before any Custom themes are applied (e.g., variables +set outside of Customize). The @code{user} theme stores settings the +user has customized and saved. Any additional themes declared with +the @code{deftheme} macro are added to the front of this list. +@end defvar + @deffn Command load-theme theme &optional no-confirm no-enable This function loads the Custom theme named @var{theme} from its source file, looking for the source file in the directories specified by the diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 24629465525..a9d0c1c4ed0 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1994, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Debugging @@ -32,7 +32,7 @@ program. @item You can use the ERT package to write regression tests for the program. -@xref{Top,the ERT manual,, ERT, ERT: Emacs Lisp Regression Testing}. +@xref{Top,the ERT manual,, ert, ERT: Emacs Lisp Regression Testing}. @item You can profile the program to get hints about how to make it more efficient. @@ -388,6 +388,7 @@ the same function. (To do this, visit the source for the function and type @kbd{C-M-x} on its definition.) You cannot use the Lisp debugger to step through a primitive function. +@c FIXME: Add @findex for the following commands? --xfq Here is a list of Debugger mode commands: @table @kbd @@ -424,7 +425,8 @@ Flag the current frame like @kbd{b}. Then continue execution like are set up to do so by @code{debug-on-entry}. @item e -Read a Lisp expression in the minibuffer, evaluate it, and print the +Read a Lisp expression in the minibuffer, evaluate it (with the +relevant lexical environment, if applicable), and print the value in the echo area. The debugger alters certain important variables, and the current buffer, as part of its operation; @kbd{e} temporarily restores their values from outside the debugger, so you can @@ -462,6 +464,9 @@ This is a list of functions that are set to break on entry by means of @code{debug-on-entry}. @strong{Warning:} if you redefine such a function and thus cancel the effect of @code{debug-on-entry}, it may erroneously show up in this list. + +@item v +Toggle the display of local variables of the current stack frame. @end table @node Invoking the Debugger diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index eae6af9969d..c4c2c13d3d2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Display @chapter Emacs Display @@ -168,6 +168,7 @@ entire frame width). @end defopt @defopt truncate-partial-width-windows +@cindex partial-width windows This variable controls line truncation in @dfn{partial-width} windows. A partial-width window is one that does not occupy the entire frame width (@pxref{Splitting Windows}). If the value is @code{nil}, line @@ -213,28 +214,28 @@ A line prefix may also be specified for regions of text using the over the @code{line-prefix} variable. @xref{Special Properties}. @end defvar - If your buffer contains @emph{very} long lines, and you use -continuation to display them, computing the continuation lines can -make redisplay slow. The column computation and indentation functions -also become slow. Then you might find it advisable to set -@code{cache-long-line-scans} to @code{t}. +@ignore + If your buffer contains only very short lines, you might find it +advisable to set @code{cache-long-scans} to @code{nil}. -@defvar cache-long-line-scans -If this variable is non-@code{nil}, various indentation and motion -functions, and Emacs redisplay, cache the results of scanning the -buffer, and consult the cache to avoid rescanning regions of the buffer -unless they are modified. +@defvar cache-long-scans +If this variable is non-@code{nil} (the default), various indentation +and motion functions, and Emacs redisplay, cache the results of +scanning the buffer, and consult the cache to avoid rescanning regions +of the buffer unless they are modified. -Turning on the cache slows down processing of short lines somewhat. +Turning off the cache speeds up processing of short lines somewhat. This variable is automatically buffer-local in every buffer. @end defvar +@end ignore @node The Echo Area @section The Echo Area @cindex error display @cindex echo area +@c FIXME: Why not use @xref{Minibuffers} directly? --xfq The @dfn{echo area} is used for displaying error messages (@pxref{Errors}), for messages made with the @code{message} primitive, and for echoing keystrokes. It is not the same as the minibuffer, @@ -440,7 +441,7 @@ that it prints a message in the echo area unconditionally. The first two arguments have the same meaning as for @code{progress-reporter-update}. Optional @var{new-message} allows -you to change the message of the @var{reporter}. Since this functions +you to change the message of the @var{reporter}. Since this function always updates the echo area, such a change will be immediately presented to the user. @end defun @@ -479,7 +480,17 @@ this macro this way: Almost all the messages displayed in the echo area are also recorded in the @file{*Messages*} buffer so that the user can refer back to them. This includes all the messages that are output with -@code{message}. +@code{message}. By default, this buffer is read-only and uses the major +mode @code{messages-buffer-mode}. Nothing prevents the user from +killing the @file{*Messages*} buffer, but the next display of a message +recreates it. Any Lisp code that needs to access the +@file{*Messages*} buffer directly and wants to ensure that it exists +should use the function @code{messages-buffer}. + +@defun messages-buffer +This function returns the @file{*Messages*} buffer. If it does not +exist, it creates it, and switches it to @code{messages-buffer-mode}. +@end defun @defopt message-log-max This variable specifies how many lines to keep in the @file{*Messages*} @@ -609,6 +620,9 @@ program signals a Lisp error and then handles it with @code{condition-case}, the user won't see the error message; it could show the message to the user by reporting it as a warning.) +@c FIXME: Why use "(bytecomp)" instead of "'bytecomp" or simply +@c "bytecomp" here? The parens are part of warning-type-format but +@c not part of the warning type. --xfq @cindex warning type Each warning has a @dfn{warning type} to classify it. The type is a list of symbols. The first symbol should be the custom group that you @@ -628,8 +642,8 @@ for logging the warning. By default, it is @file{*Warnings*}. @defun lwarn type level message &rest args This function reports a warning using the value of @code{(format -@var{message} @var{args}...)} as the message. In other respects it is -equivalent to @code{display-warning}. +@var{message} @var{args}...)} as the message in the @file{*Warnings*} +buffer. In other respects it is equivalent to @code{display-warning}. @end defun @defun warn message &rest args @@ -956,11 +970,11 @@ make it invisible again. @dfn{Selective display} refers to a pair of related features for hiding certain lines on the screen. - The first variant, explicit selective display, is designed for use -in a Lisp program: it controls which lines are hidden by altering the -text. This kind of hiding in some ways resembles the effect of the -@code{invisible} property (@pxref{Invisible Text}), but the two -features are different and do not work the same way. +@cindex explicit selective display + The first variant, explicit selective display, was designed for use in a Lisp +program: it controls which lines are hidden by altering the text. This kind of +hiding is now obsolete; instead you can get the same effect with the +@code{invisible} property (@pxref{Invisible Text}). In the second variant, the choice of lines to hide is made automatically based on indentation. This variant is designed to be a @@ -1120,6 +1134,7 @@ The value of the last form in @var{forms} is returned. @result{} # ---------- Buffer: foo ---------- + 20 # @@ -1243,6 +1258,7 @@ Type RET when done reading @node Overlays @section Overlays @cindex overlays +@c FIXME: mention intervals in this section? You can use @dfn{overlays} to alter the appearance of a buffer's text on the screen, for the sake of presentation features. An overlay is an @@ -1510,31 +1526,31 @@ of the symbol serve as defaults for the properties of the overlay. @item face @kindex face @r{(overlay property)} -This property controls the way text is displayed---for example, which -font and which colors. @xref{Faces}, for more information. - -In the simplest case, the value is a face name. It can also be a list; -then each element can be any of these possibilities: +This property controls the appearance of the text (@pxref{Faces}). +The value of the property can be the following: @itemize @bullet @item A face name (a symbol or string). @item -A property list of face attributes. This has the form (@var{keyword} -@var{value} @dots{}), where each @var{keyword} is a face attribute -name and @var{value} is a meaningful value for that attribute. With -this feature, you do not need to create a face each time you want to -specify a particular attribute for certain text. @xref{Face -Attributes}. +An anonymous face: a property list of the form @code{(@var{keyword} +@var{value} @dots{})}, where each @var{keyword} is a face attribute +name and @var{value} is a value for that attribute. @item -A cons cell, of the form @code{(foreground-color . @var{color-name})} -or @code{(background-color . @var{color-name})}. These elements -specify just the foreground color or just the background color. +A list of faces. Each list element should be either a face name or an +anonymous face. This specifies a face which is an aggregate of the +attributes of each of the listed faces. Faces occurring earlier in +the list have higher priority. -@code{(foreground-color . @var{color-name})} has the same effect as -@code{(:foreground @var{color-name})}; likewise for the background. +@item +A cons cell of the form @code{(foreground-color . @var{color-name})} +or @code{(background-color . @var{color-name})}. This specifies the +foreground or background color, similar to @code{(:foreground +@var{color-name})} or @code{(:background @var{color-name})}. This +form is supported for backward compatibility only, and should be +avoided. @end itemize @item mouse-face @@ -1655,26 +1671,26 @@ if it becomes empty (i.e., if its length becomes zero). If you give an empty overlay a non-@code{nil} @code{evaporate} property, that deletes it immediately. -@item local-map -@cindex keymap of character (and overlays) -@kindex local-map @r{(overlay property)} -If this property is non-@code{nil}, it specifies a keymap for a portion -of the text. The property's value replaces the buffer's local map, when -the character after point is within the overlay. @xref{Active Keymaps}. - @item keymap +@cindex keymap of character (and overlays) @kindex keymap @r{(overlay property)} -The @code{keymap} property is similar to @code{local-map} but overrides the -buffer's local map (and the map specified by the @code{local-map} -property) rather than replacing it. +If this property is non-@code{nil}, it specifies a keymap for a portion of the +text. This keymap is used when the character after point is within the +overlay, and takes precedence over most other keymaps. @xref{Active Keymaps}. + +@item local-map +@kindex local-map @r{(overlay property)} +The @code{local-map} property is similar to @code{keymap} but replaces the +buffer's local map rather than augmenting existing keymaps. This also means it +has lower precedence than minor mode keymaps. @end table -The @code{local-map} and @code{keymap} properties do not affect a +The @code{keymap} and @code{local-map} properties do not affect a string displayed by the @code{before-string}, @code{after-string}, or @code{display} properties. This is only relevant for mouse clicks and other mouse events that fall on the string, since point is never on the string. To bind special mouse events for the string, assign it a -@code{local-map} or @code{keymap} text property. @xref{Special +@code{keymap} or @code{local-map} text property. @xref{Special Properties}. @node Finding Overlays @@ -1787,9 +1803,9 @@ the beginning of the result if one multi-column character in @var{string} extends across the column @var{start-column}. If @var{ellipsis} is non-@code{nil}, it should be a string which will -replace the end of @var{str} (including any padding) if it extends -beyond @var{end-column}, unless the display width of @var{str} is -equal to or less than the display width of @var{ellipsis}. If +replace the end of @var{string} (including any padding) if it extends +beyond @var{width}, unless the display width of @var{string} is equal +to or less than the display width of @var{ellipsis}. If @var{ellipsis} is non-@code{nil} and not a string, it stands for @code{"..."}. @@ -1804,6 +1820,7 @@ equal to or less than the display width of @var{ellipsis}. If @node Line Height @section Line Height @cindex line height +@cindex height of a line The total height of each display line consists of the height of the contents of the line, plus optional additional vertical line spacing @@ -1838,6 +1855,7 @@ First Emacs uses @var{height} as a height spec to control extra space to bring the total line height up to @var{total}. In this case, the other ways to specify the line spacing are ignored. +@cindex height spec Any other kind of property value is a height spec, which translates into a number---the specified line height. There are several ways to write a height spec; here's how each of them translates into a number: @@ -1901,44 +1919,39 @@ height. @section Faces @cindex faces - A @dfn{face} is a collection of graphical @dfn{attributes} for -displaying text: font, foreground color, background color, optional -underlining, etc. Faces control how Emacs displays text in buffers, -as well as other parts of the frame such as the mode line. + A @dfn{face} is a collection of graphical attributes for displaying +text: font, foreground color, background color, optional underlining, +etc. Faces control how Emacs displays text in buffers, as well as +other parts of the frame such as the mode line. @cindex anonymous face One way to represent a face is as a property list of attributes, -like @code{(:foreground "red" :weight bold)}. For example, you can -assign such an @dfn{anonymous face} as the value of the @code{face} -text property; this causes Emacs to display the underlying text with -the specified attributes. @xref{Special Properties}. +like @code{(:foreground "red" :weight bold)}. Such a list is called +an @dfn{anonymous face}. For example, you can assign an anonymous +face as the value of the @code{face} text property, and Emacs will +display the underlying text with the specified attributes. +@xref{Special Properties}. @cindex face name More commonly, a face is referred to via a @dfn{face name}: a Lisp -symbol which is associated with a set of face attributes. Named faces -are defined using the @code{defface} macro (@pxref{Defining Faces}). -Emacs defines several standard named faces; @xref{Standard Faces,,, -emacs, The GNU Emacs Manual}. +symbol associated with a set of face attributes@footnote{For backward +compatibility, you can also use a string to specify a face name; that +is equivalent to a Lisp symbol with the same name.}. Named faces are +defined using the @code{defface} macro (@pxref{Defining Faces}). +Emacs comes with several standard named faces (@pxref{Basic Faces}). - Many parts of Emacs require named faces, and do not accept anonymous -faces. These include the functions documented in @ref{Attribute -Functions}, and the variable @code{font-lock-keywords} + Many parts of Emacs required named faces, and do not accept +anonymous faces. These include the functions documented in +@ref{Attribute Functions}, and the variable @code{font-lock-keywords} (@pxref{Search-based Fontification}). Unless otherwise stated, we will use the term @dfn{face} to refer only to named faces. - For backward compatibility, you can also use a string to specify a -face name; that is equivalent to a Lisp symbol with the same name. - @defun facep object This function returns a non-@code{nil} value if @var{object} is a named face: a Lisp symbol or string which serves as a face name. Otherwise, it returns @code{nil}. @end defun - By default, each face name corresponds to the same set of attributes -in all frames. But you can also assign a face name a special set of -attributes in one frame (@pxref{Attribute Functions}). - @menu * Face Attributes:: What is in a face? * Defining Faces:: How to define a face. @@ -2032,6 +2045,15 @@ name, or a hexadecimal color specification. @xref{Color Names}. On black-and-white displays, certain shades of gray are implemented by stipple patterns. +@item :distant-foreground +Alternative foreground color, a string. This is like @code{:foreground} +but the color is only used as a foreground when the background color is +near to the foreground that would have been used. This is useful for +example when marking text (i.e. the region face). If the text has a foreground +that is visible with the region face, that foreground is used. +If the foreground is near the region face background, +@code{:distant-foreground} is used instead so the text is readable. + @item :background Background color, a string. The value can be a system-defined color name, or a hexadecimal color specification. @xref{Color Names}. @@ -2072,6 +2094,8 @@ value @code{nil} means do not overline. Whether or not characters should be strike-through, and in what color. The value is used like that of @code{:overline}. +@cindex 2D box +@cindex 3D box @item :box Whether or not a box should be drawn around characters, its color, the width of the box lines, and 3D appearance. Here are the possible @@ -2131,7 +2155,8 @@ used automatically to handle certain shades of gray. @item :font The font used to display the face. Its value should be a font object. -@xref{Font Selection}, for information about font objects. +@xref{Low-Level Font}, for information about font objects, font specs, +and font entities. When specifying this attribute using @code{set-face-attribute} (@pxref{Attribute Functions}), you may also supply a font spec, a font @@ -2144,6 +2169,7 @@ font matching those wildcards. Specifying this attribute also changes the values of the @code{:family}, @code{:foundry}, @code{:width}, @code{:height}, @code{:weight}, and @code{:slant} attributes. +@cindex inheritance, for faces @item :inherit The name of a face from which to inherit attributes, or a list of face names. Attributes from inherited faces are merged into the face like @@ -2178,32 +2204,47 @@ suitable for use with @code{:stipple} (see above). It returns @node Defining Faces @subsection Defining Faces +@cindex face spec The usual way to define a face is through the @code{defface} macro. -This macro defines a face name, and associates that name with a set of -face attributes. It also sets up the face so that the user can -customize it via the Customize interface (@pxref{Customization}). +This macro associates a face name (a symbol) with a default @dfn{face +spec}. A face spec is a construct which specifies what attributes a +face should have on any given terminal; for example, a face spec might +specify one foreground color on high-color terminals, and a different +foreground color on low-color terminals. + + People are sometimes tempted to create a variable whose value is a +face name. In the vast majority of cases, this is not necessary; the +usual procedure is to define a face with @code{defface}, and then use +its name directly. @defmac defface face spec doc [keyword value]@dots{} -This macro declares @var{face} as a customizable face whose default -attributes are given by @var{spec}. You should not quote the symbol -@var{face}, and it should not end in @samp{-face} (that would be -redundant). The argument @var{doc} is a documentation string for the -face. The additional @var{keyword} arguments have the same meanings -as in @code{defgroup} and @code{defcustom} (@pxref{Common Keywords}). +This macro declares @var{face} as a named face whose default face spec +is given by @var{spec}. You should not quote the symbol @var{face}, +and it should not end in @samp{-face} (that would be redundant). The +argument @var{doc} is a documentation string for the face. The +additional @var{keyword} arguments have the same meanings as in +@code{defgroup} and @code{defcustom} (@pxref{Common Keywords}). -When @code{defface} executes, it defines the face according to -@var{spec}, then uses any customizations that were read from the -init file (@pxref{Init File}) to override that specification. +If @var{face} already has a default face spec, this macro does +nothing. -When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs -Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} -overrides any customizations of the face. This way, the face reflects -exactly what the @code{defface} says. +The default face spec determines @var{face}'s appearance when no +customizations are in effect (@pxref{Customization}). If @var{face} +has already been customized (via Custom themes or via customizations +read from the init file), its appearance is determined by the custom +face spec(s), which override the default face spec @var{spec}. +However, if the customizations are subsequently removed, the +appearance of @var{face} will again be determined by its default face +spec. -@cindex face specification -The @var{spec} argument is a @dfn{face specification}, which states -how the face should appear on different kinds of terminals. It should -be an alist whose elements each have the form +As an exception, if you evaluate a @code{defface} form with +@kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature +of @code{eval-defun} overrides any custom face specs on the face, +causing the face to reflect exactly what the @code{defface} says. + +The @var{spec} argument is a @dfn{face spec}, which states how the +face should appear on different kinds of terminals. It should be an +alist whose elements each have the form @example (@var{display} . @var{plist}) @@ -2275,7 +2316,8 @@ terminal must match one of the @var{value}s specified for it in @end table @end defmac - Here's how the standard face @code{highlight} is defined: + For example, here's the definition of the standard face +@code{highlight}: @example (defface highlight @@ -2294,65 +2336,56 @@ terminal must match one of the @var{value}s specified for it in :group 'basic-faces) @end example - Internally, Emacs stores the face's default specification in its + Internally, Emacs stores each face's default spec in its @code{face-defface-spec} symbol property (@pxref{Symbol Properties}). -The @code{saved-face} property stores the face specification saved by -the user, using the customization buffer; the @code{customized-face} -property stores the face specification customized for the current -session, but not saved; and the @code{theme-face} property stores an -alist associating the active customization settings and Custom themes -with their specifications for that face. The face's documentation -string is stored in the @code{face-documentation} property. But -normally you should not try to set any of these properties directly. -@xref{Applying Customizations}, for the @code{custom-set-faces} -function, which is used to apply customized face settings. +The @code{saved-face} property stores any face spec saved by the user +using the customization buffer; the @code{customized-face} property +stores the face spec customized for the current session, but not +saved; and the @code{theme-face} property stores an alist associating +the active customization settings and Custom themes with the face +specs for that face. The face's documentation string is stored in the +@code{face-documentation} property. - People are sometimes tempted to create variables whose values -specify a face to use. In the vast majority of cases, this is not -necessary; it is preferable to simply use faces directly. + Normally, a face is declared just once, using @code{defface}, and +any further changes to its appearance are applied using the Customize +framework (e.g., via the Customize user interface or via the +@code{custom-set-faces} function; @pxref{Applying Customizations}), or +by face remapping (@pxref{Face Remapping}). In the rare event that +you need to change a face spec directly from Lisp, you can use the +@code{face-spec-set} function. + +@defun face-spec-set face spec &optional spec-type +This function applies @var{spec} as a face spec for @code{face}. +@var{spec} should be a face spec, as described in the above +documentation for @code{defface}. + +@cindex override spec @r{(for a face)} +The argument @var{spec-type} determines which spec to set. If it is +@code{nil} or @code{face-override-spec}, this function sets the +@dfn{override spec}, which overrides over all other face specs on +@var{face}. If it is @code{face-defface-spec}, this function sets the +default face spec (the same one set by @code{defface}). If it is +@code{reset}, this function clears out all customization specs and +override specs from @var{face} (in this case, the value of @var{spec} +is ignored). Any other value of @var{spec-type} is reserved for +internal use. +@end defun @node Attribute Functions @subsection Face Attribute Functions - This section describes the functions for accessing and modifying the -attributes of an existing named face. - -@defun set-face-attribute face frame &rest arguments -This function sets one or more attributes of @var{face} for -@var{frame}. The attributes you specify this way override whatever -the @code{defface} says. - -The extra arguments @var{arguments} specify the attributes to set, and -the values for them. They should consist of alternating attribute -names (such as @code{:family} or @code{:underline}) and values. Thus, - -@example -(set-face-attribute 'foo nil - :width 'extended - :weight 'bold) -@end example - -@noindent -sets the attribute @code{:width} to @code{extended} and the attribute -@code{:weight} to @code{bold}. - -If @var{frame} is @code{t}, this function sets the default attributes -for new frames. Default attribute values specified this way override -the @code{defface} for newly created frames. - -If @var{frame} is @code{nil}, this function sets the attributes for -all existing frames, and the default for new frames. -@end defun + This section describes functions for directly accessing and +modifying the attributes of a named face. @defun face-attribute face attribute &optional frame inherit -This returns the value of the @var{attribute} attribute of @var{face} -on @var{frame}. If @var{frame} is @code{nil}, that means the selected -frame (@pxref{Input Focus}). +This function returns the value of the @var{attribute} attribute for +@var{face} on @var{frame}. -If @var{frame} is @code{t}, this returns whatever new-frames default -value you previously specified with @code{set-face-attribute} for the -@var{attribute} attribute of @var{face}. If you have not specified -one, it returns @code{nil}. +If @var{frame} is @code{nil}, that means the selected frame +(@pxref{Input Focus}). If @var{frame} is @code{t}, this function +returns the value of the specified attribute for newly-created frames +(this is normally @code{unspecified}, unless you have specified some +value using @code{set-face-attribute}; see below). If @var{inherit} is @code{nil}, only attributes directly defined by @var{face} are considered, so the return value may be @@ -2377,6 +2410,7 @@ For example, @end example @end defun +@c FIXME: Add an index for "relative face attribute", maybe here? --xfq @defun face-attribute-relative-p attribute value This function returns non-@code{nil} if @var{value}, when used as the value of the face attribute @var{attribute}, is relative. This means @@ -2409,6 +2443,36 @@ If @var{value1} is a relative value for the face attribute @var{attribute}, returns it merged with the underlying value @var{value2}; otherwise, if @var{value1} is an absolute value for the face attribute @var{attribute}, returns @var{value1} unchanged. +@end defun + + Normally, Emacs uses the face specs of each face to automatically +calculate its attributes on each frame (@pxref{Defining Faces}). The +function @code{set-face-attribute} can override this calculation by +directly assigning attributes to a face, either on a specific frame or +for all frames. This function is mostly intended for internal usage. + +@defun set-face-attribute face frame &rest arguments +This function sets one or more attributes of @var{face} for +@var{frame}. The attributes specifies in this way override the face +spec(s) belonging to @var{face}. + +The extra arguments @var{arguments} specify the attributes to set, and +the values for them. They should consist of alternating attribute +names (such as @code{:family} or @code{:underline}) and values. Thus, + +@example +(set-face-attribute 'foo nil :weight 'bold :slant 'italic) +@end example + +@noindent +sets the attribute @code{:weight} to @code{bold} and the attribute +@code{:slant} to @code{italic}. + + +If @var{frame} is @code{t}, this function sets the default attributes +for newly created frames. If @var{frame} is @code{nil}, this function +sets the attributes for all existing frames, as well as for newly +created frames. @end defun The following commands and functions mostly provide compatibility @@ -2457,16 +2521,17 @@ This sets the @code{:inverse-video} attribute of @var{face} to This swaps the foreground and background colors of face @var{face}. @end deffn - The following functions examine the attributes of a face. If you -don't specify @var{frame}, they refer to the selected frame; @code{t} -refers to the default data for new frames. They return the symbol -@code{unspecified} if the face doesn't define any value for that -attribute. If @var{inherit} is @code{nil}, only an attribute directly -defined by the face is returned. If @var{inherit} is non-@code{nil}, -any faces specified by its @code{:inherit} attribute are considered as -well, and if @var{inherit} is a face or a list of faces, then they are -also considered, until a specified attribute is found. To ensure that -the return value is always specified, use a value of @code{default} for + The following functions examine the attributes of a face. They +mostly provide compatibility with old versions of Emacs. If you don't +specify @var{frame}, they refer to the selected frame; @code{t} refers +to the default data for new frames. They return @code{unspecified} if +the face doesn't define any value for that attribute. If +@var{inherit} is @code{nil}, only an attribute directly defined by the +face is returned. If @var{inherit} is non-@code{nil}, any faces +specified by its @code{:inherit} attribute are considered as well, and +if @var{inherit} is a face or a list of faces, then they are also +considered, until a specified attribute is found. To ensure that the +return value is always specified, use a value of @code{default} for @var{inherit}. @defun face-font face &optional frame @@ -2576,13 +2641,13 @@ The value of this variable is an alist whose elements have the form any text having the face @var{face} with @var{remapping}, rather than the ordinary definition of @var{face}. -@var{remapping} may be any face specification suitable for a -@code{face} text property: either a face (i.e., a face name or a -property list of attribute/value pairs), or a list of faces. For -details, see the description of the @code{face} text property in -@ref{Special Properties}. @var{remapping} serves as the complete -specification for the remapped face---it replaces the normal -definition of @var{face}, instead of modifying it. +@var{remapping} may be any face spec suitable for a @code{face} text +property: either a face (i.e., a face name or a property list of +attribute/value pairs), or a list of faces. For details, see the +description of the @code{face} text property in @ref{Special +Properties}. @var{remapping} serves as the complete specification for +the remapped face---it replaces the normal definition of @var{face}, +instead of modifying it. If @code{face-remapping-alist} is buffer-local, its local value takes effect only within that buffer. @@ -2604,6 +2669,8 @@ then the new definition of the @code{mode-line} face inherits from the @code{mode-line} face. @end defvar +@cindex relative remapping, faces +@cindex base remapping, faces The following functions implement a higher-level interface to @code{face-remapping-alist}. Most Lisp code should use these functions instead of setting @code{face-remapping-alist} directly, to @@ -2629,7 +2696,7 @@ and @code{face-remap-reset-base} functions; it is intended for major modes to remap faces in the buffers they control. @defun face-remap-add-relative face &rest specs -This functions adds the face specifications in @var{specs} as relative +This function adds the face spec in @var{specs} as relative remappings for face @var{face} in the current buffer. The remaining arguments, @var{specs}, should form either a list of face names, or a property list of attribute/value pairs. @@ -2704,6 +2771,7 @@ differently from the default face. @end defun @cindex face alias +@cindex alias, for faces A @dfn{face alias} provides an equivalent name for a face. You can define a face alias by giving the alias symbol the @code{face-alias} property, with a value of the target face name. The following example @@ -2814,6 +2882,8 @@ these are used for messages in @file{*Compilation*} buffers. @node Font Selection @subsection Font Selection +@cindex font selection +@cindex selecting a font Before Emacs can draw a character on a graphical display, it must select a @dfn{font} for that character@footnote{In this context, the @@ -2884,6 +2954,7 @@ other registries given in @var{alternate-registries}, one by one, until it finds a registry that does exist. @end defopt +@cindex scalable fonts Emacs can make use of scalable fonts, but by default it does not use them. @@ -2897,11 +2968,11 @@ scalable font is enabled for use if its name matches any regular expression in the list. For example, @example -(setq scalable-fonts-allowed '("muleindian-2$")) +(setq scalable-fonts-allowed '("iso10646-1$")) @end example @noindent -allows the use of scalable fonts with registry @code{muleindian-2}. +allows the use of scalable fonts with registry @code{iso10646-1}. @end defopt @defvar face-font-rescale-alist @@ -3011,7 +3082,7 @@ function does nothing. If optional argument @var{style-variant-p} is non-@code{nil}, that says to create bold, italic and bold-italic variants of the fontset as well. These variant fontsets do not have a short name, only a long one, which -is made by altering @var{fontpattern} to indicate the bold or italic +is made by altering @var{fontpattern} to indicate the bold and/or italic status. The specification string also says which fonts to use in the fontset. @@ -3128,6 +3199,7 @@ does that, this function's value may not be accurate. @node Low-Level Font @subsection Low-Level Font Representation +@cindex font property Normally, it is not necessary to manipulate fonts directly. In case you need to do so, this section explains how. @@ -3146,6 +3218,7 @@ should be one of @code{font-object}, @code{font-spec}, or @code{font-entity}. @end defun +@cindex font object A font object is a Lisp object that represents a font that Emacs has @dfn{opened}. Font objects cannot be modified in Lisp, but they can be inspected. @@ -3159,6 +3232,7 @@ otherwise, @var{string} should be a string, and @var{position} specifies a position in that string. @end defun +@cindex font spec A font spec is a Lisp object that contains a set of specifications that can be used to find a font. More than one font may match the specifications in a font spec. @@ -3189,6 +3263,7 @@ size, or a floating point number that specifies the point size. Additional typographic style information for the font, such as @samp{sans}. The value should be a string or a symbol. +@cindex font registry @item :registry The charset registry and encoding of the font, such as @samp{iso8859-1}. The value should be a string or a symbol. @@ -3197,6 +3272,7 @@ The charset registry and encoding of the font, such as The script that the font must support (a symbol). @item :otf +@cindex OpenType font The font must be an OpenType font that supports these OpenType features, provided Emacs is compiled with support for @samp{libotf} (a library for performing complex text layout in certain scripts). The @@ -3223,11 +3299,14 @@ Set the font property @var{property} in the font-spec @var{font-spec} to @var{value}. @end defun +@cindex font entity A font entity is a reference to a font that need not be open. Its properties are intermediate between a font object and a font spec: like a font object, and unlike a font spec, it refers to a single, specific font. Unlike a font object, creating a font entity does not -load the contents of that font into computer memory. +load the contents of that font into computer memory. Emacs may open +multiple font objects of different sizes from a single font entity +referring to a scalable font. @defun find-font font-spec &optional frame This function returns a font entity that best matches the font spec @@ -3379,6 +3458,7 @@ etc. @defopt indicate-empty-lines @cindex fringes, and empty line indication +@cindex empty lines, indicating When this is non-@code{nil}, Emacs displays a special glyph in the fringe of each empty line at the end of the buffer, on graphical displays. @xref{Fringes}. This variable is automatically @@ -3386,6 +3466,7 @@ buffer-local in every buffer. @end defopt @defopt indicate-buffer-boundaries +@cindex buffer boundaries, indicating This buffer-local variable controls how the buffer boundaries and window scrolling are indicated in the window fringes. @@ -3514,6 +3595,8 @@ See the next subsection for details. @xref{Fringe Bitmaps}. @end ifnottex +@c FIXME: I can't find the fringes-indicator-alist variable. Maybe +@c it should be fringe-indicator-alist or fringe-cursor-alist? --xfq When @code{fringe-cursor-alist} has a buffer-local value, and there is no bitmap defined for a cursor type, the corresponding value from the default value of @code{fringes-indicator-alist} is used. @@ -3605,6 +3688,7 @@ If @var{pos} is @code{nil}, that stands for the value of point in @node Customizing Bitmaps @subsection Customizing Fringe Bitmaps +@cindex fringe bitmaps, customizing @defun define-fringe-bitmap bitmap bits &optional height width align This function defines the symbol @var{bitmap} as a new fringe bitmap, @@ -4066,6 +4150,7 @@ Here are the possibilities for @var{height}: @table @asis @item @code{(+ @var{n})} +@c FIXME: Add an index for "step"? --xfq This means to use a font that is @var{n} steps larger. A ``step'' is defined by the set of available fonts---specifically, those that match what was otherwise specified for this text, in all attributes except @@ -4151,13 +4236,15 @@ them a nonzero width. The usual way to do that is to set these variables: @defvar left-margin-width -This variable specifies the width of the left margin. -It is buffer-local in all buffers. +This variable specifies the width of the left margin, in character +cell (a.k.a.@: ``column'') units. It is buffer-local in all buffers. +A value of @code{nil} means no left marginal area. @end defvar @defvar right-margin-width -This variable specifies the width of the right margin. -It is buffer-local in all buffers. +This variable specifies the width of the right margin, in character +cell units. It is buffer-local in all buffers. A value of @code{nil} +means no right marginal area. @end defvar Setting these variables does not immediately affect the window. These @@ -4168,15 +4255,18 @@ Thus, you can make changes take effect by calling You can also set the margin widths immediately. @defun set-window-margins window left &optional right -This function specifies the margin widths for window @var{window}. -The argument @var{left} controls the left margin and -@var{right} controls the right margin (default @code{0}). +This function specifies the margin widths for window @var{window}, in +character cell units. The argument @var{left} controls the left +margin, and @var{right} controls the right margin (default @code{0}). @end defun @defun window-margins &optional window -This function returns the left and right margins of @var{window} -as a cons cell of the form @code{(@var{left} . @var{right})}. -If @var{window} is @code{nil}, the selected window is used. +This function returns the width of the left and right margins of +@var{window} as a cons cell of the form @w{@code{(@var{left} +. @var{right})}}. If one of the two marginal areas does not exist, +its width is returned as @code{nil}; if neither of the two margins exist, +the function returns @code{(nil)}. If @var{window} is @code{nil}, the +selected window is used. @end defun @node Images @@ -4341,6 +4431,7 @@ sometimes consider this useful for displaying the image for a ``disabled'' button. @item (edge-detection :matrix @var{matrix} :color-adjust @var{adjust}) +@cindex edge detection, images Specifies a general edge-detection algorithm. @var{matrix} must be either a nine-element list or a nine-element vector of numbers. A pixel at position @math{x/y} in the transformed image is computed from @@ -4424,6 +4515,7 @@ This specifies the pointer shape when the mouse pointer is over this image. @xref{Pointer Shape}, for available pointer shapes. @item :map @var{map} +@cindex image maps This associates an image map of @dfn{hot spots} with this image. An image map is an alist where each element has the format @@ -4601,6 +4693,16 @@ should never be rendered using ImageMagick, regardless of the value of ImageMagick entirely. @end defopt +@defvar image-format-suffixes +This variable is an alist mapping image types to file name extensions. +Emacs uses this in conjunction with the @code{:format} image property +(see below) to give a hint to the ImageMagick library as to the type +of an image. Each element has the form @code{(@var{type} +@var{extension})}, where @var{type} is a symbol specifying an image +content-type, and @var{extension} is a string that specifies the +associated file name extension. +@end defvar + Images loaded with ImageMagick support the following additional image descriptor properties: @@ -4611,16 +4713,31 @@ color, which is used as the image's background color if the image supports transparency. If the value is @code{nil}, it defaults to the frame's background color. -@item :width, :height +@item :width @var{width}, :height @var{height} The @code{:width} and @code{:height} keywords are used for scaling the image. If only one of them is specified, the other one will be calculated so as to preserve the aspect ratio. If both are specified, aspect ratio may not be preserved. -@item :rotation +@item :max-width @var{max-width}, :max-height @var{max-height} +The @code{:max-width} and @code{:max-height} keywords are used for +scaling if the size of the image of the image exceeds these values. +If @code{:width} is set it will have precedence over @code{max-width}, +and if @code{:height} is set it will have precedence over +@code{max-height}, but you can otherwise mix these keywords as you +wish. @code{:max-width} and @code{:max-height} will always preserve +the aspect ratio. + +@item :format @var{type} +The value, @var{type}, should be a symbol specifying the type of the +image data, as found in @code{image-format-suffixes}. This is used +when the image does not have an associated file name, to provide a +hint to ImageMagick to help it detect the image type. + +@item :rotation @var{angle} Specifies a rotation angle in degrees. -@item :index +@item :index @var{frame} @c Doesn't work: http://debbugs.gnu.org/7978 @xref{Multi-Frame Images}. @end table @@ -4689,6 +4806,7 @@ from the file's name. The remaining arguments, @var{props}, specify additional image properties---for example, +@c ':heuristic-mask' is not documented? @example (create-image "foo.xpm" 'xpm nil :heuristic-mask t) @end example @@ -4875,6 +4993,7 @@ This removes only images that were put into @var{buffer} the way @end defun @defun image-size spec &optional pixels frame +@cindex size of image This function returns the size of an image as a pair @w{@code{(@var{width} . @var{height})}}. @var{spec} is an image specification. @var{pixels} non-@code{nil} means return sizes @@ -4900,11 +5019,12 @@ The purpose of this variable is to prevent unreasonably large images from accidentally being loaded into Emacs. It only takes effect the first time an image is loaded. Once an image is placed in the image cache, it can always be displayed, even if the value of -@var{max-image-size} is subsequently changed (@pxref{Image Cache}). +@code{max-image-size} is subsequently changed (@pxref{Image Cache}). @end defvar @node Multi-Frame Images @subsection Multi-Frame Images +@cindex multi-frame images @cindex animation @cindex image animation @@ -4952,6 +5072,8 @@ or @code{nil}, the image animates once only; if @code{t} it loops forever; if a number animation stops after that many seconds. @end defun +@vindex image-minimum-frame-delay +@vindex image-default-frame-delay @noindent Animation operates by means of a timer. Note that Emacs imposes a minimum frame delay of 0.01 (@code{image-minimum-frame-delay}) seconds. If the image itself does not specify a delay, Emacs uses @@ -5296,7 +5418,7 @@ additionally available in the keymap stored in @code{button-buffer-map} as a parent keymap for its keymap. If the button has a non-@code{nil} @code{follow-link} property, and -@var{mouse-1-click-follows-link} is set, a quick @key{Mouse-1} click +@code{mouse-1-click-follows-link} is set, a quick @key{Mouse-1} click will also activate the @code{push-button} command. @xref{Clickable Text}. @@ -5335,7 +5457,7 @@ is skipped over. Returns the button found. @defun next-button pos &optional count-current @defunx previous-button pos &optional count-current -Return the next button after (for @code{next-button} or before (for +Return the next button after (for @code{next-button}) or before (for @code{previous-button}) position @var{pos} in the current buffer. If @var{count-current} is non-@code{nil}, count any button at @var{pos} in the search, instead of starting at the next button. @@ -5352,7 +5474,8 @@ in the search, instead of starting at the next button. The Ewoc package constructs buffer text that represents a structure of Lisp objects, and updates the text to follow changes in that structure. This is like the ``view'' component in the -``model/view/controller'' design paradigm. +``model/view/controller'' design paradigm. Ewoc means ``Emacs's +Widget for Object Collections''. An @dfn{ewoc} is a structure that organizes information required to construct buffer text that represents certain Lisp data. The buffer @@ -5372,6 +5495,8 @@ The text's start position in the buffer. The header and footer strings. @item +@cindex node, ewoc +@c or "@cindex node, abstract display"? A doubly-linked chain of @dfn{nodes}, each of which contains: @itemize @@ -5396,6 +5521,8 @@ between buffer positions and nodes, move point from one node's textual representation to another, and so forth. @xref{Abstract Display Functions}. +@cindex encapsulation, ewoc +@c or "@cindex encapsulation, abstract display"? A node @dfn{encapsulates} a data element much the way a variable holds a value. Normally, encapsulation occurs as a part of adding a node to the ewoc. You can retrieve the data element value and place a @@ -5721,7 +5848,7 @@ Here is an example of calling this function explicitly. @smallexample @group (defun interactive-blink-matching-open () - "Indicate momentarily the start of sexp before point." + "Indicate momentarily the start of parenthesized sexp before point." (interactive) @end group @group @@ -6002,6 +6129,7 @@ the standard display table. @subsection Glyphs @cindex glyph +@cindex glyph code A @dfn{glyph} is a graphical symbol which occupies a single character position on the screen. Each glyph is represented in Lisp as a @dfn{glyph code}, which specifies a character and optionally a @@ -6277,7 +6405,9 @@ and displaying bidirectional text. @cindex reading order @cindex visual order @cindex unicode bidirectional algorithm +@cindex UBA @cindex bidirectional reordering +@cindex reordering, of bidirectional text Text is stored in Emacs buffers and strings in @dfn{logical} (or @dfn{reading}) order, i.e., the order in which a human would read each character. In right-to-left and bidirectional text, the order in @@ -6386,6 +6516,26 @@ determined dynamically by Emacs. For buffers whose value of buffers, this function always returns @code{left-to-right}. @end defun +@cindex visual-order cursor motion + Sometimes there's a need to move point in strict visual order, +either to the left or to the right of its current screen position. +Emacs provides a primitive to do that. + +@defun move-point-visually direction +This function moves point of the currently selected window to the +buffer position that appears immediately to the right or to the left +of point on the screen. If @var{direction} is positive, point will +move one screen position to the right, otherwise it will move one +screen position to the left. Note that, depending on the surrounding +bidirectional context, this could potentially move point many buffer +positions away. If invoked at the end of a screen line, the function +moves point to the rightmost or leftmost screen position of the next +or previous screen line, as appropriate for the value of +@var{direction}. + +The function returns the new buffer position as its value. +@end defun + @cindex layout on display, and bidirectional text @cindex jumbled display of bidirectional text @cindex concatenating bidirectional strings diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 8e394b5d92d..85998fd3839 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1,6 +1,6 @@ @comment -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1992-1994, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1992-1994, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @@ -1132,14 +1132,14 @@ from the macro definition with @code{def-edebug-spec}. Adding definitions in Lisp, but @code{def-edebug-spec} makes it possible to define Edebug specifications for special forms implemented in C. -@deffn Macro def-edebug-spec macro specification +@defmac def-edebug-spec macro specification Specify which expressions of a call to macro @var{macro} are forms to be evaluated. @var{specification} should be the edebug specification. Neither argument is evaluated. The @var{macro} argument can actually be any symbol, not just a macro name. -@end deffn +@end defmac Here is a table of the possibilities for @var{specification} and how each directs processing of arguments. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 8ff34941b7d..b512968ff78 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -98,7 +98,7 @@ This is the @cite{GNU Emacs Lisp Reference Manual} @end ifnottex corresponding to Emacs version @value{EMACSVER}. -Copyright @copyright{} 1990--1996, 1998--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1990--1996, 1998--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -115,11 +115,11 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@documentencoding ISO-8859-1 +@documentencoding UTF-8 -@dircategory GNU Emacs Lisp +@dircategory Emacs lisp @direntry -* Elisp: (elisp). The Emacs Lisp Reference Manual. +* Elisp: (elisp). The Emacs Lisp Reference Manual. @end direntry @titlepage @@ -157,6 +157,17 @@ Cover art by Etienne Suvasa. @node Top @top Emacs Lisp +@ifset WWW_GNU_ORG +@html +

          The homepage for GNU Emacs is at +http://www.gnu.org/software/emacs/.
          +For information on using Emacs, refer to the +Emacs Manual.
          +To view this manual in other formats, click +here. +@end html +@end ifset + @insertcopying @end ifnottex @@ -183,7 +194,6 @@ Cover art by Etienne Suvasa. * Loading:: Reading files of Lisp code into Lisp. * Byte Compilation:: Compilation makes programs run faster. -* Advising Functions:: Adding to the definition of a function. * Debugging:: Tools and tips for debugging Lisp programs. * Read and Print:: Converting Lisp objects to text and back. @@ -603,19 +613,6 @@ Byte Compilation * Byte-Code Objects:: The data type used for byte-compiled functions. * Disassembly:: Disassembling byte-code; how to read byte-code. -Advising Emacs Lisp Functions - -* Simple Advice:: A simple example to explain the basics of advice. -* Defining Advice:: Detailed description of @code{defadvice}. -* Around-Advice:: Wrapping advice around a function's definition. -* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}. -* Activation of Advice:: Advice doesn't do anything until you activate it. -* Enabling Advice:: You can enable or disable each piece of advice. -* Preactivation:: Preactivation is a way of speeding up the - loading of compiled advice. -* Argument Access in Advice:: How advice can access the function's arguments. -* Combined Definition:: How advice is implemented. - Debugging Lisp Programs * Debugger:: A debugger for the Emacs Lisp evaluator. @@ -940,7 +937,8 @@ Information about Files * Testing Accessibility:: Is a given file readable? Writable? * Kinds of Files:: Is it a directory? A symbolic link? * Truenames:: Eliminating symbolic links from a file name. -* File Attributes:: How large is it? Any other names? Etc. +* File Attributes:: File sizes, modification times, etc. +* Extended Attributes:: Extended file attributes for access control. * Locating Files:: How to find a file in standard places. File Names @@ -1183,6 +1181,7 @@ Text Properties Non-@acronym{ASCII} Characters * Text Representations:: How Emacs represents text. +* Disabling Multibyte:: Controlling whether to use multibyte characters. * Converting Representations:: Converting unibyte to multibyte and vice versa. * Selecting a Representation:: Treating a byte sequence as unibyte or multi. * Character Codes:: How unibyte and multibyte relate to @@ -1306,7 +1305,7 @@ Processes Receiving Output from Processes -* Process Buffers:: If no filter, output is put in a buffer. +* Process Buffers:: By default, output is put in a buffer. * Filter Functions:: Filter functions accept output from the process. * Decoding Output:: Filters can get unibyte or multibyte strings. * Accepting Output:: How to wait until process output arrives. @@ -1471,7 +1470,8 @@ Operating System Interface * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. Starting Up Emacs @@ -1547,7 +1547,6 @@ Object Internals @include customize.texi @include loading.texi @include compile.texi -@include advice.texi @c This includes edebug.texi. @include debugging.texi diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index 3f3984e40d2..e00496e3478 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -1,18 +1,17 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1999, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1993, 1999, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Errors @appendix Standard Errors @cindex standard errors - Here is a list of the more important error symbols in standard Emacs, -grouped by concept. The list includes each symbol's message (on the -@code{error-message} property of the symbol) and a cross reference to a -description of how the error can occur. + Here is a list of the more important error symbols in standard Emacs, grouped +by concept. The list includes each symbol's message and a cross reference +to a description of how the error can occur. - Each error symbol has an @code{error-conditions} property that is a + Each error symbol has an set of parent error conditions that is a list of symbols. Normally this list includes the error symbol itself and the symbol @code{error}. Occasionally it includes additional symbols, which are intermediate classifications, narrower than @@ -24,8 +23,6 @@ conditions, that means it has none. As a special exception, the error symbol @code{quit} does not have the condition @code{error}, because quitting is not considered an error. -@c You can grep for "(put 'foo 'error-conditions ...) to find -@c examples defined in Lisp. E.g., soap-client.el, sasl.el. Most of these error symbols are defined in C (mainly @file{data.c}), but some are defined in Lisp. For example, the file @file{userlock.el} defines the @code{file-locked} and @code{file-supersession} errors. @@ -123,6 +120,11 @@ This is a subcategory of @code{file-error}. @xref{File Locks}. @item file-supersession This is a subcategory of @code{file-error}. @xref{Modification Time}. +@c filenotify.el +@item file-notify-error +This is a subcategory of @code{file-error}. It happens, when a file +could not be watched for changes. @xref{File Notifications}. + @c net/ange-ftp.el @item ftp-error This is a subcategory of @code{file-error}, which results from diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 4b5ef187383..05250233b00 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1994, 1998, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Evaluation @@ -242,11 +242,9 @@ it obtains a non-symbol. @xref{Function Names}, for more information about symbol function indirection. One possible consequence of this process is an infinite loop, in the -event that a symbol's function cell refers to the same symbol. Or a -symbol may have a void function cell, in which case the subroutine -@code{symbol-function} signals a @code{void-function} error. But if -neither of these things happens, we eventually obtain a non-symbol, -which ought to be a function or other suitable object. +event that a symbol's function cell refers to the same symbol. +Otherwise, we eventually obtain a non-symbol, which ought to be a +function or other suitable object. @kindex invalid-function More precisely, we should now have a Lisp function (a lambda @@ -255,12 +253,12 @@ a special form, or an autoload object. Each of these types is a case described in one of the following sections. If the object is not one of these types, Emacs signals an @code{invalid-function} error. - The following example illustrates the symbol indirection process. We -use @code{fset} to set the function cell of a symbol and + The following example illustrates the symbol indirection process. +We use @code{fset} to set the function cell of a symbol and @code{symbol-function} to get the function cell contents -(@pxref{Function Cells}). Specifically, we store the symbol @code{car} -into the function cell of @code{first}, and the symbol @code{first} into -the function cell of @code{erste}. +(@pxref{Function Cells}). Specifically, we store the symbol +@code{car} into the function cell of @code{first}, and the symbol +@code{first} into the function cell of @code{erste}. @example @group @@ -432,6 +430,19 @@ do. and which are used without evaluation. Whether a particular argument is evaluated may depend on the results of evaluating other arguments. + If an expression's first symbol is that of a special form, the +expression should follow the rules of that special form; otherwise, +Emacs's behavior is not well-defined (though it will not crash). For +example, @code{((lambda (x) x . 3) 4)} contains a subexpression that +begins with @code{lambda} but is not a well-formed @code{lambda} +expression, so Emacs may signal an error, or may return 3 or 4 or +@code{nil}, or may behave in other ways. + +@defun special-form-p object +This predicate tests whether its argument is a special form, and +returns @code{t} if so, @code{nil} otherwise. +@end defun + Here is a list, in alphabetical order, of all of the special forms in Emacs Lisp with a reference to where each is described. @@ -463,6 +474,9 @@ Emacs Lisp with a reference to where each is described. @item interactive @pxref{Interactive Call} +@item lambda +@pxref{Lambda Expressions} + @item let @itemx let* @pxref{Local Variables} @@ -512,7 +526,7 @@ GNU Emacs Lisp and Common Lisp. @code{setq}, @code{if}, and doesn't exist in Common Lisp. @code{throw} is a special form in Common Lisp (because it must be able to throw multiple values), but it is a function in Emacs Lisp (which doesn't have multiple -values).@refill +values). @end quotation @node Autoloading @@ -699,12 +713,18 @@ arguments. @defun eval form &optional lexical This is the basic function for evaluating an expression. It evaluates -@var{form} in the current environment and returns the result. How the -evaluation proceeds depends on the type of the object (@pxref{Forms}). +@var{form} in the current environment, and returns the result. The +type of the @var{form} object determines how it is evaluated. +@xref{Forms}. -The argument @var{lexical}, if non-@code{nil}, means to evaluate -@var{form} using lexical scoping rules for variables, instead of the -default dynamic scoping rules. @xref{Lexical Binding}. +The argument @var{lexical} specifies the scoping rule for local +variables (@pxref{Variable Scoping}). If it is omitted or @code{nil}, +that means to evaluate @var{form} using the default dynamic scoping +rule. If it is @code{t}, that means to use the lexical scoping rule. +The value of @var{lexical} can also be a non-empty alist specifying a +particular @dfn{lexical environment} for lexical bindings; however, +this feature is only useful for specialized purposes, such as in Emacs +Lisp debuggers. @xref{Lexical Binding}. Since @code{eval} is a function, the argument expression that appears in a call to @code{eval} is evaluated twice: once as preparation before diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 971e38f20b7..f6f1c7210bd 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1,27 +1,27 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Files @chapter Files This chapter describes the Emacs Lisp functions and variables to -find, create, view, save, and otherwise work with files and file +find, create, view, save, and otherwise work with files and directories. A few other file-related functions are described in @ref{Buffers}, and those related to backups and auto-saving are described in @ref{Backups and Auto-Saving}. Many of the file functions take one or more arguments that are file -names. A file name is actually a string. Most of these functions -expand file name arguments by calling @code{expand-file-name}, so that +names. A file name is a string. Most of these functions expand file +name arguments using the function @code{expand-file-name}, so that @file{~} is handled correctly, as are relative file names (including -@samp{../}). @xref{File Name Expansion}. +@file{../}). @xref{File Name Expansion}. In addition, certain @dfn{magic} file names are handled specially. For example, when a remote file name is specified, Emacs accesses the -file over the network via an appropriate protocol (@pxref{Remote -Files,, Remote Files, emacs, The GNU Emacs Manual}). This handling is +file over the network via an appropriate protocol. @xref{Remote +Files,, Remote Files, emacs, The GNU Emacs Manual}. This handling is done at a very low level, so you may assume that all the functions described in this chapter accept magic file names as file name arguments, except where noted. @xref{Magic File Names}, for details. @@ -58,22 +58,21 @@ done, we say that the buffer is @dfn{visiting} that file, and call the file ``the visited file'' of the buffer. A file and a buffer are two different things. A file is information -recorded permanently in the computer (unless you delete it). A buffer, -on the other hand, is information inside of Emacs that will vanish at -the end of the editing session (or when you kill the buffer). Usually, -a buffer contains information that you have copied from a file; then we -say the buffer is visiting that file. The copy in the buffer is what -you modify with editing commands. Such changes to the buffer do not -change the file; therefore, to make the changes permanent, you must -@dfn{save} the buffer, which means copying the altered buffer contents -back into the file. +recorded permanently in the computer (unless you delete it). A +buffer, on the other hand, is information inside of Emacs that will +vanish at the end of the editing session (or when you kill the +buffer). When a buffer is visiting a file, it contains information +copied from the file. The copy in the buffer is what you modify with +editing commands. Changes to the buffer do not change the file; to +make the changes permanent, you must @dfn{save} the buffer, which +means copying the altered buffer contents back into the file. - In spite of the distinction between files and buffers, people often -refer to a file when they mean a buffer and vice-versa. Indeed, we say, -``I am editing a file'', rather than, ``I am editing a buffer that I -will soon save as a file of the same name''. Humans do not usually need -to make the distinction explicit. When dealing with a computer program, -however, it is good to keep the distinction in mind. + Despite the distinction between files and buffers, people often +refer to a file when they mean a buffer and vice-versa. Indeed, we +say, ``I am editing a file'', rather than, ``I am editing a buffer +that I will soon save as a file of the same name''. Humans do not +usually need to make the distinction explicit. When dealing with a +computer program, however, it is good to keep the distinction in mind. @menu * Visiting Functions:: The usual interface functions for visiting. @@ -507,9 +506,9 @@ Name}). @section Reading from Files @cindex reading from files - You can copy a file from the disk and insert it into a buffer -using the @code{insert-file-contents} function. Don't use the user-level -command @code{insert-file} in a Lisp program, as that sets the mark. + To copy the contents of a file into a buffer, use the function +@code{insert-file-contents}. (Don't use the command +@code{insert-file} in a Lisp program, as that sets the mark.) @defun insert-file-contents filename &optional visit beg end replace This function inserts the contents of file @var{filename} into the @@ -677,11 +676,12 @@ with-temp-buffer,, The Current Buffer}. When two users edit the same file at the same time, they are likely to interfere with each other. Emacs tries to prevent this situation from arising by recording a @dfn{file lock} when a file is being -modified. (File locks are not implemented on Microsoft systems.) +modified. Emacs can then detect the first attempt to modify a buffer visiting a file that is locked by another Emacs job, and ask the user what to do. The file lock is really a file, a symbolic link with a special name, -stored in the same directory as the file you are editing. +stored in the same directory as the file you are editing. (On file +systems that do not support symbolic links, a regular file is used.) When you access files using NFS, there may be a small probability that you and another user will both lock the same file ``simultaneously''. @@ -720,11 +720,6 @@ does nothing if the current buffer is not visiting a file, or if the system does not support locking. @end defun - File locking is not supported on some systems. On systems that do not -support it, the functions @code{lock-buffer}, @code{unlock-buffer} and -@code{file-locked-p} do nothing and return @code{nil}. It is also -possible to disable locking, by setting the variable @code{create-lockfiles}. - @defopt create-lockfiles If this variable is @code{nil}, Emacs does not lock files. @end defopt @@ -761,26 +756,31 @@ name of the user who has locked the file. @end itemize If you wish, you can replace the @code{ask-user-about-lock} function -with your own version that makes the decision in another way. The code -for its usual definition is in @file{userlock.el}. +with your own version that makes the decision in another way. @end defun @node Information about Files @section Information about Files @cindex file, information about - The functions described in this section all operate on strings that -designate file names. With a few exceptions, all the functions have -names that begin with the word @samp{file}. These functions all -return information about actual files or directories, so their -arguments must all exist as actual files or directories unless -otherwise noted. + This section describes the functions for retrieving various types of +information about files (or directories or symbolic links), such as +whether a file is readable or writable, and its size. These functions +all take arguments which are file names. Except where noted, these +arguments need to specify existing files, or an error is signaled. + +@cindex file names, trailing whitespace +@cindex trailing blanks in file names + Be careful with file names that end in spaces. On some filesystems +(notably, MS-Windows), trailing whitespace characters in file names +are silently and automatically ignored. @menu * Testing Accessibility:: Is a given file readable? Writable? * Kinds of Files:: Is it a directory? A symbolic link? * Truenames:: Eliminating symbolic links from a file name. -* File Attributes:: How large is it? Any other names? Etc. +* File Attributes:: File sizes, modification times, etc. +* Extended Attributes:: Extended file attributes for access control. * Locating Files:: How to find a file in standard places. @end menu @@ -789,10 +789,16 @@ otherwise noted. @cindex accessibility of a file @cindex file accessibility - These functions test for permission to access a file in specific -ways. Unless explicitly stated otherwise, they recursively follow -symbolic links for their file name arguments, at all levels (at the -level of the file itself and at all levels of parent directories). + These functions test for permission to access a file for reading, +writing, or execution. Unless explicitly stated otherwise, they +recursively follow symbolic links for their file name arguments, at +all levels (at the level of the file itself and at all levels of +parent directories). + + On some operating systems, more complex sets of access permissions +can be specified, via mechanisms such as Access Control Lists (ACLs). +@xref{Extended Attributes}, for how to query and set those +permissions. @defun file-exists-p filename This function returns @code{t} if a file named @var{filename} appears @@ -802,9 +808,8 @@ true if the file exists and you have execute permission on the containing directories, regardless of the permissions of the file itself.) -If the file does not exist, or if fascist access control policies -prevent you from finding the attributes of the file, this function -returns @code{nil}. +If the file does not exist, or if access control policies prevent you +from finding its attributes, this function returns @code{nil}. Directories are files, so @code{file-exists-p} returns @code{t} when given a directory name. However, symbolic links are treated @@ -815,24 +820,8 @@ name only if the target file exists. @defun file-readable-p filename This function returns @code{t} if a file named @var{filename} exists and you can read it. It returns @code{nil} otherwise. - -@example -@group -(file-readable-p "files.texi") - @result{} t -@end group -@group -(file-exists-p "/usr/spool/mqueue") - @result{} t -@end group -@group -(file-readable-p "/usr/spool/mqueue") - @result{} nil -@end group -@end example @end defun -@c Emacs 19 feature @defun file-executable-p filename This function returns @code{t} if a file named @var{filename} exists and you can execute it. It returns @code{nil} otherwise. On Unix and @@ -848,27 +837,18 @@ file exists and you can write it. It is creatable if it does not exist, but the specified directory does exist and you can write in that directory. -In the third example below, @file{foo} is not writable because the -parent directory does not exist, even though the user could create such -a directory. +In the example below, @file{foo} is not writable because the parent +directory does not exist, even though the user could create such a +directory. @example @group -(file-writable-p "~/foo") - @result{} t -@end group -@group -(file-writable-p "/foo") - @result{} nil -@end group -@group (file-writable-p "~/no-such-dir/foo") @result{} nil @end group @end example @end defun -@c Emacs 19 feature @defun file-accessible-directory-p dirname This function returns @code{t} if you have permission to open existing files in the directory whose name as a file is @var{dirname}; @@ -877,16 +857,13 @@ The value of @var{dirname} may be either a directory name (such as @file{/foo/}) or the file name of a file which is a directory (such as @file{/foo}, without the final slash). -Example: after the following, +For example, from the following we deduce that any attempt to read a +file in @file{/foo/} will give an error: @example (file-accessible-directory-p "/foo") @result{} nil @end example - -@noindent -we can deduce that any attempt to read a file in @file{/foo/} will -give an error. @end defun @defun access-file filename string @@ -909,39 +886,59 @@ replace @var{filename} with its target. However, it does recursively follow symbolic links at all levels of parent directories. @end defun -@defun file-newer-than-file-p filename1 filename2 -@cindex file age -@cindex file modification time -This function returns @code{t} if the file @var{filename1} is -newer than file @var{filename2}. If @var{filename1} does not -exist, it returns @code{nil}. If @var{filename1} does exist, but -@var{filename2} does not, it returns @code{t}. +@defun file-modes filename +@cindex mode bits +@cindex file permissions +@cindex permissions, file +@cindex file modes +This function returns the @dfn{mode bits} of @var{filename}---an +integer summarizing its read, write, and execution permissions. +Symbolic links in @var{filename} are recursively followed at all +levels. If the file does not exist, the return value is @code{nil}. -In the following example, assume that the file @file{aug-19} was written -on the 19th, @file{aug-20} was written on the 20th, and the file -@file{no-file} doesn't exist at all. +@xref{File permissions,,, coreutils, The @sc{gnu} @code{Coreutils} +Manual}, for a description of mode bits. For example, if the +low-order bit is 1, the file is executable by all users; if the +second-lowest-order bit is 1, the file is writable by all users; etc. +The highest possible value is 4095 (7777 octal), meaning that everyone +has read, write, and execute permission, the @acronym{SUID} bit is set +for both others and group, and the sticky bit is set. + +@xref{Changing Files}, for the @code{set-file-modes} function, which +can be used to set these permissions. @example @group -(file-newer-than-file-p "aug-19" "aug-20") +(file-modes "~/junk/diffs") + @result{} 492 ; @r{Decimal integer.} +@end group +@group +(format "%o" 492) + @result{} "754" ; @r{Convert to octal.} +@end group + +@group +(set-file-modes "~/junk/diffs" #o666) @result{} nil @end group + @group -(file-newer-than-file-p "aug-20" "aug-19") - @result{} t -@end group -@group -(file-newer-than-file-p "aug-19" "no-file") - @result{} t -@end group -@group -(file-newer-than-file-p "no-file" "aug-19") - @result{} nil +$ ls -l diffs +-rw-rw-rw- 1 lewis lewis 3063 Oct 30 16:00 diffs @end group @end example -You can use @code{file-attributes} to get a file's last modification -time as a list of four integers. @xref{File Attributes}. +@cindex MS-DOS and file modes +@cindex file modes and MS-DOS +@strong{MS-DOS note:} On MS-DOS, there is no such thing as an +``executable'' file mode bit. So @code{file-modes} considers a file +executable if its name ends in one of the standard executable +extensions, such as @file{.com}, @file{.bat}, @file{.exe}, and some +others. Files that begin with the Unix-standard @samp{#!} signature, +such as shell and Perl scripts, are also considered executable. +Directories are also reported as executable, for compatibility with +Unix. These conventions are also followed by @code{file-attributes} +(@pxref{File Attributes}). @end defun @node Kinds of Files @@ -979,8 +976,6 @@ If the file @var{filename} is not a symbolic link (or there is no such file), @result{} "/pub/bin" @end group @end example - -@c !!! file-symlink-p: should show output of ls -l for comparison @end defun The next two functions recursively follow symbolic links at @@ -1021,21 +1016,6 @@ a regular file (not a directory, named pipe, terminal, or other I/O device). @end defun -@defun file-equal-p file1 file2 -This function returns @code{t} if the files @var{file1} and -@var{file2} name the same file. If @var{file1} or @var{file2} does -not exist, the return value is unspecified. -@end defun - -@defun file-in-directory-p file dir -This function returns @code{t} if @var{file} is a file in directory -@var{dir}, or in a subdirectory of @var{dir}. It also returns -@code{t} if @var{file} and @var{dir} are the same directory. It -compares the @code{file-truename} values of the two directories -(@pxref{Truenames}). If @var{dir} does not name an existing -directory, the return value is @code{nil}. -@end defun - @node Truenames @subsection Truenames @cindex truename (of file) @@ -1058,14 +1038,14 @@ This function does not expand environment variables. Only substitute-in-file-name}. If you may need to follow symbolic links preceding @samp{..}@: -appearing as a name component, you should make sure to call -@code{file-truename} without prior direct or indirect calls to -@code{expand-file-name}, as otherwise the file name component -immediately preceding @samp{..} will be ``simplified away'' before -@code{file-truename} is called. To eliminate the need for a call to -@code{expand-file-name}, @code{file-truename} handles @samp{~} in the -same way that @code{expand-file-name} does. @xref{File Name -Expansion,, Functions that Expand Filenames}. +appearing as a name component, call @code{file-truename} without prior +direct or indirect calls to @code{expand-file-name}. Otherwise, the +file name component immediately preceding @samp{..} will be +``simplified away'' before @code{file-truename} is called. To +eliminate the need for a call to @code{expand-file-name}, +@code{file-truename} handles @samp{~} in the same way that +@code{expand-file-name} does. @xref{File Name Expansion,, Functions +that Expand Filenames}. @end defun @defun file-chase-links filename &optional limit @@ -1094,70 +1074,61 @@ we would have: @result{} "/home/foo/hello" @end example - @xref{Buffer File Name}, for related information. +@defun file-equal-p file1 file2 +This function returns @code{t} if the files @var{file1} and +@var{file2} name the same file. This is similar to comparing their +truenames, except that remote file names are also handled in an +appropriate manner. If @var{file1} or @var{file2} does not exist, the +return value is unspecified. +@end defun + +@defun file-in-directory-p file dir +This function returns @code{t} if @var{file} is a file in directory +@var{dir}, or in a subdirectory of @var{dir}. It also returns +@code{t} if @var{file} and @var{dir} are the same directory. It +compares the truenames of the two directories. If @var{dir} does not +name an existing directory, the return value is @code{nil}. +@end defun @node File Attributes -@subsection Other Information about Files +@subsection File Attributes +@cindex file attributes This section describes the functions for getting detailed -information about a file, other than its contents. This information -includes the mode bits that control access permissions, the owner and -group numbers, the number of names, the inode number, the size, and -the times of access and modification. +information about a file, including the owner and group numbers, the +number of names, the inode number, the size, and the times of access +and modification. -@defun file-modes filename -@cindex file permissions -@cindex permissions, file -@cindex file attributes -@cindex file modes -This function returns the @dfn{mode bits} describing the @dfn{file -permissions} of @var{filename}, as an integer. It recursively follows -symbolic links in @var{filename} at all levels. If @var{filename} -does not exist, the return value is @code{nil}. +@defun file-newer-than-file-p filename1 filename2 +@cindex file age +@cindex file modification time +This function returns @code{t} if the file @var{filename1} is +newer than file @var{filename2}. If @var{filename1} does not +exist, it returns @code{nil}. If @var{filename1} does exist, but +@var{filename2} does not, it returns @code{t}. -@xref{File Permissions,,, coreutils, The @sc{gnu} @code{Coreutils} -Manual}, for a description of mode bits. If the low-order bit is 1, -then the file is executable by all users, if the second-lowest-order -bit is 1, then the file is writable by all users, etc. The highest -value returnable is 4095 (7777 octal), meaning that everyone has read, -write, and execute permission, that the @acronym{SUID} bit is set for -both others and group, and that the sticky bit is set. +In the following example, assume that the file @file{aug-19} was written +on the 19th, @file{aug-20} was written on the 20th, and the file +@file{no-file} doesn't exist at all. @example @group -(file-modes "~/junk/diffs") - @result{} 492 ; @r{Decimal integer.} -@end group -@group -(format "%o" 492) - @result{} "754" ; @r{Convert to octal.} -@end group - -@group -(set-file-modes "~/junk/diffs" #o666) +(file-newer-than-file-p "aug-19" "aug-20") @result{} nil @end group - @group -% ls -l diffs - -rw-rw-rw- 1 lewis 0 3063 Oct 30 16:00 diffs +(file-newer-than-file-p "aug-20" "aug-19") + @result{} t +@end group +@group +(file-newer-than-file-p "aug-19" "no-file") + @result{} t +@end group +@group +(file-newer-than-file-p "no-file" "aug-19") + @result{} nil @end group @end example - -@xref{Changing Files}, for functions that change file permissions, -such as @code{set-file-modes}. - -@cindex MS-DOS and file modes -@cindex file modes and MS-DOS -@strong{MS-DOS note:} On MS-DOS, there is no such thing as an -``executable'' file mode bit. So @code{file-modes} considers a file -executable if its name ends in one of the standard executable -extensions, such as @file{.com}, @file{.bat}, @file{.exe}, and some -others. Files that begin with the Unix-standard @samp{#!} signature, -such as shell and Perl scripts, are also considered executable. -Directories are also reported as executable, for compatibility with -Unix. These conventions are also followed by @code{file-attributes}, -below. @end defun If the @var{filename} argument to the next two functions is a @@ -1165,31 +1136,6 @@ symbolic link, then these function do @emph{not} replace it with its target. However, they both recursively follow symbolic links at all levels of parent directories. -@defun file-nlinks filename -This functions returns the number of names (i.e., hard links) that -file @var{filename} has. If the file does not exist, then this function -returns @code{nil}. Note that symbolic links have no effect on this -function, because they are not considered to be names of the files they -link to. - -@example -@group -% ls -l foo* --rw-rw-rw- 2 rms 4 Aug 19 01:27 foo --rw-rw-rw- 2 rms 4 Aug 19 01:27 foo1 -@end group - -@group -(file-nlinks "foo") - @result{} 2 -@end group -@group -(file-nlinks "doesnt-exist") - @result{} nil -@end group -@end example -@end defun - @defun file-attributes filename &optional id-format @anchor{Definition of file-attributes} This function returns a list of attributes of file @var{filename}. If @@ -1254,7 +1200,7 @@ An unspecified value, present for backward compatibility. @item The file's inode number. If possible, this is an integer. If the inode number is too large to be represented as an integer in Emacs -Lisp but dividing it by @math{2^16} yields a representable integer, +Lisp but dividing it by @math{2^{16}} yields a representable integer, then the value has the form @code{(@var{high} . @var{low})}, where @var{low} holds the low 16 bits. If the inode number is too wide for even that, the value is of the form @@ -1331,52 +1277,99 @@ is on the file-system device whose number is 1014478468. @end table @end defun -@cindex SELinux context - SELinux is a Linux kernel feature which provides more sophisticated -file access controls than ordinary ``Unix-style'' file permissions. -If Emacs has been compiled with SELinux support on a system with -SELinux enabled, you can use the function @code{file-selinux-context} -to retrieve a file's SELinux security context. For the function -@code{set-file-selinux-context}, see @ref{Changing Files}. +@defun file-nlinks filename +This function returns the number of names (i.e., hard links) that +file @var{filename} has. If the file does not exist, this function +returns @code{nil}. Note that symbolic links have no effect on this +function, because they are not considered to be names of the files +they link to. -@defun file-selinux-context filename -This function returns the SELinux security context of the file -@var{filename}. This return value is a list of the form -@code{(@var{user} @var{role} @var{type} @var{range})}, whose elements -are the context's user, role, type, and range respectively, as Lisp -strings. See the SELinux documentation for details about what these -actually mean. +@example +@group +$ ls -l foo* +-rw-rw-rw- 2 rms rms 4 Aug 19 01:27 foo +-rw-rw-rw- 2 rms rms 4 Aug 19 01:27 foo1 +@end group -If the file does not exist or is inaccessible, or if the system does -not support SELinux, or if Emacs was not compiled with SELinux -support, then the return value is @code{(nil nil nil nil)}. +@group +(file-nlinks "foo") + @result{} 2 +@end group +@group +(file-nlinks "doesnt-exist") + @result{} nil +@end group +@end example @end defun +@node Extended Attributes +@subsection Extended File Attributes +@cindex extended file attributes + +On some operating systems, each file can be associated with arbitrary +@dfn{extended file attributes}. At present, Emacs supports querying +and setting two specific sets of extended file attributes: Access +Control Lists (ACLs) and SELinux contexts. These extended file +attributes are used, on some systems, to impose more sophisticated +file access controls than the basic ``Unix-style'' permissions +discussed in the previous sections. + @cindex access control list @cindex ACL entries - If Emacs has been compiled with @dfn{ACL} (access control list) -support, you can use the function @code{file-acl} to retrieve a file's -ACL entries. The interface implementation is platform-specific; on -GNU/Linux and BSD, Emacs uses the POSIX ACL interface, while on -MS-Windows Emacs emulates the POSIX ACL interface with native file -security APIs. +@cindex SELinux context + A detailed explanation of ACLs and SELinux is beyond the scope of +this manual. For our purposes, each file can be associated with an +@dfn{ACL}, which specifies its properties under an ACL-based file +control system, and/or an @dfn{SELinux context}, which specifies its +properties under the SELinux system. @defun file-acl filename -This function returns the ACL entries of the file @var{filename}. The -return value is a platform-dependent object containing some -representation of the ACL entries. Don't use it for anything except -passing it to the @code{set-file-acl} function (@pxref{Changing Files, -set-file-acl}). +This function returns the ACL for the file @var{filename}. The exact +Lisp representation of the ACL is unspecified (and may change in +future Emacs versions), but it is the same as what @code{set-file-acl} +takes for its @var{acl} argument (@pxref{Changing Files}). -If the file does not exist or is inaccessible, or if Emacs was unable to -determine the ACL entries, then the return value is @code{nil}. The -latter can happen for local files if Emacs was not compiled with ACL -support, or for remote files if the file handler returns nil for the -file's ACL entries. +The underlying ACL implementation is platform-specific; on GNU/Linux +and BSD, Emacs uses the POSIX ACL interface, while on MS-Windows Emacs +emulates the POSIX ACL interface with native file security APIs. + +If Emacs was not compiled with ACL support, or the file does not exist +or is inaccessible, or Emacs was unable to determine the ACL entries +for any other reason, then the return value is @code{nil}. +@end defun + +@defun file-selinux-context filename +This function returns the SELinux context of the file @var{filename}, +as a list of the form @code{(@var{user} @var{role} @var{type} +@var{range})}. The list elements are the context's user, role, type, +and range respectively, as Lisp strings; see the SELinux documentation +for details about what these actually mean. The return value has the +same form as what @code{set-file-selinux-context} takes for its +@var{context} argument (@pxref{Changing Files}). + +If Emacs was not compiled with SELinux support, or the file does not +exist or is inaccessible, or if the system does not support SELinux, +then the return value is @code{(nil nil nil nil)}. +@end defun + +@defun file-extended-attributes filename +This function returns an alist of the Emacs-recognized extended +attributes of file @var{filename}. Currently, it serves as a +convenient way to retrieve both the ACL and SELinux context; you can +then call the function @code{set-file-extended-attributes}, with the +returned alist as its second argument, to apply the same file access +attributes to another file (@pxref{Changing Files}). + +One of the elements is @code{(acl . @var{acl})}, where @var{acl} has +the same form returned by @code{file-acl}. + +Another element is @code{(selinux-context . @var{context})}, where +@var{context} is the SELinux context, in the same form returned by +@code{file-selinux-context}. @end defun @node Locating Files -@subsection How to Locate Files in Standard Places +@subsection Locating Files in Standard Places @cindex locate file in path @cindex find file in path @@ -1477,9 +1470,9 @@ In the first part of the following example, we list two files, @example @group -% ls -li fo* -81908 -rw-rw-rw- 1 rms 29 Aug 18 20:32 foo -84302 -rw-rw-rw- 1 rms 24 Aug 18 20:31 foo3 +$ ls -li fo* +81908 -rw-rw-rw- 1 rms rms 29 Aug 18 20:32 foo +84302 -rw-rw-rw- 1 rms rms 24 Aug 18 20:31 foo3 @end group @end example @@ -1494,10 +1487,10 @@ the files again. This shows two names for one file, @file{foo} and @end group @group -% ls -li fo* -81908 -rw-rw-rw- 2 rms 29 Aug 18 20:32 foo -81908 -rw-rw-rw- 2 rms 29 Aug 18 20:32 foo2 -84302 -rw-rw-rw- 1 rms 24 Aug 18 20:31 foo3 +$ ls -li fo* +81908 -rw-rw-rw- 2 rms rms 29 Aug 18 20:32 foo +81908 -rw-rw-rw- 2 rms rms 29 Aug 18 20:32 foo2 +84302 -rw-rw-rw- 1 rms rms 24 Aug 18 20:31 foo3 @end group @end example @@ -1519,10 +1512,10 @@ contents of @file{foo3} are lost. @end group @group -% ls -li fo* -81908 -rw-rw-rw- 3 rms 29 Aug 18 20:32 foo -81908 -rw-rw-rw- 3 rms 29 Aug 18 20:32 foo2 -81908 -rw-rw-rw- 3 rms 29 Aug 18 20:32 foo3 +$ ls -li fo* +81908 -rw-rw-rw- 3 rms rms 29 Aug 18 20:32 foo +81908 -rw-rw-rw- 3 rms rms 29 Aug 18 20:32 foo2 +81908 -rw-rw-rw- 3 rms rms 29 Aug 18 20:32 foo3 @end group @end example @@ -1542,7 +1535,7 @@ with @code{add-name-to-file} and then deleting @var{filename} has the same effect as renaming, aside from momentary intermediate states. @end deffn -@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid preserve-selinux +@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid preserve-extended-attributes This command copies the file @var{oldname} to @var{newname}. An error is signaled if @var{oldname} does not exist. If @var{newname} names a directory, it copies @var{oldname} into that directory, @@ -1555,8 +1548,6 @@ some operating systems.) If setting the time gets an error, interactive call, a prefix argument specifies a non-@code{nil} value for @var{time}. -This function copies the file modes, too. - If argument @var{preserve-uid-gid} is @code{nil}, we let the operating system decide the user and group ownership of the new file (this is usually set to the user running Emacs). If @var{preserve-uid-gid} is @@ -1564,10 +1555,16 @@ non-@code{nil}, we attempt to copy the user and group ownership of the file. This works only on some operating systems, and only if you have the correct permissions to do so. -If the optional argument @var{preserve-extended-attributes} is -non-@code{nil}, and Emacs has been built with the appropriate support, -this function attempts to copy the file's extended attributes, such as -its SELinux context and ACL entries (@pxref{File Attributes}). +If the optional argument @var{preserve-permissions} is non-@code{nil}, +this function copies the file modes (or ``permissions'') of +@var{oldname} to @var{newname}, as well as the Access Control List and +SELinux context (if any). @xref{Information about Files}. + +Otherwise, the file modes of @var{newname} are left unchanged if it is +an existing file, and set to those of @var{oldname}, masked by the +default file permissions (see @code{set-default-file-modes} below), if +@var{newname} is to be newly created. The Access Control List or +SELinux context are not copied over in either case. @end deffn @deffn Command make-symbolic-link filename newname &optional ok-if-exists @@ -1609,7 +1606,7 @@ See also @code{delete-directory} in @ref{Create/Delete Dirs}. @cindex permissions, file @cindex file modes, setting @deffn Command set-file-modes filename mode -This function sets the @dfn{file mode} (or @dfn{file permissions}) of +This function sets the @dfn{file mode} (or @dfn{permissions}) of @var{filename} to @var{mode}. It recursively follows symbolic links at all levels for @var{filename}. @@ -1625,7 +1622,7 @@ octal numbers to enter @var{mode}. For example, @noindent specifies that the file should be readable and writable for its owner, readable for group members, and readable for all other users. -@xref{File Permissions,,, coreutils, The @sc{gnu} @code{Coreutils} +@xref{File permissions,,, coreutils, The @sc{gnu} @code{Coreutils} Manual}, for a description of mode bit specifications. Interactively, @var{mode} is read from the minibuffer using @@ -1638,13 +1635,12 @@ returns the permissions of a file. @defun set-default-file-modes mode @cindex umask -This function sets the default file permissions for new files created -by Emacs and its subprocesses. Every file created with Emacs -initially has these permissions, or a subset of them -(@code{write-region} will not grant execute permissions even if the -default file permissions allow execution). On Unix and GNU/Linux, the -default permissions are given by the bitwise complement of the -``umask'' value. +This function sets the default permissions for new files created by +Emacs and its subprocesses. Every file created with Emacs initially +has these permissions, or a subset of them (@code{write-region} will +not grant execute permissions even if the default file permissions +allow execution). On Unix and GNU/Linux, the default permissions are +given by the bitwise complement of the ``umask'' value. The argument @var{mode} should be an integer which specifies the permissions, similar to @code{set-file-modes} above. Only the lowest @@ -1676,7 +1672,7 @@ the permissions on which the specification is based are taken from the mode bits of @var{base-file}. If @var{base-file} is omitted or @code{nil}, the function uses @code{0} as the base mode bits. The complete and relative specifications can be combined, as in -@code{"u+r,g+rx,o+r,g-w"}. @xref{File Permissions,,, coreutils, The +@code{"u+r,g+rx,o+r,g-w"}. @xref{File permissions,,, coreutils, The @sc{gnu} @code{Coreutils} Manual}, for a description of file mode specifications. @end defun @@ -1698,25 +1694,31 @@ time and must be in the format returned by @code{current-time} (@pxref{Time of Day}). @end defun -@defun set-file-selinux-context filename context -This function sets the SELinux security context of the file -@var{filename} to @var{context}. @xref{File Attributes}, for a brief -description of SELinux contexts. The @var{context} argument should be -a list @code{(@var{user} @var{role} @var{type} @var{range})}, like the -return value of @code{file-selinux-context}. The function returns -@code{t} if it succeeds to set the SELinux security context of -@var{filename}, @code{nil} otherwise. The function does nothing and -returns @code{nil} if SELinux is disabled, or if Emacs was compiled -without SELinux support. +@defun set-file-extended-attributes filename attribute-alist +This function sets the Emacs-recognized extended file attributes for +@code{filename}. The second argument @var{attribute-alist} should be +an alist of the same form returned by @code{file-extended-attributes}. +@xref{Extended Attributes}. @end defun -@defun set-file-acl filename acl-string -This function sets the ACL entries of the file @var{filename} to -@var{acl-string}. @xref{File Attributes}, for a brief description of -ACLs. The @var{acl-string} argument should be a string containing the -textual representation of the desired ACL entries as returned by -@code{file-acl} (@pxref{File Attributes, file-acl}). The function -returns @code{t} if it succeeds to set the ACL entries of +@defun set-file-selinux-context filename context +This function sets the SELinux security context for @var{filename} to +@var{context}. The @var{context} argument should be a list +@code{(@var{user} @var{role} @var{type} @var{range})}, where each +element is a string. @xref{Extended Attributes}. + +The function returns @code{t} if it succeeds in setting the SELinux +context of @var{filename}. It returns @code{nil} if the context was +not set (e.g., if SELinux is disabled, or if Emacs was compiled +without SELinux support). +@end defun + +@defun set-file-acl filename acl +This function sets the Access Control List for @var{filename} to +@var{acl}. The @var{acl} argument should have the same form returned +by the function @code{file-acl}. @xref{Extended Attributes}. + +The function returns @code{t} if it successfully sets the ACL of @var{filename}, @code{nil} otherwise. @end defun @@ -2105,10 +2107,6 @@ start with @samp{~}.) Otherwise, the current buffer's value of (expand-file-name "foo" "/usr/spool/") @result{} "/usr/spool/foo" @end group -@group -(expand-file-name "$HOME/foo") - @result{} "/xcssun/users/rms/lewis/$HOME/foo" -@end group @end example If the part of the combined file name before the first slash is @@ -2142,7 +2140,14 @@ This is for the sake of filesystems that have the concept of a @file{/../} is interpreted exactly the same as @file{/}. Note that @code{expand-file-name} does @emph{not} expand environment -variables; only @code{substitute-in-file-name} does that. +variables; only @code{substitute-in-file-name} does that: + +@example +@group +(expand-file-name "$HOME/foo") + @result{} "/xcssun/users/rms/lewis/$HOME/foo" +@end group +@end example Note also that @code{expand-file-name} does not follow symbolic links at any level. This results in a difference between the way @@ -2367,7 +2372,7 @@ buffer's default directory is prepended to @var{directory}, if In the following example, suppose that @file{~rms/lewis} is the current default directory, and has five files whose names begin with @samp{f}: @file{foo}, @file{file~}, @file{file.c}, @file{file.c.~1~}, and -@file{file.c.~2~}.@refill +@file{file.c.~2~}. @example @group @@ -2398,7 +2403,7 @@ function returns @code{t}. The function returns @code{nil} if directory In the following example, suppose that the current default directory has five files whose names begin with @samp{f}: @file{foo}, @file{file~}, @file{file.c}, @file{file.c.~1~}, and -@file{file.c.~2~}.@refill +@file{file.c.~2~}. @example @group @@ -2427,7 +2432,7 @@ has five files whose names begin with @samp{f}: @file{foo}, @code{file-name-completion} usually ignores file names that end in any string in this list. It does not ignore them when all the possible completions end in one of these suffixes. This variable has no effect -on @code{file-name-all-completions}.@refill +on @code{file-name-all-completions}. A typical value might look like this: @@ -2769,16 +2774,17 @@ first, before handlers for jobs such as remote file access. @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirectory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, @code{file-ownership-preserved-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect},@* @@ -2817,20 +2823,21 @@ first, before handlers for jobs such as remote file access. @code{file-accessible-direc@discretionary{}{}{}tory-p}, @code{file-acl}, @code{file-attributes}, -@code{file-direct@discretionary{}{}{}ory-p}, +@code{file-direc@discretionary{}{}{}tory-p}, @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirec@discretionary{}{}{}tory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, @code{file-ownership-pre@discretionary{}{}{}served-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect}, diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 7d56d38ffad..d281c6652a0 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Frames @@ -446,7 +446,7 @@ default parameters by supplying their own parameters. If you invoke Emacs with command-line options that specify frame appearance, those options take effect by adding elements to either @code{initial-frame-alist} or @code{default-frame-alist}. Options -which affect just the initial frame, such as @samp{-geometry} and +which affect just the initial frame, such as @samp{--geometry} and @samp{--maximized}, add to @code{initial-frame-alist}; the others add to @code{default-frame-alist}. @pxref{Emacs Invocation,, Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}. @@ -632,8 +632,9 @@ possible. The value @code{fullboth} specifies that both the width and the height shall be set to the size of the screen. The value @code{maximized} specifies that the frame shall be maximized. The difference between @code{maximized} and @code{fullboth} is that the -former still has window manager decorations while the latter really -covers the whole screen. +former can still be resized by dragging window manager decorations +with the mouse, while the latter really covers the whole screen and +does not allow resizing by mouse dragging. @end table @node Layout Parameters @@ -1361,7 +1362,7 @@ Terminals}. @node Input Focus @section Input Focus @cindex input focus -@c @cindex selected frame Duplicates selected-frame +@c @cindex selected frame Duplicates selected-frame, same for selected-window. At any time, one frame in Emacs is the @dfn{selected frame}. The selected window always resides on the selected frame. @@ -1478,6 +1479,14 @@ The redirection lasts until @code{redirect-frame-focus} is called to change it. @end defun +@defvar focus-in-hook +This is a normal hook run when an Emacs frame gains input focus. +@end defvar + +@defvar focus-out-hook +This is a normal hook run when an Emacs frame loses input focus. +@end defvar + @defopt focus-follows-mouse This option is how you inform Emacs whether the window manager transfers focus when the user moves the mouse. Non-@code{nil} says that it does. @@ -1740,8 +1749,10 @@ allows to know if the pointer has been hidden. @node Pop-Up Menus @section Pop-Up Menus - When using a window system, a Lisp program can pop up a menu so that -the user can choose an alternative with the mouse. + A Lisp program can pop up a menu so that the user can choose an +alternative with the mouse. On a text terminal, if the mouse is not +available, the user can choose an alternative using the keyboard +motion keys---@kbd{C-n}, @kbd{C-p}, or up- and down-arrow keys. @defun x-popup-menu position menu This function displays a pop-up menu and returns an indication of @@ -1762,20 +1773,22 @@ pixels, counting from the top left corner of @var{window}. @var{window} may be a window or a frame. If @var{position} is @code{t}, it means to use the current mouse -position. If @var{position} is @code{nil}, it means to precompute the -key binding equivalents for the keymaps specified in @var{menu}, -without actually displaying or popping up the menu. +position (or the top-left corner of the frame if the mouse is not +available on a text terminal). If @var{position} is @code{nil}, it +means to precompute the key binding equivalents for the keymaps +specified in @var{menu}, without actually displaying or popping up the +menu. The argument @var{menu} says what to display in the menu. It can be a keymap or a list of keymaps (@pxref{Menu Keymaps}). In this case, the return value is the list of events corresponding to the user's choice. This list has more than one element if the choice occurred in a submenu. (Note that @code{x-popup-menu} does not actually execute the -command bound to that sequence of events.) On toolkits that support -menu titles, the title is taken from the prompt string of @var{menu} -if @var{menu} is a keymap, or from the prompt string of the first -keymap in @var{menu} if it is a list of keymaps (@pxref{Defining -Menus}). +command bound to that sequence of events.) On text terminals and +toolkits that support menu titles, the title is taken from the prompt +string of @var{menu} if @var{menu} is a keymap, or from the prompt +string of the first keymap in @var{menu} if it is a list of keymaps +(@pxref{Defining Menus}). Alternatively, @var{menu} can have the following form: @@ -1799,7 +1812,7 @@ cell; this makes a non-selectable menu item. If the user gets rid of the menu without making a valid choice, for instance by clicking the mouse away from a valid choice or by typing -keyboard input, then this normally results in a quit and +@kbd{C-g}, then this normally results in a quit and @code{x-popup-menu} does not return. But if @var{position} is a mouse button event (indicating that the user invoked the menu with the mouse) then no quit occurs and @code{x-popup-menu} returns @code{nil}. @@ -1871,7 +1884,8 @@ window don't matter; only the frame matters. If @var{header} is non-@code{nil}, the frame title for the box is @samp{Information}, otherwise it is @samp{Question}. The former is used -for @code{message-box} (@pxref{message-box}). +for @code{message-box} (@pxref{message-box}). (On text terminals, the +box title is not displayed.) In some configurations, Emacs cannot display a real dialog box; so instead it displays the same items in a pop-up menu in the center of the @@ -2283,9 +2297,9 @@ obtain information about displays. @defun display-popup-menus-p &optional display This function returns @code{t} if popup menus are supported on -@var{display}, @code{nil} if not. Support for popup menus requires that -the mouse be available, since the user cannot choose menu items without -a mouse. +@var{display}, @code{nil} if not. Support for popup menus requires +that the mouse be available, since the menu is popped up by clicking +the mouse on some portion of the Emacs display. @end defun @defun display-graphic-p &optional display @@ -2390,6 +2404,7 @@ displays returned by @code{display-mm-height} and @code{display-mm-width} in case the system provides incorrect values. @end defopt +@cindex backing store @defun display-backing-store &optional display This function returns the backing store capability of the display. Backing store means recording the pixels of windows (and parts of @@ -2401,6 +2416,7 @@ Values can be the symbols @code{always}, @code{when-mapped}, or when the question is inapplicable to a certain kind of display. @end defun +@cindex SaveUnder feature @defun display-save-under &optional display This function returns non-@code{nil} if the display supports the SaveUnder feature. That feature is used by pop-up windows diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 999923f5b84..b38eab2649a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Functions @@ -21,6 +21,7 @@ define them. * Function Cells:: Accessing or setting the function definition of a symbol. * Closures:: Functions that enclose a lexical environment. +* Advising Functions:: Adding to the definition of a function. * Obsolete Functions:: Declaring functions obsolete. * Inline Functions:: Functions that the compiler will expand inline. * Declare Form:: Adding additional information about a function. @@ -196,9 +197,8 @@ an example: @end example @noindent -In Emacs Lisp, such a list is valid as an expression---it evaluates to -itself. But its main use is not to be evaluated as an expression, but -to be called as a function. +In Emacs Lisp, such a list is a valid expression which evaluates to +a function object. A lambda expression, by itself, has no name; it is an @dfn{anonymous function}. Although lambda expressions can be used this way @@ -581,6 +581,7 @@ redefinition from unintentional redefinition. @end defmac @cindex function aliases +@cindex alias, for functions @defun defalias name definition &optional doc @anchor{Definition of defalias} This function defines the symbol @var{name} as a function, with @@ -591,6 +592,11 @@ If @var{doc} is non-@code{nil}, it becomes the function documentation of @var{name}. Otherwise, any documentation provided by @var{definition} is used. +@cindex defalias-fset-function property +Internally, @code{defalias} normally uses @code{fset} to set the definition. +If @var{name} has a @code{defalias-fset-function} property, however, +the associated value is used as a function to call in place of @code{fset}. + The proper place to use @code{defalias} is where a specific function name is being defined---especially where that name appears explicitly in the source file being loaded. This is because @code{defalias} records @@ -975,10 +981,11 @@ Note that we do not quote the @code{lambda} form. compiled. This would not happen if, say, you had constructed the anonymous function by quoting it as a list: +@c Do not unquote this lambda! @example @group (defun double-property (symbol prop) - (change-property symbol prop (lambda (x) (* 2 x)))) + (change-property symbol prop '(lambda (x) (* 2 x)))) @end group @end example @@ -1000,12 +1007,12 @@ indirect-function}. @defun symbol-function symbol @kindex void-function -This returns the object in the function cell of @var{symbol}. If the -symbol's function cell is void, a @code{void-function} error is -signaled. +This returns the object in the function cell of @var{symbol}. It does +not check that the returned object is a legitimate function. -This function does not check that the returned object is a legitimate -function. +If the function cell is void, the return value is @code{nil}. To +distinguish between a function cell that is void and one set to +@code{nil}, use @code{fboundp} (see below). @example @group @@ -1025,10 +1032,10 @@ function. @end defun @cindex void function cell - If you have never given a symbol any function definition, we say that -that symbol's function cell is @dfn{void}. In other words, the function -cell does not have any Lisp object in it. If you try to call such a symbol -as a function, it signals a @code{void-function} error. + If you have never given a symbol any function definition, we say +that that symbol's function cell is @dfn{void}. In other words, the +function cell does not have any Lisp object in it. If you try to call +the symbol as a function, Emacs signals a @code{void-function} error. Note that void is not the same as @code{nil} or the symbol @code{void}. The symbols @code{nil} and @code{void} are Lisp objects, @@ -1076,12 +1083,10 @@ This function stores @var{definition} in the function cell of this is not checked. The argument @var{symbol} is an ordinary evaluated argument. -The primary use of this function is as a subroutine by constructs that -define or alter functions, like @code{defadvice} (@pxref{Advising -Functions}). (If @code{defun} were not a primitive, it could be -written as a Lisp macro using @code{fset}.) You can also use it to -give a symbol a function definition that is not a list, e.g., a -keyboard macro (@pxref{Keyboard Macros}): +The primary use of this function is as a subroutine by constructs that define +or alter functions, like @code{defun} or @code{advice-add} (@pxref{Advising +Functions}). You can also use it to give a symbol a function definition that +is not a function, e.g., a keyboard macro (@pxref{Keyboard Macros}): @example ;; @r{Define a named keyboard macro.} @@ -1132,8 +1137,272 @@ However, the fact that the internal structure of a closure is implementation detail. For this reason, we recommend against directly examining or altering the structure of closure objects. +@node Advising Functions +@section Advising Emacs Lisp Functions +@cindex advising functions +@cindex piece of advice + +Any variable or object field which holds a function can be modified with the +appropriate setter function, such as @code{set-process-filter}, @code{fset}, or +@code{setq}, but those can be too blunt, completely throwing away the +previous value. + +In order to modify such hooks in a more controlled way, Emacs provides the +macros @code{add-function} and @code{remove-function}, which let you modify the +existing function value by composing it with another function. + +For example, in order to trace the calls to a process filter, you can use: + +@example +(add-function :before (process-filter proc) #'my-tracing-function) +@end example + +This will cause the process's output to be passed first to +@code{my-tracing-function} and then to the original process filter. +When you're done with it, you can revert to the untraced behavior with: + +@example +(remove-function (process-filter proc) #'my-tracing-function) +@end example + +The argument @code{:before} specifies how the two functions are composed, since +there are many different ways to do it. The added function is also called an +@emph{advice}. + +The function cell of a symbol can be manipulated similarly, but since it can +contain other things than a plain function, you have to use @var{advice-add} +and @var{advice-remove} instead, which +@c use @var{add-function} and @var{remove-function} internally, but +know how to handle cases such as when the function cell holds a macro rather +than function, or when the function is autoloaded so the advice's activation +needs to be postponed. + +@menu +* Advising Primitives:: Primitives to Manipulate Advices +* Advising Named Functions:: Advising Named Functions +@end menu + +@node Advising Primitives +@subsection Primitives to manipulate advice + +@defmac add-function where place function &optional props +This macro is the handy way to add the advice @var{function} to the function +stored in @var{place} (@pxref{Generalized Variables}). + +@var{where} determines how @var{function} is composed with the +existing function. It can be one of the following: + +@table @code +@item :before +Call @var{function} before the old function. Both functions receive the +same arguments, and the return value of the composition is the return value of +the old function. More specifically, the composition of the two functions +behaves like: +@example +(lambda (&rest r) (apply @var{function} r) (apply @var{oldfun} r)) +@end example +This is similar to @code{(add-hook @var{hook} @var{function})}, except that it +applies to single-function hooks rather than normal hooks. + +@item :after +Call @var{function} after the old function. Both functions receive the +same arguments, and the return value of the composition is the return value of +the old function. More specifically, the composition of the two functions +behaves like: +@example +(lambda (&rest r) (prog1 (apply @var{oldfun} r) (apply @var{function} r))) +@end example +This is similar to @code{(add-hook @var{hook} @var{function} nil 'append)}, +except that it applies to single-function hooks rather than normal hooks. + +@item :override +This completely replaces the old function with the new one. The old function +can of course be recovered if you later call @code{remove-function}. + +@item :around +Call @var{function} instead of the old function, but provide the old function +as an extra argument to @var{function}. This is the most flexible composition. +For example, it lets you call the old function with different arguments, or +within a let-binding, or you can sometimes delegate the work to the old +function and sometimes override it completely. More specifically, the +composition of the two functions behaves like: +@example +(lambda (&rest r) (apply @var{function} @var{oldfun} r)) +@end example + +@item :before-while +Call @var{function} before the old function and don't call the old +function if @var{function} returns @code{nil}. Both functions receive the +same arguments, and the return value of the composition is the return value of +the old function. More specifically, the composition of the two functions +behaves like: +@example +(lambda (&rest r) (and (apply @var{function} r) (apply @var{oldfun} r))) +@end example +This is reminiscent of @code{(add-hook @var{hook} @var{function})}, when +@var{hook} is run via @code{run-hook-with-args-until-failure}. + +@item :before-until +Call @var{function} before the old function and only call the old function if +@var{function} returns @code{nil}. More specifically, the composition of the +two functions behaves like: +@example +(lambda (&rest r) (or (apply @var{function} r) (apply @var{oldfun} r))) +@end example +This is reminiscent of @code{(add-hook @var{hook} @var{function})}, when +@var{hook} is run via @code{run-hook-with-args-until-success}. + +@item :after-while +Call @var{function} after the old function and only if the old function +returned non-@code{nil}. Both functions receive the same arguments, and the +return value of the composition is the return value of @var{function}. +More specifically, the composition of the two functions behaves like: +@example +(lambda (&rest r) (and (apply @var{oldfun} r) (apply @var{function} r))) +@end example +This is reminiscent of @code{(add-hook @var{hook} @var{function} nil 'append)}, +when @var{hook} is run via @code{run-hook-with-args-until-failure}. + +@item :after-until +Call @var{function} after the old function and only if the old function +returned @code{nil}. More specifically, the composition of the two functions +behaves like: +@example +(lambda (&rest r) (or (apply @var{oldfun} r) (apply @var{function} r))) +@end example +This is reminiscent of @code{(add-hook @var{hook} @var{function} nil 'append)}, +when @var{hook} is run via @code{run-hook-with-args-until-success}. + +@item :filter-args +Call @var{function} first and use the result (which should be a list) as the +new arguments to pass to the old function. More specifically, the composition +of the two functions behaves like: +@example +(lambda (&rest r) (apply @var{oldfun} (funcall @var{function} r))) +@end example + +@item :filter-return +Call the old function first and pass the result to @var{function}. +More specifically, the composition of the two functions behaves like: +@example +(lambda (&rest r) (funcall @var{function} (apply @var{oldfun} r))) +@end example +@end table + +When modifying a variable (whose name will usually end with @code{-function}), +you can choose whether @var{function} is used globally or only in the current +buffer: if @var{place} is just a symbol, then @var{function} is added to the +global value of @var{place}. Whereas if @var{place} is of the form +@code{(local @var{symbol})}, where @var{symbol} is an expression which returns +the variable name, then @var{function} will only be added in the +current buffer. + +Every function added with @code{add-function} can be accompanied by an +association list of properties @var{props}. Currently only two of those +properties have a special meaning: + +@table @code +@item name +This gives a name to the advice, which @code{remove-function} can use to +identify which function to remove. Typically used when @var{function} is an +anonymous function. + +@item depth +This specifies where to place the advice, in case several advices are present. +By default, the depth is 0. A depth of 100 indicates that this advice should +be kept as deep as possible, whereas a depth of -100 indicates that it +should stay as the outermost advice. When two advices specify the same depth, +the most recently added advice will be outermost. +@end table +@end defmac + +@defmac remove-function place function +This macro removes @var{function} from the function stored in +@var{place}. This only works if @var{function} was added to @var{place} +using @code{add-function}. + +@var{function} is compared with functions added to @var{place} using +@code{equal}, to try and make it work also with lambda expressions. It is +additionally compared also with the @code{name} property of the functions added +to @var{place}, which can be more reliable than comparing lambda expressions +using @code{equal}. +@end defmac + +@defun advice-function-member-p advice function-def +Return non-@code{nil} if @var{advice} is already in @var{function-def}. +Like for @code{remove-function} above, instead of @var{advice} being the actual +function, it can also be the @code{name} of the piece of advice. +@end defun + +@defun advice-function-mapc f function-def +Call the function @var{f} for every advice that was added to +@var{function-def}. @var{f} is called with two arguments: the advice function +and its properties. +@end defun + +@node Advising Named Functions +@subsection Advising Named Functions + +A common use of advice is for named functions and macros. +Since @var{add-function} does not know how to deal with macros and autoloaded +functions, Emacs provides a separate set of functions to manipulate pieces of +advice applied to named functions. + + Advice can be useful for altering the behavior of an existing +function without having to redefine the whole function. However, it +can be a source of bugs, since existing callers to the function may +assume the old behavior, and work incorrectly when the behavior is +changed by advice. Advice can also cause confusion in debugging, if +the person doing the debugging does not notice or remember that the +function has been modified by advice. + + For these reasons, advice should be reserved for the cases where you +cannot modify a function's behavior in any other way. If it is +possible to do the same thing via a hook, that is preferable +(@pxref{Hooks}). If you simply want to change what a particular key +does, it may be better to write a new command, and remap the old +command's key bindings to the new one (@pxref{Remapping Commands}). +In particular, Emacs's own source files should not put advice on +functions in Emacs. (There are currently a few exceptions to this +convention, but we aim to correct them.) + + Macros can also be advised, in much the same way as functions. +However, special forms (@pxref{Special Forms}) cannot be advised. + + It is possible to advise a primitive (@pxref{What Is a Function}), +but one should typically @emph{not} do so, for two reasons. Firstly, +some primitives are used by the advice mechanism, and advising them +could cause an infinite recursion. Secondly, many primitives are +called directly from C, and such calls ignore advice; hence, one ends +up in a confusing situation where some calls (occurring from Lisp +code) obey the advice and other calls (from C code) do not. + +@defun advice-add symbol where function &optional props +Add the advice @var{function} to the named function @var{symbol}. +@var{where} and @var{props} have the same meaning as for @code{add-function} +(@pxref{Advising Primitives}). +@end defun + +@defun advice-remove symbol function +Remove the advice @var{function} from the named function @var{symbol}. +@var{function} can also be the @code{name} of an advice. +@end defun + +@defun advice-member-p function symbol +Return non-@code{nil} if the advice @var{function} is already in the named +function @var{symbol}. @var{function} can also be the @code{name} of +an advice. +@end defun + +@defun advice-mapc function symbol +Call @var{function} for every advice that was added to the named function +@var{symbol}. @var{function} is called with two arguments: the advice function +and its properties. +@end defun + @node Obsolete Functions @section Declaring Functions Obsolete +@cindex obsolete functions You can mark a named function as @dfn{obsolete}, meaning that it may be removed at some point in the future. This causes Emacs to warn @@ -1285,14 +1554,17 @@ following effects: This acts like a call to @code{set-advertised-calling-convention} (@pxref{Obsolete Functions}); @var{signature} specifies the correct argument list for calling the function or macro, and @var{when} should -be a string indicating when the variable was first made obsolete. +be a string indicating when the old argument list was first made obsolete. @item (debug @var{edebug-form-spec}) This is valid for macros only. When stepping through the macro with Edebug, use @var{edebug-form-spec}. @xref{Instrumenting Macro Calls}. @item (doc-string @var{n}) -Use element number @var{n}, if any, as the documentation string. +This is used when defining a function or macro which itself will be used to +define entities like functions, macros, or variables. It indicates that +the @var{n}th argument, if any, should be considered +as a documentation string. @item (indent @var{indent-spec}) Indent calls to this function or macro according to @var{indent-spec}. @@ -1307,7 +1579,37 @@ instead), a string (specifying the warning message), or @code{nil} (in which case the warning message gives no extra details). @var{when} should be a string indicating when the function or macro was first made obsolete. + +@item (compiler-macro @var{expander}) +This can only be used for functions, and tells the compiler to use +@var{expander} as an optimization function. When encountering a call to the +function, of the form @code{(@var{function} @var{args}@dots{})}, the macro +expander will call @var{expander} with that form as well as with +@var{args}@dots{}, and @var{expander} can either return a new expression to use +instead of the function call, or it can return just the form unchanged, +to indicate that the function call should be left alone. @var{expander} can +be a symbol, or it can be a form @code{(lambda (@var{arg}) @var{body})} in +which case @var{arg} will hold the original function call expression, and the +(unevaluated) arguments to the function can be accessed using the function's +formal arguments. + +@item (gv-expander @var{expander}) +Declare @var{expander} to be the function to handle calls to the macro (or +function) as a generalized variable, similarly to @code{gv-define-expander}. +@var{expander} can be a symbol or it can be of the form @code{(lambda +(@var{arg}) @var{body})} in which case that function will additionally have +access to the macro (or function)'s arguments. + +@item (gv-setter @var{setter}) +Declare @var{setter} to be the function to handle calls to the macro (or +function) as a generalized variable. @var{setter} can be a symbol in which +case it will be passed to @code{gv-define-simple-setter}, or it can be of the +form @code{(lambda (@var{arg}) @var{body})} in which case that function will +additionally have access to the macro (or function)'s arguments and it will +passed to @code{gv-define-setter}. + @end table + @end defmac @node Declaring Functions diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 655f31ab114..0c82bb59784 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 1999, 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Hash Tables @chapter Hash Tables diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 9fe069b84d0..50103d3a8b3 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Documentation @@ -10,8 +10,13 @@ GNU Emacs has convenient built-in help facilities, most of which derive their information from documentation strings associated with functions and variables. This chapter describes how to access -documentation strings in Lisp programs. @xref{Documentation Tips}, -for how to write good documentation strings. +documentation strings in Lisp programs. + + The contents of a documentation string should follow certain +conventions. In particular, its first line should be a complete +sentence (or two complete sentences) that briefly describes what the +function or variable does. @xref{Documentation Tips}, for how to +write good documentation strings. Note that the documentation strings for Emacs are not the same thing as the Emacs manual. Manuals have their own source files, written in @@ -40,78 +45,48 @@ Help, emacs, The GNU Emacs Manual}. @cindex string, writing a doc string A documentation string is written using the Lisp syntax for strings, -with double-quote characters surrounding the text of the string. This -is because it really is a Lisp string object. The string serves as -documentation when it is written in the proper place in the definition -of a function or variable. In a function definition, the documentation -string follows the argument list. In a variable definition, the -documentation string follows the initial value of the variable. +with double-quote characters surrounding the text. It is, in fact, an +actual Lisp string. When the string appears in the proper place in a +function or variable definition, it serves as the function's or +variable's documentation. - When you write a documentation string, make the first line a -complete sentence (or two complete sentences) that briefly describes -what the function or variable does. Some commands, such as -@code{apropos}, show only the first line of a multi-line documentation -string. Also, you should not indent the second line of a -documentation string, if it has one, because that looks odd when you -use @kbd{C-h f} (@code{describe-function}) or @kbd{C-h v} -(@code{describe-variable}) to view the documentation string. There -are many other conventions for documentation strings; see -@ref{Documentation Tips}. +@cindex @code{function-documentation} property + In a function definition (a @code{lambda} or @code{defun} form), the +documentation string is specified after the argument list, and is +normally stored directly in the function object. @xref{Function +Documentation}. You can also put function documentation in the +@code{function-documentation} property of a function name +(@pxref{Accessing Documentation}). - Documentation strings can contain several special text sequences, -referring to key bindings which are looked up in the current keymaps -when the user views the documentation. This allows the help commands -to display the correct keys even if a user rearranges the default key +@cindex @code{variable-documentation} property + In a variable definition (a @code{defvar} form), the documentation +string is specified after the initial value. @xref{Defining +Variables}. The string is stored in the variable's +@code{variable-documentation} property. + +@cindex @file{DOC} (documentation) file + Sometimes, Emacs does not keep documentation strings in memory. +There are two such circumstances. Firstly, to save memory, the +documentation for preloaded functions and variables (including +primitives) is kept in a file named @file{DOC}, in the directory +specified by @code{doc-directory} (@pxref{Accessing Documentation}). +Secondly, when a function or variable is loaded from a byte-compiled +file, Emacs avoids loading its documentation string (@pxref{Docs and +Compilation}). In both cases, Emacs looks up the documentation string +from the file only when needed, such as when the user calls @kbd{C-h +f} (@code{describe-function}) for a function. + + Documentation strings can contain special @dfn{key substitution +sequences}, referring to key bindings which are looked up only when +the user views the documentation. This allows the help commands to +display the correct keys even if a user rearranges the default key bindings. @xref{Keys in Documentation}. In the documentation string of an autoloaded command -(@pxref{Autoload}), these special text sequences have an additional -special effect: they cause @kbd{C-h f} (@code{describe-function}) on -the command to trigger autoloading. (This is needed for correctly -setting up the hyperlinks in the @file{*Help*} buffer). - -@vindex emacs-lisp-docstring-fill-column - Emacs Lisp mode fills documentation strings to the width -specified by @code{emacs-lisp-docstring-fill-column}. - - Exactly where a documentation string is stored depends on how its -function or variable was defined or loaded into memory: - -@itemize @bullet -@item -@kindex function-documentation -When you define a function (@pxref{Lambda Expressions}, and -@pxref{Function Documentation}), the documentation string is stored in -the function definition itself. You can also put function -documentation in the @code{function-documentation} property of a -function name. That is useful for function definitions which can't -hold a documentation string, such as keyboard macros. - -@item -@kindex variable-documentation -When you define a variable with a @code{defvar} or related form -(@pxref{Defining Variables}), the documentation is stored in the -variable's @code{variable-documentation} property. - -@cindex @file{DOC-@var{version}} (documentation) file -@item -To save memory, the documentation for preloaded functions and -variables (including primitive functions and autoloaded functions) is -not kept in memory, but in the file -@file{emacs/etc/DOC-@var{version}}, where @var{version} is the Emacs -version number (@pxref{Version Info}). - -@item -When a function or variable is loaded from a byte-compiled file during -the Emacs session, its documentation string is not loaded into memory. -Instead, Emacs looks it up in the byte-compiled file as needed. -@xref{Docs and Compilation}. -@end itemize - -@noindent -Regardless of where the documentation string is stored, you can -retrieve it using the @code{documentation} or -@code{documentation-property} function, described in the next section. +(@pxref{Autoload}), these key-substitution sequences have an +additional special effect: they cause @kbd{C-h f} on the command to +trigger autoloading. (This is needed for correctly setting up the +hyperlinks in the @file{*Help*} buffer.) @node Accessing Documentation @section Access to Documentation Strings @@ -123,18 +98,20 @@ most often used to look up the documentation strings of variables, for which @var{property} is @code{variable-documentation}. However, it can also be used to look up other kinds of documentation, such as for customization groups (but for function documentation, use the -@code{documentation} command, below). +@code{documentation} function, below). -If the value recorded in the property list refers to a documentation -string stored in a @file{DOC-@var{version}} file or a byte-compiled -file, it looks up that string and returns it. If the property value -isn't @code{nil}, isn't a string, and doesn't refer to text in a file, -then it is evaluated as a Lisp expression to obtain a string. +If the property value refers to a documentation string stored in the +@file{DOC} file or a byte-compiled file, this function looks up that +string and returns it. -The last thing this function does is pass the string through -@code{substitute-command-keys} to substitute actual key bindings -(@pxref{Keys in Documentation}). However, it skips this step if -@var{verbatim} is non-@code{nil}. +If the property value isn't @code{nil}, isn't a string, and doesn't +refer to text in a file, then it is evaluated as a Lisp expression to +obtain a string. + +Finally, this function passes the string through +@code{substitute-command-keys} to substitute key bindings (@pxref{Keys +in Documentation}). It skips this step if @var{verbatim} is +non-@code{nil}. @smallexample @group @@ -161,16 +138,18 @@ ordinary functions. If @var{function} is a symbol, this function first looks for the @code{function-documentation} property of that symbol; if that has a non-@code{nil} value, the documentation comes from that value (if the -value is not a string, it is evaluated). If @var{function} is not a -symbol, or if it has no @code{function-documentation} property, then -@code{documentation} extracts the documentation string from the actual -function definition, reading it from a file if called for. +value is not a string, it is evaluated). -Finally, unless @var{verbatim} is non-@code{nil}, it calls -@code{substitute-command-keys} so as to return a value containing the -actual (current) key bindings. +If @var{function} is not a symbol, or if it has no +@code{function-documentation} property, then @code{documentation} +extracts the documentation string from the actual function definition, +reading it from a file if called for. -The function @code{documentation} signals a @code{void-function} error +Finally, unless @var{verbatim} is non-@code{nil}, this function calls +@code{substitute-command-keys}. The result is the documentation +string to return. + +The @code{documentation} function signals a @code{void-function} error if @var{function} has no function definition. However, it is OK if the function definition has no documentation string. In that case, @code{documentation} returns @code{nil}. @@ -181,7 +160,6 @@ This function returns the documentation string of @var{face} as a face. @end defun -@c Wordy to prevent overfull hboxes. --rjc 15mar92 Here is an example of using the two functions, @code{documentation} and @code{documentation-property}, to display the documentation strings for several symbols in a @file{*Help*} buffer. @@ -296,12 +274,12 @@ memory in the function definitions and variable property lists. Emacs reads the file @var{filename} from the @file{emacs/etc} directory. When the dumped Emacs is later executed, the same file will be looked for in the directory @code{doc-directory}. Usually @var{filename} is -@code{"DOC-@var{version}"}. +@code{"DOC"}. @end defun @defvar doc-directory This variable holds the name of the directory which should contain the -file @code{"DOC-@var{version}"} that contains documentation strings for +file @code{"DOC"} that contains documentation strings for built-in and preloaded functions and variables. In most cases, this is the same as @code{data-directory}. They may be @@ -314,6 +292,7 @@ without actually installing it. @xref{Definition of data-directory}. @cindex documentation, keys in @cindex keys in documentation strings @cindex substituting keys in documentation +@cindex key substitution sequence When documentation strings refer to key sequences, they should use the current, actual key bindings. They can do so using certain special text diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index 745393f8166..22061fe9931 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1998, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1993, 1998, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Hooks @@ -115,6 +115,12 @@ Function to call to ``quit'' the current buffer. @vindex delayed-warnings-hook The command loop runs this soon after @code{post-command-hook} (q.v.). +@item focus-in-hook +@vindex focus-in-hook +@itemx focus-out-hook +@vindex focus-out-hook +@xref{Input Focus}. + @item delete-frame-functions @xref{Deleting Frames}. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 3269776b626..94e4b705105 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1993, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node GNU Emacs Internals @@ -116,6 +116,11 @@ time.) expect in an ordinary unmodified Emacs. If you feel you must override normal features for your site, do it with @file{default.el}, so that users can override your changes if they wish. @xref{Startup Summary}. +Note that if either @file{site-load.el} or @file{site-init.el} changes +@code{load-path}, the changes will be lost after dumping. +@xref{Library Search}. To make a permanent change to +@code{load-path}, use the @option{--enable-locallisppath} option +of @command{configure}. In a package that can be preloaded, it is sometimes necessary (or useful) to delay certain evaluations until Emacs subsequently starts @@ -661,15 +666,25 @@ equivalent of @code{&rest}). Both @code{UNEVALLED} and @code{MANY} are macros. If @var{max} is a number, it must be more than @var{min} but less than 8. +@cindex interactive specification in primitives @item interactive -This is an interactive specification, a string such as might be used as -the argument of @code{interactive} in a Lisp function. In the case of -@code{or}, it is 0 (a null pointer), indicating that @code{or} cannot be -called interactively. A value of @code{""} indicates a function that -should receive no arguments when called interactively. If the value -begins with a @samp{(}, the string is evaluated as a Lisp form. -For examples of the last two forms, see @code{widen} and -@code{narrow-to-region} in @file{editfns.c}. +This is an interactive specification, a string such as might be used +as the argument of @code{interactive} in a Lisp function. In the case +of @code{or}, it is 0 (a null pointer), indicating that @code{or} +cannot be called interactively. A value of @code{""} indicates a +function that should receive no arguments when called interactively. +If the value begins with a @samp{"(}, the string is evaluated as a +Lisp form. For example: + +@example +@group +DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, + "(list (read-char-by-name \"Insert character: \")\ + (prefix-numeric-value current-prefix-arg)\ + t))", + doc: /* @dots{} /*) +@end group +@end example @item doc This is the documentation string. It uses C comment syntax rather @@ -1454,12 +1469,10 @@ process. For a network or serial process, it is @code{nil} if the process is running or @code{t} if the process is stopped. @item filter -If non-@code{nil}, a function used to accept output from the process -instead of a buffer. +A function used to accept output from the process. @item sentinel -If non-@code{nil}, a function called whenever the state of the process -changes. +A function called whenever the state of the process changes. @item buffer The associated buffer of the process. diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 948f00d7e5f..0c5346fbb63 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -1,6 +1,6 @@ -@c -*-coding: iso-latin-1-*- +@c -*-coding: utf-8-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Introduction @@ -456,7 +456,7 @@ described using a format like that for functions, except that there are no arguments. Here is a description of the imaginary @code{electric-future-map} -variable.@refill +variable. @defvar electric-future-map The value of this variable is a full keymap used by Electric Command @@ -545,9 +545,9 @@ Eirik Fuller, Stephen Gildea, Bob Glickstein, Eric Hanchrow, Jesper Harder, George Hartzell, Nathan Hess, Masayuki Ida, Dan Jacobson, Jak Kirman, Bob Knighten, Frederick M. Korz, Joe Lammens, Glenn M. Lewis, K. Richard Magill, Brian Marick, Roland McGrath, Stefan Monnier, Skip -Montanaro, John Gardiner Myers, Thomas A. Peterson, Francesco Potorti, +Montanaro, John Gardiner Myers, Thomas A. Peterson, Francesco Potortì, Friedrich Pukelsheim, Arnold D. Robbins, Raul Rockwell, Jason Rumney, -Per Starbck, Shinichirou Sugou, Kimmo Suominen, Edward Tharp, Bill +Per Starbäck, Shinichirou Sugou, Kimmo Suominen, Edward Tharp, Bill Trost, Rickard Westman, Jean White, Eduard Wiebe, Matthew Wilding, Carl Witty, Dale Worley, Rusty Wright, and David D. Zuhn. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 822e952ef98..a372cecb818 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 1998-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Keymaps @chapter Keymaps @@ -622,76 +622,67 @@ string for the keymap. The prompt string should be given for menu keymaps @node Active Keymaps @section Active Keymaps @cindex active keymap -@cindex global keymap + + Emacs contains many keymaps, but at any time only a few keymaps are +@dfn{active}. When Emacs receives user input, it translates the input +event (@pxref{Translation Keymaps}), and looks for a key binding in +the active keymaps. + + Usually, the active keymaps are: (i) the keymap specified by the +@code{keymap} property, (ii) the keymaps of enabled minor modes, (iii) +the current buffer's local keymap, and (iv) the global keymap, in that +order. Emacs searches for each input key sequence in all these +keymaps. + + Of these ``usual'' keymaps, the highest-precedence one is specified +by the @code{keymap} text or overlay property at point, if any. (For +a mouse input event, Emacs uses the event position instead of point; +@iftex +see the next section for details.) +@end iftex +@ifnottex +@pxref{Searching Keymaps}.) +@end ifnottex + + Next in precedence are keymaps specified by enabled minor modes. +These keymaps, if any, are specified by the variables +@code{emulation-mode-map-alists}, +@code{minor-mode-overriding-map-alist}, and +@code{minor-mode-map-alist}. @xref{Controlling Active Maps}. + @cindex local keymap - - Emacs normally contains many keymaps; at any given time, just a few -of them are @dfn{active}, meaning that they participate in the -interpretation of user input. All the active keymaps are used -together to determine what command to execute when a key is entered. - - Normally the active keymaps are the @code{keymap} property keymap, -the keymaps of any enabled minor modes, the current buffer's local -keymap, and the global keymap, in that order. Emacs searches for each -input key sequence in all these keymaps. @xref{Searching Keymaps}, -for more details of this procedure. - - When the key sequence starts with a mouse event, -the active keymaps are determined based on the -position in that event. If the event happened on a string embedded -with a @code{display}, @code{before-string}, or @code{after-string} -property (@pxref{Special Properties}), the non-@code{nil} map -properties of the string override those of the buffer (if the -underlying buffer text contains map properties in its text properties -or overlays, they are ignored). - - The @dfn{global keymap} holds the bindings of keys that are defined -regardless of the current buffer, such as @kbd{C-f}. The variable -@code{global-map} holds this keymap, which is always active. - - Each buffer may have another keymap, its @dfn{local keymap}, which -may contain new or overriding definitions for keys. The current -buffer's local keymap is always active except when -@code{overriding-local-map} overrides it. The @code{local-map} text -or overlay property can specify an alternative local keymap for certain -parts of the buffer; see @ref{Special Properties}. - - Each minor mode can have a keymap; if it does, the keymap is active -when the minor mode is enabled. Modes for emulation can specify -additional active keymaps through the variable -@code{emulation-mode-map-alists}. - - The highest precedence normal keymap comes from the @code{keymap} -text or overlay property. If that is non-@code{nil}, it is the first -keymap to be processed, in normal circumstances. Next comes -any keymap added by the function @code{set-temporary-overlay-map}. -@xref{Controlling Active Maps}. - - However, there are also special ways for programs to substitute -other keymaps for some of those. The variable -@code{overriding-local-map}, if non-@code{nil}, specifies a keymap -that replaces all the usual active keymaps except the global keymap. -Another way to do this is with @code{overriding-terminal-local-map}; -it operates on a per-terminal basis. These variables are documented -below. + Next in precedence is the buffer's @dfn{local keymap}, containing +key bindings specific to the buffer. The minibuffer also has a local +keymap (@pxref{Intro to Minibuffers}). If there is a @code{local-map} +text or overlay property at point, that specifies the local keymap to +use, in place of the buffer's default local keymap. @cindex major mode keymap - Since every buffer that uses the same major mode normally uses the -same local keymap, you can think of the keymap as local to the mode. A -change to the local keymap of a buffer (using @code{local-set-key}, for -example) is seen also in the other buffers that share that keymap. + The local keymap is normally set by the buffer's major mode, and +every buffer with the same major mode shares the same local keymap. +Hence, if you call @code{local-set-key} (@pxref{Key Binding Commands}) +to change the local keymap in one buffer, that also affects the local +keymaps in other buffers with the same major mode. - The local keymaps that are used for Lisp mode and some other major -modes exist even if they have not yet been used. These local keymaps are -the values of variables such as @code{lisp-mode-map}. For most major -modes, which are less frequently used, the local keymap is constructed -only when the mode is used for the first time in a session. +@cindex global keymap + Finally, the @dfn{global keymap} contains key bindings that are +defined regardless of the current buffer, such as @kbd{C-f}. It is +always active, and is bound to the variable @code{global-map}. - The minibuffer has local keymaps, too; they contain various completion -and exit commands. @xref{Intro to Minibuffers}. + Apart from the above ``usual'' keymaps, Emacs provides special ways +for programs to make other keymaps active. Firstly, the variable +@code{overriding-local-map} specifies a keymap that replaces the usual +active keymaps, except for the global keymap. Secondly, the +terminal-local variable @code{overriding-terminal-local-map} specifies +a keymap that takes precedence over @emph{all} other keymaps +(including @code{overriding-local-map}); this is normally used for +modal/transient keybindings (the function @code{set-transient-map} +provides a convenient interface for this). @xref{Controlling Active +Maps}, for details. - Emacs has other keymaps that are used in a different way---translating -events within @code{read-key-sequence}. @xref{Translation Keymaps}. + Making keymaps active is not the only way to use them. Keymaps are +also used in other ways, such as for translating events within +@code{read-key-sequence}. @xref{Translation Keymaps}. @xref{Standard Keymaps}, for a list of some standard keymaps. @@ -728,7 +719,7 @@ If @var{position} is non-@code{nil}, it should be either a buffer position or an event position like the value of @code{event-start}. Then the maps consulted are determined based on @var{position}. -An error is signaled if @var{key} is not a string or a vector. +Emacs signals an error if @var{key} is not a string or a vector. @example @group @@ -742,46 +733,52 @@ An error is signaled if @var{key} is not a string or a vector. @section Searching the Active Keymaps @cindex searching active keymaps for keys - After translation of event subsequences (@pxref{Translation -Keymaps}) Emacs looks for them in the active keymaps. Here is a -pseudo-Lisp description of the order and conditions for searching -them: +Here is a pseudo-Lisp summary of how Emacs searches the active +keymaps: @lisp -(or (cond - (overriding-terminal-local-map - (@var{find-in} overriding-terminal-local-map)) - (overriding-local-map - (@var{find-in} overriding-local-map)) - ((or (@var{find-in} (get-char-property (point) 'keymap)) - (@var{find-in} @var{temp-map}) +(or (if overriding-terminal-local-map + (@var{find-in} overriding-terminal-local-map)) + (if overriding-local-map + (@var{find-in} overriding-local-map) + (or (@var{find-in} (get-char-property (point) 'keymap)) (@var{find-in-any} emulation-mode-map-alists) (@var{find-in-any} minor-mode-overriding-map-alist) (@var{find-in-any} minor-mode-map-alist) (if (get-text-property (point) 'local-map) (@var{find-in} (get-char-property (point) 'local-map)) - (@var{find-in} (current-local-map)))))) + (@var{find-in} (current-local-map))))) (@var{find-in} (current-global-map))) @end lisp @noindent -@var{find-in} and @var{find-in-any} are pseudo functions that search -in one keymap and in an alist of keymaps, respectively. (Searching a -single keymap for a binding is called @dfn{key lookup}; see @ref{Key -Lookup}.) If the key sequence starts with a mouse event, that event's position -is used instead of point and the current buffer. Mouse events on an -embedded string use non-@code{nil} text properties from that string -instead of the buffer. @var{temp-map} is a pseudo variable that -represents the effect of a @code{set-temporary-overlay-map} call. +Here, @var{find-in} and @var{find-in-any} are pseudo functions that +search in one keymap and in an alist of keymaps, respectively. Note +that the @code{set-transient-map} function works by setting +@code{overriding-terminal-local-map} (@pxref{Controlling Active +Maps}). - When a match is found (@pxref{Key Lookup}), if the binding in the -keymap is a function, the search is over. However if the keymap entry -is a symbol with a value or a string, Emacs replaces the input key -sequences with the variable's value or the string, and restarts the -search of the active keymaps. + In the above pseudo-code, if a key sequence starts with a mouse +event (@pxref{Mouse Events}), that event's position is used instead of +point, and the event's buffer is used instead of the current buffer. +In particular, this affects how the @code{keymap} and @code{local-map} +properties are looked up. If a mouse event occurs on a string +embedded with a @code{display}, @code{before-string}, or +@code{after-string} property (@pxref{Special Properties}), and the +string has a non-@code{nil} @code{keymap} or @code{local-map} +property, that overrides the corresponding property in the underlying +buffer text (i.e., the property specified by the underlying text is +ignored). - The function finally found might also be remapped. @xref{Remapping -Commands}. + When a key binding is found in one of the active keymaps, and that +binding is a command, the search is over---the command is executed. +However, if the binding is a symbol with a value or a string, Emacs +replaces the input key sequences with the variable's value or the +string, and restarts the search of the active keymaps. @xref{Key +Lookup}. + + The command which is finally found might also be remapped. +@xref{Remapping Commands}. @node Controlling Active Maps @section Controlling the Active Keymaps @@ -858,7 +855,6 @@ keymap. @code{use-local-map} returns @code{nil}. Most major mode commands use this function. @end defun -@c Emacs 19 feature @defvar minor-mode-map-alist @anchor{Definition of minor-mode-map-alist} This variable is an alist describing keymaps that may or may not be @@ -943,7 +939,7 @@ event is run directly by @code{read-event}. @xref{Special Events}. @end defvar @defvar emulation-mode-map-alists -This variable holds a list of keymap alists to use for emulations +This variable holds a list of keymap alists to use for emulation modes. It is intended for modes or packages using multiple minor-mode keymaps. Each element is a keymap alist which has the same format and meaning as @code{minor-mode-map-alist}, or a symbol with a variable @@ -952,19 +948,25 @@ are used before @code{minor-mode-map-alist} and @code{minor-mode-overriding-map-alist}. @end defvar -@defun set-temporary-overlay-map keymap &optional keep -This function adds @var{keymap} as a temporary keymap that takes -precedence over most other keymaps. It does not take precedence over -the ``overriding'' maps (see above); and unlike them, if no match for -a key is found in @var{keymap}, the search continues. +@cindex transient keymap +@defun set-transient-map keymap &optional keep +This function adds @var{keymap} as a @dfn{transient} keymap, which +takes precedence over other keymaps for one (or more) subsequent keys. -Normally, @var{keymap} is used only once. If the optional argument -@var{pred} is @code{t}, the map stays active if a key from @var{keymap} -is used. @var{pred} can also be a function of no arguments: if it returns -non-@code{nil} then @var{keymap} stays active. +Normally, @var{keymap} is used just once, to look up the very next +key. If the optional argument @var{pred} is @code{t}, the map stays +active as long as the user types keys defined in @var{keymap}; when +the user types a key that is not in @var{keymap}, the transient keymap +is deactivated and normal key lookup continues for that key. -For a pseudo-Lisp description of exactly how and when this keymap applies, -@pxref{Searching Keymaps}. +The @var{pred} argument can also be a function. In that case, the +function is called with no arguments, prior to running each command, +while @var{keymap} is active; it should return non-@code{nil} if +@var{keymap} should stay active. + +This function works by adding and removing @code{keymap} from the +variable @code{overriding-terminal-local-map}, which takes precedence +over all other active keymaps (@pxref{Searching Keymaps}). @end defun @node Key Lookup @@ -1549,32 +1551,36 @@ specifies a list of keymaps to search in. This argument is ignored if @node Translation Keymaps @section Keymaps for Translating Sequences of Events +@cindex translation keymap @cindex keymaps for translating events - This section describes keymaps that are used during reading a key -sequence, to translate certain event sequences into others. -@code{read-key-sequence} checks every subsequence of the key sequence -being read, as it is read, against @code{input-decode-map}, then -@code{local-function-key-map}, and then against @code{key-translation-map}. + When the @code{read-key-sequence} function reads a key sequence +(@pxref{Key Sequence Input}), it uses @dfn{translation keymaps} to +translate certain event sequences into others. The translation +keymaps are @code{input-decode-map}, @code{local-function-key-map}, +and @code{key-translation-map} (in order of priority). -These keymaps have the same structure as other keymaps, but they are used -differently: they specify translations to make while reading key sequences, -rather than bindings for key sequences. + Translation keymaps have the same structure as other keymaps, but +are used differently: they specify translations to make while reading +key sequences, rather than bindings for complete key sequences. As +each key sequence is read, it is checked against each translation +keymap. If one of the translation keymaps ``binds'' @var{k} to a +vector @var{v}, then whenever @var{k} appears as a sub-sequence +@emph{anywhere} in a key sequence, that sub-sequence is replaced with +the events in @var{v}. -If one of these keymaps ``binds'' a key sequence @var{k} to a vector -@var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a -key sequence, it is replaced with the events in @var{v}. + For example, VT100 terminals send @kbd{@key{ESC} O P} when the +keypad key @key{PF1} is pressed. On such terminals, Emacs must +translate that sequence of events into a single event @code{pf1}. +This is done by ``binding'' @kbd{@key{ESC} O P} to @code{[pf1]} in +@code{input-decode-map}. Thus, when you type @kbd{C-c @key{PF1}} on +the terminal, the terminal emits the character sequence @kbd{C-c +@key{ESC} O P}, and @code{read-key-sequence} translates this back into +@kbd{C-c @key{PF1}} and returns it as the vector @code{[?\C-c pf1]}. -For example, VT100 terminals send @kbd{@key{ESC} O P} when the -keypad @key{PF1} key is pressed. Therefore, we want Emacs to translate -that sequence of events into the single event @code{pf1}. We accomplish -this by ``binding'' @kbd{@key{ESC} O P} to @code{[pf1]} in -@code{input-decode-map}, when using a VT100. - -Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c -@key{ESC} O P}; later the function @code{read-key-sequence} translates -this back into @kbd{C-c @key{PF1}}, which it returns as the vector -@code{[?\C-c pf1]}. + Translation keymaps take effect only after Emacs has decoded the +keyboard input (via the input coding system specified by +@code{keyboard-coding-system}). @xref{Terminal I/O Encoding}. @defvar input-decode-map This variable holds a keymap that describes the character sequences sent @@ -1662,10 +1668,6 @@ to turn the character that follows into a Hyper character: @end group @end example - If you have enabled keyboard character set decoding using -@code{set-keyboard-coding-system}, decoding is done before the -translations listed above. @xref{Terminal I/O Encoding}. - @subsection Interaction with normal keymaps The end of a key sequence is detected when that key sequence either is bound @@ -2024,7 +2026,7 @@ which is a string that appears as an element of the keymap. the menu's commands. Emacs displays the overall prompt string as the menu title in some cases, depending on the toolkit (if any) used for displaying menus.@footnote{It is required for menus which do not use a -toolkit, e.g., under MS-DOS.} Keyboard menus also display the +toolkit, e.g., on a text terminal.} Keyboard menus also display the overall prompt string. The easiest way to construct a keymap with a prompt string is to @@ -2372,16 +2374,17 @@ if the menu keymap contains a single nested keymap and no other menu items, the menu shows the contents of the nested keymap directly, not as a submenu. - However, if Emacs is compiled without X toolkit support, submenus -are not supported. Each nested keymap is shown as a menu item, but -clicking on it does not automatically pop up the submenu. If you wish -to imitate the effect of submenus, you can do that by giving a nested -keymap an item string which starts with @samp{@@}. This causes Emacs -to display the nested keymap using a separate @dfn{menu pane}; the -rest of the item string after the @samp{@@} is the pane label. If -Emacs is compiled without X toolkit support, menu panes are not used; -in that case, a @samp{@@} at the beginning of an item string is -omitted when the menu label is displayed, and has no other effect. + However, if Emacs is compiled without X toolkit support, or on text +terminals, submenus are not supported. Each nested keymap is shown as +a menu item, but clicking on it does not automatically pop up the +submenu. If you wish to imitate the effect of submenus, you can do +that by giving a nested keymap an item string which starts with +@samp{@@}. This causes Emacs to display the nested keymap using a +separate @dfn{menu pane}; the rest of the item string after the +@samp{@@} is the pane label. If Emacs is compiled without X toolkit +support, or if a menu is displayed on a text terminal, menu panes are +not used; in that case, a @samp{@@} at the beginning of an item string +is omitted when the menu label is displayed, and has no other effect. @node Keyboard Menus @subsection Menus and the Keyboard @@ -2486,10 +2489,10 @@ can do it this way: @subsection The Menu Bar @cindex menu bar - On graphical displays, there is usually a @dfn{menu bar} at the top -of each frame. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. Menu -bar items are subcommands of the fake ``function key'' -@code{menu-bar}, as defined in the active keymaps. + Emacs usually shows a @dfn{menu bar} at the top of each frame. +@xref{Menu Bars,,,emacs, The GNU Emacs Manual}. Menu bar items are +subcommands of the fake ``function key'' @code{menu-bar}, as defined +in the active keymaps. To add an item to the menu bar, invent a fake ``function key'' of your own (let's call it @var{key}), and make a binding for the key sequence @@ -2556,7 +2559,7 @@ at the end of the menu bar, following local menu items. @defvar menu-bar-update-hook This normal hook is run by redisplay to update the menu bar contents, -before redisplaying the menu bar. You can use it to update submenus +before redisplaying the menu bar. You can use it to update menus whose contents should vary. Since this hook is run frequently, we advise you to ensure that the functions it calls do not take much time in the usual case. @@ -2576,7 +2579,7 @@ in Documentation}. A @dfn{tool bar} is a row of clickable icons at the top of a frame, just below the menu bar. @xref{Tool Bars,,,emacs, The GNU Emacs -Manual}. +Manual}. Emacs normally shows a tool bar on graphical displays. On each frame, the frame parameter @code{tool-bar-lines} controls how many lines' worth of height to reserve for the tool bar. A zero @@ -2631,6 +2634,9 @@ Used when the item is disabled and deselected. @end table @end table +The GTK+ and NS versions of Emacs ignores items 1 to 3, because disabled and/or +deselected images are autocomputed from item 0. + If @var{image} is a single image specification, Emacs draws the tool bar button in disabled state by applying an edge-detection algorithm to the image. diff --git a/doc/lispref/lay-flat.texi b/doc/lispref/lay-flat.texi index f12e724d6a9..98c778ce7b9 100644 --- a/doc/lispref/lay-flat.texi +++ b/doc/lispref/lay-flat.texi @@ -1,12 +1,13 @@ \input texinfo @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c @comment %**start of header @setfilename inner-covers.info @settitle Inner Covers @smallbook +@documentencoding UTF-8 @comment %**end of header @headings off diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 14601de1814..ed18c038e85 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Lists @@ -270,8 +270,10 @@ are numbered starting with zero, so the @sc{car} of @var{list} is element number zero. If the length of @var{list} is @var{n} or less, the value is @code{nil}. -If @var{n} is negative, @code{nth} returns the first element of -@var{list}. +@c Behavior for -ve n undefined since 2013/08; see bug#15059. +@ignore +If @var{n} is negative, @code{nth} returns the first element of @var{list}. +@end ignore @example @group @@ -281,10 +283,6 @@ If @var{n} is negative, @code{nth} returns the first element of @group (nth 10 '(1 2 3 4)) @result{} nil -@end group -@group -(nth -3 '(1 2 3 4)) - @result{} 1 (nth n x) @equiv{} (car (nthcdr n x)) @end group @@ -300,7 +298,8 @@ This function returns the @var{n}th @sc{cdr} of @var{list}. In other words, it skips past the first @var{n} links of @var{list} and returns what follows. -If @var{n} is zero or negative, @code{nthcdr} returns all of +@c "or negative" removed 2013/08; see bug#15059. +If @var{n} is zero, @code{nthcdr} returns all of @var{list}. If the length of @var{list} is @var{n} or less, @code{nthcdr} returns @code{nil}. @@ -314,7 +313,7 @@ If @var{n} is zero or negative, @code{nthcdr} returns all of @result{} nil @end group @group -(nthcdr -3 '(1 2 3 4)) +(nthcdr 0 '(1 2 3 4)) @result{} (1 2 3 4) @end group @end example @@ -1045,6 +1044,7 @@ x1 @node Rearrangement @subsection Functions that Rearrange Lists @cindex rearrangement of lists +@cindex reordering, of elements in lists @cindex modification of lists Here are some functions that rearrange lists ``destructively'' by diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 51a060bc6c6..a07c2e8a792 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Loading @@ -29,6 +29,8 @@ into a buffer and evaluated there. (Indeed, most code is tested this way.) Most often, the forms are function definitions and variable definitions. +For on-demand loading of external libraries, @pxref{Dynamic Libraries}. + @menu * How Programs Do Loading:: The @code{load} function and others. * Load Suffixes:: Details about the suffixes that @code{load} tries. @@ -91,6 +93,10 @@ If the optional argument @var{must-suffix} is non-@code{nil}, then @samp{.el} or @samp{.elc} (possibly extended with a compression suffix), unless it contains an explicit directory name. +If the option @code{load-prefer-newer} is non-@code{nil}, then when +searching suffixes, @code{load} selects whichever version of a file +(@samp{.elc}, @samp{.el}, etc.) has been modified most recently. + If @var{filename} is a relative file name, such as @file{foo} or @file{baz/foo.bar}, @code{load} searches for the file using the variable @code{load-path}. It appends @var{filename} to each of the directories @@ -244,6 +250,12 @@ value of @code{(get-load-suffixes)} and then those in it skips the former group, and if @var{must-suffix} is non-@code{nil}, it skips the latter group. +@defopt load-prefer-newer +If this option is non-@code{nil}, then rather than stopping at the +first suffix that exists, @code{load} tests them all, and uses +whichever file is the newest. +@end defopt + @node Library Search @section Library Search @cindex library search @@ -253,37 +265,41 @@ it skips the latter group. in a list of directories specified by the variable @code{load-path}. @defvar load-path -@cindex @env{EMACSLOADPATH} environment variable The value of this variable is a list of directories to search when loading files with @code{load}. Each element is a string (which must be a directory name) or @code{nil} (which stands for the current working directory). @end defvar - Each time Emacs starts up, it sets up the value of @code{load-path} -in several steps. First, it initializes @code{load-path} to the -directories specified by the environment variable @env{EMACSLOADPATH}, -if that exists. The syntax of @env{EMACSLOADPATH} is the same as used -for @code{PATH}; directory names are separated by @samp{:} (or -@samp{;}, on some operating systems), and @samp{.} stands for the -current default directory. Here is an example of how to set -@env{EMACSLOADPATH} variable from @command{sh}: + When Emacs starts up, it sets up the value of @code{load-path} +in several steps. First, it initializes @code{load-path} using +default locations set when Emacs was compiled. Normally, this +is a directory something like @example -export EMACSLOADPATH -EMACSLOADPATH=/home/foo/.emacs.d/lisp:/opt/emacs/lisp +"/usr/local/share/emacs/@var{version}/lisp" @end example -@noindent -Here is how to set it from @code{csh}: +(In this and the following examples, replace @file{/usr/local} with +the installation prefix appropriate for your Emacs.) +These directories contain the standard Lisp files that come with +Emacs. If Emacs cannot find them, it will not start correctly. -@example -setenv EMACSLOADPATH /home/foo/.emacs.d/lisp:/opt/emacs/lisp -@end example +If you run Emacs from the directory where it was built---that is, an +executable that has not been formally installed---Emacs instead +initializes @code{load-path} using the @file{lisp} +directory in the directory containing the sources from which it +was built. +@c Though there should be no *.el files in builddir/lisp, so it's pointless. +If you built Emacs in a separate directory from the +sources, it also adds the lisp directories from the build directory. +(In all cases, elements are represented as absolute file names.) @cindex site-lisp directories - If @env{EMACSLOADPATH} is not set (which is usually the case), Emacs -initializes @code{load-path} with the following two directories: +Unless you start Emacs with the @option{--no-site-lisp} option, +it then adds two more @file{site-lisp} directories to the front of +@code{load-path}. These are intended for locally installed Lisp files, +and are normally of the form: @example "/usr/local/share/emacs/@var{version}/site-lisp" @@ -297,26 +313,54 @@ and @end example @noindent -The first one is for locally installed packages for a particular Emacs -version; the second is for locally installed packages meant for use -with all installed Emacs versions. +The first one is for locally installed files for a specific Emacs +version; the second is for locally installed files meant for use +with all installed Emacs versions. (If Emacs is running uninstalled, +it also adds @file{site-lisp} directories from the source and build +directories, if they exist. Normally these directories do not contain +@file{site-lisp} directories.) - If you run Emacs from the directory where it was built---that is, an -executable that has not been formally installed---Emacs puts two more -directories in @code{load-path}. These are the @code{lisp} and -@code{site-lisp} subdirectories of the main build directory. (Both -are represented as absolute file names.) +@cindex @env{EMACSLOADPATH} environment variable +If the environment variable @env{EMACSLOADPATH} is set, it modifies +the above initialization procedure. Emacs initializes +@code{load-path} based on the value of the environment variable. - Next, Emacs ``expands'' the initial list of directories in -@code{load-path} by adding the subdirectories of those directories. -Both immediate subdirectories and subdirectories multiple levels down -are added. But it excludes subdirectories whose names do not start -with a letter or digit, and subdirectories named @file{RCS} or -@file{CVS}, and subdirectories containing a file named -@file{.nosearch}. +The syntax of @env{EMACSLOADPATH} is the same as used for @code{PATH}; +directory names are separated by @samp{:} (or @samp{;}, on some +operating systems). +@ignore +@c AFAICS, does not (yet) work right to specify non-absolute elements. +and @samp{.} stands for the current default directory. +@end ignore +Here is an example of how to set @env{EMACSLOADPATH} variable (from a +@command{sh}-style shell): - Next, Emacs adds any extra load directory that you specify using the -@samp{-L} command-line option (@pxref{Action Arguments,,,emacs, The +@example +export EMACSLOADPATH=/home/foo/.emacs.d/lisp: +@end example + +An empty element in the value of the environment variable, whether +trailing (as in the above example), leading, or embedded, is replaced +by the default value of @code{load-path} as determined by the standard +initialization procedure. If there are no such empty elements, then +@env{EMACSLOADPATH} specifies the entire @code{load-path}. You must +include either an empty element, or the explicit path to the directory +containing the standard Lisp files, else Emacs will not function. +(Another way to modify @code{load-path} is to use the @option{-L} +command-line option when starting Emacs; see below.) + + For each directory in @code{load-path}, Emacs then checks to see if +it contains a file @file{subdirs.el}, and if so, loads it. The +@file{subdirs.el} file is created when Emacs is built/installed, +and contains code that causes Emacs to add any subdirectories of those +directories to @code{load-path}. Both immediate subdirectories and +subdirectories multiple levels down are added. But it excludes +subdirectories whose names do not start with a letter or digit, and +subdirectories named @file{RCS} or @file{CVS}, and subdirectories +containing a file named @file{.nosearch}. + + Next, Emacs adds any extra load directories that you specify using the +@option{-L} command-line option (@pxref{Action Arguments,,,emacs, The GNU Emacs Manual}). It also adds the directories where optional packages are installed, if any (@pxref{Packaging Basics}). @@ -327,12 +371,10 @@ add one or more directories to @code{load-path}. For example: (push "~/.emacs.d/lisp" load-path) @end example - Dumping Emacs uses a special value of @code{load-path}. If the -value of @code{load-path} at the end of dumping is unchanged (that is, -still the same special value), the dumped Emacs switches to the -ordinary @code{load-path} value when it starts up, as described above. -But if @code{load-path} has any other value at the end of dumping, -that value is used for execution of the dumped Emacs also. + Dumping Emacs uses a special value of @code{load-path}. If you use +a @file{site-load.el} or @file{site-init.el} file to customize the +dumped Emacs (@pxref{Building Emacs}), any changes to @code{load-path} +that these files make will be lost after dumping. @deffn Command locate-library library &optional nosuffix path interactive-call This command finds the precise file name for library @var{library}. It @@ -461,7 +503,7 @@ and calls @code{define-key}; not even if the variable name is the same symbol @var{function}. @cindex function cell in autoload -if @var{function} already has non-void function definition that is not +If @var{function} already has a non-void function definition that is not an autoload object, this function does nothing and returns @code{nil}. Otherwise, it constructs an autoload object (@pxref{Autoload Type}), and stores it as the function definition for @var{function}. The @@ -483,7 +525,7 @@ For example, @noindent In this case, @code{"prolog"} is the name of the file to load, 169681 refers to the documentation string in the -@file{emacs/etc/DOC-@var{version}} file (@pxref{Documentation Basics}), +@file{emacs/etc/DOC} file (@pxref{Documentation Basics}), @code{t} means the function is interactive, and @code{nil} that it is not a macro or a keymap. @end defun @@ -990,19 +1032,18 @@ file that was just loaded. @end defvar If you want code to be executed when a @emph{particular} library is -loaded, use the function @code{eval-after-load}: +loaded, use the macro @code{with-eval-after-load}: -@defun eval-after-load library form -This function arranges to evaluate @var{form} at the end of loading +@defmac with-eval-after-load library body@dots{} +This macro arranges to evaluate @var{body} at the end of loading the file @var{library}, each time @var{library} is loaded. If -@var{library} is already loaded, it evaluates @var{form} right away. -Don't forget to quote @var{form}! +@var{library} is already loaded, it evaluates @var{body} right away. You don't need to give a directory or extension in the file name @var{library}. Normally, you just give a bare file name, like this: @example -(eval-after-load "edebug" '(def-edebug-spec c-point t)) +(with-eval-after-load "edebug" (def-edebug-spec c-point t)) @end example To restrict which files can trigger the evaluation, include a @@ -1014,16 +1055,16 @@ example, @file{my_inst.elc} or @file{my_inst.elc.gz} in some directory @file{my_inst.el}: @example -(eval-after-load "foo/bar/my_inst.elc" @dots{}) +(with-eval-after-load "foo/bar/my_inst.elc" @dots{}) @end example @var{library} can also be a feature (i.e., a symbol), in which case -@var{form} is evaluated at the end of any file where +@var{body} is evaluated at the end of any file where @code{(provide @var{library})} is called. -An error in @var{form} does not undo the load, but does prevent -execution of the rest of @var{form}. -@end defun +An error in @var{body} does not undo the load, but does prevent +execution of the rest of @var{body}. +@end defmac Normally, well-designed Lisp programs should not use @code{eval-after-load}. If you need to examine and set the variables @@ -1031,18 +1072,3 @@ defined in another library (those meant for outside use), you can do it immediately---there is no need to wait until the library is loaded. If you need to call functions defined by that library, you should load the library, preferably with @code{require} (@pxref{Named Features}). - -@defvar after-load-alist -This variable stores an alist built by @code{eval-after-load}, -containing the expressions to evaluate when certain libraries are -loaded. Each element looks like this: - -@example -(@var{regexp-or-feature} @var{forms}@dots{}) -@end example - -The key @var{regexp-or-feature} is either a regular expression or a -symbol, and the value is a list of forms. The forms are evaluated -when the key matches the absolute true name or feature name of the -library being loaded. -@end defvar diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index 5520bbbd1df..9be12fa431b 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1995, 1998, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Macros @@ -55,6 +55,11 @@ expansion, which is @code{(setq x (1+ x))}. Once the macro definition returns this expansion, Lisp proceeds to evaluate it, thus incrementing @code{x}. +@defun macrop object +This predicate tests whether its argument is a macro, and returns +@code{t} if so, @code{nil} otherwise. +@end defun + @node Expansion @section Expansion of a Macro Call @cindex expansion of macros @@ -191,8 +196,8 @@ During Compile}). @section Defining Macros A Lisp macro object is a list whose @sc{car} is @code{macro}, and -whose @sc{cdr} is a lambda expression. Expansion of the macro works -by applying the lambda expression (with @code{apply}) to the list of +whose @sc{cdr} is a function. Expansion of the macro works +by applying the function (with @code{apply}) to the list of @emph{unevaluated} arguments from the macro call. It is possible to use an anonymous Lisp macro just like an anonymous diff --git a/doc/lispref/makefile.w32-in b/doc/lispref/makefile.w32-in index 00b938dbf68..01fe14944fd 100644 --- a/doc/lispref/makefile.w32-in +++ b/doc/lispref/makefile.w32-in @@ -1,6 +1,6 @@ # -*- Makefile -*- for the GNU Emacs Lisp Reference Manual. -# Copyright (C) 2003-2013 Free Software Foundation, Inc. +# Copyright (C) 2003-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -49,7 +49,6 @@ texinputdir = $(srcdir)\..\..\nt\envadd.bat \ srcs = \ $(emacsdir)/emacsver.texi \ $(srcdir)/abbrevs.texi \ - $(srcdir)/advice.texi \ $(srcdir)/anti.texi \ $(srcdir)/backups.texi \ $(srcdir)/buffers.texi \ diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi index d92f6a89f0a..14cbe72f67e 100644 --- a/doc/lispref/maps.texi +++ b/doc/lispref/maps.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1999, 2001-2013 Free Software Foundation, +@c Copyright (C) 1990-1993, 1999, 2001-2014 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Keymaps diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index cae14ab9a78..51b87ab1e5b 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Markers @@ -216,11 +216,14 @@ new marker that points to the same place and the same buffer as does The new marker's insertion type is specified by the argument @var{insertion-type}. @xref{Marker Insertion Types}. +@c This behavior used to be documented until 2013/08. +@ignore If passed an integer argument less than 1, @code{copy-marker} returns a new marker that points to the beginning of the current buffer. If passed an integer argument greater than the length of the buffer, @code{copy-marker} returns a new marker that points to the end of the buffer. +@end ignore @example @group @@ -279,6 +282,8 @@ This function returns the position that @var{marker} points to, or This function returns the buffer that @var{marker} points into, or @code{nil} if it points nowhere. +@c FIXME: The `buffer' argument of `set-marker' already defaults to +@c the current buffer, why use `(current-buffer)' explicitly here? @example @group (setq m (make-marker)) @@ -349,11 +354,15 @@ This function moves @var{marker} to @var{position} in @var{buffer}. If @var{buffer} is not provided, it defaults to the current buffer. +@c This behavior used to be documented until 2013/08. +@ignore If @var{position} is less than 1, @code{set-marker} moves @var{marker} to the beginning of the buffer. If @var{position} is greater than the size of the buffer (@pxref{Point}), @code{set-marker} moves marker to -the end of the buffer. If @var{position} is @code{nil} or a marker -that points nowhere, then @var{marker} is set to point nowhere. +the end of the buffer. +@end ignore +If @var{position} is @code{nil} or a marker that points nowhere, then +@var{marker} is set to point nowhere. The value returned is @var{marker}. @@ -384,7 +393,7 @@ This is another name for @code{set-marker}. @node The Mark @section The Mark @cindex mark, the -@cindex mark ring +@c @cindex the mark? Each buffer has a special marker, which is designated @dfn{the mark}. When a buffer is newly created, this marker exists but does @@ -423,6 +432,7 @@ the mark is active. This is the main motivation for using Transient Mark mode. (Another is that this enables highlighting of the region when the mark is active. @xref{Display}.) +@cindex mark ring In addition to the mark, each buffer has a @dfn{mark ring} which is a list of markers containing previous values of the mark. When editing commands change the mark, they should normally save the old value of the @@ -644,7 +654,12 @@ more marks than this are pushed onto the @code{mark-ring}, @node The Region @section The Region -@cindex region (between point and mark) +@c The index entry must be just ``region'' to make it the first hit +@c when the user types ``i region RET'', because otherwise the Info +@c reader will present substring matches in alphabetical order, +@c putting this one near the end, with something utterly unrelated as +@c the first hit. +@cindex region The text between point and the mark is known as @dfn{the region}. Various functions operate on text delimited by point and the mark, but @@ -668,6 +683,7 @@ integer). This is the position of either point or the mark, whichever is larger. @end defun +@c FIXME: Mention it in tips.texi? Instead of using @code{region-beginning} and @code{region-end}, a command designed to operate on a region should normally use @code{interactive} with the @samp{r} specification to find the @@ -680,6 +696,8 @@ mark is active, and there is a valid region in the buffer. This function is intended to be used by commands that operate on the region, instead of on text near point, when the mark is active. +@cindex empty region +@vindex use-empty-active-region A region is valid if it has a non-zero size, or if the user option @code{use-empty-active-region} is non-@code{nil} (by default, it is @code{nil}). The function @code{region-active-p} is similar to diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 9a1ec477b9f..d618912de8a 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Minibuffers @@ -211,25 +211,39 @@ This function works by calling the @end smallexample @end defun -@defun read-regexp prompt &optional default history +@defun read-regexp prompt &optional defaults history This function reads a regular expression as a string from the -minibuffer and returns it. The argument @var{prompt} is used as in -@code{read-from-minibuffer}. +minibuffer and returns it. If the minibuffer prompt string +@var{prompt} does not end in @samp{:} (followed by optional +whitespace), the function adds @samp{: } to the end, preceded by the +default return value (see below), if that is non-empty. -The optional argument @var{default} specifies a default value to -return if the user enters null input; it should be a string, or -@code{nil}, which is equivalent to an empty string. +The optional argument @var{defaults} controls the default value to +return if the user enters null input, and should be one of: a string; +@code{nil}, which is equivalent to an empty string; a list of strings; +or a symbol. -The optional argument @var{history}, if non-@code{nil}, is a symbol -specifying a minibuffer history list to use (@pxref{Minibuffer -History}). If it is omitted or @code{nil}, the history list defaults -to @code{regexp-history}. +If @var{defaults} is a symbol, @code{read-regexp} consults the value +of the variable @code{read-regexp-defaults-function} (see below), and +if that is non-@code{nil} uses it in preference to @var{defaults}. +The value in this case should be either: -@code{read-regexp} also collects a few useful candidates for input and -passes them to @code{read-from-minibuffer}, to make them available to -the user as the ``future minibuffer history list'' (@pxref{Minibuffer -History, future list,, emacs, The GNU Emacs Manual}). These -candidates are: +@itemize @minus +@item +@code{regexp-history-last}, which means to use the first element of +the appropriate minibuffer history list (see below). + +@item +A function of no arguments, whose return value (which should be +@code{nil}, a string, or a list of strings) becomes the value of +@var{defaults}. +@end itemize + +@code{read-regexp} now ensures that the result of processing +@var{defaults} is a list (i.e., if the value is @code{nil} or a +string, it converts it to a list of one element). To this list, +@code{read-regexp} then appends a few potentially useful candidates for +input. These are: @itemize @minus @item @@ -242,10 +256,37 @@ The last string used in an incremental search. The last string or pattern used in query-replace commands. @end itemize -This function works by calling the @code{read-from-minibuffer} -function, after computing the list of defaults as described above. +The function now has a list of regular expressions that it passes to +@code{read-from-minibuffer} to obtain the user's input. The first +element of the list is the default result in case of empty input. All +elements of the list are available to the user as the ``future +minibuffer history list'' (@pxref{Minibuffer History, future list,, +emacs, The GNU Emacs Manual}). + +The optional argument @var{history}, if non-@code{nil}, is a symbol +specifying a minibuffer history list to use (@pxref{Minibuffer +History}). If it is omitted or @code{nil}, the history list defaults +to @code{regexp-history}. @end defun +@defvar read-regexp-defaults-function +The function @code{read-regexp} may use the value of this variable to +determine its list of default regular expressions. If non-@code{nil}, +the value of this variable should be either: + +@itemize @minus +@item +The symbol @code{regexp-history-last}. + +@item +A function of no arguments that returns either @code{nil}, a string, +or a list of strings. +@end itemize + +@noindent +See @code{read-regexp} above for details of how these values are used. +@end defvar + @defvar minibuffer-allow-text-properties If this variable is @code{nil}, then @code{read-from-minibuffer} and @code{read-string} strip all text properties from the minibuffer @@ -889,6 +930,7 @@ Here is an example: @c FIXME? completion-table-with-context? @findex completion-table-case-fold @findex completion-table-in-turn +@findex completion-table-merge @findex completion-table-subvert @findex completion-table-with-quoting @findex completion-table-with-predicate @@ -897,9 +939,10 @@ Here is an example: @cindex completion tables, combining There are several functions that take an existing completion table and return a modified version. @code{completion-table-case-fold} returns -a case-insensitive table. @code{completion-table-in-turn} combines -multiple input tables. @code{completion-table-subvert} alters a table -to use a different initial prefix. @code{completion-table-with-quoting} +a case-insensitive table. @code{completion-table-in-turn} and +@code{completion-table-merge} combine multiple input tables in +different ways. @code{completion-table-subvert} alters a table to use +a different initial prefix. @code{completion-table-with-quoting} returns a table suitable for operating on quoted text. @code{completion-table-with-predicate} filters a table with a predicate function. @code{completion-table-with-terminator} adds a @@ -1099,7 +1142,7 @@ The list of completions is displayed as text in a buffer named @file{*Completions*}. @end deffn -@defun display-completion-list completions &optional common-substring +@defun display-completion-list completions This function displays @var{completions} to the stream in @code{standard-output}, usually a buffer. (@xref{Read and Print}, for more information about streams.) The argument @var{completions} is normally @@ -1110,13 +1153,6 @@ which is printed as if the strings were concatenated. The first of the two strings is the actual completion, the second string serves as annotation. -The argument @var{common-substring} is the prefix that is common to -all the completions. With normal Emacs completion, it is usually the -same as the string that was completed. @code{display-completion-list} -uses this to highlight text in the completion list for better visual -feedback. This is not needed in the minibuffer; for minibuffer -completion, you can pass @code{nil}. - This function is called by @code{minibuffer-completion-help}. A common way to use it is together with @code{with-output-to-temp-buffer}, like this: @@ -1124,8 +1160,7 @@ common way to use it is together with @example (with-output-to-temp-buffer "*Completions*" (display-completion-list - (all-completions (buffer-string) my-alist) - (buffer-string))) + (all-completions (buffer-string) my-alist))) @end example @end defun @@ -2224,12 +2259,6 @@ This is like @code{minibuffer-contents}, except that it does not copy text properties, just the characters themselves. @xref{Text Properties}. @end defun -@defun minibuffer-completion-contents -This is like @code{minibuffer-contents}, except that it returns only -the contents before point. That is the part that completion commands -operate on. @xref{Minibuffer Completion}. -@end defun - @defun delete-minibuffer-contents This function erases the editable contents of the minibuffer (that is, everything except the prompt), if a minibuffer is current. Otherwise, diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7d42d2591d6..df0dd1a58e0 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Modes @@ -69,11 +69,13 @@ functions are called with arguments, or their return values are used in some way. The hook's documentation says how the functions are called. You can use @code{add-hook} to add a function to an abnormal hook, but you must write the function to follow the hook's calling -convention. +convention. By convention, abnormal hook names end in @samp{-functions}. - By convention, abnormal hook names end in @samp{-functions}. If the -variable's name ends in @samp{-function}, then its value is just a single -function, not a list of functions. +@cindex single-function hook +If the variable's name ends in @samp{-function}, then its value is +just a single function, not a list of functions. @code{add-hook} cannot be +used to modify such a @emph{single function hook}, and you have to use +@code{add-function} instead (@pxref{Advising Functions}). @menu * Running Hooks:: How to run a hook. @@ -129,47 +131,6 @@ non-@code{nil} value, it returns that value; otherwise it returns @code{nil}. @end defun -@defmac with-wrapper-hook hook args &rest body -This macro runs the abnormal hook @code{hook} as a series of nested -``wrapper functions'' around the @var{body} forms. The effect is -similar to nested @code{around} advices (@pxref{Around-Advice}). - -Each hook function should accept an argument list consisting of a function -@var{fun}, followed by the additional arguments listed in @var{args}. -The first hook function is passed a function @var{fun} that, if it is -called with arguments @var{args}, performs @var{body} (i.e., the default -operation). The @var{fun} passed to each successive hook function is -constructed from all the preceding hook functions (and @var{body}); if -this @var{fun} is called with arguments @var{args}, it does what the -@code{with-wrapper-hook} call would if the preceding hook functions were -the only ones in @var{hook}. - -Each hook function may call its @var{fun} argument as many times as it -wishes, including never. In that case, such a hook function acts to -replace the default definition altogether, and any preceding hook -functions. Of course, a subsequent hook function may do the same thing. - -Each hook function definition is used to construct the @var{fun} passed -to the next hook function in @var{hook}, if any. The last or -``outermost'' @var{fun} is called once to produce the overall effect. - -When might you want to use a wrapper hook? The function -@code{filter-buffer-substring} illustrates a common case. There is a -basic functionality, performed by @var{body}---in this case, to extract -a buffer-substring. Then any number of hook functions can act in -sequence to modify that string, before returning the final result. -A wrapper-hook also allows for a hook function to completely replace the -default definition (by not calling @var{fun}). -@end defmac - -@defun run-hook-wrapped hook wrap-function &rest args -This function is similar to @code{run-hook-with-args-until-success}. -Like that function, it runs the functions on the abnormal hook -@code{hook}, stopping at the first one that returns non-@code{nil}. -Instead of calling the hook functions directly, though, it actually -calls @code{wrap-function} with arguments @code{fun} and @code{args}. -@end defun - @node Setting Hooks @subsection Setting Hooks @@ -646,10 +607,10 @@ mode command. The default value is @code{lisp-interaction-mode}. @defvar interpreter-mode-alist This variable specifies major modes to use for scripts that specify a command interpreter in a @samp{#!} line. Its value is an alist with -elements of the form @code{(@var{interpreter} . @var{mode})}; for -example, @code{("perl" . perl-mode)} is one element present by -default. The element says to use mode @var{mode} if the file -specifies an interpreter which matches @var{interpreter}. +elements of the form @code{(@var{regexp} . @var{mode})}; this says to +use mode @var{mode} if the file specifies an interpreter which matches +@code{\\`@var{regexp}\\'}. For example, one of the default elements +is @code{("python[0-9.]*" . python-mode)}. @end defvar @defvar magic-mode-alist @@ -1506,9 +1467,11 @@ designed for abbrevs and Auto Fill mode. Do not try substituting your own definition of @code{self-insert-command} for the standard one. The editor command loop handles this function specially.) -The key sequences bound in a minor mode should consist of @kbd{C-c} -followed by one of @kbd{.,/?`'"[]\|~!#$%^&*()-_+=}. (The other -punctuation characters are reserved for major modes.) +Minor modes may bind commands to key sequences consisting of @kbd{C-c} +followed by a punctuation character. However, sequences consisting of +@kbd{C-c} followed by one of @kbd{@{@}<>:;}, or a control character or +digit, are reserved for major modes. Also, @kbd{C-c @var{letter}} is +reserved for users. @xref{Key Binding Conventions}. @node Defining Minor Modes @subsection Defining Minor Modes @@ -1683,7 +1646,7 @@ minor modes don't need any. This defines a global toggle named @var{global-mode} whose meaning is to enable or disable the buffer-local minor mode @var{mode} in all buffers. To turn on the minor mode in a buffer, it uses the function -@var{turn-on}; to turn off the minor mode, it calls @code{mode} with +@var{turn-on}; to turn off the minor mode, it calls @var{mode} with @minus{}1 as argument. Globally enabling the mode also affects buffers subsequently created @@ -1800,7 +1763,7 @@ display of the text just as they would text in the buffer. Any characters which have no @code{face} properties are displayed, by default, in the face @code{mode-line} or @code{mode-line-inactive} (@pxref{Standard Faces,,, emacs, The GNU Emacs Manual}). The -@code{help-echo} and @code{local-map} properties in @var{string} have +@code{help-echo} and @code{keymap} properties in @var{string} have special meanings. @xref{Properties in Mode}. @item @var{symbol} @@ -2205,7 +2168,7 @@ The value of @code{global-mode-string}. Certain text properties are meaningful in the mode line. The @code{face} property affects the appearance of text; the @code{help-echo} property associates help strings with the text, and -@code{local-map} can make the text mouse-sensitive. +@code{keymap} can make the text mouse-sensitive. There are four ways to specify text properties for text in the mode line: @@ -2229,7 +2192,7 @@ structure, and make @var{form} evaluate to a string that has a text property. @end enumerate - You can use the @code{local-map} property to specify a keymap. This + You can use the @code{keymap} property to specify a keymap. This keymap only takes real effect for mouse clicks; binding character keys and function keys to it has no effect, since it is impossible to move point into the mode line. @@ -2483,7 +2446,7 @@ Selecting a special element performs: A nested sub-alist element looks like this: @example -(@var{menu-title} @var{sub-alist}) +(@var{menu-title} . @var{sub-alist}) @end example It creates the submenu @var{menu-title} specified by @var{sub-alist}. @@ -3381,6 +3344,7 @@ of Lisp sexps and adapts it to non-Lisp languages. @node SMIE @subsection Simple Minded Indentation Engine +@cindex SMIE SMIE is a package that provides a generic navigation and indentation engine. Based on a very simple parser using an ``operator precedence @@ -3548,6 +3512,8 @@ simply ignored. @node SMIE Grammar @subsubsection Defining the Grammar of a Language +@cindex SMIE grammar +@cindex grammar, SMIE The usual way to define the SMIE grammar of a language is by defining a new global variable that holds the precedence table by @@ -3623,6 +3589,8 @@ formally as left associative. @node SMIE Lexer @subsubsection Defining Tokens +@cindex SMIE lexer +@cindex defining tokens, SMIE SMIE comes with a predefined lexical analyzer which uses syntax tables in the following way: any sequence of characters that have word or @@ -3757,6 +3725,7 @@ surrounding text to find ad-hoc clues. @node SMIE Indentation @subsubsection Specifying Indentation Rules +@cindex indentation rules, SMIE Based on the provided grammar, SMIE will be able to provide automatic indentation without any extra effort. But in practice, this default diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index e462c3b4ce4..43766d5087a 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 1998-1999, 2001-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Non-ASCII Characters @chapter Non-@acronym{ASCII} Characters @@ -13,6 +13,7 @@ how they are stored in strings and buffers. @menu * Text Representations:: How Emacs represents text. +* Disabling Multibyte:: Controlling whether to use multibyte characters. * Converting Representations:: Converting unibyte to multibyte and vice versa. * Selecting a Representation:: Treating a byte sequence as unibyte or multi. * Character Codes:: How unibyte and multibyte relate to @@ -124,7 +125,8 @@ belong to the same character. @defun multibyte-string-p string Return @code{t} if @var{string} is a multibyte string, @code{nil} -otherwise. +otherwise. This function also returns @code{nil} if @var{string} is +some object other than a string. @end defun @defun string-bytes string @@ -139,6 +141,55 @@ This function concatenates all its argument @var{bytes} and makes the result a unibyte string. @end defun +@node Disabling Multibyte +@section Disabling Multibyte Characters +@cindex disabling multibyte + + By default, Emacs starts in multibyte mode: it stores the contents +of buffers and strings using an internal encoding that represents +non-@acronym{ASCII} characters using multi-byte sequences. Multibyte +mode allows you to use all the supported languages and scripts without +limitations. + +@cindex turn multibyte support on or off + Under very special circumstances, you may want to disable multibyte +character support, for a specific buffer. +When multibyte characters are disabled in a buffer, we call +that @dfn{unibyte mode}. In unibyte mode, each character in the +buffer has a character code ranging from 0 through 255 (0377 octal); 0 +through 127 (0177 octal) represent @acronym{ASCII} characters, and 128 +(0200 octal) through 255 (0377 octal) represent non-@acronym{ASCII} +characters. + + To edit a particular file in unibyte representation, visit it using +@code{find-file-literally}. @xref{Visiting Functions}. You can +convert a multibyte buffer to unibyte by saving it to a file, killing +the buffer, and visiting the file again with +@code{find-file-literally}. Alternatively, you can use @kbd{C-x +@key{RET} c} (@code{universal-coding-system-argument}) and specify +@samp{raw-text} as the coding system with which to visit or save a +file. @xref{Text Coding, , Specifying a Coding System for File Text, +emacs, GNU Emacs Manual}. Unlike @code{find-file-literally}, finding +a file as @samp{raw-text} doesn't disable format conversion, +uncompression, or auto mode selection. + +@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip. +@vindex enable-multibyte-characters +The buffer-local variable @code{enable-multibyte-characters} is +non-@code{nil} in multibyte buffers, and @code{nil} in unibyte ones. +The mode line also indicates whether a buffer is multibyte or not. +With a graphical display, in a multibyte buffer, the portion of the +mode line that indicates the character set has a tooltip that (amongst +other things) says that the buffer is multibyte. In a unibyte buffer, +the character set indicator is absent. Thus, in a unibyte buffer +(when using a graphical display) there is normally nothing before the +indication of the visited file's end-of-line convention (colon, +backslash, etc.), unless you are using an input method. + +@findex toggle-enable-multibyte-characters +You can turn off multibyte support in a specific buffer by invoking the +command @code{toggle-enable-multibyte-characters} in that buffer. + @node Converting Representations @section Converting Text Representations @@ -197,6 +248,7 @@ unibyte string, it is returned unchanged. Use this function for characters. @end defun +@c FIXME: Should `@var{character}' be `@var{byte}'? @defun byte-to-string byte @cindex byte to string This function returns a unibyte string containing a single byte of @@ -350,12 +402,14 @@ specifies how the character behaves and how it should be handled during text processing and display. Thus, character properties are an important part of specifying the character's semantics. +@c FIXME: Use the latest URI of this chapter? +@c http://www.unicode.org/versions/latest/ch04.pdf On the whole, Emacs follows the Unicode Standard in its implementation of character properties. In particular, Emacs supports the @uref{http://www.unicode.org/reports/tr23/, Unicode Character Property Model}, and the Emacs character property database is derived from the Unicode Character Database (@acronym{UCD}). See the -@uref{http://www.unicode.org/versions/Unicode5.0.0/ch04.pdf, Character +@uref{http://www.unicode.org/versions/Unicode6.2.0/ch04.pdf, Character Properties chapter of the Unicode Standard}, for a detailed description of Unicode character properties and their meaning. This section assumes you are already familiar with that chapter of the @@ -386,7 +440,7 @@ properties that Emacs knows about: Corresponds to the @code{Name} Unicode property. The value is a string consisting of upper-case Latin letters A to Z, digits, spaces, and hyphen @samp{-} characters. For unassigned codepoints, the value -is an empty string. +is @code{nil}. @cindex unicode general category @item general-category @@ -424,14 +478,14 @@ unassigned codepoints, the value is the character itself. @item decimal-digit-value Corresponds to the Unicode @code{Numeric_Value} property for -characters whose @code{Numeric_Type} is @samp{Digit}. The value is an -integer number. For unassigned codepoints, the value is @code{nil}, -which means @acronym{NaN}, or ``not-a-number''. +characters whose @code{Numeric_Type} is @samp{Decimal}. The value is +an integer number. For unassigned codepoints, the value is +@code{nil}, which means @acronym{NaN}, or ``not-a-number''. @item digit-value Corresponds to the Unicode @code{Numeric_Value} property for -characters whose @code{Numeric_Type} is @samp{Decimal}. The value is -an integer number. Examples of such characters include compatibility +characters whose @code{Numeric_Type} is @samp{Digit}. The value is an +integer number. Examples of such characters include compatibility subscript and superscript digits, for which the value is the corresponding number. For unassigned codepoints, the value is @code{nil}, which means @acronym{NaN}. @@ -468,7 +522,8 @@ is @code{nil}. @item old-name Corresponds to the Unicode @code{Unicode_1_Name} property. The value -is a string. For unassigned codepoints, the value is an empty string. +is a string. Unassigned codepoints, and characters that have no value +for this property, the value is @code{nil}. @item iso-10646-comment Corresponds to the Unicode @code{ISO_Comment} property. The value is @@ -497,11 +552,11 @@ This function returns the value of @var{char}'s @var{propname} property. @example @group -(get-char-code-property ? 'general-category) +(get-char-code-property ?\s 'general-category) @result{} Zs @end group @group -(get-char-code-property ?1 'general-category) +(get-char-code-property ?1 'general-category) @result{} Nd @end group @group @@ -554,6 +609,7 @@ property as a symbol. @end defvar @defvar char-script-table +@cindex script symbols The value of this variable is a char-table that specifies, for each character, a symbol whose name is the script to which the character belongs, according to the Unicode Standard classification of the @@ -630,6 +686,7 @@ which case the returned charset must be supported by that coding system (@pxref{Coding Systems}). @end defun +@c TODO: Explain the properties here and add indexes such as 'charset property'. @defun charset-plist charset This function returns the property list of the character set @var{charset}. Although @var{charset} is a symbol, this is not the @@ -795,6 +852,8 @@ systems specifies its own translation tables, the table that is the value of this variable, if non-@code{nil}, is applied after them. @end defvar +@c FIXME: This variable is obsolete since 23.1. We should mention +@c that here or simply remove this defvar. --xfq @defvar translation-table-for-input Self-inserting characters are translated through this translation table before they are inserted. Search commands also translate their @@ -903,7 +962,8 @@ Unix convention, used on GNU and Unix systems, is to use the linefeed character (also called newline). The DOS convention, used on MS-Windows and MS-DOS systems, is to use a carriage-return and a linefeed at the end of a line. The Mac convention is to use just -carriage-return. +carriage-return. (This was the convention used on the Macintosh +system prior to OS X.) @cindex base coding system @cindex variant coding system @@ -961,6 +1021,7 @@ The value of the @code{:mime-charset} property is also defined as an alias for the coding system. @end defun +@cindex alias, for coding systems @defun coding-system-aliases coding-system This function returns the list of aliases of @var{coding-system}. @end defun @@ -1046,6 +1107,16 @@ visited file name, saving may use the wrong file name, or it may get an error. If such a problem happens, use @kbd{C-x C-w} to specify a new file name for that buffer. +@cindex file-name encoding, MS-Windows + On Windows 2000 and later, Emacs by default uses Unicode APIs to +pass file names to the OS, so the value of +@code{file-name-coding-system} is largely ignored. Lisp applications +that need to encode or decode file names on the Lisp level should use +@code{utf-8} coding-system when @code{system-type} is +@code{windows-nt}; the conversion of UTF-8 encoded file names to the +encoding appropriate for communicating with the OS is performed +internally by Emacs. + @node Lisp and Coding Systems @subsection Coding Systems in Lisp @@ -1216,17 +1287,18 @@ Sets}) supported by @var{coding-system}. Some coding systems that support too many character sets to list them all yield special values: @itemize @bullet @item -If @var{coding-system} supports all the ISO-2022 charsets, the value -is @code{iso-2022}. -@item If @var{coding-system} supports all Emacs characters, the value is @code{(emacs)}. @item -If @var{coding-system} supports all emacs-mule characters, the value -is @code{emacs-mule}. -@item If @var{coding-system} supports all Unicode characters, the value is @code{(unicode)}. +@item +If @var{coding-system} supports all ISO-2022 charsets, the value is +@code{iso-2022}. +@item +If @var{coding-system} supports all the characters in the internal +coding system used by Emacs version 21 (prior to the implementation of +internal Unicode support), the value is @code{emacs-mule}. @end itemize @end defun @@ -1511,7 +1583,7 @@ the alist; otherwise it returns @code{nil}. If @var{operation} is @code{insert-file-contents}, the argument corresponding to the target may be a cons cell of the form -@code{(@var{filename} . @var{buffer})}). In that case, @var{filename} +@code{(@var{filename} . @var{buffer})}. In that case, @var{filename} is a file name to look up in @code{file-coding-system-alist}, and @var{buffer} is a buffer that contains the file's contents (not yet decoded). If @code{file-coding-system-alist} specifies a function to @@ -1544,8 +1616,7 @@ of the right way to use the variable: @example ;; @r{Read the file with no character code conversion.} -;; @r{Assume @acronym{crlf} represents end-of-line.} -(let ((coding-system-for-read 'emacs-mule-dos)) +(let ((coding-system-for-read 'no-conversion)) (insert-file-contents filename)) @end example @@ -1734,24 +1805,23 @@ decoding, you can call this function. @node Terminal I/O Encoding @subsection Terminal I/O Encoding - Emacs can decode keyboard input using a coding system, and encode + Emacs can use coding systems to decode keyboard input and encode terminal output. This is useful for terminals that transmit or -display text using a particular encoding such as Latin-1. Emacs does -not set @code{last-coding-system-used} for encoding or decoding of +display text using a particular encoding, such as Latin-1. Emacs does +not set @code{last-coding-system-used} when encoding or decoding terminal I/O. @defun keyboard-coding-system &optional terminal -This function returns the coding system that is in use for decoding -keyboard input from @var{terminal}---or @code{nil} if no coding system -is to be used for that terminal. If @var{terminal} is omitted or -@code{nil}, it means the selected frame's terminal. @xref{Multiple -Terminals}. +This function returns the coding system used for decoding keyboard +input from @var{terminal}. A value of @code{no-conversion} means no +decoding is done. If @var{terminal} is omitted or @code{nil}, it +means the selected frame's terminal. @xref{Multiple Terminals}. @end defun @deffn Command set-keyboard-coding-system coding-system &optional terminal This command specifies @var{coding-system} as the coding system to use for decoding keyboard input from @var{terminal}. If -@var{coding-system} is @code{nil}, that means do not decode keyboard +@var{coding-system} is @code{nil}, that means not to decode keyboard input. If @var{terminal} is a frame, it means that frame's terminal; if it is @code{nil}, that means the currently selected frame's terminal. @xref{Multiple Terminals}. @@ -1759,18 +1829,19 @@ terminal. @xref{Multiple Terminals}. @defun terminal-coding-system &optional terminal This function returns the coding system that is in use for encoding -terminal output from @var{terminal}---or @code{nil} if the output is -not encoded. If @var{terminal} is a frame, it means that frame's -terminal; if it is @code{nil}, that means the currently selected -frame's terminal. +terminal output from @var{terminal}. A value of @code{no-conversion} +means no encoding is done. If @var{terminal} is a frame, it means +that frame's terminal; if it is @code{nil}, that means the currently +selected frame's terminal. @end defun @deffn Command set-terminal-coding-system coding-system &optional terminal This command specifies @var{coding-system} as the coding system to use for encoding terminal output from @var{terminal}. If -@var{coding-system} is @code{nil}, terminal output is not encoded. If -@var{terminal} is a frame, it means that frame's terminal; if it is -@code{nil}, that means the currently selected frame's terminal. +@var{coding-system} is @code{nil}, that means not to encode terminal +output. If @var{terminal} is a frame, it means that frame's terminal; +if it is @code{nil}, that means the currently selected frame's +terminal. @end deffn @node Input Methods diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index eeebac6bf72..2e8fefed1c5 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Numbers @@ -354,9 +354,9 @@ can have just one integer object for any given value because it has a limited range of integer values. @end quotation -@defun = number-or-marker1 number-or-marker2 -This function tests whether its arguments are numerically equal, and -returns @code{t} if so, @code{nil} otherwise. +@defun = number-or-marker &rest number-or-markers +This function tests whether all its arguments are numerically equal, +and returns @code{t} if so, @code{nil} otherwise. @end defun @defun eql value1 value2 @@ -371,26 +371,27 @@ This function tests whether its arguments are numerically equal, and returns @code{t} if they are not, and @code{nil} if they are. @end defun -@defun < number-or-marker1 number-or-marker2 -This function tests whether its first argument is strictly less than -its second argument. It returns @code{t} if so, @code{nil} otherwise. -@end defun - -@defun <= number-or-marker1 number-or-marker2 -This function tests whether its first argument is less than or equal -to its second argument. It returns @code{t} if so, @code{nil} +@defun < number-or-marker &rest number-or-markers +This function tests whether every argument is strictly less than the +respective next argument. It returns @code{t} if so, @code{nil} otherwise. @end defun -@defun > number-or-marker1 number-or-marker2 -This function tests whether its first argument is strictly greater -than its second argument. It returns @code{t} if so, @code{nil} +@defun <= number-or-marker &rest number-or-markers +This function tests whether every argument is less than or equal to +the respective next argument. It returns @code{t} if so, @code{nil} otherwise. @end defun -@defun >= number-or-marker1 number-or-marker2 -This function tests whether its first argument is greater than or -equal to its second argument. It returns @code{t} if so, @code{nil} +@defun > number-or-marker &rest number-or-markers +This function tests whether every argument is strictly greater than +the respective next argument. It returns @code{t} if so, @code{nil} +otherwise. +@end defun + +@defun >= number-or-marker &rest number-or-markers +This function tests whether every argument is greater than or equal to +the respective next argument. It returns @code{t} if so, @code{nil} otherwise. @end defun @@ -446,7 +447,7 @@ may be integers or floating point numbers. @var{divisor} may also be functions convert @var{number} to an integer, or return it unchanged if it already is an integer. If @var{divisor} is non-@code{nil}, they divide @var{number} by @var{divisor} and convert the result to an -integer. integer. If @var{divisor} is zero (whether integer or +integer. If @var{divisor} is zero (whether integer or floating-point), Emacs signals an @code{arith-error} error. @defun truncate number &optional divisor @@ -1156,11 +1157,6 @@ This function returns the logarithm of @var{arg}, with base returns a NaN. @end defun -@defun log10 arg -This function returns the logarithm of @var{arg}, with base 10: -@code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}. -@end defun - @defun expt x y This function returns @var{x} raised to power @var{y}. If both arguments are integers and @var{y} is positive, the result is an diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 0437d2337a3..cfd906ba397 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Lisp Data Types @@ -565,8 +565,8 @@ Lisp, upper case and lower case letters are distinct. @end quotation Here are several examples of symbol names. Note that the @samp{+} in -the fifth example is escaped to prevent it from being read as a number. -This is not necessary in the fourth example because the rest of the name +the fourth example is escaped to prevent it from being read as a number. +This is not necessary in the sixth example because the rest of the name makes it invalid as a number. @example @@ -1301,7 +1301,7 @@ called @dfn{subrs} or @dfn{built-in functions}. (The word ``subr'' is derived from ``subroutine''.) Most primitive functions evaluate all their arguments when they are called. A primitive function that does not evaluate all its arguments is called a @dfn{special form} -(@pxref{Special Forms}).@refill +(@pxref{Special Forms}). It does not matter to the caller of a function whether the function is primitive. However, this does matter if you try to redefine a primitive diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index b481c330f9f..cff0b2b15c5 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node System Interface @@ -34,7 +34,8 @@ terminal and the screen. * X11 Keysyms:: Operating on key symbols for X Windows. * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. @end menu @@ -70,11 +71,12 @@ in their turn. The files @file{subdirs.el} are normally generated automatically when Emacs is installed. @item -If the library @file{leim-list.el} exists, Emacs loads it. This -optional library is intended for registering input methods; Emacs -looks for it in @code{load-path} (@pxref{Library Search}), skipping -those directories containing the standard Emacs libraries (since -@file{leim-list.el} should not exist in those directories). +It loads any @file{leim-list.el} that it finds in the @code{load-path} +directories. This file is intended for registering input methods. +The search is only for any personal @file{leim-list.el} files that you +may have created; it skips the directories containing the standard Emacs +libraries (these should contain only a single @file{leim-list.el} file, +which is compiled into the Emacs executable). @vindex before-init-time @item @@ -193,7 +195,9 @@ It now exits if the option @code{--batch} was specified. @item If @code{initial-buffer-choice} is a string, it visits the file with -that name. If the @file{*scratch*} buffer exists and is +that name. If it is a function, it calls the function and selects the +buffer returned by the function. It it is @code{t}, it selects the +@file{*scratch*} buffer. If the @file{*scratch*} buffer exists and is empty, it inserts @code{initial-scratch-message} into that buffer. @c To make things nice and confusing, the next three items can be @@ -217,6 +221,7 @@ specify. It runs @code{window-setup-hook}. @xref{Window Systems}. @item +@cindex startup screen It displays the @dfn{startup screen}, which is a special buffer that contains information about copyleft and basic Emacs usage. This is not done if @code{inhibit-startup-screen} or @code{initial-buffer-choice} @@ -268,11 +273,9 @@ aliases for this variable. If non-@code{nil}, this variable is a string that specifies a file or directory for Emacs to display after starting up, instead of the startup screen. -@ignore -@c I do not think this should be mentioned. AFAICS it is just a dodge -@c around inhibit-startup-screen not being settable on a site-wide basis. +If its value is a function, Emacs calls that function which must +return a buffer which is then displayed. If its value is @code{t}, Emacs displays the @file{*scratch*} buffer. -@end ignore @end defopt @defopt inhibit-startup-echo-area-message @@ -315,7 +318,7 @@ Run without an interactive terminal. @xref{Batch Mode}. Do not initialize any display; just start a server in the background. @item --no-init-file -@itemx -Q +@itemx -q Do not load either the init file, or the @file{default} library. @item --no-site-file @@ -515,9 +518,10 @@ displays the startup messages. The value of this variable is @code{t} once the command line has been processed. -If you redump Emacs by calling @code{dump-emacs}, you may wish to set -this variable to @code{nil} first in order to cause the new dumped Emacs -to process its new command-line arguments. +If you redump Emacs by calling @code{dump-emacs} (@pxref{Building +Emacs}), you may wish to set this variable to @code{nil} first in +order to cause the new dumped Emacs to process its new command-line +arguments. @end defvar @defvar command-switch-alist @@ -549,8 +553,8 @@ sole argument. In some cases, the option is followed in the command line by an argument. In these cases, the @var{handler-function} can find all the remaining command-line arguments in the variable -@code{command-line-args-left}. (The entire list of command-line -arguments is in @code{command-line-args}.) +@code{command-line-args-left} (see below). (The entire list of +command-line arguments is in @code{command-line-args}.) The command-line arguments are parsed by the @code{command-line-1} function in the @file{startup.el} file. See also @ref{Emacs @@ -958,6 +962,7 @@ to access the value of @var{variable}. If @var{value} is omitted or removes @var{variable} from the environment. Otherwise, @var{value} should be a string. +@c FIXME: Document `substitute-env-vars'? --xfq If the optional argument @var{substitute} is non-@code{nil}, Emacs calls the function @code{substitute-env-vars} to expand any environment variables in @var{value}. @@ -1094,9 +1099,9 @@ originally logged in. The value reflects command-line options such as Lisp packages that load files of customizations, or any other sort of user profile, should obey this variable in deciding where to find it. They should load the profile of the user name found in this variable. -If @code{init-file-user} is @code{nil}, meaning that the @samp{-q} -option was used, then Lisp packages should not load any customization -files or user profile. +If @code{init-file-user} is @code{nil}, meaning that the @samp{-q}, +@samp{-Q}, or @samp{-batch} option was used, then Lisp packages should +not load any customization files or user profile. @end defvar @defopt user-mail-address @@ -1146,6 +1151,7 @@ you to ``fake out'' Emacs by telling the functions what to return. The variables are also useful for constructing frame titles (@pxref{Frame Titles}). +@cindex UID @defun user-real-uid This function returns the real @acronym{UID} of the user. The value may be a floating point number, in the (unlikely) event that @@ -1157,6 +1163,7 @@ This function returns the effective @acronym{UID} of the user. The value may be a floating point number. @end defun +@cindex GID @defun group-gid This function returns the effective @acronym{GID} of the Emacs process. The value may be a floating point number. @@ -1216,9 +1223,9 @@ file-attributes}). In function arguments, e.g., the @var{time-value} argument to @code{current-time-string}, two-, three-, and four-integer lists are accepted. You can convert times from the list representation into standard human-readable strings using -@code{current-time}, or to other forms using the @code{decode-time} -and @code{format-time-string} functions documented in the following -sections. +@code{current-time-string}, or to other forms using the +@code{decode-time} and @code{format-time-string} functions documented +in the following sections. @defun current-time-string &optional time-value This function returns the current time and date as a human-readable @@ -1262,6 +1269,7 @@ exact. Do not use this function if precise time stamps are required. @end defun @defun current-time-zone &optional time-value +@cindex time zone, current This function returns a list describing the time zone that the user is in. @@ -1288,6 +1296,7 @@ time zone. @node Time Conversion @section Time Conversion +@cindex calendrical information These functions convert time values (lists of two to four integers, as explained in the previous section) into calendrical information and @@ -1516,7 +1525,7 @@ system. @defun seconds-to-time seconds This function converts @var{seconds}, a floating point number of seconds since the epoch, to a time value and returns that. To perform -the inverse conversion, use @code{float-time}. +the inverse conversion, use @code{float-time} (@pxref{Time of Day}). @end defun @defun format-seconds format-string seconds @@ -1578,6 +1587,7 @@ most-positive-fixnum}). both elapsed and processor time, used by the Emacs process. @deffn Command emacs-uptime &optional format +@cindex uptime of Emacs This function returns a string representing the Emacs @dfn{uptime}---the elapsed wall-clock time this instance of Emacs is running. The string is formatted by @code{format-seconds} according @@ -1914,10 +1924,10 @@ functions. @defun set-input-mode interrupt flow meta &optional quit-char This function sets the mode for reading keyboard input. If -@var{interrupt} is non-null, then Emacs uses input interrupts. If it is -@code{nil}, then it uses @sc{cbreak} mode. The default setting is -system-dependent. Some systems always use @sc{cbreak} mode regardless -of what is specified. +@var{interrupt} is non-@code{nil}, then Emacs uses input interrupts. +If it is @code{nil}, then it uses @sc{cbreak} mode. The default +setting is system-dependent. Some systems always use @sc{cbreak} mode +regardless of what is specified. When Emacs communicates directly with X, it ignores this argument and uses interrupts if that is the way it knows how to communicate. @@ -2067,17 +2077,17 @@ often than to actual Emacs bugs. Once you are certain which characters were actually output, you can determine reliably whether they correspond to the Termcap specifications in use. -You close the termscript file by calling this function with an -argument of @code{nil}. - -See also @code{open-dribble-file} in @ref{Recording Input}. - @example @group (open-termscript "../junk/termscript") @result{} nil @end group @end example + +You close the termscript file by calling this function with an +argument of @code{nil}. + +See also @code{open-dribble-file} in @ref{Recording Input}. @end deffn @node Sound Output @@ -2088,6 +2098,7 @@ See also @code{open-dribble-file} in @ref{Recording Input}. certain systems are supported; if you call @code{play-sound} on a system which cannot really do the job, it gives an error. +@c FIXME: Add indexes for Au and WAV? --xfq The sound must be stored as a file in RIFF-WAVE format (@samp{.wav}) or Sun Audio format (@samp{.au}). @@ -2234,6 +2245,7 @@ saved session to restore. For Emacs, this argument is @samp{--smid @var{session}}. @defvar emacs-save-session-functions +@cindex session file Emacs supports saving state via a hook called @code{emacs-save-session-functions}. Emacs runs this hook when the session manager tells it that the window system is shutting down. The @@ -2270,14 +2282,16 @@ Emacs is restarted by the session manager. @end group @end example -@node Notifications +@node Desktop Notifications @section Desktop Notifications @cindex desktop notifications +@cindex notifications, on desktop Emacs is able to send @dfn{notifications} on systems that support the freedesktop.org Desktop Notifications Specification. In order to use this functionality, Emacs must have been compiled with D-Bus support, -and the @code{notifications} library must be loaded. +and the @code{notifications} library must be loaded. @xref{Top, , +D-Bus,dbus,D-Bus integration in Emacs}. @defun notifications-notify &rest params This function sends a notification to the desktop via D-Bus, @@ -2510,6 +2524,157 @@ If @var{SPEC_VERSION} is @code{nil}, the server supports a specification prior to @samp{"1.0"}. @end defun +@node File Notifications +@section Notifications on File Changes +@cindex file notifications +@cindex watch, for filesystem events + +Several operating systems support watching of filesystems for changes +of files. If configured properly, Emacs links a respective library +like @file{gfilenotify}, @file{inotify}, or @file{w32notify} +statically. These libraries enable watching of filesystems on the +local machine. + +It is also possible to watch filesystems on remote machines, +@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} +This does not depend on one of the libraries linked to Emacs. + +Since all these libraries emit different events on notified file +changes, there is the Emacs library @code{filenotify} which provides a +unique interface. + +@defun file-notify-add-watch file flags callback +Add a watch for filesystem events pertaining to @var{file}. This +arranges for filesystem events pertaining to @var{file} to be reported +to Emacs. + +The returned value is a descriptor for the added watch. Its type +depends on the underlying library, it cannot be assumed to be an +integer as in the example below. It should be used for comparison by +@code{equal} only. + +If the @var{file} cannot be watched for some reason, this function +signals a @code{file-notify-error} error. + +Sometimes, mounted filesystems cannot be watched for file changes. +This is not detected by this function, a non-@code{nil} return value +does not guarantee that changes on @var{file} will be notified. + +@var{flags} is a list of conditions to set what will be watched for. +It can include the following symbols: + +@table @code +@item change +watch for file changes +@item attribute-change +watch for file attribute changes, like permissions or modification +time +@end table + +If @var{file} is a directory, changes for all files in that directory +will be notified. This does not work recursively. + +When any event happens, Emacs will call the @var{callback} function +passing it a single argument @var{event}, which is of the form + +@lisp +(@var{descriptor} @var{action} @var{file} [@var{file1}]) +@end lisp + +@var{descriptor} is the same object as the one returned by this +function. @var{action} is the description of the event. It could be +any one of the following symbols: + +@table @code +@item created +@var{file} was created +@item deleted +@var{file} was deleted +@item changed +@var{file} has changed +@item renamed +@var{file} has been renamed to @var{file1} +@item attribute-changed +a @var{file} attribute was changed +@end table + +@var{file} and @var{file1} are the name of the file(s) whose event is +being reported. For example: + +@example +@group +(require 'filenotify) + @result{} filenotify +@end group + +@group +(defun my-notify-callback (event) + (message "Event %S" event)) + @result{} my-notify-callback +@end group + +@group +(file-notify-add-watch + "/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025468 +@end group + +@group +(write-region "foo" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 created "/tmp/foo") + Event (35025468 changed "/tmp/foo") + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(write-region "bla" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 changed "/tmp/foo") [2 times] + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(set-file-modes "/tmp/foo" (default-file-modes)) + @result{} Event (35025468 attribute-changed "/tmp/foo") +@end group +@end example + +Whether the action @code{renamed} is returned, depends on the used +watch library. It can be expected, when a directory is watched, and +both @var{file} and @var{file1} belong to this directory. Otherwise, +the actions @code{deleted} and @code{created} could be returned in a +random order. + +@example +@group +(rename-file "/tmp/foo" "/tmp/bla") + @result{} Event (35025468 renamed "/tmp/foo" "/tmp/bla") +@end group + +@group +(file-notify-add-watch + "/var/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025504 +@end group + +@group +(rename-file "/tmp/bla" "/var/tmp/bla") + @result{} ;; gfilenotify + Event (35025468 renamed "/tmp/bla" "/var/tmp/bla") + + @result{} ;; inotify + Event (35025504 created "/var/tmp/bla") + Event (35025468 deleted "/tmp/bla") +@end group +@end example +@end defun + +@defun file-notify-rm-watch descriptor +Removes an existing file watch specified by its @var{descriptor}. +@var{descriptor} should be an object returned by +@code{file-notify-add-watch}. +@end defun @node Dynamic Libraries @section Dynamically Loaded Libraries diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index ad9f4fc1aea..4bc50b2358f 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2010-2013 Free Software Foundation, Inc. +@c Copyright (C) 2010-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Packaging @chapter Preparing Lisp code for distribution @@ -141,7 +141,8 @@ the various headers, as illustrated by the following example: ;; Author: J. R. Hacker ;; Version: 1.3 ;; Package-Requires: ((flange "1.0")) -;; Keywords: frobnicate +;; Keywords: multimedia, frobnicate +;; URL: http://example.com/jrhacker/superfrobnicate @dots{} @@ -177,6 +178,11 @@ on the @samp{flange} package, version 1.0 or higher. @xref{Library Headers}, for a description of the @samp{Package-Requires} header. If the header is omitted, the package has no dependencies. + The @samp{Keywords} and @samp{URL} headers are optional, but recommended. +The command @code{describe-package} uses these to add links to its +output. The @samp{Keywords} header should contain at least one +standard keyword from the @code{finder-known-keywords} list. + The file ought to also contain one or more autoload magic comments, as explained in @ref{Packaging Basics}. In the above example, a magic comment autoloads @code{superfrobnicator-mode}. @@ -265,7 +271,7 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: Via the Package Menu, users may download packages from @dfn{package archives}. Such archives are specified by the variable @code{package-archives}, whose default value contains a single entry: -the archive hosted by the GNU project at @url{elpa.gnu.org}. This +the archive hosted by the GNU project at @url{http://elpa.gnu.org}. This section describes how to set up and maintain a package archive. @cindex base location, package archive diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index e8b6166f63c..f83173e2038 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1,10 +1,11 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Positions @chapter Positions @cindex position (in buffer) +@cindex buffer position A @dfn{position} is the index of a character in the text of a buffer. More precisely, a position identifies the place between two characters @@ -146,9 +147,13 @@ that. @deffn Command goto-char position This function sets point in the current buffer to the value -@var{position}. If @var{position} is less than 1, it moves point to the -beginning of the buffer. If @var{position} is greater than the length -of the buffer, it moves point to the end. +@var{position}. +@c This behavior used to be documented until 2013/08. +@ignore +If @var{position} is less than 1, it moves point to the beginning of +the buffer. If @var{position} is greater than the length of the +buffer, it moves point to the end. +@end ignore If narrowing is in effect, @var{position} still counts from the beginning of the buffer, but point cannot go outside the accessible @@ -191,8 +196,8 @@ whether a given character is part of a word. @xref{Syntax Tables}. @deffn Command forward-word &optional count This function moves point forward @var{count} words (or backward if -@var{count} is negative). If @var{count} is @code{nil}, it moves -forward one word. +@var{count} is negative). If @var{count} is omitted or @code{nil}, it +defaults to 1. ``Moving one word'' means moving until point crosses a word-constituent character and then encounters a word-separator @@ -210,7 +215,7 @@ If @code{inhibit-field-text-motion} is non-@code{nil}, this function ignores field boundaries. In an interactive call, @var{count} is specified by the numeric prefix -argument. If @var{count} is omitted or @code{nil}, it defaults to 1. +argument. @end deffn @deffn Command backward-word &optional count @@ -481,9 +486,11 @@ flag, and display table may vary between windows). @xref{Usual Display}. These functions scan text to determine where screen lines break, and -thus take time proportional to the distance scanned. If you intend to -use them heavily, Emacs provides caches which may improve the -performance of your code. @xref{Truncation, cache-long-line-scans}. +thus take time proportional to the distance scanned. +@ignore +If you intend to use them heavily, Emacs provides caches which may +improve the performance of your code. @xref{Truncation, cache-long-scans}. +@end ignore @defun vertical-motion count &optional window This function moves point to the start of the screen line @var{count} @@ -805,7 +812,7 @@ thousands of times in the Lisp sources of Emacs. buffer, use @code{save-current-buffer} or @code{with-current-buffer} instead (@pxref{Current Buffer}). If you need to save or restore window configurations, see the forms described in @ref{Window -Configurations} and in @ref{Frame Configurations}. +Configurations} and in @ref{Frame Configurations}. @c frameset? @defspec save-excursion body@dots{} @cindex mark excursion diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 1181244a974..f149725b082 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Processes @@ -112,7 +112,7 @@ described below. argument that specifies where the standard output from the program will go. It should be a buffer or a buffer name; if it is a buffer name, that will create the buffer if it does not already exist. It can also -be @code{nil}, which says to discard the output unless a filter function +be @code{nil}, which says to discard the output, unless a custom filter function handles it. (@xref{Filter Functions}, and @ref{Read and Print}.) Normally, you should avoid having multiple processes send output to the same buffer because their output would be intermixed randomly. @@ -696,7 +696,7 @@ but not necessarily right away. You can delete a process explicitly at any time. If you explicitly delete a terminated process before it is deleted automatically, no harm results. Deleting a running process sends a signal to terminate it (and its child processes, if -any), and calls the process sentinel if it has one. @xref{Sentinels}. +any), and calls the process sentinel. @xref{Sentinels}. When a process is deleted, the process object itself continues to exist as long as other Lisp objects point to it. All the Lisp @@ -719,7 +719,7 @@ signal. The argument may be a process, the name of a process, a buffer, or the name of a buffer. (A buffer or buffer-name stands for the process that @code{get-buffer-process} returns.) Calling @code{delete-process} on a running process terminates it, updates the -process status, and runs the sentinel (if any) immediately. If the +process status, and runs the sentinel immediately. If the process has already terminated, calling @code{delete-process} has no effect on its status, or on the running of its sentinel (which will happen sooner or later). @@ -1130,12 +1130,12 @@ children of Emacs. @xref{System Processes}. @cindex process output @cindex output from processes - There are two ways to receive the output that a subprocess writes to -its standard output stream. The output can be inserted in a buffer, -which is called the associated buffer of the process (@pxref{Process -Buffers}), or a function called the @dfn{filter function} can be -called to act on the output. If the process has no buffer and no -filter function, its output is discarded. + The output that a subprocess writes to its standard output stream +is passed to a function called the @dfn{filter function}. The default +filter function simply inserts the output into a buffer, which is +called the associated buffer of the process (@pxref{Process +Buffers}). If the process has no buffer then the default filter +discards the output. When a subprocess terminates, Emacs reads any pending output, then stops reading output from that subprocess. Therefore, if the @@ -1170,7 +1170,7 @@ redirect one of them to a file---for example, by using an appropriate shell command. @menu -* Process Buffers:: If no filter, output is put in a buffer. +* Process Buffers:: By default, output is put in a buffer. * Filter Functions:: Filter functions accept output from the process. * Decoding Output:: Filters can get unibyte or multibyte strings. * Accepting Output:: How to wait until process output arrives. @@ -1187,11 +1187,12 @@ normal practice only one process is associated with any given buffer. Many applications of processes also use the buffer for editing input to be sent to the process, but this is not built into Emacs Lisp. - Unless the process has a filter function (@pxref{Filter Functions}), -its output is inserted in the associated buffer. The position to insert -the output is determined by the @code{process-mark}, which is then -updated to point to the end of the text just inserted. Usually, but not -always, the @code{process-mark} is at the end of the buffer. + By default, process output is inserted in the associated buffer. +(You can change this by defining a custom filter function, +@pxref{Filter Functions}.) The position to insert the output is +determined by the @code{process-mark}, which is then updated to point +to the end of the text just inserted. Usually, but not always, the +@code{process-mark} is at the end of the buffer. @findex process-kill-buffer-query-function Killing the associated buffer of a process also kills the process. @@ -1220,13 +1221,12 @@ marker that says where to insert output from the process. If @var{process} does not have a buffer, @code{process-mark} returns a marker that points nowhere. -Insertion of process output in a buffer uses this marker to decide where -to insert, and updates it to point after the inserted text. That is why -successive batches of output are inserted consecutively. +The default filter function uses this marker to decide where to +insert process output, and updates it to point after the inserted text. +That is why successive batches of output are inserted consecutively. -Filter functions normally should use this marker in the same fashion -as is done by direct insertion of output in the buffer. For an -example of a filter function that uses @code{process-mark}, +Custom filter functions normally should use this marker in the same fashion. +For an example of a filter function that uses @code{process-mark}, @pxref{Process Filter Example}. When the user is expected to enter input in the process buffer for @@ -1268,10 +1268,9 @@ subprocess with a @code{SIGHUP} signal (@pxref{Signals to Processes}). @cindex process filter A process @dfn{filter function} is a function that receives the -standard output from the associated process. If a process has a filter, -then @emph{all} output from that process is passed to the filter. The -process buffer is used directly for output from the process only when -there is no filter. +standard output from the associated process. @emph{All} output from +that process is passed to the filter. The default filter simply +outputs directly to the process buffer. The filter function can only be called when Emacs is waiting for something, because process output arrives only at such times. Emacs @@ -1300,8 +1299,8 @@ This makes it possible to use the Lisp debugger to debug the filter function. @xref{Debugger}. Many filter functions sometimes (or always) insert the output in the -process's buffer, mimicking the actions of Emacs when there is no -filter. Such filter functions need to make sure that they save the +process's buffer, mimicking the actions of the default filter. +Such filter functions need to make sure that they save the current buffer, select the correct buffer (if different) before inserting output, and then restore the original buffer. They should also check whether the buffer is still alive, update the @@ -1357,12 +1356,12 @@ received text into a temporary buffer, which can then be searched. @defun set-process-filter process filter This function gives @var{process} the filter function @var{filter}. If -@var{filter} is @code{nil}, it gives the process no filter. +@var{filter} is @code{nil}, it gives the process the default filter, +which inserts the process output into the process buffer. @end defun @defun process-filter process -This function returns the filter function of @var{process}, or @code{nil} -if it has none. +This function returns the filter function of @var{process}. @end defun Here is an example of the use of a filter function: @@ -1401,8 +1400,7 @@ backup.mss dland syllabus.mss @ignore @c The code in this example doesn't show the right way to do things. Here is another, more realistic example, which demonstrates how to use -the process mark to do insertion in the same fashion as is done when -there is no filter function: +the process mark to do insertion in the same fashion as the default filter: @smallexample @group @@ -1474,9 +1472,9 @@ until output arrives from a process. @defun accept-process-output &optional process seconds millisec just-this-one This function allows Emacs to read pending output from processes. The -output is inserted in the associated buffers or given to their filter -functions. If @var{process} is non-@code{nil} then this function does -not return until some output has been received from @var{process}. +output is given to their filter functions. If @var{process} is +non-@code{nil} then this function does not return until some output +has been received from @var{process}. The arguments @var{seconds} and @var{millisec} let you specify timeout periods. The former specifies a period measured in seconds and the @@ -1591,9 +1589,9 @@ while executing sentinels. @xref{Match Data}. @defun set-process-sentinel process sentinel This function associates @var{sentinel} with @var{process}. If -@var{sentinel} is @code{nil}, then the process will have no sentinel. -The default behavior when there is no sentinel is to insert a message in -the process's buffer when the process status changes. +@var{sentinel} is @code{nil}, then the process will have the default +sentinel, which inserts a message in the process's buffer when the +process status changes. Changes in process sentinels take effect immediately---if the sentinel is slated to be run but has not been called yet, and you specify a new @@ -1616,8 +1614,7 @@ sentinel, the eventual call to the sentinel will use the new one. @end defun @defun process-sentinel process -This function returns the sentinel of @var{process}, or @code{nil} if it -has none. +This function returns the sentinel of @var{process}. @end defun @defun waiting-for-user-input-p @@ -1974,7 +1971,7 @@ is modified as necessary to make it unique. The @var{buffer} argument is the buffer to associate with the connection. Output from the connection is inserted in the buffer, -unless you specify a filter function to handle the output. If +unless you specify your own filter function to handle the output. If @var{buffer} is @code{nil}, it means that the connection is not associated with any buffer. @@ -2082,7 +2079,7 @@ unique number in brackets, as in @samp{<@var{nnn}>}. The number is unique for each connection in the Emacs session. @item -If the server's filter is non-@code{nil}, the connection process does +If the server has a non-default filter, the connection process does not get a separate process buffer; otherwise, Emacs creates a new buffer for the purpose. The buffer name is the server's buffer name or process name, concatenated with the client identification string. @@ -2613,7 +2610,7 @@ Here is an example: @cindex stopbits, in serial connections @cindex flowcontrol, in serial connections -This functions configures a serial port connection. Arguments are +This function configures a serial port connection. Arguments are specified as keyword/argument pairs. Attributes that are not given are re-initialized from the process's current configuration (available via the function @code{process-contact}), or set to reasonable default diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 87d4051d6f0..2f287cc9705 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Searching and Matching @@ -137,7 +137,7 @@ the ball boy!" @group (word-search-forward "Please find the ball, boy.") - @result{} 36 + @result{} 39 ---------- Buffer: foo ---------- He said "Please! Find @@ -160,16 +160,17 @@ If @var{repeat} is non-@code{nil}, then the search is repeated that many times. Point is positioned at the end of the last match. @findex word-search-regexp -Internal, @code{word-search-forward} and related functions use the +Internally, @code{word-search-forward} and related functions use the function @code{word-search-regexp} to convert @var{string} to a regular expression that ignores punctuation. @end deffn @deffn Command word-search-forward-lax string &optional limit noerror repeat This command is identical to @code{word-search-forward}, except that -the end of @var{string} need not match a word boundary, unless @var{string} ends -in whitespace. For instance, searching for @samp{ball boy} matches -@samp{ball boyee}, but does not match @samp{aball boy}. +the beginning or the end of @var{string} need not match a word +boundary, unless @var{string} begins or ends in whitespace. +For instance, searching for @samp{ball boy} matches @samp{ball boyee}, +but does not match @samp{balls boy}. @end deffn @deffn Command word-search-backward string &optional limit noerror repeat @@ -181,8 +182,8 @@ beginning of the match. @deffn Command word-search-backward-lax string &optional limit noerror repeat This command is identical to @code{word-search-backward}, except that -the end of @var{string} need not match a word boundary, unless @var{string} ends -in whitespace. +the beginning or the end of @var{string} need not match a word +boundary, unless @var{string} begins or ends in whitespace. @end deffn @node Searching and Case @@ -273,12 +274,12 @@ expression is ordinary, unless a @samp{\} precedes it. therefore @samp{f} is a regular expression that matches the string @samp{f} and no other string. (It does @emph{not} match the string @samp{fg}, but it does match a @emph{part} of that string.) Likewise, -@samp{o} is a regular expression that matches only @samp{o}.@refill +@samp{o} is a regular expression that matches only @samp{o}. Any two regular expressions @var{a} and @var{b} can be concatenated. The result is a regular expression that matches a string if @var{a} matches some amount of the beginning of that string and @var{b} matches the rest of -the string.@refill +the string. As a simple example, we can concatenate the regular expressions @samp{f} and @samp{o} to get the regular expression @samp{fo}, which matches only @@ -304,7 +305,7 @@ expression. is a special character that matches any single character except a newline. Using concatenation, we can make regular expressions like @samp{a.b}, which matches any three-character string that begins with @samp{a} and ends with -@samp{b}.@refill +@samp{b}. @item @samp{*} @cindex @samp{*} in regexp @@ -488,7 +489,7 @@ example, the regular expression that matches the @samp{\} character is @samp{\\}. To write a Lisp string that contains the characters @samp{\\}, Lisp syntax requires you to quote each @samp{\} with another @samp{\}. Therefore, the read syntax for a regular expression matching -@samp{\} is @code{"\\\\"}.@refill +@samp{\} is @code{"\\\\"}. @end table @strong{Please note:} For historical compatibility, special characters @@ -496,7 +497,7 @@ are treated as ordinary ones if they are in contexts where their special meanings make no sense. For example, @samp{*foo} treats @samp{*} as ordinary since there is no preceding expression on which the @samp{*} can act. It is poor practice to depend on this behavior; quote the -special character anyway, regardless of where it appears.@refill +special character anyway, regardless of where it appears. As a @samp{\} is not special inside a character alternative, it can never remove the special meaning of @samp{-} or @samp{]}. So you @@ -589,10 +590,8 @@ through @samp{f} and @samp{A} through @samp{F}. For the most part, @samp{\} followed by any character matches only that character. However, there are several exceptions: certain -two-character sequences starting with @samp{\} that have special -meanings. (The character after the @samp{\} in such a sequence is -always ordinary when used on its own.) Here is a table of the special -@samp{\} constructs. +sequences starting with @samp{\} that have special meanings. Here is +a table of the special @samp{\} constructs. @table @samp @item \| @@ -601,14 +600,14 @@ always ordinary when used on its own.) Here is a table of the special specifies an alternative. Two regular expressions @var{a} and @var{b} with @samp{\|} in between form an expression that matches anything that either @var{a} or -@var{b} matches.@refill +@var{b} matches. Thus, @samp{foo\|bar} matches either @samp{foo} or @samp{bar} -but no other string.@refill +but no other string. @samp{\|} applies to the largest possible surrounding expressions. Only a surrounding @samp{\( @dots{} \)} grouping can limit the grouping power of -@samp{\|}.@refill +@samp{\|}. If you need full backtracking capability to handle multiple uses of @samp{\|}, use the POSIX regular expression functions (@pxref{POSIX @@ -787,7 +786,7 @@ matches the empty string, but only at point. matches the empty string, but only at the beginning or end of a word. Thus, @samp{\bfoo\b} matches any occurrence of @samp{foo} as a separate word. @samp{\bballs?\b} matches -@samp{ball} or @samp{balls} as a separate word.@refill +@samp{ball} or @samp{balls} as a separate word. @samp{\b} matches at the beginning or end of the buffer (or string) regardless of what text appears next to it. @@ -1148,13 +1147,7 @@ implemented by searching backwards from point for a match that ends at point. That can be quite slow if it has to search a long distance. You can bound the time required by specifying @var{limit}, which says not to search before @var{limit}. In this case, the match that is -found must begin at or after @var{limit}. - -If @var{greedy} is non-@code{nil}, this function extends the match -backwards as far as possible, stopping when a single additional -previous character cannot be part of a match for regexp. When the -match is extended, its starting position is allowed to occur before -@var{limit}. +found must begin at or after @var{limit}. Here's an example: @example @group @@ -1170,6 +1163,12 @@ comes back" twice. @end group @end example +If @var{greedy} is non-@code{nil}, this function extends the match +backwards as far as possible, stopping when a single additional +previous character cannot be part of a match for regexp. When the +match is extended, its starting position is allowed to occur before +@var{limit}. + @c http://debbugs.gnu.org/5689 As a general recommendation, try to avoid using @code{looking-back} wherever possible, since it is slow. For this reason, there are no @@ -1774,7 +1773,7 @@ questions, assuming that the answers will be ``no''. @item exit-prefix Like @code{exit}, but add the key that was pressed to -@code{unread-comment-events}. +@code{unread-command-events} (@pxref{Event Input Misc}). @item act-and-exit Answer this question ``yes'', and give up on the entire series of diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 00384de7ec8..52a1cf5e32c 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Sequences Arrays Vectors @@ -471,11 +471,11 @@ each initialized to @var{object}. @cindex copying vectors This function returns a new vector containing all the elements of @var{sequences}. The arguments @var{sequences} may be true lists, -vectors, strings or bool-vectors. If no @var{sequences} are given, an -empty vector is returned. +vectors, strings or bool-vectors. If no @var{sequences} are given, +the empty vector is returned. -The value is a newly constructed vector that is not @code{eq} to any -existing vector. +The value is either the empty vector, or is a newly constructed +nonempty vector that is not @code{eq} to any existing vector. @example @group @@ -711,6 +711,54 @@ each one initialized to @var{initial}. @defun bool-vector-p object This returns @code{t} if @var{object} is a bool-vector, and @code{nil} otherwise. +@end defun + +There are also some bool-vector set operation functions, described below: + +@defun bool-vector-exclusive-or a b &optional c +Return @dfn{bitwise exclusive or} of bool vectors @var{a} and @var{b}. +If optional argument @var{c} is given, the result of this operation is +stored into @var{c}. All arguments should be bool vectors of the same length. +@end defun + +@defun bool-vector-union a b &optional c +Return @dfn{bitwise or} of bool vectors @var{a} and @var{b}. If +optional argument @var{c} is given, the result of this operation is +stored into @var{c}. All arguments should be bool vectors of the same length. +@end defun + +@defun bool-vector-intersection a b &optional c +Return @dfn{bitwise and} of bool vectors @var{a} and @var{b}. If +optional argument @var{c} is given, the result of this operation is +stored into @var{c}. All arguments should be bool vectors of the same length. +@end defun + +@defun bool-vector-set-difference a b &optional c +Return @dfn{set difference} of bool vectors @var{a} and @var{b}. If +optional argument @var{c} is given, the result of this operation is +stored into @var{c}. All arguments should be bool vectors of the same length. +@end defun + +@defun bool-vector-not a &optional b +Return @dfn{set complement} of bool vector @var{a}. If optional +argument @var{b} is given, the result of this operation is stored into +@var{b}. All arguments should be bool vectors of the same length. +@end defun + +@defun bool-vector-subsetp a b +Return @code{t} if every @code{t} value in @var{a} is also t in +@var{b}, nil otherwise. All arguments should be bool vectors of the +same length. +@end defun + +@defun bool-vector-count-consecutive a b i +Return the number of consecutive elements in @var{a} equal @var{b} +starting at @var{i}. @code{a} is a bool vector, @var{b} is @code{t} +or @code{nil}, and @var{i} is an index into @code{a}. +@end defun + +@defun bool-vector-count-population a +Return the number of elements that are @code{t} in bool vector @var{a}. @end defun Here is an example of creating, examining, and updating a diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 5b7e833b235..ed3a01ba810 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1994, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Read and Print diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 340115062f9..5c814b22b2d 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Strings and Characters @@ -268,7 +268,7 @@ string to be used as a shell command, see @ref{Shell Arguments, combine-and-quote-strings}. @end defun -@defun split-string string &optional separators omit-nulls +@defun split-string string &optional separators omit-nulls trim This function splits @var{string} into substrings based on the regular expression @var{separators} (@pxref{Regular Expressions}). Each match for @var{separators} defines a splitting point; the substrings between @@ -350,6 +350,11 @@ practice: @result{} ("o" "o" "o") @end example +If the optional argument @var{trim} is non-@code{nil}, it should be a +regular expression to match text to trim from the beginning and end of +each substring. If trimming makes the substring empty, it is treated +as null. + If you need to split a string into a list of individual command-line arguments suitable for @code{call-process} or @code{start-process}, see @ref{Shell Arguments, split-string-and-unquote}. @@ -516,6 +521,13 @@ the optional argument @var{ignore-case} is non-@code{nil}, the comparison ignores case differences. @end defun +@defun string-suffix-p suffix string &optional ignore-case +This function returns non-@code{nil} if @var{suffix} is a suffix of +@var{string}; i.e., if @var{string} ends with @var{suffix}. If the +optional argument @var{ignore-case} is non-@code{nil}, the comparison +ignores case differences. +@end defun + @defun compare-strings string1 start1 end1 string2 start2 end2 &optional ignore-case This function compares a specified part of @var{string1} with a specified part of @var{string2}. The specified part of @var{string1} @@ -617,10 +629,8 @@ but its value is too large to fit into a Lisp integer, The parsing skips spaces and tabs at the beginning of @var{string}, then reads as much of @var{string} as it can interpret as a number in the given base. (On some systems it ignores other whitespace at the -beginning, not just spaces and tabs.) If the first character after -the ignored whitespace is neither a digit in the given base, nor a -plus or minus sign, nor the leading dot of a floating point number, -this function returns 0. +beginning, not just spaces and tabs.) If @var{string} cannot be +interpreted as a number, this function returns 0. @example (string-to-number "256") diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 9f916549902..e4455692d45 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Symbols @@ -539,8 +539,9 @@ deleted from the local value of a hook variable when changing major modes. @xref{Setting Hooks}. @item pure -This property is used internally to mark certain named functions for -byte compiler optimization. Do not set it. +If the value is non-@code{nil}, the named function is considered to be +side-effect free. Calls with constant arguments can be evaluated at +compile time. This may shift run time errors to compile time. @item risky-local-variable If the value is non-@code{nil}, the named variable is considered risky diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index dfa121103bc..25e6089491e 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Syntax Tables @@ -141,6 +141,7 @@ Internals}. @node Syntax Class Table @subsection Table of Syntax Classes +@cindex syntax class table Here is a table of syntax classes, the characters that designate them, their meanings, and examples of their use. @@ -335,6 +336,7 @@ that this kind of comment can be nested. For a two-character comment delimiter, @samp{n} on either character makes it nestable. +@cindex comment style Emacs supports several comment styles simultaneously in any one syntax table. A comment style is a set of flags @samp{b}, @samp{c}, and @samp{n}, so there can be up to 8 different comment styles. @@ -409,6 +411,7 @@ is not a syntax table. @end defun @deffn Command modify-syntax-entry char syntax-descriptor &optional table +@cindex syntax entry, setting This function sets the syntax entry for @var{char} according to @var{syntax-descriptor}. @var{char} must be a character, or a cons cell of the form @code{(@var{min} . @var{max})}; in the latter case, @@ -506,6 +509,11 @@ This function returns the current syntax table, which is the table for the current buffer. @end defun +@deffn Command describe-syntax &optional buffer +This command displays the contents of the syntax table of +@var{buffer} (by default, the current buffer) in a help buffer. +@end deffn + @defmac with-syntax-table table body@dots{} This macro executes @var{body} using @var{table} as the current syntax table. It returns the value of the last form in @var{body}, after @@ -1052,6 +1060,7 @@ standard categories are available in all modes. the range @w{@samp{ }} to @samp{~}. You specify the name of a category when you define it with @code{define-category}. +@cindex category set The category table is actually a char-table (@pxref{Char-Tables}). The element of the category table at index @var{c} is a @dfn{category set}---a bool-vector---that indicates which categories character @var{c} diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index c6cbfa5b3f8..18701465d0f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Text @chapter Text @@ -240,6 +240,7 @@ Major and minor modes can add functions to copied out of the buffer. @end defun +@c FIXME: `filter-buffer-substring-function' should be documented. @defvar filter-buffer-substring-functions This variable is a wrapper hook (@pxref{Running Hooks}), whose members should be functions that accept four arguments: @var{fun}, @@ -365,7 +366,8 @@ not relocate the marker, depending on the marker's insertion type the inserted text, regardless of the markers' insertion type. Insertion functions signal an error if the current buffer is -read-only or if they insert within read-only text. +read-only (@pxref{Read Only Buffers}) or if they insert within +read-only text (@pxref{Special Properties}). These functions copy text characters from strings and buffers along with their properties. The inserted characters have exactly the same @@ -421,10 +423,10 @@ insertion point. @xref{Sticky Properties}. @defun insert-buffer-substring from-buffer-or-name &optional start end This function inserts a portion of buffer @var{from-buffer-or-name} -(which must already exist) into the current buffer before point. The -text inserted is the region between @var{start} and @var{end}. (These -arguments default to the beginning and end of the accessible portion of -that buffer.) This function returns @code{nil}. +into the current buffer before point. The text inserted is the region +between @var{start} (inclusive) and @var{end} (exclusive). (These +arguments default to the beginning and end of the accessible portion +of that buffer.) This function returns @code{nil}. In this example, the form is executed with buffer @samp{bar} as the current buffer. We assume that buffer @samp{bar} is initially empty. @@ -482,6 +484,7 @@ it except to install it on a keymap. In an interactive call, @var{count} is the numeric prefix argument. +@c FIXME: This variable is obsolete since 23.1. Self-insertion translates the input character through @code{translation-table-for-input}. @xref{Translation of Characters}. @@ -768,6 +771,9 @@ space, or @var{n} spaces if @var{n} is specified. It returns @code{nil}. @end deffn +@c There is also cycle-spacing, but I cannot see it being useful in +@c Lisp programs, so it is not mentioned here. + @deffn Command delete-blank-lines This function deletes blank lines surrounding point. If point is on a blank line with one or more blank lines before or after it, then all but @@ -776,10 +782,24 @@ is deleted. If point is on a nonblank line, the command deletes all blank lines immediately following it. A blank line is defined as a line containing only tabs and spaces. +@c and the Newline character? @code{delete-blank-lines} returns @code{nil}. @end deffn +@deffn Command delete-trailing-whitespace start end +Delete trailing whitespace in the region defined by @var{start} and +@var{end}. + +This command deletes whitespace characters after the last +non-whitespace character in each line in the region. + +If this command acts on the entire buffer (i.e. if called +interactively with the mark inactive, or called from Lisp with +@var{end} nil), it also deletes all trailing lines at the end of the +buffer if the variable @code{delete-trailing-lines} is non-@code{nil}. +@end deffn + @node The Kill Ring @section The Kill Ring @cindex kill ring @@ -920,6 +940,7 @@ processes the text according to @code{yank-handled-properties} and text anyway.) @end defun +@c FIXME: Add an index for yank-handler. If you put a @code{yank-handler} text property on all or part of a string, that alters how @code{insert-for-yank} inserts the string. If different parts of the string have different @code{yank-handler} @@ -1226,7 +1247,7 @@ list, which is in the variable @code{buffer-undo-list}. @defvar buffer-undo-list This buffer-local variable's value is the undo list of the current -buffer. A value of @code{t} disables the recording of undo information. +buffer. A value of @code{t} disables the recording of undo information. @end defvar Here are the kinds of elements an undo list can have: @@ -1250,14 +1271,18 @@ reinsert it is @code{(abs @var{position})}. If @var{position} is positive, point was at the beginning of the deleted text, otherwise it was at the end. -@item (t @var{sec-high} @var{sec-low} @var{microsec} @var{picosec}) +@item (t . @var{time-flag}) This kind of element indicates that an unmodified buffer became -modified. The list @code{(@var{sec-high} @var{sec-low} @var{microsec} +modified. A @var{time-flag} of the form +@code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})} represents the visited file's modification time as of when it was previously visited or saved, using the same format as -@code{current-time}; see @ref{Time of Day}. @code{primitive-undo} uses those +@code{current-time}; see @ref{Time of Day}. +A @var{time-flag} of 0 means the buffer does not correspond to any file; +@minus{}1 means the visited file previously did not exist. +@code{primitive-undo} uses these values to determine whether to mark the buffer as unmodified once again; -it does so only if the file's modification time matches those numbers. +it does so only if the file's status matches that of @var{time-flag}. @item (nil @var{property} @var{value} @var{beg} . @var{end}) This kind of element records a change in a text property. @@ -1280,8 +1305,8 @@ This is an extensible undo item, which is undone by calling @item (apply @var{delta} @var{beg} @var{end} @var{funname} . @var{args}) This is an extensible undo item, which records a change limited to the range @var{beg} to @var{end}, which increased the size of the buffer -by @var{delta}. It is undone by calling @var{funname} with arguments -@var{args}. +by @var{delta} characters. It is undone by calling @var{funname} with +arguments @var{args}. This kind of element enables undo limited to a region to determine whether the element pertains to that region. @@ -1372,7 +1397,8 @@ possible to undo either previous changes or any subsequent changes. If the undo list of @var{buffer-or-name} is already disabled, this function has no effect. -This function returns @code{nil}. +In an interactive call, BUFFER-OR-NAME is the current buffer. You +cannot specify any other buffer. This function returns @code{nil}. @end deffn As editing continues, undo lists get longer and longer. To prevent @@ -1489,6 +1515,7 @@ the header lines. If @var{citation-regexp} is a string, it is used as a regular expression; if it matches the beginning of a line, that line is treated as a citation marker. +@c FIXME: "That mode" is confusing. It isn't a major/minor mode. Ordinarily, @code{fill-individual-paragraphs} regards each change in indentation as starting a new paragraph. If @code{fill-individual-varying-indent} is non-@code{nil}, then only @@ -1602,11 +1629,13 @@ Manual}. @defvar use-hard-newlines If this variable is non-@code{nil}, the filling functions do not delete newlines that have the @code{hard} text property. These ``hard -newlines'' act as paragraph separators. +newlines'' act as paragraph separators. @xref{Hard and Soft +Newlines,, Hard and Soft Newlines, emacs, The GNU Emacs Manual}. @end defvar @node Margins @section Margins for Filling +@cindex margins, filling @defopt fill-prefix This buffer-local variable, if non-@code{nil}, specifies a string of @@ -1796,6 +1825,7 @@ prefix or @code{nil}, meaning it has failed to determine a prefix. @cindex filling, automatic @cindex Auto Fill mode +@c FIXME: I don't think any of the variables below is a/an normal/abnormal hook. Auto Fill mode is a minor mode that fills lines automatically as text is inserted. This section describes the hook used by Auto Fill mode. For a description of functions that you can call explicitly to fill and @@ -1937,10 +1967,10 @@ its @code{sort-subr} call looks like this: @group (sort-subr reverse (function - (lambda () - (while (and (not (eobp)) - (looking-at paragraph-separate)) - (forward-line 1)))) + (lambda () + (while (and (not (eobp)) + (looking-at paragraph-separate)) + (forward-line 1)))) 'forward-paragraph) @end group @end example @@ -2126,9 +2156,12 @@ line and point. When called interactively, @var{column} is the value of prefix numeric argument. If @var{column} is not an integer, an error is signaled. +@c This behavior used to be documented until 2013/08. +@ignore If column @var{column} is beyond the end of the line, point moves to the end of the line. If @var{column} is negative, point moves to the beginning of the line. +@end ignore If it is impossible to move to column @var{column} because that is in the middle of a multicolumn character such as a tab, point moves to the @@ -2327,19 +2360,19 @@ a different meaning and does not use this variable. @end defvar @deffn Command indent-rigidly start end count -This command indents all lines starting between @var{start} +This function indents all lines starting between @var{start} (inclusive) and @var{end} (exclusive) sideways by @var{count} columns. This ``preserves the shape'' of the affected region, moving it as a -rigid unit. Consequently, this command is useful not only for indenting -regions of unindented text, but also for indenting regions of formatted -code. +rigid unit. -For example, if @var{count} is 3, this command adds 3 columns of -indentation to each of the lines beginning in the region specified. +This is useful not only for indenting regions of unindented text, but +also for indenting regions of formatted code. For example, if +@var{count} is 3, this command adds 3 columns of indentation to every +line that begins in the specified region. -In Mail mode, @kbd{C-c C-y} (@code{mail-yank-original}) uses -@code{indent-rigidly} to indent the text copied from the message being -replied to. +If called interactively with no prefix argument, this command invokes +a transient mode for adjusting indentation rigidly. @xref{Indentation +Commands,,, emacs, The GNU Emacs Manual}. @end deffn @deffn Command indent-code-rigidly start end columns &optional nochange-regexp @@ -2443,19 +2476,19 @@ stop feature only in a few major modes, such as Text mode. @deffn Command tab-to-tab-stop This command inserts spaces or tabs before point, up to the next tab -stop column defined by @code{tab-stop-list}. It searches the list for -an element greater than the current column number, and uses that element -as the column to indent to. It does nothing if no such element is -found. +stop column defined by @code{tab-stop-list}. @end deffn @defopt tab-stop-list -This variable is the list of tab stop columns used by -@code{tab-to-tab-stops}. The elements should be integers in increasing -order. The tab stop columns need not be evenly spaced. +This variable defines the tab stop columns used by @code{tab-to-tab-stop}. +It should be either @code{nil}, or a list of increasing integers, +which need not be evenly spaced. The list is implicitly +extended to infinity through repetition of the interval between the +last and penultimate elements (or @code{tab-width} if the list has +fewer than two elements). A value of @code{nil} means a tab stop +every @code{tab-width} columns. -Use @kbd{M-x edit-tab-stops} to edit the location of tab stops -interactively. +Use @kbd{M-x edit-tab-stops} to edit the location of tab stops interactively. @end defopt @node Motion by Indent @@ -2514,7 +2547,7 @@ This is the contents of the 5th foo. @end group @group -(capitalize-region 1 44) +(capitalize-region 1 37) @result{} nil ---------- Buffer: foo ---------- @@ -2662,6 +2695,13 @@ followed by the text properties. If @var{object} is a string, only text properties are considered, since strings never have overlays. @end defun +@defun get-pos-property position prop &optional object +This function is like @code{get-char-property}, except that it pays +attention to properties' stickiness and overlays' advancement settings +instead of the property of the character at (i.e. right after) +@var{position}. +@end defun + @defun get-char-property-and-overlay position prop &optional object This is like @code{get-char-property}, but gives extra information about the overlay that the property value comes from. @@ -2805,15 +2845,44 @@ from the specified range of text. Here's an example: Do not rely on the return value of this function. @end defun - The easiest way to make a string with text properties -is with @code{propertize}: +@defun add-face-text-property start end face &optional appendp object +This function acts on the text between @var{start} and @var{end}, +adding the face @var{face} to the @code{face} text property. +@var{face} should be a valid value for the @code{face} property +(@pxref{Special Properties}), such as a face name or an anonymous face +(@pxref{Faces}). + +If any text in the region already has a non-nil @code{face} property, +those face(s) are retained. This function sets the @code{face} +property to a list of faces, with @var{face} as the first element (by +default) and the pre-existing faces as the remaining elements. If the +optional argument @var{append} is non-@code{nil}, @var{face} is +appended to the end of the list instead. Note that in a face list, +the first occurring value for each attribute takes precedence. + +For example, the following code would assign a italicized green face +to the text between @var{start} and @var{end}: + +@example +(add-face-text-property @var{start} @var{end} 'italic) +(add-face-text-property @var{start} @var{end} '(:foreground "red")) +(add-face-text-property @var{start} @var{end} '(:foreground "green")) +@end example + +The optional argument @var{object}, if non-@code{nil}, specifies a +buffer or string to act on, rather than the current buffer. If +@var{object} is a string, then @var{start} and @var{end} are +zero-based indices into the string. +@end defun + + The easiest way to make a string with text properties is with +@code{propertize}: @defun propertize string &rest properties -This function returns a copy of @var{string} which has the text -properties @var{properties}. These properties apply to all the -characters in the string that is returned. Here is an example that -constructs a string with a @code{face} property and a @code{mouse-face} -property: +This function returns a copy of @var{string} with the text properties +@var{properties} added. These properties apply to all the characters +in the string that is returned. Here is an example that constructs a +string with a @code{face} property and a @code{mouse-face} property: @smallexample (propertize "foo" 'face 'italic @@ -2998,6 +3067,7 @@ Point}. @table @code @cindex property category of text character +@c FIXME: Isn't @kindex for keyboard commands? @kindex category @r{(text property)} @item category If a character has a @code{category} property, we call it the @@ -3008,33 +3078,40 @@ character. @item face @cindex face codes of text @kindex face @r{(text property)} -The @code{face} property controls the appearance of the character, -such as its font and color. @xref{Faces}. The value of the property -can be the following: +The @code{face} property controls the appearance of the character +(@pxref{Faces}). The value of the property can be the following: @itemize @bullet @item A face name (a symbol or string). @item -A property list of face attributes. This has the form (@var{keyword} -@var{value} @dots{}), where each @var{keyword} is a face attribute -name and @var{value} is a meaningful value for that attribute. With -this feature, you do not need to create a face each time you want to -specify a particular attribute for certain text. +An anonymous face: a property list of the form @code{(@var{keyword} +@var{value} @dots{})}, where each @var{keyword} is a face attribute +name and @var{value} is a value for that attribute. @item -A list of faces. This specifies a face which is an aggregate of the +A list of faces. Each list element should be either a face name or an +anonymous face. This specifies a face which is an aggregate of the attributes of each of the listed faces. Faces occurring earlier in -the list have higher priority. Each list element must have one of the -two above forms (i.e., either a face name or a property list of face -attributes). +the list have higher priority. + +@item +A cons cell of the form @code{(foreground-color . @var{color-name})} +or @code{(background-color . @var{color-name})}. This specifies the +foreground or background color, similar to @code{(:foreground +@var{color-name})} or @code{(:background @var{color-name})}. This +form is supported for backward compatibility only, and should be +avoided. @end itemize Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by dynamically updating the @code{face} property of characters based on the context. +The @code{add-face-text-property} function provides a convenient way +to set this text property. @xref{Changing Properties}. + @item font-lock-face @kindex font-lock-face @r{(text property)} This property specifies a value for the @code{face} property that Font @@ -3874,10 +3951,11 @@ between one interval and two. Insertion of text at the border between intervals also raises questions that have no satisfactory answer. - However, it is easy to arrange for editing to behave consistently for -questions of the form, ``What are the properties of this character?'' -So we have decided these are the only questions that make sense; we have -not implemented asking questions about where intervals start or end. + However, it is easy to arrange for editing to behave consistently +for questions of the form, ``What are the properties of text at this +buffer or string position?'' So we have decided these are the only +questions that make sense; we have not implemented asking questions +about where intervals start or end. In practice, you can usually use the text property search functions in place of explicit interval boundaries. You can think of them as finding @@ -3982,6 +4060,7 @@ A rectangle is represented by a list of strings. This represents a window configuration to restore in one frame, and a position to jump to in the current buffer. +@c FIXME: Mention frameset here. @item @code{(@var{frame-configuration} @var{position})} This represents a frame configuration to restore, and a position to jump to in the current buffer. @@ -4220,6 +4299,14 @@ A call to @code{libxml-parse-html-region} returns this: @end example @end defun +@cindex rendering html +@defun shr-insert-document dom +This function renders the parsed HTML in @var{dom} into the current +buffer. The argument @var{dom} should be a list as generated by +@code{libxml-parse-html-region}. This function is, e.g., used by +@ref{Top, EWW,, eww, The Emacs Web Wowser Manual}. +@end defun + @cindex parsing xml @defun libxml-parse-xml-region start end &optional base-url This function is the same as @code{libxml-parse-html-region}, except diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 4c443da3af8..d8b906d3bfe 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Tips @@ -51,13 +51,15 @@ don't postpone it. @item You should choose a short word to distinguish your program from other -Lisp programs. The names of all global variables, constants, and -functions in your program should begin with that chosen prefix. -Separate the prefix from the rest of the name with a hyphen, @samp{-}. -This practice helps avoid name conflicts, since all global variables -in Emacs Lisp share the same name space, and all functions share -another name space@footnote{The benefits of a Common Lisp-style -package system are considered not to outweigh the costs.}. +Lisp programs. The names of all global symbols in your program, that +is the names of variables, constants, and functions, should begin with +that chosen prefix. Separate the prefix from the rest of the name +with a hyphen, @samp{-}. This practice helps avoid name conflicts, +since all global variables in Emacs Lisp share the same name space, +and all functions share another name space@footnote{The benefits of a +Common Lisp-style package system are considered not to outweigh the +costs.}. Use two hyphens to separate prefix and name if the symbol is +not meant to be used by other packages. Occasionally, for a command name intended for users to use, it is more convenient if some words come before the package's name prefix. And @@ -221,18 +223,13 @@ only for special-purpose buffers.) People will find Emacs more coherent if all libraries use the same conventions. @item -If your program contains non-ASCII characters in string or character -constants, you should make sure Emacs always decodes these characters -the same way, regardless of the user's settings. The easiest way to -do this is to use the coding system @code{utf-8-emacs} (@pxref{Coding -System Basics}), and specify that coding in the @samp{-*-} line or the +The default file coding system for Emacs Lisp source files is UTF-8 +(@pxref{Text Representations}). In the rare event that your program +contains characters which are @emph{not} in UTF-8, you should specify +an appropriate coding system in the source file's @samp{-*-} line or local variables list. @xref{File Variables, , Local Variables in Files, emacs, The GNU Emacs Manual}. -@example -;; XXX.el -*- coding: utf-8-emacs; -*- -@end example - @item Indent the file using the default indentation parameters. @@ -576,10 +573,13 @@ Format the documentation string so that it fits in an Emacs window on an 60 characters. The first line should not be wider than 67 characters or it will look bad in the output of @code{apropos}. -You can fill the text if that looks good. However, rather than blindly -filling the entire documentation string, you can often make it much more -readable by choosing certain line breaks with care. Use blank lines -between sections if the documentation string is long. +@vindex emacs-lisp-docstring-fill-column +You can fill the text if that looks good. Emacs Lisp mode fills +documentation strings to the width specified by +@code{emacs-lisp-docstring-fill-column}. However, you can sometimes +make a documentation string much more readable by adjusting its line +breaks with care. Use blank lines between sections if the +documentation string is long. @item The first line of the documentation string should consist of one or two @@ -834,10 +834,10 @@ For example: @smallexample @group -(setq base-version-list ; there was a base +(setq base-version-list ; There was a base (assoc (substring fn 0 start-vn) ; version to which file-version-assoc-list)) ; this looks like - ; a subversion + ; a subversion. @end group @end smallexample @@ -875,30 +875,14 @@ strings, though. @item ;;; Comments that start with three semicolons, @samp{;;;}, should start at -the left margin. These are used, occasionally, for comments within -functions that should start at the margin. We also use them sometimes -for comments that are between functions---whether to use two or three -semicolons depends on whether the comment should be considered a +the left margin. We use them +for comments which should be considered a ``heading'' by Outline minor mode. By default, comments starting with at least three semicolons (followed by a single space and a non-whitespace character) are considered headings, comments starting -with two or fewer are not. - -Another use for triple-semicolon comments is for commenting out lines -within a function. We use three semicolons for this precisely so that -they remain at the left margin. By default, Outline minor mode does -not consider a comment to be a heading (even if it starts with at -least three semicolons) if the semicolons are followed by at least two -spaces. Thus, if you add an introductory comment to the commented out -code, make sure to indent it by at least two spaces after the three -semicolons. - -@smallexample -(defun foo (a) -;;; This is no longer necessary. -;;; (force-mode-line-update) - (message "Finished with %s" a)) -@end smallexample +with two or fewer are not. Historically, triple-semicolon comments have +also been used for commenting out lines within a function, but this use +is discouraged. When commenting out entire functions, use two semicolons. @@ -934,7 +918,7 @@ explains these conventions, starting with an example: @group ;;; foo.el --- Support for the Foo programming language -;; Copyright (C) 2010-2013 Your Name +;; Copyright (C) 2010-2014 Your Name @end group ;; Author: Your Name diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt index a134b8c4783..f9d05126651 100644 --- a/doc/lispref/two-volume-cross-refs.txt +++ b/doc/lispref/two-volume-cross-refs.txt @@ -1,4 +1,4 @@ -Copyright (C) 2001-2013 Free Software Foundation, Inc. +Copyright (C) 2001-2014 Free Software Foundation, Inc. See end for copying conditions. Two Volume Cross References diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make index 9ae4a33df44..a75b26b58c7 100644 --- a/doc/lispref/two-volume.make +++ b/doc/lispref/two-volume.make @@ -1,4 +1,4 @@ -# Copyright (C) 2007-2013 Free Software Foundation, Inc. +# Copyright (C) 2007-2014 Free Software Foundation, Inc. # See end for copying conditions. # although it would be nice to use tex rather than pdftex to avoid diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 4bcf7985f0c..dbeebcc6ee6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2013 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2014 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Variables @chapter Variables @@ -10,10 +10,10 @@ In Lisp, each variable is represented by a Lisp symbol (@pxref{Symbols}). The variable name is simply the symbol's name, and the variable's value is stored in the symbol's value cell@footnote{To -be precise, under the default @dfn{dynamic binding} rules the value +be precise, under the default @dfn{dynamic scoping} rule, the value cell always holds the variable's current value, but this is not the -case under @dfn{lexical binding} rules. @xref{Variable Scoping}, for -details.}. @xref{Symbol Components}. In Emacs Lisp, the use of a +case under the @dfn{lexical scoping} rule. @xref{Variable Scoping}, +for details.}. @xref{Symbol Components}. In Emacs Lisp, the use of a symbol as a variable is independent of its use as a function name. As previously noted in this manual, a Lisp program is represented @@ -292,20 +292,22 @@ has room to execute. @cindex void variable We say that a variable is void if its symbol has an unassigned value -cell (@pxref{Symbol Components}). Under Emacs Lisp's default dynamic -binding rules (@pxref{Variable Scoping}), the value cell stores the -variable's current (local or global) value. Note that an unassigned -value cell is @emph{not} the same as having @code{nil} in the value -cell. The symbol @code{nil} is a Lisp object and can be the value of -a variable, just as any other object can be; but it is still a value. -If a variable is void, trying to evaluate the variable signals a -@code{void-variable} error rather than a value. +cell (@pxref{Symbol Components}). - Under lexical binding rules, the value cell only holds the -variable's global value, i.e., the value outside of any lexical -binding construct. When a variable is lexically bound, the local value -is determined by the lexical environment; the variable may have a -local value if its symbol's value cell is unassigned. + Under Emacs Lisp's default dynamic scoping rule (@pxref{Variable +Scoping}), the value cell stores the variable's current (local or +global) value. Note that an unassigned value cell is @emph{not} the +same as having @code{nil} in the value cell. The symbol @code{nil} is +a Lisp object and can be the value of a variable, just as any other +object can be; but it is still a value. If a variable is void, trying +to evaluate the variable signals a @code{void-variable} error, instead +of returning a value. + + Under the optional lexical scoping rule, the value cell only holds +the variable's global value---the value outside of any lexical binding +construct. When a variable is lexically bound, the local value is +determined by the lexical environment; hence, variables can have local +values even if their symbols' value cells are unassigned. @defun makunbound symbol This function empties out the value cell of @var{symbol}, making the @@ -414,18 +416,23 @@ explicitly in the @code{defvar} form. The variable is marked as @dfn{special}, meaning that it should always be dynamically bound (@pxref{Variable Scoping}). -If @var{symbol} is void and @var{value} is specified, @code{defvar} -evaluates @var{value} and sets @var{symbol} to the result. But if -@var{symbol} already has a value (i.e., it is not void), @var{value} -is not even evaluated, and @var{symbol}'s value remains unchanged. If -@var{value} is omitted, the value of @var{symbol} is not changed in -any case. +If @var{value} is specified, and @var{symbol} is void (i.e., it has no +dynamically bound value; @pxref{Void Variables}), then @var{value} is +evaluated and @var{symbol} is set to the result. But if @var{symbol} +is not void, @var{value} is not evaluated, and @var{symbol}'s value is +left unchanged. If @var{value} is omitted, the value of @var{symbol} +is not changed in any case. If @var{symbol} has a buffer-local binding in the current buffer, -@code{defvar} operates on the default value, which is buffer-independent, -not the current (buffer-local) binding. It sets the default value if +@code{defvar} acts on the default value, which is buffer-independent, +rather than the buffer-local binding. It sets the default value if the default value is void. @xref{Buffer-Local Variables}. +If @var{symbol} is already lexically bound (e.g., if the @code{defvar} +form occurs in a @code{let} form with lexical binding enabled), then +@code{defvar} sets the dynamic value. The lexical binding remains in +effect until its binding construct exits. @xref{Variable Scoping}. + When you evaluate a top-level @code{defvar} form with @kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} arranges to set the variable unconditionally, without @@ -761,6 +768,7 @@ error is signaled. @node Variable Scoping @section Scoping Rules for Variable Bindings +@cindex scoping rule When you create a local binding for a variable, that binding takes effect only within a limited portion of the program (@pxref{Local @@ -774,12 +782,12 @@ binding can be accessed. @dfn{Extent} refers to @emph{when}, as the program is executing, the binding exists. @cindex dynamic binding -@cindex indefinite scope +@cindex dynamic scope @cindex dynamic extent By default, the local bindings that Emacs creates are @dfn{dynamic -bindings}. Such a binding has @dfn{indefinite scope}, meaning that -any part of the program can potentially access the variable binding. -It also has @dfn{dynamic extent}, meaning that the binding lasts only +bindings}. Such a binding has @dfn{dynamic scope}, meaning that any +part of the program can potentially access the variable binding. It +also has @dfn{dynamic extent}, meaning that the binding lasts only while the binding construct (such as the body of a @code{let} form) is being executed. @@ -788,11 +796,12 @@ being executed. @cindex indefinite extent Emacs can optionally create @dfn{lexical bindings}. A lexical binding has @dfn{lexical scope}, meaning that any reference to the -variable must be located textually within the binding construct. It -also has @dfn{indefinite extent}, meaning that under some -circumstances the binding can live on even after the binding construct -has finished executing, by means of special objects called -@dfn{closures}. +variable must be located textually within the binding +construct@footnote{With some exceptions; for instance, a lexical +binding can also be accessed from the Lisp debugger.}. It also has +@dfn{indefinite extent}, meaning that under some circumstances the +binding can live on even after the binding construct has finished +executing, by means of special objects called @dfn{closures}. The following subsections describe dynamic binding and lexical binding in greater detail, and how to enable lexical binding in Emacs @@ -814,8 +823,8 @@ at any point in the execution of the Lisp program is simply the most recently-created dynamic local binding for that symbol, or the global binding if there is no such local binding. - Dynamic bindings have indefinite scope and dynamic extent, as shown -by the following example: + Dynamic bindings have dynamic scope and extent, as shown by the +following example: @example @group @@ -841,9 +850,9 @@ The function @code{getx} refers to @code{x}. This is a ``free'' reference, in the sense that there is no binding for @code{x} within that @code{defun} construct itself. When we call @code{getx} from within a @code{let} form in which @code{x} is (dynamically) bound, it -retrieves the local value of @code{x} (i.e., 1). But when we call -@code{getx} outside the @code{let} form, it retrieves the global value -of @code{x} (i.e., -99). +retrieves the local value (i.e., 1). But when we call @code{getx} +outside the @code{let} form, it retrieves the global value (i.e., +-99). Here is another example, which illustrates setting a dynamically bound variable using @code{setq}: @@ -888,12 +897,11 @@ technique: @itemize @bullet @item If a variable has no global definition, use it as a local variable -only within a binding construct, e.g., the body of the @code{let} -form where the variable was bound, or the body of the function for an -argument variable. If this convention is followed consistently -throughout a program, the value of the variable will not affect, nor -be affected by, any uses of the same variable symbol elsewhere in the -program. +only within a binding construct, such as the body of the @code{let} +form where the variable was bound. If this convention is followed +consistently throughout a program, the value of the variable will not +affect, nor be affected by, any uses of the same variable symbol +elsewhere in the program. @item Otherwise, define the variable with @code{defvar}, @code{defconst}, or @@ -925,12 +933,16 @@ variables like @code{case-fold-search}: @node Lexical Binding @subsection Lexical Binding -Optionally, you can create lexical bindings in Emacs Lisp. A -lexically bound variable has @dfn{lexical scope}, meaning that any -reference to the variable must be located textually within the binding -construct. + Lexical binding was introduced to Emacs, as an optional feature, in +version 24.1. We expect its importance to increase in the future. +Lexical binding opens up many more opportunities for optimization, so +programs using it are likely to run faster in future Emacs versions. +Lexical binding is also more compatible with concurrency, which we +want to add to Emacs in the future. - Here is an example + A lexically-bound variable has @dfn{lexical scope}, meaning that any +reference to the variable must be located textually within the binding +construct. Here is an example @iftex (see the next subsection, for how to actually enable lexical binding): @end iftex @@ -969,6 +981,14 @@ wants the current value of a variable, it looks first in the lexical environment; if the variable is not specified in there, it looks in the symbol's value cell, where the dynamic value is stored. + (Internally, the lexical environment is an alist of symbol-value +pairs, with the final element in the alist being the symbol @code{t} +rather than a cons cell. Such an alist can be passed as the second +argument to the @code{eval} function, in order to specify a lexical +environment in which to evaluate a form. @xref{Eval}. Most Emacs +Lisp programs, however, should not interact directly with lexical +environments in this way; only specialized programs like debuggers.) + @cindex closures, example of using Lexical bindings have indefinite extent. Even after a binding construct has finished executing, its lexical environment can be @@ -988,7 +1008,7 @@ Here is an example: (setq my-ticker (lambda () (setq x (1+ x))))) @result{} (closure ((x . 0) t) () - (1+ x)) + (setq x (1+ x))) (funcall my-ticker) @result{} 1 @@ -1019,13 +1039,6 @@ binding of @code{x} in that lexical environment. the body of a @code{defun} or @code{defmacro} cannot refer to surrounding lexical variables. - Currently, lexical binding is not much used within the Emacs -sources. However, we expect its importance to increase in the future. -Lexical binding opens up a lot more opportunities for optimization, so -Emacs Lisp code that makes use of lexical binding is likely to run -faster in future Emacs versions. Such code is also much more friendly -to concurrency, which we want to add to Emacs in the near future. - @node Using Lexical Binding @subsection Using Lexical Binding @@ -1069,12 +1082,15 @@ discouraged. Doing so gives rise to unspecified behavior when lexical binding mode is enabled (it may use lexical binding sometimes, and dynamic binding other times). - Converting an Emacs Lisp program to lexical binding is pretty easy. -First, add a file-local variable setting of @code{lexical-binding} to -@code{t} in the Emacs Lisp source file. Second, check that every -variable in the program which needs to be dynamically bound has a -variable definition, so that it is not inadvertently bound lexically. + Converting an Emacs Lisp program to lexical binding is easy. First, +add a file-local variable setting of @code{lexical-binding} to +@code{t} in the header line of the Emacs Lisp source file (@pxref{File +Local Variables}). Second, check that every variable in the program +which needs to be dynamically bound has a variable definition, so that +it is not inadvertently bound lexically. +@cindex free variable +@cindex unused lexical variable A simple way to find out which variables need a variable definition is to byte-compile the source file. @xref{Byte Compilation}. If a non-special variable is used outside of a @code{let} form, the @@ -1649,8 +1665,7 @@ non-@code{nil} given that value. Many commonly-encountered file variables have @code{safe-local-variable} properties; these include @code{fill-column}, @code{fill-prefix}, and @code{indent-tabs-mode}. For boolean-valued variables that are safe, use @code{booleanp} as the -property value. Lambda expressions should be quoted so that -@code{describe-variable} can display the predicate. +property value. When defining a user option using @code{defcustom}, you can set its @code{safe-local-variable} property by adding the arguments @@ -1835,9 +1850,16 @@ modification times of the associated directory local variables file updates this list. @end defvar +@defvar enable-dir-local-variables +If @code{nil}, directory-local variables are ignored. This variable +may be useful for modes that want to ignore directory-locals while +still respecting file-local variables (@pxref{File Local Variables}). +@end defvar + @node Variable Aliases @section Variable Aliases @cindex variable aliases +@cindex alias, for variables It is sometimes useful to make two variables synonyms, so that both variables always have the same value, and changing either one also diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 792002add81..f19a08c85e7 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2013 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2014 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Windows @@ -252,7 +252,7 @@ child windows form a horizontal combination, consisting of the live window @var{W2} and the internal window @var{W3}. The child windows of @var{W3} form a vertical combination, consisting of the live windows @var{W4} and @var{W5}. Hence, the live windows in this -window tree are @var{W2} @var{W4}, and @var{W5}. +window tree are @var{W2}, @var{W4}, and @var{W5}. The following functions can be used to retrieve a child window of an internal window, and the siblings of a child window. @@ -717,7 +717,7 @@ window. This section describes functions for creating a new window by @dfn{splitting} an existing one. -@deffn Command split-window &optional window size side +@defun split-window &optional window size side This function creates a new live window next to the window @var{window}. If @var{window} is omitted or @code{nil}, it defaults to the selected window. That window is ``split'', and reduced in @@ -767,7 +767,7 @@ called with the arguments @var{window}, @var{size}, and @var{side}, in lieu of the usual action of @code{split-window}. Otherwise, this function obeys the @code{window-atom} or @code{window-side} window parameter, if any. @xref{Window Parameters}. -@end deffn +@end defun As an example, here is a sequence of @code{split-window} calls that yields the window configuration discussed in @ref{Windows and Frames}. @@ -1164,7 +1164,7 @@ vertical combination @var{W1}. @cindex window combination limit @defun set-window-combination-limit window limit -This functions sets the @dfn{combination limit} of the window +This function sets the @dfn{combination limit} of the window @var{window} to @var{limit}. This value can be retrieved via the function @code{window-combination-limit}. See below for its effects; note that it is only meaningful for internal windows. The @@ -1355,10 +1355,9 @@ within that frame. @var{frame} should be a live frame; if omitted or @defun set-frame-selected-window frame window &optional norecord This function makes @var{window} the window selected within the frame -@var{frame}. @var{frame} should be a live frame; if omitted or -@code{nil}, it defaults to the selected frame. @var{window} should be -a live window; if omitted or @code{nil}, it defaults to the selected -window. +@var{frame}. @var{frame} should be a live frame; if @code{nil}, it +defaults to the selected frame. @var{window} should be a live window; +if @code{nil}, it defaults to the selected window. If @var{frame} is the selected frame, this makes @var{window} the selected window. @@ -1843,7 +1842,10 @@ The constant @code{display-buffer-fallback-action}. @noindent Each action function is called in turn, passing the buffer as the first argument and the combined action alist as the second argument, -until one of the functions returns non-@code{nil}. +until one of the functions returns non-@code{nil}. The caller can +pass @code{(allow-no-window . t)} as an element of the action alist to +indicate its readiness to handle the case of not displaying the +buffer in a window. The argument @var{action} can also have a non-@code{nil}, non-list value. This has the special meaning that the buffer should be @@ -1925,6 +1927,10 @@ frames to search for a reusable window: A frame means consider windows on that frame only. @end itemize +Note that these meanings differ slightly from those of the +@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window +Ordering}). + If @var{alist} contains no @code{reusable-frames} entry, this function normally searches just the selected frame; however, if the variable @code{pop-up-frames} is non-@code{nil}, it searches all frames on the @@ -2241,8 +2247,9 @@ window and defaults to the selected one. Each list element has the form @code{(@var{buffer} @var{window-start} @var{window-pos})}, where @var{buffer} is a buffer previously shown in -the window, @var{window-start} is the window start position when that -buffer was last shown, and @var{window-pos} is the point position when +the window, @var{window-start} is the window start position +(@pxref{Window Start and End}) when that buffer was last shown, and +@var{window-pos} is the point position (@pxref{Window Point}) when that buffer was last shown in @var{window}. The list is ordered so that earlier elements correspond to more @@ -2325,10 +2332,11 @@ same frame. The following option can be used to override this behavior. @defopt switch-to-visible-buffer If this variable is non-@code{nil}, @code{switch-to-prev-buffer} and @code{switch-to-next-buffer} may switch to a buffer that is already -visible on the same frame, provided the buffer was shown in the relevant -window before. If it is @code{nil}, @code{switch-to-prev-buffer} and -@code{switch-to-next-buffer} always try to avoid switching to a buffer -that is already visible in another window on the same frame. +visible on the same frame, provided the buffer was shown in the +relevant window before. If it is @code{nil}, +@code{switch-to-prev-buffer} and @code{switch-to-next-buffer} always +try to avoid switching to a buffer that is already visible in another +window on the same frame. The default is @code{t}. @end defopt @@ -2359,6 +2367,7 @@ showing another buffer in that frame's only window. The function @code{replace-buffer-in-windows} (@pxref{Buffers and Windows}) which is called when a buffer gets killed, deletes the window in case (1) and behaves like @code{delete-windows-on} otherwise. +@c FIXME: Does replace-buffer-in-windows _delete_ a window in case (1)? When @code{bury-buffer} (@pxref{The Buffer List}) operates on the selected window (which shows the buffer that shall be buried), it @@ -2563,6 +2572,7 @@ so @code{window-point} will stay behind text inserted there. @node Window Start and End @section The Window Start and End Positions @cindex window start position +@cindex display-start position Each window maintains a marker used to keep track of a buffer position that specifies where in the buffer display should start. This position @@ -3188,6 +3198,7 @@ The value returned is @var{columns}. Here is how you can determine whether a given position @var{position} is off the screen due to horizontal scrolling: +@c FIXME: Maybe hscroll-on-screen-p is a better name? @example @group (defun hscroll-on-screen (window position) @@ -3493,8 +3504,9 @@ the following function to restore the state of the window. This function puts the window state @var{state} into @var{window}. The argument @var{state} should be the state of a window returned by an earlier invocation of @code{window-state-get}, see above. The optional -argument @var{window} must specify a live window and defaults to the -selected one. +argument @var{window} must specify a valid window and defaults to the +selected one. If @var{window} is not live, it is replaced by a live +window before putting @var{state} into it. If the optional argument @var{ignore} is non-@code{nil}, it means to ignore minimum window sizes and fixed-size restrictions. If @var{ignore} diff --git a/doc/man/ChangeLog b/doc/man/ChangeLog index 8a2a90f7895..34ecda837ef 100644 --- a/doc/man/ChangeLog +++ b/doc/man/ChangeLog @@ -1,3 +1,19 @@ +2014-01-12 Glenn Morris + + * emacs.1: Replace reference to etc/MAILINGLISTS. + +2014-01-09 Glenn Morris + + * emacs.1: Refer to online service directory rather than etc/SERVICE. + +2013-08-31 Ulrich Müller + + * emacs.1: Update manual links. + +2013-04-20 Petr Hracek (tiny change) + + * emacs.1: Add some more command-line options. (Bug#14165) + 2012-12-02 Kevin Ryde * etags.1: Mention effect of --declarations in Lisp. @@ -144,7 +160,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2007-2013 Free Software Foundation, Inc. + Copyright (C) 2007-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/man/ebrowse.1 b/doc/man/ebrowse.1 index 89506db98ef..ce887b0cf0c 100644 --- a/doc/man/ebrowse.1 +++ b/doc/man/ebrowse.1 @@ -85,7 +85,7 @@ was written by Gerd Moellmann. Copyright .if t \(co .if n (C) -2008-2013 Free Software Foundation, Inc. +2008-2014 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/man/emacs.1 b/doc/man/emacs.1 index 3d0c5107adc..04475d35da7 100644 --- a/doc/man/emacs.1 +++ b/doc/man/emacs.1 @@ -79,12 +79,22 @@ Go to the specified and .IR column . .TP +.BI \-\-chdir " directory" +Change to +.IR directory . +.TP .BR \-q ", " \-\-no\-init\-file Do not load an init file. .TP +.BR \-nl ", " \-\-no\-shared\-memory +Do not use shared memory. +.TP .B \-\-no\-site\-file Do not load the site-wide startup file. .TP +.BR \-nsl ", " \-\-no\-site\-lisp +Do not add site-lisp directories to load-path. +.TP .B \-\-no\-desktop Do not load a saved desktop. .TP @@ -325,6 +335,9 @@ in iconified state. .BR \-nbc ", " \-\-no\-blinking\-cursor Disable blinking cursor. .TP +.BI \-\-parent-id " xid" +Set parent window. +.TP .BR \-nw ", " \-\-no\-window\-system Tell .I Emacs @@ -432,7 +445,7 @@ Gives frames menu bars if .IR on ; don't have menu bars if .IR off . -See the Emacs manual, sections "Lucid Resources" and "LessTif +See the Emacs manual, sections "Lucid Resources" and "Motif Resources", for how to control the appearance of the menu bar if you have one. .TP @@ -479,7 +492,7 @@ The scroll bar width in pixels, equivalent to the frame parameter Font name for pop-up menu items, in non-toolkit versions of .IR Emacs . (For toolkit versions, see the Emacs manual, sections -"Lucid Resources" and "LessTif Resources".) +"Lucid Resources" and "Motif Resources".) .TP .BR selectionTimeout " (class " SelectionTimeout ) Number of milliseconds to wait for a selection reply. @@ -563,9 +576,6 @@ strings for the Lisp primitives and preloaded Lisp functions of GNU Emacs. They are stored here to reduce the size of Emacs proper. -/usr/local/share/emacs/$VERSION/etc/SERVICE lists people offering -various services to assist users of GNU Emacs, including education, -troubleshooting, porting and customization. . . .SH BUGS @@ -584,12 +594,11 @@ easily reproduced. Do not expect a personal answer to a bug report. The purpose of reporting bugs is to get them fixed for everyone in the next release, if possible. -For personal assistance, look in the SERVICE file (see above) for -a list of people who offer it. +For personal assistance, consult the service directory at + for a list of people who offer it. Please do not send anything but bug reports to this mailing list. -For more information about Emacs mailing lists, see the -file /usr/local/share/emacs/$VERSION/etc/MAILINGLISTS. +For other Emacs lists, see . . . .SH UNRESTRICTIONS @@ -642,7 +651,7 @@ For detailed credits and acknowledgments, see the GNU Emacs manual. Copyright .if t \(co .if n (C) -1995, 1999-2013 Free Software Foundation, Inc. +1995, 1999-2014 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/man/etags.1 b/doc/man/etags.1 index 5ccf528868b..7d13892c15f 100644 --- a/doc/man/etags.1 +++ b/doc/man/etags.1 @@ -268,7 +268,7 @@ Stallman. Copyright .if t \(co .if n (C) -1992, 1999, 2001-2013 Free Software Foundation, Inc. +1992, 1999, 2001-2014 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/man/grep-changelog.1 b/doc/man/grep-changelog.1 index ef4b2900988..a3635a61838 100644 --- a/doc/man/grep-changelog.1 +++ b/doc/man/grep-changelog.1 @@ -62,7 +62,7 @@ Display basic usage information. Copyright .if t \(co .if n (C) -2008-2013 Free Software Foundation, Inc. +2008-2014 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index b256bac417f..cdd0bc9472f 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,9 +1,1318 @@ +2014-02-22 Xue Fuqiao + + * remember.texi (Quick Start): Add an index. + (Function Reference, Quick Start): Add cross-references. + +2014-02-21 Glenn Morris + + * flymake.texi (Starting the syntax check process): Grammar fix. + + * tramp.texi (External packages): Grammar fix. + Reword for default sentinel not being nil any more. + +2014-02-19 Michael Albinus + + * trampver.texi: Update release number. + +2014-02-19 Glenn Morris + + * remember.texi: Copyedits. + (Quick Start): No need for manual autoloads. Mention remember-notes. + (Function Reference): Update arguments. Add new commands. + +2014-02-18 Glenn Morris + + * remember.texi (copying): Bump remember mode version. + (Installation): Remove unnecessary chapter. + (Quick Start): No need to explicitly load remember.el. + (Separate Text Files): New section. + +2014-02-17 Glenn Morris + + * eieio.texi (Class Values, CLOS compatibility): + Remove references to deleted eieio-describe-class/generic. + +2014-02-16 Michael Albinus + + Sync with Tramp 2.2.9. + * trampver.texi: Update release number. + + * efaq-w32.texi (Tramp ssh): Remove also pscp1 and pscp2. + +2014-02-14 Jay Belanger + + * calc.texi (Single-Variable Statistics): Remove mention of + incorrect keybinding. + +2014-02-12 Paul Eggert + + * texinfo.tex: Update from gnulib. + +2014-02-08 Glenn Morris + + * auth.texi (GnuPG and EasyPG Assistant Configuration): + Be agnostic about authinfo/authinfo.gpg default order. (Bug#16642) + +2014-02-07 Glenn Morris + + * viper.texi (File and Buffer Handling): Prefer ido to iswitchb. + +2014-02-06 Glenn Morris + + * epa.texi (Mail-mode integration): Mention epa-mail-aliases. + + * mh-e.texi, viper.texi: Do not use colons in index entries. + +2014-02-05 Paul Eggert + + * texinfo.tex: Update from gnulib. + +2014-02-05 Glenn Morris + + * epa.texi: Add indices. + + * url.texi (Cookies): Mention url-cookie-list command. + +2014-02-03 Glenn Morris + + * cl.texi (Blocks and Exits): Mention cl-tagbody. + +2014-02-02 Glenn Morris + + * efaq-w32.texi (Tramp ssh): Remove deleted tramp methods. + +2014-01-31 Glenn Morris + + * efaq.texi (Replacing highlighted text): + Update delete-selection-mode doc. + +2014-01-30 Xue Fuqiao + + * sem-user.texi (Include paths): Fix a Texinfo command. + +2014-01-27 Glenn Morris + + * idlwave.texi (Lesson III---User Catalog, Online Help) + (Starting the Shell, Catalogs, User Catalog): + * remember.texi (Quick Start): + * viper.texi: + * vip.texi (Customization, Customizing Constants) + (Customizing Key Bindings): Update for files being in ~/.emacs.d/. + +2014-01-25 Xue Fuqiao + + * cc-mode.texi (Minor Modes): Minor fix. + +2014-01-24 David Engster + + * eieio.texi (Introduction): Fix references. + +2014-01-24 Glenn Morris + + * efaq.texi (Termcap/Terminfo entries for Emacs): + Use M-x term rather than M-x terminal-emulator. + + * emacs-mime.texi (time-date): Use float-time. + +2014-01-22 David Engster + + * eieio.texi (Introduction): Move introductory paragraph about + EIEIO and CLOS from 'Building Classes' to here. + (Documentation): Remove, since eieio-doc is not part of Emacs. + (Class Values, CLOS compatibility): Mention that + `describe-function' will also give information about classes. + +2014-01-20 Paul Eggert + + * texinfo.tex: Update from gnulib. + +2014-01-15 Glenn Morris + + * Makefile.in (eww_deps): Does not depend on emacsver.texi. + +2014-01-12 Michael Albinus + + * tramp.texi (all): Doc fix according to GNU Coding Standards. + Use "file name" instead of "filename" or "path". Use "host" + instead of "machine". + +2014-01-12 David Engster + + * eieio.texi (Introduction): `class-of' is obsolete. + (Predicates, Basic Methods): Adapt function names to namespace + cleanup. + +2014-01-12 Xue Fuqiao + + * eww.texi (Basics): Use "directory" instead of "path" (Bug#16419). + +2014-01-12 Glenn Morris + + * efaq.texi (Guidelines for newsgroup postings) + (Informational files for Emacs): + Remove references to etc/MAILINGLISTS, etc/INTERVIEW. + +2014-01-10 Stefan Monnier + + * cl.texi (Function Bindings): Fix incorrect description of cl-let. + +2014-01-09 Rüdiger Sonderfeld + + * Makefile.in: Add eww.texi. + * eww.texi: New file. + +2014-01-07 Glenn Morris + + * efaq.texi (Problems with very large files): Fix superscript typo. + +2013-01-07 Rasmus + + * org.texi (Global and local cycling): Fix missing '@'. + +2013-01-07 Bastien Guerry + + * org.texi (Global and local cycling): Mention C-u C-u TAB. + (Include files, The Export Dispatcher) + (Advanced configuration) + (Header arguments in Org mode properties): Spelling fixes. + (Special blocks): Add #+BEGIN_ABSTRACT as another example. + (@LaTeX{} specific attributes): New index entries. + Use #+BEGIN_ABSTRACT in the example. + +2013-01-07 Nicolas Goaziou + + * org.texi (Org export): New section. + (HTML doctypes): Fix whitespace error. Fix display. + (Publishing options): Add missing html publishing options. + +2014-01-07 Glenn Morris + + * efaq.texi (Basic editing, Packages that do not come with Emacs): + Merge in some info from etc/MORE.STUFF. + +2014-01-05 Paul Eggert + + Specify .texi encoding (Bug#16292). + * ada-mode.texi, auth.texi, autotype.texi, bovine.texi, calc.texi: + * cc-mode.texi, cl.texi, dbus.texi, dired-x.texi, ebrowse.texi: + * ede.texi, ediff.texi, edt.texi, efaq.texi, eieio.texi: + * emacs-gnutls.texi, epa.texi, erc.texi, ert.texi: + * eshell.texi, eudc.texi, flymake.texi, forms.texi, gnus-coding.texi: + * gnus-faq.texi, htmlfontify.texi, idlwave.texi, ido.texi, info.texi: + * message.texi, mh-e.texi, newsticker.texi, nxml-mode.texi: + * octave-mode.texi, org.texi, pcl-cvs.texi, pgg.texi, rcirc.texi: + * reftex.texi, remember.texi, sasl.texi, sc.texi, semantic.texi: + * ses.texi, sieve.texi, smtpmail.texi, speedbar.texi, srecode.texi: + * todo-mode.texi, tramp.texi, url.texi, vip.texi, viper.texi: + * widget.texi, wisent.texi, woman.texi: + Add @documentencoding. + +2014-01-03 Aidan Gauland + + * eshell.texi (What Eshell is not): Clean up confusing clause. + +2014-01-03 Glenn Morris + + * efaq-w32.texi, reftex.texi: Use @insertcopying in non-TeX. + + * ede.texi, eieio.texi, semantic.texi, srecode.texi: + Add copyright notice to titlepage. + + * dbus.texi, nxml-mode.texi, widget.texi: Add titlepage. + + * ert.texi: Add a titlepage. Use @insertcopying. + + * calc.texi (Top): Use @top rather than @chapter. + +2014-01-03 Aidan Gauland + + * eshell.texi (top): Fix incorrect use of xref. + +2014-01-03 Aidan Gauland + + * eshell.texi (top): Fix incorrect info filename in an xref. + +2014-01-02 Glenn Morris + + * Makefile.in (cc_mode_deps): Rename from (typo) ccmode_deps. + +2014-01-02 Aidan Gauland + + * eshell.texi (Command Basics): Remove `Command basics' chapter. + +2014-01-02 Aidan Gauland + + * eshell.texi (What is Eshell?): Add section about what not to use + Eshell for. + +2013-12-23 Teodor Zlatanov + + * emacs-gnutls.texi (Help For Users): Document `gnutls-verify-error'. + +2013-12-22 Glenn Morris + + * woman.texi (Navigation): Use itemx where appropriate. + +2013-12-20 Tassilo Horn + + * info.texi, woman.texi: + Document `S-SPC' as alternative to `DEL' for scrolling. + +2013-12-20 Jay Belanger + + * calc.texi (Stack Manipulation Commands): Mention using the variable + `calc-context-sensitive-enter' for `calc-enter' and `calc-pop'. + +2013-12-12 Michael Albinus + + * tramp.texi (direntry): Use ssh but rsh. + (all): Encode all environment variable names with @env{...}. + (Bug Reports): Refer to Testing node. + +2013-12-12 Glenn Morris + + * autotype.texi, cc-mode.texi, ediff.texi, ert.texi: + * htmlfontify.texi, ido.texi, octave-mode.texi, org.texi: + * srecode.texi, todo-mode.texi, tramp.texi: + Sync direntry with info/dir version. + +2013-12-11 Rüdiger Sonderfeld + + * Makefile.in: Add octave-mode.texi. + +2013-12-11 Kurt Hornik + Rüdiger Sonderfeld + + * octave-mode.texi: Import from GNU Octave (doc/interpreter/emacs.txi). + +2013-12-08 Juanma Barranquero + + * dbus.texi (Properties and Annotations): Fix typo. + +2013-12-06 Bastien Guerry + + * org.texi: Don't include Emacs version within Org's version. + +2013-12-06 Nicolas Goaziou + + * org.texi (Creating one-off styles): Use new export snippet + syntax. + + * org.texi (Export settings): Documentation describing how text + above the first heading is ignored when an :export: tag is in a + file. + +2013-12-05 Michael Albinus + + * dbus.texi (Type Conversion): Clarify unibyte-ness of strings. + +2013-11-30 Glenn Morris + + * Makefile.in (distclean): Remove Makefile. + +2013-11-20 era eriksson + + * ses.texi (Quick Tutorial): New chapter. (Bug#14748) + (The Basics, Formulas): Copyedits. + (Resizing, Printer functions): Add index entries. + +2013-11-17 Jay Belanger + + * calc.texi (Customizing Calc): Mention new variable + `calc-context-sensitive-enter'. + +2013-11-12 Aaron Ecay + + * org.texi (Exporting code blocks): Document the 'inline-only + setting for `org-export-babel-evaluate'. Document how :var + introduces code block dependencies. + +2013-11-12 Achim Gratz + + * org.texi (Header arguments): Document header-args[:lang] + properties and remove deprecated old-style properties from + documentation. + + * org.texi (Agenda commands): Remove footnote from @tsubheading + and add a sentence with the reference instead. + +2013-11-12 Bastien Guerry + + * org.texi (Catching invisible edits): + * org.texi (Plain lists, Plain lists): + * org.texi (Advanced configuration): + * org.texi (Tag groups): + * org.texi (Conventions): + * org.texi (Checkboxes, Radio lists): + * org.texi (Top, Summary, Exporting): + * org.texi (In-buffer settings): Fix typos. + + * org.texi (Refile and copy): Document `org-copy' and `C-3 C-c + C-w'. Add an index entry for `org-refile-keep'. + + * org.texi (Plain lists): Add an index entry for sorting plain + list. Document sorting by checked status for check lists. + + * org.texi (Publishing options): Fix old variable names. + + * org.texi (Orgstruct mode): Fix suggested setting of + `orgstruct-heading-prefix-regexp'. + + * org.texi (Export settings): + Document `org-export-allow-bind-keywords'. + + * org.texi (History and Acknowledgments): Small rephrasing. + + * org.texi (Template elements): Add a footnote about tags accepted + in a year datetree. + + * org.texi (Beamer export, @LaTeX{} and PDF export) + (Header and sectioning, @LaTeX{} specific attributes): + Enhance style. + + * org.texi (Agenda commands): Add a footnote about dragging agenda + lines: it does not persist and it does not change the .org files. + + * org.texi (Agenda commands): Add a table heading for dragging + agenda lines forward/backward. + + * org.texi (Agenda commands): Add documentation for + `org-agenda-bulk-toggle' and `org-agenda-bulk-toggle-all'. + + * org.texi (Publishing options): Update the list of options. + (Simple example, Complex example): Fix the examples. + + * org.texi (Formula syntax for Calc): Don't use a bold font the + warning. + + * org.texi (Other built-in back-ends): New section. + + * org.texi (Editing source code): + Document `org-edit-src-auto-save-idle-delay' and + `org-edit-src-turn-on-auto-save'. + + * org.texi (External links): Document contributed link types + separately. + + * org.texi (Closing items): + Document `org-closed-keep-when-no-todo'. + + * org.texi (Export back-ends): Rename from "Export formats". + (The Export Dispatcher): Remove reference to + `org-export-run-in-background'. + (Export settings): Minor rewrites. + (ASCII/Latin-1/UTF-8 export): Update variable's name. + (In-buffer settings): Add #+HTML_HEAD_EXTRA. + + * org.texi (Export in foreign buffers): New section. + (Exporting): Remove documentation about converting the selected + region. + + * org.texi (Advanced configuration): Put the filter valid types in + a table. Use @lisp and @smalllisp. + + * org.texi: Use @code{nil} instead of nil. Update the maintainer + contact info. + + * org.texi (Exporting): Better introductory sentence. Add a note + about conversion commands. + (Feedback, Orgstruct mode, Built-in table editor) + (Built-in table editor, Orgtbl mode, Updating the table) + (Property syntax, Capturing column view, Capture) + (Agenda files, Agenda commands, CDLaTeX mode, CDLaTeX mode) + (Exporting, Extending ODT export) + (Working with @LaTeX{} math snippets, dir, Customization) + (Radio tables, A @LaTeX{} example, Pulling from MobileOrg): + Uniformly use @kbd{M-x command RET}. + + * org.texi (Filtering/limiting agenda items): New subsection. + Document the use of `org-agenda-max-*' options and + `org-agenda-limit-interactively' from the agenda. + (Agenda commands): Move details about filtering commands to + the new section, only include a summary here. + (Customizing tables in ODT export) + (System-wide header arguments, Conflicts, Dynamic blocks): + Use spaces for indentation. + + * org.texi (Emphasis and monospace): Mention `org-emphasis-alist'. + + * org.texi (Links in HTML export, Images in HTML export) + (post): Fix syntax within #+ATTR_*. + (Tables in HTML export): Document `org-html-table-row-tags' + and use `org-html-table-default-attributes' instead of + `org-html-table-tag'. + + * org.texi (Publishing action, Publishing options) + (Publishing links): Major rewrite. Enhance explanations for + `org-org-publish-to-org'. Remove reference to + `org-export-run-in-background'. + + * org.texi: Fix many small typos. Use #+NAME instead of + #+TBLNAME. Use @smalllisp instead of @example. + (Special symbols): Add index? + (HTML preamble and postamble): Don't mention obsolete use of + opt-plist. + (JavaScript support): Don't mention the org-jsinfo.el file as it + has been merged with ox-html.el. + + * org.texi (Installation, Feedback, Setting Options) + (Code evaluation security, org-crypt.el): Use @lisp instead of + @example. + (Agenda commands): Use @table instead of @example. + + * org.texi (Adding hyperlink types): New appendix. + + * org.texi (ODT export commands, Extending ODT export) + (Applying custom styles, Images in ODT export) + (Labels and captions in ODT export) + (Literal examples in ODT export) + (Configuring a document converter) + (Working with OpenDocument style files) + (Customizing tables in ODT export) + (Validating OpenDocument XML): Fix options names. + + * org.texi (History and Acknowledgments): Update acknowledgments + to Nicolas. Add Nicolas Goaziou to the list of contributors. + + * org.texi (System-wide header arguments): Don't use "customizing" + for setting a variable. Also remove comments. + + * org.texi (Weekly/daily agenda): Add `org-agenda-start-day' and + `org-agenda-start-on-weekday' to the variable index and document + them. + + * org.texi (Sparse trees, Agenda commands) + (@LaTeX{} fragments, Selective export, Export options) + (The export dispatcher, ASCII/Latin-1/UTF-8 export) + (HTML Export commands, @LaTeX{}/PDF export commands) + (iCalendar export, Publishing options, Triggering publication) + (In-buffer settings): Update to reflect changes from the new + export engine. + + * org.texi (Matching tags and properties): More examples. + Explain group tags expansion as regular expressions. + + * org.texi (Tag groups): New section. + + * org.texi (Setting tags): Tiny formatting fixes. + + * org.texi (Plain lists, Checkboxes): Use non-obsolete variable + names. + + * org.texi (Storing searches): Add "agenda" and "agenda*" to the + concept index. Include example for these agenda views. + (Special agenda views): Mention the "agenda*" agenda view. + + * org.texi (Repeated tasks): Document how to ignore a repeater + when using both a scheduled and a deadline timetamp. + + * org.texi (Global and local cycling): Wrap in a new subsection. + (Initial visibility, Catching invisible edits): New subsections. + + * org.texi (Visibility cycling): Mention that + `org-agenda-inhibit-startup' will prevent visibility setting when + the agenda opens an Org file for the first time. + + * org.texi (Org syntax): New section. + + * org.texi (Orgstruct mode): + Document `orgstruct-heading-prefix-regexp'. + + * org.texi (Speeding up your agendas): New section. + + * org.texi (Installation): When installing Org from ELPA, users + should do this from an Emacs session where no .org file has been + visited. + + * org.texi (CSS support, In-buffer settings): Update HTML options + names. + + * org.texi (Structure editing): Update documentation for + `org-insert-heading-or-item'. + (Plain lists, Relative timer): Update index entry. + + * org.texi (JavaScript support): Update variable names. + + * org.texi (comments): Minor formatting fix. + + * org.texi (@LaTeX{} fragments): Minor enhancement. + + * org.texi: Update the list contributions. + + * org.texi (Agenda commands): Exporting the agenda to an .org file + will not copy the subtrees and the inherited tags. + Document `org-agenda-filter-by-regexp'. + + * org.texi (Publishing action, Complex example): Fix names of + publishing functions. + + * org.texi (Top, Exporting): Delete references to Freemind. + (Freemind export): Delete section. + + * org.texi (Top, Exporting): Delete references to the XOXO export. + (XOXO export): Delete section. + + * org.texi (Capture): Mention that org-remember.el is not + supported anymore. + + * org.texi (Top, Exporting, Beamer class export): + Delete references to the TaskJuggler export. + (History and Acknowledgments): Mention that the TaskJuggler has + been rewritten by Nicolas and now lives in the contrib/ directory + of Org's distribution. Mention that Jambunathan rewrote the HTML + exporter. Remove Jambunathan from my own acknowledgments. + (TaskJuggler export): Delete. + + * org.texi (HTML preamble and postamble) + (Tables in HTML export, Images in HTML export) + (Math formatting in HTML export, CSS support) + (@LaTeX{} and PDF export, Publishing options): Fix the names of + the HTML export and publishing options. + + * org.texi (Literal examples, Export options) + (@LaTeX{} and PDF export, Header and sectioning) + (Publishing options): Fix LaTeX options names. + + * org.texi (Export options, CSS support, In-buffer settings): + Fix references to HTML_LINK_* and HTML_STYLE keywords. + + * org.texi (Export options, In-buffer settings): Fix references to + #+SELECT_TAGS and #+EXCLUDE_TAGS and remove reference to #+XSLT. + + * org.texi (Top, Markup, Initial text, Images and tables) + (@LaTeX{} fragments, @LaTeX{} fragments, Exporting) + (Export options, JavaScript support, Beamer class export): + Remove references to the DocBook export, which has been deleted. + (History and Acknowledgments): Mention that DocBook has been + deleted, suggest to use the Texinfo exporter instead, then to + convert the .texi to DocBook with makeinfo. + (Links in ODT export, Tables in ODT export): Fix indices. + + * org.texi (Deadlines and scheduling): Add a variable to the + index. Add documentation about delays for scheduled tasks. + + * org.texi (Emphasis and monospace): + Mention `org-fontify-emphasized-text' and + `org-emphasis-regexp-components'. + + * org.texi (References): Small enhancement. + + * org.texi (Column width and alignment): Make the example visually + more clear. + + * org.texi (The clock table): Document :mstart and :wstart as a + way to set the starting day of the week. + + * org.texi (In-buffer settings): Document new startup keywords. + Thanks to John J Foerch for this idea. + + * org.texi (Include files): Tiny formatting fix. + + * org.texi (Activation): Point to the "Conflicts" section. + +2013-11-12 Carsten Dominik + + * org.texi (CSS support): Clarify this section. + + * org.texi (@LaTeX{} specific attributes): Document that tabu and + tabularx packages are not in the default set of packages. + + * org.texi (Agenda commands): Document fortnight view. + + * org.texi: Document conflict with ecomplete.el. + + * org.texi (History and Acknowledgments): Acknowledgements for + Jason Dunsmore and Rakcspace. + + * org.texi: Rename org-crypt.el node to org-crypt. + + * org.texi (A @LaTeX{} example): Fix typo in variable name. + + * org.texi (MobileOrg): Mention the new iPhone developer. + + * org.texi (Table of contents) Improve documentation of TOC + placement. + + * org.texi: Explain that date/time information at read-date prompt + should start at the beginning, not anywhere in the middle of a + long string. + +2013-11-12 Christopher Schmidt + + * org.texi (Orgstruct mode): Fix wrong regexp. + +2013-11-12 Eric Abrahamsen + + * org.texi: Document export to (X)HTML flavors. + +2013-11-12 Eric Schulte + + * org.texi (Extracting source code): Mention the prefix argument + to org-babel-tangle. + (noweb): Remove erroneous negative. + (Specific header arguments): Document new header arguments. + Documentation for new tangle-mode header argument. + (Top): Documentation for new tangle-mode header argument. + (rownames): Documentation for new tangle-mode header argument. + Mention elisp as special rowname case. + (tangle-mode): Documentation for new tangle-mode header argument. + (post): Documentation and an example of usage. + (var): Remove the "Alternate argument syntax" section from the + documentation. + (hlines): Note that :hline has no effect for Emacs Lisp code + blocks. + +2013-11-12 Feng Shu + + * org.texi (@LaTeX{} fragments, Previewing @LaTeX{} fragments) + (Math formatting in HTML export) + (Working with @LaTeX{} math snippets): Add document about creating + formula image with imagemagick. + + * org.texi (@LaTeX{} specific attributes): Document `:caption' + attribute of #+ATTR_LATEX. + +2013-11-12 Grégoire Jadi + + * org.texi (Handling links): Fix a typo in + `org-startup-with-inline-images' documentation. + + * org.texi (Previewing @LaTeX{} fragments): Document the startup + keywords to use for previewing LaTeX fragments or not. + (Summary of in-buffer settings): Improve formatting and add an + entry for the variable `org-startup-with-latex-preview'. + + * org.texi (Property syntax): Recall the user to refresh the org + buffer when properties are set on a per-file basis. + +2013-11-12 Gustav Wikström (tiny change) + + * org.texi (Matching tags and properties): Clarification. + +2013-11-12 Ippei Furuhashi + + * org.texi (Editing and debugging formulas): Add an example when a + table has multiple #+TBLFM lines. + +2013-11-12 Ivan Vilata i Balaguer (tiny change) + + * org.texi (The clock table): Document acceptance of relative + times in tstart and tend, link to syntax description and provide + example. + +2013-11-12 Jarmo Hurri + + * org.texi (The spreadsheet): Document lookup functions. + +2013-11-12 Kodi Arfer (tiny change) + + * org.texi (CSS support): Mention .figure-number, .listing-number, + and .table-number. + +2013-11-12 Michael Brand + + * org.texi + (Formula syntax for Calc, Emacs Lisp forms as formulas): Reformat + spreadsheet formula mode strings and some examples from @example + block with xy @r{yz} to @table. + + * org.texi (Formula syntax for Calc): Improve the documentation of + empty fields in formulas for spreadsheet. Add explanation and + example for empty field. Extend explanations of format + specifiers. Add a sentence to mention Calc defmath. + + * org.texi (Column formulas): Add a sentence to be more explicit + about when a table header is mandatory. + +2013-11-12 Nicolas Goaziou + + * org.texi (Subscripts and superscripts): Remove reference to + quoted underscores until this mechanism is implemented again. + + * org.texi (Beamer export): Be more accurate about BEAMER_OPT + property. + + * org.texi (Document title): Subtree export is no longer triggered + by marking one as the region. + (Horizontal rules): LaTeX export doesn't use "\hrule" anymore, and + giving examples isn't very useful: "horizontal rule" is, at least, + as explicit as


          . + + * org.texi (HTML doctypes): Reflect keyword removal. + (CSS support): Reflect keyword removal. + + * org.texi (@LaTeX{} specific attributes): Document new :float + values. + + * org.texi (Export settings): Improve documentation. + + * org.texi (Math formatting in HTML export): Fix OPTIONS item's name. + (Text areas in HTML export): Update text areas. + (HTML Export commands): Update export commands. + + * org.texi (Header and sectioning): Add a footnote about the + different between LATEX_HEADER_EXTRA and LATEX_HEADER. + + * org.texi (The Export Dispatcher): + Document `org-export-in-background'. + + * org.texi (Footnotes): Export back-ends do not use + `org-footnote-normalize' anymore. + + * org.texi: Document variable changes. + + * org.texi (Export settings): Document p: item in OPTIONS keyword. + + * org.texi (Exporting): Massive rewrite of the first sections. + (Selective export): Delete. + (The Export Dispatcher): Rewrite. + (Export options): Rewrite as "Export settings". + + * org.texi: Small changes to documentation for embedded LaTeX. + + * org.texi (Internal links): Document #+NAME keyword and + cross-referencing during export. + + * org.texi (Include files): Remove reference to :prefix1 + and :prefix. Give more details for :minlevel. + + * org.texi (Macro replacement): Fix macro name. + Update documentation about possible locations and escaping mechanism. + + * org.texi (Table of contents): Update documentation. + Document lists of listings and lists of tables. Add documentation for + optional title and #+TOC: keyword. + +2013-11-12 Rick Frankel + + * org.texi (results): Add Format section, broken out of Type + section to match code. + (hlines, colnames): Remove incorrect Emacs Lisp exception. + Note that the actual default handling (at least for python and + emacs-lisp) does not seem to match the description. + +2013-11-12 Sacha Chua (tiny change) + + * org.texi (The date/time prompt): Update the documentation to + reflect the new way `org-read-date-get-relative' handles weekdays. + +2013-11-12 Yasushi Shoji + + * org.texi (Resolving idle time): + Document `org-clock-x11idle-program-name'. + +2013-10-24 Michael Albinus + + * ert.texi (Running Tests Interactively): Adapt examle output. + (Tests and Their Environment): Mention skip-unless. + +2013-10-23 Glenn Morris + + * dired-x.texi, ebrowse.texi, ede.texi, eieio.texi, eshell.texi: + * pcl-cvs.texi, sc.texi, srecode.texi, vip.texi, viper.texi: + * widget.texi: Nuke @refill. + + * Makefile.in (install-dvi, install-html, install-pdf) + (install-ps, uninstall-dvi, uninstall-html, uninstall-ps) + (uninstall-pdf): Quote entities that might contain whitespace. + +2013-10-17 Jay Belanger + + * calc.texi (Data Type Formats): Don't specify the size at + which integers begin to be represented by lists. + +2013-10-14 Xue Fuqiao + + * cl.texi (Argument Lists): Add indexes for &key and &aux. + +2013-10-07 Michael Albinus + + * trampver.texi: Update release number. + +2013-10-02 Michael Albinus + + Sync with Tramp 2.2.8. + + * tramp.texi (External packages): Use `non-essential'. + * trampver.texi: Update release number. + +2013-09-14 Glenn Morris + + * eshell.texi: Markup fixes. + +2013-09-11 Xue Fuqiao + + * ido.texi (Interactive Substring Matching): Use @key{RET} instead + of @kbd{RET}. + (Prefix Matching): Add an index. + +2013-09-08 Glenn Morris + + * emacs-gnutls.texi: Tweak direntry. + +2013-09-06 Michael Albinus + + * tramp.texi (Alternative Syntax): Remove chapter. + +2013-08-28 Paul Eggert + + * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, + for portability to hosts where /bin/sh has problems. + +2013-08-28 Stefan Monnier + + Try to reduce redundancy in doc/misc/Makefile.in. + * Makefile.in (DOCMISC_W32): New var to replace DOCMISC_*_W32. + (TARGETS): New intermediate variable. + (DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): Use it. + +2013-08-27 Glenn Morris + + * efaq.texi (Emacs for MS-Windows): Update location of MS FAQ. + + * efaq.texi: Rename from faq.texi, to match its output files. + * Makefile.in: Update for faq.texi name change. + + * efaq-w32.texi (EMACSVER): Get it from emacsver.texi. + + * Makefile.in (webhack): Remove; it's nothing to do with Emacs. + + * efaq-w32.texi: Move here from the web-pages repository. + * Makefile.in (DOCMISC_DVI_W32, DOCMISC_HTML_W32, DOCMISC_INFO_W32) + (DOCMISC_PDF_W32, DOCMISC_PS_W32): New configure output variables. + (INFO_COMMON, INFO_INSTALL): New derivations of INFO_TARGETS. + (DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): + Add DOCMISC_*_W32 variables. + (echo-info): Use INFO_INSTALL rather than INFO_TARGETS. + (efaq_w32_deps): New variable. + (efaq-w32, $(buildinfodir)/efaq-w32$(INFO_EXT), efaq-w32.dvi) + (efaq-w32.pdf, efaq-w32.html): New rules. + (clean): Remove efaq-w32 products. + +2013-08-26 Paul Eggert + + * texinfo.tex: Update from gnulib. + +2013-08-19 Katsumi Yamaoka + + * emacs-mime.texi (Encoding Customization): Exclude iso-2022-jp-2 and + shift_jis from the default value set to mm-coding-system-priorities for + Japanese users. + +2013-08-13 Glenn Morris + + * reftex.texi (LaTeX xr Package, Options - Table of Contents) + (Options - Defining Label Environments, Options - Creating Labels) + (Options - Referencing Labels, Options - Creating Citations) + (Options - Index Support, Options - Viewing Cross-References) + (Options - Finding Files, Options - Optimizations) + (Options - Fontification, Options - Misc): + * cc-mode.texi (Sample Init File): + * edt.texi (Init file): + * epa.texi (Encrypting/decrypting gpg files): + * mairix-el.texi (About, Setting up the mairix interface, Using) + (Extending): + Rename nodes to avoid characters that can cause Texinfo problems. + +2013-08-12 Katsumi Yamaoka + + * gnus.texi (Mail Source Specifiers): Fix description for pop3's :leave. + +2013-08-12 Glenn Morris + + * Makefile.in (ada_mode_deps, auth_deps, autotype_deps) + (bovine_deps, calc_deps, ccmode_deps, cl_deps, dbus_deps) + (dired_x_deps, ebrowse_deps, ede_deps, ediff_deps, edt_deps) + (eieio_deps, emacs_gnutls_deps, emacs_mime_deps, epa_deps) + (erc_deps, ert_deps, eshell_deps, eudc_deps, faq_deps) + (flymake_deps, forms_deps, gnus_deps, htmlfontify_deps) + (idlwave_deps, ido_deps, info_deps, mairix_el_deps, message_deps) + (mh_e_deps, newsticker_deps, nxml_mode_deps, org_deps) + (pcl_cvs_deps, pgg_deps, rcirc_deps, reftex_deps, remember_deps) + (sasl_deps, sc_deps, semantic_deps, ses_deps, sieve_deps) + (smtpmail_deps, speedbar_deps, srecode_deps, todo_mode_deps) + (tramp_deps, url_deps, vip_deps, viper_deps, widget_deps) + (wisent_deps, woman_deps): New variables. Use to reduce duplication. + + * woman.texi (Top): Avoid mailto: in html output. + + * Makefile.in (prefix, datarootdir, datadir, PACKAGE_TARNAME) + (docdir, dvidir, htmldir, pdfdir, psdir, GZIP_PROG, INSTALL) + (INSTALL_DATA): New, set by configure. + (HTML_OPTS, HTML_TARGETS, PS_TARGETS, DVIPS): New variables. + (.PHONY): Add html, ps, install-dvi, install-html, install-pdf, + install-ps, install-doc, uninstall-dvi, uninstall-html, uninstall-pdf, + uninstall-ps, and uninstall-doc. + (.SUFFIXES): Add .ps and .dvi. + (.dvi.ps): New suffix rule. + (html, ps, ada-mode.html, auth.html, autotype.html, bovine.html) + (calc.html, cc-mode.html, cl.html, dbus.html, dired-x.html) + (ebrowse.html, ede.html, ediff.html, edt.html, eieio.html) + (emacs-gnutls.html, emacs-mime.html, epa.html, erc.html) + (ert.html, eshell.html, eudc.html, faq.html, flymake.html) + (forms.html, gnus.html, htmlfontify.html, idlwave.html) + (ido.html, mairix-el.html, message.html, mh-e.html) + (newsticker.html, nxml-mode.html, org.html, pgg.html) + (rcirc.html, reftex.html, remember.html, sasl.html, sc.html) + (semantic.html, sieve.html, smtpmail.html, speedbar.html) + (srecode.html, todo-mode.html, tramp.html, url.html, vip.html) + (viper.html, widget.html, wisent.html, woman.html, install-dvi) + (install-html, install-pdf, install-ps, install-doc, uninstall-dvi) + (uninstall-html, uninstall-ps, uninstall-pdf, uninstall-doc): + New rules. + (clean): Remove HTML_TARGETS and PS_TARGETS. + +2013-08-10 Xue Fuqiao + + * ido.texi (Working Directories): + (Flexible Matching, Regexp Matching, Find File At Point) + (Ignoring, Misc Customization): Use @defopt for user options. + +2013-08-09 Xue Fuqiao + + * htmlfontify.texi (Customization): Remove documentation of + `hfy-fast-lock-save'. Minor fixes. + +2013-08-08 Xue Fuqiao + + * ido.texi (Top): Insert node "Working Directories" in menu. + (Working Directories): New node. + (Misc Customization): Add documentation of + `ido-confirm-unique-completion' and some other user options. + +2013-08-07 Eli Zaretskii + + * todo-mode.texi: Update @dircategory. + (Overview, Todo Items as Diary Entries, Todo Mode Entry Points) + (File Editing, Marked Items, Item Prefix): Fix usage of @xref and + @ref. + +2013-08-07 Xue Fuqiao + + * sc.texi (Introduction): Fix index. + (Usage Overview): + (Citations, Citation Elements, Recognizing Citations) + (Information Keys and the Info Alist, Reference Headers) + (The Built-in Header Rewrite Functions) + (Electric References, Reply Buffer Initialization) + (Filling Cited Text, Selecting an Attribution) + (Attribution Preferences) + (Anonymous Attributions, Author Names) + (Using Regi, Post-yank Formatting Commands) + (Citing Commands, Insertion Commands) + (Mail Field Commands) + (Hints to MUA Authors, Thanks and History): Change from one space + between sentences to two. + (What Supercite Does): Typo fix. + + * newsticker.texi (Usage): Use @key for RET. + + * cl.texi (Argument Lists): + (For Clauses): + (Macros): Add indexes. + +2013-08-05 Xue Fuqiao + + * cl.texi (Blocks and Exits): Add an index. + +2013-08-04 Stephen Berman + + * Makefile.in (INFO_TARGETS, DVI_TARGETS, PDF_TARGETS): Add todo-mode. + (todo-mode, $(buildinfodir)/todo-mode$(INFO_EXT)): + (todo-mode.dvi, todo-mode.pdf): New rules. + + * todo-mode.texi: New file. + +2013-08-01 Lars Magne Ingebrigtsen + + * gnus.texi (Basic Usage): Mention that warp means jump here. + (The notmuch Engine): Mention notmuch. + +2013-07-30 Tassilo Horn + + * gnus.texi (Sorting the Summary Buffer): Document new defcustom + `gnus-subthread-sort-functions' and remove the obsolete documentation + of `gnus-sort-threads-recursively'. + +2012-07-30 Paul Eggert + + * texinfo.tex: Update to 2012-07-29.17 version. + +2013-07-29 David Engster + + * eieio.texi (top): Make clear that EIEIO is not a full CLOS + implementation. + (Introduction): Add further missing features. + (Building Classes): Add introductory paragraph. + (Wish List): Add metaclasses and EQL specialization. + +2013-07-29 Michael Albinus + + * tramp.texi (Frequently Asked Questions): + Mention `tramp-use-ssh-controlmaster-options'. + +2013-07-26 Tassilo Horn + + * gnus.texi (Sorting the Summary Buffer): Document new defcustom + `gnus-sort-threads-recursively'. + +2013-07-25 Glenn Morris + + * Makefile.in (INFO_TARGETS, DVI_TARGETS, PDF_TARGETS): Add ido. + (ido, $(buildinfodir)/ido$(INFO_EXT), ido.dvi, ido.pdf): New rules. + + * erc.texi (Special Features): Update contact information. + (History): Avoid using @email. + + * eshell.texi (Bugs and ideas): Minor updates. + + * faq.texi (Reporting bugs, Origin of the term Emacs) + (Setting up a customization file) + (Using an already running Emacs process, Turning off beeping) + (Packages that do not come with Emacs) + (Replying to the sender of a message): Avoid using @email. + + * pcl-cvs.texi (Contributors, Bugs): Avoid using @email. + + * reftex.texi (Imprint): Avoid using @email. + + * ses.texi (Top): Update bug reporting instructions. + (Acknowledgments): Avoid using @email. + + * woman.texi (Introduction, Background): Remove outdated information. + (Bugs, Acknowledgments): Avoid using @email. + +2013-07-24 Xue Fuqiao + + * ido.texi: New file. + +2013-07-19 Geoff Kuenning (tiny change) + + * gnus.texi (Customizing Articles): Document function predicates. + +2013-07-08 Tassilo Horn + + * gnus.texi (lines): Correct description of + `gnus-registry-track-extra's default value. + Mention `gnus-registry-remove-extra-data'. + +2013-07-06 Lars Ingebrigtsen + + * gnus.texi (Group Parameters): Mention regexp + substitutions (bug#11688). + +2013-07-06 Nathan Trapuzzano (tiny change) + + * gnus.texi (Generic Marking Commands): Fix grammar (bug#13368). + +2013-07-06 Lars Ingebrigtsen + + * gnus.texi (Emacsen): Fix version. + + * gnus-faq.texi (FAQ 1-6): Mention the correct Emacs version. + +2013-07-06 Glenn Morris + + * mh-e.texi: Fix external links. + (Using This Manual): Printed elisp manuals no longer available. + + * newsticker.texi (Overview): Update URL. + + * nxml-mode.texi (Introduction): Update URL. + + * org.texi (JavaScript support): Fix URL. + + * wisent.texi (Wisent Overview): Remove incorrect, unnecessary uref. + + * eudc.texi (CCSO PH/QI): Remove defunct URL. + + * dbus.texi (Introspection): Update URL to a less defunct one. + + * gnus.texi (Top): Restrict "Other related manuals" to info output. + (Foreign Groups): Use @indicateurl for examples. + (Direct Functions): Remove defunct URL. + (RSS): Update URL. + + * gnus-faq.texi (FAQ 5-8, FAQ 6-3): Remove defunct URLs. + (FAQ 7-1): Update URL. + + * pgg.texi (Top, Overview): Add note about obsolescence. + +2013-07-03 Paul Eggert + + * texinfo.tex: Merge from gnulib. + +2013-07-03 Glenn Morris + + * bovine.texi (top): + * cc-mode.texi (AWK Mode Font Locking): + * mh-e.texi (Preface): + * url.texi (URI Parsing): Fix cross-references to other manuals. + +2013-07-02 Lars Magne Ingebrigtsen + + * gnus.texi (Client-Side IMAP Splitting): + Note that `nnimap-inbox' now can be a list. + +2013-06-24 Glenn Morris + + * eshell.texi: Fix cross-references to other manuals. + +2013-06-23 Glenn Morris + + * Makefile.in (HTML_TARGETS, html, emacs-faq.html, emacs-faq): + Remove; not needed now we use a standard html layout for the faq. + (clean): Remove HTML_TARGETS, emacs-faq.text. + +2013-06-21 Eduard Wiebe + + * flymake.texi (Parsing the output, Customizable variables): + Add reference to `flymake-warning-predicate'. + +2013-06-19 Michael Albinus + + * tramp.texi (Top, Configuration): Insert section `Predefined + connection information' in menu. + (Predefined connection information): New section. + (Android shell setup): Make a reference to `Predefined connection + information'. + +2013-06-19 Glenn Morris + + * Makefile.in (version): New, set by configure. + (clean): Delete dist tar file. + (infoclean): New, split from maintainer-clean. + (maintainer-clean): Run infoclean. + (dist): New rule, to make tarfile for www.gnu.org. + +2013-06-13 Albert Krewinkel + + * sieve.texi (Managing Sieve): Fix port in example, fix documentation + for keys q and Q. + (Standards): Reference RFC5804 as the defining document of the + managesieve protocol. + +2013-06-10 Aidan Gauland + + * eshell.texi (Input/Output): Expand to cover new visual-command + options, eshell-visual-subcommands and eshell-visual-options. + Divide into separate Visual Commands and Redirection sections. + +2013-06-10 Glenn Morris + + * epa.texi (Cryptographic operations on files): Update epa-decrypt-file. + +2013-06-04 Katsumi Yamaoka + + * gnus.texi (Article Date): + Fix description of gnus-article-update-date-headers. + +2013-05-28 Xue Fuqiao + + * erc.texi (Special Features): ERC is being maintained within + Emacs now. + +2013-05-25 Xue Fuqiao + + * flymake.texi: Change from one space between sentences to two. + +2013-05-04 Stefan Monnier + + * cl.texi (Obsolete Macros): Describe replacements for `flet' + (bug#14293). + +2013-04-16 Michael Albinus + + * tramp.texi (Frequently Asked Questions): Precise, how to define + an own ControlPath. + +2013-04-15 Michael Albinus + + * tramp.texi (Frequently Asked Questions): New item for + ControlPath settings. + +2013-03-31 Jay Belanger + + * calc.texi (Basic Operations on Units): Streamline some + descriptions. + +2013-03-27 Aidan Gauland + + * eshell.texi (Built-ins): Update manual to mention tramp module. + +2013-03-18 Michael Albinus + + * tramp.texi (Filename Syntax): Host names are not allowed to be + any method name, unless method name is specified explicitly. + Remove restriction on unibyte filenames. + + * trampver.texi: Update release number. + +2013-03-17 Paul Eggert + + doc: convert some TeX accents to UTF-8 + * emacs-mime.texi (Interface Functions): Use 'ï' rather than + '@"{@dotless{i}}'. + +2013-03-15 Michael Albinus + + Sync with Tramp 2.2.7. + + * trampver.texi: Update release number. + +2013-03-09 Jay Belanger + + * calc.texi (Basic Operations on Units): Streamline some + descriptions. + +2013-03-08 Glenn Morris + + * faq.texi (Top): Don't say this was updated @today. + That's irrelevant and leads to spurious diffs. + +2013-03-08 Jay Belanger + + * calc.texi (Basic Operations on Units): + Fix cross-reference. + +2013-03-07 Katsumi Yamaoka + + * gnus-faq.texi (FAQ 3-11): Now Gnus supports POP3 UIDL. + +2013-03-06 Alan Mackenzie + + * cc-mode.texi (Custom Line-Up): Clarify position of point on + calling a line-up function. + +2013-03-04 Paul Eggert + + * emacs-mime.texi, htmlfontify.texi, mairix-el.texi, mh-e.texi: + * ses.texi: Switch from Latin-1 to UTF-8. + +2013-03-03 Michael Albinus + + * tramp.texi (External methods): Tramp does not connect Android + devices by itself. + +2013-03-02 Bill Wohler + + Release MH-E manual version 8.5. + + * mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for + release 8.5. + + * mh-e.texi (Preface, Conventions, Getting Started) + (Using This Manual, Folder Selection, Viewing, Aliases) + (Identities, Speedbar, Menu Bar, Tool Bar, Scan Line Formats) + (Bug Reports, Mailing Lists, MH FAQ and Support, Getting MH-E): + Update URLs. + 2013-03-01 Michael Albinus * tramp.texi (Inline methods): Remove "ssh1", "ssh2", "plink1" and "plink2" entries. "plink2" is obsolete for a long time. - (External methods): Remove "scp1" and "scp2" entries. Explain - user name and host name specification for "adb". + (External methods): Remove "scp1" and "scp2" entries. + Explain user name and host name specification for "adb". 2013-02-28 Michael Albinus @@ -77,14 +1386,14 @@ 2013-02-07 Eric Ludlam - * doc/misc/ede.texi (Creating a project): Make ede-new doc less + * ede.texi (Creating a project): Make ede-new doc less specific, and only about items it supports, indicating that there might be more. Remove refs to simple project and direct automake from ede new. (Simple projects): Re-write to not talk about ede-simple-project which is deprecated, and instead use the term to mean projects - that don't do much management, just project wrapping. Add - ede-generic-project link. + that don't do much management, just project wrapping. + Add ede-generic-project link. (ede-generic-project): New node (bug#11441). 2013-02-07 Glenn Morris @@ -223,8 +1532,8 @@ 2012-12-24 Lars Ingebrigtsen - * gnus.texi (Browse Foreign Server): Document - `gnus-browse-delete-group'. + * gnus.texi (Browse Foreign Server): + Document `gnus-browse-delete-group'. 2012-12-22 Glenn Morris @@ -379,7 +1688,7 @@ Release MH-E manual version 8.4. - * mh-e.texi: (VERSION, EDITION, UPDATED, UPDATE-MONTH, Preface): + * mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH, Preface): Update for release 8.4. * mh-e.texi (Sequences): Add mh-whitelist-preserves-sequences-flag. @@ -409,7 +1718,7 @@ 2012-11-22 Jay Belanger - * doc/misc/calc.texi (Date Forms): Mention the customizable + * calc.texi (Date Forms): Mention the customizable Gregorian-Julian switch. (Customizing Calc): Mention the variable `calc-gregorian-switch'. @@ -441,8 +1750,8 @@ * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range. In all file place SES into @acronym{...}. (Advanced Features): Add key index and function index for - ses-set-header-row. Add description for function - ses-rename-cell. Add description for function + ses-set-header-row. Add description for function + ses-rename-cell. Add description for function ses-repair-cell-reference-all. (Ranges in formulas): Add description for ses-range flags. @@ -461,8 +1770,8 @@ Improve docs for url-queue-*. (Supported URL Types): Copyedits. Delete empty subnodes. - * url.texi (Introduction): Rename from Getting Started. Rewrite - the introduction. + * url.texi (Introduction): Rename from Getting Started. + Rewrite the introduction. (URI Parsing): Rewrite. Omit the obsolete attributes slot. 2012-11-10 Glenn Morris @@ -562,14 +1871,14 @@ 2012-10-26 Bastien Guerry - * org.texi (Installation): Update the link to Org's ELPA. Also - don't mention org-install.el anymore as the replacement file + * org.texi (Installation): Update the link to Org's ELPA. + Also don't mention org-install.el anymore as the replacement file org-loaddefs.el is now loaded by org.el. 2012-10-25 Michael Albinus - * tramp.texi (Frequently Asked Questions): Mention - `tramp-completion-reread-directory-timeout' for performance + * tramp.texi (Frequently Asked Questions): + Mention `tramp-completion-reread-directory-timeout' for performance improvement. 2012-10-25 Glenn Morris @@ -692,8 +2001,8 @@ (Referencing Labels): Update regarding reference styles. (Citation Styles): Mention support for ConTeXt. (Options (Defining Label Environments)): Fix typo. - (Options (Creating Citations)): Document - `reftex-cite-key-separator'. + (Options (Creating Citations)): + Document `reftex-cite-key-separator'. 2012-09-30 Achim Gratz @@ -725,8 +2034,8 @@ 2012-09-30 Bastien Guerry - * org.texi (Installation, Feedback, Batch execution): Use - (add-to-list 'load-path ... t) for the contrib dir. + * org.texi (Installation, Feedback, Batch execution): + Use (add-to-list 'load-path ... t) for the contrib dir. * org.texi (results): Update documentation for ":results drawer" and ":results org". @@ -753,8 +2062,8 @@ (Agenda commands): Reorder. Document `*' to toggle persistent marks. - * org.texi (Agenda dispatcher): Mention - `org-toggle-agenda-sticky'. + * org.texi (Agenda dispatcher): + Mention `org-toggle-agenda-sticky'. (Agenda commands, Exporting Agenda Views): Fix typo. * org.texi (Templates in contexts, Setting Options): Update to @@ -790,7 +2099,7 @@ * org.texi (Clocking commands): Document the use of S-M- on clock timestamps. - * org.texi (Fast access to TODO states): Explicitely says only + * org.texi (Fast access to TODO states): Explicitly says only letters are supported as fast TODO selection keys. * org.texi (Link abbreviations): Illustrate the use of the "%h" @@ -835,7 +2144,7 @@ * org.texi: The sections in the Exporting section of the manual left out articles in the description of the org-export-as-* - commands, among other places. This patch adds them, adds a few + commands, among other places. This patch adds them, adds a few missing prepositions, and switches instances of "an HTML" to "a html" for internal consistency. @@ -871,7 +2180,7 @@ corresponding function names, according to `org-agenda-view-mode-dispatch'. -2012-09-30 Jan Bäcker +2012-09-30 Jan Böcker * org.texi (The spreadsheet): Fix typo. @@ -883,7 +2192,7 @@ 2012-09-30 Nicolas Goaziou * org.texi (Literal examples): Remove reference to unknown - `org-export-latex-minted' variable. Also simplify footnote since + `org-export-latex-minted' variable. Also simplify footnote since `org-export-latex-listings' documentation is exhaustive already. * org.texi (Plain lists): Remove reference to now hard-coded @@ -924,13 +2233,13 @@ simplifications. (Basic Simplifications): Rename from "Limited Simplifications" Replace "limited" by "basic" throughout. - (Algebraic Simplifications): Indicate that the algebraic + (Algebraic Simplifications): Indicate that the algebraic simplifications are done by default. - (Unsafe Simplifications): Mention `m E'. + (Unsafe Simplifications): Mention `m E'. (Simplification of Units): Mention `m U'. (Trigonometric/Hyperbolic Functions, Reducing and Mapping) - (Kinds of Declarations, Functions for Declarations): Mention - "algebraic simplifications" instead of `a s'. + (Kinds of Declarations, Functions for Declarations): + Mention "algebraic simplifications" instead of `a s'. (Algebraic Entry): Remove mention of default simplifications. 2012-07-30 Jay Belanger @@ -962,8 +2271,8 @@ 2012-07-06 Michael Albinus - * tramp.texi (Multi-hops): Introduce - `tramp-restricted-shell-hosts-alist'. + * tramp.texi (Multi-hops): + Introduce `tramp-restricted-shell-hosts-alist'. 2012-06-26 Lars Magne Ingebrigtsen @@ -1072,9 +2381,13 @@ * org.texi (Durations and time values): Fix typo. +2012-05-26 Paul Eggert + + * texinfo.tex: Update from gnulib. + 2012-05-19 Jay Belanger - * doc/misc/calc.texi (Basic Operations on Units, Customizing Calc): + * calc.texi (Basic Operations on Units, Customizing Calc): Mention `calc-ensure-consistent-units'. 2012-05-14 Andreas Schwab @@ -1155,8 +2468,8 @@ (Synchronous Methods): Remove obsolete dbus-call-method-non-blocking. (Asynchronous Methods): Fix description of dbus-call-method-asynchronously. - (Receiving Method Calls): Fix some minor errors. Add - dbus-interface-emacs. + (Receiving Method Calls): Fix some minor errors. + Add dbus-interface-emacs. (Signals): Describe unicast signals and the new match rules. (Alternative Buses): Add the PRIVATE optional argument to dbus-init-bus. Describe its new return value. Add dbus-setenv. @@ -1189,8 +2502,8 @@ 2012-04-09 Eli Zaretskii - * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add - emacs-gnutls. + * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): + Add emacs-gnutls. ($(infodir)/emacs-gnutls, emacs-gnutls.dvi): New targets. 2012-04-09 Teodor Zlatanov @@ -1293,7 +2606,7 @@ 2012-04-01 Eric Schulte - * org.texi (Key bindings and useful functions): Updated babel key + * org.texi (Key bindings and useful functions): Update babel key binding documentation in manual. 2012-04-01 Eric Schulte @@ -1394,8 +2707,8 @@ 2012-02-13 Lars Ingebrigtsen - * gnus.texi (Customizing the IMAP Connection): Mention - nnimap-record-commands. + * gnus.texi (Customizing the IMAP Connection): + Mention nnimap-record-commands. 2012-02-10 Glenn Morris @@ -1466,8 +2779,8 @@ 2012-01-03 Bernt Hansen - * org.texi (Agenda commands): Document - `org-clock-report-include-clocking-task'. + * org.texi (Agenda commands): + Document `org-clock-report-include-clocking-task'. 2012-01-03 Bastien Guerry @@ -1552,8 +2865,8 @@ 2012-01-03 Eric Schulte - * org.texi (Buffer-wide header arguments): Update - documentation to reflect removal of #+PROPERTIES. + * org.texi (Buffer-wide header arguments): + Update documentation to reflect removal of #+PROPERTIES. 2012-01-03 Carsten Dominik @@ -1566,7 +2879,7 @@ 2012-01-03 Bastien Guerry (tiny change) - * org.texi (Selective export): Explicitely mention the default + * org.texi (Selective export): Explicitly mention the default values for `org-export-select-tags', `org-export-exclude-tags'. @@ -1704,6 +3017,10 @@ * gnus.texi (Gnus Utility Functions): Add more references and explanations (bug#9683). +2011-09-26 Paul Eggert + + * texinfo.tex: Merge from gnulib. + 2011-09-21 Lars Magne Ingebrigtsen * gnus.texi (Archived Messages): Note the default (bug#9552). @@ -1714,7 +3031,7 @@ * mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for release 8.3. - (Preface): Updated support information. + (Preface): Update support information. (From Bill Wohler): Reset text to original version. As a historical quote, the tense should be correct in the time that it was written. @@ -1916,8 +3233,8 @@ 2011-08-15 Bastien Guerry - * org.texi (Dynamic blocks, Structure editing): Mention - the function `org-narrow-to-block'. + * org.texi (Dynamic blocks, Structure editing): + Mention the function `org-narrow-to-block'. 2011-08-15 Eric Schulte @@ -1944,15 +3261,15 @@ 2011-08-15 Eric Schulte - * org.texi (Conflicts): Changed "yasnippets" to "yasnippet" and + * org.texi (Conflicts): Change "yasnippets" to "yasnippet" and added extra whitespace around functions to be consistent with the rest of the section. 2011-08-15 Eric Schulte - * org.texi (Evaluating code blocks): Expanded discussion of + * org.texi (Evaluating code blocks): Expand discussion of #+call: line syntax. - (Header arguments in function calls): Expanded discussion of + (Header arguments in function calls): Expand discussion of #+call: line syntax. 2011-08-15 Eric Schulte @@ -1982,12 +3299,12 @@ 2011-08-15 Tom Dye - * org.texi (cache): Improved documentation of code block caches. + * org.texi (cache): Improve documentation of code block caches. 2011-08-15 Tom Dye - * org.texi (Code block specific header arguments): Documentation - of multi-line header arguments. + * org.texi (Code block specific header arguments): + Documentation of multi-line header arguments. 2011-08-15 Eric Schulte @@ -2043,15 +3360,15 @@ 2011-07-04 Michael Albinus - * tramp.texi (Cleanup remote connections): Add - `tramp-cleanup-this-connection'. + * tramp.texi (Cleanup remote connections): + Add `tramp-cleanup-this-connection'. 2011-07-03 Lars Magne Ingebrigtsen * gnus.texi (Subscription Methods): Link to "Group Levels" to explain zombies. (Checking New Groups): Ditto (bug#8974). - (Checking New Groups): Moved the reference to the right place. + (Checking New Groups): Move the reference to the right place. 2011-07-03 Dave Abrahams (tiny change) @@ -2078,8 +3395,8 @@ 2011-06-26 Lars Magne Ingebrigtsen - * gnus.texi (Summary Mail Commands): Document - `gnus-summary-reply-to-list-with-original'. + * gnus.texi (Summary Mail Commands): + Document `gnus-summary-reply-to-list-with-original'. 2011-06-20 Stefan Monnier @@ -2142,7 +3459,7 @@ * gnus.texi (nnmairix caveats, Setup, Registry Article Refer Method) (Fancy splitting to parent, Store arbitrary data): - Updated gnus-registry docs. + Update gnus-registry docs. 2011-04-13 Juanma Barranquero @@ -2342,6 +3659,11 @@ dired-add-entry, dired-initial-position, dired-clean-up-after-deletion, dired-read-shell-command, or dired-find-buffer-nocreate. +2013-02-18 Aidan Gauland + + * eshell.texi (Input/Output): + Document insert output redirection operator, >>>. + 2011-02-18 Glenn Morris * dired-x.texi (Optional Installation File At Point): Simplify. @@ -3259,8 +4581,8 @@ Sync with Tramp 2.1.19. - * tramp.texi (Inline methods, Default Method): Mention - `tramp-inline-compress-start-size'. Remove "kludgy" phrase. + * tramp.texi (Inline methods, Default Method): + Mention `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove remark about doubled "-t" argument. (Auto-save and Backup): Remove reference to Emacs 21. (Filename Syntax): Describe port numbers. @@ -3637,7 +4959,7 @@ 2009-12-15 Jay Belanger - * calc/calc.texi (Radix Modes): Clarify two's complement notation. + * calc.texi (Radix Modes): Clarify two's complement notation. 2009-12-14 Chong Yidong @@ -5142,6 +6464,12 @@ * org.texi: Massive changes, in many parts of the file. +2008-04-27 Jason Riedy + + * org.texi (A LaTeX example): Note that fmt may be a + one-argument function, and efmt may be a two-argument function. + (Radio tables): Document multiple destinations. + 2008-04-13 Reiner Steib * gnus.texi (Oort Gnus): Add message-fill-column. @@ -5374,6 +6702,10 @@ * tramp.texi (Remote processes): Add `shell-command'. +2008-02-02 Michael Albinus + + * tramp.texi: Use new FSF's Back-Cover Text. + 2008-01-28 Michael Sperber * gnus.texi (Mail Source Specifiers): Document `group' specifier. @@ -5474,7 +6806,7 @@ 2007-12-29 Jay Belanger - * calc.tex (Yacas Language, Maxima Language, Giac Language): + * calc.texi (Yacas Language, Maxima Language, Giac Language): New sections. 2007-12-29 Reiner Steib @@ -5492,6 +6824,10 @@ * trampver.texi: Update release number. +2007-12-22 Richard Stallman + + * cc-mode.texi (Getting Started): Change @ref to @pxref. + 2007-12-22 Michael Albinus * dbus.texi (Type Conversion): Correct input parameters mapping. @@ -5914,7 +7250,7 @@ 2007-10-28 Kevin Greiner * gnus.texi (nntp-open-via-telnet-and-telnet): Fix grammar. - (Agent Parameters): Updated parameter names to match code. + (Agent Parameters): Update parameter names to match code. (Group Agent Commands): Corrected 'gnus-agent-fetch-series' as 'gnus-agent-summary-fetch-series'. (Agent and flags): New section providing a generalized discussion @@ -6036,7 +7372,7 @@ 2007-10-28 Reiner Steib - * gnusref.tex: Mention `gnus-summary-limit-to-recipient' and + * gnus.texi: Mention `gnus-summary-limit-to-recipient' and `gnus-summary-sort-by-recipient'. 2007-10-28 Romain Francoise @@ -6718,7 +8054,7 @@ (Tag searches): Document regular expression search for tags. (Stuck projects): New section. (In-buffer settings): New keywords. - (History and Acknowledgments): Updated description. + (History and Acknowledgments): Update description. 2007-02-24 Alan Mackenzie @@ -6753,11 +8089,6 @@ * gnus.texi (Batching Agents): Fix example. Reported by Tassilo Horn . -2007-01-27 Eli Zaretskii - - * msdog.texi (ls in Lisp): Document ls-lisp-format-time-list and - ls-lisp-use-localized-time-format. - 2007-01-20 Markus Triska * flymake.texi (Flymake mode): find-file-hook instead of ...-hooks. @@ -6950,7 +8281,7 @@ (Custom agenda views): Section completely rewritten. (Summary): Compare with Planner. (Feedback): More info about creating backtraces. - (Plain lists): Modified example. + (Plain lists): Modify example. (Breaking down tasks): New section. (Custom time format): New section. (Time stamps): Document inactive timestamps. @@ -7053,7 +8384,6 @@ * faq.texi (Escape sequences in shell output): EMACS is now set to Emacs's absolute file name, not to "t". (^M in the shell buffer): Likewise. - * misc.texi (Interactive Shell): Likewise. 2006-09-11 Reiner Steib @@ -7071,6 +8401,10 @@ * smtpmail.texi (Authentication): Mention SSL. +2006-09-03 Diane Murray + + * erc.texi (Getting Started, Connecting): Change erc-select to erc. + 2006-09-01 Eli Zaretskii * rcirc.texi (Internet Relay Chat, Useful IRC commands): @@ -7517,6 +8851,10 @@ * gnus.texi (Security): Improve. +2006-04-02 Karl Berry + + * texinfo.tex: Update to current version (2006-03-21.13). + 2006-04-02 Bill Wohler * mh-e.texi (Getting Started, Junk, Bug Reports) @@ -9350,7 +10688,7 @@ (Top): More description for the `Default Method' menu entry. (Default Method): Use @code, not @var, for Lisp variables. (Default Method): New subsection `Which method is the right one - for me?' Suggested by Christian Kirsch. + for me?'. Suggested by Christian Kirsch. (Configuration): Pointer to new subsection added. (Default Method): Too many "use" in one sentence. Rephrase. Reported by Christian Kirsch. @@ -9379,8 +10717,8 @@ 2003-11-02 Jesper Harder (tiny change) - * man/ediff.texi, man/tramp.texi, man/vip.texi, man/viper.texi: - * man/widget.texi, man/woman.texi: Replace @sc{ascii} and ASCII with + * ediff.texi, tramp.texi, vip.texi, viper.texi: + * widget.texi, woman.texi: Replace @sc{ascii} and ASCII with @acronym{ASCII}. 2003-10-26 Karl Berry @@ -9602,6 +10940,11 @@ `tramp-set-completion-function', because parsing of ssh config files looks more natural. +2003-01-15 Kevin Ryde + + * gnus.texi (Using MIME): Mention auto-compression-mode with + gnus-mime-copy-part. + 2003-01-15 ShengHuo ZHU * gnus.texi: Do not use `path' in several locations. @@ -9623,11 +10966,12 @@ 2002-10-02 Karl Berry - * (ada-mode.texi autotype.texi calc.texi cc-mode.texi cl.texi - dired-x.texi ebrowse.texi ediff.texi emacs-mime.texi - eshell.texi eudc.texi faq.texi forms.texi idlwave.texi info.texi - message.texi mh-e.texi pcl-cvs.texi reftex.texi sc.texi ses.texi - speedbar.texi vip.texi viper.texi widget.texi woman.texi): + * ada-mode.texi, autotype.texi, calc.texi, cc-mode.texi, cl.texi: + * dired-x.texi, ebrowse.texi, ediff.texi, emacs-mime.texi: + * eshell.texi, eudc.texi, faq.texi, forms.texi, idlwave.texi: + * info.texi, message.texi, mh-e.texi, pcl-cvs.texi, reftex.texi: + * sc.texi, ses.texi, speedbar.texi, vip.texi, viper.texi: + * widget.texi, woman.texi: Per rms, update all manuals to use @copying instead of @ifinfo. Also use @ifnottex instead of @ifinfo around the top node, where needed for the sake of the HTML output. @@ -9649,6 +10993,12 @@ * reftex.texi: Update to RefTeX 4.19. +2002-07-21 Jesper Harder + + * gnus.texi (Sorting Groups): Add key bindings for + gnus-group-sort-groups-by-real-name and + gnus-group-sort-selected-groups-by-real-name. + 2002-06-17 Kai Großjohann * Makefile.in (INFO_TARGETS, DVI_TARGETS): Add Tramp. @@ -9681,6 +11031,12 @@ * Makefile.in (mostlyclean, maintainer-clean): Delete more files. +2001-02-12 Michael Kifer + + * ediff.texi: Added ediff-coding-system-for-read. + + * viper.texi: Fix typos. + 2000-12-20 Eli Zaretskii * Makefile.in (../info/idlwave): Use --no-split. @@ -9778,6 +11134,12 @@ * reftex.texi: Update for RefTeX version 3.22. +1998-03-01 Kim-Minh Kaplan + + * gnus.texi (Easy Picons): Removed references to + `gnus-group-display-picons'. + (Hard Picons): Ditto. + 1998-02-08 Richard Stallman * Makefile.in (reftex.dvi, ../info/reftex): New targets. @@ -9800,6 +11162,10 @@ * Makefile (../info/viper, viper.dvi): Delete viper-cmd.texi dep. +1997-04-12 Per Abrahamsen + + * widget.texi (push-button): Document it. + 1996-08-11 Richard Stallman * Version 19.33 released. @@ -9965,7 +11331,7 @@ 1993-11-15 Paul Eggert (eggert@twinsun.com) - * man/Makefile (../info/cl.info): Rename from ../info/cl. + * Makefile (../info/cl.info): Rename from ../info/cl. 1993-11-15 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -9981,9 +11347,6 @@ * forms.texi: Fix forms.texi so that it will format correctly. Add missing `@end iftex', fix bad reference. - * info.texi, info-stn.texi: New files implement texinfo version of - `info' file. - 1993-10-20 Brian J. Fox (bfox@ai.mit.edu) * Makefile: Fix targets for texindex, new info.texi files. @@ -10072,7 +11435,7 @@ 1990-05-25 Richard Stallman (rms@sugar-bombs.ai.mit.edu) - * texindex.tex: If USG, include sys/types.h and sys/fcntl.h. + * texindex.c: If USG, include sys/types.h and sys/fcntl.h. 1989-01-17 Robert J. Chassell (bob@rice-chex.ai.mit.edu) @@ -10100,7 +11463,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2013 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index add1b42a545..e5f56be5016 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -1,6 +1,6 @@ -#### Makefile for documentation other than the Emacs manual. +### @configure_input@ -# Copyright (C) 1994, 1996-2013 Free Software Foundation, Inc. +# Copyright (C) 1994, 1996-2014 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -17,154 +17,82 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see . -SHELL = /bin/sh +SHELL = @SHELL@ # Where to find the source code. $(srcdir) will be the man-aux # subdirectory of the source tree. This is # set by the configure script's `--srcdir' option. srcdir=@srcdir@ +version=@version@ + ## Where the output files go. buildinfodir = $(srcdir)/../../info ## Directory with emacsver.texi. emacsdir = $(srcdir)/../emacs +prefix = @prefix@ +datarootdir = @datarootdir@ +datadir = @datadir@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +docdir = @docdir@ +dvidir = @dvidir@ +htmldir = @htmldir@ +pdfdir = @pdfdir@ +psdir = @psdir@ + MKDIR_P = @MKDIR_P@ +GZIP_PROG = @GZIP_PROG@ + +HTML_OPTS = --no-split --html + INFO_EXT=@INFO_EXT@ # Options used only when making info output. INFO_OPTS=@INFO_OPTS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + # The makeinfo program is part of the Texinfo distribution. # Use --force so that it generates output even if there are errors. MAKEINFO = @MAKEINFO@ MAKEINFO_OPTS = --force -I$(emacsdir) -INFO_TARGETS = ada-mode auth autotype bovine calc ccmode cl \ +## On MS Windows, efaq-w32; otherwise blank. +DOCMISC_W32 = @DOCMISC_W32@ + +## Info files to build and install on all platforms. +INFO_COMMON = ada-mode auth autotype bovine calc ccmode cl \ dbus dired-x ebrowse ede ediff edt eieio \ - emacs-mime epa erc ert eshell eudc efaq \ - flymake forms gnus emacs-gnutls htmlfontify idlwave info.info \ - mairix-el message mh-e newsticker nxml-mode \ + emacs-mime epa erc ert eshell eudc efaq eww \ + flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \ + mairix-el message mh-e newsticker nxml-mode octave-mode \ org pcl-cvs pgg rcirc remember reftex sasl \ - sc semantic ses sieve smtpmail speedbar srecode tramp \ + sc semantic ses sieve smtpmail speedbar srecode todo-mode tramp \ url vip viper widget wisent woman -DVI_TARGETS = \ - ada-mode.dvi \ - auth.dvi \ - autotype.dvi \ - bovine.dvi \ - calc.dvi \ - cc-mode.dvi \ - cl.dvi \ - dbus.dvi \ - dired-x.dvi \ - ebrowse.dvi \ - ede.dvi \ - ediff.dvi \ - edt.dvi \ - eieio.dvi \ - emacs-mime.dvi \ - epa.dvi \ - erc.dvi \ - ert.dvi \ - eshell.dvi \ - eudc.dvi \ - faq.dvi \ - flymake.dvi \ - forms.dvi \ - gnus.dvi \ - emacs-gnutls.dvi \ - htmlfontify.dvi \ - idlwave.dvi \ - info.dvi \ - mairix-el.dvi \ - message.dvi \ - mh-e.dvi \ - newsticker.dvi \ - nxml-mode.dvi \ - org.dvi \ - pcl-cvs.dvi \ - pgg.dvi \ - rcirc.dvi \ - reftex.dvi \ - remember.dvi \ - sasl.dvi \ - sc.dvi \ - semantic.dvi \ - ses.dvi \ - sieve.dvi \ - smtpmail.dvi \ - speedbar.dvi \ - srecode.dvi \ - tramp.dvi \ - url.dvi \ - vip.dvi \ - viper.dvi \ - widget.dvi \ - wisent.dvi \ - woman.dvi +## Info files to install on current platform. +INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_INFO_W32) -PDF_TARGETS = \ - ada-mode.pdf \ - auth.pdf \ - autotype.pdf \ - bovine.pdf \ - calc.pdf \ - cc-mode.pdf \ - cl.pdf \ - dbus.pdf \ - dired-x.pdf \ - ebrowse.pdf \ - ede.pdf \ - ediff.pdf \ - edt.pdf \ - eieio.pdf \ - emacs-mime.pdf \ - epa.pdf \ - erc.pdf \ - ert.pdf \ - eshell.pdf \ - eudc.pdf \ - faq.pdf \ - flymake.pdf \ - forms.pdf \ - gnus.pdf \ - htmlfontify.pdf \ - emacs-gnutls.pdf \ - idlwave.pdf \ - info.pdf \ - mairix-el.pdf \ - message.pdf \ - mh-e.pdf \ - newsticker.pdf \ - nxml-mode.pdf \ - org.pdf \ - pcl-cvs.pdf \ - pgg.pdf \ - rcirc.pdf \ - reftex.pdf \ - remember.pdf \ - sasl.pdf \ - sc.pdf \ - semantic.pdf \ - ses.pdf \ - sieve.pdf \ - smtpmail.pdf \ - speedbar.pdf \ - srecode.pdf \ - tramp.pdf \ - url.pdf \ - vip.pdf \ - viper.pdf \ - widget.pdf \ - wisent.pdf \ - woman.pdf +## Info files to build on current platform. +## This is all of them, even though they might not all get installed, +## because the info files are pre-built in release tarfiles. +INFO_TARGETS = $(INFO_COMMON) efaq-w32 -HTML_TARGETS = emacs-faq.html +# There are some naming differences between the info targets and the other +# targets, so let's resolve them here. +TARGETS_1 = $(INFO_INSTALL:ccmode=cc-mode) +TARGETS = $(TARGETS_1:info.info=info) + +DVI_TARGETS = $(TARGETS:=.dvi) +HTML_TARGETS = $(TARGETS:=.html) +PDF_TARGETS = $(TARGETS:=.pdf) +PS_TARGETS = $(TARGETS:=.ps) TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf +DVIPS = dvips ENVADD = TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" @@ -173,541 +101,756 @@ mkinfodir = @${MKDIR_P} ${buildinfodir} gfdl = ${srcdir}/doclicense.texi -.PHONY: info dvi pdf echo-info +.PHONY: info dvi html pdf ps echo-info ## Prevent implicit rule triggering for foo.info. .SUFFIXES: +.SUFFIXES: .ps .dvi + +.dvi.ps: + $(DVIPS) -o $@ $< + # Default. info: $(INFO_TARGETS) ## Used by top-level Makefile. ## Base file names of output info files. echo-info: - @echo "$(INFO_TARGETS) " | \ + @echo "$(INFO_INSTALL) " | \ sed -e 's|[^ ]*/||g' -e 's/\.info//g' -e "s/ */$(INFO_EXT) /g" -# please modify this for all the web manual targets -webhack: clean - $(MAKE) pdf MAKEINFO_OPTS="-DWEBHACKDEVEL $(MAKEINFO_OPTS)" - dvi: $(DVI_TARGETS) html: $(HTML_TARGETS) pdf: $(PDF_TARGETS) +ps: $(PS_TARGETS) + # Note that all the Info targets build the Info files in srcdir. # There is no provision for Info files to exist in the build directory. # In a distribution of Emacs, the Info files should be up to date. # Note: "<" is not portable in ordinary make rules. +ada_mode_deps = ${srcdir}/ada-mode.texi ${gfdl} ada-mode : $(buildinfodir)/ada-mode$(INFO_EXT) -$(buildinfodir)/ada-mode$(INFO_EXT): ${srcdir}/ada-mode.texi ${gfdl} +$(buildinfodir)/ada-mode$(INFO_EXT): $(ada_mode_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ada-mode.texi -ada-mode.dvi: ${srcdir}/ada-mode.texi ${gfdl} +ada-mode.dvi: $(ada_mode_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/ada-mode.texi -ada-mode.pdf: ${srcdir}/ada-mode.texi ${gfdl} +ada-mode.pdf: $(ada_mode_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/ada-mode.texi +ada-mode.html: $(ada_mode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ada-mode.texi +auth_deps = ${srcdir}/auth.texi ${gfdl} auth : $(buildinfodir)/auth$(INFO_EXT) -$(buildinfodir)/auth$(INFO_EXT): ${srcdir}/auth.texi ${gfdl} +$(buildinfodir)/auth$(INFO_EXT): $(auth_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/auth.texi -auth.dvi: ${srcdir}/auth.texi ${gfdl} +auth.dvi: $(auth_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/auth.texi -auth.pdf: ${srcdir}/auth.texi ${gfdl} +auth.pdf: $(auth_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/auth.texi +auth.html: $(auth_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/auth.texi +autotype_deps = ${srcdir}/autotype.texi ${gfdl} autotype : $(buildinfodir)/autotype$(INFO_EXT) -$(buildinfodir)/autotype$(INFO_EXT): ${srcdir}/autotype.texi ${gfdl} +$(buildinfodir)/autotype$(INFO_EXT): $(autotype_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/autotype.texi -autotype.dvi: ${srcdir}/autotype.texi ${gfdl} +autotype.dvi: $(autotype_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/autotype.texi -autotype.pdf: ${srcdir}/autotype.texi ${gfdl} +autotype.pdf: $(autotype_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/autotype.texi +autotype.html: $(autotype_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/autotype.texi +bovine_deps = ${srcdir}/bovine.texi ${gfdl} bovine : $(buildinfodir)/bovine$(INFO_EXT) -$(buildinfodir)/bovine$(INFO_EXT): ${srcdir}/bovine.texi ${gfdl} +$(buildinfodir)/bovine$(INFO_EXT): $(bovine_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/bovine.texi -bovine.dvi: ${srcdir}/bovine.texi ${gfdl} +bovine.dvi: $(bovine_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/bovine.texi -bovine.pdf: ${srcdir}/bovine.texi ${gfdl} +bovine.pdf: $(bovine_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/bovine.texi +bovine.html: $(bovine_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/bovine.texi +calc_deps = ${srcdir}/calc.texi $(emacsdir)/emacsver.texi ${gfdl} calc : $(buildinfodir)/calc$(INFO_EXT) -$(buildinfodir)/calc$(INFO_EXT): ${srcdir}/calc.texi $(emacsdir)/emacsver.texi ${gfdl} +$(buildinfodir)/calc$(INFO_EXT): $(calc_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/calc.texi -calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi ${gfdl} +calc.dvi: $(calc_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/calc.texi -calc.pdf: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi ${gfdl} +calc.pdf: $(calc_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/calc.texi +calc.html: $(calc_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/calc.texi +cc_mode_deps = ${srcdir}/cc-mode.texi ${gfdl} ccmode : $(buildinfodir)/ccmode$(INFO_EXT) -$(buildinfodir)/ccmode$(INFO_EXT): ${srcdir}/cc-mode.texi ${gfdl} +$(buildinfodir)/ccmode$(INFO_EXT): $(cc_mode_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cc-mode.texi -cc-mode.dvi: ${srcdir}/cc-mode.texi ${gfdl} +cc-mode.dvi: $(cc_mode_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/cc-mode.texi -cc-mode.pdf: ${srcdir}/cc-mode.texi ${gfdl} +cc-mode.pdf: $(cc_mode_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/cc-mode.texi +cc-mode.html: $(cc_mode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/cc-mode.texi +cl_deps = ${srcdir}/cl.texi $(emacsdir)/emacsver.texi ${gfdl} cl : $(buildinfodir)/cl$(INFO_EXT) -$(buildinfodir)/cl$(INFO_EXT): ${srcdir}/cl.texi $(emacsdir)/emacsver.texi ${gfdl} +$(buildinfodir)/cl$(INFO_EXT): $(cl_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cl.texi -cl.dvi: ${srcdir}/cl.texi $(emacsdir)/emacsver.texi ${gfdl} +cl.dvi: $(cl_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/cl.texi -cl.pdf: ${srcdir}/cl.texi $(emacsdir)/emacsver.texi ${gfdl} +cl.pdf: $(cl_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/cl.texi +cl.html: $(cl_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/cl.texi +dbus_deps = ${srcdir}/dbus.texi ${gfdl} dbus : $(buildinfodir)/dbus$(INFO_EXT) -$(buildinfodir)/dbus$(INFO_EXT): ${srcdir}/dbus.texi ${gfdl} +$(buildinfodir)/dbus$(INFO_EXT): $(dbus_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dbus.texi -dbus.dvi: ${srcdir}/dbus.texi ${gfdl} +dbus.dvi: $(dbus_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/dbus.texi -dbus.pdf: ${srcdir}/dbus.texi ${gfdl} +dbus.pdf: $(dbus_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/dbus.texi +dbus.html: $(dbus_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/dbus.texi +dired_x_deps = ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi ${gfdl} dired-x : $(buildinfodir)/dired-x$(INFO_EXT) -$(buildinfodir)/dired-x$(INFO_EXT): ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi ${gfdl} +$(buildinfodir)/dired-x$(INFO_EXT): $(dired_x_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dired-x.texi -dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi ${gfdl} +dired-x.dvi: $(dired_x_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/dired-x.texi -dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi ${gfdl} +dired-x.pdf: $(dired_x_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/dired-x.texi +dired-x.html: $(dired_x_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/dired-x.texi +ebrowse_deps = ${srcdir}/ebrowse.texi ${gfdl} ebrowse : $(buildinfodir)/ebrowse$(INFO_EXT) -$(buildinfodir)/ebrowse$(INFO_EXT): ${srcdir}/ebrowse.texi ${gfdl} +$(buildinfodir)/ebrowse$(INFO_EXT): $(ebrowse_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ebrowse.texi -ebrowse.dvi: ${srcdir}/ebrowse.texi ${gfdl} +ebrowse.dvi: $(ebrowse_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/ebrowse.texi -ebrowse.pdf: ${srcdir}/ebrowse.texi ${gfdl} +ebrowse.pdf: $(ebrowse_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/ebrowse.texi +ebrowse.html: $(ebrowse_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ebrowse.texi +ede_deps = ${srcdir}/ede.texi ${gfdl} ede : $(buildinfodir)/ede$(INFO_EXT) -$(buildinfodir)/ede$(INFO_EXT): ${srcdir}/ede.texi ${gfdl} +$(buildinfodir)/ede$(INFO_EXT): $(ede_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ede.texi -ede.dvi: ${srcdir}/ede.texi ${gfdl} +ede.dvi: $(ede_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/ede.texi -ede.pdf: ${srcdir}/ede.texi ${gfdl} +ede.pdf: $(ede_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/ede.texi +ede.html: $(ede_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ede.texi +ediff_deps = ${srcdir}/ediff.texi ${gfdl} ediff : $(buildinfodir)/ediff$(INFO_EXT) -$(buildinfodir)/ediff$(INFO_EXT): ${srcdir}/ediff.texi ${gfdl} +$(buildinfodir)/ediff$(INFO_EXT): $(ediff_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ediff.texi -ediff.dvi: ${srcdir}/ediff.texi ${gfdl} +ediff.dvi: $(ediff_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/ediff.texi -ediff.pdf: ${srcdir}/ediff.texi ${gfdl} +ediff.pdf: $(ediff_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/ediff.texi +ediff.html: $(ediff_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ediff.texi +edt_deps = ${srcdir}/edt.texi ${gfdl} edt : $(buildinfodir)/edt$(INFO_EXT) -$(buildinfodir)/edt$(INFO_EXT): ${srcdir}/edt.texi ${gfdl} +$(buildinfodir)/edt$(INFO_EXT): $(edt_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/edt.texi -edt.dvi: ${srcdir}/edt.texi ${gfdl} +edt.dvi: $(edt_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/edt.texi -edt.pdf: ${srcdir}/edt.texi ${gfdl} +edt.pdf: $(edt_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/edt.texi - -eieio : $(buildinfodir)/eieio$(INFO_EXT) -$(buildinfodir)/eieio$(INFO_EXT): ${srcdir}/eieio.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eieio.texi -eieio.dvi: ${srcdir}/eieio.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/eieio.texi -eieio.pdf: ${srcdir}/eieio.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/eieio.texi - -emacs-gnutls : $(buildinfodir)/emacs-gnutls$(INFO_EXT) -$(buildinfodir)/emacs-gnutls$(INFO_EXT): ${srcdir}/emacs-gnutls.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi -emacs-gnutls.dvi: ${srcdir}/emacs-gnutls.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-gnutls.texi -emacs-gnutls.pdf: ${srcdir}/emacs-gnutls.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-gnutls.texi - -emacs-mime : $(buildinfodir)/emacs-mime$(INFO_EXT) -$(buildinfodir)/emacs-mime$(INFO_EXT): ${srcdir}/emacs-mime.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi -emacs-mime.dvi: ${srcdir}/emacs-mime.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi -emacs-mime.pdf: ${srcdir}/emacs-mime.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-mime.texi - -epa : $(buildinfodir)/epa$(INFO_EXT) -$(buildinfodir)/epa$(INFO_EXT): ${srcdir}/epa.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/epa.texi -epa.dvi: ${srcdir}/epa.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/epa.texi -epa.pdf: ${srcdir}/epa.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi - -erc : $(buildinfodir)/erc$(INFO_EXT) -$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi $(emacsdir)/emacsver.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi -erc.dvi: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/erc.texi -erc.pdf: ${srcdir}/erc.texi $(emacsdir)/emacsver.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi - -ert : $(buildinfodir)/ert$(INFO_EXT) -$(buildinfodir)/ert$(INFO_EXT): ${srcdir}/ert.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ert.texi -ert.dvi: ${srcdir}/ert.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi -ert.pdf: ${srcdir}/ert.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi - -eshell : $(buildinfodir)/eshell$(INFO_EXT) -$(buildinfodir)/eshell$(INFO_EXT): ${srcdir}/eshell.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eshell.texi -eshell.dvi: ${srcdir}/eshell.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/eshell.texi -eshell.pdf: ${srcdir}/eshell.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/eshell.texi - -eudc : $(buildinfodir)/eudc$(INFO_EXT) -$(buildinfodir)/eudc$(INFO_EXT): ${srcdir}/eudc.texi ${gfdl} - $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eudc.texi -eudc.dvi: ${srcdir}/eudc.texi ${gfdl} - $(ENVADD) $(TEXI2DVI) ${srcdir}/eudc.texi -eudc.pdf: ${srcdir}/eudc.texi ${gfdl} - $(ENVADD) $(TEXI2PDF) ${srcdir}/eudc.texi +edt.html: $(edt_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/edt.texi ## No gfdl dependency. +efaq_deps = ${srcdir}/efaq.texi $(emacsdir)/emacsver.texi efaq : $(buildinfodir)/efaq$(INFO_EXT) -$(buildinfodir)/efaq$(INFO_EXT): ${srcdir}/faq.texi $(emacsdir)/emacsver.texi +$(buildinfodir)/efaq$(INFO_EXT): $(efaq_deps) $(mkinfodir) - $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/faq.texi -faq.dvi: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi - $(ENVADD) $(TEXI2DVI) ${srcdir}/faq.texi -faq.pdf: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi - $(ENVADD) $(TEXI2PDF) ${srcdir}/faq.texi -## This is the name used on the Emacs web-page. -## sed fixes up links to point to split version of the manual. -emacs-faq.html: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi - $(MAKEINFO) $(MAKEINFO_OPTS) --no-split \ - --css-ref='/layout.css' --html -o $@ ${srcdir}/faq.texi - sed -i -e 's|a href="\([a-z]*\)\.html#\([^"]*\)"|a href="manual/html_node/\1/\2.html"|g' \ - -e 's|/Top\.html|/|g' $@ -emacs-faq.text: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi - $(MAKEINFO) $(MAKEINFO_OPTS) --plaintext -o $@ ${srcdir}/faq.texi + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/efaq.texi +efaq.dvi: $(efaq_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/efaq.texi +efaq.pdf: $(efaq_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/efaq.texi +efaq.html: $(efaq_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/efaq.texi +efaq_w32_deps = ${srcdir}/efaq-w32.texi $(emacsdir)/emacsver.texi +efaq-w32 : $(buildinfodir)/efaq-w32$(INFO_EXT) +$(buildinfodir)/efaq-w32$(INFO_EXT): $(efaq_w32_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/efaq-w32.texi +efaq-w32.dvi: $(efaq_w32_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/efaq-w32.texi +efaq-w32.pdf: $(efaq_w32_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/efaq-w32.texi +efaq-w32.html: $(efaq_w32_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/efaq-w32.texi + +eieio_deps = ${srcdir}/eieio.texi ${gfdl} +eieio : $(buildinfodir)/eieio$(INFO_EXT) +$(buildinfodir)/eieio$(INFO_EXT): $(eieio_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eieio.texi +eieio.dvi: $(eieio_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/eieio.texi +eieio.pdf: $(eieio_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/eieio.texi +eieio.html: $(eieio_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/eieio.texi + +emacs_gnutls_deps = ${srcdir}/emacs-gnutls.texi ${gfdl} +emacs-gnutls : $(buildinfodir)/emacs-gnutls$(INFO_EXT) +$(buildinfodir)/emacs-gnutls$(INFO_EXT): $(emacs_gnutls_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi +emacs-gnutls.dvi: $(emacs_gnutls_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-gnutls.texi +emacs-gnutls.pdf: $(emacs_gnutls_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-gnutls.texi +emacs-gnutls.html: $(emacs_gnutls_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi + +emacs_mime_deps = ${srcdir}/emacs-mime.texi ${gfdl} +emacs-mime : $(buildinfodir)/emacs-mime$(INFO_EXT) +$(buildinfodir)/emacs-mime$(INFO_EXT): $(emacs_mime_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi +emacs-mime.dvi: $(emacs_mime_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi +emacs-mime.pdf: $(emacs_mime_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-mime.texi +emacs-mime.html: $(emacs_mime_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi + +epa_deps = ${srcdir}/epa.texi ${gfdl} +epa : $(buildinfodir)/epa$(INFO_EXT) +$(buildinfodir)/epa$(INFO_EXT): $(epa_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/epa.texi +epa.dvi: $(epa_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/epa.texi +epa.pdf: $(epa_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi +epa.html: $(epa_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/epa.texi + +erc_deps = ${srcdir}/erc.texi $(emacsdir)/emacsver.texi ${gfdl} +erc : $(buildinfodir)/erc$(INFO_EXT) +$(buildinfodir)/erc$(INFO_EXT): $(erc_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi +erc.dvi: $(erc_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/erc.texi +erc.pdf: $(erc_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi +erc.html: $(erc_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/erc.texi + +ert_deps = ${srcdir}/ert.texi ${gfdl} +ert : $(buildinfodir)/ert$(INFO_EXT) +$(buildinfodir)/ert$(INFO_EXT): $(ert_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ert.texi +ert.dvi: $(ert_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi +ert.pdf: $(ert_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi +ert.html: $(ert_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ert.texi + +eshell_deps = ${srcdir}/eshell.texi ${gfdl} +eshell : $(buildinfodir)/eshell$(INFO_EXT) +$(buildinfodir)/eshell$(INFO_EXT): $(eshell_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eshell.texi +eshell.dvi: $(eshell_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/eshell.texi +eshell.pdf: $(eshell_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/eshell.texi +eshell.html: $(eshell_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/eshell.texi + +eudc_deps = ${srcdir}/eudc.texi ${gfdl} +eudc : $(buildinfodir)/eudc$(INFO_EXT) +$(buildinfodir)/eudc$(INFO_EXT): $(eudc_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eudc.texi +eudc.dvi: $(eudc_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/eudc.texi +eudc.pdf: $(eudc_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/eudc.texi +eudc.html: $(eudc_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/eudc.texi + +eww_deps = ${srcdir}/eww.texi ${gfdl} +eww : $(buildinfodir)/eww$(INFO_EXT) +$(buildinfodir)/eww$(INFO_EXT): $(eww_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eww.texi +eww.dvi: $(eww_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/eww.texi +eww.pdf: $(eww_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/eww.texi +eww.html: $(eww_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/eww.texi + +flymake_deps = ${srcdir}/flymake.texi ${gfdl} flymake : $(buildinfodir)/flymake$(INFO_EXT) -$(buildinfodir)/flymake$(INFO_EXT): ${srcdir}/flymake.texi ${gfdl} +$(buildinfodir)/flymake$(INFO_EXT): $(flymake_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/flymake.texi -flymake.dvi: ${srcdir}/flymake.texi ${gfdl} +flymake.dvi: $(flymake_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/flymake.texi -flymake.pdf: ${srcdir}/flymake.texi ${gfdl} +flymake.pdf: $(flymake_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/flymake.texi +flymake.html: $(flymake_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/flymake.texi +forms_deps = ${srcdir}/forms.texi ${gfdl} forms : $(buildinfodir)/forms$(INFO_EXT) -$(buildinfodir)/forms$(INFO_EXT): ${srcdir}/forms.texi ${gfdl} +$(buildinfodir)/forms$(INFO_EXT): $(forms_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/forms.texi -forms.dvi: ${srcdir}/forms.texi ${gfdl} +forms.dvi: $(forms_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/forms.texi -forms.pdf: ${srcdir}/forms.texi ${gfdl} +forms.pdf: $(forms_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/forms.texi +forms.html: $(forms_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/forms.texi -# gnus/message/emacs-mime/sieve/pgg are part of Gnus: +## gnus/message/emacs-mime/sieve/pgg are part of Gnus. +gnus_deps = ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi ${gfdl} gnus : $(buildinfodir)/gnus$(INFO_EXT) -$(buildinfodir)/gnus$(INFO_EXT): ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi ${gfdl} +$(buildinfodir)/gnus$(INFO_EXT): $(gnus_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/gnus.texi -gnus.dvi: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi ${gfdl} +gnus.dvi: $(gnus_deps) sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi $(ENVADD) $(TEXI2DVI) gnustmp.texi cp gnustmp.dvi $@ rm gnustmp.* -gnus.pdf: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi ${gfdl} +gnus.pdf: $(gnus_deps) sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi $(ENVADD) $(TEXI2PDF) gnustmp.texi cp gnustmp.pdf $@ rm gnustmp.* +gnus.html: $(gnus_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/gnus.texi +htmlfontify_deps = ${srcdir}/htmlfontify.texi ${gfdl} htmlfontify : $(buildinfodir)/htmlfontify$(INFO_EXT) -$(buildinfodir)/htmlfontify$(INFO_EXT): ${srcdir}/htmlfontify.texi ${gfdl} +$(buildinfodir)/htmlfontify$(INFO_EXT): $(htmlfontify_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/htmlfontify.texi -htmlfontify.dvi: ${srcdir}/htmlfontify.texi ${gfdl} +htmlfontify.dvi: $(htmlfontify_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/htmlfontify.texi -htmlfontify.pdf: ${srcdir}/htmlfontify.texi ${gfdl} +htmlfontify.pdf: $(htmlfontify_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/htmlfontify.texi +htmlfontify.html: $(htmlfontify_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/htmlfontify.texi -# NB this one needs --no-split even without a .info extension. +idlwave_deps = ${srcdir}/idlwave.texi ${gfdl} idlwave : $(buildinfodir)/idlwave$(INFO_EXT) -$(buildinfodir)/idlwave$(INFO_EXT): ${srcdir}/idlwave.texi ${gfdl} +# NB this one needs --no-split even without a .info extension. +$(buildinfodir)/idlwave$(INFO_EXT): $(idlwave_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/idlwave.texi -idlwave.dvi: ${srcdir}/idlwave.texi ${gfdl} +idlwave.dvi: $(idlwave_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/idlwave.texi -idlwave.pdf: ${srcdir}/idlwave.texi ${gfdl} +idlwave.pdf: $(idlwave_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/idlwave.texi +idlwave.html: $(idlwave_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/idlwave.texi -# NB this one needs --no-split even without a .info extension. +ido_deps = ${srcdir}/ido.texi $(emacsdir)/emacsver.texi ${gfdl} +ido : $(buildinfodir)/ido$(INFO_EXT) +$(buildinfodir)/ido$(INFO_EXT): $(ido_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ido.texi +ido.dvi: $(ido_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/ido.texi +ido.pdf: $(ido_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/ido.texi +ido.html: $(ido_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ido.texi + +info_deps = ${srcdir}/info.texi ${gfdl} # Avoid name clash with overall "info" target. info.info : $(buildinfodir)/info$(INFO_EXT) -$(buildinfodir)/info$(INFO_EXT): ${srcdir}/info.texi ${gfdl} +# NB this one needs --no-split even without a .info extension. +$(buildinfodir)/info$(INFO_EXT): $(info_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/info.texi -info.dvi: ${srcdir}/info.texi ${gfdl} +info.dvi: $(info_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/info.texi -info.pdf: ${srcdir}/info.texi ${gfdl} +info.pdf: $(info_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/info.texi +info.html: $(info_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/info.texi +mairix_el_deps = ${srcdir}/mairix-el.texi ${gfdl} mairix-el : $(buildinfodir)/mairix-el$(INFO_EXT) -$(buildinfodir)/mairix-el$(INFO_EXT): ${srcdir}/mairix-el.texi ${gfdl} +$(buildinfodir)/mairix-el$(INFO_EXT): $(mairix_el_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mairix-el.texi -mairix-el.dvi: ${srcdir}/mairix-el.texi ${gfdl} +mairix-el.dvi: $(mairix_el_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/mairix-el.texi -mairix-el.pdf: ${srcdir}/mairix-el.texi ${gfdl} +mairix-el.pdf: $(mairix_el_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/mairix-el.texi +mairix-el.html: $(mairix_el_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/mairix-el.texi +message_deps = ${srcdir}/message.texi ${gfdl} message : $(buildinfodir)/message$(INFO_EXT) -$(buildinfodir)/message$(INFO_EXT): ${srcdir}/message.texi ${gfdl} +$(buildinfodir)/message$(INFO_EXT): $(message_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/message.texi -message.dvi: ${srcdir}/message.texi ${gfdl} +message.dvi: $(message_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/message.texi -message.pdf: ${srcdir}/message.texi ${gfdl} +message.pdf: $(message_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/message.texi +message.html: $(message_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/message.texi +mh_e_deps = ${srcdir}/mh-e.texi ${gfdl} mh-e : $(buildinfodir)/mh-e$(INFO_EXT) -$(buildinfodir)/mh-e$(INFO_EXT): ${srcdir}/mh-e.texi ${gfdl} +$(buildinfodir)/mh-e$(INFO_EXT): $(mh_e_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mh-e.texi -mh-e.dvi: ${srcdir}/mh-e.texi ${gfdl} +mh-e.dvi: $(mh_e_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/mh-e.texi -mh-e.pdf: ${srcdir}/mh-e.texi ${gfdl} +mh-e.pdf: $(mh_e_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/mh-e.texi +mh-e.html: $(mh_e_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/mh-e.texi +newsticker_deps = ${srcdir}/newsticker.texi ${gfdl} newsticker : $(buildinfodir)/newsticker$(INFO_EXT) -$(buildinfodir)/newsticker$(INFO_EXT): ${srcdir}/newsticker.texi ${gfdl} +$(buildinfodir)/newsticker$(INFO_EXT): $(newsticker_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/newsticker.texi -newsticker.dvi: ${srcdir}/newsticker.texi ${gfdl} +newsticker.dvi: $(newsticker_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/newsticker.texi -newsticker.pdf: ${srcdir}/newsticker.texi ${gfdl} +newsticker.pdf: $(newsticker_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/newsticker.texi +newsticker.html: $(newsticker_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/newsticker.texi +nxml_mode_deps = ${srcdir}/nxml-mode.texi ${gfdl} nxml-mode : $(buildinfodir)/nxml-mode$(INFO_EXT) -$(buildinfodir)/nxml-mode$(INFO_EXT): ${srcdir}/nxml-mode.texi ${gfdl} +$(buildinfodir)/nxml-mode$(INFO_EXT): $(nxml_mode_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/nxml-mode.texi -nxml-mode.dvi: ${srcdir}/nxml-mode.texi ${gfdl} +nxml-mode.dvi: $(nxml_mode_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/nxml-mode.texi -nxml-mode.pdf: ${srcdir}/nxml-mode.texi ${gfdl} +nxml-mode.pdf: $(nxml_mode_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/nxml-mode.texi +nxml-mode.html: $(nxml_mode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/nxml-mode.texi +octave_mode_deps = ${srcdir}/octave-mode.texi ${gfdl} +octave-mode : $(buildinfodir)/octave-mode$(INFO_EXT) +$(buildinfodir)/octave-mode$(INFO_EXT): $(octave_mode_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/octave-mode.texi +octave-mode.dvi: $(octave_mode_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/octave-mode.texi +octave-mode.pdf: $(octave_mode_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/octave-mode.texi +octave-mode.html: $(octave_mode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/octave-mode.texi + +org_deps = ${srcdir}/org.texi ${gfdl} org : $(buildinfodir)/org$(INFO_EXT) -$(buildinfodir)/org$(INFO_EXT): ${srcdir}/org.texi ${gfdl} +$(buildinfodir)/org$(INFO_EXT): $(org_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/org.texi -org.dvi: ${srcdir}/org.texi ${gfdl} +org.dvi: $(org_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/org.texi -org.pdf: ${srcdir}/org.texi ${gfdl} +org.pdf: $(org_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/org.texi +org.html: $(org_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/org.texi +pcl_cvs_deps = ${srcdir}/pcl-cvs.texi ${gfdl} pcl-cvs : $(buildinfodir)/pcl-cvs$(INFO_EXT) -$(buildinfodir)/pcl-cvs$(INFO_EXT): ${srcdir}/pcl-cvs.texi ${gfdl} +$(buildinfodir)/pcl-cvs$(INFO_EXT): $(pcl_cvs_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pcl-cvs.texi -pcl-cvs.dvi: ${srcdir}/pcl-cvs.texi ${gfdl} +pcl-cvs.dvi: $(pcl_cvs_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/pcl-cvs.texi -pcl-cvs.pdf: ${srcdir}/pcl-cvs.texi ${gfdl} +pcl-cvs.pdf: $(pcl_cvs_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/pcl-cvs.texi +pcl-cvs.html: $(pcl_cvs_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/pcl-cvs.texi +pgg_deps = ${srcdir}/pgg.texi ${gfdl} pgg : $(buildinfodir)/pgg$(INFO_EXT) -$(buildinfodir)/pgg$(INFO_EXT): ${srcdir}/pgg.texi ${gfdl} +$(buildinfodir)/pgg$(INFO_EXT): $(pgg_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pgg.texi -pgg.dvi: ${srcdir}/pgg.texi ${gfdl} +pgg.dvi: $(pgg_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/pgg.texi -pgg.pdf: ${srcdir}/pgg.texi ${gfdl} +pgg.pdf: $(pgg_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/pgg.texi +pgg.html: $(pgg_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/pgg.texi +rcirc_deps = ${srcdir}/rcirc.texi ${gfdl} rcirc : $(buildinfodir)/rcirc$(INFO_EXT) -$(buildinfodir)/rcirc$(INFO_EXT): ${srcdir}/rcirc.texi ${gfdl} +$(buildinfodir)/rcirc$(INFO_EXT): $(rcirc_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/rcirc.texi -rcirc.dvi: ${srcdir}/rcirc.texi ${gfdl} +rcirc.dvi: $(rcirc_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/rcirc.texi -rcirc.pdf: ${srcdir}/rcirc.texi ${gfdl} +rcirc.pdf: $(rcirc_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/rcirc.texi +rcirc.html: $(rcirc_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/rcirc.texi +reftex_deps = ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi ${gfdl} reftex : $(buildinfodir)/reftex$(INFO_EXT) -$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi ${gfdl} +$(buildinfodir)/reftex$(INFO_EXT): $(reftex_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/reftex.texi -reftex.dvi: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi ${gfdl} +reftex.dvi: $(reftex_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/reftex.texi -reftex.pdf: ${srcdir}/reftex.texi $(emacsdir)/emacsver.texi ${gfdl} +reftex.pdf: $(reftex_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/reftex.texi +reftex.html: $(reftex_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/reftex.texi +remember_deps = ${srcdir}/remember.texi ${gfdl} remember : $(buildinfodir)/remember$(INFO_EXT) -$(buildinfodir)/remember$(INFO_EXT): ${srcdir}/remember.texi ${gfdl} +$(buildinfodir)/remember$(INFO_EXT): $(remember_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/remember.texi -remember.dvi: ${srcdir}/remember.texi ${gfdl} +remember.dvi: $(remember_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/remember.texi -remember.pdf: ${srcdir}/remember.texi ${gfdl} +remember.pdf: $(remember_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/remember.texi +remember.html: $(remember_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/remember.texi +sasl_deps = ${srcdir}/sasl.texi ${gfdl} sasl : $(buildinfodir)/sasl$(INFO_EXT) -$(buildinfodir)/sasl$(INFO_EXT): ${srcdir}/sasl.texi ${gfdl} +$(buildinfodir)/sasl$(INFO_EXT): $(sasl_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sasl.texi -sasl.dvi: ${srcdir}/sasl.texi ${gfdl} +sasl.dvi: $(sasl_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/sasl.texi -sasl.pdf: ${srcdir}/sasl.texi ${gfdl} +sasl.pdf: $(sasl_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/sasl.texi +sasl.html: $(sasl_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/sasl.texi +sc_deps = ${srcdir}/sc.texi ${gfdl} sc : $(buildinfodir)/sc$(INFO_EXT) -$(buildinfodir)/sc$(INFO_EXT): ${srcdir}/sc.texi ${gfdl} +$(buildinfodir)/sc$(INFO_EXT): $(sc_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sc.texi -sc.dvi: ${srcdir}/sc.texi ${gfdl} +sc.dvi: $(sc_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/sc.texi -sc.pdf: ${srcdir}/sc.texi ${gfdl} +sc.pdf: $(sc_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/sc.texi +sc.html: $(sc_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/sc.texi +semantic_deps = ${srcdir}/semantic.texi ${srcdir}/sem-user.texi ${gfdl} semantic : $(buildinfodir)/semantic$(INFO_EXT) -$(buildinfodir)/semantic$(INFO_EXT): ${srcdir}/semantic.texi ${srcdir}/sem-user.texi ${gfdl} +$(buildinfodir)/semantic$(INFO_EXT): $(semantic_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/semantic.texi -semantic.dvi: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi ${gfdl} +semantic.dvi: $(semantic_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/semantic.texi -semantic.pdf: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi ${gfdl} +semantic.pdf: $(semantic_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/semantic.texi +semantic.html: $(semantic_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/semantic.texi +ses_deps = ${srcdir}/ses.texi ${gfdl} ses : $(buildinfodir)/ses$(INFO_EXT) -$(buildinfodir)/ses$(INFO_EXT): ${srcdir}/ses.texi ${gfdl} +$(buildinfodir)/ses$(INFO_EXT): $(ses_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ses.texi -ses.dvi: ${srcdir}/ses.texi ${gfdl} +ses.dvi: $(ses_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/ses.texi -ses.pdf: ${srcdir}/ses.texi ${gfdl} +ses.pdf: $(ses_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/ses.texi +ses.html: $(ses_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/ses.texi +sieve_deps = ${srcdir}/sieve.texi ${gfdl} sieve : $(buildinfodir)/sieve$(INFO_EXT) -$(buildinfodir)/sieve$(INFO_EXT): ${srcdir}/sieve.texi ${gfdl} +$(buildinfodir)/sieve$(INFO_EXT): $(sieve_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sieve.texi -sieve.dvi: ${srcdir}/sieve.texi ${gfdl} +sieve.dvi: $(sieve_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi -sieve.pdf: ${srcdir}/sieve.texi ${gfdl} +sieve.pdf: $(sieve_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/sieve.texi +sieve.html: $(sieve_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/sieve.texi +smtpmail_deps = ${srcdir}/smtpmail.texi ${gfdl} smtpmail : $(buildinfodir)/smtpmail$(INFO_EXT) -$(buildinfodir)/smtpmail$(INFO_EXT): ${srcdir}/smtpmail.texi ${gfdl} +$(buildinfodir)/smtpmail$(INFO_EXT): $(smtpmail_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/smtpmail.texi -smtpmail.dvi: ${srcdir}/smtpmail.texi ${gfdl} +smtpmail.dvi: $(smtpmail_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/smtpmail.texi -smtpmail.pdf: ${srcdir}/smtpmail.texi ${gfdl} +smtpmail.pdf: $(smtpmail_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/smtpmail.texi +smtpmail.html: $(smtpmail_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/smtpmail.texi +speedbar_deps = ${srcdir}/speedbar.texi ${gfdl} speedbar : $(buildinfodir)/speedbar$(INFO_EXT) -$(buildinfodir)/speedbar$(INFO_EXT): ${srcdir}/speedbar.texi ${gfdl} +$(buildinfodir)/speedbar$(INFO_EXT): $(speedbar_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/speedbar.texi -speedbar.dvi: ${srcdir}/speedbar.texi ${gfdl} +speedbar.dvi: $(speedbar_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/speedbar.texi -speedbar.pdf: ${srcdir}/speedbar.texi ${gfdl} +speedbar.pdf: $(speedbar_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/speedbar.texi +speedbar.html: $(speedbar_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/speedbar.texi +srecode_deps = ${srcdir}/srecode.texi ${gfdl} srecode : $(buildinfodir)/srecode$(INFO_EXT) -$(buildinfodir)/srecode$(INFO_EXT): ${srcdir}/srecode.texi ${gfdl} +$(buildinfodir)/srecode$(INFO_EXT): $(srecode_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/srecode.texi -srecode.dvi: ${srcdir}/srecode.texi ${gfdl} +srecode.dvi: $(srecode_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/srecode.texi -srecode.pdf: ${srcdir}/srecode.texi ${gfdl} +srecode.pdf: $(srecode_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/srecode.texi +srecode.html: $(srecode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/srecode.texi +todo_mode_deps = ${srcdir}/todo-mode.texi ${gfdl} +todo-mode : $(buildinfodir)/todo-mode$(INFO_EXT) +$(buildinfodir)/todo-mode$(INFO_EXT): $(todo_mode_deps) + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/todo-mode.texi +todo-mode.dvi: $(todo_mode_deps) + $(ENVADD) $(TEXI2DVI) ${srcdir}/todo-mode.texi +todo-mode.pdf: $(todo_mode_deps) + $(ENVADD) $(TEXI2PDF) ${srcdir}/todo-mode.texi +todo-mode.html: $(todo_mode_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/todo-mode.texi + +tramp_deps = ${srcdir}/tramp.texi ${srcdir}/trampver.texi ${gfdl} tramp : $(buildinfodir)/tramp$(INFO_EXT) -$(buildinfodir)/tramp$(INFO_EXT): ${srcdir}/tramp.texi ${srcdir}/trampver.texi ${gfdl} +$(buildinfodir)/tramp$(INFO_EXT): $(tramp_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ -D emacs ${srcdir}/tramp.texi -tramp.dvi: ${srcdir}/tramp.texi ${srcdir}/trampver.texi ${gfdl} +tramp.dvi: $(tramp_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi -tramp.pdf: ${srcdir}/tramp.texi ${srcdir}/trampver.texi ${gfdl} +tramp.pdf: $(tramp_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/tramp.texi +tramp.html: $(tramp_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ -D emacs ${srcdir}/tramp.texi +url_deps = ${srcdir}/url.texi ${gfdl} url : $(buildinfodir)/url$(INFO_EXT) -$(buildinfodir)/url$(INFO_EXT): ${srcdir}/url.texi ${gfdl} +$(buildinfodir)/url$(INFO_EXT): $(url_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/url.texi -url.dvi: ${srcdir}/url.texi ${gfdl} +url.dvi: $(url_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/url.texi -url.pdf: ${srcdir}/url.texi ${gfdl} +url.pdf: $(url_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/url.texi +url.html: $(url_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/url.texi +vip_deps = ${srcdir}/vip.texi ${gfdl} vip : $(buildinfodir)/vip$(INFO_EXT) -$(buildinfodir)/vip$(INFO_EXT): ${srcdir}/vip.texi ${gfdl} +$(buildinfodir)/vip$(INFO_EXT): $(vip_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/vip.texi -vip.dvi: ${srcdir}/vip.texi ${gfdl} +vip.dvi: $(vip_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/vip.texi -vip.pdf: ${srcdir}/vip.texi ${gfdl} +vip.pdf: $(vip_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/vip.texi +vip.html: $(vip_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/vip.texi +viper_deps = ${srcdir}/viper.texi ${gfdl} viper : $(buildinfodir)/viper$(INFO_EXT) -$(buildinfodir)/viper$(INFO_EXT): ${srcdir}/viper.texi ${gfdl} +$(buildinfodir)/viper$(INFO_EXT): $(viper_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/viper.texi -viper.dvi: ${srcdir}/viper.texi ${gfdl} +viper.dvi: $(viper_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/viper.texi -viper.pdf: ${srcdir}/viper.texi ${gfdl} +viper.pdf: $(viper_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/viper.texi +viper.html: $(viper_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/viper.texi +widget_deps = ${srcdir}/wisent.texi ${gfdl} widget : $(buildinfodir)/widget$(INFO_EXT) -$(buildinfodir)/widget$(INFO_EXT): ${srcdir}/widget.texi ${gfdl} +$(buildinfodir)/widget$(INFO_EXT): $(widget_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/widget.texi -widget.dvi: ${srcdir}/widget.texi ${gfdl} +widget.dvi: $(widget_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/widget.texi -widget.pdf: ${srcdir}/widget.texi ${gfdl} +widget.pdf: $(widget_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/widget.texi +widget.html: $(widget_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/widget.texi +wisent_deps = ${srcdir}/wisent.texi ${gfdl} wisent : $(buildinfodir)/wisent$(INFO_EXT) -$(buildinfodir)/wisent$(INFO_EXT): ${srcdir}/wisent.texi ${gfdl} +$(buildinfodir)/wisent$(INFO_EXT): $(wisent_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/wisent.texi -wisent.dvi: ${srcdir}/wisent.texi ${gfdl} +wisent.dvi: $(wisent_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/wisent.texi -wisent.pdf: ${srcdir}/wisent.texi ${gfdl} +wisent.pdf: $(wisent_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/wisent.texi +wisent.html: $(wisent_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/wisent.texi +woman_deps = ${srcdir}/woman.texi $(emacsdir)/emacsver.texi ${gfdl} woman : $(buildinfodir)/woman$(INFO_EXT) -$(buildinfodir)/woman$(INFO_EXT): ${srcdir}/woman.texi $(emacsdir)/emacsver.texi ${gfdl} +$(buildinfodir)/woman$(INFO_EXT): $(woman_deps) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/woman.texi -woman.dvi: ${srcdir}/woman.texi $(emacsdir)/emacsver.texi ${gfdl} +woman.dvi: $(woman_deps) $(ENVADD) $(TEXI2DVI) ${srcdir}/woman.texi -woman.pdf: ${srcdir}/woman.texi $(emacsdir)/emacsver.texi ${gfdl} +woman.pdf: $(woman_deps) $(ENVADD) $(TEXI2PDF) ${srcdir}/woman.texi - +woman.html: $(woman_deps) + $(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ ${srcdir}/woman.texi .PHONY: mostlyclean clean distclean maintainer-clean @@ -718,16 +861,89 @@ mostlyclean: rm -f gnustmp.* clean: mostlyclean - rm -f $(DVI_TARGETS) $(PDF_TARGETS) $(HTML_TARGETS) emacs-faq.text + rm -f $(DVI_TARGETS) $(HTML_TARGETS) $(PDF_TARGETS) $(PS_TARGETS) + rm -f efaq-w32.dvi efaq-w32.html efaq-w32.pdf efaq-w32.ps + rm -f emacs-misc-${version}.tar* distclean: clean -# rm -f Makefile + rm -f Makefile ## buildinfodir is relative to srcdir. -maintainer-clean: distclean +infoclean: cd $(buildinfodir); for file in $(INFO_TARGETS); do \ file=`echo $${file} | sed 's/\.info$$//'`${INFO_EXT}; \ rm -f $${file} $${file}-[1-9] $${file}-[1-9][0-9]; \ done +maintainer-clean: distclean infoclean + +dist: + rm -rf emacs-misc-${version} + mkdir emacs-misc-${version} + cp ${srcdir}/*.texi ${srcdir}/texinfo.tex \ + $(emacsdir)/emacsver.texi ${srcdir}/ChangeLog* \ + emacs-misc-${version}/ + sed -e 's/@sr[c]dir@/./' \ + -e 's/^\(emacsdir *=\).*/\1 ./' \ + -e 's/^\(buildinfodir *=\).*/\1 ./' \ + -e 's/^\(clean:.*\)/\1 infoclean/' \ + -e "s/@ver[s]ion@/${version}/" \ + -e 's/@MAKE[I]NFO@/makeinfo/' -e 's/@MK[D]IR_P@/mkdir -p/' \ + -e 's/@IN[F]O_EXT@/.info/' -e 's/@IN[F]O_OPTS@//' \ + ${srcdir}/Makefile.in > emacs-misc-${version}/Makefile + @if grep '@[a-zA-Z_]*@' emacs-misc-${version}/Makefile; then \ + echo "Unexpanded configure variables in Makefile?" 1>&2; exit 1; \ + fi + tar -cf emacs-misc-${version}.tar emacs-misc-${version} + rm -rf emacs-misc-${version} + + +.PHONY: install-dvi install-html install-pdf install-ps install-doc + +install-dvi: dvi + umask 022; $(MKDIR_P) "$(DESTDIR)$(dvidir)" + $(INSTALL_DATA) $(DVI_TARGETS) "$(DESTDIR)$(dvidir)" +install-html: html + umask 022; $(MKDIR_P) "$(DESTDIR)$(htmldir)" + $(INSTALL_DATA) $(HTML_TARGETS) "$(DESTDIR)$(htmldir)" +install-pdf: pdf + umask 022;$(MKDIR_P) "$(DESTDIR)$(pdfdir)" + $(INSTALL_DATA) $(PDF_TARGETS) "$(DESTDIR)$(pdfdir)" +install-ps: ps + umask 022; $(MKDIR_P) "$(DESTDIR)$(psdir)" + for file in $(PS_TARGETS); do \ + $(INSTALL_DATA) $${file} "$(DESTDIR)$(psdir)"; \ + [ -n "${GZIP_PROG}" ] || continue; \ + rm -f "$(DESTDIR)$(psdir)/$${file}.gz"; \ + ${GZIP_PROG} -9n "$(DESTDIR)$(psdir)/$${file}"; \ + done + +## Top-level Makefile installs the info pages. +install-doc: install-dvi install-html install-pdf install-ps + + + +.PHONY: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps uninstall-doc + +uninstall-dvi: + for file in $(DVI_TARGETS); do \ + rm -f "$(DESTDIR)$(dvidir)/$${file}"; \ + done +uninstall-html: + for file in $(HTML_TARGETS); do \ + rm -f "$(DESTDIR)$(htmldir)/$${file}"; \ + done +uninstall-ps: + ext= ; [ -n "${GZIP_PROG}" ] && ext=.gz; \ + for file in $(PS_TARGETS); do \ + rm -f "$(DESTDIR)$(psdir)/$${file}$${ext}"; \ + done +uninstall-pdf: + for file in $(PDF_TARGETS); do \ + rm -f "$(DESTDIR)$(pdfdir)/$${file}"; \ + done + +uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps + + ### Makefile ends here diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi index b5a640e13e0..f20f0910763 100644 --- a/doc/misc/ada-mode.texi +++ b/doc/misc/ada-mode.texi @@ -1,9 +1,10 @@ \input texinfo @c -*-texinfo-*- @setfilename ../../info/ada-mode @settitle Ada Mode +@documentencoding UTF-8 @copying -Copyright @copyright{} 1999--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 36ee400acca..993062f8082 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -6,11 +6,12 @@ @setfilename ../../info/auth @settitle Emacs auth-source Library @value{VERSION} +@documentencoding UTF-8 @copying This file describes the Emacs auth-source library. -Copyright @copyright{} 2008--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2008--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -469,10 +470,10 @@ It returns the number of items forgotten. @node GnuPG and EasyPG Assistant Configuration @appendix GnuPG and EasyPG Assistant Configuration -If you don't customize @code{auth-sources}, the auth-source library -reads @file{~/.authinfo.gpg}, which is a GnuPG encrypted file. Then -it will check @file{~/.authinfo} but it's not recommended to use such -an unencrypted file. +If the @code{auth-sources} variable contains @file{~/.authinfo.gpg} +before @file{~/.authinfo}, the auth-source library will try to +read the GnuPG encrypted @file{.gpg} file first, before +the unencrypted file. In Emacs 23 or later there is an option @code{auto-encryption-mode} to automatically decrypt @file{*.gpg} files. It is enabled by default. diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index 137ed6b43e8..ae3fa0e5870 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -1,16 +1,17 @@ \input texinfo @c This is an annex of the Emacs manual. -@c Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 +@c Author: Daniel Pfeiffer @setfilename ../../info/autotype @c @node Autotypist, Picture, Abbrevs, Top @c @chapter Features for Automatic Typing @settitle Features for Automatic Typing +@documentencoding UTF-8 @c @cindex text @c @cindex selfinserting text @c @cindex autotypist @copying -Copyright @copyright{} 1994--1995, 1999, 2001--2013 +Copyright @copyright{} 1994--1995, 1999, 2001--2014 Free Software Foundation, Inc. @quotation @@ -28,8 +29,8 @@ modify this GNU manual.'' @dircategory Emacs misc features @direntry -* Autotype: (autotype). Convenient features for text that you - enter frequently in Emacs. +* Autotype: (autotype). Convenient features for text that you enter + frequently in Emacs. @end direntry @titlepage @@ -301,7 +302,7 @@ of the same name as the command and can thus be overridden from your Various characters usually appear in pairs. When, for example, you insert an open parenthesis, no matter whether you are programming or writing prose, you will surely enter a closing one later. By entering both at the same time -and leaving the cursor inbetween, Emacs can guarantee you that such +and leaving the cursor in between, Emacs can guarantee you that such parentheses are always balanced. And if you have a non-qwerty keyboard, where typing some of the stranger programming language symbols makes you bend your fingers backwards, this can be quite relieving too. diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi index 978345e5cc8..5092d463a29 100644 --- a/doc/misc/bovine.texi +++ b/doc/misc/bovine.texi @@ -4,6 +4,7 @@ @set TITLE Bovine parser development @set AUTHOR Eric M. Ludlam, David Ponce, and Richard Y. Kim @settitle @value{TITLE} +@documentencoding UTF-8 @c ************************************************************************* @c @ Header @@ -23,7 +24,7 @@ @c %**end of header @copying -Copyright @copyright{} 1999--2004, 2012--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2004, 2012--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -76,7 +77,7 @@ The @dfn{bovine} parser is the original @semantic{} parser, and is an implementation of an @acronym{LL} parser. It is good for simple languages. It has many conveniences making grammar writing easy. The conveniences make it less powerful than a Bison-like @acronym{LALR} -parser. For more information, @inforef{top, the Wisent Parser Manual, +parser. For more information, @inforef{Top, The Wisent Parser Manual, wisent}. Bovine @acronym{LL} grammars are stored in files with a @file{.by} diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 2d1f59cfa68..4010d6c8c19 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -4,6 +4,7 @@ @setfilename ../../info/calc @c [title] @settitle GNU Emacs Calc Manual +@documentencoding UTF-8 @setchapternewpage odd @comment %**end of header (This is for running Texinfo on a region.) @@ -94,7 +95,7 @@ This file documents Calc, the GNU Emacs calculator, included with GNU Emacs @value{EMACSVER}. @end ifnotinfo -Copyright @copyright{} 1990--1991, 2001--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1990--1991, 2001--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -140,7 +141,7 @@ modify this GNU manual.'' @c [begin] @ifnottex @node Top, Getting Started, (dir), (dir) -@chapter The GNU Emacs Calculator +@top The GNU Emacs Calculator @noindent @dfn{Calc} is an advanced desk calculator and mathematical tool @@ -11801,6 +11802,18 @@ Thus @kbd{M-@key{DEL}} by itself removes the second-from-top stack element, leaving the first, third, fourth, and so on; @kbd{M-3 M-@key{DEL}} deletes the third stack element. +The above commands do not depend on the location of the cursor. +If the customizable variable @code{calc-context-sensitive-enter} is +non-@code{nil} (@pxref{Customizing Calc}), these commands will become +context sensitive. For example, instead of duplicating the top of the stack, +@key{RET} will copy the element at the cursor to the top of the +stack. With a positive numeric prefix, a copy of the element at the +cursor and the appropriate number of preceding elements will be placed +at the top of the stack. A negative prefix will still duplicate the +specified element of the stack regardless of the cursor position. +Similarly, @key{DEL} will remove the corresponding elements from the +stack. + @kindex @key{TAB} @pindex calc-roll-down To exchange the top two elements of the stack, press @key{TAB} @@ -20743,9 +20756,9 @@ mean, then repeating until the two values converge. $$ a_{i+1} = { a_i + b_i \over 2 } , \qquad b_{i+1} = \sqrt{a_i b_i} $$ @end tex -@cindex Root-mean-square -Another commonly used mean, the RMS (root-mean-square), can be computed -for a vector of numbers simply by using the @kbd{A} command. +@c @cindex Root-mean-square +@c Another commonly used mean, the RMS (root-mean-square), can be computed +@c for a vector of numbers simply by using the @kbd{A} command. @kindex u S @pindex calc-vector-sdev @@ -27859,7 +27872,8 @@ while typing @kbd{u c au/yr @key{RET}} produces If the units you request are inconsistent with the original units, the number will be converted into your units times whatever ``remainder'' -units are left over. For example, converting @samp{55 mph} into acres +units are left over. (This can be disabled; @pxref{Customizing Calc}.) +For example, converting @samp{55 mph} into acres produces @samp{6.08e-3 acre / m s}. (Recall that multiplication binds more strongly than division in Calc formulas, so the units here are acres per meter-second.) Remainder units are expressed in terms of @@ -27875,12 +27889,6 @@ change the @samp{s} to @samp{ms} to get @samp{9.8e-4 cm/ms^2}. The ``remainder unit'' @samp{cm} is left alone rather than being changed to the base unit @samp{m}. -If you want to disallow using inconsistent units, you can set the -customizable variable @code{calc-ensure-consistent-units} to @code{t} -(@pxref{Customizing Calc}). In this case, if you request units which -are inconsistent with the original units, you will be warned about it -and no conversion will occur. - You can use explicit unit conversion instead of the @kbd{u s} command to gain more control over the units of the result of an expression. For example, given @samp{5 m + 23 mm}, you can type @kbd{u c m} or @@ -27916,10 +27924,7 @@ prompt first for the old units which this value should be considered to have, then for the new units. (If the value on the stack can be simplified so that it doesn't contain any units, like @samp{ft/in} can be simplified to 12, then @kbd{u c} will still prompt for both old -units and new units. You can ignore the prompt for old units with -@key{RET}, or turn off the prompt by setting the customizable variable -@code{calc-allow-units-as-numbers} to @code{nil}. -@pxref{Customizing Calc}) Assuming the old and new units you give are +units and new units. Assuming the old and new units you give are consistent with each other, the result also will not contain any units. For example, @kbd{@w{u c} cm @key{RET} in @key{RET}} converts the number 2 on the stack to 5.08. @@ -28048,8 +28053,8 @@ radiation related to the cesium-133 atom. The only SI unit that is not based on a fundamental physical process (although there are efforts to change this) is the kilogram, which was originally defined as the mass of one liter of water, but is now defined as the mass of the -International Prototype Kilogram (IPK), a cylinder of platinum-iridium -kept at the Bureau International des Poids et Mesures in S@`evres, +international prototype of the kilogram (IPK), a cylinder of platinum-iridium +kept at the Bureau international des poids et mesures in S@`evres, France. (There are several copies of the IPK throughout the world.) The British imperial units, once defined in terms of physical objects, were redefined in 1963 in terms of SI units. The US customary units, @@ -33314,12 +33319,15 @@ Lisp integers. This is the only storage format for Calc data objects which is not a Lisp list. Large integers are stored as lists of the form @samp{(bigpos @var{d0} -@var{d1} @var{d2} @dots{})} for positive integers 1000000 or more, or -@samp{(bigneg @var{d0} @var{d1} @var{d2} @dots{})} for negative integers -@mathit{-1000000} or less. Each @var{d} is a base-1000 ``digit,'' a Lisp integer -from 0 to 999. The least significant digit is @var{d0}; the last digit, +@var{d1} @var{d2} @dots{})} for sufficiently large positive integers +(where ``sufficiently large'' depends on the machine), or +@samp{(bigneg @var{d0} @var{d1} @var{d2} @dots{})} for negative +integers. Each @var{d} is a base-@expr{10^n} ``digit'' (where again, +@expr{n} depends on the machine), a Lisp integer from 0 to +99@dots{}9. The least significant digit is @var{d0}; the last digit, @var{dn}, which is always nonzero, is the most significant digit. For -example, the integer @mathit{-12345678} is stored as @samp{(bigneg 678 345 12)}. +example, the integer @mathit{-12345678} might be stored as +@samp{(bigneg 678 345 12)}. The distinction between small and large integers is entirely hidden from the user. In @code{defmath} definitions, the Lisp predicate @code{integerp} @@ -35701,15 +35709,14 @@ have different dimensions. The default value of @code{calc-ensure-consistent-uni is @code{nil}. @end defvar -@defvar calc-allow-units-as-numbers -When converting units, the variable @code{calc-allow-units-as-numbers} -determines whether or not values which can be simplified so that -they don't contain units (such as @samp{ft/in} can be simplified to 12) -can be regarded as not containing units. If -@code{calc-allow-units-as-numbers} is non-@code{nil}, then @kbd{u c} -will prompt for both old units and new units when converting an expression -like @samp{ft/in}, otherwise @kbd{u c} will only prompt for the new units. -The default value of @code{calc-allow-units-as-numbers} is @code{t}. +@defvar calc-context-sensitive-enter +The commands @code{calc-enter} and @code{calc-pop} will typically +duplicate the top of the stack. If +@code{calc-context-sensitive-enter} is non-@code{nil}, then the +@code{calc-enter} will copy the element at the cursor to the +top of the stack and @code{calc-pop} will delete the element at the +cursor. The default value of @code{calc-context-sensitive-enter} is +@code{nil}. @end defvar @defvar calc-undo-length diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index bb6a5b001ad..2d916b8416c 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -83,6 +83,7 @@ the second with them pointing to the XEmacs manuals. @setfilename ../../info/ccmode @settitle CC Mode Manual +@documentencoding UTF-8 @footnotestyle end @c The following four macros generate the filenames and titles of the @@ -156,7 +157,7 @@ CC Mode @copying This manual is for CC Mode in Emacs. -Copyright @copyright{} 1995--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -176,7 +177,7 @@ modify this GNU manual.'' @dircategory Emacs editing modes @direntry * CC Mode: (ccmode). Emacs mode for editing C, C++, Objective-C, - Java, Pike, AWK, and CORBA IDL code. + Java, Pike, AWK, and CORBA IDL code. @end direntry @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -241,7 +242,7 @@ functions, classes, etc.; there are other packages for that. * Customizing Indentation:: * Custom Macros:: * Odds and Ends:: -* Sample .emacs File:: +* Sample Init File:: * Performance Issues:: * Limitations and Known Bugs:: * FAQ:: @@ -1113,7 +1114,7 @@ valid.}. This function is not bound to a key by default, but it's intended to be used on the @kbd{RET} key. If you like the behavior of @code{newline-and-indent} on @kbd{RET}, you should consider switching to -this function. @xref{Sample .emacs File}. +this function. @xref{Sample Init File}. @item @kbd{M-x c-context-open-line} @findex c-context-open-line @@ -1170,9 +1171,9 @@ and @ref{Indentation Engine Basics}. You can toggle each of these minor modes on and off, and you can configure @ccmode{} so that it starts up with your favorite -combination of them (@pxref{Sample .emacs File}). By default, when +combination of them (@pxref{Sample Init File}). By default, when you initialize a buffer, electric mode and syntactic-indentation mode -are enabled but the other two modes are disabled. +are enabled but the other three modes are disabled. @ccmode{} displays the current state of the first four of these minor modes on the modeline by appending letters to the major mode's name, @@ -2111,7 +2112,7 @@ contributing it: send a note to @email{bug-cc-mode@@gnu.org}. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! The general appearance of font-locking in AWK mode is much like in any -other programming mode. @xref{Faces For Font Lock,,,elisp, GNU Emacs +other programming mode. @xref{Faces for Font Lock,,,elisp, GNU Emacs Lisp Reference Manual}. The following faces are, however, used in a non-standard fashion in @@ -2378,7 +2379,7 @@ those set by @code{c-default-style}. @vindex initialization-hook (c-) Hook run only once per Emacs session, when @ccmode{} is initialized. This is a good place to change key bindings (or add new ones) in any -of the @ccmode{} key maps. @xref{Sample .emacs File}. +of the @ccmode{} key maps. @xref{Sample Init File}. @end defvar @defvar c-mode-common-hook @@ -2406,7 +2407,7 @@ overwritten when @ccmode{} gets loaded. Here's a simplified example of what you can add to your @file{.emacs} file to do things whenever any @ccmode{} language is edited. See the Emacs manuals for more information on customizing Emacs via hooks. -@xref{Sample .emacs File}, for a more complete sample @file{.emacs} +@xref{Sample Init File}, for a more complete sample @file{.emacs} file. @example @@ -2685,7 +2686,7 @@ create a new @dfn{style definition}, possibly based on an existing style. To do this, put the new style's settings into a list with the following format; the list can then be passed as an argument to the function @code{c-add-style}. You can see an example of a style -definition in @ref{Sample .emacs File}. +definition in @ref{Sample Init File}. @cindex style definition @c @defvr {List} style definition @@ -2753,7 +2754,7 @@ deprecated and it might be removed from @ccmode{} in a future release. You should use @code{c-set-style} instead. The sample @file{.emacs} file provides a concrete example of how a new -style can be added and automatically set. @xref{Sample .emacs File}. +style can be added and automatically set. @xref{Sample Init File}. @end defun @defvar c-style-alist @@ -6475,13 +6476,14 @@ think is generally useful, you're very welcome to contribute it; please contact @email{bug-cc-mode@@gnu.org}. Line-up functions are passed a single argument, the syntactic -element (see below). The return value is a @code{c-offsets-alist} -offset specification: for example, an integer, a symbol such as -@code{+}, a vector, @code{nil}@footnote{Returning @code{nil} is useful -when the offset specification for a syntactic element is a list -containing the line-up function (@pxref{c-offsets-alist}).}, or even -another line-up function. Full details of these are in -@ref{c-offsets-alist}. +element (see below). At the time of the call, point will be somewhere +on the line being indented. The return value is a +@code{c-offsets-alist} offset specification: for example, an integer, +a symbol such as @code{+}, a vector, @code{nil}@footnote{Returning +@code{nil} is useful when the offset specification for a syntactic +element is a list containing the line-up function +(@pxref{c-offsets-alist}).}, or even another line-up function. Full +details of these are in @ref{c-offsets-alist}. Line-up functions must not move point or change the content of the buffer (except temporarily). They are however allowed to do @@ -6759,7 +6761,7 @@ initialization code. @end defun @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Odds and Ends, Sample .emacs File, Custom Macros, Top +@node Odds and Ends, Sample Init File, Custom Macros, Top @comment node-name, next, previous, up @chapter Odds and Ends @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -6803,9 +6805,9 @@ anchoring position to indent the line in that case. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Sample .emacs File, Performance Issues, Odds and Ends, Top +@node Sample Init File, Performance Issues, Odds and Ends, Top @comment node-name, next, previous, up -@appendix Sample .emacs File +@appendix Sample Init File @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Here's a sample .emacs file fragment that might help you along the way. @@ -6862,7 +6864,7 @@ to change some of the actual values. @end verbatim @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Performance Issues, Limitations and Known Bugs, Sample .emacs File, Top +@node Performance Issues, Limitations and Known Bugs, Sample Init File, Top @comment node-name, next, previous, up @chapter Performance Issues @cindex performance diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 83df411cb23..f0ac289acab 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1,12 +1,13 @@ \input texinfo @c -*-texinfo-*- @setfilename ../../info/cl @settitle Common Lisp Extensions +@documentencoding UTF-8 @include emacsver.texi @copying This file documents the GNU Emacs Common Lisp emulation package. -Copyright @copyright{} 1993, 2001--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1993, 2001--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -273,6 +274,8 @@ and the @code{cl-eval-when} construct. @node Argument Lists @section Argument Lists +@cindex &key +@cindex &aux @noindent Emacs Lisp's notation for argument lists of functions is a subset of @@ -461,6 +464,7 @@ matter of stylistic taste: @var{body})) @end example +@cindex destructuring, in argument list Argument lists support @dfn{destructuring}. In Common Lisp, destructuring is only allowed with @code{defmacro}; this package allows it with @code{cl-defun} and other argument lists as well. @@ -1278,13 +1282,8 @@ cells of symbols rather than on the value cells. Each @var{binding} must be a list of the form @samp{(@var{name} @var{arglist} @var{forms}@dots{})}, which defines a function exactly as if it were a @code{cl-defun} form. The function @var{name} is defined -accordingly for the duration of the body of the @code{cl-flet}; then -the old function definition, or lack thereof, is restored. - -You can use @code{cl-flet} to disable or modify the behavior of -functions (including Emacs primitives) in a temporary, localized fashion. -(Compare this with the idea of advising functions. -@xref{Advising Functions,,,elisp,GNU Emacs Lisp Reference Manual}.) +accordingly but only within the body of the @code{cl-flet}, hiding any external +definition if applicable. The bindings are lexical in scope. This means that all references to the named functions must appear physically within the body of the @@ -1492,6 +1491,7 @@ simply returning @code{nil}. @node Blocks and Exits @section Blocks and Exits +@cindex block @noindent Common Lisp @dfn{blocks} provide a non-local exit mechanism very @@ -1556,6 +1556,19 @@ Common Lisp loops like @code{cl-do} and @code{cl-dolist} implicitly enclose themselves in @code{nil} blocks. @end defmac +@c FIXME? Maybe this should be in a separate section? +@defmac cl-tagbody &rest labels-or-statements +This macro executes statements while allowing for control transfer to +user-defined labels. Each element of @var{labels-or-statements} can +be either a label (an integer or a symbol), or a cons-cell +(a statement). This distinction is made before macroexpansion. +Statements are executed in sequence, discarding any return value. +Any statement can transfer control at any time to the statements that follow +one of the labels with the special form @code{(go @var{label})}. +Labels have lexical scope and dynamic extent. +@end defmac + + @node Iteration @section Iteration @@ -2139,6 +2152,7 @@ that was just set by the previous clause; in the second loop, based on the value of @code{x} left over from the previous time through the loop. +@cindex destructuring, in cl-loop Another feature of the @code{cl-loop} macro is @emph{destructuring}, similar in concept to the destructuring provided by @code{defmacro} (@pxref{Argument Lists}). @@ -2503,6 +2517,8 @@ if @var{expr} returns a list of the wrong number of arguments or with incorrect keyword arguments. @end defmac +@cindex compiler macros +@cindex define compiler macros This package also includes the Common Lisp @code{define-compiler-macro} facility, which allows you to define compile-time expansions and optimizations for your functions. @@ -4850,10 +4866,27 @@ generated directly inside Emacs will not be caught since they make direct C-language calls to the message routines rather than going through the Lisp @code{message} function. +For those cases where the dynamic scoping of @code{flet} is desired, +@code{cl-flet} is clearly not a substitute. The most direct replacement would +be instead to use @code{cl-letf} to temporarily rebind @code{(symbol-function +'@var{fun})}. But in most cases, a better substitute is to use an advice, such +as: + +@example +(defvar my-fun-advice-enable nil) +(add-advice '@var{fun} :around + (lambda (orig &rest args) + (if my-fun-advice-enable (do-something) + (apply orig args)))) +@end example + +so that you can then replace the @code{flet} with a simple dynamically scoped +binding of @code{my-fun-advice-enable}. + @c Bug#411. -Note that many primitives (e.g., @code{+}) have special byte-compile -handling. Attempts to redefine such functions using @code{flet} will -fail if byte-compiled. +Note that many primitives (e.g., @code{+}) have special byte-compile handling. +Attempts to redefine such functions using @code{flet}, @code{cl-letf}, or an +advice will fail when byte-compiled. @c Or cl-flet. @c In such cases, use @code{labels} instead. @end defmac diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index c40a5e313f5..6a91efbd728 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -2,6 +2,7 @@ @setfilename ../../info/dbus @c %**start of header @settitle Using of D-Bus +@documentencoding UTF-8 @c @setchapternewpage odd @c %**end of header @@ -9,7 +10,7 @@ @syncodeindex fn cp @copying -Copyright @copyright{} 2007--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -29,6 +30,14 @@ modify this GNU manual.'' * D-Bus: (dbus). Using D-Bus in Emacs. @end direntry +@titlepage +@title Using D-Bus in Emacs +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + + @contents @@ -403,8 +412,11 @@ Every dictionary entry has a string as key, and a variant as value. The interface offers also a signal, which returns 2 parameters: an integer, and an array consisting of elements which are a struct of a string and 2 boolean values.@footnote{ The interfaces of the service -@samp{org.freedesktop.Hal} are described at -@uref{http://people.freedesktop.org/~david/hal-spec/hal-spec.html#interfaces}.} +@samp{org.freedesktop.Hal} are described in +@c Previous link is gone. Since HAL is now obsolete, this URL +@c (unchanged in ~ 4 years) feels like it might go too... +@uref{http://people.freedesktop.org/~dkukawka/hal-spec-git/hal-spec.html#interfaces, +the HAL specification}.} @end defun @defun dbus-introspect-xml bus service path @@ -757,7 +769,7 @@ If there are no properties, @code{nil} is returned. Example: @end defun @defun dbus-get-all-managed-objects bus service path -This functions returns all objects at @var{bus}, @var{service}, +This function returns all objects at @var{bus}, @var{service}, @var{path}, and the children of @var{path}. The result is a list of objects. Every object is a cons of an existing path name, and the list of available interface objects. An interface object is another @@ -1135,10 +1147,11 @@ The signal @code{PropertyModified}, discussed as example in (@var{INTEGER} ((@var{STRING} @var{BOOL} @var{BOOL}) (@var{STRING} @var{BOOL} @var{BOOL}) @dots{})) @end lisp -@defun dbus-byte-array-to-string byte-array +@defun dbus-byte-array-to-string byte-array &optional multibyte If a D-Bus method or signal returns an array of bytes, which are known to represent an UTF8 string, this function converts @var{byte-array} -to the corresponding string. Example: +to the corresponding string. The string is unibyte encoded, unless +@var{multibyte} is non-@code{nil}. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) @@ -1148,20 +1161,30 @@ to the corresponding string. Example: @end defun @defun dbus-unescape-from-identifier string -Retrieve the original string from the encoded @var{string}. -@var{string} must have been coded with +Retrieve the original string from the encoded @var{string} as unibyte +string. @var{string} must have been encoded with @code{dbus-escape-as-identifier}. Example: @lisp (dbus-unescape-from-identifier "_30123abc_5fxyz_01_ff") -@ifinfo -@result{} "0123abc_xyz^Aÿ" -@end ifinfo -@ifnotinfo -@result{} "0123abc_xyz^A@"y" -@end ifnotinfo +@result{} "0123abc_xyz\x01\xff" @end lisp + +If the original string used in @code{dbus-escape-as-identifier} is a +multibyte string, it cannot be expected that this function returns +that string: + +@lisp +(string-equal + (dbus-unescape-from-identifier + (dbus-escape-as-identifier "Grüß Göttin")) + "Grüß Göttin") + +@result{} nil +@end lisp + + @end defun diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 1e3d11f6dc6..c0d0d4b1645 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -9,6 +9,7 @@ @comment %**start of header (This is for running Texinfo on a region.) @setfilename ../../info/dired-x @settitle Dired Extra User's Manual +@documentencoding UTF-8 @include emacsver.texi @@ -19,7 +20,7 @@ @comment %**end of header (This is for running Texinfo on a region.) @copying -Copyright @copyright{} 1994--1995, 1999, 2001--2013 +Copyright @copyright{} 1994--1995, 1999, 2001--2014 Free Software Foundation, Inc. @quotation @@ -560,7 +561,7 @@ of marked files. @vindex dired-guess-shell-alist-default Predefined rules for shell commands. Set this to @code{nil} to turn guessing off. The elements of @code{dired-guess-shell-alist-user} (defined by the -user) will override these rules.@refill +user) will override these rules. @item dired-guess-shell-alist-user @vindex dired-guess-shell-alist-user @@ -568,7 +569,6 @@ If non-@code{nil}, a user-defined alist of file regexps and their suggested commands. These rules take precedence over the predefined rules in the variable @code{dired-guess-shell-alist-default} (to which they are prepended) when @code{dired-do-shell-command} is run). -@refill Each element of the alist looks like diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi index c7f3e3b1a61..9e9596d236a 100644 --- a/doc/misc/ebrowse.texi +++ b/doc/misc/ebrowse.texi @@ -3,6 +3,7 @@ @comment %**start of header @setfilename ../../info/ebrowse @settitle A Class Browser for C++ +@documentencoding UTF-8 @setchapternewpage odd @syncodeindex fn cp @comment %**end of header @@ -10,7 +11,7 @@ @copying This file documents Ebrowse, a C++ class browser for GNU Emacs. -Copyright @copyright{} 2000--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2000--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -138,7 +139,7 @@ list of the pseudo-class @samp{*Globals*}; @item Types (@code{enum}s, and @code{typedef}s defined with class -scope).@refill +scope). @end itemize You can switch member buffers from one list to another, or to another @@ -210,7 +211,7 @@ per line. @findex --help When invoked with option @samp{--help}, @command{ebrowse} prints a list of -available command line options.@refill +available command line options. @menu * Input files:: Specifying which files to parse @@ -478,12 +479,12 @@ name. This command views the class declaration if the database contains information about it. If you don't parse the entire source you are working on, some classes will only be known to exist but the -location of their declarations and definitions will not be known.@refill +location of their declarations and definitions will not be known. @item RET Works like @kbd{SPC}, except that it finds the class declaration rather than viewing it, so that it is ready for -editing.@refill +editing. @end table The same functionality is available from the menu opened with @@ -570,7 +571,7 @@ positions the cursor on the class in the class tree. If the branch of the class tree containing the class searched for is currently collapsed, the class itself and all its base classes are recursively made visible. (See also @ref{Expanding and -Collapsing}.)@refill +Collapsing}.) This function is also available from the tree buffer's context menu. @@ -634,7 +635,7 @@ Here is an example of a tree buffer with file names displayed. You can expand and collapse parts of a tree to reduce the complexity of large class hierarchies. Expanding or collapsing branches of a tree has no impact on the functionality of other commands, like @kbd{/}. (See -also @ref{Go to Class}.)@refill +also @ref{Go to Class}.) Collapsed branches are indicated with an ellipsis following the class name like in the example below. @@ -734,7 +735,7 @@ context menu. Classes can be marked for operations similar to the standard Emacs commands @kbd{M-x tags-search} and @kbd{M-x tags-query-replace} (see -also @xref{Tags-like Functions}.)@refill +also @xref{Tags-like Functions}.) @table @kbd @cindex toggle mark @@ -1292,7 +1293,7 @@ When jumping to a member declaration or definition with one of Ebrowse's commands, the position from where you performed the jump and the position where you jumped to are recorded in a @dfn{position stack}. There are several ways in which you can quickly -move to positions in the stack:@refill +move to positions in the stack: @table @kbd @cindex return to original position diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index f2e787fd588..3ae040debea 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -1,11 +1,12 @@ \input texinfo @setfilename ../../info/ede @settitle Emacs Development Environment +@documentencoding UTF-8 @copying This file describes EDE, the Emacs Development Environment. -Copyright @copyright{} 1998--2001, 2004--2005, 2008--2013 +Copyright @copyright{} 1998--2001, 2004--2005, 2008--2014 Free Software Foundation, Inc. @quotation @@ -30,6 +31,9 @@ modify this GNU manual.'' @center @titlefont{EDE (The Emacs Development Environment)} @sp 4 @center by Eric Ludlam +@page +@vskip 0pt plus 1filll +@insertcopying @end titlepage @page @@ -1564,26 +1568,22 @@ Type: @code{string} @* Default Value: @code{"Untitled"} The name used when generating distribution files. -@refill @item :version Type: @code{string} @* Default Value: @code{"1.0"} The version number used when distributing files. -@refill @item :directory Type: @code{string} Directory this project is associated with. -@refill @item :file Type: @code{string} File name where this project is stored. -@refill @end table @@ -1656,35 +1656,30 @@ Make sure placeholder @var{THIS} is replaced with the real thing, and pass throu Type: @code{list} List of top level targets in this project. -@refill @item :tool-cache Type: @code{list} List of tool cache configurations in this project. This allows any tool to create, manage, and persist project-specific settings. -@refill @item :web-site-url Type: @code{string} @* URL to this projects web site. This is a URL to be sent to a web site for documentation. -@refill @item :web-site-directory @* A directory where web pages can be found by Emacs. For remote locations use a path compatible with ange-ftp or EFS@. You can also use TRAMP for use with rcp & scp. -@refill @item :web-site-file @* A file which contains the home page for this project. This file can be relative to slot @code{web-site-directory}. This can be a local file, use ange-ftp, EFS, or TRAMP. -@refill @item :ftp-site Type: @code{string} @* @@ -1692,7 +1687,6 @@ Type: @code{string} @* FTP site where this project's distribution can be found. This FTP site should be in Emacs form, as needed by @code{ange-ftp}, but can also be of a form used by TRAMP for use with scp, or rcp. -@refill @item :ftp-upload-site Type: @code{string} @* @@ -1700,7 +1694,6 @@ Type: @code{string} @* FTP Site to upload new distributions to. This FTP site should be in Emacs form as needed by @code{ange-ftp}. If this slot is @code{nil}, then use @code{ftp-site} instead. -@refill @item :configurations Type: @code{list} @* @@ -1709,19 +1702,16 @@ Default Value: @code{("debug" "release")} List of available configuration types. Individual target/project types can form associations between a configuration, and target specific elements such as build variables. -@refill @item :configuration-default @* Default Value: @code{"debug"} The default configuration. -@refill @item :local-variables @* Default Value: @code{nil} Project local variables -@refill @end table @@ -1966,7 +1956,6 @@ buffer's @code{default-directory} (not starting with a /). Directories that are relative to the project's root should start with a /, such as "/include", meaning the directory @code{include} off the project root directory. -@refill @item :system-include-path Type: @code{list} @* @@ -1976,7 +1965,6 @@ The system include path for files in this project. C files initialized in an ede-cpp-root-project have their semantic system include path set to this value. If this is @code{nil}, then the semantic path is not modified. -@refill @item :spp-table Type: @code{list} @* @@ -1988,7 +1976,6 @@ These macros might be passed in through the command line compiler, or are critical symbols derived from header files. Providing header files macro values through this slot improves accuracy and performance. Use `:spp-files' to use these files directly. -@refill @item :spp-files Type: @code{list} @* @@ -1998,14 +1985,12 @@ C header file with Preprocessor macros for your files. The PreProcessor symbols appearing in these files will be used while parsing files in this project. See @code{semantic-lex-c-preprocessor-symbol-map} for more on how this works. -@refill @item :header-match-regexp Type: @code{string} @* Default Value: @code{"\\.\\(h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\|H\\)$\\|\\<\\w+$"} Regexp used to identify C/C++ header files. -@refill @item :locate-fcn Type: @code{(or null function)} @* @@ -2020,7 +2005,6 @@ The function symbol must take two arguments: It should return the fully qualified file name passed in from NAME@. If that file does not exist, it should return nil. -@refill @end table @@ -2144,14 +2128,12 @@ The type of Makefile to generate. Can be one of @code{'Makefile}, 'Makefile.in, or 'Makefile.am. If this value is NOT @code{'Makefile}, then that overrides the @code{:makefile} slot in targets. -@refill @item :variables Type: @code{list} @* Default Value: @code{nil} Variables to set in this Makefile. -@refill @item :configuration-variables Type: @code{list} @* @@ -2159,27 +2141,23 @@ Default Value: @code{("debug" (("DEBUG" . "1")))} Makefile variables to use in different configurations. These variables are used in the makefile when a configuration becomes active. -@refill @item :inference-rules @* Default Value: @code{nil} Inference rules to add to the makefile. -@refill @item :include-file @* Default Value: @code{nil} Additional files to include. These files can contain additional rules, variables, and customizations. -@refill @item :automatic-dependencies Type: @code{boolean} @* Default Value: @code{t} Non-@code{nil} to do implement automatic dependencies in the Makefile. -@refill @item :metasubproject Type: @code{boolean} @* @@ -2190,7 +2168,6 @@ Usually, a subproject is determined by a parent project. If multiple top level projects are grouped into a large project not maintained by EDE, then you need to set this to non-nil. The only effect is that the @code{dist} rule will then avoid making a tar file. -@refill @end table @@ -2380,7 +2357,6 @@ Type: @code{list} @* Default Value: @code{nil} Variables to set in this Makefile, at top of file. -@refill @item :additional-variables Type: @code{(or null list)} @* @@ -2388,7 +2364,6 @@ Default Value: @code{nil} Arbitrary variables needed from this project. It is safe to leave this blank. -@refill @item :additional-rules Type: @code{(or null list)} @* @@ -2396,7 +2371,6 @@ Default Value: @code{nil} Arbitrary rules and dependencies needed to make this target. It is safe to leave this blank. -@refill @item :installation-domain Type: @code{symbol} @* @@ -2404,7 +2378,6 @@ Default Value: @code{user} Installation domain specification. The variable GNUSTEP_INSTALLATION_DOMAIN is set at this value. -@refill @item :preamble Type: @code{(or null list)} @* @@ -2412,7 +2385,6 @@ Default Value: @code{(quote ("GNUmakefile.preamble"))} The auxiliary makefile for additional variables. Included just before the specific target files. -@refill @item :postamble Type: @code{(or null list)} @* @@ -2420,7 +2392,6 @@ Default Value: @code{(quote ("GNUmakefile.postamble"))} The auxiliary makefile for additional rules. Included just after the specific target files. -@refill @item :metasubproject Type: @code{boolean} @* @@ -2431,7 +2402,6 @@ Usually, a subproject is determined by a parent project. If multiple top level projects are grouped into a large project not maintained by EDE, then you need to set this to non-nil. The only effect is that the @code{dist} rule will then avoid making a tar file. -@refill @end table @@ -2536,21 +2506,18 @@ Commit change to local variables in @var{PROJ}. Type: @code{string} Name of this target. -@refill @item :path Type: @code{string} The path to the sources of this target. Relative to the path of the project it belongs to. -@refill @item :source Type: @code{list} @* Default Value: @code{nil} Source files in this target. -@refill @item :versionsource Type: @code{list} @* @@ -2560,7 +2527,6 @@ Source files with a version string in them. These files are checked for a version string whenever the EDE version of the master project is changed. When strings are found, the version previously there is updated. -@refill @end table @@ -2752,14 +2718,12 @@ Retrieves the slot @code{menu} from an object of class @code{ede-target} Type: @code{string} Name of this target. -@refill @item :path Type: @code{string} The path to the sources of this target. Relative to the path of the project it belongs to. -@refill @item :auxsource Type: @code{list} @* @@ -2768,7 +2732,6 @@ Default Value: @code{nil} Auxiliary source files included in this target. Each of these is considered equivalent to a source file, but it is not distributed, and each should have a corresponding rule to build it. -@refill @item :compiler Type: @code{(or null symbol)} @* @@ -2778,7 +2741,6 @@ The compiler to be used to compile this object. This should be a symbol, which contains the object defining the compiler. This enables save/restore to do so by name, permitting the sharing of these compiler resources, and global customization thereof. -@refill @item :linker Type: @code{(or null symbol)} @* @@ -2788,7 +2750,6 @@ The linker to be used to link compiled sources for this object. This should be a symbol, which contains the object defining the linker. This enables save/restore to do so by name, permitting the sharing of these linker resources, and global customization thereof. -@refill @end table @@ -2950,7 +2911,6 @@ Type: @code{string} @* Default Value: @code{"Makefile"} File name of generated Makefile. -@refill @item :partofall Type: @code{boolean} @* @@ -2959,7 +2919,6 @@ Default Value: @code{t} Non @code{nil} means the rule created is part of the all target. Setting this to @code{nil} creates the rule to build this item, but does not include it in the ALL`all:' rule. -@refill @item :configuration-variables Type: @code{list} @* @@ -2969,7 +2928,6 @@ Makefile variables appended to use in different configurations. These variables are used in the makefile when a configuration becomes active. Target variables are always renamed such as foo_CFLAGS, then included into commands where the variable would usually appear. -@refill @item :rules Type: @code{list} @* @@ -2977,7 +2935,6 @@ Default Value: @code{nil} Arbitrary rules and dependencies needed to make this target. It is safe to leave this blank. -@refill @end table @@ -3221,7 +3178,6 @@ The linker flag "-l" is automatically prepended. Do not include a "lib" prefix, or a ".so" suffix. Note: Currently only used for Automake projects. -@refill @item :ldflags Type: @code{list} @* @@ -3232,7 +3188,6 @@ Use ldlibs to add addition libraries. Use this to specify specific options to the linker. Note: Not currently used. This bug needs to be fixed. -@refill @end table @@ -3358,7 +3313,6 @@ Additional packages needed. There should only be one toplevel package per auxiliary tool needed. These packages location is found, and added to the compile time load path. -@refill @end table @@ -3439,7 +3393,6 @@ Default Value: @code{"loaddefs.el"} The file that autoload definitions are placed in. There should be one load defs file for a given package. The load defs are created for all Emacs Lisp sources that exist in the directory of the created target. -@refill @item :autoload-dirs Type: @code{list} @* @@ -3447,7 +3400,6 @@ Default Value: @code{nil} The directories to scan for autoload definitions. If @code{nil} defaults to the current directory. -@refill @end table @@ -3547,7 +3499,6 @@ Default Value: @code{""} Miscellaneous sources which have a specialized makefile. The sub-makefile is used to build this target. -@refill @end table @@ -3604,7 +3555,6 @@ Default Value: @code{""} The main menu resides in this file. All other sources should be included independently. -@refill @end table @@ -3687,7 +3637,6 @@ Type: @code{string} @* Default Value: @code{"guile"} The preferred interpreter for this code. -@refill @end table @@ -3817,7 +3766,6 @@ No children Default Value: @code{nil} Additional LD args. -@refill @end table @end table @@ -3949,7 +3897,6 @@ No children Default Value: @code{nil} Additional texinfo included in this one. -@refill @end table @end table @@ -4036,21 +3983,18 @@ Type: @code{eieio-instance-inheritor-child} The parent of this instance. If a slot of this class is reference, and is unbound, then the parent is checked for a value. -@refill @item :name Type: @code{string} The name of this type of source code. Such as "C" or "Emacs Lisp" -@refill @item :sourcepattern Type: @code{string} @* Default Value: @code{".*"} Emacs regex matching sourcecode this target accepts. -@refill @item :auxsourcepattern Type: @code{(or null string)} @* @@ -4059,7 +4003,6 @@ Default Value: @code{nil} Emacs regex matching auxiliary source code this target accepts. Aux source are source code files needed for compilation, which are not compiled themselves. -@refill @item :enable-subdirectories Type: @code{boolean} @* @@ -4069,7 +4012,6 @@ Non @code{nil} if this sourcecode type uses subdirectores. If sourcecode always lives near the target creating it, this should be nil. If sourcecode can, or typically lives in a subdirectory of the owning target, set this to t. -@refill @item :garbagepattern Type: @code{list} @* @@ -4078,7 +4020,6 @@ Default Value: @code{nil} Shell file regex matching files considered as garbage. This is a list of items added to an @code{rm} command when executing a @code{clean} type directive. -@refill @end table @@ -4158,13 +4099,11 @@ Type: @code{eieio-instance-inheritor-child} The parent of this instance. If a slot of this class is reference, and is unbound, then the parent is checked for a value. -@refill @item :name Type: @code{string} Name of this type of compiler. -@refill @item :variables Type: @code{list} @@ -4173,7 +4112,6 @@ Variables needed in the Makefile for this compiler. An assoc list where each element is (VARNAME . VALUE) where VARNAME is a string, and VALUE is either a string, or a list of strings. For example, GCC would define CC=gcc, and emacs would define EMACS=emacs. -@refill @item :sourcetype Type: @code{list} @@ -4181,7 +4119,6 @@ Type: @code{list} A list of @code{ede-sourcecode} @xref{ede-sourcecode}. objects this class will handle. This is used to match target objects with the compilers and linkers they can use, and which files this object is interested in. -@refill @item :rules Type: @code{list} @* @@ -4189,7 +4126,6 @@ Default Value: @code{nil} Auxiliary rules needed for this compiler to run. For example, yacc/lex files need additional chain rules, or inferences. -@refill @item :commands Type: @code{list} @@ -4197,7 +4133,6 @@ Type: @code{list} The commands used to execute this compiler. The object which uses this compiler will place these commands after it's rule definition. -@refill @item :autoconf Type: @code{list} @* @@ -4208,14 +4143,12 @@ When a project is in Automake mode, this defines the autoconf function to call to initialize automake to use this compiler. For example, there may be multiple C compilers, but they all probably use the same autoconf form. -@refill @item :objectextention Type: @code{string} A string which is the extension used for object files. For example, C code uses .o on unix, and Emacs Lisp uses .elc. -@refill @end table @@ -4285,13 +4218,11 @@ Type: @code{eieio-instance-inheritor-child} The parent of this instance. If a slot of this class is reference, and is unbound, then the parent is checked for a value. -@refill @item :name Type: @code{string} Name of this type of compiler. -@refill @item :variables Type: @code{list} @@ -4300,7 +4231,6 @@ Variables needed in the Makefile for this compiler. An assoc list where each element is (VARNAME . VALUE) where VARNAME is a string, and VALUE is either a string, or a list of strings. For example, GCC would define CC=gcc, and emacs would define EMACS=emacs. -@refill @item :sourcetype Type: @code{list} @@ -4308,7 +4238,6 @@ Type: @code{list} A list of @code{ede-sourcecode} @xref{ede-sourcecode}. objects this class will handle. This is used to match target objects with the compilers and linkers they can use, and which files this object is interested in. -@refill @item :commands Type: @code{list} @@ -4316,21 +4245,18 @@ Type: @code{list} The commands used to execute this compiler. The object which uses this compiler will place these commands after it's rule definition. -@refill @item :objectextention Type: @code{string} A string which is the extension used for object files. For example, C code uses .o on unix, and Emacs Lisp uses .elc. -@refill @item :makedepends Type: @code{boolean} @* Default Value: @code{nil} Non-@code{nil} if this compiler can make dependencies. -@refill @item :uselinker Type: @code{boolean} @* @@ -4339,7 +4265,6 @@ Default Value: @code{nil} Non-@code{nil} if this compiler creates code that can be linked. This requires that the containing target also define a list of available linkers that can be used. -@refill @end table @@ -4399,7 +4324,6 @@ Default Value: @code{t} Type: @code{list} A variable dedicated to dependency generation. -@refill @end table @end table @@ -4439,7 +4363,6 @@ No children Type: @code{string} Name of this type of compiler. -@refill @item :variables Type: @code{list} @@ -4448,7 +4371,6 @@ Variables needed in the Makefile for this compiler. An assoc list where each element is (VARNAME . VALUE) where VARNAME is a string, and VALUE is either a string, or a list of strings. For example, GCC would define CC=gcc, and emacs would define EMACS=emacs. -@refill @item :sourcetype Type: @code{list} @@ -4456,7 +4378,6 @@ Type: @code{list} A list of @code{ede-sourcecode} @xref{ede-sourcecode}. objects this class will handle. This is used to match target objects with the compilers and linkers they can use, and which files this object is interested in. -@refill @item :commands Type: @code{list} @@ -4464,14 +4385,12 @@ Type: @code{list} The commands used to execute this compiler. The object which uses this compiler will place these commands after it's rule definition. -@refill @item :objectextention Type: @code{string} A string which is the extension used for object files. For example, C code uses .o on unix, and Emacs Lisp uses .elc. -@refill @end table @end table diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 378eee08c51..826e16c7a4c 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -10,6 +10,7 @@ @setfilename ../../info/ediff @settitle Ediff User's Manual +@documentencoding UTF-8 @synindex vr cp @synindex fn cp @synindex pg cp @@ -25,7 +26,7 @@ This file documents Ediff, a comprehensive visual interface to Unix diff and patch utilities. -Copyright @copyright{} 1995--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -42,7 +43,8 @@ modify this GNU manual.'' @dircategory Emacs misc features @direntry -* Ediff: (ediff). A visual interface for comparing and merging programs. +* Ediff: (ediff). A visual interface for comparing and + merging programs. @end direntry @titlepage diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index 339d59bd123..c4937d4ae6e 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -1,11 +1,12 @@ \input texinfo @setfilename ../../info/edt @settitle EDT Emulation for Emacs +@documentencoding UTF-8 @copying This file documents the EDT emulation package for Emacs. -Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2013 +Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2014 Free Software Foundation, Inc. @quotation @@ -789,13 +790,13 @@ so the above directions may need some modification if your site has such special needs. @menu -* edt-user.el:: Creating your own @file{edt-user.el} file. +* Init file:: Creating your own @file{edt-user.el} file. * Words:: Specifying word entities. * Control keys:: Enabling EDT control key sequence bindings. * Scroll margins:: Setting scroll margins. @end menu -@node edt-user.el +@node Init file @section Creating your own @file{edt-user.el} File A sample @file{edt-user.el} file is provided in the Emacs @file{etc/} diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi new file mode 100644 index 00000000000..17f1af61200 --- /dev/null +++ b/doc/misc/efaq-w32.texi @@ -0,0 +1,2361 @@ +\input texinfo @c -*-coding:utf-8 -*- +@setfilename efaq-w32 +@settitle GNU Emacs FAQ For MS Windows +@setchapternewpage odd +@syncodeindex pg cp +@syncodeindex ky cp +@syncodeindex tp cp +@syncodeindex vr fn + +@documentdescription +Answers to Frequently asked Questions about using Emacs on Microsoft Windows. +@end documentdescription + +@include emacsver.texi + +@documentencoding utf-8 +@documentlanguage en + +@copying +Copyright @copyright{} 2008, 2010-2014 Free Software Foundation, Inc. + +@quotation +This list of frequently asked questions about GNU Emacs on MS Windows +with answers (``FAQ'') may be translated into other languages, +transformed into other formats (e.g. Texinfo, Info, WWW), and updated +with new information. + +The same conditions apply to any derivative of the FAQ as apply to the FAQ +itself. Every copy of the FAQ must include this notice or an approved +translation, information on who is currently maintaining the FAQ and how to +contact them (including their e-mail address), and information on where the +latest version of the FAQ is archived (including FTP information). + +The FAQ may be copied and redistributed under these conditions, except that +the FAQ may not be embedded in a larger literary work unless that work +itself allows free copying and redistribution. +@end quotation +@end copying + +@dircategory Emacs +@direntry +* Emacs W32 FAQ: (efaq-w32). FAQs about Emacs on MS Windows. +@end direntry + +@c The @titlepage stuff only appears in the printed version +@titlepage +@sp 10 +@center @titlefont{GNU Emacs FAQ for MS Windows} + +@c The following two commands start the copyright page. +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@footnotestyle end + +@node Top +@top GNU Emacs FAQ for MS Windows + +This is the FAQ for using GNU Emacs on MS Windows, as distributed with +Emacs @value{EMACSVER}. + +This FAQ is maintained by the developers and users of Emacs on MS Windows. +If you find any errors, or have any suggestions, please send them to +the @url{http://lists.gnu.org/mailman/listinfo/help-emacs-windows, +help-emacs-windows} mailing list. + +At time of writing, the latest version of GNU Emacs is version @value{EMACSVER}. + +@c Links to ftp.gnu.org are given as http links, since Windows ftp clients +@c are notoriously bad at handling firewalls etc. + +@ifnottex +@insertcopying +@end ifnottex + +@contents + +@menu +* Introduction:: +* Getting Emacs:: +* Installing Emacs:: +* Display Settings:: +* Fonts and text translation:: +* Printing:: +* Sub-processes:: +* Network access:: +* Text and Utility modes:: +* Developing with Emacs:: +* Other useful ports:: +* Further information:: +* Indexes:: +@end menu + +@c ------------------------------------------------------------ +@node Introduction +@chapter Introduction +@cindex scope of FAQ + +This FAQ covers questions that are specific to running GNU Emacs on Windows. +For more general information, see the other Emacs manuals. +@xref{Further information}. + +@menu +* Why Emacs on Windows:: +* Which versions of Windows:: +* Other versions of Emacs:: +@end menu + +@node Why Emacs on Windows +@section Why support GNU Emacs on Windows? +@cindex Why Windows + +It is not our goal to ``help Windows users'' by making text editing +on Windows more convenient. We aim to replace proprietary software, +not to enhance it. So why support GNU Emacs on Windows? + +We hope that the experience of using GNU Emacs on Windows will give +programmers a taste of freedom, and that this will later inspire them +to move to a free operating system such as GNU/Linux. That is the +main valid reason to support free applications on nonfree operating +systems. + +@node Which versions of Windows +@section Which versions of Windows are supported? +@cindex Windows, versions +@cindex supported versions of Windows + +Emacs @value{EMACSVER} is known to run on all versions of Windows from +@c FIXME does it really still support Windows 98? Does it matter? +Windows 98 and Windows NT 4.0 through to Windows 7. The Windows port is +built using the Win32 API and supports most features of the X version, +including variable width fonts, images and tooltips. + +@node Other versions of Emacs +@section What other versions of Emacs run on Windows? +@cindex other ports of Emacs + +@xref{Cygwin}. + +@cindex DOS port +@cindex Windows 3.11 port +Emacs can also be compiled for MSDOS. When run on recent MS Windows, +it supports long file names, and uses the Windows clipboard. +See the @file{msdos} directory in the Emacs sources for building +instructions (requires DJGPP). + +@c ------------------------------------------------------------ +@node Getting Emacs +@chapter Getting Emacs + +@menu +* Downloading:: +* Compiling:: +* Debugging:: +@end menu + +@node Downloading +@section Where can I download Emacs? + +@cindex precompiled binaries +@cindex where to get Emacs binaries +Pre-compiled versions are distributed from +@uref{http://ftpmirror.gnu.org/emacs/windows/, ftp.gnu.org mirrors}. +Emacs binaries are distributed as zip files, digitally +signed by the developer who built them. Generally most users will +want the file @file{emacs-@value{EMACSVER}-bin-i386.zip}, which +contains everything you need to get started. + +@cindex where to get sources +@cindex Emacs source code +@cindex source for Emacs +The latest source is available from +@uref{http://ftpmirror.gnu.org/emacs/, ftp.gnu.org mirrors}. It is +distributed as a compressed tar file, digitally signed by the maintainer +who made the release. + +@cindex Bzr, getting Emacs +@cindex latest development version of Emacs +@cindex Emacs Development +The development version of Emacs is available from +@uref{http://savannah.gnu.org/projects/emacs, Savannah}, the GNU +development site. + +@node Compiling +@section How can I compile Emacs myself? +@cindex compiling Emacs + +To compile Emacs on Windows, you will need the MingW or Cygwin port of +GCC with MingW make, or a Microsoft C compiler with nmake and the +single threaded C runtime library. Recent versions of Microsoft +Visual Studio no longer come with the single threaded C runtime +library, which is required for certain POSIX compatibility, so MingW +is usually the best choice. Image support requires external +libraries, the headers and import libraries for which will need to be +installed where your compiler can find them. You will also need ports +of GNU @command{rm} and @command{cp}, as the Windows native +equivalents are not consistent between versions. GNU texinfo will be +required to build the manuals. @xref{Other useful ports}. + +After unpacking the source, or checking out of Bzr, be sure to read the +instructions in @file{nt/README} and @file{nt/INSTALL}. + +@node Debugging +@section How do I use a debugger on Emacs? +@cindex debugging Emacs +@cindex bugs in Emacs, how to debug +@cindex Emacs debugging + +By default, Emacs is compiled with debugging on, and optimizations enabled. +The optimizations may interfere with some types of debugging; the debugger +may not show clearly where it is, or may not be able to inspect certain +variables. If this is the case, reconfigure with @option{--no-opt}. + +The file @file{etc/DEBUG} contains general debugging hints, as well as +specific notes about debugging Emacs with both gdb and Microsoft debuggers. + +@menu +* GDB:: +* Microsoft Developer Studio:: +@end menu + +@node GDB +@subsection GDB +@cindex GDB, debugging Emacs with +@cindex debugging Emacs with GDB + +GDB is the GNU debugger, which can be used to debug Emacs when it has +been compiled with GCC. The best results will be obtained if you +start gdb from the @file{src} directory as @samp{gdb oo/i386/emacs.exe}. +This will load the init file @file{.gdbinit} in that directory, to +define some extra commands for working with lisp while debugging, and +set up breakpoints to catch abnormal aborts. + +@node Microsoft Developer Studio +@subsection Microsoft Developer Studio +@cindex MSVC++, debugging Emacs with +@cindex DevStudio, debugging Emacs with +@cindex debugging Emacs with MS DevStudio + +MS DevStudio can be used to debug Emacs when it has been compiled with +a Microsoft compiler. To view lisp variables, you can call the +function @code{debug_print} from the Quickwatch window. Some +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/debug.txt, +old tips} are probably still valid. + +@c ------------------------------------------------------------ +@node Installing Emacs +@chapter Installing Emacs + +@menu +* Unpacking:: +* Installing:: +* Image support:: +* Init file:: +* Location of init file:: +* Troubleshooting init file:: +* Associate files with Emacs:: +* Find-file and the Desktop:: +* Make Windows more like X:: +* Make Emacs like a Windows app:: +* Window operations:: +* Uninstall:: +* Does not run:: +* Virus:: +* Anti-virus:: +@end menu + +@node Unpacking +@section How do I unpack the distributions? +@cindex unpacking Emacs distribution +@cindex extracting Emacs distribution +@cindex unzipping Emacs distribution +@cindex untarring Emacs distribution +@cindex zip files, how to unpack Emacs binaries +@cindex tar.gz files, how to unpack Emacs sources + +The binary distributions are distributed as zip files, which are handled +natively by Windows XP and later. For earlier versions, there are many +tools that can handle the zip format, from InfoZip's command line unzip +tool, to 7zip's multi-format graphical archive explorer. Although +popular, WinZip has caused problems with line-ends in the past, and is not +Free software, so we do not recommend it. + +Source distributions are distributed as gzipped tar files. 7zip and +similar multi-format graphical tools can handle these, or you can get +Windows ports of the command line gzip and tar tools from multiple sources. +@xref{Other useful ports}. + +The command to unpack a source distribution from the command line is: +@example +tar xzf emacs-@value{EMACSVER}.tar.gz +@end example + +If this does not work with the versions of tar and gzip that you have, +you may need to try a two step process: +@example +gzip -dc emacs-@value{EMACSVER}.tar.gz | tar xvf - +@end example + +You may see many messages from tar complaining about being unable to change +the modification time on directories, and from gzip complaining about a +broken pipe. These messages are usually harmless, caused by incomplete ports +that are not fully aware of the limitations of Windows. + +@node Installing +@section How do I install Emacs after unpacking? +@cindex installing Emacs +@pindex addpm +@cindex Start Menu, creating icons for Emacs + +You can run Emacs without any extra steps, but if you want icons in your +Start Menu, or for Emacs to detect the image libraries that are already +installed on your system as part of GTK, then you should run the program +@file{emacs-@value{EMACSVER}\bin\addpm.exe}. + +@node Image support +@section How do I get image support? +@cindex images, installing libraries for +@cindex jpeg, installing image support in Emacs +@cindex png, installing image support in Emacs +@cindex gif, installing image support in Emacs +@cindex tiff, installing image support in Emacs +@cindex xpm, installing image support in Emacs +@cindex toolbar, installing color icons in +@cindex color images, installing support for images in Emacs +@cindex monochrome images, getting color images in Emacs +@cindex black and white images, getting color images in Emacs + +Emacs has built in support for XBM and PBM/PGM/PPM images. This is +sufficient to see the monochrome splash screen and tool-bar icons. +Since 22.2, the official precompiled binaries for Windows have bundled +libXpm, which is required to display the color versions of those images. + +Emacs is compiled to recognize JPEG, PNG, GIF and TIFF images also, +but displaying these image types require external DLLs which are not +bundled with Emacs. @xref{Other useful ports}. + +@node Init file +@section What is my init file? +@cindex .emacs +@cindex init file + +When Emacs starts up, it attempts to load and execute the contents of +a file commonly called @file{.emacs} (though it may have other names, +@pxref{Installing Emacs,,Where do I put my init file?}) which contains any +customizations you have made. You can manually add lisp code to your +.emacs, or you can use the Customization interface accessible from the +@emph{Options} menu. If the file does not exist, Emacs will start +with the default settings. + +@node Location of init file +@section Where do I put my init file? +@cindex HOME directory +@cindex .emacs.d +@cindex _emacs +@cindex init.el +@cindex registry, setting the HOME directory in + +On Windows, the .emacs file may be called _emacs for backward +compatibility with DOS and FAT filesystems where filenames could not +start with a dot. Some users prefer to continue using such a name, +because Explorer cannot create a file with a name starting with a dot, +even though the filesystem and most other programs can handle it. +In Emacs 22 and later, the init file may also be called +@file{.emacs.d/init.el}. Many of the other files that are created +by lisp packages are now stored in the @file{.emacs.d} directory too, +so this keeps all your Emacs related files in one place. + +All the files mentioned above should go in your @env{HOME} directory. +The @env{HOME} directory is determined by following the steps below: + +@enumerate +@item +If the environment variable @env{HOME} is set, use the directory it indicates. +@item +If the registry entry @code{HKCU\SOFTWARE\GNU\Emacs\HOME} is set, use the +directory it indicates. +@item +If the registry entry @code{HKLM\SOFTWARE\GNU\Emacs\HOME} is set, use the +directory it indicates. Not recommended, as it results in users sharing +the same HOME directory. +@item +If @file{C:\.emacs} exists, then use @file{C:/}. This is for +backward compatibility, as previous versions defaulted to @file{C:/} +if @env{HOME} was not set. +@item +Use the user's AppData directory, usually a directory called +@file{Application Data} under the user's profile directory, the location +of which varies according to Windows version and whether the computer is +part of a domain. +@end enumerate + +Within Emacs, @key{~} at the beginning of a file name is expanded to your +@env{HOME} directory, so you can always find your .emacs file with +@kbd{C-x C-f ~/.emacs}. + +@node Troubleshooting init file +@section Troubleshooting init file problems +@cindex troubleshooting init problems +@cindex debugging init problems +@cindex checking that HOME is set correctly + +If you've set @env{HOME} to a directory using one of the above +methods, and Emacs still doesn't load your init file, the first +thing you should do is check to see what Emacs thinks @env{HOME} is set +to. You can do this by evaluating the following expression in the +@file{*scratch*} buffer using @kbd{C-x C-e}: + +@example +(insert (getenv "HOME")) +@end example + +Look carefully at what is printed and make sure the value is +valid. For example, if the value has trailing whitespace, Emacs won't +be able to find the directory. Also, be sure that the value isn't a +relative drive letter (e.g., @file{d:} without a backslash); if it is, +then @env{HOME} is going to be whatever the current directory on that +drive is, which is likely not what you want to happen. + +@node Associate files with Emacs +@section How do I associate files with Emacs? +@cindex Explorer, associating Emacs with files in +@cindex emacsclient, associating files with +@cindex file associations +@cindex associating files with Emacs +@cindex ALTERNATE_EDITOR +@findex server-start + +The recommended way to associate files is to associate them with +@command{emacsclientw.exe}. In order for this to work when Emacs is +not yet started, you will also need to set the environment variable +@env{ALTERNATE_EDITOR} to @command{runemacs.exe}. To open files +in a running instance of Emacs, you will need to add the following +to your init file: +@example +(server-start) +@end example + +@menu +* Using with Explorer:: +@end menu + +@node Using with Explorer +@subsection For use with Internet Explorer +@cindex Internet Explorer, view source in Emacs +@cindex mailto urls, associating with Emacs +@cindex news urls, associating with Emacs +@cindex URLs, associating mail and news URLs with Emacs + +You can use Emacs as the editor for composing mail for +@indicateurl{mailto:} links, reading usenet for @indicateurl{news:} +links, and viewing source. The following registry entries control +this: + +@itemize @w{} +@item +Mail +@itemize +@item @strong{Key:} HKCR\mailto\shell\open\command\(Default) +@item @strong{Value:} emacsclientw -e "(message-mail (substring \"%1\" 7))" +@end itemize + +@item +News +@itemize +@item @strong{Key:} HKCR\news\shell\open\command\(Default) +@item @strong{Value:} emacsclientw -e "(gnus-fetch-group (substring \"%1\" 5)" +@end itemize + +@item +View Source +@itemize +@item @strong{Key:} HKCR\htmlfile\shell\edit\command\(Default) +@item @strong{Value:} emacsclientw "%1" +@end itemize + +@end itemize + +Thanks to Jason Rumney and Sigbjorn Finne for these tips. + +@node Find-file and the Desktop +@section How do I use find-file to open files that are on the Desktop? +@cindex Desktop, finding where it is +@cindex finding the Desktop +@cindex locating files on the Desktop + +The location of the Desktop varies between different versions of +Windows, and in a corporate environment can be moved around by the +network administrator. On NT derivatives, you can use the value of +the @env{USERPROFILE} environment variable to find where the desktop +might be: + +@example +@kbd{C-x C-f $USERPROFILE/Desktop} +@end example + +If this doesn't work, then you probably have to forgo the keyboard +just this once, and either drag a file onto the Emacs frame from the +desktop, or use the file dialog (displayed when you use the toolbar or +menu by default). Once you have a file from the Desktop inside Emacs, +@kbd{C-x C-f} will quickly reveal where your desktop is kept. + +@node Make Windows more like X +@section How can I modify Windows to act more like X? +@cindex X, making Windows behave like + +@menu +* Focus follows mouse:: +* Swap CapsLock and Control:: +@end menu + +@node Focus follows mouse +@subsection How do it make the active window follow the mouse? +@vindex focus-follows-mouse +@cindex point to focus +@cindex mouse over to focus + +Customize the variables @code{focus-follows-mouse} and +@code{mouse-autoselect-window}. The former can be used to mislead +Emacs into giving focus to other frames when the mouse is over them, +even though Windows has a click to focus policy by default (there is +software available to change that though). The latter can be used to +make Emacs use a focus-follow-mouse policy within its own frames. + +@node Swap CapsLock and Control +@subsection How do I swap CapsLock and Control? +@cindex scan codes, modifying +@cindex key layout, customizing +@cindex caps-lock, swapping with control key +@cindex control key, swapping with caps-lock +@cindex windows key, use as alt +@cindex alt key, using windows keys as additional + +This cannot be done within Emacs, but you can modify the scan code +mappings in the registry or define a new keyboard layout to swap the +keys on a system wide basis. + +@menu +* Swap Caps NT:: +* Swap Caps 98:: +@end menu + +@node Swap Caps NT +@subsubsection Windows NT/2000/XP/Vista? + +@itemize +@item +From Chris McMahon. To make CapsLock a Control key (leaving your +original control keys as they were), use this registry file: +@example +REGEDIT4 + +[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout] +"Scancode Map"=hex:00,00,00,00,00,00,00,00,02,00,00,00,1d,00,3a,00,00,00,00,00 +@end example +To swap CapsLock and the left Control key, use: +@example +REGEDIT4 + +[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout] +"Scancode Map"=hex:00,00,00,00,00,00,00,00,03,00,00,00,1d,00,3a,00,3a,00,1d,00,00,00,00,00 +@end example +Save these as files with a @file{.reg} extension, and double-click on +them in Explorer, or ``run'' them from a command prompt to have them +update your registry (you may need to reboot). +@item +Shane Holder gives some background on how "Scancode Map" is used +by the system: +@ignore +http://ftp.gnu.org/old-gnu/emacs/windows/docs/ntemacs/contrib/caps-ctrl-registry.txt +From: Shane Holder +To: ntemacs-users@@cs.washington.edu +Date: 04 Dec 1996 14:36:21 -0600 +Message-ID: +Subject: Re: Re[2]: problem with caps/ctrl swap on NT 4.0 +@end ignore +@example +It's a binary value that lets you map keystrokes in the low-level keyboard +drivers in NT. As a result you don't have to worry about applications +bypassing mappings that you've done at a higher level (i.e. it just works). + +Here's the format of the value: + + DWORD: 0x00000000 header + DWORD: 0x00000000 header + DWORD: length (in DWORDs) of remaining data, including terminating DWORD + DWORD: mapping 1 + ... + DWORD: mapping n + DWORD: 0x00000000 terminating null DWORD + +Each mapping DWORD has two parts: the input scancode, and an output +scancode. To map scancode 0x1d (left control) to scancode 0x3a (caps +lock), you want a value of 0x003a001d. Note that this does not swap the +keys. Using just this mapping value, both the left control and the caps +lock key will behave as caps-lock. To swap, you also need to map 0x3a to +0x1d, using 0x001d003a. + +This registry value is system wide, and can't be made user-specific. It +also only takes affect on reboot. +@end example +@item +Ulfar Erlingsson has provided a registry file that sets the CapsLock key +to be a Control key and the Windows key to be an Alt key: +@example +REGEDIT4 + +[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout] +"Scancode Map"=hex:00,00,00,00,00,00,00,00,03,00,00,00,1d,00,3a,00,38,00,5b,e0,00,00,00,00 +@end example +@end itemize + +@node Swap Caps 98 +@subsubsection Windows 95/98/ME + +Microsoft has a tool called keyremap that is part of their Kernel Toys add ons +for Windows 95. The tool has also been confirmed to work on Windows 98. + +@node Make Emacs like a Windows app +@section How can I modify Emacs to act more like a Windows app? +@cindex Windows, making Emacs act more like +@cindex UI, making Emacs more like other Windows apps + +Many beginning users find Emacs difficult to use because its user +interface is different in many ways. Emacs predates most UI +standards, and experienced Emacs users are used to the way things are, +so changing the defaults is difficult. Most of the ``standard'' +behavior can be approximated in Emacs after some configuring though. + +@menu +* Highlight selection:: +* CUA:: +@end menu + +@node Highlight selection +@subsection Highlighting the selection +@cindex transient-mark-mode +@cindex selection, highlighting +@cindex region, highlighting +@cindex highlighting the selected region +@cindex marked region, highlighting +@cindex point and mark, highlighting the region between +@cindex delete-selection-mode +@cindex overwriting the selected region + +Emacs has a concept of a mark and point that is similar to selections +in other programs. But the mark in Emacs is used for more than just +defining the selected region, it lives on while you continue to edit +and move around the buffer so it can also be a kind of bookmark. The +history of marks is saved so you can pop previous marks back to the +top of the stack to go back to somewhere you were some time ago. +Because of this dual purpose, the region between mark and point is not +highlighted by default unless you select a region by clicking and +dragging the mouse. + +The minor mode @code{transient-mark-mode} changes the behavior of +the mark in two ways. First, it distinguishes between an active mark +that has just been defined or reactivated, and an inactive mark. When +the mark is active, some commands that normally act on lines, words, +buffers etc. will instead act on the region. An inactive mark needs +to be reactivated to operate on it, unless @code{mark-even-if-inactive} +is set. Secondly, @code{transient-mark-mode} also highlights the +region when it is active, providing the same visual clue that you get +in other programs. + +In addition to seeing the highlighting, new Emacs users often expect +editing commands to replace the region when it is active. This behavior +can be obtained with @code{delete-selection-mode}, but see the following +question also. + +@node CUA +@subsection Standard Windows key bindings +@findex cua-mode +@cindex CUA keybindings +@cindex shift key, selecting with +@cindex standard Windows keybindings +@cindex paste with C-v +@cindex cut with C-x +@cindex copy with C-c +@cindex C-c to copy +@cindex C-x to cut +@cindex C-v to paste + +The keybindings of Emacs predate modern GUIs, and the keys that were +chosen by later GUIs for cut and copy were given important functions +as extended keymaps in Emacs. CUA mode attempts to let both bindings +co-exist by defining C-x and C-c as @code{kill-region} and +@code{copy-region-as-kill} when the region is active, and letting +them have their normal Emacs bindings when the region is not active. +Many people find this to be an acceptable compromise. CUA mode also +defines a number of other keys (C-v, Shift selection), and can be turned +on from the @emph{Options} menu. + +@node Window operations +@section Window operations +@cindex maximize frames from lisp +@cindex minimize frames from lisp +@cindex WM_SYSCOMMAND, sending system commands from lisp +@cindex system menu, simulating from lisp + +The function @code{w32-send-sys-command} can be used to simulate +choosing commands from the system menu (in the top left corner of the +Window) and a few other system wide functions. It takes an integer +argument, the value of which should be a valid @code{WM_SYSCOMMAND} +message as documented in Microsoft's API documentation. + +@node Uninstall +@section How do I uninstall Emacs? +@cindex uninstall Emacs +@cindex remove Emacs +@cindex clean Emacs registry settings +@cindex registry, cleaning the Emacs settings +@cindex Start Menu, removing Emacs from +@cindex upgrading Emacs +@cindex delete Emacs directory + +Emacs does not come with an uninstall program. No files are installed +outside of the Emacs base directory, so deleting that directory is +sufficient to clean away the files. If you ran @command{addpm}, +you'll need to delete the Start Menu group too. The registry entries +inserted by @command{addpm} will not cause any problems if you leave +them there, but for the sake of completeness, you can use @command{regedit} +to remove the keys under @code{HKEY_LOCAL_MACHINE} orx +@code{HKEY_CURRENT_USER}: @code{SOFTWARE\GNU\Emacs}, and the key +@code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\emacs.exe} if it exists. + +@node Does not run +@section When I run Emacs nothing happens +@cindex troubleshooting installation problems +@cindex window not appearing, Emacs +@cindex failure to run, Emacs +@cindex 8.3 filenames, problems caused + +Emacs could have failed to run for a number of reasons. The most +common symptom is that, when Emacs is started, the cursor changes for +a second but nothing happens. If this happens to you, it is quite +likely that the distribution was unpacked incorrectly. + +Check for the following to see if there was a problem during unpacking: +@enumerate +@item +Be sure to disable the CR/LF translation or the executables will be +unusable. Older versions of WinZipNT would enable this translation by +default. If you are using WinZipNT, disable it. +@item +Check that filenames were not truncated to 8.3. For example, there +should be a file CONTRIBUTE in the top level directory; if this has +been truncated to CONTRIBU or CONTRI~1, your distribution has been +corrupted while unpacking and Emacs will not start. +@end enumerate + +If it is still not working, send mail to the list, describing what +you've done, and what you are seeing. (The more information you send +the more likely it is that you'll receive a helpful response.. + +@node Virus +@section Does Emacs contain a virus? +@cindex virus reported in Emacs +@cindex anti-virus software reporting a virus in Emacs + +There have been reports in the past that some virus scanners claim +that the Emacs distribution has a virus. This is extremely unlikely if +you have downloaded Emacs from the GNU FTP site or one of its mirrors +and the GPG signature for it is valid and listed in the GNU keyring, +unless perhaps it is a new release made in the last few days, in which +case you should exercise more caution and report the problem. Past +problems seem to have been caused by virus checkers running into a +buffer size limit when unpacking large tar.gz files for scanning, and +reporting the failure as an ``unknown virus''. + +@node Anti-virus +@section What known problems are there with anti-virus software? +@cindex anti-virus software, bad interaction with +@cindex virus software, bad interaction with +@cindex firewall, bad interaction with +@cindex scan all files, anti-virus option causing problems +@cindex auto protect, anti-virus option causing problems +@cindex shell, interacting badly with anti-virus +@cindex subprocesses, interacting badly with anti-virus + +Anti-virus and firewall software can block Emacs from starting subprocesses +and opening network connections. Most such products have an Advanced +mode where they will prompt you rather than silently blocking. In some cases +the ``scan all files'' or ``auto protect'' option of anti-virus programs +has caused failures running shell related commands within Emacs. +@xref{Sub-processes,,Why is nothing happening when I enter shell commands?}. + +@c ------------------------------------------------------------ +@node Display Settings +@chapter Display Settings + +@menu +* Console window size:: +* Mouse trouble:: +* Cut and paste NUL:: +* Garbled clipboard:: +* Beep sound:: +@end menu + +@node Console window size +@section Emacs in console mode goes beyond the window size +@cindex console, window size +@cindex telnet, display size problems running emacs over +@cindex -nw, window size +@vindex w32-use-full-screen-buffer + +The variable @code{w32-use-full-screen-buffer} controls whether Emacs uses +the window size or buffer size to determine the number of lines on screen. +Normally the window size is correct, but when running Emacs over some +telnet servers, the buffer size needs to be used. Emacs tries to guess +the correct value at startup, but if it guesses wrong, you can customize +that variable yourself. + +@node Mouse trouble +@section What do I do if I have problems with my mouse buttons? +@cindex mouse buttons, problems with +@cindex 2 button mouse +@cindex two button mouse +@cindex third mouse button, simulating +@cindex middle mouse button, simulating +@cindex simulating three button mouse with two buttons +@cindex swap right and middle mouse buttons +@cindex exchange mouse-2 and mouse-3 buttons +@vindex w32-mouse-button-tolerance +@vindex w32-num-mouse-buttons +@vindex w32-swap-mouse-buttons + +Emacs assigns bindings assuming a three button mouse. On Windows, if +a two button mouse is detected, a hack is enabled which lets you +simulate the third button by pressing both mouse buttons +simultaneously. @code{w32-mouse-button-tolerance} defines the timeout +for what is considered ``simultaneous''. You can check how many +buttons Emacs thinks your mouse has with @kbd{C-h v} +@code{w32-num-mouse-buttons}. + +If you find yourself needing the mouse-3 bindings more often than mouse-2, +you can swap the buttons with the following code in your init file: +@example +(setq w32-swap-mouse-buttons t) +@end example + +@node Cut and paste NUL +@section How do I cut and paste text with NUL characters? +@cindex clipboard, NUL characters + +If you attempt to cut and paste text with NUL characters embedded in it, +then the text will be truncated at the first NUL character. This is a +limitation of the Windows clipboard, and does not affect killing and yanking +from the kill-ring within Emacs. + +@node Garbled clipboard +@section How can I fix garbled text yanked from the clipboard? +@cindex clipboard, corruption of +@cindex garbage on the clipboard +@cindex clipboard encoding +@cindex encoding, clipboard +@findex set-selection-coding-system + +You can try @code{set-selection-coding-system}, but generally such +corruption is a thing of the past, as Emacs uses Unicode for the clipboard +by default now. + +@node Beep sound +@section How do I change the sound of the Emacs beep? +@cindex beep, changing the sound +@cindex sound, changing the beep +@findex set-message-beep + +You can use the function @code{set-message-beep} to change the sound +that Emacs uses for its beep. This affects both console and GUI frames. +The doc string contains a list of the system sounds you can use. + +@c ------------------------------------------------------------ +@node Fonts and text translation +@chapter Fonts and text translation + +@menu +* Font names:: +* Bold and italic:: +* Multilingual fonts:: +* BDF fonts:: +* Font menu:: +* Line ends:: +@end menu + +@node Font names +@section Font names +@cindex XLFD font names +@cindex font XLFD name format +@cindex fontconfig font names in Emacs 23 +@cindex font dialog, using to find font names +@findex w32-select-font +@findex x-list-fonts + +Fonts in Emacs 22 and earlier are named using the X Logical Font +Description (XLFD) format. Emacs on Windows ignores many of the +fields, and populates them with * when listing fonts. Former +maintainer Andrew Innes wrote +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/x-font-details, +this explanation} of what each field in the font string means and how +Emacs treated them back in 19.34. Since then, multilingual support and +a redisplay overhaul to support variable width fonts have changed things +slightly; more character sets are recognized (and the old pseudo character +sets are deprecated), and the resolution fields are used to calculate the +difference between point and pixel sizes, but normally you should leave +these at the system default. The foundry field is also populated with +an indication of whether the font is outline (.TTF, .ATM) or raster (.FON) +based when fonts are listed, which may let you differentiate between two +fonts with the same name and different technologies. + +From Emacs 23, the preferred font name format will be moving to the simpler +and more flexible fontconfig format. XLFD names will continue to be +supported for backward compatibility. + +@example +XLFD: -*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1 +Fontconfig: Courier New-13 +@end example + +To find the XFLD name for a font, you can execute the following in the +@file{*scratch*} buffer by pressing C-j at the end of the line: +@example +(w32-select-font nil t) +@end example + +To see a complete list of fonts, execute the following in the +@file{*scratch*} buffer by pressing C-x C-e at the end of the line: +@example +(insert (prin1-to-string (x-list-fonts "*"))) +@end example + +The command line options and frame-parameters for changing the default font +in Emacs are documented in the manual. Fonts can also be used when defining +faces, though family and size are generally specified individually there. +In addition, Emacs on Windows reads the registry to find X Resources. This +is also documented in the manual. + +@node Bold and italic +@section How can I get bold and italic fonts to work? +@cindex italic fonts +@cindex synthesized italic and bold fonts +@cindex bold fonts, synthesized +@findex set-face-font +@vindex w32-enable-synthesized-fonts + +Emacs will only use the italic (and bold) versions of a font automatically +if it has the same width as the normal version. Many fonts have italic +and bold versions that are slightly wider. It will also only use real +bold and italic fonts by default, where other applications may use +synthesized variations that are derived from the normal font. To enable +more italic and bold fonts to be displayed, you can enable synthesized fonts +and manually set the font for italic, bold and bold-italic as follows: + +@example +(setq w32-enable-synthesized-fonts t) +(set-face-font 'italic "-*-Courier New-normal-i-*-*-11-*-*-*-c-*-iso8859-1") +(set-face-font 'bold-italic "-*-Courier New-bold-i-*-*-11-*-*-*-c-*-iso8859-1") +@end example + +@node Multilingual fonts +@section Multilingual font support +@cindex multilingual display, fonts +@cindex MULE, fonts + +@menu +* Language display:: +* Non-latin display:: +* International fonts:: +* Third-party multibyte:: +* Localized fonts:: +@end menu + +@node Language display +@subsection Is it possible to display all the supported languages? +@cindex HELLO file, displaying all +@cindex language support, fonts +@cindex GNU intlfonts, for displaying all languages +@cindex intlfonts, for displaying all languages + +To display all the languages that Emacs is capable of displaying, you will +require the BDF fonts from the GNU intlfonts package. +@xref{Fonts and text translation,,How do I use bdf fonts with Emacs?}. + +For many languages, native truetype fonts are sufficient, and in Emacs +23 the need for BDF fonts will disappear for almost all languages. At +the time of writing, some Arabic characters in the HELLO file still do +not display with native fonts, because they are pre-composed characters +from MULE character sets rather than standard Unicode Arabic, but all +other characters are able to be displayed with appropriate truetype or +opentype fonts. + +@node Non-latin display +@subsection How do I get Emacs to display non-latin characters? +@cindex fontsets, defining +@cindex language support, forcing Emacs to use specific fonts +@cindex MULE, fontsets +@cindex multilingual display, fontsets +@findex create-fontset-from-ascii-font +@findex create-fontset-from-fontset-spec + +Recent versions of Emacs display a large range of characters out of +the box, but if you are having problems with a particular character +set which you know you have fonts for, you can try defining a +new fontset with @code{create-fontset-from-ascii-font} or +@code{create-fontset-from-fontset-spec}. + +@example +(create-fontset-from-fontset-spec + "-*-Courier New-normal-r-*-*-12-*-*-*-c-*-fontset-most, + latin-iso8859-2:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-2, + latin-iso8859-3:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-3, + latin-iso8859-4:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-4, + cyrillic-iso8859-5:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-5, + greek-iso8859-7:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-7, + latin-iso8859-9:-*-Courier New-normal-r-*-*-12-*-*-*-c-*-iso8859-9, + japanese-jisx0208:-*-MS Gothic-normal-r-*-*-12-*-*-*-c-*-jisx0208-sjis, + katakana-jisx0201:-*-MS Gothic-normal-r-*-*-12-*-*-*-c-*-jisx0208-sjis, + latin-jisx0201:-*-MS Gothic-normal-r-*-*-12-*-*-*-c-*-jisx0208-sjis, + japanese-jisx0208-1978:-*-MS Gothic-normal-r-*-*-12-*-*-*-c-*-jisx0208-sjis, + korean-ksc5601:-*-Gulim-normal-r-*-*-12-*-*-*-c-*-ksc5601-*, + chinese-gb2312:-*-MS Song-normal-r-*-*-12-*-*-*-c-*-gb2312-*, + chinese-big5-1:-*-MingLiU-normal-r-*-*-12-*-*-*-c-*-big5-*, + chinese-big5-2:-*-MingLiU-normal-r-*-*-12-*-*-*-c-*-big5-*" t) +@end example + +@node International fonts +@subsection Where can I find fonts for other languages? +@cindex language support, finding fonts +@cindex fonts, where to find +@cindex MULE, finding fonts +@cindex multilingual display, finding fonts +@cindex GNU intlfonts, where to get +@cindex intlfonts, where to get + +In addition to the wide range of fonts that come with the language +support packages of various components of Windows itself, GNU/Linux +distributions these days come with a number of Free truetype fonts +that cover a wide range of languages. The GNU intlfonts source +distribution contains BDF fonts covering all of the languages that can +be displayed by Emacs 22, and can be downloaded from +@uref{http://ftpmirror.gnu.org/intlfonts, ftp.gnu.org mirrors}. + +@node Third-party multibyte +@subsection How do I use third party programs to display multibyte characters? +@cindex multilingual display, third party programs on Windows 9x/ME +@cindex language support, third party programs on Windows 9x/ME +@vindex w32-enable-unicode-output + +You probably only need to do this on the non-Unicode versions of Windows +(95, 98 and ME), and even then, various Windows and Internet Explorer +updates have made third party software unnecessary in most cases. +If you are having trouble displaying text, try defining a fontset +with the font for the languages that the third party software handles +set to what that software expects (which may not be an appropriate font +for that language, but the third party software is intercepting it +and using a different font behind the scenes). +@xref{Non-latin display}. + +In addition to defining a fontset with the expected font, you may also need +to disable unicode output with: +@example +(setq w32-enable-unicode-output nil) +@end example + +@node Localized fonts +@subsection Can I use a font with a name in my language? +@cindex fonts, localized font names +@vindex locale-coding-system + +Normally Emacs should initialize @code{locale-coding-system} appropriately +based on your locale, which will let Emacs use font names in your local +language successfully. + +@node BDF fonts +@section How do I use bdf fonts with Emacs? +@cindex BDF fonts, using +@cindex GNU intlfonts, using +@cindex intlfonts, using +@vindex w32-bdf-filename-alist +@vindex bdf-directory-alist +@vindex font-encoding-alist +@findex w32-find-bdf-fonts +@findex set-frame-font + +To use bdf fonts with Emacs, you need to tell Emacs where the fonts +are located, create fontsets for them, and then use them. We'll use +the 16 dot international fonts from @uref{http://ftpmirror.gnu.org/intlfonts, +ftp.gnu.org/gnu/intlfonts} as an +example put together by Jason Rumney. + +Download @file{16dots.tar.gz} and unpack it; I'll assume that they are in +@file{c:\intlfonts}. Then set @code{w32-bdf-filename-alist} to the list of +fonts returned by using @code{w32-find-bdf-fonts} to enumerate all of +the font files. It is a good idea to set the variable +@code{bdf-directory-list} at the same time so @code{ps-print} knows where +to find the fonts: +@example +(setq bdf-directory-list + '("c:/intlfonts/Asian" "c:/intlfonts/Chinese" + "c:/intlfonts/Chinese-X" "c:/intlfonts/Ethiopic" + "c:/intlfonts/European" "c:/intlfonts/Japanese" + "c:/intlfonts/Japanese-X" "c:/intlfonts/Korean-X" + "c:/intlfonts/Misc/")) + +(setq w32-bdf-filename-alist (w32-find-bdf-fonts bdf-directory-list)) +@end example + +Then create fontsets for the BDF fonts: + +@example +(create-fontset-from-fontset-spec + "-*-fixed-medium-r-normal-*-16-*-*-*-c-*-fontset-bdf, +japanese-jisx0208:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1983-*, +katakana-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*, +latin-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*, +japanese-jisx0208-1978:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1978-*, +thai-tis620:-misc-fixed-medium-r-normal--16-160-72-72-m-80-tis620.2529-1, +lao:-misc-fixed-medium-r-normal--16-160-72-72-m-80-MuleLao-1, +tibetan-1-column:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-80-MuleTibetan-1, +ethiopic:-Admas-Ethiomx16f-Medium-R-Normal--16-150-100-100-M-160-Ethiopic-Unicode, +tibetan:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-160-MuleTibetan-0") +@end example + +Many of the international bdf fonts from gnu.org are type 0, and therefore +need to be added to font-encoding-alist: + +@example +;; Need to add some fonts to font-encoding-alist since the bdf fonts +;; are type 0 not the default type 1. +(setq font-encoding-alist + (append '(("MuleTibetan-0" (tibetan . 0)) + ("GB2312" (chinese-gb2312 . 0)) + ("JISX0208" (japanese-jisx0208 . 0)) + ("JISX0212" (japanese-jisx0212 . 0)) + ("VISCII" (vietnamese-viscii-lower . 0)) + ("KSC5601" (korean-ksc5601 . 0)) + ("MuleArabic-0" (arabic-digit . 0)) + ("MuleArabic-1" (arabic-1-column . 0)) + ("MuleArabic-2" (arabic-2-column . 0))) font-encoding-alist)) +@end example + +You can now use the Emacs font menu (@pxref{Fonts and text +translation,,How can I have Emacs use a font menu like on X?}) to +select the @emph{bdf: 16-dot medium} fontset, or you can select it by +setting the default font: + +@example + (set-frame-font "fontset-bdf") +@end example + +Try loading the file @file{etc/HELLO}, and you should be able to see the +various international fonts displayed (except for Hindi, which is not +included in the 16-dot font distribution). + +@node Font menu +@section How can I have Emacs use a font menu like on X? +@cindex fonts, displaying a menu +@cindex fontsets, displaying a menu +@cindex font dialog, using a menu instead +@vindex w32-use-w32-font-dialog + +Place the following in your init file: + +@example +(setq w32-use-w32-font-dialog nil) +@end example + +@menu +* Add fonts to menu:: +@end menu + +@node Add fonts to menu +@subsection How can I add my font to the font menu? +@cindex font menu, adding fonts +@vindex w32-fixed-font-alist + +If you have set w32-use-w32-font-dialog to nil, you can add fonts to +the font menu by changing `w32-fixed-font-alist'. For example: + +@example +(setq w32-fixed-font-alist + (append w32-fixed-font-alist + '(("Monotype.com" + ("8" "-*-Monotype.com-normal-r-*-*-11-*-*-*-c-iso8859-1") + ("9" "-*-Monotype.com-normal-r-*-*-12-*-*-*-c-iso8859-1") + ("10" "-*-Monotype.com-normal-r-*-*-13-*-*-*-c-iso8859-1") + ("11" "-*-Monotype.com-normal-r-*-*-15-*-*-*-c-iso8859-1"))))) +@end example + +@node Line ends +@section How can I control CR/LF translation? +@cindex DOS line ends +@cindex Unix line ends +@cindex Mac line ends + +There are a number of methods by which you can control automatic CR/LF +translation in Emacs, a situation that reflects the fact that the +default support was not very robust in the past. For a discussion of +this issue, take a look at +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/translate, +this collection of email messages} on the topic. + +@menu +* Automatic line ends:: +* Line ends by filename:: +* Line ends by file system:: +@end menu + +@node Automatic line ends +@subsection Automatic CR/LF translation +@cindex line ends, automatic detection + +For existing files, Emacs scans the file to determine the line ending +convention as part of the same scan it does to determine the file +encoding. Embedded Ctrl-M (ASCII 13) characters and inconsistent line +ends can confuse the automatic scanning, and Emacs will present the +file in Unix (LF) mode with the Ctrl-M characters displayed as @samp{^M}. +It does this to be safe, as no data loss will occur if the file is really +binary and the Ctrl-M characters are significant. + +@node Line ends by filename +@subsection CR/LF translation by file extension +@cindex line ends, determining by filename +@cindex binary files, determining by file name +@vindex file-name-buffer-file-type-alist + +The variable @code{file-name-buffer-file-type-alist} holds a list of +filename patterns and their associated type; binary or text. Files marked +as binary will not have line-end detection performed on them, and instead +will always be displayed as is. With auto-detection in recent versions of +Emacs, this is seldom useful for existing files, but can still be used +to influence the choice of line ends for newly created files. + +@node Line ends by file system +@subsection CR/LF translation by file system +@cindex line ends, determining by filesystem +@cindex binary files, determining by filesystem +@vindex untranslated-filesystem-list +@findex add-untranslated-filesystem +@findex remove-untranslated-filesystem + +The variable @code{untranslated-filesystem-list} defines whole +directory trees that should not have CR/LF autodetection performed on +them. The list can be manipulated with the functions +@code{add-untranslated-filesystem} and +@code{remove-untranslated-filesystem}. With auto-detection in +recent versions of Emacs, this is seldom useful for existing files, +but can still be used to influence the choice of line ends for newly +created files. + +@c ------------------------------------------------------------ +@node Printing +@chapter Printing +@cindex printing + +A lot of effort has gone into making it easier to print from Emacs on +MS Windows, but this has still been insufficient to keep up with +changes in printing technology from text and postscript based printers +connected via ports that can be accessed directly, to graphical +printers that are only accessible via USB. For details, see +@uref{http://www.emacswiki.org/cgi-bin/wiki/PrintingFromEmacs, Emacs +Wiki}. + +@c ------------------------------------------------------------ +@node Sub-processes +@chapter Subprocesses +@cindex subprocesses + +@menu +* Quoting issues:: +* Subprocess hang:: +* Subprocess buffering:: +* Subprocesses and floppy drive:: +* Killing subprocesses:: +* Subprocess EOF:: +* Using shell:: +* Cygwin paths:: +* Dired ls:: +* Shell echo:: +* Shell completion forward slash:: +* Incorrect DOS version:: +* Shell commands do nothing:: +@end menu + +@node Quoting issues +@section Quoting issues +@cindex quoting arguments to subprocesses +@cindex sub-processes, quoting arguments to +@cindex cygwin, quoting arguments + +The quoting rules for native Windows shells and Cygwin shells have +some subtle differences. When Emacs spawns subprocesses, it tries to +determine whether the process is a Cygwin program and changes its +quoting mechanism appropriately. See this +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/shell-quoting, +previous discussion} for details. + +@node Subprocess hang +@section Programs reading input hang +@cindex subprocesses, hanging when reading input +@cindex full-screen console programs, as subprocesses +@cindex ftp, client hanging +@findex ftp + +Programs that explicitly use a handle to the console (@file{CON} or +@file{CON:}) instead of stdin and stdout cannot be used as +subprocesses to Emacs, and they will also not work in shell-mode. The +default ftp client on Windows is an example of such a program - this +ftp program is mostly fine for use with @code{ange-ftp} or +@code{tramp}, but not for @kbd{M-x ftp} (@pxref{Network access,,How do +I use FTP within Emacs}). There is no convenient way for either Emacs +or any shell used in @code{shell-mode} to redirect the input and +output of such processes from the console to input and output pipes. +The only workaround is to use a different implementation of the +program that does not use the console directly. Microsoft's new +PowerShell appears to be another such program, so that cannot be used +as a replacement shell for Emacs. + +@node Subprocess buffering +@section Buffering in shells and subprocesses +@cindex subprocesses, buffering output +@cindex output not displaying, subprocesses +@cindex SQL subprocess hanging +@cindex cvs hanging when login needed +@cindex ssh, password prompt not appearing when using with cvs +@findex sql-mode +@findex shell-mode +@cindex setbuf, using in subprocesses to prevent buffering +@cindex setvbuf, using in subprocesses to prevent buffering + +You may notice that some programs, when run in a shell in +@code{shell-mode}, +have their output buffered (e.g., people have found this happening to +them with @code{sql-mode}). When the program has a lot of output, it +overflows the buffering and gets printed to the shell buffer; however, +if the program only outputs a small amount of text, it will remain +buffered and won't appear in the shell buffer. The same can happen +in other subprocesses that themselves run other programs as +subprocesses, for example when using @command{cvs} from Emacs, which +is itself configured to use @command{ssh}, password prompts fail to +appear when expected, and @command{cvs} appears to hang. + +Although it may at first seem like the shell is buffering the output +from the program, it is actually the program that is buffering +output. The C runtime typically decides how to buffer output based +upon whether stdout is bound to a handle to a console window or +not. If bound to a console window, output is buffered line by line; if +bound to a block device, such as a file, output is buffered block by +block. + +In a shell buffer, stdout is a pipe handle and so is buffered in +blocks. If you would like the buffering behavior of your program to +behave differently, the program itself is going to have to be changed; +you can use @code{setbuf} and @code{setvbuf} to manipulate +the buffering semantics. + +Some programs handle this by having an explicit flag to control their +buffering behavior, typically @option{-i} for interactive. Other +programs manage to detect that they are running under Emacs, by +using @samp{getenv("emacs")} internally. + +@menu +* Perl script buffering:: +@end menu + +@node Perl script buffering +@subsection Perl script buffering +@cindex perl, avoiding buffering when used as a subprocess of Emacs + +A handy solution for Perl scripts to the above problem is to use: + +@example +# Turn all buffering off. +select((select(STDOUT), $| = 1)[0]); +select((select(STDERR), $| = 1)[0]); +select((select(STDIN), $| = 1)[0]); +@end example + +@node Subprocesses and floppy drive +@section 16-bit subprocesses accessing the floppy drive +@cindex floppy drive, access when subprocesses started +@cindex subprocess starting causes floppy drive access + +If you are finding the 16 bit DOS subprocesses cause your A: drive to +be accessed, hanging Emacs until the read times out if there is no +floppy in the drive, check to see if your virus software is causing +the problem. + +@node Killing subprocesses +@section Killing subprocesses on Windows 95/98/Me +@cindex subprocess, killing on Windows 95/98/ME +@cindex killing subprocesses, Windows 95/98/ME +@cindex shutdown, complaints about cmdproxy.exe running + +Emacs cannot guarantee that a subprocess gets killed on Windows 95 and +its descendants, and it is a difficult limitation to work around. To +avoid problems on these systems, you should let subprocesses run to +completion including explicitly exiting shells before killing the +associated buffer. + +If you find that while shutting down, Windows complains that there is +a running @command{cmdproxy.exe} even though you carefully exited all +shells and none were showing in Task Manager before the shutdown, this +could be due to buggy interaction with your virus scanner. + +@node Subprocess EOF +@section Sending EOF to subprocesses +@cindex EOF, sending to subprocesses +@cindex shell terminates when EOF sent to subprocess +@findex process-send-eof + +When an EOF is sent to a subprocess running in an interactive shell +with @code{process-send-eof}, the shell terminates unexpectedly as +if its input was closed. This affects the use of @kbd{C-c C-d} in +shell buffers. See +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/shell-ctrl-d, +this discussion} for more details. + +@node Using shell +@section How do I use a shell in Emacs? +@cindex interactive shell, using +@cindex shell within emacs, using +@findex shell +@findex shell-command +@vindex shell-file-name +@vindex explicit-shell-file-name + +You can start an interactive shell in Emacs by typing @kbd{M-x shell}. +Emacs uses the @env{SHELL} environment variable to determine which +program to use as the shell. To instruct Emacs to use a non-default +shell, you can either set this environment variable, or customize +@code{explicit-shell-file-name}. You can also customize +@code{shell-file-name} to change the shell that will be used by +subprocesses that are started with @code{shell-command} and +related non-interactive shell commands. + +@menu +* Bash:: +@end menu + +@node Bash +@subsection bash +@cindex cygwin bash as shell within Emacs +@cindex shell, using cygwin bash within Emacs +@cindex bash, using cygwin shell within Emacs +@vindex comint-scroll-show-maximum-output +@vindex comint-completion-addsuffix +@vindex comint-eol-on-send +@vindex w32-quote-process-args +@vindex shell-mode-hook + +Cygwin bash is a popular shell for use with Emacs. To use bash as the +default shell in Emacs, you can place the following in your init file: + +@example +(defun my-shell-setup () + "For Cygwin bash under Emacs 20" + (setq comint-scroll-show-maximum-output 'this) + (make-variable-buffer-local 'comint-completion-addsuffix)) + (setq comint-completion-addsuffix t) + ;; (setq comint-process-echoes t) ;; reported that this is no longer needed + (setq comint-eol-on-send t) + (setq w32-quote-process-args ?\") + +(setq shell-mode-hook 'my-shell-setup) +@end example + +If you find that you are having trouble with Emacs tracking drive +changes with bash, see Mike Fabian's +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/drive-tracking, +note}. + +WARNING: Some versions of bash set and use the environment variable +PID. For some as yet unknown reason, if @env{PID} is set and Emacs +passes it on to bash subshells, bash dies (Emacs can inherit the +@env{PID} variable if it's started from a bash shell). If you clear +the @env{PID} variable in your init file, you should be able to +continue to use bash as your subshell: +@example + (setenv "PID" nil) +@end example + +@node Cygwin paths +@section How do I use Cygwin style paths in Emacs? +@cindex cygwin paths, using within Emacs +@cindex mount points, cygwin +@cindex cygwin mount points, using within Emacs + +The package +@uref{http://www.emacswiki.org/cgi-bin/wiki/cygwin-mount.el, +cygwin-mount.el} teaches Emacs about Cygwin mount points. + +@node Dired ls +@section How do I make dired use my ls program? +@cindex dired, using an external ls program +@cindex dired, interpreting symlinks the same way as cygwin +@cindex symlinks in dired, interpreting the same way as cygwin +@cindex cygwin symlinks in dired +@vindex ls-lisp-use-insert-directory-program +@vindex insert-directory-program + +Dired uses an internal lisp implementation of @command{ls} by default +on Windows. For consistent display of symbolic links and other +information with other programs (eg Cygwin) and performance reasons, +you may want to use a Windows port of @command{ls} instead. + +@example +(setq ls-lisp-use-insert-directory-program t) ;; use external ls +(setq insert-directory-program "c:/cygwin/bin/ls") ;; ls program name +@end example + +@node Shell echo +@section How do I prevent shell commands from being echoed? +@cindex echo, suppressing for shell input +@cindex shell commands, suppressing echo +@vindex comint-process-echoes +@vindex comint-mode-hook +@vindex explicit-cmd.exe-args +@vindex explicit-cmdproxy.exe-args +@vindex explicit-bash.exe-args +@vindex explicit-bash-args +@cindex shell specific arguments + +Some shells echo the commands that you send to them, and the echoed +commands appear in the output buffer. In particular, the default +shells, @command{command.com} and @command{cmd.exe}, have this behavior. + +To prevent echoed commands from being printed, you can place the +following in your init file: + +@example + (defun my-comint-init () + (setq comint-process-echoes t)) + (add-hook 'comint-mode-hook 'my-comint-init) +@end example + +If @code{shell-mode} still is not stripping echoed commands, then +you'll have to explicitly tell the shell to not echo commands. You can +do this by setting the @code{explicit-@var{SHELL}-args} variable +appropriately; where @var{SHELL} is the value of your @env{SHELL} +environment variable (do a @kbd{M-: (getenv "SHELL")} to see what it +is currently set to). Assuming that you are on NT and that your +@env{SHELL} environment variable is set to @command{cmd.exe}, +then placing the following in your init file will tell +@command{cmd.exe} to not echo commands: + +@example + (setq explicit-cmd.exe-args '("/q")) +@end example + +The comint package will use the value of this variable as an argument +to @command{cmd.exe} every time it starts up a new shell; the +@option{/q} is the argument to @command{cmd.exe} that stops the +echoing (invoking @samp{cmd /?} in a shell will show you all of the +command line arguments to @command{cmd.exe}). + +Note that this variable is case sensitive; if the value of your +@env{SHELL} environment variable is @command{CMD.EXE} instead, then +this variable needs to be named @code{explicit-CMD.EXE-args} instead. + +@node Shell completion forward slash +@section How can I make shell completion use forward slashes? +@cindex completion, using forward slashes in shell buffers +@cindex forward slashes for completion in shell buffers +@vindex comint-completion-addsuffix + +The character appended to directory names when completing in a shell +buffer is controlled by the variable @code{comint-completion-addsuffix}. +See its documentation (with @kbd{C-h v}) for details. + +@node Incorrect DOS version +@section Why do I get incorrect DOS version messages? +@cindex nmake, Incorrect DOS version messages +@cindex shell, Incorrect DOS version messages +@cindex COMSPEC, effect on subprocesses of subprocesses + +This might happen if, for example, you invoke @command{nmake} in a +shell and it tries to create sub-shells. The problem happens because +when the shell is initially created, the first argument to the shell +is not the directory in which the shell program resides. When this +happens, @command{command.com} fabricates a value for its +@env{COMSPEC} environment variable that is incorrect. Then, when +other programs go to use @env{COMSPEC} to find the shell, they are +given the wrong value. + +The fix for this is to either prevent any arguments from being sent to +the shell when it starts up (in which case @command{command.com} will +use a default, and correct, value for @env{COMSPEC}), or to have the +first argument be the directory in which the shell executable resides. + +@node Shell commands do nothing +@section Why is nothing happening when I enter shell commands? +@cindex shell commands not working +@cindex anti-virus software, bad interaction with +@cindex virus software, bad interaction with +@cindex firewall, bad interaction with +@cindex scan all files, anti-virus option causing problems +@cindex auto protect, anti-virus option causing problems +@cindex shell, interacting badly with anti-virus + +Some anti-virus software has been reported to cause problems with +shells in the past. Try turning off options such as ``Scan all +files''. @xref{Installing Emacs,,What known problems are there with anti-virus software?}. + +@c ------------------------------------------------------------ +@node Network access +@chapter Network access + +@menu +* Mail:: +* Attachments with Gnus:: +* Using FTP:: +* Tramp ssh:: +* telnet:: +@end menu + +@node Mail +@section How do I use mail in Emacs? + +Emacs comes with several options for reading and writing mail. These +are documented in the manual, and the choice of which method to use +depends on personal taste. There are some issues specific to Windows +however, related to the fact that Windows machines do not have the +mail infrastructure that is commonly installed on other platforms, so +mail will not work without some configuration. + +@menu +* Outgoing mail:: +* Incoming mail with Rmail:: +* Incoming mail with Gnus:: +* Incoming mail other:: +@end menu + +@node Outgoing mail +@subsection Outgoing mail +@cindex mail, outgoing +@cindex smtp server +@vindex user-full-name +@vindex user-mail-address +@vindex smtpmail-default-smtp-server +@vindex smtpmail-smtp-server +@vindex send-mail-command +@vindex message-send-mail-function +@findex smtpmail-send-it +@vindex smtpmail-debug-info + +For outgoing mail, you will need to use @file{smtpmail.el} which +allows Emacs to talk directly to SMTP mail servers. This is included +with Emacs, and can be set up as follows: + +@example +(setq user-full-name "@var{Your full name}") +(setq user-mail-address "@var{Your@@email.address}") +(setq smtpmail-default-smtp-server "@var{domain.name.of.your.smtp.server}") + +(setq send-mail-command 'smtpmail-send-it) ; For mail-mode (Rmail) +(setq message-send-mail-function 'smtpmail-send-it) ; For message-mode (Gnus) +@end example + +Note that if you want to change the name of the SMTP server after +smtpmail is loaded, then you'll need to change +@code{smtpmail-smtp-server}. + +If you are experiencing problems with sending large messages, check +the value of the variable @code{smtpmail-debug-info}. If it is non-nil, you +should set it to @code{nil}: + +@node Incoming mail with Rmail +@subsection Incoming mail with Rmail and POP3 +@cindex mail, incoming with rmail +@cindex pop3, using rmail +@cindex rmail, mail client +@cindex movemail, using pop3 +@cindex MAILHOST +@vindex rmail-primary-inbox-list +@vindex rmail-pop-password-required + +For incoming mail using the Rmail package and a POP3 server, you will +need the following configuration: + +@example +(setenv "MAILHOST" "@var{domain.name.of.your.pop3.server}") +(setq rmail-primary-inbox-list '("po:@var{your logon id}")) +(setq rmail-pop-password-required t) +@end example + +@node Incoming mail with Gnus +@subsection Incoming mail with Gnus +@cindex mail, incoming with Gnus +@cindex pop3, using Gnus +@cindex imap, using Gnus +@cindex gnus, mail and news client + +Although Gnus started life as a Usenet news reader, it also makes a +good mail reader, particularly if you subscribe to a lot of mailing +lists, or you want to use IMAP rather than POP3, which is not +supported by Rmail. @xref{Top,The Gnus manual,,gnus, The Gnus manual}. + +@node Incoming mail other +@subsection Other incoming mail options +@cindex mail, other options +@cindex wanderlust, mail and news client +@cindex vm, mail client +@cindex mh-e, mail client + +Other options for reading mail in Emacs include VM, MH-E and Wanderlust. +MH-E is included with Emacs. The others require lisp or executable code +that does not come with Emacs, so you should seek help where you +obtained the packages from if you want to use them. + +@node Attachments with Gnus +@section How do I open attachments in Gnus? +@cindex gnus, attachments +@cindex attachments, in gnus +@cindex mail, attachments in gnus +@cindex .mailcap +@cindex MIME, configuration for Gnus + +In your @env{HOME} directory create a file called @file{.mailcap}, +with contents like the following: +@example +application/zip "C:/Program Files/7-Zip/7zFM.exe" +video/* "C:/Program Files/VideoLAN/VLC/vlc.exe" +@end example + +@strong{Warning:} Associating MIME types with @command{start} or other +generic Windows commands to open arbitrary files might seem like a +good idea, but it leaves your system as open to attack as Outlook +Express was at its worst. Especially dangerous is associating +application/* or */* in this way. + +@node Using FTP +@section How do I use FTP within Emacs? +@cindex ftp, using within Emacs +@cindex ange-ftp +@cindex tramp, ftp +@cindex remote hosts via ftp +@vindex ange-ftp-ftp-program-name + +Windows built in FTP client can be used with ange-ftp. Ange-ftp is +the Emacs package that provides FTP connectivity to tramp, a +multi-protocol remote file access package for Emacs that is enabled by +default. + +The Windows FTP client does have problems with some firewalls, due to +lack of passive mode support, so you may want to try an alternative +ftp client instead. Make sure that the client you are trying is in +your @env{PATH} before the default Windows client, or rename the +default Windows client to avoid it getting in the way. Alternatively +you can customize @code{ange-ftp-ftp-program-name} to the full path to +the version you are trying. @xref{Other useful ports}. + +@node Tramp ssh +@section How do I use Tramp to work in Emacs via SSH? +@cindex tramp, ssh +@cindex ssh, accessing remote hosts within Emacs +@cindex remote hosts via ssh +@cindex openssh +@cindex PuTTY +@cindex plink +@vindex tramp-default-method +@vindex tramp-default-method-alist + +Tramp can use a number of protocols to connect to remote machines to +read files and even run commands on those files remotely. A popular +one is ssh. As well as Cygwin versions of openssh, you can use +PuTTY's command line plink program as the ssh client. The relevant +methods to use in @code{tramp-default-method} or +@code{tramp-default-method-alist} for these options are: +@itemize @w{} +@item +openssh +@itemize +@item @code{scp} Uses scp for copying, ssh for shell operations. +@item @code{ssh} Uses ssh with encoding on stdin/stdout for file transfer. +@end itemize + +@item +PuTTY +@itemize +@item @code{pscp} Uses pscp for copying, plink for shell operations. +@item @code{plink} Uses plink with encoding on stdin/stdout for file transfer. +@end itemize +@end itemize + +@node telnet +@section How do I use telnet with Emacs? +@cindex telnet, in Emacs +@findex telnet +@cindex telnet client, that works with Emacs + +To use telnet-mode on Windows, you need a telnet client that uses +stdin and stdout for input and output. The default Windows client is +a Windows application, and will not work as a subprocess. Several +options exist, but information that was formerly in this FAQ is out of +date now, so no concrete pointers are available. + +@c ------------------------------------------------------------ +@node Text and Utility modes +@chapter Text and Utility modes + +@menu +* TeX:: +* Spell check:: +* Encryption:: +* Mouse wheel:: +* Grep:: +@end menu + +@node TeX +@section How do I use TeX with Emacs? +@cindex tex +@cindex typesetting + +You will need an implementation of TeX for Windows. +A number of implementations are listed on the +@uref{http://www.tug.org/interest.html#free, TeX Users Group} website. + +@menu +* AUCTeX:: +@end menu + +@node AUCTeX +@subsection AUCTeX +@cindex auctex, precompiled for Windows +@cindex latex +@cindex preview-latex + +AUCTeX is an Emacs package for writing LaTeX files, which also +includes preview-latex, an Emacs mode for previewing the formatted +contents of LaTeX documents. Pre-compiled versions for Windows are +available from +@uref{http://www.gnu.org/software/auctex/download-for-windows.html, the +AUCTeX site}. + +@node Spell check +@section How do I perform spell checks? +@cindex spell checking +@cindex ispell +@cindex aspell +@cindex flyspell +@vindex ispell-program-name +@findex flyspell-mode + +Emacs has support for spell checking on demand (@code{ispell}) and as +your type (@code{flyspell}). Both packages depend on a copy of +@command{ispell} 3.2 or a compatible spell-checking program. +GNU Aspell is a popular choice these days, Windows installers are +available from the @uref{http://aspell.net/win32/, official site}. + +Once installed, you will need to configure @code{ispell-program-name} +to tell ispell and flyspell to use @command{aspell} as a replacement for +ispell. You can include the full path to the @file{aspell} binary, which +means you do not need to add its installation directory to the @env{PATH}. + +@node Encryption +@section Emacs and encryption +@cindex encryption +@cindex gpg, Windows binaries +@cindex pgp encryption, with GNU Privacy Guard +@cindex signatures on Emacs distribution, checking +@cindex Emacs distribution, checking digital signatures + +GNU Privacy Guard is a Free replacement for PGP, with Windows binaries +available. See @uref{http://www.gnupg.org/}. + +@node Mouse wheel +@section Why doesn't my wheel mouse work in Emacs? +@cindex mouse wheel +@cindex wheel mouse +@cindex middle button, on wheel mouse +@cindex scrolling, with mouse wheel + +Some wheel mice ship with default settings that do not send the +standard wheel events to programs, but instead try to simulate scroll +bar events. Usually this is configurable from the hardware specific +pages on the mouse control panel. The middle button is often mapped +in the same settings to have some functionality other than sending +middle mouse button events. In some cases, uninstalling the +manufacturer's drivers and telling Windows to use the generic USB or +PS/2 drivers is the only way to make the mouse work properly. + +@node Grep +@section How do I use grep with Emacs? +@cindex searching through files with grep +@cindex grep +@cindex findstr +@findex grep + +The best way to use @kbd{M-x grep} with Emacs is to download a port of +GNU @command{grep}. @xref{Other useful ports}. + +If you want a quick solution without installing extra tools, a poor +substitute that works for simple text searches is to specify the built +in Windows command @command{findstr} as the command to run at the +@kbd{M-x grep} prompt. Normally you will want to use the @option{/n} +argument to @command{findstr}. + +@menu +* Recursive grep:: +@end menu + +@node Recursive grep +@subsection How do I do a recursive grep? +@cindex recursive searching with grep +@cindex grep, recursive through subdirectories +@cindex findstr, recursive +@cindex find, using with grep +@cindex find, the POSIX command +@findex rgrep +@findex grep-find +@findex find-grep-dired +@vindex find-program +@vindex grep-find-command + +The Emacs commands @code{rgrep}, @code{grep-find} +and @code{find-grep-dired} are all different interfaces for +grepping recursively into subdirectories. By default, they use the +command @command{find} to determine which files to work on, and either +run @command{grep} directly from find, or use @command{xargs} to batch +up files and reduce the number of invocations of @command{grep}. + +Windows also comes with a @command{find} command, but it is not in any +way compatible with the POSIX @command{find} that Emacs tries to use. +Emacs expects a @command{find} compatible with GNU findutils. +@xref{Other useful ports}. After you have installed it, you will need +to make sure that Emacs finds this version, not the standard Windows +@command{find} command. You can do this by either renaming the +Windows command, changing your @env{PATH} to ensure that the directory +containing the findutils @file{bin} directory comes before the Windows +system directory, or set the variable @code{find-program} to the full +path to the findutils @command{find} command. + +An alternative if you have a recent version of grep is to customize +@code{grep-find-command} to use @samp{grep -r} instead of both find +and grep. Another alternative if you don't need the full capabilities +of grep is to use @samp{findstr /n /r}. + +@c ------------------------------------------------------------ +@node Developing with Emacs +@chapter Developing with Emacs + +@menu +* MSVC:: +* Borland C++ Builder:: +* Version control:: +* Perldb:: +@end menu + +@node MSVC +@section How do I use Emacs with Microsoft Visual C++ + +There are two ways you can use Emacs in conjunction with MSVC. You +can use Emacs as the editor, and do everything else in the DevStudio +IDE. Or you can use Emacs as an IDE, calling the MSVC command line +tools to build your project. + +@menu +* DevStudio:: +* MSVC command line:: +@end menu + +@node DevStudio +@subsection Emacs as the text editor for DevStudio +@cindex DevStudio, using Emacs as editor in +@cindex MSVC++, using Emacs as editor with +@cindex Visual Studio, using Emacs as editor in +@cindex VisEmacs, add in for MS Developer Studio + +Christopher Payne wrote a Visual Studio add-in that makes Emacs the +default text editor, this has now been taken over by Jeff Paquette. +See the following two URLS for details: +@itemize +@item @uref{http://sourceforge.net/projects/visemacs/} for the latest version. +@item @uref{http://www.smathers.net/VisEmacs.htm} for notes on usage. +@end itemize + +@node MSVC command line +@subsection Using MSVC command line tools from Emacs +@cindex MSVC++, compiling within Emacs +@findex compile + +This is an app note on how to use Microsoft Visual C++ with Emacs. The +experiments done below were done with Emacs 19.34.1 on Windows 95, +using Visual C++ 4.0 Standard Edition. Your mileage may vary. + +This writeup assumes minimal knowledge of Emacs hacking on the part of +the reader. + +@menu +* VC++ environment:: +* Default compile command:: +* Reverting buffers:: +* Edit MSVC:: +@end menu + +@node VC++ environment +@subsubsection VC++ Environment Variables +@cindex vcvars32.bat +@cindex MSVC++, environment variables + +There is a batch file in your VC++ installation's bin directory called +@file{vcvars32.bat}, which sets up the environment variables needed to +run the VC++ command line tools. Arrange for those same environment +variables to be set in your Emacs session. You can do this on Windows +9x by calling the @file{vcvars32.bat} script from @file{autoexec.bat}. +On other versions of Windows you can set the environment variables +globally using the System control panel. + +For all versions of Windows you can alternatively set the variables +just inside Emacs by using @code{setenv} calls in your init file. +@xref{Installing Emacs,,Where do I put my init file?}. + +You should now be able to compile from Emacs. Load a source file from +a VC++ project. Type @kbd{M-x compile}. Replace the proposed command line +with: +@example +nmake -f @var{ProjectName}.mak +@end example + +You will find that this defaults to a debug build. You can change it +to a release build with: +@example +nmake -f @var{ProjectName}.mak CFG="@var{ProjectName} - Win32 Release" +@end example + +@node Default compile command +@subsubsection Setting the default compile command +@cindex compile, setting default command +@cindex nmake, as default compile command +@vindex compile-command + +Now set the default value for the compile command line. Add the +following to your init file: + +@example +;; Set up for Visual C++ compiling +(setq compile-command "nmake -f ") +@end example + +If you work on the same project long term, you can add the project +makefile to the string. + +David Biesack suggests that perhaps it's +easy to write a @file{Makefile} in the project directory which does + +@example +PROJECT=MyProject +all: debug +debug: FORCE + nmake /f $(PROJECT).mak CFG="$(PROJECT) - Win32 Debug" +release: FORCE + nmake /f $(PROJECT).mak CFG="$(PROJECT) - Win32 Release" +FORCE: +@end example + +and then you can simply change compile-command to @command{nmake}. + +Caleb T. Deupree reports that on VC++ +5.0 and up, "You can also set an option in Options/Build to export a +makefile every time the project is saved, which you can then use to +compile with @samp{nmake -f project.mak}." VC++ 4.0 builds the make file +every time, and there is no option. + +@node Reverting buffers +@subsubsection Reverting Buffers +@cindex DevStudio, keeping source in sync +@cindex Visual Studio, keeping source in sync +@cindex MSVC++, keeping source in sync +@findex auto-revert-mode +@findex global-auto-revert-mode + +It is recommended that you use @code{auto-revert-mode} in buffers +that you have open in both Emacs and MSVC++ at the same time. Then if +you mistakenly edit the file in MSVC++, Emacs will pick up your +changes immediately, rather than after you have written lots more code +and attempt to save. + +@node Edit MSVC +@subsubsection Edit with Emacs function for MSVC +@cindex DevStudio, load in Emacs command +@cindex Visual Studio, load in Emacs command +@cindex MSVC++, load in Emacs command +@cindex emacsclient, calling from Visual Studio + +You can also set up VC++ to import a file into Emacs for you, all +ready for editing. In VC++, go to the @code{Tools} pull-down menu, and +click on @code{Customize...}. In the @code{Tools} tab, click on +@code{Add}. Use @code{Browse} to locate the +@file{emacsclientw.exe} file in your Emacs bin directory, and +select it. For arguments, use @option{+$(CurLine)} +@option{"$(FilePath)"} and for the directory use the @code{$(WkspDir)} +(the quotes around FilePath handle paths with spaces in them). Set the +Menu Text to say "Em&acs". The @option{+$(CurLine)} will set point in +Emacs to the same line as the cursor position in VC++. The ampersand +in the word @code{Em&acs} allows you to select emacs from the keyboard. (E +is already used for the OLE control test container.) + +You should now be able to go to any source file in your project. Then, +use the pull-down menu @code{Tools->Emacs}. The active file in your +VC++ IDE should now be front and center in Emacs, all ready to edit as +you wish. If you use keystrokes to work the menus, try @kbd{Alt-T A} to +move the file into Emacs. Binding this tool to a keystroke will be +left as an exercise for the student. + +If you have the option of saving files before running tools, make sure +this option is set. (I don't see it on VC++ 4.0.) + +@node Borland C++ Builder +@section Emacs and Borland C++ Builder +@cindex Borland C++, integration with Emacs + +Jonathan Arnold has written an +@uref{http://www.buddydog.org/C++Builder/c++builder.html, EmacsEdit +``expert''} for interfacing C++ Builder and Emacs. + +@node Version control +@section Is there a version of my VC software I can use with Emacs? +@cindex version control, integration with Emacs +@cindex revision control, integration with Emacs +@cindex source control, integration with Emacs +@cindex cvs, version control integration with Emacs +@cindex rcs, version control integration with Emacs +@cindex svn, version control integration with Emacs +@cindex git, version control integration with Emacs +@cindex bzr, version control integration with Emacs +@cindex arch, version control integration with Emacs +@cindex mercurial, version control integration with Emacs +@cindex hg, version control integration with Emacs +@cindex monotone, version control integration with Emacs +@cindex mcvs, version control integration with Emacs + +If you are using a graphical revision control tool already, check if +it comes with command-line tools. Many such GUI tools are just +wrappers for the same command line tools that Emacs requires for its +VC integration. Most of the supported VC systems have well supported +Free native Windows binaries. For those that don't Cygwin may be an option. +@xref{Other useful ports}. + +@node Perldb +@section How do I use the Perl debugger with Emacs? +@cindex perl, debugging within Emacs +@cindex perldb, using with Emacs + +From Jay Rogers: + +Some versions of the perl debugger itself need to be patched to work +with emacs. They are perl versions 5.001 and less, and version +5.004_01. To fix, locate and change the code similar to the following +code in lib/perl5db.pl +@example + if (-e "/dev/tty") @{ + $console = "/dev/tty"; + $rcfile=".perldb"; + @} + elsif (-e "con") @{ + $console = ""; <---- change "con" to "" + $rcfile="perldb.ini"; + @} + else @{ + $console = "sys\$command"; + $rcfile="perldb.ini"; + @} +@end example + +Doug Campbell also has some +@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/perldb, +suggestions} for improving the interaction of perldb and Emacs. + +@c ------------------------------------------------------------ +@node Other useful ports +@chapter Other useful ports +@cindex useful tools +@cindex subprocesses, useful tools + +@menu +* Cygwin:: +* MinGW:: +* UWIN:: +* GnuWin32:: +* GTK:: +* Read man pages:: +@end menu + +@node Cygwin +@section Cygwin +@cindex cygwin environment +@cindex cygwin, library conflicts +@cindex library conflicts with cygwin +@cindex interoperability with cygwin +@cindex subprocesses, cygwin tools +@vindex exec-path + +@uref{http://www.cygwin.com/}. + +Cygwin is a popular complete POSIX emulation environment for Windows. +Most of its tools can be used with Emacs, and it covers a wide range +of ported software. The main shell used by Cygwin is GNU +@command{bash}, but other shells are also available. Some Cygwin +tools may not interoperate well with Emacs or other native Windows +tools, due to the total immersion aspect of Cygwin, including its +non-native filesystem mapping. + +If you choose to use Cygwin, then its tools will probably be all that +you need, but you will need to get image libraries from elsewhere, as +the Cygwin ones are not compatible with non-Cygwin software. In fact, +if Cygwin is on your PATH when you run Emacs, and Emacs does not find +other versions of the image libraries first, then the Cygwin ones can +cause problems. Cygwin developers recommend that you do not put +Cygwin on your system @env{PATH} for this reason. Instead you can +make the Cygwin tools available within Emacs by setting @code{exec-path} +in your init file. + +@node MinGW +@section MinGW and MSYS +@cindex mingw tools +@cindex msys environment +@cindex subprocesses, mingw and msys + +@uref{http://www.mingw.org/} + +MinGW is a set of development tools that produce native Windows +executables, not dependent on Cygwin's POSIX emulation DLLs. + +MSYS is a POSIX shell and minimal set of tools that are commonly used in +configure scripts. Like Cygwin, this environment uses a non-native +filesystem mapping to appear more POSIX like to the scripts that it +runs. This is intended to complement the MinGW tools to make it easier +to port software to Windows. + +@node UWIN +@section UWIN +@cindex uwin environment +@cindex subprocesses, uwin + +@uref{http://www.research.att.com/sw/tools/uwin/} + +UWIN is another POSIX emulation environment, like Cygwin and MSYS, +that provides a large number of ported tools. The shell used by UWIN +is @command{ksh}, the Korn shell. + +@node GnuWin32 +@section GnuWin32 +@cindex gnuwin32 tools +@cindex subprocesses, gnuwin32 +@cindex image libraries, gnuwin32 +@cindex image libraries, development + +@uref{http://gnuwin32.sourceforge.net/} + +GnuWin32 provides precompiled native Windows ports of a wide selection +of Free software and libraries. Tools available here that are useful +for Emacs include: + +@itemize +@item Arc - used by @code{archive-mode} to edit .arc files. +@item Bzip2 - used by Emacs to automatically decompress .bz2 files. +@item CompFace - used by @code{gnus} to display XFace headers in messages. +@item CoreUtils - GNU file, shell and text utilities (also in MSYS) +@item DiffUtils - for @code{ediff} and producing patches +@item FindUtils - for @code{grep-find} and other file searches. +@item GifLib - library to support GIF images. +@item Grep - for searching through files with @code{grep}. +@item Gzip - used by Emacs to automatically decompress .gz files. +@item Jpeg - library to support JPEG images (also in GTK). +@item Lha - used by @code{archive-mode} to edit .lzh files. +@item LibPng - library to support PNG images (also in GTK). +@item LibTiff - library to support TIFF images (also in GTK). +@item Make - used by @code{compile} for building projects (also in MinGW) +@item OpenSSL - used by @code{gnus} to talk to servers over SSL. +@item Patch - used by @code{ediff-patch-file} and others to apply patches. +@item Tar - used by @code{tar-mode} to edit tar files. +@item TexInfo - used to build Emacs' manuals. +@item Unzip - used by @code{archive-mode} for extracting zip files. +@item Xpm - library to support XPM images (bundled with Emacs binaries) +@item Zip - used by @code{archive-mode} for editing zip files. +@item Zlib - required by LibPng (also in GTK). +@end itemize + +@node GTK +@section GTK +@cindex GTK image libraries +@cindex image libraries, GTK +@cindex addpm, using GTK image libraries + +GTK is a potential source for some of the image libraries that Emacs +requires. GTK is installed along with other ports of GUI software, +such as the GIMP image editor, and Pidgin instant messenger client. +If GTK is installed when you run @command{addpm}, Emacs will use the +image libraries that it provides, even if they are not on the +@env{PATH}. GTK ships with JPEG, PNG and TIFF support. + +@node Read man pages +@section How do I read man pages? +@cindex man pages +@findex woman +@findex man + +Man pages for Emacs and other ported programs that you have can be +read using Emacs' built-in manual reader @code{woman}. This +requires no external programs, but if you do have a port of +@command{man}, there is also an Emacs wrapper @code{man} that +which may be slightly faster. + +@c ------------------------------------------------------------ +@node Further information +@chapter Further information + +@menu +* More information:: +* Mailing lists:: +@end menu + +@node More information +@section Where can I get more information about Emacs? +@cindex other sources of information +@cindex faqs, general +@cindex faqs, old +@cindex help, manuals and other sources +@cindex manuals +@cindex wiki + +If you have general questions about Emacs, the best places to start +looking are @ref{Top,,, emacs, The GNU Emacs Manual}, and +@ref{Top,,, efaq, the standard Emacs FAQ}. +In Emacs, you can browse the manual using Info by typing @kbd{C-h r}, +and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include: + +@itemize +@item @uref{http://www.gnu.org/software/emacs/, The Emacs homepage} +@item @uref{http://www.gnu.org/software/emacs/manual/, Other Emacs manuals} +@item @uref{http://www.emacswiki.org/, Emacs Wiki} +@end itemize + +@node Mailing lists +@section What mailing lists are there for discussing Emacs on Windows? +@cindex mailing lists +@cindex help, mailing lists + +The official mailing list for Windows specific help and discussion is +@url{http://lists.gnu.org/mailman/listinfo/help-emacs-windows, +help-emacs-windows}. See that link for information on how to subscribe +or unsubscribe. The +@uref{http://lists.gnu.org/archive/html/help-emacs-windows/, list archives} +are available online. + +@c ------------------------------------------------------------ +@node Indexes +@unnumbered Indexes + +@unnumberedsec Function and Variable Index + +@printindex fn + +@unnumberedsec Concept Index + +@printindex cp + +@bye diff --git a/doc/misc/faq.texi b/doc/misc/efaq.texi similarity index 97% rename from doc/misc/faq.texi rename to doc/misc/efaq.texi index 39b4a9037bd..a13d3df43f1 100644 --- a/doc/misc/faq.texi +++ b/doc/misc/efaq.texi @@ -2,6 +2,7 @@ @c %**start of header @setfilename ../../info/efaq @settitle GNU Emacs FAQ +@documentencoding UTF-8 @c %**end of header @include emacsver.texi @@ -11,7 +12,7 @@ @c appreciate a notice if you do). @copying -Copyright @copyright{} 2001--2013 Free Software Foundation, Inc.@* +Copyright @copyright{} 2001--2014 Free Software Foundation, Inc.@* Copyright @copyright{} 1994, 1995, 1996, 1997, 1998, 1999, 2000 Reuven M. Lerner@* Copyright @copyright{} 1992, 1993 Steven Byrnes@* @@ -58,8 +59,7 @@ distribution.] @node Top, FAQ notation, (dir), (dir) @top The GNU Emacs FAQ -@c FIXME @today is just the day we ran `makeinfo'. -This is the GNU Emacs FAQ, last updated on @today{}. +This is the GNU Emacs FAQ. This FAQ is maintained as a part of GNU Emacs. If you find any errors, or have any suggestions, please use @kbd{M-x report-emacs-bug} to report @@ -392,12 +392,9 @@ recipients the same freedom that you enjoyed. @cindex Posting messages to newsgroups @cindex GNU mailing lists -The file @file{etc/MAILINGLISTS} describes the purpose of each GNU -mailing list (@pxref{Informational files for Emacs}). For those lists -which are gatewayed with newsgroups, it lists both the newsgroup name -and the mailing list address. The Emacs mailing lists are also -described at @uref{http://savannah.gnu.org/mail/?group=emacs, the Emacs -Savannah page}. +The Emacs mailing lists are described at +@uref{http://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah +page}. Some of them are gatewayed to newsgroups. The newsgroup @uref{news:comp.emacs} is for discussion of Emacs programs in general. The newsgroup @uref{news:gnu.emacs.help} is specifically @@ -445,9 +442,9 @@ mail-to-news gateway). The correct way to report Emacs bugs is to use the command @kbd{M-x report-emacs-bug}. It sets up a mail buffer with the -essential information and the correct e-mail address, which is -@email{bug-gnu-emacs@@gnu.org} for the released versions of Emacs. -Anything sent to @email{bug-gnu-emacs@@gnu.org} also appears in the +essential information and the correct e-mail address, +@email{bug-gnu-emacs@@gnu.org}. +Anything sent there also appears in the newsgroup @uref{news:gnu.emacs.bug}, but please use e-mail instead of news to submit the bug report. This ensures a reliable return address so you can be contacted for further details. @@ -460,13 +457,17 @@ report (@pxref{Bugs, , Reporting Bugs, emacs, The GNU Emacs Manual}). RMS says: @quotation -Sending bug reports to @email{help-gnu-emacs@@gnu.org} (which has the -effect of posting on @uref{news:gnu.emacs.help}) is undesirable because -it takes the time of an unnecessarily large group of people, most of -whom are just users and have no idea how to fix these problem. -@email{bug-gnu-emacs@@gnu.org} reaches a much smaller group of people -who are more likely to know what to do and have expressed a wish to -receive more messages about Emacs than the others. +Sending bug reports to +@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +the help-gnu-emacs mailing list} +(which has the effect of posting on @uref{news:gnu.emacs.help}) is +undesirable because it takes the time of an unnecessarily large group +of people, most of whom are just users and have no idea how to fix +these problem. +@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The +bug-gnu-emacs list} reaches a much smaller group of people who are +more likely to know what to do and have expressed a wish to receive +more messages about Emacs than the others. @end quotation RMS says it is sometimes fine to post to @uref{news:gnu.emacs.help}: @@ -558,6 +559,9 @@ common) invokes help. Emacs help works best if it is invoked by a single key whose value should be stored in the variable @code{help-char}. +Some Emacs slides and tutorials can be found at +@uref{http://web.psung.name/emacs/}. + @node Learning how to do something @section How do I find out how to do something in Emacs? @cindex Help for Emacs @@ -858,9 +862,7 @@ You can get Tkinfo at @cindex @file{COPYING}, description of file @cindex @file{DISTRIB}, description of file @cindex @file{GNU}, description of file -@cindex @file{INTERVIEW}, description of file @cindex @file{MACHINES}, description of file -@cindex @file{MAILINGLISTS}, description of file @cindex @file{NEWS}, description of file This isn't a frequently asked question, but it should be! A variety of @@ -884,16 +886,9 @@ Emacs Availability Information @item GNU The GNU Manifesto -@item INTERVIEW -Richard Stallman discusses his public-domain UNIX-compatible software -system with BYTE editors - @item MACHINES Status of Emacs on Various Machines and Systems -@item MAILINGLISTS -GNU Project Electronic Mailing Lists - @item NEWS Emacs news, a history of recent user-visible changes @@ -961,7 +956,8 @@ by RMS for the editor TECO (Text Editor and COrrector, originally Tape Editor and COrrector) under ITS (the Incompatible Timesharing System) on a PDP-10. RMS had already extended TECO with a ``real-time'' full-screen mode with reprogrammable keys. Emacs was started by -@email{gls@@east.sun.com, Guy Steele} as a project to unify the many +@c gls@@east.sun.com +Guy Steele as a project to unify the many divergent TECO command sets and key bindings at MIT, and completed by RMS. @@ -1341,7 +1337,9 @@ of files from Macintosh, Microsoft, and Unix platforms. In general, new Emacs users should not be provided with @file{.emacs} files, because this can cause confusing non-standard behavior. Then -they send questions to @email{help-gnu-emacs@@gnu.org} asking why Emacs +they send questions to +@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +the help-gnu-emacs mailing list} asking why Emacs isn't behaving as documented. Emacs includes the Customize facility (@pxref{Using Customize}). This @@ -1580,10 +1578,9 @@ According to the documentation string for @code{delete-selection-mode} delete-selection-mode @key{RET}}): @quotation -When Delete Selection mode is enabled, Transient Mark mode is also -enabled and typed text replaces the selection if the selection is -active. Otherwise, typed text is just inserted at point regardless of -any selection. +When Delete Selection mode is enabled, typed text replaces the selection +if the selection is active. Otherwise, typed text is just inserted at +point regardless of any selection. @end quotation This mode also allows you to delete (not kill) the highlighted region by @@ -1806,7 +1803,8 @@ requested by @code{emacsclient}, Emacs will switch to it; otherwise @cindex @code{gnuserv} There is an alternative version of @samp{emacsclient} called -@samp{gnuserv}, written by @email{ange@@hplb.hpl.hp.com, Andy Norman} +@c ange@@hplb.hpl.hp.com +@samp{gnuserv}, written by Andy Norman (@pxref{Packages that do not come with Emacs}). @samp{gnuserv} uses Internet domain sockets, so it can work across most network connections. @@ -1974,7 +1972,8 @@ On some systems, @key{Insert} toggles @code{overwrite-mode} on and off. @cindex Visible bell @cindex Bell, visible -@email{martin@@cc.gatech.edu, Martin R. Frank} writes: +@c martin@@cc.gatech.edu +Martin R. Frank writes: Tell Emacs to use the @dfn{visible bell} instead of the audible bell, and set the visible bell to nothing. @@ -2738,7 +2737,7 @@ type @kbd{C-h C-p} to read it. Old versions (i.e., anything before 19.29) of Emacs had problems editing files larger than 8 megabytes. In versions 19.29 and later, the maximum -buffer size is at least 2^27@minus{}1, or 134,217,727 bytes, or 132 MBytes. +buffer size is at least @math{2^{27}-1}, or 134,217,727 bytes, or 132 MBytes. The maximum buffer size on 32-bit machines increased to 256 MBytes in Emacs 22, and again to 512 MBytes in Emacs 23.2. @@ -2853,8 +2852,7 @@ To make a terminfo entry for @samp{emacs}, use @code{tic} or @file{/usr/lib/terminfo/d/dumb} to @file{/usr/lib/terminfo/e/emacs}. Having a termcap/terminfo entry will not enable the use of full screen -programs in shell buffers. Use @kbd{M-x terminal-emulator} for that -instead. +programs in shell buffers. Use @kbd{M-x term} for that instead. A workaround to the problem of missing termcap/terminfo entries is to change terminal type @samp{emacs} to type @samp{dumb} or @samp{unknown} @@ -3287,6 +3285,7 @@ the constituent Emacs packages. For advice on how to find extra packages that are not part of Emacs, see @ref{Packages that do not come with Emacs}. +@c Note that M-x view-external-packages references this node. @node Packages that do not come with Emacs @section Where can I get Emacs Lisp packages that don't come with Emacs? @cindex Unbundled packages @@ -3296,31 +3295,41 @@ see @ref{Packages that do not come with Emacs}. @cindex Emacs Lisp List @cindex Emacs Lisp Archive -Your first port of call should be the @kbd{M-x list-packages} command. -This connects to the @uref{http:///elpa.gnu.org, GNU ELPA} (``Emacs -Lisp Package Archive'') server and fetches the list of additional -packages that it offers. These are GNU packages that are available -for use with Emacs, but are distributed separately. Select a package -to get more details about the features that it offers, and then if you -wish, Emacs can download and automatically install it for you. +The easiest way to add more features to your Emacs is to use the +command @kbd{M-x list-packages}. This contacts the +@uref{http:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'') +server and fetches the list of additional packages that it offers. +These are GNU packages that are available for use with Emacs, but are +distributed separately from Emacs itself, for reasons of space, etc. +You can browse the resulting @file{*Packages*} buffer to see what is +available, and then Emacs can automatically download and install the +packages that you select. @xref{Packages,,, emacs, The GNU Emacs Manual}. -@uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs Lisp -List (ELL)}, maintained by @email{S.J.Eglen@@damtp.cam.ac.uk, Stephen Eglen}, -aims to provide one compact list with links to all of the current Emacs -Lisp files on the Internet. The ELL can be browsed over the web, or -from Emacs with @uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.el, -the @file{ell} package}. +There are other, non-GNU, Emacs Lisp package servers, including: +@uref{http://melpa.milkbox.net, MELPA}; and +@uref{http://marmalade-repo.org, Marmalade}. To use additional +package servers, customize the @code{package-archives} variable. +Be aware that installing a package can run arbitrary code, so only add +sources that you trust. -Many authors post their packages to the @uref{news:gnu.emacs.sources, -Emacs sources newsgroup}. You can search the archives of this -group with @uref{http://groups.google.com/group/gnu.emacs.sources, Google}, -or @uref{http://dir.gmane.org/gmane.emacs.sources, Gmane}, for example. +The @uref{https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources, +GNU Emacs sources mailing list}, which is gatewayed to the +@uref{news:gnu.emacs.sources, Emacs sources newsgroup} (although the +connection between the two can be unreliable) is an official place +where people can post or announce their extensions to Emacs. -Several packages are stored in -@uref{http://emacswiki.org/elisp/, the Lisp area of the Emacs Wiki}. +The @uref{http://emacswiki.org, Emacs Wiki} contains pointers to some +additional extensions. @uref{http://wikemacs.org, WikEmacs} is an +alternative wiki for Emacs. -Read the file @file{etc/MORE.STUFF} for more information about -external packages. +@uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs +Lisp List (ELL)}, has pointers to many Emacs Lisp files, but at time +of writing it is no longer being updated. + +It is impossible for us to list here all the sites that offer Emacs +Lisp packages. If you are interested in a specific feature, then +after checking Emacs itself and GNU ELPA, a web search is often the +best way to find results. @node Spell-checkers @section Spell-checkers @@ -3444,8 +3453,9 @@ lack certain features, such as the Emacs Lisp extension language. @cindex Emacs for MS-Windows @cindex Microsoft Windows, Emacs for -There is a @uref{http://www.gnu.org/software/emacs/windows/ntemacs.html, -separate FAQ} for Emacs on MS-Windows. For MS-DOS, @pxref{Emacs for MS-DOS}. +There is a separate FAQ for Emacs on MS-Windows, +@pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}. +For MS-DOS, @pxref{Emacs for MS-DOS}. @node Emacs for GNUstep @@ -4314,7 +4324,8 @@ these systems, you should configure @code{movemail} to use @code{flock}. @cindex Sender, replying only to @cindex Rmail, replying to the sender of a message in -@email{isaacson@@seas.upenn.edu, Ron Isaacson} says: When you hit +@c isaacson@@seas.upenn.edu +Ron Isaacson says: When you hit @key{r} to reply in Rmail, by default it CCs all of the original recipients (everyone on the original @samp{To} and @samp{CC} lists). With a prefix argument (i.e., typing @kbd{C-u} before @key{r}), diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index b16144e98a2..a06b45f665f 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -3,6 +3,7 @@ @set TITLE Enhanced Implementation of Emacs Interpreted Objects @set AUTHOR Eric M. Ludlam @settitle @value{TITLE} +@documentencoding UTF-8 @c ************************************************************************* @c @ Header @@ -11,7 +12,7 @@ @copying This manual documents EIEIO, an object framework for Emacs Lisp. -Copyright @copyright{} 2007--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -35,21 +36,22 @@ modify this GNU manual.'' @center @titlefont{@value{TITLE}} @sp 4 @center by @value{AUTHOR} -@end titlepage @page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage @macro eieio{} @i{EIEIO} @end macro -@node Top, Quick Start, (dir), (dir) -@comment node-name, next, previous, up +@node Top @top EIEIO -@eieio{} (``Enhanced Implementation of Emacs Interpreted Objects'') is -a CLOS (Common Lisp Object System) compatibility layer for Emacs Lisp. -It provides a framework for writing object-oriented applications in -Emacs. +@eieio{} (``Enhanced Implementation of Emacs Interpreted Objects'') +provides an Object Oriented layer for Emacs Lisp, following the basic +concepts of the Common Lisp Object System (CLOS). It provides a +framework for writing object-oriented applications in Emacs. @ifnottex @insertcopying @@ -70,7 +72,6 @@ Emacs. * Base Classes:: Additional classes you can inherit from. * Browsing:: Browsing your class lists. * Class Values:: Displaying information about a class or object. -* Documentation:: Automatically creating texinfo documentation. * Default Superclass:: The root superclasses. * Signals:: When you make errors. * Naming Conventions:: Name your objects in an Emacs friendly way. @@ -173,12 +174,19 @@ some other data type, Emacs signals a @code{no-method-definition} error. @ref{Signals}. @node Introduction -@comment node-name, next, previous, up @chapter Introduction -Due to restrictions in the Emacs Lisp language, CLOS cannot be -completely supported, and a few functions have been added in place of -setf. +First off, please note that this manual cannot serve as a complete +introduction to object oriented programming and generic functions in +LISP. Although EIEIO is not a complete implementation of the Common +Lisp Object System (CLOS) and also differs from it in several aspects, +it follows the same basic concepts. Therefore, it is highly +recommended to learn those from a textbook or tutorial first, +especially if you only know OOP from languages like C++ or Java. If +on the other hand you are already familiar with CLOS, you should be +aware that @eieio{} does not implement the full CLOS specification and +also differs in some other aspects which are mentioned below (also +@pxref{CLOS compatibility}). @eieio{} supports the following features: @@ -201,8 +209,6 @@ Byte compilation support of methods. @item Help system extensions for classes and methods. @item -Automatic texinfo documentation generator. -@item Several base classes for interesting tasks. @item Simple test suite. @@ -212,20 +218,33 @@ Public and private classifications for slots (extensions to CLOS) Customization support in a class (extension to CLOS) @end enumerate -Here are some CLOS features that @eieio{} presently lacks: +Due to restrictions in the Emacs Lisp language, CLOS cannot be +completely supported, and a few functions have been added in place of +setf. Here are some important CLOS features that @eieio{} presently +lacks: @table @asis -@item Complete @code{defclass} tag support -All CLOS tags are currently supported, but the following are not -currently implemented correctly: -@table @code -@item :metaclass -There is only one base superclass for all @eieio{} classes, which is -the @code{eieio-default-superclass}. -@item :default-initargs +@item Method dispatch +EIEO does not support method dispatch for built-in types and multiple +arguments types. In other words, method dispatch only looks at the +first argument, and this one must be an @eieio{} type. + +@item Support for metaclasses +There is just one default metaclass, @code{eieio-default-superclass}, +and you cannot define your own. The @code{:metaclass} tag in +@code{defclass} is ignored. Also, functions like `find-class', which +should return instances of the metaclass, behave differently in +@eieio{} in that they return symbols or plain structures instead. + +@item EQL specialization +EIEIO does not support it. + +@item @code{:around} method tag +This CLOS method tag is non-functional. + +@item :default-initargs in @code{defclass} Each slot has an @code{:initarg} tag, so this is not really necessary. -@end table @item Mock object initializers Each class contains a mock object used for fast initialization of @@ -233,13 +252,9 @@ instantiated objects. Using functions with side effects on object slot values can potentially cause modifications in the mock object. @eieio{} should use a deep copy but currently does not. -@item @code{:around} method tag -This CLOS method tag is non-functional. - @end table @node Building Classes -@comment node-name, next, previous, up @chapter Building Classes A @dfn{class} is a definition for organizing data and methods @@ -615,7 +630,6 @@ function of @code{:initform}. @eieio{}-specific tags. @node Making New Objects -@comment node-name, next, previous, up @chapter Making New Objects Suppose we have a simple class is defined, such as: @@ -685,7 +699,6 @@ a string. @end defun @node Accessing Slots -@comment node-name, next, previous, up @chapter Accessing Slots There are several ways to access slot values in an object. The naming @@ -802,7 +815,6 @@ variable name of the same name as the slot. @end defun @node Writing Methods -@comment node-name, next, previous, up @chapter Writing Methods Writing a method in @eieio{} is similar to writing a function. The @@ -1019,7 +1031,6 @@ Retrieved from: http://192.220.96.201/dylan/linearization-oopsla96.html @end table @node Predicates -@comment node-name, next, previous, up @chapter Predicates and Utilities Now that we know how to create classes, access slots, and define @@ -1052,7 +1063,7 @@ make a slot unbound. @var{object} can be an instance or a class. @end defun -@defun class-name class +@defun eieio-class-name class Return a string of the form @samp{#} which should look similar to other Lisp objects like buffers and processes. Printing a class results only in a symbol. @@ -1076,7 +1087,7 @@ constructor is a function used to create new instances of without knowing what it is. This is not a part of CLOS. @end defun -@defun object-name obj +@defun eieio-object-name obj Return a string of the form @samp{#} for @var{obj}. This should look like Lisp symbols from other parts of Emacs such as buffers and processes, and is shorter and cleaner than printing the @@ -1085,43 +1096,39 @@ and object's print form, as this allows the object to add extra display information into the symbol. @end defun -@defun object-class obj +@defun eieio-object-class obj Returns the class symbol from @var{obj}. @end defun -@defun class-of obj -CLOS symbol which does the same thing as @code{object-class} -@end defun - -@defun object-class-fast obj -Same as @code{object-class} except this is a macro, and no +@defun eieio--object-class obj +Same as @code{eieio-object-class} except this is a macro, and no type-checking is performed. @end defun -@defun object-class-name obj +@defun eieio-object-class-name obj Returns the symbol of @var{obj}'s class. @end defun -@defun class-parents class +@defun eieio-class-parents class Returns the direct parents class of @var{class}. Returns @code{nil} if it is a superclass. @end defun -@defun class-parents-fast class -Just like @code{class-parent} except it is a macro and no type checking +@defun eieio-class-parents-fast class +Just like @code{eieio-class-parents} except it is a macro and no type checking is performed. @end defun -@defun class-parent class +@defun eieio-class-parent class Deprecated function which returns the first parent of @var{class}. @end defun -@defun class-children class +@defun eieio-class-children class Return the list of classes inheriting from @var{class}. @end defun -@defun class-children-fast class -Just like @code{class-children}, but with no checks. +@defun eieio-class-children-fast class +Just like @code{eieio-class-children}, but with no checks. @end defun @defun same-class-p obj class @@ -1180,7 +1187,6 @@ all its subclasses. @end defun @node Customizing -@comment node-name, next, previous, up @chapter Customizing Objects @eieio{} supports the Custom facility through two new widget types. @@ -1262,7 +1268,6 @@ nil. @end defun @node Base Classes -@comment node-name, next, previous, up @chapter Base Classes All defined classes, if created with no specified parent class, @@ -1284,7 +1289,6 @@ even inherit from more than one of these classes at once.) @end menu @node eieio-instance-inheritor -@comment node-name, next, previous, up @section @code{eieio-instance-inheritor} This class is defined in the package @file{eieio-base}. @@ -1349,7 +1353,6 @@ list of objects to be searched. @end deffn @node eieio-singleton -@comment node-name, next, previous, up @section @code{eieio-singleton} This class is defined in the package @file{eieio-base}. @@ -1361,7 +1364,6 @@ only ever be one instance of this class. Multiple calls to @end deftp @node eieio-persistent -@comment node-name, next, previous, up @section @code{eieio-persistent} This class is defined in the package @file{eieio-base}. @@ -1413,7 +1415,6 @@ being pedantic. @end defun @node eieio-named -@comment node-name, next, previous, up @section @code{eieio-named} This class is defined in the package @file{eieio-base}. @@ -1425,7 +1426,6 @@ access to it. @end deftp @node eieio-speedbar -@comment node-name, next, previous, up @section @code{eieio-speedbar} This class is in package @file{eieio-speedbar}. @@ -1520,7 +1520,6 @@ on how speedbar modes work @end deffn @node Browsing -@comment node-name, next, previous, up @chapter Browsing class trees The command @kbd{M-x eieio-browse} displays a buffer listing all the @@ -1543,63 +1542,15 @@ Note: new classes are consed into the inheritance lists, so the tree comes out upside-down. @node Class Values -@comment node-name, next, previous, up @chapter Class Values -Details about any class or object can be retrieved using the function -@code{eieio-describe-class}. Interactively, type in the name of -a class. In a program, pass it a string with the name of a class, a -class symbol, or an object. The resulting buffer will display all slot -names. - -Additionally, all methods defined to have functionality on this class is -displayed. - -@node Documentation -@comment node-name, next, previous, up -@chapter Documentation - -It is possible to automatically create documentation for your classes in -texinfo format by using the tools in the file @file{eieio-doc.el} - -@deffn Command eieiodoc-class class indexstring &optional skiplist - -This will start at the current point, and create an indented menu of -all the child classes of, and including @var{class}, but skipping any -classes that might be in @var{skiplist}. It will then create nodes for -all these classes, subsection headings, and indexes. - -Each class will be indexed using the texinfo labeled index -@var{indexstring} which is a two letter description. -@xref{New Indices,,,texinfo,Texinfo manual}. - -To use this command, the texinfo macro - -@example -@@defindex @@var @{ indexstring @} -@end example - -@noindent -where @var{indexstring} is replaced with the two letter code. - -Next, an inheritance tree will be created listing all parents of that -section's class. - -Then, all the slots will be expanded in tables, and described -using the documentation strings from the code. Default values will also -be displayed. Only those slots with @code{:initarg} specified will be -expanded, others will be hidden. If a slot is inherited from a parent, -that slot will also be skipped unless the default value is different. -If there is a change, then the documentation part of the slot will be -replace with an @@xref back to the parent. - -This command can only display documentation for classes whose -definitions have been loaded in this Emacs session. - -@end deffn +You can use the normal @code{describe-function} command to retrieve +information about a class. Running it on constructors will show a +full description of the generated class. If you call it on a generic +function, all implementations of that generic function will be listed, +together with links through which you can directly jump to the source. @node Default Superclass -@comment node-name, next, previous, up @chapter Default Superclass All defined classes, if created with no specified parent class, will @@ -1608,7 +1559,6 @@ inherit from a special class stored in with it, certain default methods or attributes can be added to all objects. In CLOS, this would be named @code{STANDARD-CLASS}, and that symbol is an alias to @code{eieio-default-superclass}. -@refill Currently, the default superclass is defined as follows: @@ -1675,9 +1625,9 @@ sure to call @dfn{call-next-method} first and modify the returned object. @defun object-print this &rest strings @anchor{object-print} -Pretty printer for object @var{this}. Call function @dfn{object-name} with @var{strings}. +Pretty printer for object @var{this}. Call function @dfn{eieio-object-name} with @var{strings}. The default method for printing object @var{this} is to use the -function @dfn{object-name}. +function @dfn{eieio-object-name}. It is sometimes useful to put a summary of the object into the default # string when using eieio browsing tools. @@ -1776,7 +1726,6 @@ return value of @dfn{call-next-method}. @end defun @node Signals -@comment node-name, next, previous, up @chapter Signals There are new condition names (signals) that can be caught when using @@ -1821,7 +1770,6 @@ This signal is called when an attempt to reference @var{slot} in @end deffn @node Naming Conventions -@comment node-name, next, previous, up @chapter Naming Conventions @xref{Tips,,Tips and Conventions,elisp,GNU Emacs Lisp Reference @@ -1850,7 +1798,6 @@ must ``require'' that library with the @code{require} command. @end itemize @node CLOS compatibility -@comment node-name, next, previous, up @chapter CLOS compatibility Currently, the following functions should behave almost as expected from @@ -1909,10 +1856,9 @@ loaded so the form @code{(setf (slot-value object slot) t)} should work. @end table -CLOS supports the @code{describe} command, but @eieio{} only provides -@code{eieio-describe-class}, and @code{eieio-describe-generic}. These -functions are adviced into @code{describe-variable}, and -@code{describe-function}. +CLOS supports the @code{describe} command, but @eieio{} provides +support for using the standard @code{describe-function} command on a +constructor or generic function. When creating a new class (@pxref{Building Classes}) there are several new keywords supported by @eieio{}. @@ -1930,8 +1876,9 @@ Some important compatibility features that would be good to add are: @enumerate @item +Support for metaclasses and EQL specialization. +@item @code{:around} method key. - @item Method dispatch for built-in types. @item diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 740dfee41ed..9d250e06888 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -4,11 +4,12 @@ @setfilename ../../info/emacs-gnutls @settitle Emacs GnuTLS Integration @value{VERSION} +@documentencoding UTF-8 @copying This file describes the Emacs GnuTLS integration. -Copyright @copyright{} 2012--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2012--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -25,7 +26,7 @@ modify this GNU manual.'' @dircategory Emacs network features @direntry -* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration. +* Emacs GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration. @end direntry @titlepage @@ -132,6 +133,24 @@ know if you do, so we can make the change to benefit the other users of that platform. @end defvar +@defvar gnutls-verify-error +The @code{gnutls-verify-error} variable allows you to verify SSL/TLS +server certificates for all connections or by host name. It defaults +to @code{nil} for now but will likely be changed to @code{t} later, +meaning that all certificates will be verified. + +There are two checks available currently, that the certificate has +been issued by a trusted authority as defined by +@code{gnutls-trustfiles}, and that the hostname matches the +certificate. @code{t} enables both checks, but you can enable them +individually as well with @code{:trustfiles} and @code{:hostname} +instead. + +Because of the low-level interactions with the GnuTLS library, there +is no way currently to ask if a certificate can be accepted. You have +to look in the @code{*Messages*} buffer. +@end defvar + @defvar gnutls-min-prime-bits The @code{gnutls-min-prime-bits} variable is a pretty exotic customization for cases where you want to refuse handshakes with keys diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index b1cf40aa645..7931ab298f0 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -11,7 +11,7 @@ @copying This file documents the Emacs MIME interface functionality. -Copyright @copyright{} 1998--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1998--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -26,8 +26,8 @@ modify this GNU manual.'' @end quotation @end copying -@c Node ``Interface Functions'' uses Latin-1 characters -@documentencoding ISO-8859-1 +@c Node ``Interface Functions'' uses non-ASCII characters +@documentencoding UTF-8 @dircategory Emacs lisp libraries @direntry @@ -871,15 +871,15 @@ by using the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}). @vindex mm-coding-system-priorities Prioritize coding systems to use for outgoing messages. The default is @code{nil}, which means to use the defaults in Emacs, but is -@code{(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)} when -running Emacs in the Japanese language environment. It is a list of -coding system symbols (aliases of coding systems are also allowed, use -@kbd{M-x describe-coding-system} to make sure you are specifying correct -coding system names). For example, if you have configured Emacs -to prefer UTF-8, but wish that outgoing messages should be sent in -ISO-8859-1 if possible, you can set this variable to -@code{(iso-8859-1)}. You can override this setting on a per-message -basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). +@code{(iso-8859-1 iso-2022-jp utf-8)} when running Emacs in the Japanese +language environment. It is a list of coding system symbols (aliases of +coding systems are also allowed, use @kbd{M-x describe-coding-system} to +make sure you are specifying correct coding system names). For example, +if you have configured Emacs to prefer UTF-8, but wish that outgoing +messages should be sent in ISO-8859-1 if possible, you can set this +variable to @code{(iso-8859-1)}. You can override this setting on a +per-message basis by using the @code{charset} @acronym{MML} tag +(@pxref{MML Definition}). As different hierarchies prefer different charsets, you may want to set @code{mm-coding-system-priorities} according to the hierarchy in Gnus. @@ -904,7 +904,7 @@ Here's an example: (mm-coding-system-priorities '(iso-8859-15 iso-8859-1 utf-8))) ("^fj\\." ;; Japanese (mm-coding-system-priorities - '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))) + '(iso-8859-1 iso-2022-jp utf-8))) ("^ru\\." ;; Cyrillic (mm-coding-system-priorities '(koi8-r iso-8859-5 iso-8859-1 utf-8)))) @@ -1221,7 +1221,7 @@ Return the value of the field under point. @item mail-encode-encoded-word-region @findex mail-encode-encoded-word-region Encode the non-@acronym{ASCII} words in the region. For instance, -@samp{Na@"{@dotless{i}}ve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}. +@samp{Naïve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}. @item mail-encode-encoded-word-buffer @findex mail-encode-encoded-word-buffer @@ -1234,7 +1234,7 @@ Encode the words that need encoding in a string, and return the result. @example (mail-encode-encoded-word-string - "This is na@"{@dotless{i}}ve, baby") + "This is naïve, baby") @result{} "This is =?iso-8859-1?q?na=EFve,?= baby" @end example @@ -1249,7 +1249,7 @@ Decode the encoded words in the string and return the result. @example (mail-decode-encoded-word-string "This is =?iso-8859-1?q?na=EFve,?= baby") -@result{} "This is na@"{@dotless{i}}ve, baby" +@result{} "This is naïve, baby" @end example @end table @@ -1511,7 +1511,7 @@ Here's a bunch of time/date/second/day examples: (date-to-time "Sat Sep 12 12:21:54 1998 +0200") @result{} (13818 19266) -(time-to-seconds '(13818 19266)) +(float-time '(13818 19266)) @result{} 905595714.0 (seconds-to-time 905595714.0) @@ -1583,9 +1583,8 @@ These are the functions available: @item date-to-time Take a date and return a time. -@item time-to-seconds -Take a time and return seconds. Note that Emacs has a built-in -function, @code{float-time}, that does this. +@item float-time +Take a time and return seconds. (This is a built-in function.) @item seconds-to-time Take seconds and return a time. @@ -1890,5 +1889,5 @@ Documentation of the text/plain format parameter for flowed text. @c Local Variables: @c mode: texinfo -@c coding: iso-8859-1 +@c coding: utf-8 @c End: diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index e21851ef37a..4dbc1373d32 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -2,6 +2,7 @@ @c %**start of header @setfilename ../../info/epa @settitle EasyPG Assistant User's Manual +@documentencoding UTF-8 @c %**end of header @set VERSION 1.0.0 @@ -9,7 +10,7 @@ @copying This file describes EasyPG Assistant @value{VERSION}. -Copyright @copyright{} 2007--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -62,6 +63,9 @@ called EasyPG Library. * Caching Passphrases:: * Bug Reports:: * GNU Free Documentation License:: The license for this documentation. +* Key Index:: +* Function Index:: +* Variable Index:: @end menu @node Overview @@ -106,7 +110,7 @@ This chapter introduces various commands for typical use cases. * Cryptographic operations on files:: * Dired integration:: * Mail-mode integration:: -* Encrypting/decrypting *.gpg files:: +* Encrypting/decrypting gpg files:: @end menu @node Key management @@ -240,8 +244,9 @@ you answered yes, it will let you select the signing keys. @node Cryptographic operations on files @section Cryptographic operations on files -@deffn Command epa-decrypt-file file -Decrypt @var{file}. +@deffn Command epa-decrypt-file file &optional output +Decrypt @var{file}. If you do not specify the name @var{output} to +use for the decrypted file, this function prompts for the value to use. @end deffn @deffn Command epa-verify-file file @@ -337,16 +342,19 @@ Compose a signed message from the current buffer. @kindex @kbd{C-c C-e C-e} @kindex @kbd{C-c C-e e} @findex epa-mail-encrypt +@vindex epa-mail-aliases Compose an encrypted message from the current buffer. By default it tries to build the recipient list from @samp{to}, @samp{cc}, and @samp{bcc} fields of the mail header. To include your key in the recipient list, use @samp{encrypt-to} option in -@file{~/.gnupg/gpg.conf}. +@file{~/.gnupg/gpg.conf}. This function translates recipient +addresses using the @code{epa-mail-aliases} list. You can also +use that option to ignore specific recipients for encryption purposes. @end table -@node Encrypting/decrypting *.gpg files -@section Encrypting/decrypting *.gpg files +@node Encrypting/decrypting gpg files +@section Encrypting/decrypting gpg files By default, every file whose name ends with @samp{.gpg} will be treated as encrypted. That is, when you open such a file, the decrypted text is inserted in the buffer rather than encrypted one. @@ -395,7 +403,7 @@ which encryption method should be used through @xref{File Variables, , variable for this. @vindex epa-file-encrypt-to -For example, if you want an Elisp file should be encrypted with a +For example, if you want an Elisp file to be encrypted with a public key associated with an email address @samp{ueno@@unixuser.org}, add the following line to the beginning of the file. @@ -463,7 +471,7 @@ To set up gpg-agent, follow the instruction in GnuPG manual. To set up elisp passphrase cache, set @code{epa-file-cache-passphrase-for-symmetric-encryption}. -@xref{Encrypting/decrypting *.gpg files}. +@xref{Encrypting/decrypting gpg files}. @node Bug Reports @chapter Bug Reports @@ -491,6 +499,18 @@ buffer name is a whitespace. @appendix GNU Free Documentation License @include doclicense.texi +@node Key Index +@unnumbered Key Index +@printindex ky + +@node Function Index +@unnumbered Function Index +@printindex fn + +@node Variable Index +@unnumbered Variable Index +@printindex vr + @bye @c End: diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index cc61cd1ab5b..05338d8cf29 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -4,12 +4,13 @@ @settitle ERC Manual @syncodeindex fn cp @include emacsver.texi +@documentencoding UTF-8 @c %**end of header @copying This manual is for ERC as distributed with Emacs @value{EMACSVER}. -Copyright @copyright{} 2005--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2005--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -234,9 +235,8 @@ forwards. Different channels and servers may have different language encodings. -In addition, it is possible to translate the messages that ERC uses into -multiple languages. Please contact the developers of ERC at -@email{erc-discuss@@gnu.org} if you are interested in helping with the +multiple languages. Please contact the Emacs developers +if you are interested in helping with the translation effort. @item user scripting @@ -784,9 +784,9 @@ To report a bug in ERC, use @kbd{M-x report-emacs-bug}. @chapter History @cindex history, of ERC -ERC was originally written by Alexander L. Belikoff -@email{abel@@bfr.co.il} and Sergey Berezin -@email{sergey.berezin@@cs.cmu.edu}. They stopped development around +@c abel@@bfr.co.il, sergey.berezin@@cs.cmu.edu +ERC was originally written by Alexander L. Belikoff and Sergey Berezin. +They stopped development around December 1999. Their last released version was ERC 2.0. P.S.: If one of the original developers of ERC reads this, we'd like to @@ -796,8 +796,9 @@ general. @itemize @item 2001 -In June 2001, Mario Lang @email{mlang@@delysid.org} and Alex Schroeder -@email{alex@@gnu.org} took over development and created a ERC Project at +@c mlang@@delysid.org, alex@@gnu.org +In June 2001, Mario Lang and Alex Schroeder +took over development and created a ERC Project at @uref{http://sourceforge.net/projects/erc}. In reaction to a mail about the new ERC development effort, Sergey @@ -825,7 +826,8 @@ ERC 4.0 was released. @item 2005 -ERC 5.0 was released. Michael Olson @email{mwolson@@gnu.org} became +@c mwolson@@gnu.org +ERC 5.0 was released. Michael Olson became the release manager and eventually the maintainer. After some discussion between him and the Emacs developers, it was diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 8728d53ea27..d57e629775c 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -2,15 +2,16 @@ @c %**start of header @setfilename ../../info/ert @settitle Emacs Lisp Regression Testing +@documentencoding UTF-8 @c %**end of header @dircategory Emacs misc features @direntry -* ERT: (ert). Emacs Lisp regression testing tool. +* ERT: (ert). Emacs Lisp regression testing tool. @end direntry @copying -Copyright @copyright{} 2008, 2010--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2008, 2010--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -25,9 +26,21 @@ modify this GNU manual.'' @end quotation @end copying +@titlepage +@title Emacs Lisp Regression Testing +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex @node Top @top ERT: Emacs Lisp Regression Testing +@insertcopying + ERT is a tool for automated testing in Emacs Lisp. Its main features are facilities for defining tests, running them and reporting the results, and for debugging test failures interactively. @@ -85,6 +98,7 @@ Appendix @end detailmenu @end menu +@end ifnottex @node Introduction @chapter Introduction @@ -183,9 +197,10 @@ tests run. It looks like this: @example Selector: t -Passed: 31 -Failed: 2 (2 unexpected) -Total: 33/33 +Passed: 31 +Skipped: 0 +Failed: 2 (2 unexpected) +Total: 33/33 Started at: 2008-09-11 08:39:25-0700 Finished. @@ -454,6 +469,19 @@ versions, specific architectures, etc.: @node Tests and Their Environment @section Tests and Their Environment +Sometimes, it doesn't make sense to run a test due to missing +preconditions. A required Emacs feature might not be compiled in, the +function to be tested could call an external binary which might not be +available on the test machine, you name it. In this case, the macro +@code{skip-unless} could be used to skip the test: + +@lisp +(ert-deftest test-dbus () + "A test that checks D-BUS functionality." + (skip-unless (featurep 'dbusbind)) + ...) +@end lisp + The outcome of running a test should not depend on the current state of the environment, and each test should leave its environment in the same state it found it in. In particular, a test should not depend on diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index ec01f731daf..befe3187d89 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -4,12 +4,13 @@ @settitle Eshell: The Emacs Shell @defindex cm @synindex vr fn +@documentencoding UTF-8 @c %**end of header @copying This manual is for Eshell, the Emacs shell. -Copyright @copyright{} 1999--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -61,20 +62,19 @@ modify this GNU manual.'' @node Top @top Eshell -Eshell is a shell-like command interpreter -implemented in Emacs Lisp. It invokes no external processes except for -those requested by the user. It is intended to be a functional -replacement for command shells such as @command{bash}, @command{zsh}, -@command{rc}, or @command{4dos}; since Emacs itself is capable of -handling the sort of tasks accomplished by those tools. +Eshell is a shell-like command interpreter implemented in Emacs Lisp. +It invokes no external processes except for those requested by the +user. It is intended to be an alternative to the IELM (@pxref{Lisp Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor}) +REPL for Emacs @emph{and} with an interface similar to command shells +such as @command{bash}, @command{zsh}, @command{rc}, or +@command{4dos}. @c This manual is updated to release 2.4 of Eshell. @insertcopying @end ifnottex @menu -* What is Eshell?:: A brief introduction to the Emacs Shell. -* Command basics:: The basics of command usage. +* Introduction:: A brief introduction to the Emacs Shell. * Commands:: * Expansion:: * Input/Output:: @@ -87,8 +87,9 @@ handling the sort of tasks accomplished by those tools. * Key Index:: @end menu -@node What is Eshell? -@chapter What is Eshell? +@node Introduction +@chapter Introduction +@section What is Eshell? @cindex what is Eshell? @cindex Eshell, what it is @@ -139,6 +140,24 @@ Any tool you use often deserves the time spent learning to master it. looks like: But don't let it fool you; once you know what's going on, it's easier than it looks: @code{ls -lt **/*.doc(Lk+50aM+5)}.} +@section What Eshell is not +@cindex Eshell, what it is not +@cindex what Eshell is not +@cindex what isn't Eshell? + +Eshell is @emph{not} a replacement for system shells such as +@command{bash} or @command{zsh}. Use Eshell when you want to move +text between Emacs and external processes; if you only want to pipe +output from one external process to another (and then another, and so +on), use a system shell, because Emacs's IO system is buffer oriented, +not stream oriented, and is very inefficient at such tasks. If you +want to write shell scripts in Eshell, don't; either write an elisp +library or use a system shell. + +Some things Eshell just doesn't do well. It fills the niche between +IELM and your system shell, where the peculiar use-cases lie, and it +is less than ideal outside that niche. + @menu * Contributors to Eshell:: People who have helped out! @end menu @@ -158,123 +177,31 @@ The following persons have made contributions to Eshell. @item Eli Zaretskii made it possible for Eshell to run without requiring asynchronous subprocess support. This is important for MS-DOS, which -does not have such support.@refill +does not have such support. @item -Miles Bader contributed many fixes during the port to Emacs 21.@refill +Miles Bader contributed many fixes during the port to Emacs 21. @item Stefan Monnier fixed the things which bothered him, which of course made -things better for all.@refill +things better for all. @item Gerd Moellmann also helped to contribute bug fixes during the initial -integration with Emacs 21.@refill +integration with Emacs 21. @item Alex Schroeder contributed code for interactively querying the user -before overwriting files.@refill +before overwriting files. @item -Sudish Joseph helped with some XEmacs compatibility issues.@refill +Sudish Joseph helped with some XEmacs compatibility issues. @end itemize Apart from these, a lot of people have sent suggestions, ideas, requests, bug reports and encouragement. Thanks a lot! Without you there would be no new releases of Eshell. -@node Command basics -@chapter Basic overview - -A command shell is a means of entering verbally-formed commands. This -is really all that it does, and every feature described in this manual -is a means to that end. Therefore, it's important to take firm hold on -exactly what a command is, and how it fits in the overall picture of -things. - -@menu -* Commands verbs:: Commands always begin with a verb. -* Command arguments:: Some verbs require arguments. -@end menu - -@node Commands verbs -@section Commands verbs - -Commands are expressed using @dfn{script}, a special shorthand language -computers can understand with no trouble. Script is an extremely simple -language; oddly enough, this is what makes it look so complicated! -Whereas normal languages use a variety of embellishments, the form of a -script command is always: - -@example -@var{verb} [@var{arguments}] -@end example - -The verb expresses what you want your computer to do. There are a fixed -number of verbs, although this number is usually quite large. On the -author's computer, it reaches almost 1400 in number. But of course, -only a handful of these are really necessary. - -Sometimes, the verb is all that's written. A verb is always a single -word, usually related to the task it performs. @command{reboot} is a -good example. Entering that on GNU/Linux will reboot the -computer---assuming you have sufficient privileges. - -Other verbs require more information. These are usually very capable -verbs, and must be told specifically what to do. The extra information -is given in the form of @dfn{arguments}. For example, the -@command{echo} verb prints back whatever arguments you type. It -requires these arguments to know what to echo. A proper use of -@command{echo} looks like this: - -@example -echo This is an example of using echo! -@end example - -This script command causes the computer to echo back: ``This is an -example of using echo!'' - -Although command verbs are always simple words, like @command{reboot} or -@command{echo}, arguments may have a wide variety of forms. There are -textual arguments, numerical arguments---even Lisp arguments. -Distinguishing these different types of arguments requires special -typing, for the computer to know exactly what you mean. - -@node Command arguments -@section Command arguments - -Eshell recognizes several different kinds of command arguments: - -@enumerate -@item Strings (also called textual arguments) -@item Numbers (floating point or integer) -@item Lisp lists -@item Lisp symbols -@item Emacs buffers -@item Emacs process handles -@end enumerate - -Most users need to worry only about the first two. The third, Lisp lists, -occur very frequently, but almost always behind the scenes. - -Strings are the most common type of argument, and consist of nearly any -character. Special characters---those used by Eshell -specifically---must be preceded by a backslash (@samp{\}). When in doubt, it -is safe to add backslashes anywhere and everywhere. - -Here is a more complicated @command{echo} example: - -@example -echo A\ Multi-word\ Argument\ With\ A\ \$\ dollar -@end example - -Beyond this, things get a bit more complicated. While not beyond the -reach of someone wishing to learn, it is definitely beyond the scope of -this manual to present it all in a simplistic manner. Get comfortable -with Eshell as a basic command invocation tool, and learn more about the -commands on your system; then come back when it all sits more familiarly -on your mind. Have fun! - @node Commands @chapter Commands @@ -353,9 +280,9 @@ sudo is an alias, defined as "*sudo $*" @vindex eshell-prefer-lisp-functions If you would prefer to use the built-in commands instead of the external -commands, set @var{eshell-prefer-lisp-functions} to @code{t}. +commands, set @code{eshell-prefer-lisp-functions} to @code{t}. -Some of the built-in commands have different behaviour from their +Some of the built-in commands have different behavior from their external counterparts, and some have no external counterpart. Most of these will print a usage message when given the @code{--help} option. @@ -378,12 +305,13 @@ Similar to, but slightly different from, the GNU Coreutils @item define @cmindex define -Define a varalias. @xref{Variable Aliases, , , elisp}. +Define a varalias. +@xref{Variable Aliases, , , elisp, The Emacs Lisp Reference Manual}. @item diff @cmindex diff Use Emacs's internal @code{diff} (not to be confused with -@code{ediff}). @xref{Comparing Files, , , elisp}. +@code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs Manual}. @item grep @cmindex grep @@ -422,15 +350,18 @@ and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}. @item locate @cmindex locate Alias to Emacs's @code{locate} function, which simply runs the external -@command{locate} command and parses the results. @xref{Dired and `find', , , elisp}. +@command{locate} command and parses the results. +@xref{Dired and Find, , , emacs, The GNU Emacs Manual}. @item make @cmindex make -Run @command{make} through @code{compile}. @xref{Running Compilations under Emacs, , , elisp}. +Run @command{make} through @code{compile}. +@xref{Compilation, , , emacs, The GNU Emacs Manual}. @item occur @cmindex occur -Alias to Emacs's @code{occur}. @xref{Other Search-and-Loop Commands, , , elisp}. +Alias to Emacs's @code{occur}. +@xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @item printnl @cmindex printnl @@ -460,8 +391,9 @@ With @samp{cd -42}, you can access the directory stack by number. @cmindex su @itemx sudo @cmindex sudo -Uses TRAMP's @command{su} or @command{sudo} method to run a command via -@command{su} or @command{sudo}. +Uses TRAMP's @command{su} or @command{sudo} method @pxref{Inline methods, , , tramp} +to run a command via @command{su} or @command{sudo}. These commands +are in the eshell-tramp module, which is disabled by default. @end table @@ -510,7 +442,7 @@ Aliases are commands that expand to a longer input line. For example, with the command invocation @samp{alias ll ls -l}; with this defined, running @samp{ll foo} in Eshell will actually run @samp{ls -l foo}. Aliases defined (or deleted) by the @command{alias} command are -automatically written to the file named by @var{eshell-aliases-file}, +automatically written to the file named by @code{eshell-aliases-file}, which you can also edit directly (although you will have to manually reload it). @@ -534,7 +466,7 @@ by @code{!foo:n}. The history ring is loaded from a file at the start of every session, and written back to the file at the end of every session. The file path -is specified in @var{eshell-history-file-name}. Unlike other shells, +is specified in @code{eshell-history-file-name}. Unlike other shells, such as Bash, Eshell can not be configured to keep a history ring of a different size than that of the history file. @@ -647,7 +579,8 @@ variables in command invocations. @item $#var Expands to the length of the value bound to @code{var}. Raises an error -if the value is not a sequence (@pxref{Sequences Arrays and Vectors, Sequences, , elisp}). +if the value is not a sequence +(@pxref{Sequences Arrays Vectors, Sequences, , elisp, The Emacs Lisp Reference Manual}). @item $(lisp) Expands to the result of evaluating the S-expression @code{(lisp)}. On @@ -679,7 +612,8 @@ any regular expression. So to split on numbers, use @samp{$var["[0-9]+" 10 20]} @item $var[hello] Calls @code{assoc} on @code{var} with @code{"hello"}, expecting it to be -an alist (@pxref{Association List Type, Association Lists, , elisp}). +an alist (@pxref{Association List Type, Association Lists, , elisp, +The Emacs Lisp Reference Manual}). @item $#var[hello] Returns the length of the cdr of the element of @code{var} who car is equal @@ -692,22 +626,35 @@ to @code{"hello"}. Eshell's globbing syntax is very similar to that of Zsh. Users coming from Bash can still use Bash-style globbing, as there are no incompatibilities. Most globbing is pattern-based expansion, but there -is also predicate-based expansion. See @ref{Filename Generation, , , zsh} -for full syntax. To customize the syntax and behaviour of globbing in -Eshell see the Customize@footnote{@xref{Customization Settings, Customize, , elisp}.} +is also predicate-based expansion. See +@ref{Filename Generation, , , zsh, The Z Shell Manual} +for full syntax. To customize the syntax and behavior of globbing in +Eshell see the Customize@footnote{@xref{Easy Customization, , , emacs, +The GNU Emacs Manual}.} groups ``eshell-glob'' and ``eshell-pred''. @node Input/Output @chapter Input/Output Since Eshell does not communicate with a terminal like most command -shells, IO is a little different. If you try to run programs from -within Eshell that are not line-oriented, such as programs that use -ncurses, you will just get garbage output, since the Eshell buffer is -not a terminal emulator. Eshell solves this problem by running -specified commands in Emacs's terminal emulator; to let Eshell know -which commands need to be run in a terminal, add them to the list -@var{eshell-visual-commands}. +shells, IO is a little different. +@section Visual Commands +If you try to run programs from within Eshell that are not +line-oriented, such as programs that use ncurses, you will just get +garbage output, since the Eshell buffer is not a terminal emulator. +Eshell solves this problem by running such programs in Emacs's +terminal emulator. + +Programs that need a terminal to display output properly are referred +to in this manual as ``visual commands,'' because they are not simply +line-oriented. You must tell Eshell which commands are visual, by +adding them to @code{eshell-visual-commands}; for commands that are +visual for only certain @emph{sub}-commands -- e.g. @samp{git log} but +not @samp{git status} -- use @code{eshell-visual-subcommands}; and for +commands that are visual only when passed certain options, use +@code{eshell-visual-options}. + +@section Redirection Redirection is mostly the same in Eshell as it is in other command shells. The output redirection operators @code{>} and @code{>>} as well as pipes are supported, but there is not yet any support for @@ -720,16 +667,16 @@ on the right-hand side, into which it inserts the output of the left-hand side. e.g., @samp{echo hello >>> #} inserts the string @code{"hello"} into the @code{*scratch*} buffer. -@var{eshell-virtual-targets} is a list of mappings of virtual device +@code{eshell-virtual-targets} is a list of mappings of virtual device names to functions. Eshell comes with two virtual devices: @file{/dev/kill}, which sends the text to the kill ring, and @file{/dev/clip}, which sends text to the clipboard. You can, of course, define your own virtual targets. They are defined -by adding a list of the form @code{("/dev/name" function mode)} to -@var{eshell-virtual-targets}. The first element is the device name; -@code{function} may be either a lambda or a function name. If -@code{mode} is nil, then the function is the output function; if it is +by adding a list of the form @samp{("/dev/name" @var{function} @var{mode})} to +@code{eshell-virtual-targets}. The first element is the device name; +@var{function} may be either a lambda or a function name. If +@var{mode} is nil, then the function is the output function; if it is non-nil, then the function is passed the redirection mode as a symbol--@code{overwrite} for @code{>}, @code{append} for @code{>>}, or @code{insert} for @code{>>>}--and the function is expected to return @@ -745,7 +692,8 @@ can be disabled and enabled without having to unload and reload them, and to provide a common parent Customize group for the modules.@footnote{ERC provides a similar module facility.} An Eshell module is defined the same as any other library but one requirement: the -module must define a Customize@footnote{@xref{Customization Settings, Customize, , elisp}.} +module must define a Customize@footnote{@xref{Customization, , , +elisp, The Emacs Lisp Reference Manual}.} group using @code{eshell-defgroup} (in place of @code{defgroup}) with @code{eshell-module} as the parent group.@footnote{If the module has no user-customizable options, then there is no need to define it as an @@ -753,7 +701,7 @@ Eshell module.} You also need to load the following as shown: @example (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'esh-mode) (require 'eshell)) @@ -798,16 +746,18 @@ Eshell module.} You also need to load the following as shown: @cindex known bugs @cindex bugs, known -If you find a bug or misfeature, don't hesitate to let me know! Send -email to @email{johnw@@gnu.org}. Feature requests should also be sent -there. I prefer discussing one thing at a time. If you find several +If you find a bug or misfeature, don't hesitate to report it, by +using @kbd{M-x report-emacs-bug}. The same applies to feature requests. +It is best to discuss one thing at a time. If you find several unrelated bugs, please report them separately. +@ignore If you have ideas for improvements, or if you have written some extensions to this package, I would like to hear from you. I hope you find this package useful! +@end ignore -Below is a complete list of known problems with Eshell version 2.4.2, +Below is a list of some known problems with Eshell version 2.4.2, which is the version included with Emacs 22. @table @asis diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 5b06cc7f11a..1df54ca4395 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -3,6 +3,7 @@ @setfilename ../../info/eudc @settitle Emacs Unified Directory Client (EUDC) Manual @afourpaper +@documentencoding UTF-8 @c %**end of header @copying @@ -12,7 +13,7 @@ EUDC is the Emacs Unified Directory Client, a common interface to directory servers using various protocols such as LDAP or the CCSO white pages directory system (PH/QI) -Copyright @copyright{} 1998, 2000--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1998, 2000--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -150,14 +151,17 @@ phone number, email, academic information or any other details it was configured to. Nowadays this system is not widely used. The system consists of two parts: a database server traditionally called -@samp{qi} and a command-line client called @samp{ph}. As of 2010, the -code can still be downloaded from @url{http://www-dev.cites.uiuc.edu/ph/}. +@samp{qi} and a command-line client called @samp{ph}. +@ignore +Until 2010, the code could be downloaded from +@url{http://www-dev.cites.uiuc.edu/ph/}. +@end ignore -The original command-line @samp{ph} client that comes with the -@samp{ph/qi} distribution provides additional features like the -possibility to communicate with the server in login-mode which makes it -possible to change records in the database. This is not implemented in -EUDC. +The original command-line @samp{ph} client that came with the +@samp{ph/qi} distribution provided additional features that are +not implemented in EUDC, like the possibility to communicate with the +server in login-mode, which made it possible to change records in the +database. @node BBDB diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi new file mode 100644 index 00000000000..38bec5a4c8b --- /dev/null +++ b/doc/misc/eww.texi @@ -0,0 +1,253 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename ../../info/eww +@settitle Emacs Web Wowser +@documentencoding UTF-8 +@c %**end of header + +@copying +This file documents the GNU Emacs Web Wowser (EWW) package. + +Copyright @copyright{} 2014 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License.'' + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs misc features +@direntry +* EWW: (eww). Emacs Web Wowser +@end direntry + +@finalout + +@titlepage +@title Emacs Web Wowser (EWW) +@subtitle A web browser for GNU Emacs. + +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top EWW + +@insertcopying +@end ifnottex + +@menu +* Overview:: +* Basics:: +* Advanced:: + +Appendices +* History and Acknowledgments:: +* GNU Free Documentation License:: The license for this documentation. + +Indices +* Key Index:: +* Variable Index:: +* Lisp Function Index:: +* Concept Index:: +@end menu + +@node Overview +@chapter Overview +@dfn{EWW}, the Emacs Web Wowser, is a web browser for GNU Emacs. It +can load, parse, and display various web pages using @dfn{shr.el}. +However a GNU Emacs with @code{libxml2} support is required. + +@node Basics +@chapter Basic Usage + +@findex eww +@findex eww-open-file +@vindex eww-search-prefix +@cindex eww +@cindex Web Browsing + You can open a URL or search the web with the command @kbd{M-x eww}. +If the input doesn't look like a URL or domain name the web will be +searched via @code{eww-search-prefix}. The default search engine is +@url{https://duckduckgo.com, DuckDuckGo}. If you want to open a file +either prefix the file name with @code{file://} or use the command +@kbd{M-x eww-open-file}. + +@findex eww-quit +@findex eww-reload +@findex eww-copy-page-url +@kindex q +@kindex w +@kindex g + If loading the URL was successful the buffer @code{*eww*} is opened +and the web page is rendered in it. You can leave EWW by pressing +@kbd{q} or exit the browser by calling @kbd{eww-quit}. To reload the +web page hit @kbd{g} (@code{eww-reload}). Pressing @kbd{w} +(@code{eww-copy-page-url}) will copy the current URL to the kill ring. + +@findex eww-download +@vindex eww-download-directory +@kindex d +@cindex Download + A URL under the point can be downloaded with @kbd{d} +(@code{eww-download}). The file will be written to the directory +specified in @code{eww-download-directory} (Default: @file{~/Downloads/}). + +@findex eww-back-url +@findex eww-forward-url +@findex eww-list-histories +@kindex r +@kindex l +@kindex H +@cindex History + EWW remembers the URLs you have visited to allow you to go back and +forth between them. By pressing @kbd{l} (@code{eww-back-url}) you go +to the previous URL. You can go forward again with @kbd{r} +(@code{eww-forward-url}). If you want an overview of your browsing +history press @kbd{H} (@code{eww-list-histories}) to open the history +buffer @code{*eww history*}. The history is lost when EWW is quit. +If you want to remember websites you can use bookmarks. + +@findex eww-add-bookmark +@findex eww-list-bookmarks +@kindex b +@kindex B +@cindex Bookmarks + EWW allows you to @dfn{bookmark} URLs. Simply hit @kbd{b} +(@code{eww-add-bookmark}) to store a bookmark for the current website. +You can view stored bookmarks with @kbd{B} +(@code{eww-list-bookmarks}). This will open the bookmark buffer +@code{*eww bookmarks*}. + +@findex eww-browse-with-external-browser +@vindex shr-external-browser +@vindex eww-use-external-browser-for-content-type +@kindex & +@cindex External Browser + Although EWW and shr.el do their best to render webpages in GNU +Emacs some websites use features which can not be properly represented +or are not implemented (E.g., JavaScript). If you have trouble +viewing a website with EWW then hit @kbd{&} +(@code{eww-browse-with-external-browser}) inside the EWW buffer to +open the website in the external browser specified by +@code{shr-external-browser}. Some content types, such as video or +audio content, do not make sense to display in GNU Emacs at all. You +can tell EWW to open specific content automatically in an external +browser by customizing +@code{eww-use-external-browser-for-content-type}. + +@node Advanced +@chapter Advanced + +@findex eww-view-source +@kindex v +@cindex Viewing Source + You can view the source of a website with @kbd{v} +(@code{eww-view-source}). This will open a new buffer +@code{*eww-source*} and insert the source. The buffer will be set to +@code{html-mode} if available. + +@findex url-cookie-list +@kindex C +@cindex Cookies + EWW handles cookies through the @ref{Top, url package, ,url}. +You can list existing cookies with @kbd{C} (@code{url-cookie-list}). +For details about the Cookie handling @xref{Cookies,,,url}. + +@vindex eww-header-line-format +@cindex Header + The header line of the EWW buffer can be changed by customizing +@code{eww-header-line-format}. The format replaces @code{%t} with the +title of the website and @code{%u} with the URL. + +@c @vindex shr-bullet +@c @vindex shr-hr-line +@c @vindex eww-form-checkbox-selected-symbol +@c @vindex eww-form-checkbox-symbol +@c EWW and the rendering engine shr.el use ASCII characters to +@c represent some graphical elements, such as bullet points +@c (@code{shr-bullet}), check boxes +@c (@code{eww-form-checkbox-selected-symbol} and +@c @code{eww-form-checkbox-symbol}), and horizontal rules +@c @code{shr-hr-line}). Depending on your fonts these characters can be +@c replaced by Unicode glyphs to achieve better looking results. + +@vindex shr-max-image-proportion +@vindex shr-blocked-images +@cindex Image Display + Loading random images from the web can be problematic due to their +size or content. By customizing @code{shr-max-image-proportion} you +can set the maximal image proportion in relation to the window they +are displayed in. E.g., 0.7 means an image is allowed to take up 70% +of the width and height. If Emacs supports image scaling (ImageMagick +support required) then larger images are scaled down. You can block +specific images completely by customizing @code{shr-blocked-images}. + +@node History and Acknowledgments +@appendix History and Acknowledgments + +EWW was originally written by Lars Ingebrigtsen, known for his work on +Gnus. He started writing an Emacs HTML rendering library, +@code{shr.el}, to read blogs in Gnus. He eventually added a web +browser front end and HTML form support. Which resulted in EWW, the +Emacs Web Wowser. EWW was announced on 16 June 2013: +@url{http://lars.ingebrigtsen.no/2013/06/16/eww/}. + +EWW was then moved from the Gnus repository to GNU Emacs and several +developers started contributing to it as well. A list of contributors +at the time of writing this manual: + +@itemize @bullet +@item Daniel Hackney +@item Eli Zaretskii +@item Glenn Morris +@item Ivan Kanis +@item Juri Linkov +@item Katsumi Yamaoka +@item Kenjiro NAKAYAMA +@item Lars Magne Ingebrigtsen +@item Leo Liu +@item Paul Eggert +@item Rüdiger Sonderfeld +@item Stefan Monnier +@item Ted Zlatanov +@end itemize + +@node GNU Free Documentation License +@chapter GNU Free Documentation License +@include doclicense.texi + +@node Key Index +@unnumbered Key Index + +@printindex ky + +@node Variable Index +@unnumbered Variable Index + +@printindex vr + +@node Lisp Function Index +@unnumbered Function Index + +@printindex fn + +@node Concept Index +@unnumbered Concept Index + +@printindex cp + + +@bye diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 5dedda16ee1..5125acd1f0d 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -5,13 +5,14 @@ @set UPDATED April 2004 @settitle GNU Flymake @value{VERSION} @syncodeindex pg cp +@documentencoding UTF-8 @comment %**end of header @copying This manual is for GNU Flymake (version @value{VERSION}, @value{UPDATED}), which is a universal on-the-fly syntax checker for GNU Emacs. -Copyright @copyright{} 2004--2013 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -63,13 +64,13 @@ modify this GNU manual.'' @cindex Overview of Flymake Flymake is a universal on-the-fly syntax checker implemented as an -Emacs minor mode. Flymake runs the pre-configured syntax check tool +Emacs minor mode. Flymake runs the pre-configured syntax check tool (compiler for C++ files, @code{perl} for perl files, etc.)@: in the background, passing it a temporary copy of the current buffer, and -parses the output for known error/warning message patterns. Flymake +parses the output for known error/warning message patterns. Flymake then highlights erroneous lines (i.e., lines for which at least one error or warning has been reported by the syntax check tool), and -displays an overall buffer status in the mode line. Status information +displays an overall buffer status in the mode line. Status information displayed by Flymake contains total number of errors and warnings reported for the buffer during the last syntax check. @@ -79,14 +80,14 @@ line, respectively. Calling @code{flymake-display-err-menu-for-current-line} will popup a menu containing error messages reported by the syntax check tool for -the current line. Errors/warnings belonging to another file, such as a +the current line. Errors/warnings belonging to another file, such as a @code{.h} header file included by a @code{.c} file, are shown in the -current buffer as belonging to the first line. Menu items for such -messages also contain a filename and a line number. Selecting such a +current buffer as belonging to the first line. Menu items for such +messages also contain a filename and a line number. Selecting such a menu item will automatically open the file and jump to the line with error. -Syntax check is done 'on-the-fly'. It is started whenever +Syntax check is done ``on-the-fly''. It is started whenever @itemize @bullet @item buffer is loaded @@ -97,7 +98,7 @@ delay is configurable). Flymake is a universal syntax checker in the sense that it's easily extended to support new syntax check tools and error message -patterns. @xref{Configuring Flymake}. +patterns. @xref{Configuring Flymake}. @node Installing Flymake @chapter Installing @@ -107,7 +108,7 @@ patterns. @xref{Configuring Flymake}. Flymake is packaged in a single file, @code{flymake.el}. To install/update Flymake, place @code{flymake.el} to a directory -somewhere on Emacs load path. You might also want to byte-compile +somewhere on Emacs load path. You might also want to byte-compile @code{flymake.el} to improve performance. Also, place the following line in the @code{.emacs} file. @@ -141,13 +142,13 @@ You might also map the most frequently used Flymake functions, such as @section Flymake mode @cindex flymake-mode -Flymake is an Emacs minor mode. To use Flymake, you +Flymake is an Emacs minor mode. To use Flymake, you must first activate @code{flymake-mode} by using the @code{flymake-mode} function. Instead of manually activating @code{flymake-mode}, you can configure Flymake to automatically enable @code{flymake-mode} upon opening any -file for which syntax check is possible. To do so, place the following +file for which syntax check is possible. To do so, place the following line in @code{.emacs}: @lisp @@ -159,9 +160,9 @@ line in @code{.emacs}: @cindex Manually starting the syntax check When @code{flymake-mode} is active, syntax check is started -automatically on any of the three conditions mentioned above. Syntax +automatically on any of the three conditions mentioned above. Syntax check can also be started manually by using the -@code{flymake-start-syntax-check-for-current-buffer} function. This +@code{flymake-start-syntax-check-for-current-buffer} function. This can be used, for example, when changes were made to some other buffer affecting the current buffer. @@ -171,7 +172,7 @@ affecting the current buffer. After syntax check is completed, lines for which at least one error or warning has been reported are highlighted, and total number of errors -and warning is shown in the mode line. Use the following functions to +and warning is shown in the mode line. Use the following functions to navigate the highlighted lines. @multitable @columnfractions 0.25 0.75 @@ -184,7 +185,7 @@ navigate the highlighted lines. @end multitable -These functions treat erroneous lines as a linked list. Therefore, +These functions treat erroneous lines as a linked list. Therefore, @code{flymake-goto-next-error} will go to the first erroneous line when invoked in the end of the buffer. @@ -193,7 +194,7 @@ when invoked in the end of the buffer. @cindex Viewing error messages To view error messages belonging to the current line, use the -@code{flymake-display-err-menu-for-current-line} function. If there's +@code{flymake-display-err-menu-for-current-line} function. If there's at least one error or warning reported for the current line, this function will display a popup menu with error/warning texts. Selecting the menu item whose error belongs to another file brings @@ -209,12 +210,12 @@ The following statuses are defined. @multitable @columnfractions 0.25 0.75 @item Flymake* or Flymake:E/W* -@tab Flymake is currently running. For the second case, E/W contains the +@tab Flymake is currently running. For the second case, E/W contains the error and warning count for the previous run. @item Flymake -@tab Syntax check is not running. Usually this means syntax check was -successfully passed (no errors, no warnings). Other possibilities are: +@tab Syntax check is not running. Usually this means syntax check was +successfully passed (no errors, no warnings). Other possibilities are: syntax check was killed as a result of executing @code{flymake-compile}, or syntax check cannot start as compilation is currently in progress. @@ -232,7 +233,7 @@ OFF for the buffer. @multitable @columnfractions 0.25 0.75 @item CFGERR @tab Syntax check process returned nonzero exit code, but no -errors/warnings were reported. This indicates a possible configuration +errors/warnings were reported. This indicates a possible configuration error (for example, no suitable error message patterns for the syntax check tool). @@ -253,12 +254,12 @@ syntax check tool). @cindex Troubleshooting Flymake uses a simple logging facility for indicating important points -in the control flow. The logging facility sends logging messages to -the @code{*Messages*} buffer. The information logged can be used for +in the control flow. The logging facility sends logging messages to +the @code{*Messages*} buffer. The information logged can be used for resolving various problems related to Flymake. Logging output is controlled by the @code{flymake-log-level} -variable. @code{3} is the most verbose level, and @code{-1} switches +variable. @code{3} is the most verbose level, and @code{-1} switches logging off. @node Configuring Flymake @@ -286,30 +287,33 @@ Controls logging output, see @ref{Troubleshooting}. @item flymake-allowed-file-name-masks A list of @code{(filename-regexp, init-function, cleanup-function -getfname-function)} for configuring syntax check tools. @xref{Adding +getfname-function)} for configuring syntax check tools. @xref{Adding support for a new syntax check tool}. @ignore @item flymake-buildfile-dirs A list of directories (relative paths) for searching a -buildfile. @xref{Locating the buildfile}. +buildfile. @xref{Locating the buildfile}. @end ignore @item flymake-master-file-dirs -A list of directories for searching a master file. @xref{Locating a +A list of directories for searching a master file. @xref{Locating a master file}. @item flymake-get-project-include-dirs-function A function used for obtaining a list of project include dirs (C/C++ -specific). @xref{Getting the include directories}. +specific). @xref{Getting the include directories}. @item flymake-master-file-count-limit @itemx flymake-check-file-limit -Used when looking for a master file. @xref{Locating a master file}. +Used when looking for a master file. @xref{Locating a master file}. @item flymake-err-line-patterns Patterns for error/warning messages in the form @code{(regexp file-idx -line-idx col-idx err-text-idx)}. @xref{Parsing the output}. +line-idx col-idx err-text-idx)}. @xref{Parsing the output}. + +@item flymake-warning-predicate +Predicate to classify error text as warning. @xref{Parsing the output}. @item flymake-compilation-prevents-syntax-check A flag indicating whether compilation and syntax check of the same @@ -321,7 +325,7 @@ started after @code{flymake-no-changes-timeout} seconds. @item flymake-gui-warnings-enabled A boolean flag indicating whether Flymake will show message boxes for -non-recoverable errors. If @code{flymake-gui-warnings-enabled} is +non-recoverable errors. If @code{flymake-gui-warnings-enabled} is @code{nil}, these errors will only be logged to the @code{*Messages*} buffer. @@ -360,7 +364,7 @@ Which fringe (if any) should show the warning/error bitmaps. @end menu Syntax check tools are configured using the -@code{flymake-allowed-file-name-masks} list. Each item of this list +@code{flymake-allowed-file-name-masks} list. Each item of this list has the following format: @lisp @@ -371,14 +375,14 @@ has the following format: @item filename-regexp This field is used as a key for locating init/cleanup/getfname functions for the buffer. Items in -@code{flymake-allowed-file-name-masks} are searched sequentially. The +@code{flymake-allowed-file-name-masks} are searched sequentially. The first item with @code{filename-regexp} matching buffer filename is -selected. If no match is found, @code{flymake-mode} is switched off. +selected. If no match is found, @code{flymake-mode} is switched off. @item init-function @code{init-function} is required to initialize the syntax check, -usually by creating a temporary copy of the buffer contents. The -function must return @code{(list cmd-name arg-list)}. If +usually by creating a temporary copy of the buffer contents. The +function must return @code{(list cmd-name arg-list)}. If @code{init-function} returns null, syntax check is aborted, by @code{flymake-mode} is not switched off. @@ -389,7 +393,7 @@ usually deleting a temporary copy created by the @code{init-function}. @item getfname-function This function is used for translating filenames reported by the syntax -check tool into ``real'' filenames. Filenames reported by the tool +check tool into ``real'' filenames. Filenames reported by the tool will be different from the real ones, as actually the tool works with the temporary copy. In most cases, the default implementation provided by Flymake, @code{flymake-get-real-file-name}, can be used as @@ -411,7 +415,7 @@ support for various syntax check tools. @cindex Adding support for perl In this example, we will add support for @code{perl} as a syntax check -tool. @code{perl} supports the @code{-c} option which does syntax +tool. @code{perl} supports the @code{-c} option which does syntax checking. First, we write the @code{init-function}: @@ -463,7 +467,7 @@ In this example we will add support for C files syntax checked by @command{gcc} called via @command{make}. We're not required to write any new functions, as Flymake already has -functions for @command{make}. We just add a new entry to the +functions for @command{make}. We just add a new entry to the @code{flymake-allowed-file-name-masks}: @lisp @@ -489,7 +493,7 @@ command line: @code{base-dir} is a directory containing @code{Makefile}, see @ref{Locating the buildfile}. -Thus, @code{Makefile} must contain the @code{check-syntax} target. In +Thus, @code{Makefile} must contain the @code{check-syntax} target. In our case this target might look like this: @verbatim @@ -527,12 +531,12 @@ check-syntax: Syntax check is started by calling @code{flymake-start-syntax-check-for-current-buffer}. Flymake first determines whether it is able to do syntax -check. It then saves a copy of the buffer in a temporary file in the +check. It then saves a copy of the buffer in a temporary file in the buffer's directory (or in the system temp directory, for java files), creates a syntax check command and launches a process with -this command. The output is parsed using a list of error message patterns, +this command. The output is parsed using a list of error message patterns, and error information (file name, line number, type and text) is -saved. After the process has finished, Flymake highlights erroneous +saved. After the process has finished, Flymake highlights erroneous lines in the buffer using the accumulated error information. @node Determining whether syntax check is possible @@ -551,14 +555,14 @@ Two syntax check modes are distinguished: @item Buffer can be syntax checked in a standalone fashion, that is, the file (its temporary copy, in fact) can be passed over to the compiler to -do the syntax check. Examples are C/C++ (.c, .cpp) and Java (.java) +do the syntax check. Examples are C/C++ (.c, .cpp) and Java (.java) sources. @item Buffer can be syntax checked, but additional file, called master file, -is required to perform this operation. A master file is a file that +is required to perform this operation. A master file is a file that includes the current file, so that running a syntax check tool on it -will also check syntax in the current file. Examples are C/C++ (.h, +will also check syntax in the current file. Examples are C/C++ (.h, .hpp) headers. @end enumerate @@ -579,7 +583,7 @@ copies, finding master files, etc.), as well as some tool-specific After the possibility of the syntax check has been determined, a temporary copy of the current buffer is made so that the most recent -unsaved changes could be seen by the syntax check tool. Making a copy +unsaved changes could be seen by the syntax check tool. Making a copy is quite straightforward in a standalone case (mode @code{1}), as it's just saving buffer contents to a temporary file. @@ -595,11 +599,11 @@ name. Locating a master file is discussed in the following section. Patching just changes all appropriate lines of the master file so that they -use the new (temporary) name of the current file. For example, suppose current +use the new (temporary) name of the current file. For example, suppose current file name is @code{file.h}, the master file is @code{file.cpp}, and -it includes current file via @code{#include "file.h"}. Current file's copy +it includes current file via @code{#include "file.h"}. Current file's copy is saved to file @code{file_flymake.h}, so the include line must be -changed to @code{#include "file_flymake.h"}. Finally, patched master file +changed to @code{#include "file_flymake.h"}. Finally, patched master file is saved to @code{file_flymake_master.cpp}, and the last one is passed to the syntax check tool. @@ -609,27 +613,27 @@ the syntax check tool. Master file is located in two steps. -First, a list of possible master files is built. A simple name -matching is used to find the files. For a C++ header @code{file.h}, +First, a list of possible master files is built. A simple name +matching is used to find the files. For a C++ header @code{file.h}, Flymake searches for all @code{.cpp} files in the directories whose relative paths are stored in a customizable variable @code{flymake-master-file-dirs}, which -usually contains something like @code{("." "./src")}. No more than +usually contains something like @code{("." "./src")}. No more than @code{flymake-master-file-count-limit} entries is added to the master file -list. The list is then sorted to move files with names @code{file.cpp} to +list. The list is then sorted to move files with names @code{file.cpp} to the top. Next, each master file in a list is checked to contain the appropriate -include directives. No more than @code{flymake-check-file-limit} of each +include directives. No more than @code{flymake-check-file-limit} of each file are parsed. For @code{file.h}, the include directives to look for are -@code{#include "file.h"}, @code{#include "../file.h"}, etc. Each +@code{#include "file.h"}, @code{#include "../file.h"}, etc. Each include is checked against a list of include directories (see @ref{Getting the include directories}) to be sure it points to the correct @code{file.h}. -First matching master file found stops the search. The master file is then -patched and saved to disk. In case no master file is found, syntax check is +First matching master file found stops the search. The master file is then +patched and saved to disk. In case no master file is found, syntax check is aborted, and corresponding status (!) is reported in the mode line. @node Getting the include directories @@ -637,19 +641,19 @@ aborted, and corresponding status (!) is reported in the mode line. @cindex Include directories (C/C++ specific) Two sets of include directories are distinguished: system include directories -and project include directories. The former is just the contents of the -@code{INCLUDE} environment variable. The latter is not so easy to obtain, +and project include directories. The former is just the contents of the +@code{INCLUDE} environment variable. The latter is not so easy to obtain, and the way it can be obtained can vary greatly for different projects. Therefore, a customizable variable @code{flymake-get-project-include-dirs-function} is used to provide the way to implement the desired behavior. The default implementation, @code{flymake-get-project-include-dirs-imp}, -uses a @command{make} call. This requires a correct base directory, that is, a +uses a @command{make} call. This requires a correct base directory, that is, a directory containing a correct @file{Makefile}, to be determined. As obtaining the project include directories might be a costly operation, its -return value is cached in the hash table. The cache is cleared in the beginning +return value is cached in the hash table. The cache is cleared in the beginning of every syntax check attempt. @node Locating the buildfile @@ -659,18 +663,18 @@ of every syntax check attempt. @cindex Makefile, locating Flymake can be configured to use different tools for performing syntax -checks. For example, it can use direct compiler call to syntax check a perl +checks. For example, it can use direct compiler call to syntax check a perl script or a call to @command{make} for a more complicated case of a -@code{C/C++} source. The general idea is that simple files, like perl +@code{C/C++} source. The general idea is that simple files, like perl scripts and html pages, can be checked by directly invoking a -corresponding tool. Files that are usually more complex and generally +corresponding tool. Files that are usually more complex and generally used as part of larger projects, might require non-trivial options to be passed to the syntax check tool, like include directories for -C++. The latter files are syntax checked using some build tool, like +C++. The latter files are syntax checked using some build tool, like Make or Ant. All Make configuration data is usually stored in a file called -@code{Makefile}. To allow for future extensions, flymake uses a notion of +@code{Makefile}. To allow for future extensions, flymake uses a notion of buildfile to reference the 'project configuration' file. Special function, @code{flymake-find-buildfile} is provided for locating buildfiles. @@ -679,7 +683,7 @@ for possible master files. @ignore A customizable variable @code{flymake-buildfile-dirs} holds a list of relative paths to the -buildfile. They are checked sequentially until a buildfile is found. +buildfile. They are checked sequentially until a buildfile is found. @end ignore In case there's no build file, syntax check is aborted. @@ -690,9 +694,9 @@ Buildfile values are also cached. @cindex Syntax check process The command line (command name and the list of arguments) for launching a process is returned by the -initialization function. Flymake then just calls @code{start-process} -to start an asynchronous process and configures process filter and -sentinel which is used for processing the output of the syntax check +initialization function. Flymake then just calls @code{start-process} +to start an asynchronous process and configures a process filter and +sentinel, which are used for processing the output of the syntax check tool. @node Parsing the output @@ -701,24 +705,24 @@ tool. The output generated by the syntax check tool is parsed in the process filter/sentinel using the error message patterns stored in the -@code{flymake-err-line-patterns} variable. This variable contains a +@code{flymake-err-line-patterns} variable. This variable contains a list of items of the form @code{(regexp file-idx line-idx err-text-idx)}, used to determine whether a particular line is an error message and extract file name, line number and error text, -respectively. Error type (error/warning) is also guessed by matching -error text with the '@code{^[wW]arning}' pattern. Anything that was not -classified as a warning is considered an error. Type is then used to +respectively. Error type (error/warning) is also guessed by matching +error text with the '@code{^[wW]arning}' pattern. Anything that was not +classified as a warning is considered an error. Type is then used to sort error menu items, which shows error messages first. Flymake is also able to interpret error message patterns missing err-text-idx -information. This is done by merely taking the rest of the matched line -(@code{(substring line (match-end 0))}) as error text. This trick allows +information. This is done by merely taking the rest of the matched line +(@code{(substring line (match-end 0))}) as error text. This trick allows to make use of a huge collection of error message line patterns from -@code{compile.el}. All these error patterns are appended to +@code{compile.el}. All these error patterns are appended to the end of @code{flymake-err-line-patterns}. The error information obtained is saved in a buffer local -variable. The buffer for which the process output belongs is +variable. The buffer for which the process output belongs is determined from the process-id@w{}->@w{}buffer mapping updated after every process launch/exit. @@ -727,7 +731,7 @@ after every process launch/exit. @cindex Erroneous lines, faces Highlighting is implemented with overlays and happens in the process -sentinel, after calling the cleanup function. Two customizable faces +sentinel, after calling the cleanup function. Two customizable faces are used: @code{flymake-errline} and @code{flymake-warnline}. Errors belonging outside the current buffer are considered to belong to line 1 of the current buffer. @@ -749,12 +753,13 @@ and @code{flymake-warning-bitmap}. The only mode flymake currently knows about is @code{compile}. Flymake can be configured to not start syntax check if it thinks the -compilation is in progress. The check is made by the +compilation is in progress. The check is made by the @code{flymake-compilation-is-running}, which tests the -@code{compilation-in-progress} variable. The reason why this might be +@code{compilation-in-progress} variable. The reason why this might be useful is saving CPU time in case both syntax check and compilation -are very CPU intensive. The original reason for adding this feature, -though, was working around a locking problem with MS Visual C++ compiler. +are very CPU intensive. The original reason for adding this feature, +though, was working around a locking problem with MS Visual C++ +compiler. Flymake also provides an alternative command for starting compilation, @code{flymake-compile}: diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi index 17b117be961..164140bbfe6 100644 --- a/doc/misc/forms.texi +++ b/doc/misc/forms.texi @@ -14,11 +14,12 @@ @end iftex @c @smallbook @comment %**end of header (This is for running Texinfo on a region.) +@documentencoding UTF-8 @copying This file documents Forms mode, a form-editing major mode for GNU Emacs. -Copyright @copyright{} 1989, 1997, 2001--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1989, 1997, 2001--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi index 15393ad8032..2147e5f62a0 100644 --- a/doc/misc/gnus-coding.texi +++ b/doc/misc/gnus-coding.texi @@ -2,12 +2,13 @@ @setfilename gnus-coding @settitle Gnus Coding Style and Maintenance Guide +@documentencoding UTF-8 @syncodeindex fn cp @syncodeindex vr cp @syncodeindex pg cp @copying -Copyright @copyright{} 2004--2005, 2007--2013 Free Software +Copyright @copyright{} 2004--2005, 2007--2014 Free Software Foundation, Inc. @quotation @@ -387,5 +388,5 @@ changed. @c Local Variables: @c mode: texinfo -@c coding: iso-8859-1 +@c coding: utf-8 @c End: diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index ede957a5c35..858ce8c2a50 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1,10 +1,11 @@ @c \input texinfo @c -*-texinfo-*- @c Uncomment 1st line before texing this file alone. @c %**start of header -@c Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc. +@c Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc. @c @c @setfilename gnus-faq.info @c @settitle Frequently Asked Questions +@c @documentencoding UTF-8 @c %**end of header @c @@ -222,10 +223,9 @@ Which version of Emacs do I need? @subsubheading Answer -Gnus 5.10 requires an Emacs version that is greater than or equal -to Emacs 20.7 or XEmacs 21.1. -The development versions of Gnus (aka No Gnus) requires Emacs 21 -or XEmacs 21.4. +Gnus 5.13 requires an Emacs version that is greater than or equal +to Emacs 23.1 or XEmacs 21.1, although there are some features that +only work on Emacs 24. @node FAQ 1-7 @subsubheading Question 1.7 @@ -705,32 +705,9 @@ retrieves via POP3? @subsubheading Answer -First of all, that's not the way POP3 is intended to work, -if you have the possibility, you should use the IMAP -Protocol if you want your messages to stay on the -server. Nevertheless there might be situations where you -need the feature, but sadly Gnus itself has no predefined -functionality to do so. - -However this is Gnus county so there are possibilities to -achieve what you want. The easiest way is to get an external -program which retrieves copies of the mail and stores them -on disk, so Gnus can read it from there. On Unix systems you -could use, e.g., fetchmail for this, on MS Windows you can use -Hamster, an excellent local news and mail server. - -The other solution would be, to replace the method Gnus -uses to get mail from POP3 servers by one which is capable -of leaving the mail on the server. If you use XEmacs, get -the package mail-lib, it includes an enhanced pop3.el, -look in the file, there's documentation on how to tell -Gnus to use it and not to delete the retrieved mail. For -GNU Emacs look for the file epop3.el which can do the same -(If you know the home of this file, please send me an -e-mail). You can also tell Gnus to use an external program -(e.g., fetchmail) to fetch your mail, see the info node -"Mail Source Specifiers" in the Gnus manual on how to do -it. +Yes, if the POP3 server supports the UIDL control (maybe almost servers +do it nowadays). To do that, add a @code{:leave VALUE} pair to each +POP3 mail source. See @pxref{Mail Source Specifiers} for VALUE. @node FAQ 4 - Reading messages @subsection Reading messages @@ -1541,8 +1518,9 @@ cat file.face | sed 's/\\/\\\\/g;s/\"/\\\"/g;' > file.face.quoted If you can't use compface, there's an online X-face converter at @uref{http://www.dairiki.org/xface/}. -If you use MS Windows, you could also use the WinFace program from -@uref{http://www.xs4all.nl/~walterln/winface/}. +If you use MS Windows, you could also use the WinFace program, +which used to be available from +@indicateurl{http://www.xs4all.nl/~walterln/winface/}. Now you only have to tell Gnus to include the X-face in your postings by saying @example @@ -1835,15 +1813,20 @@ too. Of course you can also use grep to search through your local mail, but this is both slow for big archives and inconvenient since you are not displaying the found mail -in Gnus. Here comes nnir into action. Nnir is a front end +in Gnus. Here nnir comes into action. Nnir is a front end to search engines like swish-e or swish++ and -others. You index your mail with one of those search +others. You index your mail with one of those search engines and with the help of nnir you can search through the indexed mail and generate a temporary group with all -messages which met your search criteria. If this sound -cool to you get nnir.el from +messages which met your search criteria. If this sounds +cool to you, get nnir.el from +@c FIXME Isn't this file in Gnus? +@ignore +@c Dead link 2013/7. @uref{ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/} -or @uref{ftp://ftp.is.informatik.uni-duisburg.de/pub/src/emacs/}. +or +@end ignore +@uref{ftp://ftp.is.informatik.uni-duisburg.de/pub/src/emacs/}. Instructions on how to use it are at the top of the file. @node FAQ 6-4 @@ -1966,7 +1949,7 @@ the easiest solution is a small nntp server like @uref{http://infa.abo.fi/~patrik/sn/, sn}, of course you can also install a full featured news server like -@uref{http://www.isc.org/products/INN/, inn}. +@uref{http://www.isc.org/software/inn/, inn}. Then you want to fetch your Mail, popular choices are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail} and @uref{http://pyropus.ca/software/getmail/, getmail}. diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el index ff082e4ecf0..fdb4fe88099 100644 --- a/doc/misc/gnus-news.el +++ b/doc/misc/gnus-news.el @@ -1,5 +1,5 @@ ;;; gnus-news.el --- a hack to create GNUS-NEWS from texinfo source -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Reiner Steib ;; Keywords: tools @@ -26,7 +26,7 @@ (defvar gnus-news-header-disclaimer "GNUS NEWS -- history of user-visible changes. -Copyright (C) 1999-2013 Free Software Foundation, Inc. +Copyright (C) 1999-2014 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Gnus bug reports to bugs@gnus.org. diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 9c1ecb19748..a48b1f1bc5b 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- -@c Copyright (C) 2004-2013 Free Software Foundation, Inc. +@c Copyright (C) 2004-2014 Free Software Foundation, Inc. @c Permission is granted to anyone to make or distribute verbatim copies @c of this document as received, in any medium, provided that the diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 983887d721d..6ad0c26f9ac 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -11,7 +11,7 @@ @documentencoding UTF-8 @copying -Copyright @copyright{} 1995--2013 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2014 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -420,6 +420,9 @@ This manual corresponds to Gnus v5.13 * Index:: Variable, function and concept index. * Key Index:: Key Index. +@c Doesn't work right in html. +@c FIXME Do this in a more standard way. +@ifinfo Other related manuals * Message:(message). Composing messages. @@ -427,6 +430,7 @@ Other related manuals * Sieve:(sieve). Managing Sieve scripts in Emacs. * EasyPG:(epa). @acronym{PGP/MIME} with Gnus. * SASL:(sasl). @acronym{SASL} authentication in Emacs. +@end ifinfo @detailmenu --- The Detailed Node Listing --- @@ -2712,11 +2716,11 @@ the article range. This command is similar to @code{gnus-read-ephemeral-gmane-group}, but the group name and the article number and range are constructed from a given @acronym{URL}. Supported @acronym{URL} formats include: -@url{http://thread.gmane.org/gmane.foo.bar/12300/focus=12399}, -@url{http://thread.gmane.org/gmane.foo.bar/12345/}, -@url{http://article.gmane.org/gmane.foo.bar/12345/}, -@url{http://permalink.gmane.org/gmane.foo.bar/12345/}, and -@url{http://news.gmane.org/group/gmane.foo.bar/thread=12345}. +@indicateurl{http://thread.gmane.org/gmane.foo.bar/12300/focus=12399}, +@indicateurl{http://thread.gmane.org/gmane.foo.bar/12345/}, +@indicateurl{http://article.gmane.org/gmane.foo.bar/12345/}, +@indicateurl{http://permalink.gmane.org/gmane.foo.bar/12345/}, and +@indicateurl{http://news.gmane.org/group/gmane.foo.bar/thread=12345}. @item gnus-read-ephemeral-emacs-bug-group @findex gnus-read-ephemeral-emacs-bug-group @@ -3087,6 +3091,12 @@ if address "sender" ["name@@one.org", "else@@two.org"] @{ @} @end example +You can also use regexp expansions in the rules: + +@example +(sieve header :regex "list-id" "") +@end example + See @pxref{Sieve Commands} for commands and variables that might be of interest in relation to the sieve parameter. @@ -6376,10 +6386,10 @@ The default is @code{t}. @node Generic Marking Commands @subsection Generic Marking Commands -Some people would like the command that ticks an article (@kbd{!}) go to -the next article. Others would like it to go to the next unread -article. Yet others would like it to stay on the current article. And -even though I haven't heard of anybody wanting it to go to the +Some people would like the command that ticks an article (@kbd{!}) to +go to the next article. Others would like it to go to the next unread +article. Yet others would like it to stay on the current article. +And even though I haven't heard of anybody wanting it to go to the previous (unread) article, I'm sure there are people that want that as well. @@ -7384,6 +7394,14 @@ say something like: gnus-thread-sort-by-score)) @end lisp +By default, threads including their subthreads are sorted according to +the value of @code{gnus-thread-sort-functions}. By customizing +@code{gnus-subthread-sort-functions} you can define a custom sorting +order for subthreads. This allows for example to sort threads from +high score to low score in the summary buffer, but to have subthreads +still sorted chronologically from old to new without taking their +score into account. + @vindex gnus-thread-score-function The function in the @code{gnus-thread-score-function} variable (default @code{+}) is used for calculating the total score of a thread. Useful @@ -9517,18 +9535,9 @@ Say how much time has elapsed between the article was posted and now Date: 6 weeks, 4 days, 1 hour, 3 minutes, 8 seconds ago @end example -This line is updated continually by default. The frequency (in -seconds) is controlled by the @code{gnus-article-update-date-headers} -variable. - -If you wish to switch updating off, say: - -@vindex gnus-article-update-date-headers -@lisp -(setq gnus-article-update-date-headers nil) -@end lisp - -in your @file{~/.gnus.el} file. +To make this line updated continually, set the +@code{gnus-article-update-date-headers} variable to the frequency in +seconds (the default is @code{nil}). @item W T o @kindex W T o (Summary) @@ -10220,8 +10229,8 @@ summary buffer, point will just move to this article. If given a positive numerical prefix, fetch that many articles back into the ancestry. If given a negative numerical prefix, fetch just that ancestor. So if you say @kbd{3 ^}, Gnus will fetch the parent, the -grandparent and the grandgrandparent of the current article. If you say -@kbd{-3 ^}, Gnus will only fetch the grandgrandparent of the current +grandparent and the great-grandparent of the current article. If you say +@kbd{-3 ^}, Gnus will only fetch the great-grandparent of the current article. @item A R (Summary) @@ -11857,6 +11866,11 @@ predicate. The following predicates are recognized: @code{or}, (typep "text/x-vcard")) @end lisp +@item +A function: the function is called with no arguments and should return +@code{nil} or non-@code{nil}. The current article is available in the +buffer named by @code{gnus-article-buffer}. + @end enumerate You may have noticed that the word @dfn{part} is used here. This refers @@ -13818,9 +13832,12 @@ installed. You then define a server as follows: @findex nntp-open-ssl-stream @item nntp-open-ssl-stream Opens a connection to a server over a @dfn{secure} channel. To use -this you must have @uref{http://www.openssl.org, OpenSSL} or -@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL, SSLeay} installed. You -then define a server as follows: +this you must have @uref{http://www.openssl.org, OpenSSL} +@ignore +@c Defunct URL, ancient package, so don't mention it. +or @uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL, SSLeay} +@end ignore +installed. You then define a server as follows: @lisp ;; @r{"snews" is port 563 and is predefined in our @file{/etc/services}} @@ -14249,7 +14266,8 @@ variables are relevant: @table @code @item nnimap-inbox -This is the @acronym{IMAP} mail box that will be scanned for new mail. +This is the @acronym{IMAP} mail box that will be scanned for new +mail. This can also be a list of mail box names. @item nnimap-split-methods Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting @@ -14778,14 +14796,16 @@ and says what authentication scheme to use. The default is @item :leave Non-@code{nil} if the mail is to be left on the @acronym{POP} server -after fetching. Mails once fetched will never be fetched again by the -@acronym{UIDL} control. Only the built-in @code{pop3-movemail} program -(the default) supports this keyword. +after fetching. Only the built-in @code{pop3-movemail} program (the +default) supports this keyword. -If this is neither @code{nil} nor a number, all mails will be left on -the server. If this is a number, leave mails on the server for this -many days since you first checked new mails. If this is @code{nil} -(the default), mails will be deleted on the server right after fetching. +If this is a number, leave mails on the server for this many days since +you first checked new mails. In that case, mails once fetched will +never be fetched again by the @acronym{UIDL} control. If this is +@code{nil} (the default), mails will be deleted on the server right +after fetching. If this is neither @code{nil} nor a number, all mails +will be left on the server, and you will end up getting the same mails +again and again. @vindex pop3-uidl-file The @code{pop3-uidl-file} variable specifies the file to which the @@ -15400,7 +15420,7 @@ substitutions in the group names), you can say things like: In this example, messages sent to @samp{debian-foo@@lists.debian.org} will be filed in @samp{mail.debian.foo}. -If the string contains the element @samp{\&}, then the previously +If the string contains the element @samp{\\&}, then the previously matched string will be substituted. Similarly, the elements @samp{\\1} up to @samp{\\9} will be substituted with the text matched by the groupings 1 through 9. @@ -16961,7 +16981,7 @@ Some web sites have an RDF Site Summary (@acronym{RSS}). @acronym{RSS} is a format for summarizing headlines from news related sites (such as BBC or CNN). But basically anything list-like can be presented as an @acronym{RSS} feed: weblogs, changelogs or recent -changes to a wiki (e.g., @url{http://cliki.net/recent-changes.rdf}). +changes to a wiki (e.g., @url{http://cliki.net/site/recent-changes}). @acronym{RSS} has a quite regular and nice interface, and it's possible to get the information Gnus needs to keep groups updated. @@ -21091,17 +21111,17 @@ the articles that match this query, and takes you to a summary buffer showing these articles. Articles may then be read, moved and deleted using the usual commands. -The @code{nnir} group made in this way is an @code{ephemeral} group, and -some changes are not permanent: aside from reading, moving, and +The @code{nnir} group made in this way is an @code{ephemeral} group, +and some changes are not permanent: aside from reading, moving, and deleting, you can't act on the original article. But there is an -alternative: you can @emph{warp} to the original group for the article -on the current line with @kbd{A W}, aka +alternative: you can @emph{warp} (i.e., jump) to the original group +for the article on the current line with @kbd{A W}, aka @code{gnus-warp-to-article}. Even better, the function -@code{gnus-summary-refer-thread}, bound by default in summary buffers to -@kbd{A T}, will first warp to the original group before it works its -magic and includes all the articles in the thread. From here you can -read, move and delete articles, but also copy them, alter article marks, -whatever. Go nuts. +@code{gnus-summary-refer-thread}, bound by default in summary buffers +to @kbd{A T}, will first warp to the original group before it works +its magic and includes all the articles in the thread. From here you +can read, move and delete articles, but also copy them, alter article +marks, whatever. Go nuts. You say you want to search more than just the group on the current line? No problem: just process-mark the groups you want to search. You want @@ -21143,6 +21163,7 @@ query language anyway. * The swish++ Engine:: Swish++ configuration and usage. * The swish-e Engine:: Swish-e configuration and usage. * The namazu Engine:: Namazu configuration and usage. +* The notmuch Engine:: Notmuch configuration and usage. * The hyrex Engine:: Hyrex configuration and usage. * Customizations:: User customizable settings. @end menu @@ -21372,6 +21393,26 @@ mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ For maximum searching efficiency you might want to have a cron job run this command periodically, say every four hours. + +@node The notmuch Engine +@subsubsection The notmuch Engine + +@table @code +@item nnir-notmuch-program +The name of the notmuch search executable. Defaults to +@samp{notmuch}. + +@item nnir-notmuch-additional-switches +A list of strings, to be given as additional arguments to notmuch. + +@item nnir-notmuch-remove-prefix +The prefix to remove from each file name returned by notmuch in order +to get a group name (albeit with @samp{/} instead of @samp{.}). This +is a regular expression. + +@end table + + @node The hyrex Engine @subsubsection The hyrex Engine This engine is obsolete. @@ -22957,7 +22998,7 @@ elements on the line is (i.e., the non-info part). If you put additional elements on the mode line (e.g., a clock), you should modify this variable: -@c Hook written by Francesco Potorti` +@c Hook written by Francesco Potortì @lisp (add-hook 'display-time-hook (lambda () (setq gnus-mode-non-string-length @@ -26001,9 +26042,13 @@ following variables. @defvar gnus-registry-track-extra This is a list of symbols, so it's best to change it from the -Customize interface. By default it's @code{(subject sender)}, which -may work for you. It can be annoying if your mail flow is large and -people don't stick to the same groups. +Customize interface. By default it's @code{(subject sender recipient)}, +which may work for you. It can be annoying if your mail flow is large +and people don't stick to the same groups. + +When you decide to stop tracking any of those extra data, you can use +the command @code{gnus-registry-remove-extra-data} to purge it from +the existing registry entries. @end defvar @defvar gnus-registry-split-strategy @@ -26576,7 +26621,7 @@ This version of Gnus should work on: @itemize @bullet @item -Emacs 21.1 and up. +Emacs 23.1 and up. @item XEmacs 21.4 and up. diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index 6cb8942bf15..d23f5d737ae 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -3,13 +3,15 @@ @setfilename ../../info/htmlfontify @settitle Htmlfontify User Manual @exampleindent 2 +@documentencoding UTF-8 @comment %**end of header @copying This manual documents Htmlfontify, a source code -> crosslinked + formatted + syntax colorized html transformer. -Copyright @copyright{} 2002, 2003, 2013 Free Software Foundation, Inc. +Copyright @copyright{} 2002-2003, 2013-2014 Free Software Foundation, +Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -26,7 +28,7 @@ modify this GNU manual.'' @dircategory Emacs misc features @direntry -* Htmlfontify: (htmlfontify). Convert source code to html. +* Htmlfontify: (htmlfontify). Convert source code to html. @end direntry @titlepage @@ -56,7 +58,7 @@ modify this GNU manual.'' @menu * Introduction:: About Htmlfontify. * Usage & Examples:: How to use Htmlfontify. -* Customization:: Fine-tuning Htmlfontify's behaviour. +* Customization:: Fine-tuning Htmlfontify's behavior. * Requirements:: External programs used by Htmlfontify. * GNU Free Documentation License:: The license for this documentation. * Index:: Index of contents. @@ -123,8 +125,8 @@ reproduces the look of the current Emacs buffer as closely as possible. entities, so you should even be able to do html-within-html fontified display. -You should, however, note that random control or eight-bit characters -such as ^L (\x0c) or (\xa4) won't get mapped yet. +You should, however, note that random control or non-ASCII characters +such as ^L (\x0c) or ¤ (\xa4) won't get mapped yet. If the @var{srcdir} and @var{file} arguments are set, lookup etags derived entries in the @ref{hfy-tags-cache} and add html anchors @@ -819,7 +821,7 @@ which @emph{didn't} clash with @var{class} was returned. In versions from 0.18 onwards, each font attribute list is scored, and the non-conflicting list with the highest score is returned. (A specification with a class of @code{t} is considered to match any class you specify. -This matches Emacs's behaviour when deciding on which face attributes to +This matches Emacs's behavior when deciding on which face attributes to use, to the best of my understanding ). If @var{class} is nil, then you just get get whatever @@ -1275,6 +1277,7 @@ normally be applied. @vindex hfy-html-quote-regex @anchor{hfy-html-quote-regex} +@c FIXME: the cross-reference below looks ugly Regex to match (with a single back-reference per match) strings in HTML which should be quoted with @ref{hfy-html-quote} (and @pxref{hfy-html-quote-map}) to make them safe. @@ -1340,31 +1343,6 @@ See also: @ref{hfy-page-footer} String to add to the @samp{.*" - nil t) - (replace-match - (format - "" - org-export-htmlized-org-css-url) - t t))) - (write-file (concat filename ".html"))) - (kill-buffer newbuf))) - (set-buffer-modified-p nil) - (if (equal to-buffer 'string) - (progn (setq str-ret (buffer-string)) - (kill-buffer (current-buffer)) - str-ret) - (kill-buffer (current-buffer)))))) - -(defvar org-archive-location) ;; gets loaded with the org-archive require. -(defun org-get-current-options () - "Return a string with current options as keyword options. -Does include HTML export options as well as TODO and CATEGORY stuff." - (require 'org-archive) - (format - "#+TITLE: %s -#+AUTHOR: %s -#+EMAIL: %s -#+DATE: %s -#+DESCRIPTION: -#+KEYWORDS: -#+LANGUAGE: %s -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s -#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s -%s -#+EXPORT_SELECT_TAGS: %s -#+EXPORT_EXCLUDE_TAGS: %s -#+LINK_UP: %s -#+LINK_HOME: %s -#+XSLT: -#+CATEGORY: %s -#+SEQ_TODO: %s -#+TYP_TODO: %s -#+PRIORITIES: %c %c %c -#+DRAWERS: %s -#+STARTUP: %s %s %s %s %s -#+TAGS: %s -#+FILETAGS: %s -#+ARCHIVE: %s -#+LINK: %s -" - (buffer-name) (user-full-name) user-mail-address - (format-time-string (substring (car org-time-stamp-formats) 1 -1)) - org-export-default-language - org-export-headline-levels - org-export-with-section-numbers - org-export-with-toc - org-export-preserve-breaks - org-export-html-expand - org-export-with-fixed-width - org-export-with-tables - org-export-with-sub-superscripts - org-export-with-special-strings - org-export-with-footnotes - org-export-with-emphasize - org-export-with-timestamps - org-export-with-TeX-macros - org-export-with-LaTeX-fragments - org-export-skip-text-before-1st-heading - org-export-with-drawers - org-export-with-todo-keywords - org-export-with-priority - org-export-with-tags - (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "") - (mapconcat 'identity org-export-select-tags " ") - (mapconcat 'identity org-export-exclude-tags " ") - org-export-html-link-up - org-export-html-link-home - (or (ignore-errors - (file-name-sans-extension - (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) - "NOFILENAME") - "TODO FEEDBACK VERIFY DONE" - "Me Jason Marie DONE" - org-highest-priority org-lowest-priority org-default-priority - (mapconcat 'identity org-drawers " ") - (cdr (assoc org-startup-folded - '((nil . "showall") (t . "overview") (content . "content")))) - (if org-odd-levels-only "odd" "oddeven") - (if org-hide-leading-stars "hidestars" "showstars") - (if org-startup-align-all-tables "align" "noalign") - (cond ((eq org-log-done t) "logdone") - ((equal org-log-done 'note) "lognotedone") - ((not org-log-done) "nologdone")) - (or (mapconcat (lambda (x) - (cond - ((equal :startgroup (car x)) "{") - ((equal :endgroup (car x)) "}") - ((equal :newline (car x)) "") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - (or org-tag-alist (org-get-buffer-tags)) " ") "") - (mapconcat 'identity org-file-tags " ") - org-archive-location - "org file:~/org/%s.org")) - -(defun org-insert-export-options-template () - "Insert into the buffer a template with information for exporting." - (interactive) - (if (not (bolp)) (newline)) - (let ((s (org-get-current-options))) - (and (string-match "#\\+CATEGORY" s) - (setq s (substring s 0 (match-beginning 0)))) - (insert s))) - -(defvar org-table-colgroup-info nil) - -(defun org-table-clean-before-export (lines &optional maybe-quoted) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match - (if maybe-quoted - "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" - "^[ \t]*| *\\([\#!$*_^ /]\\) *|") - x))) - lines)) - ;; No special marking column - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - (t x))) - lines))) - ;; there is a special marking column - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x) - ;; ignore this line - nil) - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and timestamps from lines going into the toc." - (if (not s) - "" ; Return a string when argument is nil - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) - (setq s (replace-match "" t t s))) - s)) - - -(defun org-get-text-property-any (pos prop &optional object) - (or (get-text-property pos prop object) - (and (setq pos (next-single-property-change pos prop object)) - (get-text-property pos prop object)))) - -(defun org-export-get-coderef-format (path desc) - (save-match-data - (if (and desc (string-match - (regexp-quote (concat "(" path ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")))) - -(defun org-export-push-to-kill-ring (format) - "Push buffer content to kill ring. -The depends on the variable `org-export-copy-to-kill-ring'." - (when org-export-copy-to-kill-ring - (org-kill-new (buffer-string)) - (when (fboundp 'x-set-selection) - (ignore-errors (x-set-selection 'PRIMARY (buffer-string))) - (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string)))) - (message "%s export done, pushed to kill ring and clipboard" format))) - -(provide 'org-exp) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-exp.el ends here diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 606db0814c2..f8625f12958 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -1,6 +1,6 @@ ;;; org-faces.el --- Face definitions for Org-mode. -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -202,7 +202,7 @@ set the properties in the `org-column' face. For example, set Under XEmacs, the rules are simpler, because the XEmacs version of column view defines special faces for each outline level. See the file -`org-colview-xemacs.el' for details." +`org-colview-xemacs.el' in Org's contrib/ directory for details." :group 'org-faces) (defface org-column-title @@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file "Face for column display of entry properties." :group 'org-faces) -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (defface org-agenda-column-dateline (org-compatible-face 'org-column '((t nil))) @@ -264,7 +258,7 @@ column view defines special faces for each outline level. See the file '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) (t (:underline t))) - "Face for links." + "Face for footnotes." :group 'org-faces) (defface org-ellipsis @@ -394,6 +388,14 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face"))))) +(defface org-priority ;; originally copied from font-lock-string-face + (org-compatible-face 'font-lock-keyword-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) + "Face used for priority cookies." + :group 'org-faces) + (defcustom org-priority-faces nil "Faces for specific Priorities. This is a list of cons cells, with priority character in the car @@ -685,25 +687,28 @@ month and 365.24 days for a year)." (defface org-agenda-restriction-lock (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 16) (background light)) (:background "yellow1")) - (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) + '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) (t (:inverse-video t)))) "Face for showing the agenda restriction lock." :group 'org-faces) (defface org-agenda-filter-tags - (org-compatible-face 'mode-line - nil) + (org-compatible-face 'mode-line nil) "Face for tag(s) in the mode-line when filtering the agenda." :group 'org-faces) +(defface org-agenda-filter-regexp + (org-compatible-face 'mode-line nil) + "Face for regexp(s) in the mode-line when filtering the agenda." + :group 'org-faces) + (defface org-agenda-filter-category - (org-compatible-face 'mode-line - nil) - "Face for tag(s) in the mode-line when filtering the agenda." + (org-compatible-face 'mode-line nil) + "Face for categories(s) in the mode-line when filtering the agenda." :group 'org-faces) (defface org-time-grid ;; originally copied from font-lock-variable-name-face @@ -718,20 +723,17 @@ month and 365.24 days for a year)." "Face used to show the current time in the time grid.") (defface org-agenda-diary - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used for agenda entries that come from the Emacs diary." :group 'org-faces) (defface org-agenda-calendar-event - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used to show events and appointments in the agenda." :group 'org-faces) (defface org-agenda-calendar-sexp - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used to show events computed from a S-expression." :group 'org-faces) @@ -757,7 +759,7 @@ level org-n-level-faces" :version "24.1" :type 'boolean) -(defface org-latex-and-export-specials +(defface org-latex-and-related (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit underline)) (t '(:underline t))))) @@ -770,8 +772,24 @@ level org-n-level-faces" (((class color) (background dark)) (:foreground "burlywood")) (t (,@font)))) - "Face used to highlight math latex and other special exporter stuff." - :group 'org-faces) + "Face used to highlight LaTeX data, entities and sub/superscript." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-macro + (org-compatible-face 'org-latex-and-related nil) + "Face for macros." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-tag-group + (org-compatible-face 'org-tag nil) + "Face for group tags." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) (org-copy-face 'mode-line 'org-mode-line-clock "Face used for clock display in mode line.") diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 05ead8f0279..6e680718642 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -1,6 +1,6 @@ ;;; org-feed.el --- Add RSS feed items to Org files ;; -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 4cde24bf57f..c8b8c2ea773 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -1,6 +1,6 @@ ;;; org-footnote.el --- Footnote support in Org and elsewhere ;; -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -42,8 +42,6 @@ (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) -(declare-function org-export-preprocess-string "org-exp" - (string &rest parameters)) (declare-function org-fill-paragraph "org" (&optional justify)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-id-uuid "org-id" ()) @@ -87,7 +85,7 @@ "Regular expression matching the definition of a footnote.") (defconst org-footnote-forbidden-blocks - '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src") + '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") "Names of blocks where footnotes are not allowed.") (defgroup org-footnote nil @@ -96,15 +94,19 @@ :group 'org) (defcustom org-footnote-section "Footnotes" - "Outline heading containing footnote definitions before export. -This can be nil, to place footnotes locally at the end of the current -outline node. If can also be the name of a special outline heading -under which footnotes should be put. + "Outline heading containing footnote definitions. + +This can be nil, to place footnotes locally at the end of the +current outline node. If can also be the name of a special +outline heading under which footnotes should be put. + This variable defines the place where Org puts the definition -automatically, i.e. when creating the footnote, and when sorting the notes. -However, by hand you may place definitions *anywhere*. -If this is a string, during export, all subtrees starting with this -heading will be removed after extracting footnote definitions." +automatically, i.e. when creating the footnote, and when sorting +the notes. However, by hand you may place definitions +*anywhere*. + +If this is a string, during export, all subtrees starting with +this heading will be ignored." :group 'org-footnote :type '(choice (string :tag "Collect footnotes under heading") @@ -136,13 +138,13 @@ will be used to define the footnote at the reference position." "Non-nil means define automatically new labels for footnotes. Possible values are: -nil prompt the user for each label -t create unique labels of the form [fn:1], [fn:2], ... -confirm like t, but let the user edit the created value. In particular, - the label can be removed from the minibuffer, to create +nil Prompt the user for each label. +t Create unique labels of the form [fn:1], [fn:2], etc. +confirm Like t, but let the user edit the created value. + The label can be removed from the minibuffer to create an anonymous footnote. random Automatically generate a unique, random label. -plain Automatically create plain number labels like [1]" +plain Automatically create plain number labels like [1]." :group 'org-footnote :type '(choice (const :tag "Prompt for label" nil) @@ -164,6 +166,7 @@ The main values of this variable can be set with in-buffer options: #+STARTUP: nofnadjust" :group 'org-footnote :type '(choice + (const :tag "No adjustment" nil) (const :tag "Renumber" renumber) (const :tag "Sort" sort) (const :tag "Renumber and Sort" t))) @@ -182,8 +185,6 @@ extracted will be filled again." (not (or (org-in-commented-line) (org-in-indented-comment-line) (org-inside-LaTeX-fragment-p) - ;; Avoid protected environments (LaTeX export) - (get-text-property (point) 'org-protected) ;; Avoid literal example. (org-in-verbatim-emphasis) (save-excursion @@ -230,13 +231,7 @@ positions, and the definition, when inlined." (org-in-regexp org-bracket-link-regexp)))) (and linkp (< (point) (cdr linkp)))))) ;; Verify point doesn't belong to a LaTeX macro. - ;; Beware though, when two footnotes are side by - ;; side, once the first one is changed into LaTeX, - ;; the second one might then be considered as an - ;; optional argument of the command. Thus, check - ;; the `org-protected' property of that command. - (or (not (org-inside-latex-macro-p)) - (get-text-property (1- beg) 'org-protected))) + (not (org-inside-latex-macro-p))) (list label beg end ;; Definition: ensure this is an inline footnote first. (and (or (not label) (match-string 1)) @@ -257,11 +252,12 @@ otherwise." (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p)) (save-excursion (end-of-line) - ;; Footnotes definitions are separated by new headlines or blank - ;; lines. - (let ((lim (save-excursion (re-search-backward - (concat org-outline-regexp-bol - "\\|^[ \t]*$") nil t)))) + ;; Footnotes definitions are separated by new headlines, another + ;; footnote definition or 2 blank lines. + (let ((lim (save-excursion + (re-search-backward + (concat org-outline-regexp-bol + "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) (when (re-search-backward org-footnote-definition-re lim t) (let ((label (org-match-string-no-properties 1)) (beg (match-beginning 0)) @@ -277,7 +273,7 @@ otherwise." (re-search-forward (concat org-outline-regexp-bol "\\|" org-footnote-definition-re "\\|" - "^[ \t]*$") bound 'move)) + "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) (match-beginning 0) (point))))) (list label beg end @@ -602,38 +598,15 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-previous-reference (car tmp))) (t (org-footnote-new))))) -(defvar org-footnote-insert-pos-for-preprocessor 'point-max - "See `org-footnote-normalize'.") - -(defvar org-export-footnotes-seen) ; silence byte-compiler -(defvar org-export-footnotes-data) ; silence byte-compiler - ;;;###autoload -(defun org-footnote-normalize (&optional sort-only export-props) +(defun org-footnote-normalize (&optional sort-only) "Collect the footnotes in various formats and normalize them. This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format that is understood by the -Org-mode exporters. +normalizes them to the usual [N] format. When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence. - -If Org is amidst an export process, EXPORT-PROPS will hold the -export properties of the buffer. - -When EXPORT-PROPS is non-nil, the default action is to insert -normalized footnotes towards the end of the pre-processing -buffer. Some exporters (docbook, odt...) expect footnote -definitions to be available before any references to them. Such -exporters can let bind `org-footnote-insert-pos-for-preprocessor' -to symbol `point-min' to achieve the desired behaviour. - -Additional note on `org-footnote-insert-pos-for-preprocessor': -1. This variable has not effect when FOR-PREPROCESSOR is nil. -2. This variable (potentially) obviates the need for extra scan - of pre-processor buffer as witnessed in - `org-export-docbook-get-footnotes'." +referenced sequence." ;; This is based on Paul's function, but rewritten. ;; ;; Re-create `org-with-limited-levels', but not limited to Org @@ -643,17 +616,12 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': org-inlinetask-min-level (1- org-inlinetask-min-level))) (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) + (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (org-outline-regexp (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - ;; Determine the highest marker used so far. - (ref-table (when export-props org-export-footnotes-seen)) - (count (if (and export-props ref-table) - (apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table)) - 0)) - ins-point ref) + (count 0) + ins-point ref ref-table) (save-excursion ;; 1. Find every footnote reference, extract the definition, and ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also @@ -675,15 +643,10 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; Replace footnote reference with [MARKER]. Maybe fill ;; paragraph once done. If SORT-ONLY is non-nil, only move ;; to the end of reference found to avoid matching it twice. - ;; If EXPORT-PROPS isn't nil, also add `org-footnote' - ;; property to it, so it can be easily recognized by - ;; exporters. (if sort-only (goto-char (nth 2 ref)) (delete-region (nth 1 ref) (nth 2 ref)) (goto-char (nth 1 ref)) - (let ((new-ref (format "[%d]" marker))) - (when export-props (org-add-props new-ref '(org-footnote t))) - (insert new-ref)) + (insert (format "[%d]" marker)) (and inlinep org-footnote-fill-after-inline-note-extraction (org-fill-paragraph))) @@ -691,22 +654,9 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; type (INLINEP) and position (POS) to REF-TABLE if data ;; was unknown. (unless a - (let ((def (or (nth 3 ref) ; inline - (and export-props - (cdr (assoc lbl org-export-footnotes-data))) + (let ((def (or (nth 3 ref) ; Inline definition. (nth 3 (org-footnote-get-definition lbl))))) - (push (list lbl marker - ;; When exporting, each definition goes - ;; through `org-export-preprocess-string' so - ;; it is ready to insert in the - ;; backend-specific buffer. - (if (and export-props def) - (let ((parameters - (org-combine-plists - export-props - '(:todo-keywords t :tags t :priority t)))) - (apply #'org-export-preprocess-string def parameters)) - def) + (push (list lbl marker def ;; Reference beginning position is a marker ;; to preserve it during further buffer ;; modifications. @@ -728,14 +678,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (unless (bolp) (newline))) ;; No footnote section set: Footnotes will be added at the end ;; of the section containing their first reference. - ;; Nevertheless, in an export situation, set insertion point to - ;; `point-max' by default. - ((derived-mode-p 'org-mode) - (when export-props - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (forward-line) - (delete-region (point) (point-max)))) + ((derived-mode-p 'org-mode)) (t ;; Remove any left-over tag in the buffer, if one is set up. (when org-footnote-tag-for-non-org-mode-files @@ -753,14 +696,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (re-search-backward message-signature-separator nil t)) (beginning-of-line) (goto-char (point-max))))) - ;; During export, `org-footnote-insert-pos-for-preprocessor' has - ;; precedence over previously found position. - (setq ins-point - (copy-marker - (if (and export-props - (eq org-footnote-insert-pos-for-preprocessor 'point-min)) - (point-min) - (point)))) + (setq ins-point (point-marker)) ;; 3. Clean-up REF-TABLE. (setq ref-table (delq nil @@ -791,26 +727,22 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; No footnote: exit. ((not ref-table)) ;; Cases when footnotes should be inserted in one place. - ((or (not (derived-mode-p 'org-mode)) - org-footnote-section - export-props) + ((or (not (derived-mode-p 'org-mode)) org-footnote-section) ;; Insert again the section title, if any. Ensure that title, ;; or the subsequent footnotes, will be separated by a blank ;; lines from the rest of the document. In an Org buffer, ;; separate section with a blank line, unless explicitly ;; stated in `org-blank-before-new-entry'. - (cond - ((not (derived-mode-p 'org-mode)) - (skip-chars-backward " \t\n\r") - (delete-region (point) ins-point) - (unless (bolp) (newline)) - (when org-footnote-tag-for-non-org-mode-files - (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) - ((and org-footnote-section (not export-props)) + (if (not (derived-mode-p 'org-mode)) + (progn (skip-chars-backward " \t\n\r") + (delete-region (point) ins-point) + (unless (bolp) (newline)) + (when org-footnote-tag-for-non-org-mode-files + (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) (when (and (cdr (assq 'heading org-blank-before-new-entry)) (zerop (save-excursion (org-back-over-empty-lines)))) (insert "\n")) - (insert "* " org-footnote-section "\n"))) + (insert "* " org-footnote-section "\n")) (set-marker ins-point nil) ;; Insert the footnotes, separated by a blank line. (insert @@ -820,10 +752,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (set-marker (nth 4 x) nil) (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) ref-table "\n")) - (unless (eobp) (insert "\n\n")) - ;; When exporting, add newly inserted markers along with their - ;; associated definition to `org-export-footnotes-seen'. - (when export-props (setq org-export-footnotes-seen ref-table))) + (unless (eobp) (insert "\n\n"))) ;; Each footnote definition has to be inserted at the end of ;; the section where its first reference belongs. (t diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el deleted file mode 100644 index c33b70224fa..00000000000 --- a/lisp/org/org-freemind.el +++ /dev/null @@ -1,1226 +0,0 @@ -;;; org-freemind.el --- Export Org files to freemind - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; -------------------------------------------------------------------- -;; Features that might be required by this library: -;; -;; `backquote', `bytecomp', `cl', `easymenu', `font-lock', -;; `noutline', `org', `org-compat', `org-faces', `org-footnote', -;; `org-list', `org-macs', `org-src', `outline', `syntax', -;; `time-date', `xml'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; This file tries to implement some functions useful for -;; transformation between org-mode and FreeMind files. -;; -;; Here are the commands you can use: -;; -;; M-x `org-freemind-from-org-mode' -;; M-x `org-freemind-from-org-mode-node' -;; M-x `org-freemind-from-org-sparse-tree' -;; -;; M-x `org-freemind-to-org-mode' -;; -;; M-x `org-freemind-show' -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; 2009-02-15: Added check for next level=current+1 -;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'. -;; 2009-10-25: Added support for `org-odd-levels-only'. -;; Added y/n question before showing in FreeMind. -;; 2009-11-04: Added support for #+BEGIN_HTML. -;; -;;; Code: - -(require 'xml) -(require 'org) - ;(require 'rx) -(require 'org-exp) -(eval-when-compile (require 'cl)) - -(defgroup org-freemind nil - "Customization group for org-freemind export/import." - :group 'org) - -;; Fix-me: I am not sure these are useful: -;; -;; (defcustom org-freemind-main-fgcolor "black" -;; "Color of main node's text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-main-color "black" -;; "Background color of main node." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-fgcolor "black" -;; "Color of child nodes' text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-color "black" -;; "Background color of child nodes." -;; :type 'color -;; :group 'org-freemind) - -(defvar org-freemind-node-style nil "Internal use.") - -(defcustom org-freemind-node-styles nil - "Styles to apply to node. -NOT READY YET." - :type '(repeat - (list :tag "Node styles for file" - (regexp :tag "File name") - (repeat - (list :tag "Node" - (regexp :tag "Node name regexp") - (set :tag "Node properties" - (list :format "%v" (const :format "" node-style) - (choice :tag "Style" - :value bubble - (const bubble) - (const fork))) - (list :format "%v" (const :format "" color) - (color :tag "Color" :value "red")) - (list :format "%v" (const :format "" background-color) - (color :tag "Background color" :value "yellow")) - (list :format "%v" (const :format "" edge-color) - (color :tag "Edge color" :value "green")) - (list :format "%v" (const :format "" edge-style) - (choice :tag "Edge style" :value bezier - (const :tag "Linear" linear) - (const :tag "Bezier" bezier) - (const :tag "Sharp Linear" sharp-linear) - (const :tag "Sharp Bezier" sharp-bezier))) - (list :format "%v" (const :format "" edge-width) - (choice :tag "Edge width" :value thin - (const :tag "Parent" parent) - (const :tag "Thin" thin) - (const 1) - (const 2) - (const 4) - (const 8))) - (list :format "%v" (const :format "" italic) - (const :tag "Italic font" t)) - (list :format "%v" (const :format "" bold) - (const :tag "Bold font" t)) - (list :format "%v" (const :format "" font-name) - (string :tag "Font name" :value "SansSerif")) - (list :format "%v" (const :format "" font-size) - (integer :tag "Font size" :value 12))))))) - :group 'org-freemind) - -;;;###autoload -(defun org-export-as-freemind (&optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the current buffer as a Freemind file. -If there is an active region, export only the region. HIDDEN is -obsolete and does nothing. EXT-PLIST is a property list with -external parameters overriding org-mode's default settings, but -still inferior to file-local settings. When TO-BUFFER is -non-nil, create a buffer with that name and export to that -buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind but just return the resulting HTML as a string. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of the document (all top level -sections). When PUB-DIR is set, use this as the publishing -directory. - -See `org-freemind-from-org-mode' for more information." - (interactive "P") - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :ascii opt-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".mm"))) - (when (file-exists-p filename) - (delete-file filename)) - (cond - (subtree-p - (org-freemind-from-org-mode-node (line-number-at-pos rbeg) - filename)) - (t (org-freemind-from-org-mode bfname filename))))) - -;;;###autoload -(defun org-freemind-show (mm-file) - "Show file MM-FILE in Freemind." - (interactive - (list - (save-match-data - (let ((name (read-file-name "FreeMind file: " - nil nil nil - (if (buffer-file-name) - (let* ((name-ext (file-name-nondirectory (buffer-file-name))) - (name (file-name-sans-extension name-ext)) - (ext (file-name-extension name-ext))) - (cond - ((string= "mm" ext) - name-ext) - ((string= "org" ext) - (let ((name-mm (concat name ".mm"))) - (if (file-exists-p name-mm) - name-mm - (message "Not exported to Freemind format yet") - ""))) - (t - ""))) - "") - ;; Fix-me: Is this an Emacs bug? - ;; This predicate function is never - ;; called. - (lambda (fn) - (string-match "^mm$" (file-name-extension fn)))))) - (setq name (expand-file-name name)) - name)))) - (org-open-file mm-file)) - -(defconst org-freemind-org-nfix "--org-mode: ") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format converters - -(defun org-freemind-escape-str-from-org (org-str) - "Do some html-escaping of ORG-STR and return the result. -The characters \"&<> will be escaped." - (let ((chars (append org-str nil)) - (fm-str "")) - (dolist (cc chars) - (setq fm-str - (concat fm-str - (if (< cc 160) - (cond - ((= cc ?\") """) - ((= cc ?\&) "&") - ((= cc ?\<) "<") - ((= cc ?\>) ">") - (t (char-to-string cc))) - ;; Formatting as &#number; is maybe needed - ;; according to a bug report from kazuo - ;; fujimoto, but I have now instead added a xml - ;; processing instruction saying that the mm - ;; file is utf-8: - ;; - ;; (format "&#x%x;" (- cc ;; ?\x800)) - (format "&#x%x;" (encode-char cc 'ucs)) - )))) - fm-str)) - -;;(org-freemind-unescape-str-to-org "mA≌B<C<=") -;;(org-freemind-unescape-str-to-org "<<") -(defun org-freemind-unescape-str-to-org (fm-str) - "Do some html-unescaping of FM-STR and return the result. -This is the opposite of `org-freemind-escape-str-from-org' but it -will also unescape &#nn;." - (let ((org-str fm-str)) - (setq org-str (replace-regexp-in-string """ "\"" org-str)) - (setq org-str (replace-regexp-in-string "&" "&" org-str)) - (setq org-str (replace-regexp-in-string "<" "<" org-str)) - (setq org-str (replace-regexp-in-string ">" ">" org-str)) - (setq org-str (replace-regexp-in-string - "&#x\\([a-f0-9]\\{2,4\\}\\);" - (lambda (m) - (char-to-string - (+ (string-to-number (match-string 1 m) 16) - 0 ;?\x800 ;; What is this for? Encoding? - ))) - org-str)))) - -;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: ") -;; (str2 (org-freemind-escape-str-from-org str1)) -;; (str3 (org-freemind-unescape-str-to-org str2))) -;; (unless (string= str1 str3) -;; (error "Error str3=%s" str3))) - -(defun org-freemind-convert-links-helper (matched) - "Helper for `org-freemind-convert-links-from-org'. -MATCHED is the link just matched." - (let* ((link (match-string 1 matched)) - (text (match-string 2 matched)) - (ext (file-name-extension link)) - (col-pos (org-string-match-p ":" link)) - (is-img (and (image-type-from-file-name link) - (let ((url-type (substring link 0 col-pos))) - (member url-type '("file" "http" "https"))))) - ) - (if is-img - ;; Fix-me: I can't find a way to get the border to "shrink - ;; wrap" around the image using
          . - ;; - ;; (concat "
          " - ;; "\""" - ;; "
          " - ;; "" text "" - ;; "
          ") - (concat "
          " - "\""" - "
          " - "" text "" - "
          ") - (concat "" text "")))) - -(defun org-freemind-convert-links-from-org (org-str) - "Convert org links in ORG-STR to freemind links and return the result." - (let ((fm-str (replace-regexp-in-string - ;;(rx (not (any "[\"")) - ;; (submatch - ;; "http" - ;; (opt ?\s) - ;; "://" - ;; (1+ - ;; (any "-%.?@a-zA-Z0-9()_/:~=&#")))) - "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)" - "[[\\1][\\1]]" - org-str - nil ;; fixedcase - nil ;; literal - 1 ;; subexp - ))) - (replace-regexp-in-string - ;;(rx "[[" - ;; (submatch (*? nonl)) - ;; "][" - ;; (submatch (*? nonl)) - ;; "]]") - "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" - ;;"\\2" - 'org-freemind-convert-links-helper - fm-str t t))) - -;;(org-freemind-convert-links-to-org "link-text") -(defun org-freemind-convert-links-to-org (fm-str) - "Convert freemind links in FM-STR to org links and return the result." - (let ((org-str (replace-regexp-in-string - ;;(rx ""))) - ;; space) - ;; "href=\"" - ;; (submatch (0+ (not (any "\"")))) - ;; "\"" - ;; (0+ (not (any ">"))) - ;; ">" - ;; (submatch (0+ (not (any "<")))) - ;; "") - "]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)" - "[[\\1][\\2]]" - fm-str))) - org-str)) - -;; Fix-me: -;;(defun org-freemind-convert-drawers-from-org (text) -;; ) - -;; (let* ((str1 "[[http://www.somewhere/][link-text]") -;; (str2 (org-freemind-convert-links-from-org str1)) -;; (str3 (org-freemind-convert-links-to-org str2))) -;; (unless (string= str1 str3) -;; (error "Error str3=%s" str3))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Org => FreeMind - -(defvar org-freemind-bol-helper-base-indent nil) - -(defun org-freemind-bol-helper (matched) - "Helper for `org-freemind-convert-text-p'. -MATCHED is the link just matched." - (let ((res "") - (bi org-freemind-bol-helper-base-indent)) - (dolist (cc (append matched nil)) - (if (= 32 cc) - ;;(setq res (concat res " ")) - ;; We need to use the numerical version. Otherwise Freemind - ;; ver 0.9.0 RC9 can not export to html/javascript. - (progn - (if (< 0 bi) - (setq bi (1- bi)) - (setq res (concat res " ")))) - (setq res (concat res (char-to-string cc))))) - res)) -;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n ")) - -(defun org-freemind-convert-text-p (text) - "Convert TEXT to html with

          paragraphs." - ;; (string-match-p "[^ ]" " a") - (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text)) - (setq text (org-freemind-escape-str-from-org text)) - - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1\\3\\5" text)) - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1\\3\\5" text)) - - (setq text (concat "

          " text)) - (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "

          " text)) - (setq text (replace-regexp-in-string "\\(?:

          \\|\n\\) +" 'org-freemind-bol-helper text)) - (setq text (replace-regexp-in-string "\n" "
          " text)) - (setq text (concat text "

          ")) - - (org-freemind-convert-links-from-org text)) - -(defcustom org-freemind-node-css-style - "p { margin-top: 3px; margin-bottom: 3px; }" - "CSS style for Freemind nodes." - ;; Fix-me: I do not understand this. It worked to export from Freemind - ;; with this setting now, but not before??? Was this perhaps a java - ;; bug or is it a windows xp bug (some resource gets exhausted if you - ;; use sticky keys which I do). - :version "24.1" - :group 'org-freemind) - -(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) - "Convert text part of org node to freemind subnode or note. -Convert the text part of the org node named NODE-NAME. The text -is in the current buffer between START and END. Drawers matching -DRAWERS-REGEXP are converted to freemind notes." - ;; fix-me: doc - (let ((text (buffer-substring-no-properties start end)) - (node-res "") - (note-res "")) - (save-match-data - ;;(setq text (org-freemind-escape-str-from-org text)) - ;; First see if there is something that should be moved to the - ;; note part: - (let (drawers) - (while (string-match drawers-regexp text) - (setq drawers (cons (match-string 0 text) drawers)) - (setq text - (concat (substring text 0 (match-beginning 0)) - (substring text (match-end 0)))) - ) - (when drawers - (dolist (drawer drawers) - (let ((lines (split-string drawer "\n"))) - (dolist (line lines) - (setq note-res (concat - note-res - org-freemind-org-nfix line "
          \n"))) - )))) - - (when (> (length note-res) 0) - (setq note-res (concat - "\n" - "\n" - "\n" - "\n" - note-res - "\n" - "\n" - "\n"))) - - ;; There is always an LF char: - (when (> (length text) 1) - (setq node-res (concat - "\n" - "\n" - "\n" - (if (= 0 (length org-freemind-node-css-style)) - "" - (concat - "\n")) - "\n" - "\n")) - (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML")) - (end-html-mark (regexp-quote "#+END_HTML")) - head - end-pos - end-pos-match - ) - ;; Take care of #+BEGIN_HTML - #+END_HTML - (while (string-match begin-html-mark text) - (setq head (substring text 0 (match-beginning 0))) - (setq end-pos-match (match-end 0)) - (setq node-res (concat node-res - (org-freemind-convert-text-p head))) - (setq text (substring text end-pos-match)) - (setq end-pos (string-match end-html-mark text)) - (if end-pos - (setq end-pos-match (match-end 0)) - (message "org-freemind: Missing #+END_HTML") - (setq end-pos (length text)) - (setq end-pos-match end-pos)) - (setq node-res (concat node-res - (substring text 0 end-pos))) - (setq text (substring text end-pos-match))) - (setq node-res (concat node-res - (org-freemind-convert-text-p text)))) - (setq node-res (concat - node-res - "\n" - "\n" - "\n" - ;; Put a note that this is for the parent node - ;; "" - ;; "" - ;; "" - ;; "" - ;; "

          " - ;; "-- This is more about \"" node-name "\" --" - ;; "

          " - ;; "" - ;; "" - ;; "
          \n" - note-res - "
          \n" ;; ok - ))) - (list node-res note-res)))) - -(defun org-freemind-write-node (mm-buffer drawers-regexp - num-left-nodes base-level - current-level next-level this-m2 - this-node-end - this-children-visible - next-node-start - next-has-some-visible-child) - (let* (this-icons - this-bg-color - this-m2-link - this-m2-escaped - this-rich-node - this-rich-note - ) - (when (string-match "TODO" this-m2) - (setq this-m2 (replace-match "" nil nil this-m2)) - (add-to-list 'this-icons "button_cancel") - (setq this-bg-color "#ffff88") - (when (string-match "\\[#\\(.\\)\\]" this-m2) - (let ((prior (string-to-char (match-string 1 this-m2)))) - (setq this-m2 (replace-match "" nil nil this-m2)) - (cond - ((= prior ?A) - (add-to-list 'this-icons "full-1") - (setq this-bg-color "#ff0000")) - ((= prior ?B) - (add-to-list 'this-icons "full-2") - (setq this-bg-color "#ffaa00")) - ((= prior ?C) - (add-to-list 'this-icons "full-3") - (setq this-bg-color "#ffdd00")) - ((= prior ?D) - (add-to-list 'this-icons "full-4") - (setq this-bg-color "#ffff00")) - ((= prior ?E) - (add-to-list 'this-icons "full-5")) - ((= prior ?F) - (add-to-list 'this-icons "full-6")) - ((= prior ?G) - (add-to-list 'this-icons "full-7")) - )))) - (setq this-m2 (org-trim this-m2)) - (when (string-match org-bracket-link-analytic-regexp this-m2) - (setq this-m2-link (concat "link=\"" (match-string 1 this-m2) - (match-string 3 this-m2) "\" ") - this-m2 (replace-match "\\5" nil nil this-m2 0))) - (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2)) - (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note - this-m2-escaped - this-node-end - (1- next-node-start) - drawers-regexp))) - (setq this-rich-node (nth 0 node-notes)) - (setq this-rich-note (nth 1 node-notes))) - (with-current-buffer mm-buffer - (insert " next-level current-level) - (unless (or this-children-visible - next-has-some-visible-child) - (insert " folded=\"true\""))) - (when (and (= current-level (1+ base-level)) - (> num-left-nodes 0)) - (setq num-left-nodes (1- num-left-nodes)) - (insert " position=\"left\"")) - (when this-bg-color - (insert " background_color=\"" this-bg-color "\"")) - (insert ">\n") - (when this-icons - (dolist (icon this-icons) - (insert "\n"))) - ) - (with-current-buffer mm-buffer - ;;(when this-rich-note (insert this-rich-note)) - (when this-rich-node (insert this-rich-node)))) - num-left-nodes) - -(defun org-freemind-check-overwrite (file interactively) - "Check if file FILE already exists. -If FILE does not exists return t. - -If INTERACTIVELY is non-nil ask if the file should be replaced -and return t/nil if it should/should not be replaced. - -Otherwise give an error say the file exists." - (if (file-exists-p file) - (if interactively - (y-or-n-p (format "File %s exists, replace it? " file)) - (error "File %s already exists" file)) - t)) - -(defvar org-freemind-node-pattern - ;;(rx bol - ;; (submatch (1+ "*")) - ;; (1+ space) - ;; (submatch (*? nonl)) - ;; eol) - "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$") - -(defun org-freemind-look-for-visible-child (node-level) - (save-excursion - (save-match-data - (let ((found-visible-child nil)) - (while (and (not found-visible-child) - (re-search-forward org-freemind-node-pattern nil t)) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (>= node-level level) - (setq found-visible-child 'none) - (unless (get-char-property (line-beginning-position) 'invisible) - (setq found-visible-child 'found))))) - (eq found-visible-child 'found) - )))) - -(defun org-freemind-goto-line (line) - "Go to line number LINE." - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)))) - -(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line) - (with-current-buffer org-buffer - (dolist (node-style org-freemind-node-styles) - (when (org-string-match-p (car node-style) buffer-file-name) - (setq org-freemind-node-style (cadr node-style)))) - ;;(message "org-freemind-node-style =%s" org-freemind-node-style) - (save-match-data - (let* ((drawers (copy-sequence org-drawers)) - drawers-regexp - (num-top1-nodes 0) - (num-top2-nodes 0) - num-left-nodes - (unclosed-nodes 0) - (odd-only org-odd-levels-only) - (first-time t) - (current-level 1) - base-level - prev-node-end - rich-text - unfinished-tag - node-at-line-level - node-at-line-last) - (with-current-buffer mm-buffer - (erase-buffer) - (setq buffer-file-coding-system 'utf-8) - ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this: - ;;(insert "\n") - (insert "\n") - (insert "\n")) - (save-excursion - ;; Get special buffer vars: - (goto-char (point-min)) - (message "Writing Freemind file...") - (while (re-search-forward "^#\\+DRAWERS:" nil t) - (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position)))) - (setq drawers (append drawers (split-string dr-txt) nil)))) - (setq drawers-regexp - (concat "^[[:blank:]]*:" - (regexp-opt drawers) - ;;(rx ":" (0+ blank) - ;; "\n" - ;; (*? anything) - ;; "\n" - ;; (0+ blank) - ;; ":END:" - ;; (0+ blank) - ;; eol) - ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$" - )) - - (if node-at-line - ;; Get number of top nodes and last line for this node - (progn - (org-freemind-goto-line node-at-line) - (unless (looking-at org-freemind-node-pattern) - (error "No node at line %s" node-at-line)) - (setq node-at-line-level (length (match-string-no-properties 1))) - (forward-line) - (setq node-at-line-last - (catch 'last-line - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (<= level node-at-line-level) - (progn - (beginning-of-line) - (throw 'last-line (1- (point)))) - (if (= level (1+ node-at-line-level)) - (setq num-top2-nodes (1+ num-top2-nodes)))))))) - (setq current-level node-at-line-level) - (setq num-top1-nodes 1) - (org-freemind-goto-line node-at-line)) - - ;; First get number of top nodes - (goto-char (point-min)) - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (= level 1) - (setq num-top1-nodes (1+ num-top1-nodes)) - (if (= level 2) - (setq num-top2-nodes (1+ num-top2-nodes)))))) - ;; If there is more than one top node we need to insert a node - ;; to keep them together. - (goto-char (point-min)) - (when (> num-top1-nodes 1) - (setq num-top2-nodes num-top1-nodes) - (setq current-level 0) - (let ((orig-name (if buffer-file-name - (file-name-nondirectory (buffer-file-name)) - (buffer-name)))) - (with-current-buffer mm-buffer - (insert "\n" - ;; Put a note that this is for the parent node - "" - "" - "" - "" - "

          " - org-freemind-org-nfix "WHOLE FILE" - "

          " - "" - "" - "
          \n"))))) - - (setq num-left-nodes (floor num-top2-nodes 2)) - (setq base-level current-level) - (let (this-m2 - this-node-end - this-children-visible - next-m2 - next-node-start - next-level - next-has-some-visible-child - next-children-visible - ) - (while (and - (re-search-forward org-freemind-node-pattern nil t) - (if node-at-line-last (<= (point) node-at-line-last) t) - ) - (let* ((next-m1 (match-string-no-properties 1)) - (next-node-end (match-end 0)) - ) - (setq next-node-start (match-beginning 0)) - (setq next-m2 (match-string-no-properties 2)) - (setq next-level (length next-m1)) - (setq next-children-visible - (not (eq 'outline - (get-char-property (line-end-position) 'invisible)))) - (setq next-has-some-visible-child - (if next-children-visible t - (org-freemind-look-for-visible-child next-level))) - (when this-m2 - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))) - (when (if (= num-top1-nodes 1) (> current-level base-level) t) - (while (>= current-level next-level) - (with-current-buffer mm-buffer - (insert "
          \n") - (setq current-level - (- current-level (if odd-only 2 1)))))) - (setq this-node-end (1+ next-node-end)) - (setq this-m2 next-m2) - (setq current-level next-level) - (setq this-children-visible next-children-visible) - (forward-char) - )) -;;; (unless (if node-at-line-last -;;; (>= (point) node-at-line-last) -;;; nil) - ;; Write last node: - (setq this-m2 next-m2) - (setq current-level next-level) - (setq next-node-start (if node-at-line-last - (1+ node-at-line-last) - (point-max))) - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) - (with-current-buffer mm-buffer (insert "
          \n")) - ;) - ) - (with-current-buffer mm-buffer - (while (> current-level base-level) - (insert "\n") - (setq current-level - (- current-level (if odd-only 2 1))) - )) - (with-current-buffer mm-buffer - (insert "") - (delete-trailing-whitespace) - (goto-char (point-min)) - )))))) - -(defun org-freemind-get-node-style (node-name) - "NOT READY YET." - ;; - ;; - (let (node-styles - node-style) - (dolist (style-list org-freemind-node-style) - (let ((node-regexp (car style-list))) - (message "node-regexp=%s node-name=%s" node-regexp node-name) - (when (org-string-match-p node-regexp node-name) - ;;(setq node-style (org-freemind-do-apply-node-style style-list)) - (setq node-style (cadr style-list)) - (when node-style - (message "node-style=%s" node-style) - (setq node-styles (append node-styles node-style))) - ))))) - -(defun org-freemind-do-apply-node-style (style-list) - (message "style-list=%S" style-list) - (let ((node-style 'fork) - (color "red") - (background-color "yellow") - (edge-color "green") - (edge-style 'bezier) - (edge-width 'thin) - (italic t) - (bold t) - (font-name "SansSerif") - (font-size 12)) - (dolist (style (cadr style-list)) - (message " style=%s" style) - (let ((what (car style))) - (cond - ((eq what 'node-style) - (setq node-style (cadr style))) - ((eq what 'color) - (setq color (cadr style))) - ((eq what 'background-color) - (setq background-color (cadr style))) - - ((eq what 'edge-color) - (setq edge-color (cadr style))) - - ((eq what 'edge-style) - (setq edge-style (cadr style))) - - ((eq what 'edge-width) - (setq edge-width (cadr style))) - - ((eq what 'italic) - (setq italic (cadr style))) - - ((eq what 'bold) - (setq bold (cadr style))) - - ((eq what 'font-name) - (setq font-name (cadr style))) - - ((eq what 'font-size) - (setq font-size (cadr style))) - ) - (insert (format " style=\"%s\"" node-style)) - (insert (format " color=\"%s\"" color)) - (insert (format " background_color=\"%s\"" background-color)) - (insert ">\n") - (insert "\n") - (insert " Org - -;; (sort '(b a c) 'org-freemind-lt-symbols) -(defun org-freemind-lt-symbols (sym-a sym-b) - (string< (symbol-name sym-a) (symbol-name sym-b))) -;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs) -(defun org-freemind-lt-xml-attrs (attr-a attr-b) - (string< (symbol-name (car attr-a)) (symbol-name (car attr-b)))) - -;; xml-parse-region gives things like -;; ((p nil "\n" -;; (a -;; ((href . "link")) -;; "text") -;; "\n" -;; (b nil "hej") -;; "\n")) - -;; '(a . nil) - -;; (org-freemind-symbols= 'a (car '(A B))) -(defsubst org-freemind-symbols= (sym-a sym-b) - "Return t if downcased names of SYM-A and SYM-B are equal. -SYM-A and SYM-B should be symbols." - (or (eq sym-a sym-b) - (string= (downcase (symbol-name sym-a)) - (downcase (symbol-name sym-b))))) - -(defun org-freemind-get-children (parent path) - "Find children node to PARENT from PATH. -PATH should be a list of steps, where each step has the form - - '(NODE-NAME (ATTR-NAME . ATTR-VALUE))" - ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val - ;; Fix-me: case insensitive version for children? - (let* ((children (if (not (listp (car parent))) - (cddr parent) - (let (cs) - (dolist (p parent) - (dolist (c (cddr p)) - (add-to-list 'cs c))) - cs) - )) - (step (car path)) - (step-node (if (listp step) (car step) step)) - (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs))) - (path-tail (cdr path)) - path-children) - (dolist (child children) - ;; skip xml.el formatting nodes - (unless (stringp child) - ;; compare node name - (when (if (not step-node) - t ;; any node name - (org-freemind-symbols= step-node (car child))) - (if (not step-attr-list) - ;;(throw 'path-child child) ;; no attr to care about - (add-to-list 'path-children child) - (let* ((child-attr-list (cadr child)) - (step-attr-copy (copy-sequence step-attr-list))) - (dolist (child-attr child-attr-list) - ;; Compare attr names: - (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr)) - ;; Compare values: - (let ((step-val (cdar step-attr-copy)) - (child-val (cdr child-attr))) - (when (if (not step-val) - t ;; any value - (string= step-val child-val)) - (setq step-attr-copy (cdr step-attr-copy)))))) - ;; Did we find all? - (unless step-attr-copy - ;;(throw 'path-child child) - (add-to-list 'path-children child) - )))))) - (if path-tail - (org-freemind-get-children path-children path-tail) - path-children))) - -(defun org-freemind-get-richcontent-node (node) - (let ((rc-nodes - (org-freemind-get-children node '((richcontent (type . "NODE")) html body)))) - (when (> (length rc-nodes) 1) - (lwarn t :warning "Unexpected structure: several ")) - (car rc-nodes))) - -(defun org-freemind-get-richcontent-note (node) - (let ((rc-notes - (org-freemind-get-children node '((richcontent (type . "NOTE")) html body)))) - (when (> (length rc-notes) 1) - (lwarn t :warning "Unexpected structure: several ")) - (car rc-notes))) - -(defun org-freemind-test-get-tree-text () - (let ((node '(p nil "\n" - (a - ((href . "link")) - "text") - "\n" - (b nil "hej") - "\n"))) - (org-freemind-get-tree-text node))) -;; (org-freemind-test-get-tree-text) - -(defun org-freemind-get-tree-text (node) - (when node - (let ((ntxt "") - (link nil) - (lf-after nil)) - (dolist (n node) - (case n - ;;(a (setq is-link t) ) - ((h1 h2 h3 h4 h5 h6 p) - ;;(setq ntxt (concat "\n" ntxt)) - (setq lf-after 2)) - (br - (setq lf-after 1)) - (t - (cond - ((stringp n) - (when (string= n "\n") (setq n "")) - (if link - (setq ntxt (concat ntxt - "[[" link "][" n "]]")) - (setq ntxt (concat ntxt n)))) - ((and n (listp n)) - (if (symbolp (car n)) - (setq ntxt (concat ntxt (org-freemind-get-tree-text n))) - ;; This should be the attributes: - (dolist (att-val n) - (let ((att (car att-val)) - (val (cdr att-val))) - (when (eq att 'href) - (setq link val)))))))))) - (if lf-after - (setq ntxt (concat ntxt (make-string lf-after ?\n))) - (setq ntxt (concat ntxt " "))) - ;;(setq ntxt (concat ntxt (format "{%s}" n))) - ntxt))) - -(defun org-freemind-get-richcontent-node-text (node) - "Get the node text as from the richcontent node NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-node node)) - (txt (org-freemind-get-tree-text rc))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-richcontent-note-text (node) - "Get the node text as from the richcontent note NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-note node)) - (txt (when rc (org-freemind-get-tree-text rc)))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-icon-names (node) - (let* ((icon-nodes (org-freemind-get-children node '((icon )))) - names) - (dolist (icn icon-nodes) - (setq names (cons (cdr (assq 'builtin (cadr icn))) names))) - ;; (icon (builtin . "full-1")) - names)) - -(defun org-freemind-node-to-org (node level skip-levels) - (let ((qname (car node)) - (attributes (cadr node)) - text - ;; Fix-me: note is never inserted - (note (org-freemind-get-richcontent-note-text node)) - (mark "-- This is more about ") - (icons (org-freemind-get-icon-names node)) - (children (cddr node))) - (when (< 0 (- level skip-levels)) - (dolist (attrib attributes) - (case (car attrib) - ('TEXT (setq text (cdr attrib))) - ('text (setq text (cdr attrib))))) - (unless text - ;; There should be a richcontent node holding the text: - (setq text (org-freemind-get-richcontent-node-text node))) - (when icons - (when (member "full-1" icons) (setq text (concat "[#A] " text))) - (when (member "full-2" icons) (setq text (concat "[#B] " text))) - (when (member "full-3" icons) (setq text (concat "[#C] " text))) - (when (member "full-4" icons) (setq text (concat "[#D] " text))) - (when (member "full-5" icons) (setq text (concat "[#E] " text))) - (when (member "full-6" icons) (setq text (concat "[#F] " text))) - (when (member "full-7" icons) (setq text (concat "[#G] " text))) - (when (member "button_cancel" icons) (setq text (concat "TODO " text))) - ) - (if (and note - (string= mark (substring note 0 (length mark)))) - (progn - (setq text (replace-regexp-in-string "\n $" "" text)) - (insert text)) - (case qname - ('node - (insert (make-string (- level skip-levels) ?*) " " text "\n") - (when note - (insert ":COMMENT:\n" note "\n:END:\n")) - )))) - (dolist (child children) - (unless (or (null child) - (stringp child)) - (org-freemind-node-to-org child (1+ level) skip-levels))))) - -;; Fix-me: put back special things, like drawers that are stored in -;; the notes. Should maybe all notes contents be put in drawers? -;;;###autoload -(defun org-freemind-to-org-mode (mm-file org-file) - "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE." - (interactive - (save-match-data - (let* ((mm-file (buffer-file-name)) - (default-org-file (concat (file-name-nondirectory mm-file) ".org")) - (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file))) - (list mm-file org-file)))) - (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any)) - (let ((mm-buffer (find-file-noselect mm-file)) - (org-buffer (find-file-noselect org-file))) - (with-current-buffer mm-buffer - (let* ((xml-list (xml-parse-file mm-file)) - (top-node (cadr (cddar xml-list))) - (note (org-freemind-get-richcontent-note-text top-node)) - (skip-levels - (if (and note - (string-match "^--org-mode: WHOLE FILE$" note)) - 1 - 0))) - (with-current-buffer org-buffer - (erase-buffer) - (org-freemind-node-to-org top-node 1 skip-levels) - (goto-char (point-min)) - (org-set-tags t t) ;; Align all tags - ) - (switch-to-buffer-other-window org-buffer) - ))))) - -(provide 'org-freemind) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-freemind.el ends here diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 4419fdbe85d..785b577f645 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -1,6 +1,6 @@ ;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Tassilo Horn @@ -43,8 +43,7 @@ (declare-function gnus-summary-last-subject "gnus-sum" nil) ;; Customization variables -(when (fboundp 'defvaralias) - (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)) +(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) (defcustom org-gnus-prefer-web-links nil "If non-nil, `org-store-link' creates web links to Google groups or Gmane. @@ -66,6 +65,12 @@ this variable to `t'." :version "24.1" :type 'boolean) +(defcustom org-gnus-no-server nil + "Should Gnus be started using `gnus-no-server'?" + :group 'org-gnus + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) ;; Install the link type (org-add-link-type "gnus" 'org-gnus-open) @@ -287,7 +292,7 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-no-new-news () "Like `M-x gnus' but doesn't check for new news." - (if (not (gnus-alive-p)) (gnus))) + (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) (provide 'org-gnus) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 8465ba45a27..721718d2b6c 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -1,6 +1,6 @@ ;;; org-habit.el --- The habit tracking code for Org-mode -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; Author: John Wiegley ;; Keywords: outlines, hypermedia, calendar, wp @@ -85,6 +85,12 @@ today's agenda, even if they are not scheduled." :version "24.1" :type 'character) +(defcustom org-habit-show-done-always-green nil + "Non-nil means DONE days will always be green in the consistency graph. +It will be green even if it was done after the deadline." + :group 'org-habit + :type 'boolean) + (defface org-habit-clear-face '((((background light)) (:background "#8270f9")) (((background dark)) (:background "blue"))) @@ -194,7 +200,9 @@ This list represents a \"habit\" for the rest of this module." (count 0)) (unless reversed (goto-char end)) (while (and (< count maxdays) - (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t)) + (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]" + (regexp-opt org-done-keywords)) + limit t)) (push (time-to-days (org-time-string-to-time (match-string-no-properties 1))) closed-dates) @@ -272,8 +280,9 @@ Habits are assigned colors on the following basis: (if donep '(org-habit-ready-face . org-habit-ready-future-face) '(org-habit-alert-face . org-habit-alert-future-face))) - (t - '(org-habit-overdue-face . org-habit-overdue-future-face))))) + ((and org-habit-show-done-always-green donep) + '(org-habit-ready-face . org-habit-ready-future-face)) + (t '(org-habit-overdue-face . org-habit-overdue-future-face))))) (defun org-habit-build-graph (habit starting current ending) "Build a graph for the given HABIT, from STARTING to ENDING. diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el deleted file mode 100644 index ca90f855aab..00000000000 --- a/lisp/org/org-html.el +++ /dev/null @@ -1,2761 +0,0 @@ -;;; org-html.el --- HTML export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-exp) -(require 'format-spec) - -(eval-when-compile (require 'cl)) - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-footnotes-section "
          -

          %s:

          -
          -%s -
          -
          " - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-footnote-format "%s" - "The format for the footnote reference. -%s will be replaced by the footnote reference itself." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-footnote-separator ", " - "Text used to separate footnotes." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to `buffer-file-coding-system'." - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-xml-declaration - '(("html" . "") - ("php" . "\"; ?>")) - "The extension for exported HTML files. -%s will be replaced with the charset of the exported file. -This may be a string, or an alist with export extensions -and corresponding declarations." - :group 'org-export-html - :type '(choice - (string :tag "Single declaration") - (repeat :tag "Dependent on extension" - (cons (string :tag "Extension") - (string :tag "Declaration"))))) - -(defcustom org-export-html-style-include-scripts t - "Non-nil means include the JavaScript snippets in exported HTML files. -The actual script is defined in `org-export-html-scripts' and should -not be modified." - :group 'org-export-html - :type 'boolean) - -(defvar org-export-html-scripts - "" - "Basic JavaScript that is needed by HTML files produced by Org-mode.") - -(defconst org-export-html-style-default - "" - "The default style specification for exported HTML files. -Please use the variables `org-export-html-style' and -`org-export-html-style-extra' to add to this style. If you wish to not -have the default style included, customize the variable -`org-export-html-style-include-default'.") - -(defcustom org-export-html-style-include-default t - "Non-nil means include the default style in exported HTML files. -The actual style is defined in `org-export-html-style-default' and should -not be modified. Use the variables `org-export-html-style' to add -your own style information." - :group 'org-export-html - :type 'boolean) - -;;;###autoload -(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) - -(defcustom org-export-html-style "" - "Org-wide style definitions for exported HTML files. - -This variable needs to contain the full HTML structure to provide a style, -including the surrounding HTML tags. If you set the value of this variable, -you should consider to include definitions for the following classes: - title, todo, done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - - -If you'd like to refer to an external style file, use something like - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header. -See also the variable `org-export-html-style-extra'." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style 'safe-local-variable 'stringp) - -(defcustom org-export-html-style-extra "" - "Additional style information for HTML export. -The value of this variable is inserted into the HTML buffer right after -the value of `org-export-html-style'. Use this variable for per-file -settings of style information, and do not forget to surround the style -settings with tags." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style-extra 'safe-local-variable 'stringp) - -(defcustom org-export-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") - (scale "100") - (align "center") - (indent "2em") - (mathml nil)) - "Options for MathJax setup. - -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. - -You can also customize this for each buffer, using something like - -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" - :group 'org-export-html - :version "24.1" - :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) - -(defun org-export-html-mathjax-config (template options in-buffer) - "Insert the user setup into the matchjax template." - (let (name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (setq template - (replace-regexp-in-string - (concat "%" (upcase (symbol-name name))) val template t t))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\ -/** - * - * @source: %PATH - * - * @licstart The following is the entire license notice for the - * JavaScript code in %PATH. - * - * Copyright (C) 2012-2013 MathJax - * - * Licensed under the Apache License, Version 2.0 (the \"License\"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an \"AS IS\" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * @licend The above is the entire license notice - * for the JavaScript code in %PATH. - * - */ - -/* -@licstart The following is the entire license notice for the -JavaScript code below. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code below is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code below. -*/ - -" - "The MathJax setup for XHTML files." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-tag-class-prefix "" - "Prefix to class names for TODO keywords. -Each tag gets a class given by the tag itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-todo-kwd-class-prefix "" - "Prefix to class names for TODO keywords. -Each TODO keyword gets a class given by the keyword itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-headline-anchor-format "" - "Format for anchors in HTML headlines. -It requires to %s: both will be replaced by the anchor referring -to the headline (e.g. \"sec-2\"). When set to `nil', don't insert -HTML anchors in headlines." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-preamble t - "Non-nil means insert a preamble in HTML export. - -When `t', insert a string as defined by one of the formatting -strings in `org-export-html-preamble-format'. When set to a -string, this string overrides `org-export-html-preamble-format'. -When set to a function, apply this function and insert the -returned string. The function takes no argument, but you can -use `opt-plist' to access the current export options. - -Setting :html-preamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No preamble" nil) - (const :tag "Default preamble" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-preamble-format '(("en" "")) - "Alist of languages and format strings for the HTML preamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-preamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -preamble itself. This format string can contain these elements: - -%t stands for the title. -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-postamble 'auto - "Non-nil means insert a postamble in HTML export. - -When `t', insert a string as defined by the format string in -`org-export-html-postamble-format'. When set to a string, this -string overrides `org-export-html-postamble-format'. When set to -'auto, discard `org-export-html-postamble-format' and honor -`org-export-author/email/creator-info' variables. When set to a -function, apply this function and insert the returned string. -The function takes no argument, but you can use `opt-plist' to -access the current export options. - -Setting :html-postamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto preamble" 'auto) - (const :tag "Default format string" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-postamble-format - '(("en" "

          Author: %a (%e)

          -

          Date: %d

          -

          Generated by %c

          -

          %v

          -")) - "Alist of languages and format strings for the HTML postamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-postamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -postamble itself. This format string can contain these elements: - -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. -%c will be replaced by information about Org/Emacs versions. -%v will be replaced by `org-export-html-validation-link'. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-home/up-format - "
          - UP - | - HOME -
          " - "Snippet used to insert the HOME and UP links. -This is a format string, the first %s will receive the UP link, -the second the HOME link. If both `org-export-html-link-up' and -`org-export-html-link-home' are empty, the entire snippet will be -ignored." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export. -This is also important for the classes that will be wrapped around headlines -and outline structure. If this variable is 1, the top-level headlines will -be

          , and the corresponding classes will be outline-1, section-number-1, -and outline-text-1. If this is 2, all of these will get a 2 instead. -The default for this variable is 2, because we use

          for formatting the -document title." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means inline images into exported HTML pages. -This is done using an tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -(defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif" "svg") - "Extensions of image files that can be inlined into HTML." - :group 'org-export-html - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
          tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-use-header-tags-for-first-column'. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-row-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be evaluated -for each row in order to construct the table row tags. During evaluation, -the variable `head' will be true when this is a header line, nil when this -is a body line. And the variable `nline' will contain the line number, -starting from 1 in the first header line. For example - - (setq org-export-table-row-tags - (cons '(if head - \"\" - (if (= (mod nline 2) 1) - \"\" - \"\")) - \"\")) - -will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." - :group 'org-export-tables - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) - -(defcustom org-export-html-table-align-individual-fields t - "Non-nil means attach style attributes for alignment to each table field. -When nil, alignment will only be specified in the column tags, but this -is ignored by some browsers (like Firefox, Safari). Opera does it right -though." - :group 'org-export-tables - :version "24.1" - :type 'boolean) - -(defcustom org-export-html-table-use-header-tags-for-first-column nil - "Non-nil means format column one in tables with header tags. -When nil, also column one will use data tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-html-validation-link - "Validate XHTML 1.0" - "Link to HTML validation service." - :group 'org-export-html - :type 'string) - -;; FIXME Obsolete since Org 7.7 -;; Use the :timestamp option or `org-export-time-stamp-file' instead -(defvar org-export-html-with-timestamp nil - "If non-nil, write container for HTML-helper-mode timestamp.") - -;; FIXME Obsolete since Org 7.7 -(defvar org-export-html-html-helper-timestamp - "\n



          \n

          \n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode.") - -(defcustom org-export-html-protect-char-alist - '(("&" . "&") - ("<" . "<") - (">" . ">")) - "Alist of characters to be converted by `org-html-protect'." - :group 'org-export-html - :version "24.1" - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) - -(defgroup org-export-htmlize nil - "Options for processing examples with htmlize.el." - :tag "Org Export Htmlize" - :group 'org-export-html) - -(defcustom org-export-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. - -However, this will fail when using Emacs in batch mode for export, because -then no rich font definitions are in place. It will also not be good if -people with different Emacs setup contribute HTML files to a website, -because the fonts will represent the individual setups. In these cases, -it is much better to let Org/Htmlize assign classes only, and to use -a style file to define the look of these classes. -To get a start for your css file, start Emacs session and make sure that -all the faces you are interested in are defined, for example by loading files -in all modes you want. Then, use the command -\\[org-export-htmlize-generate-css] to extract class definitions." - :group 'org-export-htmlize - :type '(choice (const css) (const inline-css))) - -(defcustom org-export-htmlize-css-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-htmlize - :type 'string) - -(defcustom org-export-htmlized-org-css-url nil - "URL pointing to a CSS file defining text colors for htmlized Emacs buffers. -Normally when creating an htmlized version of an Org buffer, htmlize will -create CSS to define the font colors. However, this does not work when -converting in batch mode, and it also can look bad if different people -with different fontification setup work on the same website. -When this variable is non-nil, creating an htmlized version of an Org buffer -using `org-export-as-org' will remove the internal CSS section and replace it -with a link to this URL." - :group 'org-export-htmlize - :type '(choice - (const :tag "Keep internal css" nil) - (string :tag "URL or local href"))) - -;; FIXME: The following variable is obsolete since Org 7.7 but is -;; still declared and checked within code for compatibility reasons. -;; Use the custom variables `org-export-html-divs' instead. -(defvar org-export-html-content-div "content" - "The name of the container DIV that holds all the page contents. - -This variable is obsolete since Org version 7.7. -Please set `org-export-html-divs' instead.") - -(defcustom org-export-html-divs '("preamble" "content" "postamble") - "The name of the main divs for HTML export. -This is a list of three strings, the first one for the preamble -DIV, the second one for the content DIV and the third one for the -postamble DIV." - :group 'org-export-html - :version "24.1" - :type '(list - (string :tag " Div for the preamble:") - (string :tag " Div for the content:") - (string :tag "Div for the postamble:"))) - -(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z" - "Format string to format the date and time. - -The default is an extended format of the ISO 8601 specification." - :group 'org-export-html - :version "24.1" - :type 'string) - -;;; Hooks - -(defvar org-export-html-after-blockquotes-hook nil - "Hook run during HTML export, after blockquote, verse, center are done.") - -(defvar org-export-html-final-hook nil - "Hook run at the end of HTML export, in the new buffer.") - -;;; HTML export - -(defun org-export-html-preprocess (parameters) - "Convert LaTeX fragments to images." - (when (and org-current-export-file - (plist-get parameters :LaTeX-fragments)) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s" - nil nil - (cond - ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) - ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick) - ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)))) - (goto-char (point-min)) - (let (label l1) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (setq label (match-string 1)) - (save-match-data - (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) - (setq l1 (substring label (match-beginning 1))) - (setq l1 label))) - (replace-match (format "[[#%s][%s]]" label l1) t t))))) - -;;;###autoload -(defun org-export-as-html-and-open (arg) - "Export the outline as HTML and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-export-as-html arg) - (org-open-file buffer-file-name) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))) - -;;;###autoload -(defun org-export-as-html-batch () - "Call the function `org-export-as-html'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-html-batch" - (org-export-as-html org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-html-to-buffer (arg) - "Call `org-export-as-html` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-html'." - (interactive "P") - (org-export-as-html arg nil "*Org HTML Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org HTML Export*"))) - -;;;###autoload -(defun org-replace-region-by-html (beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use this -command to convert it." - (interactive "r") - (let (reg html buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq html (org-export-region-as-html - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq html (org-export-region-as-html - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert html))) - -;;;###autoload -(defun org-export-region-as-html (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-export-region-as-html beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org HTML Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-html nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar html-table-tag nil) ; dynamically scoped into this. -(defvar org-par-open nil) - -;;; org-html-cvt-link-fn -(defconst org-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. -Takes two arguments, TYPE and PATH. -Returns exportable url as (TYPE PATH), or nil to signal that it -didn't handle this case. -Intended to be locally bound around a call to `org-export-as-html'." ) - -(defun org-html-cvt-org-as-html (opt-plist type path) - "Convert an org filename to an equivalent html filename. -If TYPE is not file, just return `nil'. -See variable `org-export-html-link-org-files-as-html'" - - (save-match-data - (and - org-export-html-link-org-files-as-html - (string= type "file") - (string-match "\\.org$" path) - (progn - (list - "file" - (concat - (substring path 0 (match-beginning 0)) - "." - (plist-get opt-plist :html-extension))))))) - - -;;; org-html-should-inline-p -(defun org-html-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (declare (special - org-export-html-inline-images - org-export-html-inline-image-extensions)) - (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions))) - -;;; org-html-make-link -(defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. -OPT-PLIST is an options list. -TYPE is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the \"a\" element. -MAY-INLINE-P allows inlining it as an image." - - (declare (special org-par-open)) - (save-match-data - (let* ((filename path) - ;;First pass. Just sanity stuff. - (components-1 - (cond - ((string= type "file") - (list - type - ;;Substitute just if original path was absolute. - ;;(Otherwise path must remain relative) - (if (file-name-absolute-p path) - (concat "file://" (expand-file-name path)) - path))) - ((string= type "") - (list nil path)) - (t (list type path)))) - - ;;Second pass. Components converted so they can refer - ;;to a remote site. - (components-2 - (or - (and org-html-cvt-link-fn - (apply org-html-cvt-link-fn - opt-plist components-1)) - (apply #'org-html-cvt-org-as-html - opt-plist components-1) - components-1)) - (type (first components-2)) - (thefile (second components-2))) - - - ;;Third pass. Build final link except for leading type - ;;spec. - (cond - ((or - (not type) - (string= type "http") - (string= type "https") - (string= type "file") - (string= type "coderef")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile - (let - ((str (org-export-html-format-href thefile))) - (if (and type (not (or (string= "file" type) - (string= "coderef" type)))) - (concat type ":" str) - str))) - - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "" - (org-export-html-format-desc desc) - ""))))) - -(defun org-html-handle-links (org-line opt-plist) - "Return ORG-LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link) - (while (string-match org-bracket-link-analytic-regexp++ org-line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 org-line)))) - (setq type (cond - ((match-end 2) (match-string 2 org-line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 org-line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props - (concat "") - '(org-protected t)))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) - - ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" - coderef-str coderef-str))) - (setq rpl - (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<" type ":" - (save-match-data (org-link-unescape path)) - ">")))) - (setq org-line (replace-match rpl t t org-line) - start (+ start (length rpl)))) - org-line)) - -;;; org-export-as-html - -(defvar org-heading-keyword-regexp-format) ; defined in org.el - -;;;###autoload -(defun org-export-as-html (arg &optional ext-plist to-buffer body-only pub-dir) - "Export the outline as a pretty HTML file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting HTML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -..., without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting...") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* ((opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - (style (concat (if (plist-get opt-plist :style-include-default) - org-export-html-style-default) - (plist-get opt-plist :style) - (plist-get opt-plist :style-extra) - "\n" - (if (plist-get opt-plist :style-include-scripts) - org-export-html-scripts))) - (html-extension (plist-get opt-plist :html-extension)) - valid thetoc have-headings first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (org-line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." html-extension) - (file-name-as-directory - (or pub-dir (org-export-directory :html opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (date (org-html-expand (plist-get opt-plist :date))) - (author (org-html-expand (plist-get opt-plist :author))) - (html-validation-link (or org-export-html-validation-link "")) - (title (org-html-expand - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (link-up (and (plist-get opt-plist :link-up) - (string-match "\\S-" (plist-get opt-plist :link-up)) - (plist-get opt-plist :link-up))) - (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (inquote nil) - (infixed nil) - (inverse nil) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (keywords (org-html-expand (plist-get opt-plist :keywords))) - (description (org-html-expand (plist-get opt-plist :description))) - (num (plist-get opt-plist :section-numbers)) - (lang-words nil) - (head-count 0) cnt - (start 0) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-html-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-html-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (custom-id (or (org-entry-get nil "CUSTOM_ID" t) "")) - (footnote-def-prefix (format "fn-%s" custom-id)) - (footnote-ref-prefix (format "fnr-%s" custom-id)) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'html - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - (mathjax - (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) - (and org-export-have-math - (eq (plist-get opt-plist :LaTeX-fragments) t))) - - (org-export-html-mathjax-config - org-export-html-mathjax-template - org-export-html-mathjax-options - (or (plist-get opt-plist :mathjax) "")) - "")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - href) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string org-export-html-date-format-string)))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - - ;; Switch to the output buffer - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (unless body-only - ;; File header - (insert (format - "%s - - - -%s - - - - - - - -%s -%s - - -%s -" - (format - (or (and (stringp org-export-html-xml-declaration) - org-export-html-xml-declaration) - (cdr (assoc html-extension org-export-html-xml-declaration)) - (cdr (assoc "html" org-export-html-xml-declaration)) - - "") - (or charset "iso-8859-1")) - language language - title - (or charset "iso-8859-1") - title date author description keywords - style - mathjax - (if (or link-up link-home) - (concat - (format org-export-html-home/up-format - (or link-up link-home) - (or link-home link-up)) - "\n") - ""))) - - ;; insert html preamble - (when (plist-get opt-plist :html-preamble) - (let ((html-pre (plist-get opt-plist :html-preamble)) - (html-pre-real-contents "")) - (cond ((stringp html-pre) - (setq html-pre-real-contents - (format-spec html-pre `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))) - ((functionp html-pre) - (insert "
          \n") - (if (stringp (funcall html-pre)) (insert (funcall html-pre))) - (insert "\n
          \n")) - (t - (setq html-pre-real-contents - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email)))))) - ;; don't output an empty preamble DIV - (unless (and (functionp html-pre) - (equal html-pre-real-contents "")) - (insert "
          \n") - (insert html-pre-real-contents) - (insert "\n
          \n")))) - - ;; begin wrap around body - (insert (format "\n
          " - ;; FIXME org-export-html-content-div is obsolete since 7.7 - (or org-export-html-content-div - (nth 1 org-export-html-divs))) - ;; FIXME this should go in the preamble but is here so - ;; that org-infojs can still find it - "\n

          " title "

          \n")) - - ;; insert body - (if org-export-with-toc - (progn - (push (format "%s\n" - org-export-html-toplevel-hlevel - (nth 3 lang-words) - org-export-html-toplevel-hlevel) - thetoc) - (push "
          \n" thetoc) - (push "
            \n
          • " thetoc) - (setq lines - (mapcar - #'(lambda (org-line) - (if (and (string-match org-todo-line-regexp org-line) - (not (get-text-property 0 'org-protected org-line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 org-line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 org-line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - org-line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match - "   \\1" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if (and num (if (integerp num) - (>= num level) - num)) - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n
              \n
            • " thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "
            • \n
            " thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp org-line) - (setq org-line (replace-match - (concat "@" - (match-string 1 org-line) "@ ") - t t org-line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (setq href (org-solidify-link-text - (or (cdr (assoc href - org-export-preferred-target-alist)) href))) - (push - (format - (if todo - "
          • \n
          • %s" - "
          • \n
          • %s") - href txt) thetoc) - - (setq org-last-level level))))) - org-line) - lines)) - (while (> org-last-level (1- org-min-level)) - (setq org-last-level (1- org-last-level)) - (push "
          • \n
          \n" thetoc)) - (push "
          \n" thetoc) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (setq head-count 0) - (org-init-section-numbers) - - (org-open-par) - - (while (setq org-line (pop lines) origline org-line) - (catch 'nextline - - ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol org-line)) - (insert "\n") - (org-open-par) - (setq inquote nil)) - ;; inside a quote section? - (when inquote - (insert (org-html-protect org-line) "\n") - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line)) - (when (not infixed) - (setq infixed t) - (org-close-par-maybe) - - (insert "
          \n"))
          -	    (insert (org-html-protect (match-string 3 org-line)) "\n")
          -	    (when (or (not lines)
          -		      (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
          -					 (car lines))))
          -	      (setq infixed nil)
          -	      (insert "
          \n") - (org-open-par)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected org-line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected org-line) 10000) - (length org-line)))) - (let (par (ind (get-text-property 0 'original-indentation org-line))) - (when (re-search-backward - "\\(

          \\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert org-line "\n") - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (insert (pop lines) "\n")) - (and par (insert "

          \n"))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" org-line) - (org-close-par-maybe) - (insert "

          \n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" org-line) - (org-close-par-maybe) - (insert "\n
          \n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" org-line) - (org-close-par-maybe) - (insert "\n

          \n") - (setq org-par-open t) - (setq inverse t) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" org-line) - (insert "

          \n") - (setq org-par-open nil) - (org-open-par) - (setq inverse nil) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" org-line) - (org-close-par-maybe) - (insert "\n
          ") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" org-line) - (org-close-par-maybe) - (insert "\n
          ") - (org-open-par) - (throw 'nextline nil)) - (run-hooks 'org-export-html-after-blockquotes-hook) - (when inverse - (let ((i (org-get-string-indentation org-line))) - (if (> i 0) - (setq org-line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim org-line)))) - (unless (string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (concat org-line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected org-line) - (setq start (match-end 1))) - ((match-end 2) - (setq org-line (replace-match - (format - "@@" - (org-solidify-link-text (match-string 1 org-line)) - (org-solidify-link-text (match-string 1 org-line))) - t t org-line))) - ((and org-export-with-toc (equal (string-to-char org-line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq org-line (replace-match - (concat "@" - (match-string 1 org-line) "@ ") - ;; (concat "@" (match-string 1 org-line) "@ ") - t t org-line))) - (t - (setq org-line (replace-match - (concat "@" (match-string 1 org-line) - "@ ") - t t org-line))))) - - (setq org-line (org-html-handle-time-stamps org-line)) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp org-line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line) - (setq org-line (org-html-expand org-line))) - - ;; Format the links - (setq org-line (org-html-handle-links org-line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp org-line) - (match-beginning 2)) - - (setq org-line - (concat (substring org-line 0 (match-beginning 2)) - "" (match-string 2 org-line) - "" (substring org-line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected org-line) - (not (get-text-property (match-beginning 2) 'org-footnote org-line))) - (setq start (match-end 2)) - (let ((n (match-string 2 org-line)) extra a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq extra (format ".%d" (cdr a)))) - (setq extra "") - (push (cons n 1) footref-seen)) - (setq org-line - (replace-match - (concat - (format - (concat "%s" - (format org-export-html-footnote-format - (concat "%s"))) - (or (match-string 1 org-line) "") n extra n n) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring org-line (match-end 0)))) - org-export-html-footnote-separator - "")) - t t org-line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (or (match-string 2 org-line) "")) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (setq first-heading-pos (or first-heading-pos (point))) - (org-html-level-start level txt umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - - ;; QUOTES - (when (string-match quote-re org-line) - (org-close-par-maybe) - (insert "
          ")
          -	      (setq inquote t)))
          -
          -	   ((and org-export-with-tables
          -		 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
          -	    (when (not table-open)
          -	      ;; New table starts
          -	      (setq table-open t table-buffer nil table-orig-buffer nil))
          -
          -	    ;; Accumulate lines
          -	    (setq table-buffer (cons org-line table-buffer)
          -		  table-orig-buffer (cons origline table-orig-buffer))
          -	    (when (or (not lines)
          -		      (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
          -					 (car lines))))
          -	      (setq table-open nil
          -		    table-buffer (nreverse table-buffer)
          -		    table-orig-buffer (nreverse table-orig-buffer))
          -	      (org-close-par-maybe)
          -	      (insert (org-format-table-html table-buffer table-orig-buffer))))
          -
          -	   ;; Normal lines
          -
          -	   (t
          -	    ;; This line either is list item or end a list.
          -	    (when (get-text-property 0 'list-item org-line)
          -	      (setq org-line (org-html-export-list-line
          -			      org-line
          -			      (get-text-property 0 'list-item org-line)
          -			      (get-text-property 0 'list-struct org-line)
          -			      (get-text-property 0 'list-prevs org-line))))
          -
          -	    ;; Horizontal line
          -	    (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
          -	      (if org-par-open
          -		  (insert "\n

          \n
          \n

          \n") - (insert "\n


          \n")) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - org-line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line) - (org-close-par-maybe) - (let ((n (match-string 1 org-line))) - (setq org-par-open t - org-line (replace-match - (format - (concat "

          " - (format org-export-html-footnote-format - (concat - "%s"))) - n n n) t t org-line))))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (replace-match "
          " t t org-line))) - (org-export-preserve-breaks - (setq org-line (concat org-line "
          ")))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-par-open - (string-match "\\\\par\\>" org-line start)) - ;; Leave a space in the

          so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected org-line)) - (setq org-line (replace-match "

          " t t org-line))) - (setq start (match-end 0)))) - - (insert org-line "\n"))))) - - ;; Properly close all local lists and other lists - (when inquote - (insert "

          \n") - (org-open-par)) - - (org-html-level-start 1 nil umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - ;; the
          to close the last text-... div. - (when (and (> umax 0) first-heading-pos) (insert "\n")) - - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "\\(\\(

          \\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)" - nil t) - (push (match-string 1) footnotes) - (replace-match "\\4" t nil) - (goto-char (match-beginning 0)))) - (when footnotes - (insert (format org-export-html-footnotes-section - (nth 4 lang-words) - (mapconcat 'identity (nreverse footnotes) "\n")) - "\n")) - (let ((bib (org-export-html-get-bibliography))) - (when bib - (insert "\n" bib "\n"))) - - (unless body-only - ;; end wrap around body - (insert "\n") - - ;; export html postamble - (let ((html-post (plist-get opt-plist :html-postamble)) - (email - (mapconcat (lambda(e) - (format "%s" e e)) - (split-string email ",+ *") - ", ")) - (creator-info - (concat "Org version " - (org-version) " with Emacs version " - (number-to-string emacs-major-version)))) - - (when (plist-get opt-plist :html-postamble) - (insert "\n

          \n") - (cond ((stringp html-post) - (insert (format-spec html-post - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link))))) - ((functionp html-post) - (if (stringp (funcall html-post)) (insert (funcall html-post)))) - ((eq html-post 'auto) - ;; fall back on default postamble - (when (plist-get opt-plist :time-stamp-file) - (insert "

          " (nth 2 lang-words) ": " date "

          \n")) - (when (and (plist-get opt-plist :author-info) author) - (insert "

          " (nth 1 lang-words) ": " author "

          \n")) - (when (and (plist-get opt-plist :email-info) email) - (insert "

          " email "

          \n")) - (when (plist-get opt-plist :creator-info) - (insert "

          " - (concat "Org version " - (org-version) " with Emacs version " - (number-to-string emacs-major-version) "

          \n"))) - (insert html-validation-link "\n")) - (t - (insert (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-postamble-format)) - (cadr (assoc "en" org-export-html-postamble-format))) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))))) - (insert "\n
          ")))) - - ;; FIXME `org-export-html-with-timestamp' has been declared - ;; obsolete since Org 7.7 -- don't forget to remove this. - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - - (unless body-only (insert "\n\n\n")) - - (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode (default-value 'major-mode)) - (html-mode))) - - ;; insert the table of contents - (goto-char (point-min)) - (when thetoc - (if (or (re-search-forward - "

          \\s-*\\[TABLE-OF-CONTENTS\\]\\s-*

          " nil t) - (re-search-forward - "\\[TABLE-OF-CONTENTS\\]" nil t)) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos) - (when (looking-at "\\s-*

          ") - (goto-char (match-end 0)) - (insert "\n"))) - (insert "
          \n") - (let ((beg (point))) - (mapc 'insert thetoc) - (insert "
          \n") - (while (re-search-backward "
        5. [ \r\n\t]*
        6. \n?" beg t) - (replace-match "")))) - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward "

          [ \r\n\t]*

          " nil t) - (replace-match "")) - (goto-char (point-min)) - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "%s" - (make-string n ?x))))) - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t)) - ;; Run the hook - (run-hooks 'org-export-html-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "HTML") - (message "Exporting... done")) - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) - -(defun org-export-html-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-export-html-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-html-do-expand s)) - s)) - -(defun org-export-html-format-image (src par-open) - "Create image tag with source and attributes." - (save-match-data - (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src) - (format "\"%s\"/" - src (org-find-text-property-in-string 'org-latex-src src)) - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src))) - (setq caption (and caption (org-html-do-expand caption))) - (concat - (if caption - (format "%s
          -

          " - (if org-par-open "

          \n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "" - src - (if (string-match "\\%s -
          %s" - (concat "\n

          " caption "

          ") - (if org-par-open "\n

          " "")))))))) - -(defun org-export-html-get-bibliography () - "Find bibliography, cut it out and return it." - (catch 'exit - (let (beg end (cnt 1) bib) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^[ \t]*

          " nil t) - (setq cnt (+ cnt (if (string= (match-string 0) "") (forward-char 1)) - (setq bib (buffer-substring beg (point))) - (delete-region beg (point)) - (throw 'exit bib)))) - nil)))) - -(defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines &optional no-css) - "Find out which HTML converter to use and return the HTML code. -NO-CSS is passed to the exporter." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-format-org-table-html lines nil no-css) - ;; Table made by table.el - (or (org-format-table-table-html-using-table-generate-source - olines (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-format-table-table-html lines)))) - -(defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice no-css) - "Format a table into HTML. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding
          " . "
          tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (col-cookies (org-find-text-property-in-string 'org-col-cookies - (car lines))) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (html-table-tag (org-export-splice-attributes - html-table-tag attributes)) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines))))) - (nline 0) fnum nfields i (cnt 0) - tbopen org-line fields html gr colgropen rowstart rowend - ali align aligns n) - (setq caption (and caption (org-html-do-expand caption))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - (if splice (setq head nil)) - (unless splice (push (if head "" "") html)) - (setq tbopen t) - (while (setq org-line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" org-line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0) - nfields (length fnum))) - (setq nline (1+ nline) i -1 - rowstart (eval (car org-export-table-row-tags)) - rowend (eval (cdr org-export-table-row-tags))) - (push (concat rowstart - (mapconcat - (lambda (x) - (setq i (1+ i) ali (format "@@class%03d@@" i)) - (if (and (< i nfields) ; make sure no rogue line causes an error here - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (cond - (head - (concat - (format (car org-export-table-header-tags) - "col" ali) - x - (cdr org-export-table-header-tags))) - ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) - (concat - (format (car org-export-table-header-tags) - "row" ali) - x - (cdr org-export-table-header-tags))) - (t - (concat (format (car org-export-table-data-tags) ali) - x - (cdr org-export-table-data-tags))))) - fields "") - rowend) - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
          \n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortunately often ignored...) - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - (setq i 0) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info) - i (1+ i) - align (if (nth 1 (assoc i col-cookies)) - (cdr (assoc (nth 1 (assoc i col-cookies)) - '(("l" . "left") ("r" . "right") - ("c" . "center")))) - (if (> (/ (float x) nline) - org-table-number-fraction) - "right" "left"))) - (push align aligns) - (format (if no-css - "%s%s" - "%s%s") - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen - "\n" - "") - (setq colgropen t)) - "") - align - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (setq aligns (nreverse aligns)) - (if colgropen (setq html (cons (car html) - (cons "" (cdr html))))) - ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, include empty captions for the DocBook - ;; export only so that it produces valid XML. - (when (or caption (eq org-export-current-backend 'docbook)) - (push (format "%s" (or caption "")) html)) - (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) - (push html-table-tag html)) - (setq html (mapcar - (lambda (x) - (replace-regexp-in-string - "@@class\\([0-9]+\\)@@" - (lambda (txt) - (if (not org-export-html-table-align-individual-fields) - "" - (setq n (string-to-number (match-string 1 txt))) - (format (if no-css " align=\"%s\"" " class=\"%s\"") - (or (nth n aligns) "left")))) - x)) - html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-export-splice-attributes (tag attributes) - "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." - (if (not attributes) - tag - (let (oldatt newatt) - (setq oldatt (org-extract-attributes-from-string tag) - tag (pop oldatt) - newatt (cdr (org-extract-attributes-from-string attributes))) - (while newatt - (setq oldatt (plist-put oldatt (pop newatt) (pop newatt)))) - (if (string-match ">" tag) - (setq tag - (replace-match (concat (org-attributes-to-string oldatt) ">") - t t tag))) - tag))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (org-line field-buffer - (head org-export-highlight-first-table-line) - fields html empty i) - (setq html (concat html-table-tag "\n")) - (while (setq org-line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" org-line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat - (format (car org-export-table-header-tags) "col" "") - x - (cdr org-export-table-header-tags)) - (concat (format (car org-export-table-data-tags) "") x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "
          " (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines - &optional - spanned-only) - "Format a table into html, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))))) - -(defun org-export-splice-style (style extra) - "Splice EXTRA into STYLE, just before \"\"." - (if (and (stringp extra) - (string-match "\\S-" extra) - (string-match "" style)) - (concat (substring style 0 (match-beginning 0)) - "\n" extra "\n" - (substring style (match-beginning 0))) - style)) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - " @" - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1)) - "@") - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
          "))) - r)))) - -(defvar htmlize-buffer-places) ; from htmlize.el -(defun org-export-htmlize-region-for-paste (beg end) - "Convert the region to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-export-htmlize-output-type) - (htmlize-css-name-prefix org-export-htmlize-css-font-prefix) - (htmlbuf (htmlize-region beg end))) - (unwind-protect - (with-current-buffer htmlbuf - (buffer-substring (plist-get htmlize-buffer-places 'content-start) - (plist-get htmlize-buffer-places 'content-end))) - (kill-buffer htmlbuf)))) - -(defun org-export-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-export-htmlize-output-type' to `css', calls to -the function `org-export-htmlize-region-for-paste' will produce code -that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") - (goto-char (point-min)) - (if (re-search-forward "" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-html-protect (s) - "Convert characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl org-export-html-protect-char-alist) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res))))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-entity-get-representation wd 'html)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-open-par () - "Insert

          , but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

          ") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

          ") - (setq org-par-open nil))) -(defun org-close-li (&optional type) - "Close
        7. if necessary." - (org-close-par-maybe) - (insert (if (equal type "d") "\n" "
        8. \n"))) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets (and target - (assoc target org-export-target-aliases))) - (extra-class (and title (org-get-text-property-any 0 'html-container-class title))) - (preferred (and target - (cdr (assoc target org-export-preferred-target-alist)))) - (l org-level-max) - (num (plist-get opt-plist :section-numbers)) - snumber snu href suffix) - (setq extra-targets (remove (or preferred target) extra-targets)) - (setq extra-targets - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (if (stringp org-export-html-headline-anchor-format) - (format org-export-html-headline-anchor-format x x) - "")) - extra-targets - "")) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat - (lambda (x) - (format "%s" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (if target - (insert (format "
        9. " (org-solidify-link-text (or preferred target))) - extra-targets title "
          \n") - (insert "
        10. " title "
          \n"))) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (if target - (insert (format "
            \n
          • " (org-solidify-link-text (or preferred target))) - extra-targets title "
            \n") - (insert "
              \n
            • " title "
              \n")))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level) - snu (replace-regexp-in-string "\\." "-" snumber)) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if (and num (not body-only)) - (setq title (concat - (format "%s" - level - (if (and num - (if (integerp num) - ;; fix up num to take into - ;; account the top-level - ;; heading value - (>= (+ num org-export-html-toplevel-hlevel -1) - level) - num)) - snumber - "")) - " " title))) - (unless (= head-count 1) (insert "\n
        11. \n")) - (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) - (setq suffix (org-solidify-link-text (or href snu))) - (setq href (org-solidify-link-text (or href (concat "sec-" snu)))) - (insert (format "\n
          \n%s%s\n
          \n" - suffix level (if extra-class (concat " " extra-class) "") - level href - extra-targets - title level level suffix)) - (org-open-par))))) - -(defun org-export-html-get-tag-class-name (tag) - "Turn tag into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" tag) - (setq tag (replace-match "_" t t tag)))) - (concat org-export-html-tag-class-prefix tag)) - -(defun org-export-html-get-todo-kwd-class-name (kwd) - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - (concat org-export-html-todo-kwd-class-prefix kwd)) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "
          \n") - (org-close-li) - (insert "

    \n"))) - -(defun org-html-export-list-line (org-line pos struct prevs) - "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. - -POS is the item position or org-line position the org-line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-close-par-maybe) - ;; Ending for every item - (org-close-li type) - ;; We're ending last item of the list: end list. - (when lastp - (insert (format "\n" type)) - (org-open-par)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") org-line) - (let* ((checkbox (match-string 3 org-line)) - (desc-tag (or (match-string 4 org-line) "???")) - (body (or (match-string 5 org-line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-close-par-maybe) - (insert (format "<%sl>\n" type))) - (insert (cond - ((equal type "d") - (format "
    %s
    " desc-tag)) - ((and (equal type "o") counter) - (format "
  • " counter)) - (t "
  • "))) - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (cond - ((string-match "X" checkbox) "[X] ") - ((string-match " " checkbox) "[ ] ") - (t "[-] ")) - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t org-line)))) - -(provide 'org-html) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-html.el ends here diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el deleted file mode 100644 index 12cd0584fa0..00000000000 --- a/lisp/org/org-icalendar.el +++ /dev/null @@ -1,692 +0,0 @@ -;;; org-icalendar.el --- iCalendar export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-exp) - -(eval-when-compile (require 'cl)) - -(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-alarm-time 0 - "Number of minutes for triggering an alarm for exported timed events. -A zero value (the default) turns off the definition of an alarm trigger -for timed events. If non-zero, alarms are created. - -- a single alarm per entry is defined -- The alarm will go off N minutes before the event -- only a DISPLAY action is defined." - :group 'org-export-icalendar - :version "24.1" - :type 'integer) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-combined-description nil - "Calendar description for the combined iCalendar (all agenda files)." - :group 'org-export-icalendar - :version "24.1" - :type 'string) - -(defcustom org-icalendar-use-plain-timestamp t - "Non-nil means make an event from every plain time stamp." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-honor-noexport-tag nil - "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." - :group 'org-export-icalendar - :version "24.1" - :type 'boolean) - -(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) - "Contexts where iCalendar export should use a deadline time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Deadlines in TODO entries become calendar events. -event-if-not-todo Deadlines in non-TODO entries become calendar events. -todo-due Use deadlines in TODO entries as due-dates" - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag "Deadlines in non-TODO entries become events" - event-if-not-todo) - (const :tag "Deadline in TODO entries become events" - event-if-todo) - (const :tag "Deadlines in TODO entries become due-dates" - todo-due))) - -(defcustom org-icalendar-use-scheduled '(todo-start) - "Contexts where iCalendar export should use a scheduling time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Scheduling time stamps in TODO entries become an event. -event-if-not-todo Scheduling time stamps in non-TODO entries become an event. -todo-start Scheduling time stamps in TODO entries become start date. - Some calendar applications show TODO entries only after - that date." - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag - "SCHEDULED timestamps in non-TODO entries become events" - event-if-not-todo) - (const :tag "SCHEDULED timestamps in TODO entries become events" - event-if-todo) - (const :tag "SCHEDULED in TODO entries become start date" - todo-start))) - -(defcustom org-icalendar-categories '(local-tags category) - "Items that should be entered into the categories field. -This is a list of symbols, the following are valid: - -category The Org-mode category of the current file or tree -todo-state The todo state, if any -local-tags The tags, defined in the current line -all-tags All tags, including inherited ones." - :group 'org-export-icalendar - :type '(repeat - (choice - (const :tag "The file or tree category" category) - (const :tag "The TODO state" todo-state) - (const :tag "Tags defined in current line" local-tags) - (const :tag "All tags, including inherited ones" all-tags)))) - -(defcustom org-icalendar-include-todo nil - "Non-nil means export to iCalendar files should also cover TODO items. -Valid values are: -nil don't include any TODO items -t include all TODO items that are not in a DONE state -unblocked include all TODO items that are not blocked -all include both done and not done items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "Unblocked" unblocked) - (const :tag "All" all))) - -(defvar org-icalendar-verify-function nil - "Function to verify entries for iCalendar export. -This can be set to a function that will be called at each entry that -is considered for export to iCalendar. When the function returns nil, -the entry will be skipped. When it returns a non-nil value, the entry -will be considered for export. -This is used internally when an agenda buffer is exported to an ics file, -to make sure that only entries currently listed in the agenda will end -up in the ics file. But for normal iCalendar export, you can use this -for whatever you need.") - -(defcustom org-icalendar-include-bbdb-anniversaries nil - "Non-nil means a combined iCalendar files should include anniversaries. -The anniversaries are define in the BBDB database." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-sexps t - "Non-nil means export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-store-UID nil - "Non-nil means store any created UIDs in properties. -The iCalendar standard requires that all entries have a unique identifier. -Org will create these identifiers as needed. When this variable is non-nil, -the created UIDs will be stored in the ID property of the entry. Then the -next time this entry is exported, it will be exported with the same UID, -superseding the previous form of it. This is essential for -synchronization services. -This variable is not turned on by default because we want to avoid creating -a property drawer in every entry if people are only playing with this feature, -or if they are only using it locally." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-timezone (getenv "TZ") - "The time zone string for iCalendar export. -When nil or the empty string, use output from \(current-time-zone\)." - :group 'org-export-icalendar - :type '(choice - (const :tag "Unspecified" nil) - (string :tag "Time zone"))) - -;; Backward compatibility with previous variable -(defvar org-icalendar-use-UTC-date-time nil) -(defcustom org-icalendar-date-time-format - (if org-icalendar-use-UTC-date-time - ":%Y%m%dT%H%M%SZ" - ":%Y%m%dT%H%M%S") - "Format-string for exporting icalendar DATE-TIME. -See `format-time-string' for a full documentation. The only -difference is that `org-icalendar-timezone' is used for %Z. - -Interesting value are: - - \":%Y%m%dT%H%M%S\" for local time - - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone - - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" - - :group 'org-export-icalendar - :version "24.1" - :type '(choice - (const :tag "Local time" ":%Y%m%dT%H%M%S") - (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") - (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") - (string :tag "Explicit format"))) - -(defun org-icalendar-use-UTC-date-timep () - (char-equal (elt org-icalendar-date-time-format - (1- (length org-icalendar-date-time-format))) ?Z)) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in the variable `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-agenda-prepare-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-icalendar-start-file org-icalendar-combined-name)) - (org-icalendar-start-file category)) - (org-icalendar-print-entries combine) - (when (or (and combine (not files)) (not combine)) - (when (and combine org-icalendar-include-bbdb-anniversaries) - (require 'org-bbdb) - (org-bbdb-anniv-export-ical)) - (org-icalendar-finish-file) - (set-buffer ical-buffer) - (run-hooks 'org-before-save-iCalendar-file-hook) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-before-save-iCalendar-file-hook nil - "Hook run before an iCalendar file has been saved. -This can be used to modify the result of the export.") - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calendar application to re-read -the iCalendar file.") - -(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-icalendar-print-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (require 'org-agenda) - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-icalendar-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start tags - tmp pri categories location summary desc uid alarm alarm-time - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq pos (match-beginning 0) - ts (match-string 0) - tags (org-get-tags-at) - inc t - hd (condition-case nil - (org-icalendar-cleanup-string - (org-get-heading t)) - (error (throw :skip nil))) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new))) - categories (org-export-get-categories) - alarm-time (get-text-property (point) 'org-appt-warntime) - alarm-time (if alarm-time (string-to-number alarm-time) 0) - alarm "" - deadlinep nil scheduledp nil) - (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state)) - ;; donep (org-entry-is-done-p) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) - inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts))) - (when (and (not org-icalendar-use-plain-timestamp) - (not deadlinep) (not scheduledp)) - (throw :skip t)) - ;; don't export entries with a :noexport: tag - (when (and org-icalendar-honor-noexport-tag - (delq nil (mapcar (lambda(x) - (member x org-export-exclude-tags)) tags))) - (throw :skip t)) - (when (and - deadlinep - (if todo - (not (memq 'event-if-todo org-icalendar-use-deadline)) - (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) - (throw :skip t)) - (when (and - scheduledp - (if todo - (not (memq 'event-if-todo org-icalendar-use-scheduled)) - (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) - (throw :skip t)) - (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - ;; create an alarm entry if the entry is timed. this is not very general in that: - ;; (a) only one alarm per entry is defined, - ;; (b) only minutes are allowed for the trigger period ahead of the start time, and - ;; (c) only a DISPLAY action is defined. - ;; [ESF] - (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) - (car t1) (nth 1 t1) (nth 2 t1)) - (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" - summary (or alarm-time org-icalendar-alarm-time))) - (setq alarm ""))) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (let ((entry (substring ts 1 -1))) - (put-text-property 0 1 'uid - (concat " " prefix uid) entry) - (insert entry " " summary "\n"))) - (princ (format "BEGIN:VEVENT -UID: %s -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s%s -END:VEVENT\n" - (concat prefix uid) - (org-icalendar-ts-to-string ts "DTSTART") - (org-icalendar-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - categories - alarm))))) - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")))) - (princ (org-diary-to-ical-string sexp-buffer)) - (kill-buffer sexp-buffer)) - - (when org-icalendar-include-todo - (setq prefix "TODO-") - (goto-char (point-min)) - (while (re-search-forward org-complex-heading-regexp nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data - (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (cond - ;; check if the state is one we should use - ((eq org-icalendar-include-todo 'all) - ;; all should be included - t) - ((eq org-icalendar-include-todo 'unblocked) - ;; only undone entries that are not blocked - (and (member state org-not-done-keywords) - (or (not org-blocker-hook) - (save-match-data - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point-at-bol) - :from 'todo - :to 'done)))))) - ((eq org-icalendar-include-todo t) - ;; include everything that is not done - (member state org-not-done-keywords)))) - (setq hd (match-string 4) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - due (and (member 'todo-due org-icalendar-use-deadline) - (org-entry-get nil "DEADLINE")) - start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) - categories (org-export-get-categories) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new)))) - (and due (setq due (org-icalendar-ts-to-string due "DUE"))) - (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) - - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -UID: %s -%s -SUMMARY:%s%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - (concat prefix uid) - (or start dts) - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if due (concat "\n" due) "") - categories - pri status))))))))) - -(defun org-export-get-categories () - "Get categories according to `org-icalendar-categories'." - (let ((cs org-icalendar-categories) c rtn tmp) - (while (setq c (pop cs)) - (cond - ((eq c 'category) (push (org-get-category) rtn)) - ((eq c 'todo-state) - (setq tmp (org-get-todo-state)) - (and tmp (push tmp rtn))) - ((eq c 'local-tags) - (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) - ((eq c 'all-tags) - (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) - (mapconcat 'identity (nreverse rtn) ","))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s)))) - (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) - (let ((start 0)) - (while (string-match "\\([,;]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (setq s (org-trim s)) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters. -This seems to be more like RFC 2455, but it causes problems, so it is -not used right now." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s))) - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - (setq s (org-trim s))) - (while (string-match "\"" s) (setq s (replace-match "''" t t s))) - (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) - s)) - -(defun org-icalendar-start-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (if (> (length org-icalendar-timezone) 0) - org-icalendar-timezone - (cadr (current-time-zone)))) - (description org-icalendar-combined-description)) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -X-WR-CALDESC:%s -CALSCALE:GREGORIAN\n" name user timezone description)))) - -(defun org-icalendar-finish-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-icalendar-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) - t2 fmt have-time time) - (if (not t1) - "" - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time - (replace-regexp-in-string "%Z" - org-icalendar-timezone - org-icalendar-date-time-format t) - ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time - (and (org-icalendar-use-UTC-date-timep) - have-time)))))) - -(provide 'org-icalendar) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-icalendar.el ends here diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index ecf67f72f3a..fdd0ff00dea 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -1,6 +1,6 @@ ;;; org-id.el --- Global identifiers for Org-mode entries ;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -186,7 +186,7 @@ the link." :type 'boolean) (defcustom org-id-locations-file (convert-standard-filename - "~/.emacs.d/.org-id-locations") + (concat user-emacs-directory ".org-id-locations")) "The file for remembering in which file an ID was defined. This variable is only relevant when `org-id-track-globally' is set." :group 'org-id @@ -233,6 +233,7 @@ With optional argument FORCE, force the creation of a new ID." (org-entry-put (point) "ID" nil)) (org-id-get (point) 'create)) +;;;###autoload (defun org-id-copy () "Copy the ID of the entry at point to the kill ring. Create an ID if necessary." @@ -258,6 +259,7 @@ In any case, the ID of the entry is returned." (org-id-add-location id (buffer-file-name (buffer-base-buffer))) id))))) +;;;###autoload (defun org-id-get-with-outline-path-completion (&optional targets) "Use `outline-path-completion' to retrieve the ID of an entry. TARGETS may be a setting for `org-refile-targets' to define @@ -274,6 +276,7 @@ If necessary, the ID is created." (prog1 (org-id-get pom 'create) (move-marker pom nil)))) +;;;###autoload (defun org-id-get-with-outline-drilling (&optional targets) "Use an outline-cycling interface to retrieve the ID of an entry. This only finds entries in the current buffer, using `org-get-location'. @@ -320,6 +323,7 @@ With optional argument MARKERP, return the position as a new marker." ;; Creating new IDs +;;;###autoload (defun org-id-new (&optional prefix) "Create a new globally unique ID. @@ -343,7 +347,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (unless (org-uuidgen-p unique) (setq unique (org-id-uuid)))) ((eq org-id-method 'org) - (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) + (let* ((etime (org-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain (progn (require 'message) @@ -376,9 +380,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (substring rnd 18 20) (substring rnd 20 32)))) -(defun org-id-reverse-string (s) - (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) - (defun org-id-int-to-b36-one-digit (i) "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z." (cond @@ -432,7 +433,7 @@ and time is the usual three-integer representation of time." (if (= 2 (length parts)) (setq prefix (car parts) time (nth 1 parts)) (setq prefix nil time (nth 0 parts))) - (setq time (org-id-reverse-string time)) + (setq time (org-reverse-string time)) (setq time (list (org-id-b36-to-int (substring time 0 4)) (org-id-b36-to-int (substring time 4 8)) (org-id-b36-to-int (substring time 8 12)))) @@ -440,6 +441,7 @@ and time is the usual three-integer representation of time." ;; Storing ID locations (files) +;;;###autoload (defun org-id-update-id-locations (&optional files silent) "Scan relevant files for IDs. Store the relation between files and corresponding IDs. @@ -530,7 +532,9 @@ When CHECK is given, prepare detailed information about duplicate IDs." (org-id-hash-to-alist org-id-locations) org-id-locations))) (with-temp-file org-id-locations-file - (print out (current-buffer)))))) + (let ((print-level nil) + (print-length nil)) + (print out (current-buffer))))))) (defun org-id-locations-load () "Read the data from `org-id-locations-file'." diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 6e6f2bf1589..fa5f0608498 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -1,5 +1,5 @@ ;;; org-indent.el --- Dynamic indentation for Org-mode -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -88,7 +88,7 @@ This is used locally in each buffer being initialized.") (defvar org-hide-leading-stars-before-indent-mode nil "Used locally.") (defvar org-indent-modified-headline-flag nil - "Non-nil means the last deletion operated on an headline. + "Non-nil means the last deletion operated on a headline. It is modified by `org-indent-notify-modified-headline'.") @@ -147,8 +147,8 @@ useful to make it ever so slightly different." (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (with-silent-modifications - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (org-with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) ;;;###autoload (define-minor-mode org-indent-mode @@ -182,11 +182,11 @@ during idle time." (org-set-local 'org-hide-leading-stars-before-indent-mode org-hide-leading-stars) (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'filter-buffer-substring-functions) - (add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete)))) + (org-add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete))) + nil t) (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) (org-add-hook 'before-change-functions 'org-indent-notify-modified-headline nil 'local) @@ -342,50 +342,50 @@ stopped." ;; 2. For each line, set `line-prefix' and `wrap-prefix' ;; properties depending on the type of line (headline, ;; inline task, item or other). - (with-silent-modifications - (while (and (<= (point) end) (not (eobp))) - (cond - ;; When in asynchronous mode, check if interrupt is - ;; required. - ((and delay (input-pending-p)) (throw 'interrupt (point))) - ;; In asynchronous mode, take a break of - ;; `org-indent-agent-resume-delay' every DELAY to avoid - ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) - (setq org-indent-agent-resume-timer - (run-with-idle-timer - (time-add (current-idle-time) - org-indent-agent-resume-delay) - nil #'org-indent-initialize-agent)) - (throw 'interrupt (point))) - ;; Headline or inline task. - ((looking-at org-outline-regexp) - (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (line (* added-ind-per-lvl (1- nstars))) - (wrap (+ line (1+ nstars)))) - (cond - ;; Headline: new value for PF. - ((looking-at limited-re) - (org-indent-set-line-properties line wrap t) - (setq pf wrap)) - ;; End of inline task: PF-INLINE is now nil. - ((looking-at "\\*+ end[ \t]*$") - (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline nil)) - ;; Start of inline task. Determine if it contains - ;; text, or if it is only one line long. Set - ;; PF-INLINE accordingly. - (t (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) - ;; List item: `wrap-prefix' is set where body starts. - ((org-at-item-p) - (let* ((line (or pf-inline pf 0)) - (wrap (+ (org-list-item-body-column (point)) line))) - (org-indent-set-line-properties line wrap nil))) - ;; Normal line: use PF-INLINE, PF or nil as prefixes. - (t (let* ((line (or pf-inline pf 0)) - (wrap (+ line (org-get-indentation)))) - (org-indent-set-line-properties line wrap nil)))))))))) + (org-with-silent-modifications + (while (and (<= (point) end) (not (eobp))) + (cond + ;; When in asynchronous mode, check if interrupt is + ;; required. + ((and delay (input-pending-p)) (throw 'interrupt (point))) + ;; In asynchronous mode, take a break of + ;; `org-indent-agent-resume-delay' every DELAY to avoid + ;; blocking any other idle timer or process output. + ((and delay (time-less-p time-limit (current-time))) + (setq org-indent-agent-resume-timer + (run-with-idle-timer + (time-add (current-idle-time) + org-indent-agent-resume-delay) + nil #'org-indent-initialize-agent)) + (throw 'interrupt (point))) + ;; Headline or inline task. + ((looking-at org-outline-regexp) + (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) + (line (* added-ind-per-lvl (1- nstars))) + (wrap (+ line (1+ nstars)))) + (cond + ;; Headline: new value for PF. + ((looking-at limited-re) + (org-indent-set-line-properties line wrap t) + (setq pf wrap)) + ;; End of inline task: PF-INLINE is now nil. + ((looking-at "\\*+ end[ \t]*$") + (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline nil)) + ;; Start of inline task. Determine if it contains + ;; text, or if it is only one line long. Set + ;; PF-INLINE accordingly. + (t (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) + ;; List item: `wrap-prefix' is set where body starts. + ((org-at-item-p) + (let* ((line (or pf-inline pf 0)) + (wrap (+ (org-list-item-body-column (point)) line))) + (org-indent-set-line-properties line wrap nil))) + ;; Normal line: use PF-INLINE, PF or nil as prefixes. + (t (let* ((line (or pf-inline pf 0)) + (wrap (+ line (org-get-indentation)))) + (org-indent-set-line-properties line wrap nil)))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. @@ -412,7 +412,7 @@ range of inserted text. DUMMY is an unused argument. This function is meant to be called by `after-change-functions'." (when org-indent-mode (save-match-data - ;; If an headline was modified or inserted, set properties until + ;; If a headline was modified or inserted, set properties until ;; next headline. (if (or org-indent-modified-headline-flag (save-excursion diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 421dde8e204..8a2d7176257 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -1,6 +1,6 @@ ;;; org-info.el --- Support for links to Info nodes from within Org-Mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 43913acacde..de4267c8d9c 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -1,6 +1,6 @@ ;;; org-inlinetask.el --- Tasks independent of outline hierarchy -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -27,31 +27,25 @@ ;;; Commentary: ;; ;; This module implements inline tasks in Org-mode. Inline tasks are -;; tasks that have all the properties of normal outline nodes, including -;; the ability to store meta data like scheduling dates, TODO state, tags -;; and properties. However, these nodes are treated specially by the -;; visibility cycling and export commands. +;; tasks that have all the properties of normal outline nodes, +;; including the ability to store meta data like scheduling dates, +;; TODO state, tags and properties. However, these nodes are treated +;; specially by the visibility cycling. ;; -;; Visibility cycling exempts these nodes from cycling. So whenever their -;; parent is opened, so are these tasks. This will only work with -;; `org-cycle', so if you are also using other commands to show/hide -;; entries, you will occasionally find these tasks to behave like -;; all other outline nodes, seemingly splitting the text of the parent -;; into children. +;; Visibility cycling exempts these nodes from cycling. So whenever +;; their parent is opened, so are these tasks. This will only work +;; with `org-cycle', so if you are also using other commands to +;; show/hide entries, you will occasionally find these tasks to behave +;; like all other outline nodes, seemingly splitting the text of the +;; parent into children. ;; -;; Export commands do not treat these nodes as part of the sectioning -;; structure, but as a special inline text that is either removed, or -;; formatted in some special way. This in handled by -;; `org-inlinetask-export' and `org-inlinetask-export-templates' -;; variables. +;; Special fontification of inline tasks, so that they can be +;; immediately recognized. From the stars of the headline, only the +;; first and the last two will be visible, the others will be hidden +;; using the `org-hide' face. ;; -;; Special fontification of inline tasks, so that they can be immediately -;; recognized. From the stars of the headline, only the first and the -;; last two will be visible, the others will be hidden using the -;; `org-hide' face. -;; -;; An inline task is identified solely by a minimum outline level, given -;; by the variable `org-inlinetask-min-level', default 15. +;; An inline task is identified solely by a minimum outline level, +;; given by the variable `org-inlinetask-min-level', default 15. ;; ;; If you need to have a time planning line (DEADLINE etc), drawers, ;; for example LOGBOOK of PROPERTIES, or even normal text as part of @@ -109,71 +103,9 @@ the value of this variable." "Non-nil means display the first star of an inline task as additional marker. When nil, the first star is not shown." :tag "Org Inline Tasks" - :group 'org-structure) - -(defcustom org-inlinetask-export t - "Non-nil means export inline tasks. -When nil, they will not be exported." - :group 'org-inlinetask + :group 'org-structure :type 'boolean) -(defvar org-inlinetask-export-templates - '((html "
    %s%s
    %s
    " - '((unless (eq todo "") - (format "%s%s " - class todo todo priority)) - heading content)) - (odt "%s" '((org-odt-format-inlinetask heading content - todo priority tags))) - - (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}" - '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority)) - heading content)) - (ascii " -- %s%s%s" - '((unless (eq todo "") (format "%s%s " todo priority)) - heading - (unless (eq content "") - (format "\n ¦ %s" - (mapconcat 'identity (org-split-string content "\n") - "\n ¦ "))))) - (docbook " - -%s%s -%s - -" - '((unless (eq todo "") (format "%s%s " todo priority)) - heading content))) - "Templates for inline tasks in various exporters. - -This variable is an alist in the shape of \(BACKEND STRING OBJECTS\). - -BACKEND is the name of the backend for the template \(ascii, html...\). - -STRING is a format control string. - -OBJECTS is a list of elements to be substituted into the format -string. They can be of any type, from a string to a form -returning a value (thus allowing conditional insertion). A nil -object will be substituted as the empty string. Obviously, there -must be at least as many objects as %-sequences in the format -string. - -Moreover, the following special keywords are provided: `todo', -`priority', `heading', `content', `tags'. If some of them are not -defined in an inline task, their value is the empty string. - -As an example, valid associations are: - -\(html \"
    • %s

      %s

    \" \(heading content\)\) - -or, with the additional package \"todonotes\" for LaTeX, - -\(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\" - '\(\(unless \(eq todo \"\"\) - \(format \"\\textsc{%s%s}\" todo priority\)\) - heading content\)\)\)") - (defvar org-odd-levels-only) (defvar org-keyword-time-regexp) (defvar org-drawer-regexp) @@ -328,89 +260,6 @@ If the task has an end part, also demote it." (goto-char beg) (org-fixup-indentation diff))))))) -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-inlinetask-export-handler () - "Handle headlines with level larger or equal to `org-inlinetask-min-level'. -Either remove headline and meta data, or do special formatting." - (goto-char (point-min)) - (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp)) - (inline-re (concat (org-inlinetask-outline-regexp) ".*"))) - (while (re-search-forward inline-re nil t) - (let ((headline (match-string 0)) - (beg (point-at-bol)) - (end (copy-marker (save-excursion - (org-inlinetask-goto-end) (point)))) - content) - ;; Delete SCHEDULED, DEADLINE... - (while (re-search-forward keywords-re end t) - (delete-region (point-at-bol) (1+ (point-at-eol)))) - (goto-char beg) - ;; Delete drawers - (while (re-search-forward org-drawer-regexp end t) - (when (save-excursion (re-search-forward org-property-end-re nil t)) - (delete-region beg (1+ (match-end 0))))) - ;; Get CONTENT, if any. - (goto-char beg) - (forward-line 1) - (unless (= (point) end) - (setq content (buffer-substring (point) - (save-excursion (goto-char end) - (forward-line -1) - (point))))) - ;; Remove the task. - (goto-char beg) - (delete-region beg end) - (when (and org-inlinetask-export - (assq org-export-current-backend - org-inlinetask-export-templates)) - ;; Format CONTENT, if appropriate. - (setq content - (if (not (and content (string-match "\\S-" content))) - "" - ;; Ensure CONTENT has minimal indentation, a single - ;; newline character at its boundaries, and isn't - ;; protected. - (when (string-match "\\`\\([ \t]*\n\\)+" content) - (setq content (substring content (match-end 0)))) - (when (string-match "[ \t\n]+\\'" content) - (setq content (substring content 0 (match-beginning 0)))) - (org-add-props - (concat "\n\n" (org-remove-indentation content) "\n\n") - '(org-protected nil org-native-text nil)))) - - (when (string-match org-complex-heading-regexp headline) - (let* ((nil-to-str - (function - ;; Change nil arguments into empty strings. - (lambda (el) (or (eval el) "")))) - ;; Set up keywords provided to templates. - (todo (or (match-string 2 headline) "")) - (class (or (and (eq "" todo) "") - (if (member todo org-done-keywords) "done" "todo"))) - (priority (or (match-string 3 headline) "")) - (heading (or (match-string 4 headline) "")) - (tags (or (match-string 5 headline) "")) - ;; Read `org-inlinetask-export-templates'. - (backend-spec (assq org-export-current-backend - org-inlinetask-export-templates)) - (format-str (org-add-props (nth 1 backend-spec) - '(org-protected t org-native-text t))) - (tokens (cadr (nth 2 backend-spec))) - ;; Build export string. Ensure it won't break - ;; surrounding lists by giving it arbitrary high - ;; indentation. - (export-str (org-add-props - (eval (append '(format format-str) - (mapcar nil-to-str tokens))) - '(original-indentation 1000)))) - ;; Ensure task starts a new paragraph. - (unless (or (bobp) - (save-excursion (forward-line -1) - (looking-at "[ \t]*$"))) - (insert "\n")) - (insert export-str) - (unless (bolp) (insert "\n"))))))))) - (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." (save-excursion @@ -467,7 +316,8 @@ Either remove headline and meta data, or do special formatting." ((= end start)) ;; Inlinetask was folded: expand it. ((get-char-property (1+ start) 'invisible) - (org-show-entry)) + (outline-flag-region start end nil) + (org-cycle-hide-drawers 'children)) (t (outline-flag-region start end t))))) (defun org-inlinetask-remove-END-maybe () @@ -476,9 +326,6 @@ Either remove headline and meta data, or do special formatting." org-inlinetask-min-level)) (replace-match ""))) -(eval-after-load "org-exp" - '(add-hook 'org-export-preprocess-before-backend-specifics-hook - 'org-inlinetask-export-handler)) (eval-after-load "org" '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index afacae3ec34..8f9761b323f 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -1,6 +1,6 @@ ;;; org-irc.el --- Store links to IRC sessions ;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; ;; Author: Philip Jackson ;; Keywords: erc, irc, link, org @@ -105,7 +105,7 @@ attributes that are found." ((eq major-mode 'erc-mode) (org-irc-erc-store-link)))) -(defun org-irc-elipsify-description (string &optional after) +(defun org-irc-ellipsify-description (string &optional after) "Remove unnecessary white space from STRING and add ellipses if necessary. Strip starting and ending white space from STRING and replace any chars that the value AFTER with '...'" @@ -158,7 +158,7 @@ the session itself." (progn (org-store-link-props :type "file" - :description (concat "'" (org-irc-elipsify-description + :description (concat "'" (org-irc-ellipsify-description (cadr parsed-line) 20) "' from an IRC conversation") :link (concat "file:" (car parsed-line) "::" diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el deleted file mode 100644 index 08c01108b98..00000000000 --- a/lisp/org/org-jsinfo.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements the support for Sebastian Rose's JavaScript -;; org-info.js to display an org-mode file exported to HTML in an -;; Info-like way, or using folding similar to the outline structure -;; org org-mode itself. - -;; Documentation for using this module is in the Org manual. The script -;; itself is documented by Sebastian Rose in a file distributed with -;; the script. FIXME: Accurate pointers! - -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org-exp) -(require 'org-html) - -(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt)) -(add-hook 'org-export-options-filters 'org-infojs-handle-options) - -(defgroup org-infojs nil - "Options specific for using org-info.js in HTML export of Org-mode files." - :tag "Org Export HTML INFOJS" - :group 'org-export-html) - -(defcustom org-export-html-use-infojs 'when-configured - "Should Sebastian Rose's Java Script org-info.js be linked into HTML files? -This option can be nil or t to never or always use the script. It can -also be the symbol `when-configured', meaning that the script will be -linked into the export file if and only if there is a \"#+INFOJS_OPT:\" -line in the buffer. See also the variable `org-infojs-options'." - :group 'org-export-html - :group 'org-infojs - :type '(choice - (const :tag "Never" nil) - (const :tag "When configured in buffer" when-configured) - (const :tag "Always" t))) - -(defconst org-infojs-opts-table - '((path PATH "http://orgmode.org/org-info.js") - (view VIEW "info") - (toc TOC :table-of-contents) - (ftoc FIXED_TOC "0") - (tdepth TOC_DEPTH "max") - (sdepth SECTION_DEPTH "max") - (mouse MOUSE_HINT "underline") - (buttons VIEW_BUTTONS "0") - (ltoc LOCAL_TOC "1") - (up LINK_UP :link-up) - (home LINK_HOME :link-home)) - "JavaScript options, long form for script, default values.") - -(defvar org-infojs-options) -(when (and (boundp 'org-infojs-options) - (assq 'runs org-infojs-options)) - (setq org-infojs-options (delq (assq 'runs org-infojs-options) - org-infojs-options))) - -(defcustom org-infojs-options - (mapcar (lambda (x) (cons (car x) (nth 2 x))) - org-infojs-opts-table) - "Options settings for the INFOJS JavaScript. -Each of the options must have an entry in `org-export-html/infojs-opts-table'. -The value can either be a string that will be passed to the script, or -a property. This property is then assumed to be a property that is defined -by the Export/Publishing setup of Org. -The `sdepth' and `tdepth' parameters can also be set to \"max\", which -means to use the maximum value consistent with other options." - :group 'org-infojs - :type - `(set :greedy t :inline t - ,@(mapcar - (lambda (x) - (list 'cons (list 'const (car x)) - '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) - org-infojs-opts-table))) - -(defcustom org-infojs-template - " - -" - "The template for the export style additions when org-info.js is used. -Option settings will replace the %MANAGER-OPTIONS cookie." - :group 'org-infojs - :type 'string) - -(defun org-infojs-handle-options (exp-plist) - "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly." - (if (or (not org-export-html-use-infojs) - (and (eq org-export-html-use-infojs 'when-configured) - (or (not (plist-get exp-plist :infojs-opt)) - (string-match "\\" - (plist-get exp-plist :infojs-opt))))) - ;; We do not want to use the script - exp-plist - ;; We do want to use the script, set it up - (let ((template org-infojs-template) - (ptoc (plist-get exp-plist :table-of-contents)) - (hlevels (plist-get exp-plist :headline-levels)) - tdepth sdepth s v e opt var val table default) - (setq sdepth hlevels - tdepth hlevels) - (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) - (setq v (plist-get exp-plist :infojs-opt) - table org-infojs-opts-table) - (while (setq e (pop table)) - (setq opt (car e) var (nth 1 e) - default (cdr (assoc opt org-infojs-options))) - (and (symbolp default) (not (memq default '(t nil))) - (setq default (plist-get exp-plist default))) - (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) - (setq val (match-string 1 v)) - (setq val default)) - (cond - ((eq opt 'path) - (setq template - (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) - ((eq opt 'sdepth) - (if (integerp (read val)) - (setq sdepth (min (read val) hlevels)))) - ((eq opt 'tdepth) - (if (integerp (read val)) - (setq tdepth (min (read val) hlevels)))) - (t - (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) s)))) - - ;; Now we set the depth of the *generated* TOC to SDEPTH, because the - ;; toc will actually determine the splitting. How much of the toc will - ;; actually be displayed is governed by the TDEPTH option. - (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) - - ;; The table of contents should not show more sections then we generate - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) s) - - (setq s (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) (cdr x))) - s "\n")) - (when (and s (> (length s) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq s (replace-match s t t template)) - (setq exp-plist - (plist-put - exp-plist :style-extra - (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) - ;; This script absolutely needs the table of contents, to we change that - ;; setting - (if (not (plist-get exp-plist :table-of-contents)) - (setq exp-plist (plist-put exp-plist :table-of-contents t))) - ;; Return the modified property list - exp-plist))) - -(defun org-infojs-options-inbuffer-template () - (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s" - (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil) - (let ((a (cdr (assoc 'toc org-infojs-options)))) - (cond ((memq a '(nil t)) a) - (t (plist-get (org-infile-export-plist) :table-of-contents)))) - (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil) - (cdr (assoc 'mouse org-infojs-options)) - (cdr (assoc 'buttons org-infojs-options)) - (cdr (assoc 'path org-infojs-options)))) - -(provide 'org-infojs) -(provide 'org-jsinfo) - -;;; org-jsinfo.el ends here diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el deleted file mode 100644 index 609bcbee103..00000000000 --- a/lisp/org/org-latex.el +++ /dev/null @@ -1,2901 +0,0 @@ -;;; org-latex.el --- LaTeX exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-latex.el -;; Author: Bastien Guerry -;; Maintainer: Carsten Dominik -;; Keywords: org, wp, tex -;; Description: Converts an org-mode buffer into LaTeX - -;; 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 . - -;;; Commentary: -;; -;; This library implements a LaTeX exporter for org-mode. -;; -;; It is part of Org and will be autoloaded -;; -;; The interactive functions are similar to those of the HTML exporter: -;; -;; M-x `org-export-as-latex' -;; M-x `org-export-as-pdf' -;; M-x `org-export-as-pdf-and-open' -;; M-x `org-export-as-latex-batch' -;; M-x `org-export-as-latex-to-buffer' -;; M-x `org-export-region-as-latex' -;; M-x `org-replace-region-by-latex' -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'footnote) -(require 'org) -(require 'org-exp) -(require 'org-macs) -(require 'org-beamer) - -;;; Variables: -(defvar org-export-latex-class nil) -(defvar org-export-latex-class-options nil) -(defvar org-export-latex-header nil) -(defvar org-export-latex-append-header nil) -(defvar org-export-latex-options-plist nil) -(defvar org-export-latex-todo-keywords-1 nil) -(defvar org-export-latex-complex-heading-re nil) -(defvar org-export-latex-not-done-keywords nil) -(defvar org-export-latex-done-keywords nil) -(defvar org-export-latex-display-custom-times nil) -(defvar org-export-latex-all-targets-re nil) -(defvar org-export-latex-add-level 0) -(defvar org-export-latex-footmark-seen nil - "List of footnotes markers seen so far by exporter.") -(defvar org-export-latex-sectioning "") -(defvar org-export-latex-sectioning-depth 0) -(defvar org-export-latex-special-keyword-regexp - (concat "\\<\\(" org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string"\\)") - "Regexp matching special time planning keywords plus the time after it.") -(defvar org-re-quote) ; dynamically scoped from org.el -(defvar org-commentsp) ; dynamically scoped from org.el - -;;; User variables: - -(defgroup org-export-latex nil - "Options for exporting Org-mode files to LaTeX." - :tag "Org Export LaTeX" - :group 'org-export) - -(defcustom org-export-latex-default-class "article" - "The default LaTeX class." - :group 'org-export-latex - :type '(string :tag "LaTeX class")) - -(defcustom org-export-latex-classes - '(("article" - "\\documentclass[11pt]{article}" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}") - ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) - ("report" - "\\documentclass[11pt]{report}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("book" - "\\documentclass[11pt]{book}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("beamer" - "\\documentclass{beamer}" - org-beamer-sectioning - )) - "Alist of LaTeX classes and associated header and structure. -If #+LaTeX_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - (numbered-section . unnumbered-section\) - ...\) - -The header string ------------------ - -The HEADER-STRING is the header that will be inserted into the LaTeX file. -It should contain the \\documentclass macro, and anything else that is needed -for this setup. To this header, the following commands will be added: - -- Calls to \\usepackage for all packages mentioned in the variables - `org-export-latex-default-packages-alist' and - `org-export-latex-packages-alist'. Thus, your header definitions should - avoid to also request these packages. - -- Lines specified via \"#+LaTeX_HEADER:\" - -If you need more control about the sequence in which the header is built -up, or if you want to exclude one of these building blocks for a particular -class, you can use the following macro-like placeholders. - - [DEFAULT-PACKAGES] \\usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - [BEAMER-HEADER-EXTRA] the beamer extra headers - -So a header like - - \\documentclass{article} - [NO-DEFAULT-PACKAGES] - [EXTRA] - \\providecommand{\\alert}[1]{\\textbf{#1}} - [PACKAGES] - -will omit the default packages, and will include the #+LaTeX_HEADER lines, -then have a call to \\providecommand, and then place \\usepackage commands -based on the content of `org-export-latex-packages-alist'. - -If your header or `org-export-latex-default-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with -a coding system derived from `buffer-file-coding-system'. See also the -variable `org-export-latex-inputenc-alist' for a way to influence this -mechanism. - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements following -the header string. For each sectioning level, a number of strings is -specified. A %s formatter is mandatory in each section string and will -be replaced by the title of the section. - -Instead of a cons cell (numbered . unnumbered), you can also provide a list -of 2 or 4 elements, - - (numbered-open numbered-close) - -or - - (numbered-open numbered-close unnumbered-open unnumbered-close) - -providing opening and closing strings for a LaTeX environment that should -represent the document section. The opening clause should have a %s -to represent the section title. - -Instead of a list of sectioning commands, you can also specify a -function name. That function will be called with two parameters, -the (reduced) level of the headline, and the headline text. The function -must return a cons cell with the (possibly modified) headline text, and the -sectioning list in the cdr." - :group 'org-export-latex - :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) - -(defcustom org-export-latex-inputenc-alist nil - "Alist of inputenc coding system names, and what should really be used. -For example, adding an entry - - (\"utf8\" . \"utf8x\") - -will cause \\usepackage[utf8x]{inputenc} to be used for buffers that -are written as utf8 files." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) - - -(defcustom org-export-latex-emphasis-alist - '(("*" "\\textbf{%s}" nil) - ("/" "\\emph{%s}" nil) - ("_" "\\underline{%s}" nil) - ("+" "\\st{%s}" nil) - ("=" "\\protectedtexttt" t) - ("~" "\\verb" t)) - "Alist of LaTeX expressions to convert emphasis fontifiers. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a format string to wrap fontified text with. -If it is \"\\verb\", Org will automatically select a delimiter -character that is not in the string. \"\\protectedtexttt\" will use \\texttt -to typeset and try to protect special characters. -The third element decides whether to protect converted text from other -conversions." - :group 'org-export-latex - :type 'alist) - -(defcustom org-export-latex-title-command "\\maketitle" - "The command used to insert the title just after \\begin{document}. -If this string contains the formatting specification \"%s\" then -it will be used as a format string, passing the title as an -argument." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-import-inbuffer-stuff nil - "Non-nil means define TeX macros for Org's inbuffer definitions. -For example \orgTITLE for #+TITLE." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-date-format - "\\today" - "Format string for \\date{...}." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}" - "Markup for TODO keywords, as a printf format. -This can be a single format for all keywords, a cons cell with separate -formats for not-done and done states, or an association list with setup -for individual keywords. If a keyword shows up for which there is no -markup defined, the first one in the association list will be used." - :group 'org-export-latex - :type '(choice - (string :tag "Default") - (cons :tag "Distinguish undone and done" - (string :tag "Not-DONE states") - (string :tag "DONE states")) - (repeat :tag "Per keyword markup" - (cons - (string :tag "Keyword") - (string :tag "Markup"))))) - -(defcustom org-export-latex-tag-markup "\\textbf{%s}" - "Markup for tags, as a printf format." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-markup "\\textit{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}" - "A printf format string to be applied to inactive time stamps." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-href-format "\\href{%s}{%s}" - "A printf format string to be applied to href links. -The format must contain either two %s instances or just one. -If it contains two %s instances, the first will be filled with -the link, the second with the link description. If it contains -only one, the %s will be filled with the link." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" - "A printf format string to be applied to hyperref links. -The format must contain one or two %s instances. The first one -will be filled with the link, the second with its description." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-options-format - "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n" - "A format string for hyperref options. -When non-nil, it must contain three %s format specifications -which will respectively be replaced by the document's keywords, -its description and the Org's version number, as a string. Set -this option to the empty string if you don't want to include -hyperref options altogether." - :type 'string - :version "24.3" - :group 'org-export-latex) - -(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," - "Text used to separate footnotes." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-quotes - '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'")) - ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-latex - :version "24.1" - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - -(defcustom org-export-latex-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-table-caption-above t - "When non-nil, the caption is set above the table. When nil, -the caption is set below the table." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-tables-column-borders nil - "When non-nil, grouping columns can cause outer vertical lines in tables. -When nil, grouping causes only separation lines between groups." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-tstart nil - "LaTeX command for top rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\toprule" "\\toprule"))) - -(defcustom org-export-latex-tables-hline "\\hline" - "LaTeX command to use for a rule somewhere in the middle of a table." - :group 'org-export-latex - :version "24.1" - :type '(choice - (string :tag "String") - (const :tag "Standard: \\hline" "\\hline") - (const :tag "Booktabs default: \\midrule" "\\midrule"))) - -(defcustom org-export-latex-tables-tend nil - "LaTeX command for bottom rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\bottomrule" "\\bottomrule"))) - -(defcustom org-export-latex-low-levels 'itemize - "How to convert sections below the current level of sectioning. -This is specified by the `org-export-headline-levels' option or the -value of \"H:\" in Org's #+OPTION line. - -This can be either nil (skip the sections), `description', `itemize', -or `enumerate' (convert the sections as the corresponding list type), or -a string to be used instead of \\section{%s}. In this latter case, -the %s stands here for the inserted headline and is mandatory. - -It may also be a list of three string to define a user-defined environment -that should be used. The first string should be the like -\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up -to two occurrences of %s for the title and a label, respectively. The third -string should be like \"\\end{itemize\"." - :group 'org-export-latex - :type '(choice (const :tag "Ignore" nil) - (const :tag "Convert as descriptive list" description) - (const :tag "Convert as itemized list" itemize) - (const :tag "Convert as enumerated list" enumerate) - (list :tag "User-defined environment" - :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s") - (string :tag "Start") - (string :tag "End") - (string :tag "item")) - (string :tag "Use a section string" :value "\\subparagraph{%s}"))) - -(defcustom org-export-latex-list-parameters - '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$") - "Parameters for the LaTeX list exporter. -These parameters will be passed on to `org-list-to-latex', which in turn -will pass them (combined with the LaTeX default list parameters) to -`org-list-to-generic'." - :group 'org-export-latex - :type 'plist) - -(defcustom org-export-latex-verbatim-wrap - '("\\begin{verbatim}\n" . "\\end{verbatim}") - "Environment to be wrapped around a fixed-width section in LaTeX export. -This is a cons with two strings, to be added before and after the -fixed-with text. - -Defaults to \\begin{verbatim} and \\end{verbatim}." - :group 'org-export-translation - :group 'org-export-latex - :type '(cons (string :tag "Open") - (string :tag "Close"))) - -(defcustom org-export-latex-listings nil - "Non-nil means export source code using the listings package. -This package will fontify source code, possibly even with color. -If you want to use this, you also need to make LaTeX use the -listings package, and if you want to have color, the color -package. Just add these to `org-export-latex-packages-alist', -for example using customize, or with something like - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) - -Alternatively, - - (setq org-export-latex-listings 'minted) - -causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add -the minted package to `org-export-latex-packages-alist', for -example using customize, or with - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) - -In addition, it is necessary to install -pygments (http://pygments.org), and to configure the variable -`org-latex-to-pdf-process' so that the -shell-escape option is -passed to pdflatex. -" - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") - (c "C") (cc "C++") - (fortran "fortran") - (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") - (html "HTML") (xml "XML") - (tex "TeX") (latex "TeX") - (shell-script "bash") - (gnuplot "Gnuplot") - (ocaml "Caml") (caml "Caml") - (sql "SQL") (sqlite "sql")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the listings package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present." - :group 'org-export-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-w-names t - "Non-nil means export names of named code blocks. -Code blocks exported with the listings package (controlled by the -`org-export-latex-listings' variable) can be named in the style -of noweb." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-minted-langs - '((emacs-lisp "common-lisp") - (cc "c++") - (cperl "perl") - (shell-script "bash") - (caml "ocaml")) - "Alist mapping languages to their minted language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the minted package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present. - -Note that minted uses all lower case for language identifiers, -and that the full list of language identifiers can be obtained -with: -pygmentize -L lexers -" - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-options nil - "Association list of options for the latex listings package. - -These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-listings-options - '((\"basicstyle\" \"\\small\") - (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) - -will typeset the code in a small size font with underlined, bold -black keywords. - -Note that the same options will be applied to blocks of all -languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) - -(defcustom org-export-latex-minted-options nil - "Association list of options for the latex minted package. - -These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-minted-options - '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) - -will result in src blocks being exported with - -\\begin{minted}[bgcolor=bg,frame=lines]{} - -as the start of the minted environment. Note that the same -options will be applied to blocks of all languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) - -(defvar org-export-latex-custom-lang-environments nil - "Association list mapping languages to language-specific latex - environments used during export of src blocks by the listings - and minted latex packages. For example, - - (setq org-export-latex-custom-lang-environments - '((python \"pythoncode\"))) - - would have the effect that if org encounters begin_src python - during latex export it will output - - \\begin{pythoncode} - - \\end{pythoncode}") - -(defcustom org-export-latex-remove-from-headlines - '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. -Non-nil means remove this keyword type from the headline. - -Don't remove the keys, just change their values. - -Obsolete, this variable is no longer used. Use the separate -variables `org-export-with-todo-keywords', `org-export-with-priority', -and `org-export-with-tags' instead." - :type 'plist - :group 'org-export-latex) - -(defcustom org-export-latex-image-default-option "width=.9\\linewidth" - "Default option for images." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-default-figure-position "htb" - "Default position for latex figures." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-tabular-environment "tabular" - "Default environment used to build tables." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}" - "Format string for links with unknown path type." - :group 'org-export-latex - :version "24.3" - :type 'string) - -(defcustom org-export-latex-inline-image-extensions - '("pdf" "jpeg" "jpg" "png" "ps" "eps") - "Extensions of image files that can be inlined into LaTeX. -Note that the image extension *actually* allowed depend on the way the -LaTeX file is processed. When used with pdflatex, pdf, jpg and png images -are OK. When processing through dvi to Postscript, only ps and eps are -allowed. The default we use here encompasses both." - :group 'org-export-latex - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTeX file." - :group 'org-export-latex - :type 'coding-system) - -(defgroup org-export-pdf nil - "Options for exporting Org-mode files to PDF, via LaTeX." - :tag "Org Export PDF" - :group 'org-export-latex - :group 'org-export) - -(defcustom org-latex-to-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file and process latex -fragments to pdf files.By default,this is a list of strings,and each of -strings will be given to the shell as a command. %f in the command will -be replaced by the full file name, %b by the file base name (i.e. without -extension) and %o by the base directory of the file. - -If you set `org-create-formula-image-program' -`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a -sublist which contains your own command(s) for LaTeX fragments -previewing, like this: - - '(\"xelatex -interaction nonstopmode -output-directory %o %f\" - \"xelatex -interaction nonstopmode -output-directory %o %f\" - ;; use below command(s) to convert latex fragments - (\"xelatex %f\")) - -With no such sublist, the default command used to convert LaTeX -fragments will be the first string in the list. - -The reason why this is a list is that it usually takes several runs of -`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever -mechanism to detect which of these commands have to be run to get to a stable -result, and it also does not do any error checking. - -By default, Org uses 3 runs of `pdflatex' to do the processing. If you -have texi2dvi on your system and if that does not cause the infamous -egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice. Org does offer it as one -of the customize options. - -Alternatively, this may be a Lisp function that does the processing, so you -could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. -This function should accept the file name as its single argument." - :group 'org-export-pdf - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "2 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "xelatex,bibtex,xelatex,xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "texi2dvi" - ("texi2dvi -p -b -c -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) - (function))) - -(defcustom org-export-pdf-logfiles - '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") - "The list of file extensions to consider as LaTeX logfiles." - :group 'org-export-pdf - :version "24.1" - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-pdf-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -These are the .aux, .log, .out, and .toc files." - :group 'org-export-pdf - :type 'boolean) - -;;; Hooks - -(defvar org-export-latex-after-initial-vars-hook nil - "Hook run before LaTeX export. -The exact moment is after the initial variables like org-export-latex-class -have been determined from the environment.") - -(defvar org-export-latex-after-blockquotes-hook nil - "Hook run during LaTeX export, after blockquote, verse, center are done.") - -(defvar org-export-latex-final-hook nil - "Hook run in the finalized LaTeX buffer.") - -(defvar org-export-latex-after-save-hook nil - "Hook run in the finalized LaTeX buffer, after it has been saved.") - -;;; Autoload functions: - -;;;###autoload -(defun org-export-as-latex-batch () - "Call `org-export-as-latex', may be used in batch processing. -For example: - -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-latex-batch" - (org-export-as-latex org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-latex-to-buffer (arg) - "Call `org-export-as-latex` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-latex'." - (interactive "P") - (org-export-as-latex arg nil "*Org LaTeX Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org LaTeX Export*"))) - -;;;###autoload -(defun org-replace-region-by-latex (beg end) - "Replace the region from BEG to END with its LaTeX export. -It assumes the region has `org-mode' syntax, and then convert it to -LaTeX. This can be used in any buffer. For example, you could -write an itemized list in `org-mode' syntax in an LaTeX buffer and -then use this command to convert it." - (interactive "r") - (let (reg latex buf) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq latex (org-export-region-as-latex - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq latex (org-export-region-as-latex - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert latex))) - -;;;###autoload -(defun org-export-region-as-latex (beg end &optional body-only buffer) - "Convert region from BEG to END in `org-mode' buffer to LaTeX. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted LaTeX. If BUFFER is the symbol `string', return the -produced LaTeX as a string and leave no buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq latex (org-export-region-as-latex beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org LaTeX Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-latex - nil ext-plist - buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir) - "Export current buffer to a LaTeX file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will be exported -depending on `org-export-latex-low-levels'. The default is to -convert them as description lists. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local settings. -When TO-BUFFER is non-nil, create a buffer with that name and export -to that buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind and just return the resulting LaTeX as a string, with -no LaTeX header. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of \\begin{document}...\\end{document}, -without even the \\begin{document} and \\end{document} commands. -When PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (when (and (not body-only) arg (listp arg)) (setq body-only t)) - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting to LaTeX...") - (org-unmodified - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill nil)))) - (org-update-radio-target-regexp) - (org-export-latex-set-initial-vars ext-plist arg) - (setq org-export-opt-plist org-export-latex-options-plist - org-export-footnotes-data (org-footnote-all-labels 'with-defs) - org-export-footnotes-seen nil - org-export-latex-footmark-seen nil) - (org-install-letbind) - (run-hooks 'org-export-latex-after-initial-vars-hook) - (let* ((wcf (current-window-configuration)) - (opt-plist - (org-export-process-option-filters org-export-latex-options-plist)) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; Make sure the variable contains the updated values. - (org-export-latex-options-plist (setq org-export-opt-plist opt-plist)) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "No Title")) - (filename - (and (not to-buffer) - (concat - (file-name-as-directory - (or pub-dir - (org-export-directory :LaTeX org-export-latex-options-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get rbeg "EXPORT_FILE_NAME" t)) - (file-name-nondirectory ;sans-extension - (or buffer-file-name - (error "Don't know which export file to use"))))) - ".tex"))) - (filename - (and filename - (if (equal (file-truename filename) - (file-truename (or buffer-file-name "dummy.org"))) - (concat filename ".tex") - filename))) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (TeX-master (boundp 'TeX-master)) - (buffer (if to-buffer - (if (eq to-buffer 'string) - (get-buffer-create "*Org LaTeX Export*") - (get-buffer-create to-buffer)) - (find-file-noselect filename))) - (odd org-odd-levels-only) - (header (org-export-latex-make-header title opt-plist)) - (skip (cond (subtree-p nil) - (region-p nil) - (t (plist-get opt-plist :skip-before-1st-heading)))) - (text (plist-get opt-plist :text)) - (org-export-preprocess-hook - (cons - `(lambda () (org-set-local 'org-complex-heading-regexp - ,org-export-latex-complex-heading-re)) - org-export-preprocess-hook)) - (first-lines (if skip "" (org-export-latex-first-lines - opt-plist - (if subtree-p - (save-excursion - (goto-char rbeg) - (point-at-bol 2)) - rbeg) - (if region-p rend)))) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-latex-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-latex-coding-system - coding-system)) - (region (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (text - (and text (string-match "\\S-" text) - (org-export-preprocess-string - text - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text nil - :skip-before-1st-heading skip - :select-tags nil - :exclude-tags nil - :LaTeX-fragments nil))) - (string-for-export - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text (if (eq to-buffer 'string) nil text) - :skip-before-1st-heading skip - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :LaTeX-fragments nil))) - - (set-buffer buffer) - (erase-buffer) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - ;; insert the header and initial document commands - (unless (or (eq to-buffer 'string) body-only) - (insert header)) - - ;; insert text found in #+TEXT - (when (and text (not (eq to-buffer 'string))) - (insert (org-export-latex-content - text '(lists tables fixed-width keywords)) - "\n\n")) - - ;; insert lines before the first headline - (unless (or skip (string-match "^\\*" first-lines)) - (insert first-lines)) - - ;; export the content of headlines - (org-export-latex-global - (with-temp-buffer - (insert string-for-export) - (goto-char (point-min)) - (when (re-search-forward "^\\(\\*+\\) " nil t) - (let* ((asters (length (match-string 1))) - (level (if odd (- asters 2) (- asters 1)))) - (setq org-export-latex-add-level - (if odd (1- (/ (1+ asters) 2)) (1- asters))) - (org-export-latex-parse-global level odd))))) - - ;; finalization - (unless body-only (insert "\n\\end{document}")) - - ;; Attach description terms to the \item macro - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t) - (delete-region (match-beginning 1) (match-end 1))) - - ;; Relocate the table of contents - (goto-char (point-min)) - (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (goto-char (point-min)) - (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t) - (replace-match "")) - (goto-char (point-min)) - (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (replace-match "\\tableofcontents" t t))) - - ;; Cleanup forced line ends in items where they are not needed - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin" - nil t) - (delete-region (match-beginning 1) (match-end 1))) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*" - nil t) - (if (looking-at "[\n \t]+") - (replace-match "\n"))) - - ;; Ensure we have a final newline - (goto-char (point-max)) - (or (eq (char-before) ?\n) - (insert ?\n)) - - (run-hooks 'org-export-latex-final-hook) - (if to-buffer - (unless (eq major-mode 'latex-mode) (latex-mode)) - (save-buffer)) - (org-export-latex-fix-inputenc) - (run-hooks 'org-export-latex-after-save-hook) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "LaTeX") - (message "Exporting to LaTeX...done")) - (prog1 - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer)) - (set-window-configuration wcf)))) - -;;;###autoload -(defun org-export-as-pdf (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export as LaTeX, then process through to PDF." - (interactive "P") - (message "Exporting to PDF...") - (let* ((wconfig (current-window-configuration)) - (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir)) - (file (buffer-file-name lbuf)) - (base (file-name-sans-extension (buffer-file-name lbuf))) - (pdffile (concat base ".pdf")) - (cmds (if (eq org-export-latex-listings 'minted) - ;; automatically add -shell-escape when needed - (mapcar (lambda (cmd) - (replace-regexp-in-string - "pdflatex " "pdflatex -shell-escape " cmd)) - org-latex-to-pdf-process) - org-latex-to-pdf-process)) - (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - (bibtex-p (with-current-buffer lbuf - (save-excursion - (goto-char (point-min)) - (re-search-forward "\\\\bibliography{" nil t)))) - cmd output-dir errors) - (with-current-buffer outbuf (erase-buffer)) - (message (concat "Processing LaTeX file " file "...")) - (setq output-dir (file-name-directory file)) - (with-current-buffer lbuf - (save-excursion - (if (and cmds (symbolp cmds)) - (funcall cmds (shell-quote-argument file)) - (while cmds - (setq cmd (pop cmds)) - (cond - ((not (listp cmd)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))))))) - (message (concat "Processing LaTeX file " file "...done")) - (setq errors (org-export-latex-get-error outbuf)) - (if (not (file-exists-p pdffile)) - (error (concat "PDF file " pdffile " was not produced" - (if errors (concat ":" errors "") ""))) - (set-window-configuration wconfig) - (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq file (concat base "." ext)) - (and (file-exists-p file) (delete-file file)))) - (message (concat - "Exporting to PDF...done" - (if errors - (concat ", with some errors:" errors) - ""))) - pdffile))) - -(defun org-export-latex-get-error (buf) - "Collect the kinds of errors that remain in pdflatex processing." - (with-current-buffer buf - (save-excursion - (goto-char (point-max)) - (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) - ;; OK, we are at the location of the final run - (let ((pos (point)) (errors "") (case-fold-search t)) - (if (re-search-forward "Reference.*?undefined" nil t) - (setq errors (concat errors " [undefined reference]"))) - (goto-char pos) - (if (re-search-forward "Citation.*?undefined" nil t) - (setq errors (concat errors " [undefined citation]"))) - (goto-char pos) - (if (re-search-forward "Undefined control sequence" nil t) - (setq errors (concat errors " [undefined control sequence]"))) - (and (org-string-nw-p errors) errors)))))) - -;;;###autoload -(defun org-export-as-pdf-and-open (arg) - "Export as LaTeX, then process through to PDF, and open." - (interactive "P") - (let ((pdffile (org-export-as-pdf arg))) - (if pdffile - (progn - (org-open-file pdffile) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (find-buffer-visiting - (concat (file-name-sans-extension (buffer-file-name)) - ".tex"))))) - (error "PDF file was not produced")))) - -;;; Parsing functions: - -(defun org-export-latex-parse-global (level odd) - "Parse the current buffer recursively, starting at LEVEL. -If ODD is non-nil, assume the buffer only contains odd sections. -Return a list reflecting the document structure." - (save-excursion - (goto-char (point-min)) - (let* ((cnt 0) output - (depth org-export-latex-sectioning-depth)) - (while (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") - ;; make sure that there is no upper heading - (when (> level 0) - (save-excursion - (save-match-data - (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string level) - "\\}\\) \\(.*\\)$") nil t)))) t) - (setq cnt (1+ cnt)) - (let* ((pos (match-beginning 0)) - (heading (match-string 2)) - (nlevel (if odd (/ (+ 3 level) 2) (1+ level)))) - (save-excursion - (narrow-to-region - (point) - (save-match-data - (if (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") nil t) - (match-beginning 0) - (point-max)))) - (goto-char (point-min)) - (setq output - (append output - (list - (list - `(pos . ,pos) - `(level . ,nlevel) - `(occur . ,cnt) - `(heading . ,heading) - `(content . ,(org-export-latex-parse-content)) - `(subcontent . ,(org-export-latex-parse-subcontent - level odd))))))) - (widen))) - (list output)))) - -(defun org-export-latex-parse-content () - "Extract the content of a section." - (let ((beg (point)) - (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t) - (progn (beginning-of-line) (point)) - (point-max)))) - (buffer-substring beg end))) - -(defun org-export-latex-parse-subcontent (level odd) - "Extract the subcontent of a section at LEVEL. -If ODD Is non-nil, assume subcontent only contains odd sections." - (if (not (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 4 2) level)) - "\\}\\) \\(.*\\)$") - nil t)) - nil ; subcontent is nil - (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) - -;;; Rendering functions: -(defun org-export-latex-global (content) - "Export CONTENT to LaTeX. -CONTENT is an element of the list produced by -`org-export-latex-parse-global'." - (if (eq (car content) 'subcontent) - (mapc 'org-export-latex-sub (cdr content)) - (org-export-latex-sub (car content)))) - -(defun org-export-latex-sub (subcontent) - "Export the list SUBCONTENT to LaTeX. -SUBCONTENT is an alist containing information about the headline -and its content." - (let ((num (plist-get org-export-latex-options-plist :section-numbers))) - (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) - -(defun org-export-latex-subcontent (subcontent num) - "Export each cell of SUBCONTENT to LaTeX. -If NUM is non-nil export numbered sections, otherwise use unnumbered -sections. If NUM is an integer, export the highest NUM levels as -numbered sections and lower levels as unnumbered sections." - (let* ((heading (cdr (assoc 'heading subcontent))) - (level (- (cdr (assoc 'level subcontent)) - org-export-latex-add-level)) - (occur (number-to-string (cdr (assoc 'occur subcontent)))) - (content (cdr (assoc 'content subcontent))) - (subcontent (cadr (assoc 'subcontent subcontent))) - (label (org-get-text-property-any 0 'target heading)) - (label-list (cons label (cdr (assoc label - org-export-target-aliases)))) - (sectioning org-export-latex-sectioning) - (depth org-export-latex-sectioning-depth) - main-heading sub-heading ctnt) - (when (symbolp (car sectioning)) - (setq sectioning (funcall (car sectioning) level heading)) - (when sectioning - (setq heading (car sectioning) - sectioning (cdr sectioning) - ;; target property migh have changed... - label (org-get-text-property-any 0 'target heading) - label-list (cons label (cdr (assoc label - org-export-target-aliases))))) - (if sectioning (setq sectioning (make-list 10 sectioning))) - (setq depth (if sectioning 10000 0))) - (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading) - (setq main-heading (substring heading 0 (match-beginning 0)) - sub-heading (substring heading (match-end 0)))) - (setq heading (org-export-latex-fontify-headline heading) - sub-heading (and sub-heading - (org-export-latex-fontify-headline sub-heading)) - main-heading (and main-heading - (org-export-latex-fontify-headline main-heading))) - (cond - ;; Normal conversion - ((<= level depth) - (let* ((sec (nth (1- level) sectioning)) - (num (if (integerp num) - (>= num level) - num)) - start end) - (if (consp (cdr sec)) - (setq start (nth (if num 0 2) sec) - end (nth (if num 1 3) sec)) - (setq start (if num (car sec) (cdr sec)))) - (insert (format start (if main-heading main-heading heading) - (or sub-heading ""))) - (insert "\n") - (when label - (insert (mapconcat (lambda (l) (format "\\label{%s}" l)) - label-list "\n") "\n")) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) - (while (org-looking-back "\n\n") (backward-delete-char 1)) - (org-export-latex-sub subcontent))) - (when (and end (string-match "[^ \t]" end)) - (let ((hook (org-get-text-property-any 0 'org-insert-hook end))) - (and (functionp hook) (funcall hook))) - (insert end "\n")))) - ;; At a level under the hl option: we can drop this subsection - ((> level depth) - (cond ((eq org-export-latex-low-levels 'description) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert "\\begin{description}\n")) - (insert (format "\n\\item[%s]%s~\n" - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert "\\end{description} % ends low level\n")) - ((memq org-export-latex-low-levels '(itemize enumerate)) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (format "\\begin{%s}\n" - (symbol-name org-export-latex-low-levels)))) - (let ((ctnt (org-export-latex-content content))) - (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) "")) - "\n\\item %s\\\\\n%s%%" - "\n\\item %s\n%s%%") - heading - (if label (format "\\label{%s}" label) ""))) - (insert ctnt)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (format "\\end{%s} %% ends low level\n" - (symbol-name org-export-latex-low-levels)))) - - ((and (listp org-export-latex-low-levels) - org-export-latex-low-levels) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (car org-export-latex-low-levels) "\n")) - (insert (format (nth 2 org-export-latex-low-levels) - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (nth 1 org-export-latex-low-levels) - " %% ends low level\n")) - - ((stringp org-export-latex-low-levels) - (insert (format org-export-latex-low-levels heading) "\n") - (when label (insert (format "\\label{%s}\n" label))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))))))))) - -;;; Exporting internals: -(defun org-export-latex-set-initial-vars (ext-plist level) - "Store org local variables required for LaTeX export. -EXT-PLIST is an optional additional plist. -LEVEL indicates the default depth for export." - (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 - org-export-latex-done-keywords org-done-keywords - org-export-latex-not-done-keywords org-not-done-keywords - org-export-latex-complex-heading-re org-complex-heading-regexp - org-export-latex-display-custom-times org-display-custom-times - org-export-latex-all-targets-re - (org-make-target-link-regexp (org-all-targets)) - org-export-latex-options-plist - (org-combine-plists (org-default-export-plist) ext-plist - (org-infile-export-plist)) - org-export-latex-class - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class) - org-export-latex-default-class) - org-export-latex-class-options - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class-options)) - org-export-latex-class - (or (car (assoc org-export-latex-class org-export-latex-classes)) - (error "No definition for class `%s' in `org-export-latex-classes'" - org-export-latex-class)) - org-export-latex-header - (cadr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning - (cddr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning-depth - (or level - (let ((hl-levels - (plist-get org-export-latex-options-plist :headline-levels)) - (sec-depth (length org-export-latex-sectioning))) - (if (> hl-levels sec-depth) sec-depth hl-levels)))) - (when (and org-export-latex-class-options - (string-match "\\S-" org-export-latex-class-options) - (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?" - org-export-latex-header)) - (setq org-export-latex-header - (concat (substring org-export-latex-header 0 (match-end 1)) - org-export-latex-class-options - (substring org-export-latex-header (match-end 0)))))) - -(defvar org-export-latex-format-toc-function - 'org-export-latex-format-toc-default - "The function formatting returning the string to create the table of contents. -The function mus take one parameter, the depth of the table of contents.") - -(defun org-export-latex-make-header (title opt-plist) - "Make the LaTeX header and return it as a string. -TITLE is the current title from the buffer or region. -OPT-PLIST is the options plist for current buffer." - (let ((toc (plist-get opt-plist :table-of-contents)) - (author (org-export-apply-macros-in-string - (plist-get opt-plist :author))) - (email (replace-regexp-in-string - "_" "\\\\_" - (org-export-apply-macros-in-string - (plist-get opt-plist :email)))) - (description (org-export-apply-macros-in-string - (plist-get opt-plist :description))) - (keywords (org-export-apply-macros-in-string - (plist-get opt-plist :keywords)))) - (concat - (if (plist-get opt-plist :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; insert LaTeX custom header and packages from the list - (org-splice-latex-header - (org-export-apply-macros-in-string org-export-latex-header) - org-export-latex-default-packages-alist - org-export-latex-packages-alist nil - (org-export-apply-macros-in-string - (plist-get opt-plist :latex-header-extra))) - ;; append another special variable - (org-export-apply-macros-in-string org-export-latex-append-header) - ;; define alert if not yet defined - "\n\\providecommand{\\alert}[1]{\\textbf{#1}}" - ;; insert the title - (format - "\n\n\\title{%s}\n" - (org-export-latex-fontify-headline title)) - ;; insert author info - (if (plist-get opt-plist :author-info) - (format "\\author{%s%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)) - (if (and (plist-get opt-plist :email-info) email - (string-match "\\S-" email)) - (format "\\thanks{%s}" email) - "")) - (format "%%\\author{%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)))) - ;; insert the date - (format "\\date{%s}\n" - (format-time-string - (or (plist-get opt-plist :date) - org-export-latex-date-format))) - ;; add some hyperref options - (format org-export-latex-hyperref-options-format - (org-export-latex-fontify-headline keywords) - (org-export-latex-fontify-headline description) - (org-version)) - ;; beginning of the document - "\n\\begin{document}\n\n" - ;; insert the title command - (when (string-match "\\S-" title) - (if (string-match "%s" org-export-latex-title-command) - (format org-export-latex-title-command title) - org-export-latex-title-command)) - "\n\n" - ;; table of contents - (when (and org-export-with-toc - (plist-get opt-plist :section-numbers)) - (funcall org-export-latex-format-toc-function - (cond ((numberp toc) - (min toc (plist-get opt-plist :headline-levels))) - (toc (plist-get opt-plist :headline-levels)))))))) - -(defun org-export-latex-format-toc-default (depth) - (when depth - (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" - depth))) - -(defun org-export-latex-first-lines (opt-plist &optional beg end) - "Export the first lines before first headline. -If BEG is non-nil, it is the beginning of the region. -If END is non-nil, it is the end of the region." - (save-excursion - (goto-char (or beg (point-min))) - (let* ((pt (point)) - (end (if (re-search-forward - (concat "^" (org-get-limited-outline-regexp)) end t) - (goto-char (match-beginning 0)) - (goto-char (or end (point-max)))))) - (prog1 - (org-export-latex-content - (org-export-preprocess-string - (buffer-substring pt end) - :for-backend 'latex - :emph-multiline t - :add-text nil - :comments nil - :skip-before-1st-heading nil - :LaTeX-fragments nil - :timestamps (plist-get opt-plist :timestamps) - :footnotes (plist-get opt-plist :footnotes))) - (org-unmodified - (let ((inhibit-read-only t) - (limit (max pt (1- end)))) - (add-text-properties pt limit - '(:org-license-to-kill t)) - (save-excursion - (goto-char pt) - (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t) - (let ((case-fold-search t)) - (unless (org-string-match-p - "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)" - (match-string 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(:org-license-to-kill t)))))))))))) - - -(defvar org-export-latex-header-defs nil - "The header definitions that might be used in the LaTeX body.") - -(defun org-export-latex-content (content &optional exclude-list) - "Convert CONTENT string to LaTeX. -Don't perform conversions that are in EXCLUDE-LIST. Recognized -conversion types are: quotation-marks, emphasis, sub-superscript, -links, keywords, lists, tables, fixed-width" - (with-temp-buffer - (org-install-letbind) - (insert content) - (unless (memq 'timestamps exclude-list) - (org-export-latex-time-stamps)) - (unless (memq 'quotation-marks exclude-list) - (org-export-latex-quotation-marks)) - (unless (memq 'emphasis exclude-list) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify))) - (unless (memq 'sub-superscript exclude-list) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript))) - (unless (memq 'links exclude-list) - (org-export-latex-links)) - (unless (memq 'keywords exclude-list) - (org-export-latex-keywords)) - (unless (memq 'lists exclude-list) - (org-export-latex-lists)) - (unless (memq 'tables exclude-list) - (org-export-latex-tables - (plist-get org-export-latex-options-plist :tables))) - (unless (memq 'fixed-width exclude-list) - (org-export-latex-fixed-width - (plist-get org-export-latex-options-plist :fixed-width))) - ;; return string - (buffer-substring (point-min) (point-max)))) - -(defun org-export-latex-protect-string (s) - "Add the org-protected property to string S." - (add-text-properties 0 (length s) '(org-protected t) s) s) - -(defun org-export-latex-protect-char-in-string (char-list string) - "Add org-protected text-property to char from CHAR-LIST in STRING." - (with-temp-buffer - (save-match-data - (insert string) - (goto-char (point-min)) - (while (re-search-forward (regexp-opt char-list) nil t) - (add-text-properties (match-beginning 0) - (match-end 0) '(org-protected t))) - (buffer-string)))) - -(defun org-export-latex-keywords-maybe (&optional remove-list) - "Maybe remove keywords depending on rules in REMOVE-LIST." - (goto-char (point-min)) - (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) - (case-fold-search nil) - (todo-markup org-export-latex-todo-keyword-markup) - fmt) - ;; convert TODO keywords - (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) - (if (plist-get remove-list :todo) - (replace-match "") - (setq fmt (cond - ((stringp todo-markup) todo-markup) - ((and (consp todo-markup) (stringp (car todo-markup))) - (if (member (match-string 1) org-export-latex-done-keywords) - (cdr todo-markup) (car todo-markup))) - (t (cdr (or (assoc (match-string 1) todo-markup) - (car todo-markup)))))) - (replace-match (org-export-latex-protect-string - (format fmt (match-string 1))) t t))) - ;; convert priority string - (when (re-search-forward "\\[\\\\#.\\]" nil t) - (if (plist-get remove-list :priority) - (replace-match "") - (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) - ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) - (if (or (not org-export-with-tags) - (plist-get remove-list :tags)) - (replace-match "") - (replace-match - (org-export-latex-protect-string - (format org-export-latex-tag-markup - (save-match-data - (replace-regexp-in-string - "\\([_#]\\)" "\\\\\\1" (match-string 0))))) - t t))))) - -(defun org-export-latex-fontify-headline (string) - "Fontify special words in STRING." - (with-temp-buffer - ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at - ;; the beginning of the buffer - inserting "\n" is safe here though. - (insert "\n" string) - - ;; Preserve math snippets - - (let* ((matchers (plist-get org-format-latex-options :matchers)) - (re-list org-latex-regexps) - beg end re e m n block off) - ;; Check the different regular expressions - (while (setq e (pop re-list)) - (setq m (car e) re (nth 1 e) n (nth 2 e) - block (if (nth 3 e) "\n\n" "")) - (setq off (if (member m '("$" "$1")) 1 0)) - (when (and (member m matchers) (not (equal m "begin"))) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) - (add-text-properties beg end - '(org-protected t org-latex-math t)))))) - - ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - (goto-char (point-min)) - (let ((re (concat "\\\\\\([a-zA-Z]+\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" - (org-create-multibrace-regexp "{" "}" 3) - "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; check for comment line - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may need conversion - (org-entity-get (match-string 1))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify)) - (org-export-latex-time-stamps) - (org-export-latex-quotation-marks) - (org-export-latex-keywords-maybe) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript)) - (org-export-latex-links) - (org-trim (buffer-string)))) - -(defun org-export-latex-time-stamps () - "Format time stamps." - (goto-char (point-min)) - (let ((org-display-custom-times org-export-latex-display-custom-times)) - (while (re-search-forward org-ts-regexp-both nil t) - (org-if-unprotected-at (1- (point)) - (replace-match - (org-export-latex-protect-string - (format (if (string= "<" (substring (match-string 0) 0 1)) - org-export-latex-timestamp-markup - org-export-latex-timestamp-inactive-markup) - (substring (org-translate-time (match-string 0)) 1 -1))) - t t))))) - -(defun org-export-latex-quotation-marks () - "Export quotation marks depending on language conventions." - (mapc (lambda(l) - (goto-char (point-min)) - (while (re-search-forward (car l) nil t) - (let ((rpl (concat (match-string 1) - (org-export-latex-protect-string - (copy-sequence (cdr l)))))) - (org-if-unprotected-1 - (replace-match rpl t t))))) - (cdr (or (assoc (plist-get org-export-latex-options-plist :language) - org-export-latex-quotes) - ;; falls back on english - (assoc "en" org-export-latex-quotes))))) - -(defun org-export-latex-special-chars (sub-superscript) - "Export special characters to LaTeX. -If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. -See the `org-export-latex.el' code for a complete conversion table." - (goto-char (point-min)) - (mapc (lambda(c) - (goto-char (point-min)) - (while (re-search-forward c nil t) - ;; Put the point where to check for org-protected - (unless (get-text-property (match-beginning 2) 'org-protected) - (cond ((member (match-string 2) '("\\$" "$")) - (if (equal (match-string 2) "\\$") - nil - (replace-match "\\$" t t))) - ((member (match-string 2) '("&" "%" "#")) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t) - (backward-char 1))) - ((equal (match-string 2) "...") - (replace-match - (concat (match-string 1) - (org-export-latex-protect-string "\\ldots{}")) t t)) - ((equal (match-string 2) "~") - (cond ((equal (match-string 1) "\\") nil) - ((eq 'org-link (get-text-property 0 'face (match-string 2))) - (replace-match (concat (match-string 1) "\\~") t t)) - (t (replace-match - (org-export-latex-protect-string - (concat (match-string 1) "\\~{}")) t t)))) - ((member (match-string 2) '("{" "}")) - (unless (save-match-data (org-inside-latex-math-p)) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t))))) - (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p))) - (cond ((equal (match-string 2) "\\") - (replace-match (or (save-match-data - (org-export-latex-treat-backslash-char - (match-string 1) - (or (match-string 3) ""))) - "") t t) - (when (and (get-text-property (1- (point)) 'org-entity) - (looking-at "{}")) - ;; OK, this was an entity replacement, and the user - ;; had terminated the entity with {}. Make sure - ;; {} is protected as well, and remove the extra {} - ;; inserted by the conversion. - (put-text-property (point) (+ 2 (point)) 'org-protected t) - (if (save-excursion (goto-char (max (- (point) 2) (point-min))) - (looking-at "{}")) - (replace-match "")) - (forward-char 2)) - (backward-char 1)) - ((member (match-string 2) '("_" "^")) - (replace-match (or (save-match-data - (org-export-latex-treat-sub-super-char - sub-superscript - (match-string 2) - (match-string 1) - (match-string 3))) "") t t) - (backward-char 1))))))) - '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" - "\\(\\(\\\\?\\$\\)\\)" - "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" - "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" - "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)" - ;; (?\< . "\\textless{}") - ;; (?\> . "\\textgreater{}") - ))) - -(defun org-inside-latex-math-p () - (get-text-property (point) 'org-latex-math)) - -(defun org-export-latex-treat-sub-super-char - (subsup char string-before string-after) - "Convert the \"_\" and \"^\" characters to LaTeX. -SUBSUP corresponds to the ^: option in the #+OPTIONS line. -Convert CHAR depending on STRING-BEFORE and STRING-AFTER." - (cond ((equal string-before "\\") - (concat string-before char string-after)) - ((and (string-match "\\S-+" string-after)) - ;; this is part of a math formula - (cond ((eq 'org-link (get-text-property 0 'face char)) - (concat string-before "\\" char string-after)) - ((save-match-data (org-inside-latex-math-p)) - (if subsup - (cond ((eq 1 (length string-after)) - (concat string-before char string-after)) - ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) - (format "%s%s{%s}" string-before char - (match-string 1 string-after)))))) - ((and (> (length string-after) 1) - (or (eq subsup t) - (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (or (string-match "[{]?\\([^}]+\\)[}]?" string-after) - (string-match "[(]?\\([^)]+\\)[)]?" string-after))) - - (org-export-latex-protect-string - (format "%s$%s{%s}$" string-before char - (if (and (> (match-end 1) (1+ (match-beginning 1))) - (not (equal (substring string-after 0 2) "{\\"))) - (concat "\\mathrm{" (match-string 1 string-after) "}") - (match-string 1 string-after))))) - ((eq subsup t) (concat string-before "$" char string-after "$")) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - -(defun org-export-latex-treat-backslash-char (string-before string-after) - "Convert the \"$\" special character to LaTeX. -The conversion is made depending of STRING-BEFORE and STRING-AFTER." - (let ((ass (org-entity-get string-after))) - (cond - (ass (org-add-props - (if (nth 2 ass) - (concat string-before - (org-export-latex-protect-string - (concat "$" (nth 1 ass) "$"))) - (concat string-before (org-export-latex-protect-string - (nth 1 ass)))) - nil 'org-entity t)) - ((and (not (string-match "^[ \n\t]" string-after)) - (not (string-match "[ \t]\\'\\|^" string-before))) - ;; backslash is inside a word - (concat string-before - (org-export-latex-protect-string - (concat "\\textbackslash{}" string-after)))) - ((not (or (equal string-after "") - (string-match "^[ \t\n]" string-after))) - ;; backslash might escape a character (like \#) or a user TeX - ;; macro (like \setcounter) - (concat string-before - (org-export-latex-protect-string (concat "\\" string-after)))) - ((and (string-match "^[ \t\n]" string-after) - (string-match "[ \t\n]\\'" string-before)) - ;; backslash is alone, convert it to $\backslash$ - (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))) - (t (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after)))))) - -(defun org-export-latex-keywords () - "Convert special keywords to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-export-latex-special-keyword-regexp nil t) - (replace-match (format org-export-latex-timestamp-keyword-markup - (match-string 0)) t t) - (save-excursion - (beginning-of-line 1) - (unless (looking-at ".*\n[ \t]*\n") - (end-of-line 1) - (insert "\n"))))) - -(defun org-export-latex-fixed-width (opt) - "When OPT is non-nil convert fixed-width sections to LaTeX." - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (unless (get-text-property (point) 'org-example) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line))))))) - -(defvar org-table-last-alignment) ; defined in org-table.el -(defvar org-table-last-column-widths) ; defined in org-table.el -(declare-function orgtbl-to-latex "org-table" (table params) t) -(defun org-export-latex-tables (insert) - "Convert tables to LaTeX and INSERT it." - ;; First, get the table.el tables - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t) - (org-if-unprotected - (require 'table) - (org-export-latex-convert-table.el-table))) - - ;; And now the Org-mode tables - (goto-char (point-min)) - (while (re-search-forward "^\\([ \t]*\\)|" nil t) - (org-if-unprotected-at (1- (point)) - (org-table-align) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (raw-table (buffer-substring beg end)) - (org-table-last-alignment (copy-sequence org-table-last-alignment)) - (org-table-last-column-widths (copy-sequence - org-table-last-column-widths)) - fnum fields line lines olines gr colgropen line-fmt align - caption width shortn label attr hfmt floatp placement - longtblp tblenv tabular-env) - (if org-export-latex-tables-verbatim - (let* ((tbl (concat "\\begin{verbatim}\n" raw-table - "\\end{verbatim}\n"))) - (apply 'delete-region (list beg end)) - (insert (org-export-latex-protect-string tbl))) - (progn - (setq caption (org-find-text-property-in-string - 'org-caption raw-table) - shortn (org-find-text-property-in-string - 'org-caption-shortn raw-table) - attr (org-find-text-property-in-string - 'org-attributes raw-table) - label (org-find-text-property-in-string - 'org-label raw-table) - longtblp (and attr (stringp attr) - (string-match "\\" attr)) - tblenv (if (and attr (stringp attr)) - (cond ((string-match "\\" attr) - "sidewaystable") - ((or (string-match (regexp-quote "table*") attr) - (string-match "\\" attr)) - "table*") - (t "table")) - "table") - tabular-env - (if (and attr (stringp attr) - (string-match "\\(tabular.\\)" attr)) - (match-string 1 attr) - org-export-latex-tabular-environment) - width (and attr (stringp attr) - (string-match "\\" attr)) - floatp (or label caption)) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (table-generate-source 'latex "*org-export-table*" "caption") - (setq tbl (with-current-buffer "*org-export-table*" - (buffer-string))) - (while (string-match "^%.*\n" tbl) - (setq tbl (replace-match "" t t tbl))) - ;; fix the hlines - (when rmlines - (let ((n 0) lines) - (setq lines (mapcar (lambda (x) - (if (string-match "^\\\\hline$" x) - (progn - (setq n (1+ n)) - (if (= n 2) x nil)) - x)) - (org-split-string tbl "\n"))) - (setq tbl (mapconcat 'identity (delq nil lines) "\n")))) - (when (and align (string-match "\\\\begin{tabular}{.*}" tbl)) - (setq tbl (replace-match (concat "\\begin{tabular}{" align "}") - t t tbl))) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (beginning-of-line 0) - (while (looking-at "[ \t]*\\(|\\|\\+-\\)") - (delete-region (point) (1+ (point-at-eol)))) - (when org-export-latex-tables-centered - (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) - (when floatp - (setq tbl (concat "\\begin{table}\n" - (if (not org-export-latex-table-caption-above) tbl) - (format "\\caption%s{%s%s}\n" - (if shortn (format "[%s]" shortn) "") - (if label (format "\\label{%s}" label) "") - (or caption "")) - (if org-export-latex-table-caption-above tbl) - "\n\\end{table}\n"))) - (insert (org-export-latex-protect-string tbl)))) - -(defun org-export-latex-fontify () - "Convert fontification to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - ;; The match goes one char after the *string*, except at the end of a line - (let ((emph (assoc (match-string 3) - org-export-latex-emphasis-alist)) - (beg (match-beginning 0)) - (end (match-end 0)) - rpl s) - (unless emph - (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\"" - (match-string 3))) - (unless (or (and (get-text-property (- (point) 2) 'org-protected) - (not (get-text-property - (- (point) 2) 'org-verbatim-emph))) - (equal (char-after (match-beginning 3)) - (char-after (1+ (match-beginning 3)))) - (save-excursion - (goto-char (match-beginning 1)) - (save-match-data - (and (org-at-table-p) - (string-match - "[|\n]" (buffer-substring beg end))))) - (and (equal (match-string 3) "+") - (save-match-data - (string-match "\\`-+\\'" (match-string 4))))) - (setq s (match-string 4)) - (setq rpl (concat (match-string 1) - (org-export-latex-emph-format (cadr emph) - (match-string 4)) - (match-string 5))) - (if (caddr emph) - (setq rpl (org-export-latex-protect-string rpl)) - (save-match-data - (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - '(org-protected t) rpl) - (add-text-properties (match-beginning 3) (match-end 3) - '(org-protected t) rpl))))) - (replace-match rpl t t))) - (backward-char))) - -(defun org-export-latex-emph-format (format string) - "Format an emphasis string and handle the \\verb special case." - (when (member format '("\\verb" "\\protectedtexttt")) - (save-match-data - (if (equal format "\\verb") - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (catch 'exit - (loop for i from 0 to (1- (length ll)) do - (if (not (string-match (regexp-quote (substring ll i (1+ i))) - string)) - (progn - (setq format (concat "\\verb" (substring ll i (1+ i)) - "%s" (substring ll i (1+ i)))) - (throw 'exit nil)))))) - (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") char) - (while (string-match "[\\{}$%&_#~^]" string) - (setq char (match-string 0 string)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring string - 0 (match-beginning 0))))) - (setq string (substring string (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq string (concat rtn string) format "\\texttt{%s}") - (while (string-match "--" string) - (setq string (replace-match "-{}-" t t string))))))) - (format format string)) - -(defun org-export-latex-links () - ;; Make sure to use the LaTeX hyperref and graphicx package - ;; or send some warnings. - "Convert links to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-analytic-regexp++ nil t) - (org-if-unprotected-1 - (goto-char (match-beginning 0)) - (let* ((re-radio org-export-latex-all-targets-re) - (remove (list (match-beginning 0) (match-end 0))) - (raw-path (org-extract-attributes (match-string 3))) - (full-raw-path (concat (match-string 1) raw-path)) - (desc (match-string 5)) - (type (or (match-string 2) - (if (or (file-name-absolute-p raw-path) - (string-match "^\\.\\.?/" raw-path)) - "file"))) - (coderefp (equal type "coderef")) - (caption (org-find-text-property-in-string 'org-caption raw-path)) - (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path)) - (attr (or (org-find-text-property-in-string 'org-attributes raw-path) - (plist-get org-export-latex-options-plist :latex-image-options))) - (label (org-find-text-property-in-string 'org-label raw-path)) - imgp radiop fnc - ;; define the path of the link - (path (cond - ((member type '("coderef")) - raw-path) - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((and re-radio (string-match re-radio raw-path)) - (setq radiop t)) - ((equal type "mailto") - (concat type ":" raw-path)) - ((equal type "file") - (if (and (org-file-image-p - (expand-file-name (org-link-unescape raw-path)) - org-export-latex-inline-image-extensions) - (or (get-text-property 0 'org-no-description raw-path) - (equal desc full-raw-path))) - (setq imgp t) - (progn (setq raw-path (org-link-unescape raw-path)) - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - (if (file-exists-p raw-path) - (concat type "://" (expand-file-name raw-path)) - (concat type "://" (org-export-directory - :LaTeX org-export-latex-options-plist) - raw-path)))))))) - ;; process with link inserting - (apply 'delete-region remove) - (setq caption (and caption (org-export-latex-fontify-headline caption))) - (cond ((and imgp - (plist-get org-export-latex-options-plist :inline-images)) - ;; OK, we need to inline an image - (insert - (org-export-latex-format-image raw-path caption label attr shortn))) - (coderefp - (insert (format - (org-export-get-coderef-format path desc) - (cdr (assoc path org-export-code-refs))))) - (radiop (insert (format org-export-latex-hyperref-format - (org-solidify-link-text raw-path) desc))) - ((not type) - (insert (format org-export-latex-hyperref-format - (org-remove-initial-hash - (org-solidify-link-text raw-path)) - desc))) - (path - (when (org-at-table-p) - ;; There is a strange problem when we have a link in a table, - ;; ampersands then cause a problem. I think this must be - ;; a LaTeX issue, but we here implement a work-around anyway. - (setq path (org-export-latex-protect-amp path) - desc (org-export-latex-protect-amp desc))) - (insert - (if (string-match "%s.*%s" org-export-latex-href-format) - (format org-export-latex-href-format path desc) - (format org-export-latex-href-format path)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for formatting the link - (insert - (save-match-data - (funcall fnc (org-link-unescape raw-path) desc 'latex)))) - ;; Unrecognized path type - (t (insert (format org-export-latex-link-with-unknown-path-format desc)))))))) - - -(defun org-export-latex-format-image (path caption label attr &optional shortn) - "Format the image element, depending on user settings." - (let (ind floatp wrapp multicolumnp placement figenv) - (setq floatp (or caption label)) - (setq ind (org-get-text-property-any 0 'original-indentation path)) - (when (and attr (stringp attr)) - (if (string-match "[ \t]*\\" attr) - (setq wrapp t floatp nil attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\" attr) - (setq multicolumnp t attr (replace-match "" t t attr)))) - - (setq placement - (cond - (wrapp "{l}{0.5\\textwidth}") - (floatp (concat "[" org-latex-default-figure-position "]")) - (t ""))) - - (when (and attr (stringp attr) - (string-match "[ \t]*\\" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - - ;; Convert blockquotes - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-START" nil t) - (org-replace-match-keep-properties "\\begin{quote}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-END" nil t) - (org-replace-match-keep-properties "\\end{quote}" t t)) - - ;; Convert verse - (goto-char (point-min)) - (while (search-forward "ORG-VERSE-START" nil t) - (org-replace-match-keep-properties "\\begin{verse}" t t) - (beginning-of-line 2) - (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp))) - (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)") - (goto-char (match-end 1)) - (org-replace-match-keep-properties - (org-export-latex-protect-string - (concat "\\hspace*{1cm}" (match-string 2))) t t) - (beginning-of-line 1)) - (if (looking-at "[ \t]*$") - (insert (org-export-latex-protect-string "\\vspace*{1em}")) - (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$") - (end-of-line 1) - (insert "\\\\"))) - (beginning-of-line 2)) - (and (looking-at "[ \t]*ORG-VERSE-END.*") - (org-replace-match-keep-properties "\\end{verse}" t t))) - - ;; Convert #+INDEX to LaTeX \\index. - (goto-char (point-min)) - (let ((case-fold-search t) entry) - (while (re-search-forward - "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$" - nil t) - (setq entry - (save-match-data - (org-export-latex-protect-string - (org-export-latex-fontify-headline (match-string 1))))) - (replace-match (format "\\index{%s}" entry) t t))) - - ;; Convert center - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-START" nil t) - (org-replace-match-keep-properties "\\begin{center}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-END" nil t) - (org-replace-match-keep-properties "\\end{center}" t t)) - - (run-hooks 'org-export-latex-after-blockquotes-hook) - - ;; Convert horizontal rules - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "\\hrule") t t))) - - ;; Protect LaTeX commands like \command[...]{...} or \command{...} - (goto-char (point-min)) - (let ((re (concat - "\\\\\\([a-zA-Z]+\\*?\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; Check for comment line. - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may - ;; need conversion. - (org-entity-get (match-string 1)) - ;; Do not protect interior of footnotes. Those have - ;; already been taken care of earlier in the function. - ;; Yet, keep looking inside them for more commands. - (and (equal (match-string 1) "footnote") - (goto-char (match-end 1)))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - - ;; Special case for \nbsp - (goto-char (point-min)) - (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "~")))) - - ;; Protect LaTeX entities - (goto-char (point-min)) - (while (re-search-forward org-latex-entities-regexp nil t) - (org-if-unprotected - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t)))) - - ;; Replace radio links - (goto-char (point-min)) - (while (re-search-forward - (concat "<<>>?\\((INVISIBLE)\\)?") nil t) - (org-if-unprotected-at (+ (match-beginning 0) 2) - (replace-match - (concat - (org-export-latex-protect-string - (format "\\label{%s}" (save-match-data (org-solidify-link-text - (match-string 1))))) - (if (match-string 2) "" (match-string 1))) - t t))) - - ;; Delete @<...> constructs - ;; Thanks to Daniel Clemente for this regexp - (goto-char (point-min)) - (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) - (org-if-unprotected - (replace-match "")))) - -(defun org-export-latex-fix-inputenc () - "Set the coding system in inputenc to what the buffer is." - (let* ((cs buffer-file-coding-system) - (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs)) - "utf8"))) - (when opt - ;; Translate if that is requested - (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt)) - ;; find the \usepackage statement and replace the option - (goto-char (point-min)) - (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - nil t) - (goto-char (match-beginning 1)) - (delete-region (match-beginning 1) (match-end 1)) - (insert opt)) - (and buffer-file-name - (save-buffer))))) - -;;; List handling: - -(defun org-export-latex-lists () - "Convert plain text lists in current buffer into LaTeX lists." - ;; `org-list-end-re' output has changed since preprocess from - ;; org-exp.el. Make sure it is taken into account. - (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) - (mapc - (lambda (e) - ;; For each type of context allowed for list export (E), find - ;; every list, parse it, delete it and insert resulting - ;; conversion to latex (RES), while keeping the same - ;; `original-indentation' property. - (let (res) - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (when (and (eq (get-text-property (point) 'list-context) e) - (not (get-text-property (point) 'org-example))) - (beginning-of-line) - (setq res - (org-list-to-latex - ;; Narrowing is needed because we're converting - ;; from inner functions to outer ones. - (save-restriction - (narrow-to-region (point) (point-max)) - (org-list-parse-list t)) - org-export-latex-list-parameters)) - ;; Extend previous value of original-indentation to the - ;; whole string - (insert (org-add-props res nil 'original-indentation - (org-find-text-property-in-string - 'original-indentation res))))))) - ;; List of allowed contexts for export, and the default one. - (append org-list-export-context '(nil))))) - -(defconst org-latex-entities - '("\\!" - "\\'" - "\\+" - "\\," - "\\-" - "\\:" - "\\;" - "\\<" - "\\=" - "\\>" - "\\Huge" - "\\LARGE" - "\\Large" - "\\Styles" - "\\\\" - "\\`" - "\\\"" - "\\addcontentsline" - "\\address" - "\\addtocontents" - "\\addtocounter" - "\\addtolength" - "\\addvspace" - "\\alph" - "\\appendix" - "\\arabic" - "\\author" - "\\begin{array}" - "\\begin{center}" - "\\begin{description}" - "\\begin{enumerate}" - "\\begin{eqnarray}" - "\\begin{equation}" - "\\begin{figure}" - "\\begin{flushleft}" - "\\begin{flushright}" - "\\begin{itemize}" - "\\begin{list}" - "\\begin{minipage}" - "\\begin{picture}" - "\\begin{quotation}" - "\\begin{quote}" - "\\begin{tabbing}" - "\\begin{table}" - "\\begin{tabular}" - "\\begin{thebibliography}" - "\\begin{theorem}" - "\\begin{titlepage}" - "\\begin{verbatim}" - "\\begin{verse}" - "\\bf" - "\\bf" - "\\bibitem" - "\\bigskip" - "\\cdots" - "\\centering" - "\\circle" - "\\cite" - "\\cleardoublepage" - "\\clearpage" - "\\cline" - "\\closing" - "\\dashbox" - "\\date" - "\\ddots" - "\\dotfill" - "\\em" - "\\fbox" - "\\flushbottom" - "\\fnsymbol" - "\\footnote" - "\\footnotemark" - "\\footnotesize" - "\\footnotetext" - "\\frac" - "\\frame" - "\\framebox" - "\\hfill" - "\\hline" - "\\hrulespace" - "\\hspace" - "\\huge" - "\\hyphenation" - "\\include" - "\\includeonly" - "\\indent" - "\\input" - "\\it" - "\\kill" - "\\label" - "\\large" - "\\ldots" - "\\line" - "\\linebreak" - "\\linethickness" - "\\listoffigures" - "\\listoftables" - "\\location" - "\\makebox" - "\\maketitle" - "\\mark" - "\\mbox" - "\\medskip" - "\\multicolumn" - "\\multiput" - "\\newcommand" - "\\newcounter" - "\\newenvironment" - "\\newfont" - "\\newlength" - "\\newline" - "\\newpage" - "\\newsavebox" - "\\newtheorem" - "\\nocite" - "\\nofiles" - "\\noindent" - "\\nolinebreak" - "\\nopagebreak" - "\\normalsize" - "\\onecolumn" - "\\opening" - "\\oval" - "\\overbrace" - "\\overline" - "\\pagebreak" - "\\pagenumbering" - "\\pageref" - "\\pagestyle" - "\\par" - "\\parbox" - "\\put" - "\\raggedbottom" - "\\raggedleft" - "\\raggedright" - "\\raisebox" - "\\ref" - "\\rm" - "\\roman" - "\\rule" - "\\savebox" - "\\sc" - "\\scriptsize" - "\\setcounter" - "\\setlength" - "\\settowidth" - "\\sf" - "\\shortstack" - "\\signature" - "\\sl" - "\\small" - "\\smallskip" - "\\sqrt" - "\\tableofcontents" - "\\telephone" - "\\thanks" - "\\thispagestyle" - "\\tiny" - "\\title" - "\\tt" - "\\twocolumn" - "\\typein" - "\\typeout" - "\\underbrace" - "\\underline" - "\\usebox" - "\\usecounter" - "\\value" - "\\vdots" - "\\vector" - "\\verb" - "\\vfill" - "\\vline" - "\\vspace") - "A list of LaTeX commands to be protected when performing conversion.") - -(defconst org-latex-entities-regexp - (let (names rest) - (dolist (x org-latex-entities) - (if (string-match "[a-zA-Z]$" x) - (push x names) - (push x rest))) - (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)" - "\\|\\(" (regexp-opt (nreverse rest)) "\\)"))) - -(provide 'org-export-latex) -(provide 'org-latex) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-latex.el ends here diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 47476481625..d24dad28363 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -1,9 +1,9 @@ ;;; org-list.el --- Plain lists for Org-mode ;; -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik -;; Bastien Guerry +;; Bastien Guerry ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; @@ -94,6 +94,11 @@ (defvar org-ts-regexp) (defvar org-ts-regexp-both) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) + (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) @@ -107,10 +112,6 @@ (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-at-heading-p "org" (&optional invisible-ok)) @@ -118,15 +119,21 @@ (declare-function org-remove-if "org" (predicate seq)) (declare-function org-reduced-level "org" (L)) (declare-function org-show-subtree "org" ()) +(declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s)) (declare-function org-uniquify "org" (list)) -(declare-function outline-invisible-p "outline" (&optional pos)) -(declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-next-heading "outline" ()) -(declare-function outline-previous-heading "outline" ()) + +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) + +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) + @@ -154,6 +161,7 @@ plain list item with an implied large level number, all true children and grand children of the outline heading will be exposed in a children' view." :group 'org-plain-lists + :group 'org-cycle :type '(choice (const :tag "Never" nil) (const :tag "With cursor in plain list (recommended)" t) @@ -209,14 +217,26 @@ Valid values are ?. and ?\). To get both terminators, use t." (const :tag "paren like in \"2)\"" ?\)) (const :tag "both" t))) -(defcustom org-alphabetical-lists nil +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "24.4") ; Since 8.0 +(defcustom org-list-allow-alphabetical nil "Non-nil means single character alphabetical bullets are allowed. + Both uppercase and lowercase are handled. Lists with more than 26 items will fallback to standard numbering. Alphabetical -counters like \"[@c]\" will be recognized." +counters like \"[@c]\" will be recognized. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code after updating it: + + \(when (featurep 'org-element) (load \"org-element\" t t))" :group 'org-plain-lists :version "24.1" - :type 'boolean) + :type 'boolean + :set (lambda (var val) + (when (featurep 'org-element) (load "org-element" t t)) + (set var val))) (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. @@ -230,7 +250,9 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) -(defcustom org-empty-line-terminates-plain-lists nil +(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists + 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 +(defcustom org-list-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. Otherwise, two of them will be necessary." :group 'org-plain-lists @@ -282,7 +304,9 @@ This hook runs even if checkbox rule in implement alternative ways of collecting statistics information.") -(defcustom org-hierarchical-checkbox-statistics t +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 +(defcustom org-checkbox-hierarchical-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. This can be set to nil on a per-node basis using a COOKIE_DATA property @@ -290,7 +314,9 @@ with the word \"recursive\" in the value." :group 'org-plain-lists :type 'boolean) -(defcustom org-description-max-indent 20 +(org-defvaralias 'org-description-max-indent + 'org-list-description-max-indent) ;; Since 8.0 +(defcustom org-list-description-max-indent 20 "Maximum indentation for the second line of a description list. When the indentation would be larger than this, it will become 5 characters instead." @@ -333,7 +359,7 @@ list, obtained by prompting the user." (string :tag "Format")))) (defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" - "docbook" "html" "latex" "odt") + "html" "latex" "odt") "Names of blocks where lists are not allowed. Names must be in lower case.") @@ -348,10 +374,10 @@ specifically, type `block' is determined by the variable ;;; Predicates and regexps -(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n" +(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" "^[ \t]*\n[ \t]*\n") "Regex corresponding to the end of a list. -It depends on `org-empty-line-terminates-plain-lists'.") +It depends on `org-list-empty-line-terminates-plain-lists'.") (defconst org-list-full-item-re (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" @@ -371,7 +397,7 @@ group 4: description tag") ((= org-plain-list-ordered-item-terminator ?\)) ")") ((= org-plain-list-ordered-item-terminator ?.) "\\.") (t "[.)]"))) - (alpha (if org-alphabetical-lists "\\|[A-Za-z]" ""))) + (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))) (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) @@ -385,7 +411,7 @@ group 4: description tag") (save-excursion (goto-char (match-end 0)) (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" - (if org-alphabetical-lists + (if org-list-allow-alphabetical "\\([0-9]+\\|[A-Za-z]\\)" "[0-9]+") "\\][ \t]*\\)"))) @@ -642,8 +668,7 @@ Assume point is at an item." (save-excursion (catch 'exit (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) + (let ((ind (org-get-indentation))) (cond ((<= (point) lim-up) ;; At upward limit: if we ended at an item, store it, @@ -651,18 +676,10 @@ Assume point is at an item." ;; Jump to part 2. (throw 'exit (setq itm-lst - (if (or (not (looking-at item-re)) - (get-text-property (point) 'org-example)) + (if (not (looking-at item-re)) (memq (assq (car beg-cell) itm-lst) itm-lst) (setq beg-cell (cons (point) ind)) (cons (funcall assoc-at-point ind) itm-lst))))) - ;; At a verbatim block, go before its beginning. Move - ;; from eol to ensure `previous-single-property-change' - ;; will return a value. - ((get-text-property (point) 'org-example) - (goto-char (previous-single-property-change - (point-at-eol) 'org-example nil lim-up)) - (forward-line -1)) ;; Looking at a list ending regexp. Dismiss useless ;; data recorded above BEG-CELL. Jump to part 2. ((looking-at org-list-end-re) @@ -711,8 +728,7 @@ Assume point is at an item." ;; position of items in END-LST-2. (catch 'exit (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) + (let ((ind (org-get-indentation))) (cond ((>= (point) lim-down) ;; At downward limit: this is de facto the end of the @@ -720,12 +736,6 @@ Assume point is at an item." ;; part 3. (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) - ;; At a verbatim block, move to its end. Point is at bol - ;; and 'org-example property is set by whole lines: - ;; `next-single-property-change' always return a value. - ((get-text-property (point) 'org-example) - (goto-char - (next-single-property-change (point) 'org-example nil lim-down))) ;; Looking at a list ending regexp. Save point as an ;; ending position and jump to part 3. ((looking-at org-list-end-re) @@ -1097,8 +1107,9 @@ It determines the number of whitespaces to append by looking at org-list-two-spaces-after-bullet-regexp bullet)) " " " "))) - (string-match "\\S-+\\([ \t]*\\)" bullet) - (replace-match spaces nil nil bullet 1)))) + (if (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match spaces nil nil bullet 1) + bullet)))) (defun org-list-swap-items (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. @@ -1208,11 +1219,11 @@ some heuristics to guess the result." (point)))))))) (cond ;; Trivial cases where there should be none. - ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0) + ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) ;; When `org-blank-before-new-entry' says so, it is 1. ((eq insert-blank-p t) 1) ;; `plain-list-item' is 'auto. Count blank lines separating - ;; neighbours items in list. + ;; neighbors' items in list. (t (let ((next-p (org-list-get-next-item item struct prevs))) (cond ;; Is there a next item? @@ -1613,7 +1624,7 @@ bullets between START and END." STRUCT is list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." - (and org-alphabetical-lists + (and org-list-allow-alphabetical (catch 'exit (let ((item first) (ascii 64) (case-fold-search nil)) ;; Pretend that bullets are uppercase and check if alphabet @@ -1851,9 +1862,10 @@ Initial position of cursor is restored after the changes." (item-re (org-item-re)) (shift-body-ind (function - ;; Shift the indentation between END and BEG by DELTA. - ;; Start from the line before END. - (lambda (end beg delta) + ;; Shift the indentation between END and BEG by DELTA. If + ;; MAX-IND is non-nil, ensure that no line will be indented + ;; more than that number. Start from the line before END. + (lambda (end beg delta max-ind) (goto-char end) (skip-chars-backward " \r\t\n") (beginning-of-line) @@ -1867,7 +1879,8 @@ Initial position of cursor is restored after the changes." ;; Shift only non-empty lines. ((org-looking-at-p "^[ \t]*\\S-") (let ((i (org-get-indentation))) - (org-indent-line-to (+ i delta))))) + (org-indent-line-to + (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) (forward-line -1))))) (modify-item (function @@ -1903,53 +1916,60 @@ Initial position of cursor is restored after the changes." (indent-to new-ind))))))) ;; 1. First get list of items and position endings. We maintain ;; two alists: ITM-SHIFT, determining indentation shift needed - ;; at item, and END-POS, a pseudo-alist where key is ending + ;; at item, and END-LIST, a pseudo-alist where key is ending ;; position and value point. (let (end-list acc-end itm-shift all-ends sliced-struct) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (ind-old (org-list-get-ind pos old-struct)) - (bul-pos (org-list-get-bullet pos struct)) - (bul-old (org-list-get-bullet pos old-struct)) - (ind-shift (- (+ ind-pos (length bul-pos)) - (+ ind-old (length bul-old)))) - (end-pos (org-list-get-item-end pos old-struct))) - (push (cons pos ind-shift) itm-shift) - (unless (assq end-pos old-struct) - ;; To determine real ind of an ending position that - ;; is not at an item, we have to find the item it - ;; belongs to: it is the last item (ITEM-UP), whose - ;; ending is further than the position we're - ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons end-pos item-up) end-list))) - (push (cons end-pos pos) acc-end))) - old-struct) + (dolist (e old-struct) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (push (cons pos ind-shift) itm-shift) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that + ;; is not at an item, we have to find the item it + ;; belongs to: it is the last item (ITEM-UP), whose + ;; ending is further than the position we're + ;; interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) ;; 2. Slice the items into parts that should be shifted by the - ;; same amount of indentation. The slices are returned in - ;; reverse order so changes modifying buffer do not change - ;; positions they refer to. + ;; same amount of indentation. Each slice follow the pattern + ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in + ;; reverse order. (setq all-ends (sort (append (mapcar 'car itm-shift) (org-uniquify (mapcar 'car end-list))) '<)) (while (cdr all-ends) (let* ((up (pop all-ends)) (down (car all-ends)) - (ind (if (assq up struct) - (cdr (assq up itm-shift)) - (cdr (assq (cdr (assq up end-list)) itm-shift))))) - (push (list down up ind) sliced-struct))) + (itemp (assq up struct)) + (item (if itemp up (cdr (assq up end-list)))) + (ind (cdr (assq item itm-shift))) + ;; If we're not at an item, there's a child of the item + ;; point belongs to above. Make sure this slice isn't + ;; moved within that child by specifying a maximum + ;; indentation. + (max-ind (and (not itemp) + (+ (org-list-get-ind item struct) + (length (org-list-get-bullet item struct)) + org-list-indent-offset)))) + (push (list down up ind max-ind) sliced-struct))) ;; 3. Shift each slice in buffer, provided delta isn't 0, from ;; end to beginning. Take a special action when beginning is ;; at item bullet. - (mapc (lambda (e) - (unless (zerop (nth 2 e)) (apply shift-body-ind e)) - (let* ((beg (nth 1 e)) - (cell (assq beg struct))) - (unless (or (not cell) (equal cell (assq beg old-struct))) - (funcall modify-item beg)))) - sliced-struct)) + (dolist (e sliced-struct) + (unless (and (zerop (nth 2 e)) (not (nth 3 e))) + (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) + (funcall modify-item beg))))) ;; 4. Go back to initial position and clean marker. (goto-char origin) (move-marker origin nil))) @@ -2148,7 +2168,7 @@ the item, so this really moves item trees." (prevs (org-list-prevs-alist struct)) (next-item (org-list-get-next-item (point-at-bol) struct prevs))) (unless (or next-item org-list-use-circular-motion) - (error "Cannot move this item further down")) + (user-error "Cannot move this item further down")) (if (not next-item) (setq struct (org-list-send-item item 'begin struct)) (setq struct (org-list-swap-items item next-item struct)) @@ -2169,7 +2189,7 @@ the item, so this really moves item trees." (prevs (org-list-prevs-alist struct)) (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) (unless (or prev-item org-list-use-circular-motion) - (error "Cannot move this item further up")) + (user-error "Cannot move this item further up")) (if (not prev-item) (setq struct (org-list-send-item item 'end struct)) (setq struct (org-list-swap-items prev-item item struct))) @@ -2203,9 +2223,8 @@ item is invisible." ;; If we're in a description list, ask for the new term. (desc (when (eq (org-list-get-list-type itemp struct prevs) 'descriptive) - (concat (read-string "Term: ") " :: ")))) - (setq struct - (org-list-insert-item pos struct prevs checkbox desc)) + " :: "))) + (setq struct (org-list-insert-item pos struct prevs checkbox desc)) (org-list-write-struct struct (org-list-parents-alist struct)) (when checkbox (org-update-checkbox-count-maybe)) (looking-at org-list-full-item-re) @@ -2214,6 +2233,7 @@ item is invisible." (string-match "[.)]" (match-string 1)))) (match-beginning 4) (match-end 0))) + (if desc (backward-char 1)) t))))) (defun org-list-repair () @@ -2429,7 +2449,7 @@ With optional prefix argument ALL, do this for the whole buffer." (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") (recursivep - (or (not org-hierarchical-checkbox-statistics) + (or (not org-checkbox-hierarchical-statistics) (string-match "\\" (or (org-entry-get nil "COOKIE_DATA") "")))) (bounds (if all @@ -2771,7 +2791,7 @@ Return t at each successful move." (cond ((ignore-errors (org-list-indent-item-generic 1 t struct))) ((ignore-errors (org-list-indent-item-generic -1 t struct))) - (t (error "Cannot move item")))) + (t (user-error "Cannot move item")))) t)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) @@ -2787,13 +2807,14 @@ optional argument WITH-CASE, the sorting considers case as well. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to -be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise -meaning of each character: +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the +detailed meaning of each character: n Numerically, by converting the beginning of the item to a number. a Alphabetically. Only the first line of item is checked. t By date/time, either the first active time stamp in the entry, if any, or by the first inactive one. In a timer list, sort the timers. +x By \"checked\" status of a check list. Capital letters will reverse the sort order. @@ -2801,7 +2822,10 @@ If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the record. It must return either a string or a number that should serve as the sorting key for that record. It will then use -COMPARE-FUNC to compare entries." +COMPARE-FUNC to compare entries. + +Sorting is done against the visible part of the headlines, it +ignores hidden links." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) @@ -2809,13 +2833,16 @@ COMPARE-FUNC to compare entries." (start (org-list-get-list-begin (point-at-bol) struct prevs)) (end (org-list-get-list-end (point-at-bol) struct prevs)) (sorting-type - (progn - (message - "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") - (read-char-exclusive))) - (getkey-func (and (= (downcase sorting-type) ?f) - (intern (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil))))) + (or sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") + (read-char-exclusive)))) + (getkey-func + (or getkey-func + (and (= (downcase sorting-type) ?f) + (intern (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)))))) (message "Sorting items...") (save-restriction (narrow-to-region start end) @@ -2826,10 +2853,11 @@ COMPARE-FUNC to compare entries." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((= dcst ?t) '<))) + ((= dcst ?t) '<) + ((= dcst ?x) 'string<))) (next-record (lambda () (skip-chars-forward " \r\t\n") - (beginning-of-line))) + (or (eobp) (beginning-of-line)))) (end-record (lambda () (goto-char (org-list-get-item-end-before-blank (point) struct)))) @@ -2838,21 +2866,28 @@ COMPARE-FUNC to compare entries." (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") (cond ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) + (string-to-number + (org-sort-remove-invisible + (buffer-substring (match-end 0) (point-at-eol))))) ((= dcst ?a) (funcall case-func - (buffer-substring (match-end 0) (point-at-eol)))) + (org-sort-remove-invisible + (buffer-substring + (match-end 0) (point-at-eol))))) ((= dcst ?t) (cond ;; If it is a timer list, convert timer to seconds ((org-at-item-timer-p) (org-timer-hms-to-secs (match-string 1))) - ((or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) + ((or (save-excursion + (re-search-forward org-ts-regexp (point-at-eol) t)) + (save-excursion (re-search-forward org-ts-regexp-both + (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) (t (org-float-time now)))) + ((= dcst ?x) (or (and (stringp (match-string 1)) + (match-string 1)) + "")) ((= dcst ?f) (if getkey-func (let ((value (funcall getkey-func))) @@ -3021,9 +3056,8 @@ for this list." (unless (org-at-item-p) (error "Not at a list item")) (save-excursion (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") - (if maybe - (throw 'exit nil) + (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") + (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) @@ -3037,13 +3071,11 @@ for this list." (re-search-backward "#\\+ORGLST" nil t) (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) - (list (save-restriction - (narrow-to-region top-point bottom-point) - (org-list-parse-list))) + (plain-list (buffer-substring-no-properties top-point bottom-point)) beg txt) (unless (fboundp transform) (error "No such transformation function %s" transform)) - (let ((txt (funcall transform list))) + (let ((txt (funcall transform plain-list))) ;; Find the insertion place (save-excursion (goto-char (point-min)) @@ -3200,65 +3232,24 @@ items." (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" - :dstart "\\begin{description}\n" :dend "\\end{description}" - :dtstart "[" :dtend "] " - :istart "\\item " :iend "\n" - :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) - (if enum - ;; LaTeX increments counter just before - ;; using it, so set it to the desired - ;; value, minus one. - (format "\\setcounter{enum%s}{%s}\n\\item " - enum (1- counter)) - "\\item ")) - :csep "\n" - :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" - :cbtrans "\\texttt{[-]}") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-latex) + (org-export-string-as list 'latex t)) -(defun org-list-to-html (list &optional params) +(defun org-list-to-html (list) "Convert LIST into a HTML list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "
      \n" :oend "\n
    " - :ustart "
      \n" :uend "\n
    " - :dstart "
    \n" :dend "\n
    " - :dtstart "
    " :dtend "
    \n" - :ddstart "
    " :ddend "
    " - :istart "
  • " :iend "
  • " - :icount (format "
  • " counter) - :isep "\n" :lsep "\n" :csep "\n" - :cbon "[X]" :cboff "[ ]" - :cbtrans "[-]") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-html) + (org-export-string-as list 'html t)) (defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" - :ustart "@enumerate\n" :uend "@end enumerate" - :dstart "@table @asis\n" :dend "@end table" - :dtstart " " :dtend "\n" - :istart "@item\n" :iend "\n" - :icount "@item\n" - :csep "\n" - :cbon "@code{[X]}" :cboff "@code{[ ]}" - :cbtrans "@code{[-]}") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-texinfo) + (org-export-string-as list 'texinfo t)) (defun org-list-to-subtree (list &optional params) "Convert LIST into an Org subtree. diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el deleted file mode 100644 index 11711353ff7..00000000000 --- a/lisp/org/org-lparse.el +++ /dev/null @@ -1,2303 +0,0 @@ -;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; `org-lparse' is the entry point for the generic line-oriented -;; exporter. `org-do-lparse' is the genericized version of the -;; original `org-export-as-html' routine. - -;; `org-lparse-native-backends' is a good starting point for -;; exploring the generic exporter. - -;; Following new interactive commands are provided by this library. -;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer' -;; `org-replace-region-by', `org-lparse-region'. - -;; Note that the above routines correspond to the following routines -;; in the html exporter `org-export-as-html', -;; `org-export-as-html-and-open', `org-export-as-html-to-buffer', -;; `org-replace-region-by-html' and `org-export-region-as-html'. - -;; The new interactive command `org-lparse-convert' can be used to -;; convert documents between various formats. Use this to command, -;; for example, to convert odt file to doc or pdf format. - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-exp) -(require 'org-list) -(require 'format-spec) - -(defun org-lparse-and-open (target-backend native-backend arg - &optional file-or-buf) - "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists." - (let (f (file-or-buf (or file-or-buf - (org-lparse target-backend native-backend - arg 'hidden)))) - (when file-or-buf - (setq f (cond - ((bufferp file-or-buf) buffer-file-name) - ((file-exists-p file-or-buf) file-or-buf) - (t (error "org-lparse-and-open: This shouldn't happen")))) - (message "Opening file %s" f) - (org-open-file f 'system) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))))) - -(defun org-lparse-batch (target-backend &optional native-backend) - "Call the function `org-lparse'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-lparse-batch" - (setq native-backend (or native-backend target-backend)) - (org-lparse target-backend native-backend - org-export-headline-levels 'hidden)) - -(defun org-lparse-to-buffer (backend arg) - "Call `org-lparse' with output to a temporary buffer. -No file is created. The prefix ARG is passed through to -`org-lparse'." - (let ((tempbuf (format "*Org %s Export*" (upcase backend)))) - (org-lparse backend backend arg nil nil tempbuf) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window tempbuf)))) - -(defun org-replace-region-by (backend beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use -this command to convert it." - (let (reg backend-string buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq backend-string (org-lparse-region backend beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq backend-string (org-lparse-region backend (point-min) - (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert backend-string))) - -(defun org-lparse-region (backend beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-lparse-region \"html\" beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar org-lparse-par-open nil) - -(defun org-lparse-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) - (inline-image-extensions - (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (and (or (eq t inline-images) (and inline-images (not descp))) - (org-file-image-p filename inline-image-extensions)))) - -(defun org-lparse-format-org-link (line opt-plist) - "Return LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link - org-lparse-link-description-is-image) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq org-lparse-link-description-is-image nil) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (setq org-lparse-link-description-is-image t) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (save-match-data - (setq desc (org-add-props - (org-lparse-format 'INLINE-IMAGE desc) - '(org-protected t))))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist "" "" (org-solidify-link-text - (save-match-data - (org-link-unescape frag-0)) - nil) desc attr descp)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc attr descp)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - - ((string= type "coderef") - (setq rpl (org-lparse-format - 'ORG-LINK opt-plist type "" path desc nil descp))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl (save-match-data - (funcall fnc (org-link-unescape path) - desc1 (and (boundp 'org-lparse-backend) - (case org-lparse-backend - (xhtml 'html) - (t org-lparse-backend))))))) - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-lparse-format - 'ORG-LINK opt-plist "file" path-1 fragment-1 - desc-2 attr descp)))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<" type ":" - (save-match-data (org-link-unescape path)) - ">")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) - line)) - -(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse' -(defun org-lparse-stash-save-paragraph-state () - (assert (zerop org-lparse-par-open-stashed)) - (setq org-lparse-par-open-stashed org-lparse-par-open) - (setq org-lparse-par-open nil)) - -(defun org-lparse-stash-pop-paragraph-state () - (setq org-lparse-par-open org-lparse-par-open-stashed) - (setq org-lparse-par-open-stashed 0)) - -(defmacro with-org-lparse-preserve-paragraph-state (&rest body) - `(let ((org-lparse-do-open-par org-lparse-par-open)) - (org-lparse-end-paragraph) - ,@body - (when org-lparse-do-open-par - (org-lparse-begin-paragraph)))) -(def-edebug-spec with-org-lparse-preserve-paragraph-state (body)) - -(defvar org-lparse-native-backends nil - "List of native backends registered with `org-lparse'. -A backend can use `org-lparse-register-backend' to add itself to -this list. - -All native backends must implement a get routine and a mandatory -set of callback routines. - -The get routine must be named as org--get where backend -is the name of the backend. The exporter uses `org-lparse-get' -and retrieves the backend-specific callback by querying for -ENTITY-CONTROL and ENTITY-FORMAT variables. - -For the sake of illustration, the html backend implements -`org-xhtml-get'. It returns -`org-xhtml-entity-control-callbacks-alist' and -`org-xhtml-entity-format-callbacks-alist' as the values of -ENTITY-CONTROL and ENTITY-FORMAT settings.") - -(defun org-lparse-register-backend (backend) - "Make BACKEND known to `org-lparse' library. -Add BACKEND to `org-lparse-native-backends'." - (when backend - (setq backend (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend) - (t (error "Error while registering backend: %S" backend)))) - (add-to-list 'org-lparse-native-backends backend))) - -(defun org-lparse-unregister-backend (backend) - (setq org-lparse-native-backends - (remove (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend)) - org-lparse-native-backends)) - (message "Unregistered backend %S" backend)) - -(defun org-lparse-do-reachable-formats (in-fmt) - "Return verbose info about formats to which IN-FMT can be converted. -Return a list where each element is of the -form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See -`org-export-odt-convert-processes' for CONVERTER-PROCESS and see -`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST." - (let (reachable-formats) - (dolist (backend org-lparse-native-backends reachable-formats) - (let* ((converter (org-lparse-backend-get - backend 'CONVERT-METHOD)) - (capabilities (org-lparse-backend-get - backend 'CONVERT-CAPABILITIES))) - (when converter - (dolist (c capabilities) - (when (member in-fmt (nth 1 c)) - (push (cons converter (nth 2 c)) reachable-formats)))))))) - -(defun org-lparse-reachable-formats (in-fmt) - "Return list of formats to which IN-FMT can be converted. -The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-lparse-do-reachable-formats in-fmt)))) - l)) - -(defun org-lparse-reachable-p (in-fmt out-fmt) - "Return non-nil if IN-FMT can be converted to OUT-FMT." - (catch 'done - (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt))) - (dolist (e reachable-formats) - (let ((out-fmt-spec (assoc out-fmt (cdr e)))) - (when out-fmt-spec - (throw 'done (cons (car e) out-fmt-spec)))))))) - -(defun org-lparse-backend-is-native-p (backend) - (member backend org-lparse-native-backends)) - -(defun org-lparse (target-backend native-backend arg - &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -If there is an active region, export only the region. The -outline is first exported to NATIVE-BACKEND and optionally -converted to TARGET-BACKEND. See `org-lparse-native-backends' -for list of known native backends. Each native backend can -specify a converter and list of target backends it exports to -using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get -method. See `org-xhtml-get' for an illustrative example. - -ARG is a prefix argument that specifies how many levels of -outline should become headlines. The default is 3. Lower levels -will become bulleted lists. - -HIDDEN is obsolete and does nothing. - -EXT-PLIST is a property list that controls various aspects of -export. The settings here override org-mode's default settings -and but are inferior to file-local settings. - -TO-BUFFER dumps the exported lines to a buffer or a string -instead of a file. If TO-BUFFER is the symbol `string' return the -exported lines as a string. If TO-BUFFER is non-nil, create a -buffer with that name and export to that buffer. - -BODY-ONLY controls the presence of header and footer lines in -exported text. If BODY-ONLY is non-nil, don't produce the file -header and footer, simply return the content of ..., -without even the body tags themselves. - -PUB-DIR specifies the publishing directory." - (let* ((org-lparse-backend (intern native-backend)) - (org-lparse-other-backend (and target-backend - (intern target-backend)))) - (add-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (add-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote) - (unless (org-lparse-backend-is-native-p native-backend) - (error "Don't know how to export natively to backend %s" native-backend)) - - (unless (or (equal native-backend target-backend) - (org-lparse-reachable-p native-backend target-backend)) - (error "Don't know how to export to backend %s %s" target-backend - (format "via %s" native-backend))) - (run-hooks 'org-export-first-hook) - (prog1 - (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir) - (remove-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote)))) - -(defcustom org-lparse-use-flashy-warning nil - "Control flashing of messages logged with `org-lparse-warn'. -When non-nil, messages are fontified with warning face and the -exporter lingers for a while to catch user's attention." - :type 'boolean - :group 'org-lparse) - -(defun org-lparse-convert-read-params () - "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'. -This is a helper routine for interactive use." - (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) - (in-file (read-file-name "File to be converted: " - nil buffer-file-name t)) - (in-fmt (file-name-extension in-file)) - (out-fmt-choices (org-lparse-reachable-formats in-fmt)) - (out-fmt - (or (and out-fmt-choices - (funcall input "Output format: " - out-fmt-choices nil nil nil)) - (error - "No known converter or no known output formats for %s files" - in-fmt)))) - (list in-file out-fmt))) - -(eval-when-compile - (require 'browse-url)) - -(declare-function browse-url-file-url "browse-url" (file)) - -(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg) - "Workhorse routine for `org-export-odt-convert'." - (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) - (in-fmt (file-name-extension in-file)) - (out-fmt (or out-fmt (error "Output format unspecified"))) - (how (or (org-lparse-reachable-p in-fmt out-fmt) - (error "Cannot convert from %s format to %s format?" - in-fmt out-fmt))) - (convert-process (car how)) - (out-file (concat (file-name-sans-extension in-file) "." - (nth 1 (or (cdr how) out-fmt)))) - (extra-options (or (nth 2 (cdr how)) "")) - (out-dir (file-name-directory in-file)) - (cmd (format-spec convert-process - `((?i . ,(shell-quote-argument in-file)) - (?I . ,(browse-url-file-url in-file)) - (?f . ,out-fmt) - (?o . ,out-file) - (?O . ,(browse-url-file-url out-file)) - (?d . , (shell-quote-argument out-dir)) - (?D . ,(browse-url-file-url out-dir)) - (?x . ,extra-options))))) - (when (file-exists-p out-file) - (delete-file out-file)) - - (message "Executing %s" cmd) - (let ((cmd-output (shell-command-to-string cmd))) - (message "%s" cmd-output)) - - (cond - ((file-exists-p out-file) - (message "Exported to %s" out-file) - (when prefix-arg - (message "Opening %s..." out-file) - (org-open-file out-file 'system)) - out-file) - (t - (message "Export to %s failed" out-file) - nil)))) - -(defvar org-lparse-insert-tag-with-newlines 'both) - -;; Following variables are let-bound during `org-lparse' -(defvar org-lparse-dyn-first-heading-pos) -(defvar org-lparse-toc) -(defvar org-lparse-entity-control-callbacks-alist) -(defvar org-lparse-entity-format-callbacks-alist) -(defvar org-lparse-backend nil - "The native backend to which the document is currently exported. -This variable is let bound during `org-lparse'. Valid values are -one of the symbols corresponding to `org-lparse-native-backends'. - -Compare this variable with `org-export-current-backend' which is -bound only during `org-export-preprocess-string' stage of the -export process. - -See also `org-lparse-other-backend'.") - -(defvar org-lparse-other-backend nil - "The target backend to which the document is currently exported. -This variable is let bound during `org-lparse'. This variable is -set to either `org-lparse-backend' or one of the symbols -corresponding to OTHER-BACKENDS specification of the -org-lparse-backend. - -For example, if a document is exported to \"odt\" then both -org-lparse-backend and org-lparse-other-backend are bound to -'odt. On the other hand, if a document is exported to \"odt\" -and then converted to \"doc\" then org-lparse-backend is set to -'odt and org-lparse-other-backend is set to 'doc.") - -(defvar org-lparse-body-only nil - "Bind this to BODY-ONLY arg of `org-lparse'.") - -(defvar org-lparse-to-buffer nil - "Bind this to TO-BUFFER arg of `org-lparse'.") - -(defun org-lparse-get-block-params (params) - (save-match-data - (when params - (setq params (org-trim params)) - (unless (string-match "\\`(.*)\\'" params) - (setq params (format "(%s)" params))) - (ignore-errors (read params))))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defvar org-lparse-special-blocks '("list-table" "annotation")) -(defun org-do-lparse (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -See `org-lparse' for more information. This function is a -html-agnostic version of the `org-export-as-html' function in 7.5 -version." - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (org-lparse-warn - (format "Exporting to %s using org-lparse..." - (upcase (symbol-name - (or org-lparse-backend org-lparse-other-backend))))) - - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that - ; we are interested in - ; collecting styles - org-lparse-encode-pending - org-lparse-par-open - (org-lparse-par-open-stashed 0) - - ;; list related vars - (org-lparse-list-stack '()) - - ;; list-table related vars - org-lparse-list-table-p - org-lparse-list-table:table-cell-open - org-lparse-list-table:table-row - org-lparse-list-table:lines - - org-lparse-outline-text-open - (org-lparse-latex-fragment-fallback ; currently used only by - ; odt exporter - (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK)) - (if (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) - 'dvipng - 'verbatim))) - (org-lparse-insert-tag-with-newlines 'both) - (org-lparse-to-buffer to-buffer) - (org-lparse-body-only body-only) - (org-lparse-entity-control-callbacks-alist - (org-lparse-get 'ENTITY-CONTROL)) - (org-lparse-entity-format-callbacks-alist - (org-lparse-get 'ENTITY-FORMAT)) - (opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - valid org-lparse-dyn-first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist)) - (file-name-as-directory - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil) ; Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME))) - (t (get-buffer-create to-buffer))) - (find-file-noselect - (or (let ((f (org-lparse-get 'INIT-METHOD))) - (and f (functionp f) (funcall f filename))) - filename)))) - (org-levels-open (make-vector org-level-max nil)) - (dummy (mapc - (lambda(p) - (let* ((val (plist-get opt-plist p)) - (val (org-xml-encode-org-text-skip-links val))) - (setq opt-plist (plist-put opt-plist p val)))) - '(:date :author :keywords :description))) - (date (plist-get opt-plist :date)) - (date (cond - ((and date (string-match "%" date)) - (format-time-string date)) - (date date) - (t (format-time-string "%Y-%m-%d %T %Z")))) - (dummy (setq opt-plist (plist-put opt-plist :effective-date date))) - (title (org-xml-encode-org-text-skip-links - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (org-lparse-dyn-current-environment nil) - ;; Get the language-dependent settings - (lang-words (or (assoc (plist-get opt-plist :language) - org-export-language-setup) - (assoc "en" org-export-language-setup))) - (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words))) - (head-count 0) cnt - (start 0) - (coding-system-for-write - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (save-buffer-coding-system - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (org-footnote-insert-pos-for-preprocessor 'point-min) - (org-lparse-opt-plist opt-plist) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend (if (equal org-lparse-backend 'xhtml) ; hack - 'html - org-lparse-backend) - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - org-lparse-output-buffer - org-lparse-footnote-definitions - org-lparse-footnote-number - ;; collection - org-lparse-collect-buffer - (org-lparse-collect-count 0) ; things will get haywire if - ; collections are chained. Use - ; this variable to assert this - ; pre-requisite - org-lparse-toc - href - ) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - (org-init-section-numbers) - - ;; Switch to the output buffer - (setq org-lparse-output-buffer buffer) - (set-buffer org-lparse-output-buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (setq org-lparse-opt-plist - (plist-put org-lparse-opt-plist :headline-levels umax)) - - (when (and org-export-with-toc (not body-only)) - (setq lines (org-lparse-prepare-toc - lines level-offset opt-plist umax-toc))) - - (unless body-only - (org-lparse-begin 'DOCUMENT-CONTENT opt-plist) - (org-lparse-begin 'DOCUMENT-BODY opt-plist)) - - (setq head-count 0) - (org-init-section-numbers) - - (org-lparse-begin-paragraph) - - (while (setq line (pop lines) origline line) - (catch 'nextline - (when (and (org-lparse-current-environment-p 'quote) - (string-match org-outline-regexp-bol line)) - (org-lparse-end-environment 'quote)) - - (when (org-lparse-current-environment-p 'quote) - (org-lparse-insert 'LINE line) - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not (org-lparse-current-environment-p 'fixedwidth)) - (org-lparse-begin-environment 'fixedwidth)) - (org-lparse-insert 'LINE (match-string 3 line)) - (when (or (not lines) - (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" - (car lines)))) - (org-lparse-end-environment 'fixedwidth)) - (throw 'nextline nil)) - - ;; Native Text - (when (and (get-text-property 0 'org-native-text line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-native-text line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-begin-environment 'native) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-native-text (car lines)))) - (org-lparse-insert 'LINE (pop lines))) - (org-lparse-end-environment 'native)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (org-lparse-insert 'LINE (pop lines)))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (string-match - "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line) - (let* ((style (intern (downcase (match-string 1 line)))) - (env-options-plist (org-lparse-get-block-params - (match-string 3 line))) - (f (cdr (assoc (match-string 2 line) - '(("START" . org-lparse-begin-environment) - ("END" . org-lparse-end-environment)))))) - (when (memq style - (append - '(blockquote verse center) - (mapcar 'intern org-lparse-special-blocks))) - (funcall f style env-options-plist) - (throw 'nextline nil)))) - - (when (org-lparse-current-environment-p 'verse) - (let ((i (org-get-string-indentation line))) - (if (> i 0) - (setq line (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'SPACES (* 2 i))) - " " (org-trim line)))) - (unless (string-match "\\\\\\\\[ \t]*$" line) - (setq line (concat line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected line) - (setq start (match-end 1))) - ((match-end 2) - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR "" (org-solidify-link-text - (match-string 1 line)))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'FONTIFY (match-string 1 line) "target")) - ;; (concat "@" (match-string 1 line) "@ ") - t t line))) - (t - (setq line (replace-match - (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR (match-string 1 line) - (org-solidify-link-text (match-string 1 line)) - "target")) " ") - t t line))))) - - (let ((org-lparse-encode-pending t)) - (setq line (org-lparse-handle-time-stamps line))) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) - (setq line (org-xml-encode-org-text-skip-links line))) - - (setq line (org-lparse-format-org-link line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp line) - (match-beginning 2)) - (setq line (concat - (substring line 0 (match-beginning 2)) - (org-lparse-format 'TODO (match-string 2 line)) - (substring line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) - (setq start (match-end 2)) - (let ((n (match-string 2 line)) refcnt a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq refcnt (cdr a))) - (setq refcnt 1) - (push (cons n 1) footref-seen)) - (setq line - (replace-match - (concat - (or (match-string 1 line) "") - (org-lparse-format - 'FOOTNOTE-REFERENCE - n (cdr (assoc n org-lparse-footnote-definitions)) - refcnt) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) - (ignore-errors - (org-lparse-get 'FOOTNOTE-SEPARATOR)) - "")) - t t line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (unless org-lparse-dyn-first-heading-pos - (setq org-lparse-dyn-first-heading-pos (point))) - (org-lparse-begin-level level txt umax head-count) - - ;; QUOTES - (when (string-match quote-re line) - (org-lparse-begin-environment 'quote))) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (when (not table-open) - ;; New table starts - (setq table-open t table-buffer nil table-orig-buffer nil)) - - ;; Accumulate lines - (setq table-buffer (cons line table-buffer) - table-orig-buffer (cons origline table-orig-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer) - table-orig-buffer (nreverse table-orig-buffer)) - (org-lparse-end-paragraph) - (when org-lparse-list-table-p - (error "Regular tables are not allowed in a list-table block")) - (org-lparse-insert 'TABLE table-buffer table-orig-buffer))) - - ;; Normal lines - (t - ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item line) - (setq line (org-lparse-export-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line)))) - - ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) - (with-org-lparse-preserve-paragraph-state - (org-lparse-insert 'HORIZONTAL-LINE)) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (when (string-match "^ [-+*]-\\|^[ \t]*$" line) - (when org-lparse-footnote-number - (org-lparse-end-footnote-definition org-lparse-footnote-number) - (setq org-lparse-footnote-number nil)) - (org-lparse-begin-paragraph)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) - (org-lparse-end-paragraph) - (setq org-lparse-footnote-number (match-string 1 line)) - (setq line (replace-match "" t t line)) - (org-lparse-begin-footnote-definition org-lparse-footnote-number))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match - (org-lparse-format 'LINE-BREAK) - t t line))) - (org-export-preserve-breaks - (setq line (concat line (org-lparse-format 'LINE-BREAK))))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-lparse-par-open - (string-match "\\\\par\\>" line start)) - (error "FIXME") - ;; Leave a space in the

    so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "

    " t t line))) - (setq start (match-end 0)))) - - (org-lparse-insert 'LINE line))))) - - ;; Properly close all local lists and other lists - (when (org-lparse-current-environment-p 'quote) - (org-lparse-end-environment 'quote)) - - (org-lparse-end-level 1 umax) - - ;; the

to close the last text-... div. - (when (and (> umax 0) org-lparse-dyn-first-heading-pos) - (org-lparse-end-outline-text-or-outline)) - - (org-lparse-end 'DOCUMENT-BODY opt-plist) - (unless body-only - (org-lparse-end 'DOCUMENT-CONTENT)) - - (org-lparse-end 'EXPORT) - - ;; kill collection buffer - (when org-lparse-collect-buffer - (kill-buffer org-lparse-collect-buffer)) - - (goto-char (point-min)) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done")) - - (cond - ((not to-buffer) - (let ((f (org-lparse-get 'SAVE-METHOD))) - (or (and f (functionp f) (funcall f filename opt-plist)) - (save-buffer))) - (or (and (boundp 'org-lparse-other-backend) - org-lparse-other-backend - (not (equal org-lparse-backend org-lparse-other-backend)) - (org-lparse-do-convert - buffer-file-name (symbol-name org-lparse-other-backend))) - (current-buffer))) - ((eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))) - (t (current-buffer)))))) - -(defun org-lparse-format-table (lines olines) - "Returns backend-specific code for org-type and table-type tables." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-lparse-format-org-table lines nil) - ;; Table made by table.el - (or (org-lparse-format-table-table-using-table-generate-source - ;; FIXME: Need to take care of this during merge - (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend) - olines - (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-lparse-format-table-table lines)))) - -(defun org-lparse-table-get-colalign-info (lines) - (let ((col-cookies (org-find-text-property-in-string - 'org-col-cookies (car lines)))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - col-cookies)) - -(defvar org-lparse-table-style) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-num-numeric-items-per-column) -(defvar org-lparse-table-colalign-info) -(defvar org-lparse-table-colalign-vector) - -;; Following variables are defined in org-table.el -(defvar org-table-number-fraction) -(defvar org-table-number-regexp) -(defun org-lparse-org-table-to-list-table (lines &optional splice) - "Convert org-table to list-table. -LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each -element is a `string' representing a single row of org-table. -Thus each ROW has vertical separators \"|\" separating the table -fields. A ROW could also be a row-group separator of the form -\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3 -...). ROW could either be symbol `:hrule' or a list of the -form (FIELD1 FIELD2 FIELD3 ...) as appropriate." - (let (line lines-1) - (cond - (splice - (while (setq line (pop lines)) - (unless (string-match "^[ \t]*|-" line) - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))) - (t - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*|-" line) - (when lines - (push :hrule lines-1))) - (t - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))))) - (nreverse lines-1))) - -(defun org-lparse-insert-org-table (lines &optional splice) - "Format a org-type table into backend-specific code. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (short-caption (or (org-find-text-property-in-string - 'org-caption-shortn (car lines)) caption)) - (caption (and caption (org-xml-encode-org-text caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines)) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines)))))) - (setq lines (org-lparse-org-table-to-list-table lines splice)) - (org-lparse-insert-list-table - lines splice caption label attributes head org-lparse-table-colalign-info - short-caption))) - -(defun org-lparse-insert-list-table (lines &optional splice - caption label attributes head - org-lparse-table-colalign-info - short-caption) - (or (featurep 'org-table) ; required for - (require 'org-table)) ; `org-table-number-regexp' - (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0) - tbopen fields line - org-lparse-table-cur-rowgrp-is-hdr - org-lparse-table-rowgrp-open - org-lparse-table-num-numeric-items-per-column - org-lparse-table-colalign-vector n - org-lparse-table-rowgrp-info - org-lparse-table-begin-marker - (org-lparse-table-style 'org-table) - org-lparse-table-is-styled) - (cond - (splice - (setq org-lparse-table-is-styled nil) - (while (setq line (pop lines)) - (insert (org-lparse-format-table-row line) "\n"))) - (t - (setq org-lparse-table-is-styled t) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (setq org-lparse-table-begin-marker (point)) - (org-lparse-begin-table-rowgroup head) - (while (setq line (pop lines)) - (cond - ((equal line :hrule) - (org-lparse-begin-table-rowgroup)) - (t - (insert (org-lparse-format-table-row line) "\n")))) - (org-lparse-end 'TABLE-ROWGROUP) - (org-lparse-end-table))))) - -(defun org-lparse-format-org-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-org-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-format-list-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-list-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-insert-table-table (lines) - "Format a table generated by table.el into backend-specific code. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (org-lparse-table-cur-rowgrp-is-hdr - org-export-highlight-first-table-line) - (caption nil) - (short-caption nil) - (attributes nil) - (label nil) - (org-lparse-table-style 'table-table) - (org-lparse-table-is-styled nil) - fields org-lparse-table-ncols i (org-lparse-table-rownum -1) - (empty (org-lparse-format 'SPACES 1))) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*\\+-" line) - (when field-buffer - (let ((org-export-table-row-tags '("" . "")) - ;; (org-export-html-table-use-header-tags-for-first-column nil) - ) - (insert (org-lparse-format-table-row field-buffer empty))) - (setq org-lparse-table-cur-rowgrp-is-hdr nil) - (setq field-buffer nil))) - (t - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x (org-lparse-format 'LINE-BREAK) - (pop fields))) - field-buffer)) - (setq field-buffer fields))))) - (org-lparse-end-table))) - -(defun org-lparse-format-table-table (lines) - (with-temp-buffer - (org-lparse-insert-table-table lines) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defvar table-source-languages) ; defined in table.el -(defun org-lparse-format-table-table-using-table-generate-source (backend - lines - &optional - spanned-only) - "Format a table into BACKEND, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (cond - ((member backend table-source-languages) - (table-generate-source backend " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))) - (t - ;; table.el doesn't support the given backend. Currently this - ;; happens in case of odt export. Strip the table from the - ;; generated document. A better alternative would be to embed - ;; the table as ascii text in the output document. - (org-lparse-warn - (concat - "Found table.el-type table in the source org file. " - (format "table.el doesn't support %s backend. " - (upcase (symbol-name backend))) - "Skipping ahead ...")) - ""))))) - -(defun org-lparse-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) " " - (org-lparse-format - 'FONTIFY - (concat - (if (match-end 1) - (org-lparse-format - 'FONTIFY - (match-string 1 s) "timestamp-kwd")) - " " - (org-lparse-format - 'FONTIFY - (substring (org-translate-time (match-string 3 s)) 1 -1) - "timestamp")) - "timestamp-wrapper")) - s (substring s (match-end 0))))) - - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r (org-lparse-format 'LINE-BREAK)))) - r)))) - -(defun org-xml-encode-plain-text (s) - "Convert plain text characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-xml-encode-org-text-skip-links (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-xml-encode-org-text s) res) - (push l res)) - (push (org-xml-encode-org-text string) res) - (apply 'concat (nreverse res))))) - -(defun org-xml-encode-org-text (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-xml-encode-plain-text s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-lparse-apply-char-styles s))) - (if org-export-with-special-strings - (setq s (org-lparse-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-lparse-apply-sub-superscript-styles s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-lparse-format 'ORG-ENTITY wd)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-lparse-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS)) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-lparse-apply-sub-superscript-styles (string) - "Apply subscript and superscript styles to STRING. -Use `org-export-with-sub-superscripts' to control application of -sub and superscript styles." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") - 'subscript 'superscript) - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - (org-lparse-format 'FONTIFY c key)) - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defvar org-lparse-char-styles - `(("*" bold) - ("/" emphasis) - ("_" underline) - ("=" code) - ("~" verbatim) - ("+" strike)) - "Map Org emphasis markers to char styles. -This is an alist where each element is of the -form (ORG-EMPHASIS-CHAR . CHAR-STYLE).") - -(defun org-lparse-apply-char-styles (string) - "Apply char styles to STRING. -The variable `org-lparse-char-styles' controls how the Org -emphasis markers are interpreted." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (org-lparse-format - 'FONTIFY (match-string 4 string) - (nth 1 (assoc (match-string 3 string) - org-lparse-char-styles))) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-lparse-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. - -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-lparse-end-paragraph) - ;; Ending for every item - (org-lparse-end-list-item-1 type) - ;; We're ending last item of the list: end list. - (when lastp - (org-lparse-end-list type) - (org-lparse-begin-paragraph)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-lparse-end-paragraph) - (org-lparse-begin-list type)) - - (let ((arg (cond ((equal type "d") desc-tag) - ((equal type "o") counter)))) - (org-lparse-begin-list-item type arg)) - - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (org-lparse-format - 'FONTIFY (concat - "[" - (cond - ((string-match "X" checkbox) "X") - ((string-match " " checkbox) - (org-lparse-format 'SPACES 1)) - (t "-")) - "]") - 'code) - " " - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t line)))) - -(defun org-lparse-bind-local-variables (opt-plist) - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars)) - -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-footnote-number) -(defvar org-lparse-footnote-definitions) -(defvar org-lparse-output-buffer nil - "Buffer to which `org-do-lparse' writes to. -This buffer contains the contents of the to-be-created exported -document.") - -(defcustom org-lparse-debug nil - "Enable or Disable logging of `org-lparse' callbacks. -The parameters passed to the backend-registered ENTITY-CONTROL -and ENTITY-FORMAT callbacks are logged as comment strings in the -exported buffer. (org-lparse-format 'COMMENT fmt args) is used -for logging. Customize this variable only if you are an expert -user. Valid values of this variable are: -nil : Disable logging -control : Log all invocations of `org-lparse-begin' and - `org-lparse-end' callbacks. -format : Log invocations of `org-lparse-format' callbacks. -t : Log all invocations of `org-lparse-begin', `org-lparse-end' - and `org-lparse-format' callbacks," - :group 'org-lparse - :type '(choice - (const :tag "Disable" nil) - (const :tag "Format callbacks" format) - (const :tag "Control callbacks" control) - (const :tag "Format and Control callbacks" t))) - -(defun org-lparse-begin (entity &rest args) - "Begin ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc. - -Use (org-lparse-begin 'LIST \"o\") to begin a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args))) - - (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-end (entity &rest args) - "Close ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM -etc. - -Use (org-lparse-end 'LIST \"o\") to close a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s END %S" entity args))) - - (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-begin-paragraph (&optional style) - "Insert

, but first close previous paragraph if any." - (org-lparse-end-paragraph) - (org-lparse-begin 'PARAGRAPH style) - (setq org-lparse-par-open t)) - -(defun org-lparse-end-paragraph () - "Close paragraph if there is one open." - (when org-lparse-par-open - (org-lparse-end 'PARAGRAPH) - (setq org-lparse-par-open nil))) - -(defun org-lparse-end-list-item-1 (&optional type) - "Close

  • if necessary." - (org-lparse-end-paragraph) - (org-lparse-end-list-item (or type "u"))) - -(define-obsolete-function-alias - 'org-lparse-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote - "24.3") - -(defun org-lparse-preprocess-after-blockquote () - "Treat `org-lparse-special-blocks' specially." - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t) - (when (member (downcase (match-string 2)) org-lparse-special-blocks) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (format "ORG-%s-START %s" (upcase (match-string 2)) - (match-string 3)) - (format "ORG-%s-END %s" (upcase (match-string 2)) - (match-string 3))) t t)))) - -(define-obsolete-function-alias - 'org-lparse-strip-experimental-blocks-maybe-hook - 'org-lparse-strip-experimental-blocks-maybe - "24.3") - -(defun org-lparse-strip-experimental-blocks-maybe () - "Strip \"list-table\" and \"annotation\" blocks. -Stripping happens only when the exported backend is not one of -\"odt\" or \"xhtml\"." - (when (not org-lparse-backend) - (message "Stripping following blocks - %S" org-lparse-special-blocks) - (goto-char (point-min)) - (let ((case-fold-search t)) - (while - (re-search-forward - "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*" - nil t) - (when (member (match-string 1) org-lparse-special-blocks) - (replace-match "" t t)))))) - -(defvar org-lparse-list-table-p nil - "Non-nil if `org-do-lparse' is within a list-table.") - -(defvar org-lparse-dyn-current-environment nil) -(defun org-lparse-begin-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p t)) - (t (setq org-lparse-dyn-current-environment style) - (org-lparse-begin 'ENVIRONMENT style env-options-plist)))) - -(defun org-lparse-end-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p nil)) - (t (org-lparse-end 'ENVIRONMENT style env-options-plist) - (setq org-lparse-dyn-current-environment nil)))) - -(defun org-lparse-current-environment-p (style) - (eq org-lparse-dyn-current-environment style)) - -(defun org-lparse-begin-footnote-definition (n) - (org-lparse-begin-collect) - (setq org-lparse-insert-tag-with-newlines nil) - (org-lparse-begin 'FOOTNOTE-DEFINITION n)) - -(defun org-lparse-end-footnote-definition (n) - (org-lparse-end 'FOOTNOTE-DEFINITION n) - (setq org-lparse-insert-tag-with-newlines 'both) - (let ((footnote-def (org-lparse-end-collect))) - ;; Cleanup newlines in footnote definition. This ensures that a - ;; transcoded line is never (wrongly) broken in to multiple lines. - (let ((pos 0)) - (while (string-match "[\r\n]+" footnote-def pos) - (setq pos (1+ (match-beginning 0))) - (setq footnote-def (replace-match " " t t footnote-def)))) - (push (cons n footnote-def) org-lparse-footnote-definitions))) - -(defvar org-lparse-collect-buffer nil - "An auxiliary buffer named \"*Org Lparse Collect*\". -`org-do-lparse' uses this as output buffer while collecting -footnote definitions and table-cell contents of list-tables. See -`org-lparse-begin-collect' and `org-lparse-end-collect'.") - -(defvar org-lparse-collect-count nil - "Count number of calls to `org-lparse-begin-collect'. -Use this counter to catch chained collections if they ever -happen.") - -(defun org-lparse-begin-collect () - "Temporarily switch to `org-lparse-collect-buffer'. -Also erase it's contents." - (unless (zerop org-lparse-collect-count) - (error "FIXME (org-lparse.el): Encountered chained collections")) - (incf org-lparse-collect-count) - (unless org-lparse-collect-buffer - (setq org-lparse-collect-buffer - (get-buffer-create "*Org Lparse Collect*"))) - (set-buffer org-lparse-collect-buffer) - (erase-buffer)) - -(defun org-lparse-end-collect () - "Switch to `org-lparse-output-buffer'. -Return contents of `org-lparse-collect-buffer' as a `string'." - (assert (> org-lparse-collect-count 0)) - (decf org-lparse-collect-count) - (prog1 (buffer-string) - (erase-buffer) - (set-buffer org-lparse-output-buffer))) - -(defun org-lparse-format (entity &rest args) - "Format ENTITY in backend-specific way and return it. -ARGS is specific to entity being formatted. - -Use (org-lparse-format 'HEADING \"text\" 1) to format text as -level 1 heading. - -See `org-xhtml-entity-format-callbacks-alist' for more information." - (when (and (member org-lparse-debug '(t format)) - (not (equal entity 'COMMENT))) - (insert (org-lparse-format 'COMMENT "%s: %S" entity args))) - (cond - ((consp entity) - (let ((text (pop args))) - (apply 'org-lparse-format 'TAGS entity text args))) - (t - (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))))) - -(defun org-lparse-insert (entity &rest args) - (insert (apply 'org-lparse-format entity args))) - -(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc) - (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (org-min-level (org-get-min-level lines level-offset)) - (org-last-level org-min-level) - level) - (with-temp-buffer - (org-lparse-bind-local-variables opt-plist) - (erase-buffer) - (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc) - (setq - lines - (mapcar - #'(lambda (line) - (when (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line)) - (<= (setq level (org-tr-level - (- (match-end 1) (match-beginning 1) - level-offset))) - umax-toc)) - (let ((txt (save-match-data - (org-xml-encode-org-text-skip-links - (org-export-cleanup-toc-line - (match-string 3 line))))) - (todo (and - org-export-mark-todo-in-toc - (or (and (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - (and (= level umax-toc) - (org-search-todo-below - line lines level))))) - tags) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line - (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'FONTIFY - (match-string 1 line) "target")) - t t line))) - (when (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq tags (match-string 1 txt) - txt (replace-match "" t nil txt))) - (when (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (org-lparse-format - 'TOC-ITEM - (let* ((snumber (org-section-number level)) - (href (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (href - (or - (cdr (assoc - href org-export-preferred-target-alist)) - href)) - (href (org-solidify-link-text href))) - (org-lparse-format 'TOC-ENTRY snumber todo txt tags href)) - level org-last-level) - (setq org-last-level level))) - line) - lines)) - (org-lparse-end 'TOC) - (setq org-lparse-toc (buffer-string)))) - lines) - -(defun org-lparse-format-table-row (fields &optional text-for-empty-fields) - (if org-lparse-table-ncols - ;; second and subsequent rows of the table - (when (and org-lparse-list-table-p - (> (length fields) org-lparse-table-ncols)) - (error "Table row has %d columns but header row claims %d columns" - (length fields) org-lparse-table-ncols)) - ;; first row of the table - (setq org-lparse-table-ncols (length fields)) - (when org-lparse-table-is-styled - (setq org-lparse-table-num-numeric-items-per-column - (make-vector org-lparse-table-ncols 0)) - (setq org-lparse-table-colalign-vector - (make-vector org-lparse-table-ncols nil)) - (let ((c -1)) - (while (< (incf c) org-lparse-table-ncols) - (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))) - (align (nth 0 col-cookie))) - (setf (aref org-lparse-table-colalign-vector c) - (cond - ((string= align "l") "left") - ((string= align "r") "right") - ((string= align "c") "center")))))))) - (incf org-lparse-table-rownum) - (let ((i -1)) - (org-lparse-format - 'TABLE-ROW - (mapconcat - (lambda (x) - (when (and (string= x "") text-for-empty-fields) - (setq x text-for-empty-fields)) - (incf i) - (let (col-cookie horiz-span) - (when org-lparse-table-is-styled - (when (and (< i org-lparse-table-ncols) - (string-match org-table-number-regexp x)) - (incf (aref org-lparse-table-num-numeric-items-per-column i))) - (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info)) - horiz-span (nth 1 col-cookie))) - (org-lparse-format - 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0)))) - fields "\n")))) - -(defun org-lparse-get (what &optional opt-plist) - "Query for value of WHAT for the current backend `org-lparse-backend'. -See also `org-lparse-backend-get'." - (if (boundp 'org-lparse-backend) - (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist) - (error "org-lparse-backend is not bound yet"))) - -(defun org-lparse-backend-get (backend what &optional opt-plist) - "Query BACKEND for value of WHAT. -Dispatch the call to `org--user-get'. If that throws an -error, dispatch the call to `org--get'. See -`org-xhtml-get' for all known settings queried for by -`org-lparse' during the course of export." - (assert (stringp backend) t) - (unless (org-lparse-backend-is-native-p backend) - (error "Unknown native backend %s" backend)) - (let ((backend-get-method (intern (format "org-%s-get" backend))) - (backend-user-get-method (intern (format "org-%s-user-get" backend)))) - (cond - ((functionp backend-get-method) - (condition-case nil - (funcall backend-user-get-method what opt-plist) - (error (funcall backend-get-method what opt-plist)))) - (t - (error "Native backend %s doesn't define %s" backend backend-get-method))))) - -(defun org-lparse-insert-tag (tag &rest args) - (when (member org-lparse-insert-tag-with-newlines '(lead both)) - (insert "\n")) - (insert (apply 'format tag args)) - (when (member org-lparse-insert-tag-with-newlines '(trail both)) - (insert "\n"))) - -(defun org-lparse-get-targets-from-title (title) - (let* ((target (org-get-text-property-any 0 'target title)) - (extra-targets (assoc target org-export-target-aliases)) - (target (or (cdr (assoc target org-export-preferred-target-alist)) - target))) - (cons target (remove target extra-targets)))) - -(defun org-lparse-suffix-from-snumber (snumber) - (let* ((snu (replace-regexp-in-string "\\." "-" snumber)) - (href (cdr (assoc (concat "sec-" snu) - org-export-preferred-target-alist)))) - (org-solidify-link-text (or href snu)))) - -(defun org-lparse-begin-level (level title umax head-count) - "Insert a new LEVEL in HTML export. -When TITLE is nil, just close all open levels." - (org-lparse-end-level level umax) - (unless title (error "Why is heading nil")) - (let* ((targets (org-lparse-get-targets-from-title title)) - (target (car targets)) (extra-targets (cdr targets)) - (target (and target (org-solidify-link-text target))) - (extra-class (org-get-text-property-any 0 'html-container-class title)) - snumber tags level1 class) - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq tags (and org-export-with-tags (match-string 1 title))) - (setq title (replace-match "" t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (org-lparse-end-list-item-1) - (aset org-levels-open (1- level) t) - (org-lparse-end-paragraph) - (org-lparse-begin-list 'unordered)) - (org-lparse-begin-list-item - 'unordered target (org-lparse-format - 'HEADLINE title extra-targets tags))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) - (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)) - (unless (= head-count 1) - (org-lparse-end-outline-text-or-outline)) - (org-lparse-begin-outline-and-outline-text - level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-paragraph)))) - -(defun org-lparse-end-level (level umax) - (org-lparse-end-paragraph) - (loop for l from org-level-max downto level - do (when (aref org-levels-open (1- l)) - ;; Terminate one level in HTML export - (if (<= l umax) - (org-lparse-end-outline-text-or-outline) - (org-lparse-end-list-item-1) - (org-lparse-end-list 'unordered)) - (aset org-levels-open (1- l) nil)))) - -(defvar org-lparse-outline-text-open) -(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags - target extra-targets - extra-class) - (org-lparse-begin - 'OUTLINE level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-outline-text level1 snumber extra-class)) - -(defun org-lparse-end-outline-text-or-outline () - (cond - (org-lparse-outline-text-open - (org-lparse-end 'OUTLINE-TEXT) - (setq org-lparse-outline-text-open nil)) - (t (org-lparse-end 'OUTLINE)))) - -(defun org-lparse-begin-outline-text (level1 snumber extra-class) - (assert (not org-lparse-outline-text-open) t) - (setq org-lparse-outline-text-open t) - (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class)) - -(defun org-lparse-html-list-type-to-canonical-list-type (ltype) - (cdr (assoc ltype '(("o" . ordered) - ("u" . unordered) - ("d" . description))))) - -;; following vars are bound during `org-do-lparse' -(defvar org-lparse-list-stack) -(defvar org-lparse-list-table:table-row) -(defvar org-lparse-list-table:lines) - -;; Notes on LIST-TABLES -;; ==================== -;; Lists withing "list-table" blocks (as shown below) -;; -;; #+begin_list-table -;; - Row 1 -;; - 1.1 -;; - 1.2 -;; - 1.3 -;; - Row 2 -;; - 2.1 -;; - 2.2 -;; - 2.3 -;; #+end_list-table -;; -;; will be exported as though it were a table as shown below. -;; -;; | Row 1 | 1.1 | 1.2 | 1.3 | -;; | Row 2 | 2.1 | 2.2 | 2.3 | -;; -;; Note that org-tables are NOT multi-line and each line is mapped to -;; a unique row in the exported document. So if an exported table -;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the -;; table editor will be a cumbersome task. Furthermore inclusion of -;; multi-paragraph text in a table cell is well-nigh impossible. -;; -;; LIST-TABLEs are meant to circumvent the above problems with -;; org-tables. -;; -;; Note that in the example above the list items could be paragraphs -;; themselves and the list can be arbitrarily deep. -;; -;; Inspired by following thread: -;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html - -(defun org-lparse-begin-list (ltype) - (push ltype org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin LIST-TABLE - (setq org-lparse-list-table:lines nil) - (setq org-lparse-list-table:table-row nil)) - ((= 2 list-level) - (ignore)) - (t - (org-lparse-begin 'LIST ltype))))) - -(defun org-lparse-end-list (ltype) - (pop org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST ltype)) - ;; process LIST-TABLE - ((= 0 list-level) - ;; end LIST-TABLE - (insert (org-lparse-format-list-table - (nreverse org-lparse-list-table:lines)))) - ((= 1 list-level) - (ignore)) - (t - (org-lparse-end 'LIST ltype))))) - -(defun org-lparse-begin-list-item (ltype &optional arg headline) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST-ITEM ltype arg headline)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin TABLE-ROW for LIST-TABLE - (setq org-lparse-list-table:table-row nil) - (org-lparse-begin-list-table:table-cell)) - ((= 2 list-level) - ;; begin TABLE-CELL for LIST-TABLE - (org-lparse-begin-list-table:table-cell)) - (t - (org-lparse-begin 'LIST-ITEM ltype arg headline))))) - -(defun org-lparse-end-list-item (ltype) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST-ITEM ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; end TABLE-ROW for LIST-TABLE - (org-lparse-end-list-table:table-cell) - (push (nreverse org-lparse-list-table:table-row) - org-lparse-list-table:lines)) - ((= 2 list-level) - ;; end TABLE-CELL for LIST-TABLE - (org-lparse-end-list-table:table-cell)) - (t - (org-lparse-end 'LIST-ITEM ltype))))) - -(defvar org-lparse-list-table:table-cell-open) -(defun org-lparse-begin-list-table:table-cell () - (org-lparse-end-list-table:table-cell) - (setq org-lparse-list-table:table-cell-open t) - (org-lparse-begin-collect) - (org-lparse-begin-paragraph)) - -(defun org-lparse-end-list-table:table-cell () - (when org-lparse-list-table:table-cell-open - (setq org-lparse-list-table:table-cell-open nil) - (org-lparse-end-paragraph) - (push (org-lparse-end-collect) - org-lparse-list-table:table-row))) - -(defvar org-lparse-table-rowgrp-info) -(defun org-lparse-begin-table-rowgroup (&optional is-header-row) - (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info) - (org-lparse-begin 'TABLE-ROWGROUP is-header-row)) - -(defun org-lparse-end-table () - (when org-lparse-table-is-styled - ;; column groups - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - - ;; column alignment - (let ((c -1)) - (mapc - (lambda (x) - (incf c) - (setf (aref org-lparse-table-colalign-vector c) - (or (aref org-lparse-table-colalign-vector c) - (if (> (/ (float x) (1+ org-lparse-table-rownum)) - org-table-number-fraction) - "right" "left")))) - org-lparse-table-num-numeric-items-per-column))) - (org-lparse-end 'TABLE)) - -(defvar org-lparse-encode-pending nil) - -(defun org-lparse-format-tags (tag text prefix suffix &rest args) - (cond - ((consp tag) - (concat prefix (apply 'format (car tag) args) text suffix - (format (cdr tag)))) - ((stringp tag) ; singleton tag - (concat prefix (apply 'format tag args) text)))) - -(defun org-xml-fix-class-name (kwd) ; audit callers of this function - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) - -(defun org-lparse-format-todo (todo) - (org-lparse-format 'FONTIFY - (concat - (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX)) - (org-xml-fix-class-name todo)) - (list (if (member todo org-done-keywords) "done" "todo") - todo))) - -(defun org-lparse-format-extra-targets (extra-targets) - (if (not extra-targets) "" - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-lparse-format 'ANCHOR "" x)) - extra-targets ""))) - -(defun org-lparse-format-org-tags (tags) - (if (not tags) "" - (org-lparse-format - 'FONTIFY (mapconcat - (lambda (x) - (org-lparse-format - 'FONTIFY x - (concat - (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX)) - (org-xml-fix-class-name x)))) - (org-split-string tags ":") - (org-lparse-format 'SPACES 1)) "tag"))) - -(defun org-lparse-format-section-number (&optional snumber level) - (and org-export-with-section-numbers - (not org-lparse-body-only) snumber level - (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level)))) - -(defun org-lparse-warn (msg) - (if (not org-lparse-use-flashy-warning) - (message msg) - (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg) - (message msg) - (sleep-for 3))) - -(defun org-xml-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-xml-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-xml-encode-org-text s)) - s)) - -(provide 'org-lparse) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-lparse.el ends here diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el deleted file mode 100644 index 5df68f56a05..00000000000 --- a/lisp/org/org-mac-message.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Authors: John Wiegley -;; Christopher Suckling - -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; This file implements links to Apple Mail.app messages from within Org-mode. -;; Org-mode does not load this module by default - if you would actually like -;; this to happen then configure the variable `org-modules'. - -;; If you would like to create links to all flagged messages in an -;; Apple Mail.app account, please customize the variable -;; `org-mac-mail-account' and then call one of the following functions: - -;; (org-mac-message-insert-selected) copies a formatted list of links to -;; the kill ring. - -;; (org-mac-message-insert-selected) inserts at point links to any -;; messages selected in Mail.app. - -;; (org-mac-message-insert-flagged) searches within an org-mode buffer -;; for a specific heading, creating it if it doesn't exist. Any -;; message:// links within the first level of the heading are deleted -;; and replaced with links to flagged messages. - -;;; Code: - -(require 'org) - -(defgroup org-mac-flagged-mail nil - "Options concerning linking to flagged Mail.app messages." - :tag "Org Mail.app" - :group 'org-link) - -(defcustom org-mac-mail-account "customize" - "The Mail.app account in which to search for flagged messages." - :group 'org-mac-flagged-mail - :type 'string) - -(org-add-link-type "message" 'org-mac-message-open) - -;; In mac.c, removed in Emacs 23. -(declare-function do-applescript "org-mac-message" (script)) -(unless (fboundp 'do-applescript) - ;; Need to fake this using shell-command-to-string - (defun do-applescript (script) - (let (start cmd return) - (while (string-match "\n" script) - (setq script (replace-match "\r" t t script))) - (while (string-match "'" script start) - (setq start (+ 2 (match-beginning 0)) - script (replace-match "\\'" t t script))) - (setq cmd (concat "osascript -e '" script "'")) - (setq return (shell-command-to-string cmd)) - (concat "\"" (org-trim return) "\"")))) - -(defun org-mac-message-open (message-id) - "Visit the message with the given MESSAGE-ID. -This will use the command `open' with the message URL." - (start-process (concat "open message:" message-id) nil - "open" (concat "message://<" (substring message-id 2) ">"))) - -(defun as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app." - (do-applescript - (concat - "tell application \"Mail\"\n" - "set theLinkList to {}\n" - "set theSelection to selection\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app." - (do-applescript - (concat - ;; Is Growl installed? - "tell application \"System Events\"\n" - "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" - "if (count of growlHelpers) > 0 then\n" - "set growlHelperApp to item 1 of growlHelpers\n" - "else\n" - "set growlHelperApp to \"\"\n" - "end if\n" - "end tell\n" - - ;; Get links - "tell application \"Mail\"\n" - "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" - "set theLinkList to {}\n" - "repeat with aMailbox in theMailboxes\n" - "set theSelection to (every message in aMailbox whose flagged status = true)\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - - ;; Report progress through Growl - ;; This "double tell" idiom is described in detail at - ;; http://macscripter.net/viewtopic.php?id=24570 The - ;; script compiler needs static knowledge of the - ;; growlHelperApp. Hmm, since we're compiling - ;; on-the-fly here, this is likely to be way less - ;; portable than I'd hoped. It'll work when the name - ;; is still "GrowlHelperApp", though. - "if growlHelperApp is not \"\" then\n" - "tell application \"GrowlHelperApp\"\n" - "tell application growlHelperApp\n" - "set the allNotificationsList to {\"FlaggedMail\"}\n" - "set the enabledNotificationsList to allNotificationsList\n" - "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" - "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" - "end tell\n" - "end tell\n" - "end if\n" - "end repeat\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun org-mac-message-get-links (&optional select-or-flag) - "Create links to the messages currently selected or flagged in Mail.app. -This will use AppleScript to get the message-id and the subject of the -messages in Mail.app and make a link out of it. -When SELECT-OR-FLAG is \"s\", get the selected messages (this is also -the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. -The Org-syntax text will be pushed to the kill ring, and also returned." - (interactive "sLink to (s)elected or (f)lagged messages: ") - (setq select-or-flag (or select-or-flag "s")) - (message "AppleScript: searching mailboxes...") - (let* ((as-link-list - (if (string= select-or-flag "s") - (as-get-selected-mail) - (if (string= select-or-flag "f") - (as-get-flagged-mail) - (error "Please select \"s\" or \"f\"")))) - (link-list - (mapcar - (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) - (split-string as-link-list "[\r\n]+"))) - split-link URL description orglink orglink-insert rtn orglink-list) - (while link-list - (setq split-link (split-string (pop link-list) "::split::")) - (setq URL (car split-link)) - (setq description (cadr split-link)) - (when (not (string= URL "")) - (setq orglink (org-make-link-string URL description)) - (push orglink orglink-list))) - (setq rtn (mapconcat 'identity orglink-list "\n")) - (kill-new rtn) - rtn)) - -(defun org-mac-message-insert-selected () - "Insert a link to the messages currently selected in Mail.app. -This will use AppleScript to get the message-id and the subject of the -active mail in Mail.app and make a link out of it." - (interactive) - (insert (org-mac-message-get-links "s"))) - -;; The following line is for backward compatibility -(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected) - -(defun org-mac-message-insert-flagged (org-buffer org-heading) - "Asks for an org buffer and a heading within it, and replace message links. -If heading exists, delete all message:// links within heading's first -level. If heading doesn't exist, create it at point-max. Insert -list of message:// links to flagged mail after heading." - (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") - (with-current-buffer org-buffer - (goto-char (point-min)) - (let ((isearch-forward t) - (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) - (if (org-goto-local-search-headings org-heading nil t) - (if (not (eobp)) - (progn - (save-excursion - (while (re-search-forward - message-re (save-excursion (outline-next-heading)) t) - (delete-region (match-beginning 0) (match-end 0))) - (insert "\n" (org-mac-message-get-links "f"))) - (flush-lines "^$" (point) (outline-next-heading))) - (insert "\n" (org-mac-message-get-links "f"))) - (goto-char (point-max)) - (insert "\n") - (org-insert-heading nil t) - (insert org-heading "\n" (org-mac-message-get-links "f")))))) - -(provide 'org-mac-message) - -;;; org-mac-message.el ends here diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el new file mode 100644 index 00000000000..5b890346dd7 --- /dev/null +++ b/lisp/org/org-macro.el @@ -0,0 +1,193 @@ +;;; org-macro.el --- Macro Replacement Code for Org Mode + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: + +;; Macros are expanded with `org-macro-replace-all', which relies +;; internally on `org-macro-expand'. + +;; Default templates for expansion are stored in the buffer-local +;; variable `org-macro-templates'. This variable is updated by +;; `org-macro-initialize-templates', which recursively calls +;; `org-macro--collect-macros' in order to read setup files. + +;; Along with macros defined through #+MACRO: keyword, default +;; templates include the following hard-coded macros: +;; {{{time(format-string)}}}, {{{property(node-property)}}}, +;; {{{input-file}}} and {{{modification-time(format-string)}}}. + +;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, +;; {{{email}}} and {{{title}}} macros. + +;;; Code: +(require 'org-macs) + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-remove-double-quotes "org" (s)) +(declare-function org-mode "org" ()) +(declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-with-wide-buffer "org-macs" (&rest body)) + +;;; Variables + +(defvar org-macro-templates nil + "Alist containing all macro templates in current buffer. +Associations are in the shape of (NAME . TEMPLATE) where NAME +stands for macro's name and template for its replacement value, +both as strings. This is an internal variable. Do not set it +directly, use instead: + + #+MACRO: name template") +(make-variable-buffer-local 'org-macro-templates) + + +;;; Functions + +(defun org-macro--collect-macros () + "Collect macro definitions in current buffer and setup files. +Return an alist containing all macro templates found." + (let* (collect-macros ; For byte-compiler. + (collect-macros + (lambda (files templates) + ;; Return an alist of macro templates. FILES is a list of + ;; setup files names read so far, used to avoid circular + ;; dependencies. TEMPLATES is the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "MACRO") + ;; Install macro in TEMPLATES. + (when (string-match + "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (funcall collect-macros (cons file files) + templates))))))))))) + templates)))) + (funcall collect-macros nil nil))) + +(defun org-macro-initialize-templates () + "Collect macro templates defined in current buffer. +Templates are stored in buffer-local variable +`org-macro-templates'. In addition to buffer-defined macros, the +function installs the following ones: \"property\", +\"time\". and, if the buffer is associated to a file, +\"input-file\" and \"modification-time\"." + (let* ((templates (org-macro--collect-macros)) + (update-templates + (lambda (cell) + (let ((old-template (assoc (car cell) templates))) + (if old-template (setcdr old-template (cdr cell)) + (push cell templates)))))) + ;; Install hard-coded macros. + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") + (cons "time" "(eval (format-time-string \"$1\"))"))) + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (when (and visited-file (file-exists-p visited-file)) + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "input-file" (file-name-nondirectory visited-file)) + (cons "modification-time" + (format "(eval (format-time-string \"$1\" '%s))" + (prin1-to-string + (nth 5 (file-attributes visited-file))))))))) + (setq org-macro-templates templates))) + +(defun org-macro-expand (macro templates) + "Return expanded MACRO, as a string. +MACRO is an object, obtained, for example, with +`org-element-context'. TEMPLATES is an alist of templates used +for expansion. See `org-macro-templates' for a buffer-local +default value. Return nil if no template was found." + (let ((template + ;; Macro names are case-insensitive. + (cdr (assoc-string (org-element-property :key macro) templates t)))) + (when template + (let ((value (replace-regexp-in-string + "\\$[0-9]+" + (lambda (arg) + (or (nth (1- (string-to-number (substring arg 1))) + (org-element-property :args macro)) + ;; No argument: remove place-holder. + "")) + template nil 'literal))) + ;; VALUE starts with "(eval": it is a s-exp, `eval' it. + (when (string-match "\\`(eval\\>" value) + (setq value (eval (read value)))) + ;; Return string. + (format "%s" (or value "")))))) + +(defun org-macro-replace-all (templates) + "Replace all macros in current buffer by their expansion. +TEMPLATES is an alist of templates used for expansion. See +`org-macro-templates' for a buffer-local default value." + (save-excursion + (goto-char (point-min)) + (let (record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'macro) + (let* ((value (org-macro-expand object templates)) + (begin (org-element-property :begin object)) + (signature (list begin + object + (org-element-property :args object)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the same + ;; position twice. + (if (member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key object)) + (when value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end object)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of recursive + ;; expansions. + (save-excursion (insert value))))))))))) + + +(provide 'org-macro) +;;; org-macro.el ends here diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 57b2d8a577e..ddd6e2e90f5 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1,6 +1,6 @@ ;;; org-macs.el --- Top-level definitions for Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -33,7 +33,9 @@ (eval-and-compile (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly))) + (defmacro declare-function (fn file &optional arglist fileonly) + `(autoload ',fn ,file))) + (if (>= emacs-major-version 23) (defsubst org-char-to-string(c) "Defsubst to decode UTF-8 character values in emacs 23 and beyond." @@ -63,14 +65,6 @@ `(interactive-p)))) (def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) -(when (and (not (fboundp 'with-silent-modifications)) - (or (< emacs-major-version 23) - (and (= emacs-major-version 23) - (< emacs-minor-version 2)))) - (defmacro with-silent-modifications (&rest body) - `(org-unmodified ,@body)) - (def-edebug-spec with-silent-modifications (body))) - (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) @@ -87,16 +81,6 @@ Otherwise return nil." (and v (not (equal v "nil")) v)) -(defmacro org-unmodified (&rest body) - "Execute body without changing `buffer-modified-p'. -Also, do not record undo information." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) - (let ((buffer-undo-list t) - (inhibit-modification-hooks t)) - ,@body)))) -(def-edebug-spec org-unmodified (body)) - (defun org-substitute-posix-classes (re) "Substitute posix classes in regular expression RE." (let ((ss re)) @@ -126,14 +110,18 @@ Also, do not record undo information." (org-move-to-column ,col))))) (def-edebug-spec org-preserve-lc (body)) -;; Copied from bookmark.el -(defmacro org-with-buffer-modified-unmodified (&rest body) +;; Use `org-with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications +(defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (org-with-gensyms (was-modified) `(let ((,was-modified (buffer-modified-p))) (unwind-protect - (progn ,@body) - (set-buffer-modified-p ,was-modified))))) + (let ((buffer-undo-list t) + (inhibit-modification-hooks t)) + ,@body) + (set-buffer-modified-p ,was-modified))))) +(def-edebug-spec org-unmodified (body)) (defmacro org-without-partial-completion (&rest body) `(if (and (boundp 'partial-completion-mode) @@ -176,46 +164,17 @@ We use a macro so that the test can happen at compilation time." (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) (def-edebug-spec org-no-warnings (body)) -(defmacro org-if-unprotected (&rest body) - "Execute BODY if there is no `org-protected' text property at point." - `(unless (get-text-property (point) 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected (body)) - -(defmacro org-if-unprotected-1 (&rest body) - "Execute BODY if there is no `org-protected' text property at point-1." - `(unless (get-text-property (1- (point)) 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected-1 (body)) - -(defmacro org-if-unprotected-at (pos &rest body) - "Execute BODY if there is no `org-protected' text property at POS." - `(unless (get-text-property ,pos 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected-at (form body)) -(put 'org-if-unprotected-at 'lisp-indent-function 1) - -(defun org-re-search-forward-unprotected (&rest args) - "Like re-search-forward, but stop only in unprotected places." - (catch 'exit - (while t - (unless (apply 're-search-forward args) - (throw 'exit nil)) - (unless (get-text-property (match-beginning 0) 'org-protected) - (throw 'exit (point)))))) - -;; FIXME: Normalize argument names -(defmacro org-with-remote-undo (_buffer &rest _body) +(defmacro org-with-remote-undo (buffer &rest body) "Execute BODY while recording undo information in two buffers." (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) `(let ((,cline (org-current-line)) (,cmd this-command) (,buf1 (current-buffer)) - (,buf2 ,_buffer) + (,buf2 ,buffer) (,undo1 buffer-undo-list) - (,undo2 (with-current-buffer ,_buffer buffer-undo-list)) + (,undo2 (with-current-buffer ,buffer buffer-undo-list)) ,c1 ,c2) - ,@_body + ,@body (when org-agenda-allow-remote-undo (setq ,c1 (org-verify-change-for-undo ,undo1 (with-current-buffer ,buf1 buffer-undo-list)) @@ -324,14 +283,6 @@ we turn off invisibility temporarily. Use this in a `let' form." (<= (match-beginning n) pos) (>= (match-end n) pos))) -(defun org-autoload (file functions) - "Establish autoload for all FUNCTIONS in FILE, if not bound already." - (let ((d (format "Documentation will be available after `%s.el' is loaded." - file)) - f) - (while (setq f (pop functions)) - (or (fboundp f) (autoload f file d t))))) - (defun org-match-line (re) "Looking-at at the beginning of the current line." (save-excursion @@ -427,6 +378,13 @@ the value in cdr." (cons (list (car flat) (cadr flat)) (org-make-parameter-alist (cddr flat))))) +;;;###autoload +(defmacro org-load-noerror-mustsuffix (file) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." + (if (featurep 'xemacs) + `(load ,file 'noerror) + `(load ,file 'noerror nil nil 'mustsuffix))) + (provide 'org-macs) ;;; org-macs.el ends here diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el deleted file mode 100644 index 820988bdbb4..00000000000 --- a/lisp/org/org-mew.el +++ /dev/null @@ -1,136 +0,0 @@ -;;; org-mew.el --- Support for links to Mew messages from within Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: Tokuya Kameshima -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements links to Mew messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -(defgroup org-mew nil - "Options concerning the Mew link." - :tag "Org Startup" - :group 'org-link) - -(defcustom org-mew-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-mew - :type 'boolean) - -;; Declare external functions and variables -(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit)) -(declare-function mew-case-folder "ext:mew-func" (case folder)) -(declare-function mew-header-get-value "ext:mew-header" - (field &optional as-list)) -(declare-function mew-init "ext:mew" ()) -(declare-function mew-refile-get "ext:mew-refile" (msg)) -(declare-function mew-sinfo-get-case "ext:mew-summary" ()) -(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay)) -(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext)) -(declare-function mew-summary-get-mark "ext:mew-mark" ()) -(declare-function mew-summary-message-number2 "ext:mew-syntax" ()) -(declare-function mew-summary-pick-with-mewl "ext:mew-pick" - (pattern folder src-msgs)) -(declare-function mew-summary-search-msg "ext:mew-const" (msg)) -(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg)) -(declare-function mew-summary-visit-folder "ext:mew-summary4" - (folder &optional goend no-ls)) -(declare-function mew-window-push "ext:mew" ()) -(defvar mew-init-p) -(defvar mew-summary-goto-line-then-display) - -;; Install the link type -(org-add-link-type "mew" 'org-mew-open) -(add-hook 'org-store-link-functions 'org-mew-store-link) - -;; Implementation -(defun org-mew-store-link () - "Store a link to a Mew folder or message." - (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) - (let* ((msgnum (mew-summary-message-number2)) - (mark-info (mew-summary-get-mark)) - (folder-name - (if (and org-mew-link-to-refile-destination - (eq mark-info ?o)) ; marked as refile - (mew-case-folder (mew-sinfo-get-case) - (nth 1 (mew-refile-get msgnum))) - (mew-summary-folder-name))) - message-id from to subject desc link date date-ts date-ts-ia) - (save-window-excursion - (if (fboundp 'mew-summary-set-message-buffer) - (mew-summary-set-message-buffer folder-name msgnum) - (set-buffer (mew-cache-hit folder-name msgnum t))) - (setq message-id (mew-header-get-value "Message-Id:")) - (setq from (mew-header-get-value "From:")) - (setq to (mew-header-get-value "To:")) - (setq date (mew-header-get-value "Date:")) - (setq date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (setq date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - (setq subject (mew-header-get-value "Subject:"))) - (org-store-link-props :type "mew" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (concat "mew:" folder-name "#" message-id)) - (org-add-link-props :link link :description desc) - link))) - -(defun org-mew-open (path) - "Follow the Mew message link specified by PATH." - (let (folder msgnum) - (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's - (setq folder (match-string 1 path)) - (setq msgnum (match-string 2 path))) - ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path) - (setq folder (match-string 1 path)) - (setq msgnum (match-string 4 path))) - (t (error "Error in Mew link"))) - (require 'mew) - (mew-window-push) - (unless mew-init-p (mew-init)) - (mew-summary-visit-folder folder) - (when msgnum - (if (not (string-match "\\`[0-9]+\\'" msgnum)) - (let* ((pattern (concat "message-id=" msgnum)) - (msgs (mew-summary-pick-with-mewl pattern folder nil))) - (setq msgnum (car msgs)))) - (if (mew-summary-search-msg msgnum) - (if mew-summary-goto-line-then-display - (mew-summary-display)) - (error "Message not found"))))) - -(provide 'org-mew) - -;;; org-mew.el ends here diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 48767b7b797..bdd6e150bd9 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -1,6 +1,6 @@ ;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Thomas Baumann ;; Keywords: outlines, hypermedia, calendar, wp @@ -30,6 +30,7 @@ ;;; Code: +(require 'org-macs) (require 'org) ;; Customization variables diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el deleted file mode 100644 index c614799db82..00000000000 --- a/lisp/org/org-mks.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; org-mks.el --- Multi-key-selection for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;; Commentary: -;; - -;;; Code: - -(require 'org) -(eval-when-compile - (require 'cl)) - -(defun org-mks (table title &optional prompt specials) - "Select a member of an alist with multiple keys. -TABLE is the alist which should contain entries where the car is a string. -There should be two types of entries. - -1. prefix descriptions like (\"a\" \"Description\") - This indicates that `a' is a prefix key for multi-letter selection, and - that there are entries following with keys like \"ab\", \"ax\"... - -2. Selectable members must have more than two elements, with the first - being the string of keys that lead to selecting it, and the second a - short description string of the item. - -The command will then make a temporary buffer listing all entries -that can be selected with a single key, and all the single key -prefixes. When you press the key for a single-letter entry, it is selected. -When you press a prefix key, the commands (and maybe further prefixes) -under this key will be shown and offered for selection. - -TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (while (and tbl (string-match re (caar tbl))) (pop tbl))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) - -(provide 'org-mks) - -;;; org-mks.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 293d2a000c0..f5a4ae90378 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -1,5 +1,5 @@ ;;; org-mobile.el --- Code for asymmetric sync with a mobile device -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -76,6 +76,13 @@ org-agenda-text-search-extra-files :group 'org-mobile :type 'directory) +(defcustom org-mobile-allpriorities "A B C" + "Default set of priority cookies for the index file." + :version "24.4" + :package-version '(Org . "8.0") + :type 'string + :group 'org-mobile) + (defcustom org-mobile-use-encryption nil "Non-nil means keep only encrypted files on the WebDAV server. Encryption uses AES-256, with a password given in @@ -276,7 +283,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (list f)) (t nil))) org-mobile-files))) - (files (delete + (files (delq nil (mapcar (lambda (f) (unless (and (not (string= org-mobile-files-exclude-regexp "")) @@ -300,8 +307,6 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (push (cons file link-name) rtn))) (nreverse rtn))) -(defvar org-agenda-filter) - ;;;###autoload (defun org-mobile-push () "Push the current state of Org affairs to the target directory. @@ -314,23 +319,24 @@ create all custom agenda views, for upload to the mobile phone." (org-agenda-tag-filter org-agenda-tag-filter) (org-agenda-redo-command org-agenda-redo-command)) (save-excursion - (save-window-excursion - (run-hooks 'org-mobile-pre-push-hook) - (org-mobile-check-setup) - (org-mobile-prepare-file-lists) - (message "Creating agendas...") - (let ((inhibit-redisplay t) - (org-agenda-files (mapcar 'car org-mobile-files-alist))) - (org-mobile-create-sumo-agenda)) - (message "Creating agendas...done") - (org-save-all-org-buffers) ; to save any IDs created by this process - (message "Copying files...") - (org-mobile-copy-agenda-files) - (message "Writing index file...") - (org-mobile-create-index-file) - (message "Writing checksums...") - (org-mobile-write-checksums) - (run-hooks 'org-mobile-post-push-hook))) + (save-restriction + (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-check-setup) + (org-mobile-prepare-file-lists) + (message "Creating agendas...") + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) + (message "Creating agendas...done") + (org-save-all-org-buffers) ; to save any IDs created by this process + (message "Copying files...") + (org-mobile-copy-agenda-files) + (message "Writing index file...") + (org-mobile-create-index-file) + (message "Writing checksums...") + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook)))) (setq org-agenda-buffer-name org-agenda-curbuf-name org-agenda-this-buffer-name org-agenda-curbuf-name)) (redraw-display) @@ -463,7 +469,7 @@ agenda view showing the flagged items." (setq tags (append def-tags tags nil)) (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") - (insert "#+ALLPRIORITIES: A B C" "\n") + (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") (when (file-exists-p (expand-file-name org-mobile-directory "agendas.org")) (insert "* [[file:agendas.org][Agenda Views]]\n")) @@ -1061,10 +1067,13 @@ be returned that indicates what went wrong." (t (error "Heading changed in MobileOrg and on the computer"))))) ((eq what 'addheading) - (if (org-on-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn + ;; Workaround a `org-insert-heading-respect-content' bug + ;; which prevents correct insertion when point is invisible + (org-show-subtree) (end-of-line 1) - (org-insert-heading-respect-content t) + (org-insert-heading-respect-content '(16) t) (org-demote)) (beginning-of-line) (insert "* ")) @@ -1073,7 +1082,7 @@ be returned that indicates what went wrong." ((eq what 'refile) (org-copy-subtree) (org-with-point-at (org-mobile-locate-entry new) - (if (org-on-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn (setq level (org-get-valid-level (funcall outline-level) 1)) (org-end-of-subtree t t) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index fac43e4bc49..27dc0e070fc 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -1,6 +1,6 @@ ;;; org-mouse.el --- Better mouse support for org-mode -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Piotr Zielinski ;; Maintainer: Carsten Dominik @@ -656,11 +656,11 @@ This means, between the beginning of line and the point." ["All Clear" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[ ]"))))] + (replace-match "[ ] "))))] ["All Set" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[X]"))))] + (replace-match "[X] "))))] ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] ["All Remove" (org-mouse-for-each-item (lambda () @@ -1056,7 +1056,7 @@ This means, between the beginning of line and the point." ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] "--" - ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) + ["Create iCalendar file" org-icalendar-combine-agenda-files t]) "--" ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el deleted file mode 100644 index 92228f37eb8..00000000000 --- a/lisp/org/org-odt.el +++ /dev/null @@ -1,2859 +0,0 @@ -;;; org-odt.el --- OpenDocument Text exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-lparse) - -(defgroup org-export-odt nil - "Options specific for ODT export of Org-mode files." - :tag "Org Export ODT" - :group 'org-export - :version "24.1") - -(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse -(defun org-odt-insert-toc () - (goto-char (point-min)) - (cond - ((re-search-forward - "\\(]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(\\)?" - nil t) - (replace-match "")) - (t - (goto-char org-lparse-dyn-first-heading-pos))) - (insert (org-odt-format-toc))) - -(defun org-odt-end-export () - (org-odt-insert-toc) - (org-odt-fixup-label-references) - - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward - "[ \r\n\t]*" - nil t) - (replace-match "")) - (goto-char (point-min)) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "%s" - (make-string n ?x))))) - - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t))) - -(defvar org-odt-suppress-xref nil) -(defconst org-export-odt-special-string-regexps - '(("\\\\-" . "­\\1") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-odt-lib-dir (file-name-directory load-file-name) - "Location of ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defvar org-odt-data-dir nil - "Data directory for ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defconst org-odt-schema-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./schema/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir)))) - "List of directories to search for OpenDocument schema files. -Use this list to set the default value of -`org-export-odt-schema-dir'. The entries in this list are -populated heuristically based on the values of `org-odt-lib-dir' -and `org-odt-data-dir'.") - -(defcustom org-export-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (org-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (org-odt): Trying %s..." schema-dir) - (when (and (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (org-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-odt-schema-dir-list) - (message "Debug (org-odt): No OpenDocument schema files installed") - nil))) - schema-dir) - "Directory that contains OpenDocument schema files. - -This directory contains: -1. rnc files for OpenDocument schema -2. a \"schemas.xml\" file that specifies locating rules needed - for auto validation of OpenDocument XML files. - -Use the customize interface to set this variable. This ensures -that `rng-schema-locating-files' is updated and auto-validation -of OpenDocument XML takes place based on the value -`rng-nxml-auto-validate-flag'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-schema-dir-list'. The OASIS schema files are available -only in the org's private git repository. It is *not* bundled -with GNU ELPA tar or standard Emacs distribution." - :type '(choice - (const :tag "Not set" nil) - (directory :tag "Schema directory")) - :group 'org-export-odt - :version "24.1" - :set - (lambda (var value) - "Set `org-export-odt-schema-dir'. -Also add it to `rng-schema-locating-files'." - (let ((schema-dir value)) - (set var - (if (and - (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - schema-dir - (when value - (message "Error (org-odt): %s has no OpenDocument schema files" - value)) - nil))) - (when org-export-odt-schema-dir - (eval-after-load 'rng-loc - '(add-to-list 'rng-schema-locating-files - (expand-file-name "schemas.xml" - org-export-odt-schema-dir)))))) - -(defconst org-odt-styles-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./styles/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./styles/" org-odt-data-dir))) - (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git - (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa - (expand-file-name "./org/" data-directory) ; system - ) - "List of directories to search for OpenDocument styles files. -See `org-odt-styles-dir'. The entries in this list are populated -heuristically based on the values of `org-odt-lib-dir' and -`org-odt-data-dir'.") - -(defconst org-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (org-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (org-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (org-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-odt-styles-dir-list) - nil))) - (unless styles-dir - (error "Error (org-odt): Cannot find factory styles files, aborting")) - styles-dir) - "Directory that holds auxiliary XML files used by the ODT exporter. - -This directory contains the following XML files - - \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These - XML files are used as the default values of - `org-export-odt-styles-file' and - `org-export-odt-content-template-file'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or -standard Emacs.") - -(defvar org-odt-file-extensions - '(("odt" . "OpenDocument Text") - ("ott" . "OpenDocument Text Template") - ("odm" . "OpenDocument Master Document") - ("ods" . "OpenDocument Spreadsheet") - ("ots" . "OpenDocument Spreadsheet Template") - ("odg" . "OpenDocument Drawing (Graphics)") - ("otg" . "OpenDocument Drawing Template") - ("odp" . "OpenDocument Presentation") - ("otp" . "OpenDocument Presentation Template") - ("odi" . "OpenDocument Image") - ("odf" . "OpenDocument Formula") - ("odc" . "OpenDocument Chart"))) - -(mapc - (lambda (desc) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-odt-file-extensions) - -;; register the odt exporter with the pre-processor -(add-to-list 'org-export-backends 'odt) - -;; register the odt exporter with org-lparse library -(org-lparse-register-backend 'odt) - -(defun org-odt-unload-function () - (org-lparse-unregister-backend 'odt) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - nil) - -(defcustom org-export-odt-content-template-file nil - "Template file for \"content.xml\". -The exporter embeds the exported content just before -\"\" element. - -If unspecified, the file named \"OrgOdtContentTemplate.xml\" -under `org-odt-styles-dir' is used." - :type 'file - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-styles-file nil - "Default styles file for use with ODT export. -Valid values are one of: -1. nil -2. path to a styles.xml file -3. path to a *.odt or a *.ott file -4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 -...)) - -In case of option 1, an in-built styles.xml is used. See -`org-odt-styles-dir' for more information. - -In case of option 3, the specified file is unzipped and the -styles.xml embedded therein is used. - -In case of option 4, the specified ODT-OR-OTT-FILE is unzipped -and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the -generated odt file. Use relative path for specifying the -FILE-MEMBERS. styles.xml must be specified as one of the -FILE-MEMBERS. - -Use options 1, 2 or 3 only if styles.xml alone suffices for -achieving the desired formatting. Use option 4, if the styles.xml -references additional files like header and footer images for -achieving the desired formatting. - -Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on -a per-file basis. For example, - -#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or -#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "Factory settings" nil) - (file :must-match t :tag "styles.xml") - (file :must-match t :tag "ODT or OTT file") - (list :tag "ODT or OTT file + Members" - (file :must-match t :tag "ODF Text or Text Template file") - (cons :tag "Members" - (file :tag " Member" "styles.xml") - (repeat (file :tag "Member")))))) - -(eval-after-load 'org-exp - '(add-to-list 'org-export-inbuffer-options-extra - '("ODT_STYLES_FILE" :odt-styles-file))) - -(defconst org-export-odt-tmpdir-prefix "%s-") -(defconst org-export-odt-bookmark-prefix "OrgXref.") -(defvar org-odt-zip-dir nil - "Temporary directory that holds XML files during export.") - -(defvar org-export-odt-embed-images t - "Should the images be copied in to the odt file or just linked?") - -(defvar org-export-odt-inline-images 'maybe) -(defcustom org-export-odt-inline-image-extensions - '("png" "jpeg" "jpg" "gif") - "Extensions of image files that can be inlined into HTML." - :type '(repeat (string :tag "Extension")) - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch - "Scaling factor for converting images pixels to inches. -Use this for sizing of embedded images. See Info node `(org) -Images in ODT export' for more information." - :type 'float - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-create-custom-styles-for-srcblocks t - "Whether custom styles for colorized source blocks be automatically created. -When this option is turned on, the exporter creates custom styles -for source blocks based on the advice of `htmlfontify'. Creation -of custom styles happen as part of `org-odt-hfy-face-to-css'. - -When this option is turned off exporter does not create such -styles. - -Use the latter option if you do not want the custom styles to be -based on your current display settings. It is necessary that the -styles.xml already contains needed styles for colorizing to work. - -This variable is effective only if -`org-export-odt-fontify-srcblocks' is turned on." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar org-export-odt-default-org-styles-alist - '((paragraph . ((default . "Text_20_body") - (fixedwidth . "OrgFixedWidthBlock") - (verse . "OrgVerse") - (quote . "Quotations") - (blockquote . "Quotations") - (center . "OrgCenter") - (left . "OrgLeft") - (right . "OrgRight") - (title . "OrgTitle") - (subtitle . "OrgSubtitle") - (footnote . "Footnote") - (src . "OrgSrcBlock") - (illustration . "Illustration") - (table . "Table") - (definition-term . "Text_20_body_20_bold") - (horizontal-line . "Horizontal_20_Line"))) - (character . ((default . "Default") - (bold . "Bold") - (emphasis . "Emphasis") - (code . "OrgCode") - (verbatim . "OrgCode") - (strike . "Strikethrough") - (underline . "Underline") - (subscript . "OrgSubscript") - (superscript . "OrgSuperscript"))) - (list . ((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (description . "OrgDescriptionList")))) - "Default styles for various entities.") - -(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist) -(defun org-odt-get-style-name-for-entity (category &optional entity) - (let ((entity (or entity 'default))) - (or - (cdr (assoc entity (cdr (assoc category - org-export-odt-org-styles-alist)))) - (cdr (assoc entity (cdr (assoc category - org-export-odt-default-org-styles-alist)))) - (error "Cannot determine style name for entity %s of type %s" - entity category)))) - -(defcustom org-export-odt-preferred-output-format nil - "Automatically post-process to this format after exporting to \"odt\". -Interactive commands `org-export-as-odt' and -`org-export-as-odt-and-open' export first to \"odt\" format and -then use `org-export-odt-convert-process' to convert the -resulting document to this format. During customization of this -variable, the list of valid values are populated based on -`org-export-odt-convert-capabilities'. - -You can set this option on per-file basis using file local -values. See Info node `(emacs) File Variables'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,c ,c)) - (org-lparse-reachable-formats "odt"))))) -;;;###autoload -(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) - -(defmacro org-odt-cleanup-xml-buffers (&rest body) - `(let ((org-odt-zip-dir - (make-temp-file - (format org-export-odt-tmpdir-prefix "odf") t)) - (--cleanup-xml-buffers - (function - (lambda nil - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml"))) - ;; kill all xml buffers - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect - (expand-file-name file org-odt-zip-dir) t) - (set-buffer-modified-p nil) - (kill-buffer))) - xml-files)) - ;; delete temporary directory. - (org-delete-directory org-odt-zip-dir t))))) - (condition-case err - (prog1 (progn ,@body) - (funcall --cleanup-xml-buffers)) - ((quit error) - (funcall --cleanup-xml-buffers) - (message "OpenDocument export failed: %s" - (error-message-string err)))))) - -;;;###autoload -(defun org-export-as-odt-and-open (arg) - "Export the outline as ODT and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse-and-open - (or org-export-odt-preferred-output-format "odt") "odt" arg))) - -;;;###autoload -(defun org-export-as-odt-batch () - "Call the function `org-lparse-batch'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-odt-batch" - (org-odt-cleanup-xml-buffers (org-lparse-batch "odt"))) - -;;; org-export-as-odt -;;;###autoload -(defun org-export-as-odt (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline as a OpenDocumentText file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. HIDDEN is obsolete and does nothing. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting XML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -..., without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse (or org-export-odt-preferred-output-format "odt") - "odt" arg hidden ext-plist to-buffer body-only pub-dir))) - -(defvar org-odt-entity-control-callbacks-alist - `((EXPORT - . (org-odt-begin-export org-odt-end-export)) - (DOCUMENT-CONTENT - . (org-odt-begin-document-content org-odt-end-document-content)) - (DOCUMENT-BODY - . (org-odt-begin-document-body org-odt-end-document-body)) - (TOC - . (org-odt-begin-toc org-odt-end-toc)) - (ENVIRONMENT - . (org-odt-begin-environment org-odt-end-environment)) - (FOOTNOTE-DEFINITION - . (org-odt-begin-footnote-definition org-odt-end-footnote-definition)) - (TABLE - . (org-odt-begin-table org-odt-end-table)) - (TABLE-ROWGROUP - . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup)) - (LIST - . (org-odt-begin-list org-odt-end-list)) - (LIST-ITEM - . (org-odt-begin-list-item org-odt-end-list-item)) - (OUTLINE - . (org-odt-begin-outline org-odt-end-outline)) - (OUTLINE-TEXT - . (org-odt-begin-outline-text org-odt-end-outline-text)) - (PARAGRAPH - . (org-odt-begin-paragraph org-odt-end-paragraph))) - "") - -(defvar org-odt-entity-format-callbacks-alist - `((EXTRA-TARGETS . org-lparse-format-extra-targets) - (ORG-TAGS . org-lparse-format-org-tags) - (SECTION-NUMBER . org-lparse-format-section-number) - (HEADLINE . org-odt-format-headline) - (TOC-ENTRY . org-odt-format-toc-entry) - (TOC-ITEM . org-odt-format-toc-item) - (TAGS . org-odt-format-tags) - (SPACES . org-odt-format-spaces) - (TABS . org-odt-format-tabs) - (LINE-BREAK . org-odt-format-line-break) - (FONTIFY . org-odt-format-fontify) - (TODO . org-lparse-format-todo) - (LINK . org-odt-format-link) - (INLINE-IMAGE . org-odt-format-inline-image) - (ORG-LINK . org-odt-format-org-link) - (HEADING . org-odt-format-heading) - (ANCHOR . org-odt-format-anchor) - (TABLE . org-lparse-format-table) - (TABLE-ROW . org-odt-format-table-row) - (TABLE-CELL . org-odt-format-table-cell) - (FOOTNOTES-SECTION . ignore) - (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference) - (HORIZONTAL-LINE . org-odt-format-horizontal-line) - (COMMENT . org-odt-format-comment) - (LINE . org-odt-format-line) - (ORG-ENTITY . org-odt-format-org-entity)) - "") - -;;;_. callbacks -;;;_. control callbacks -;;;_ , document body -(defun org-odt-begin-office-body () - ;; automatic styles - (insert-file-contents - (or org-export-odt-content-template-file - (expand-file-name "OrgOdtContentTemplate.xml" - org-odt-styles-dir))) - (goto-char (point-min)) - (re-search-forward "" nil nil) - (delete-region (match-beginning 0) (point-max))) - -;; Following variable is let bound when `org-do-lparse' is in -;; progress. See org-html.el. -(defvar org-lparse-toc) -(defun org-odt-format-toc () - (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n"))) - -(defun org-odt-format-preamble (opt-plist) - (let* ((title (plist-get opt-plist :title)) - (author (plist-get opt-plist :author)) - (date (plist-get opt-plist :date)) - (iso-date (org-odt-format-date date)) - (date (org-odt-format-date date "%d %b %Y")) - (email (plist-get opt-plist :email)) - ;; switch on or off above vars based on user settings - (author (and (plist-get opt-plist :author-info) (or author email))) - (email (and (plist-get opt-plist :email-info) email)) - (date (and (plist-get opt-plist :time-stamp-file) date))) - (concat - ;; title - (when title - (concat - (org-odt-format-stylized-paragraph - 'title (org-odt-format-tags - '("" . "") title)) - ;; separator - "")) - (cond - ((and author (not email)) - ;; author only - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("" . "") - author)) - ;; separator - "")) - ((and author email) - ;; author and email - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-link - (org-odt-format-tags - '("" . "") - author) (concat "mailto:" email))) - ;; separator - ""))) - ;; date - (when date - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("" - . "") date "N75" iso-date)) - ;; separator - ""))))) - -(defun org-odt-begin-document-body (opt-plist) - (org-odt-begin-office-body) - (insert (org-odt-format-preamble opt-plist)) - (setq org-lparse-dyn-first-heading-pos (point))) - -(defvar org-lparse-body-only) ; let bound during org-do-lparse -(defvar org-lparse-to-buffer) ; let bound during org-do-lparse -(defun org-odt-end-document-body (opt-plist) - (unless org-lparse-body-only - (org-lparse-insert-tag "") - (org-lparse-insert-tag ""))) - -(defun org-odt-begin-document-content (opt-plist) - (ignore)) - -(defun org-odt-end-document-content () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-outline (level1 snumber title tags - target extra-targets class) - (org-lparse-insert - 'HEADING (org-lparse-format - 'HEADLINE title extra-targets tags snumber level1) - level1 target)) - -(defun org-odt-end-outline () - (ignore)) - -(defun org-odt-begin-outline-text (level1 snumber class) - (ignore)) - -(defun org-odt-end-outline-text () - (ignore)) - -(defun org-odt-begin-section (style &optional name) - (let ((default-name (car (org-odt-add-automatic-style "Section")))) - (org-lparse-insert-tag - "" - style (or name default-name)))) - -(defun org-odt-end-section () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-paragraph (&optional style) - (org-lparse-insert-tag - "" (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defun org-odt-end-paragraph () - (org-lparse-insert-tag "")) - -(defun org-odt-get-extra-attrs-for-paragraph-style (style) - (let (style-name) - (setq style-name - (cond - ((stringp style) style) - ((symbolp style) (org-odt-get-style-name-for-entity - 'paragraph style)))) - (unless style-name - (error "Don't know how to handle paragraph style %s" style)) - (format " text:style-name=\"%s\"" style-name))) - -(defun org-odt-format-stylized-paragraph (style text) - (org-odt-format-tags - '("" . "") text - (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defvar org-lparse-opt-plist) ; bound during org-do-lparse -(defun org-odt-format-author (&optional author) - (when (setq author (or author (plist-get org-lparse-opt-plist :author))) - (org-odt-format-tags '("" . "") author))) - -(defun org-odt-format-date (&optional org-ts fmt) - (save-match-data - (let* ((time - (and (stringp org-ts) - (string-match org-ts-regexp0 org-ts) - (apply 'encode-time - (org-fix-decoded-time - (org-parse-time-string (match-string 0 org-ts) t))))) - date) - (cond - (fmt (format-time-string fmt time)) - (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time)) - (format "%s:%s" (substring date 0 -2) (substring date -2))))))) - -(defun org-odt-begin-annotation (&optional author date) - (org-lparse-insert-tag "") - (when (setq author (org-odt-format-author author)) - (insert author)) - (insert (org-odt-format-tags - '("" . "") - (org-odt-format-date - (or date (plist-get org-lparse-opt-plist :date))))) - (org-lparse-begin-paragraph)) - -(defun org-odt-end-annotation () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-environment (style env-options-plist) - (case style - (annotation - (org-lparse-stash-save-paragraph-state) - (org-odt-begin-annotation (plist-get env-options-plist 'author) - (plist-get env-options-plist 'date))) - ((blockquote verse center quote) - (org-lparse-begin-paragraph style) - (list)) - ((fixedwidth native) - (org-lparse-end-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defun org-odt-end-environment (style env-options-plist) - (case style - (annotation - (org-lparse-end-paragraph) - (org-odt-end-annotation) - (org-lparse-stash-pop-paragraph-state)) - ((blockquote verse center quote) - (org-lparse-end-paragraph) - (list)) - ((fixedwidth native) - (org-lparse-begin-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse -(defvar org-odt-list-stack-stashed) -(defun org-odt-begin-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype)) - (extra (concat (if (or org-lparse-list-table-p - (and (= 1 (length org-lparse-list-stack)) - (null org-odt-list-stack-stashed))) - " text:continue-numbering=\"false\"" - " text:continue-numbering=\"true\"") - (when style-name - (format " text:style-name=\"%s\"" style-name))))) - (case ltype - ((ordered unordered description) - (org-lparse-end-paragraph) - (org-lparse-insert-tag "" extra)) - (t (error "Unknown list type: %s" ltype))))) - -(defun org-odt-end-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (if ltype - (org-lparse-insert-tag "") - (error "Unknown list type: %s" ltype))) - -(defun org-odt-begin-list-item (ltype &optional arg headline) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - (ordered - (assert (not headline) t) - (let* ((counter arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "" "")) - (org-lparse-begin-paragraph))) - (unordered - (let* ((id arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "" "")) - (org-lparse-begin-paragraph) - (insert (if headline (org-odt-format-target headline id) - (org-odt-format-bookmark "" id))))) - (description - (assert (not headline) t) - (let ((term (or arg "(no term)"))) - (insert - (org-odt-format-tags - '("" . "") - (org-odt-format-stylized-paragraph 'definition-term term))) - (org-lparse-begin-list-item 'unordered) - (org-lparse-begin-list 'description) - (org-lparse-begin-list-item 'unordered))) - (t (error "Unknown list type")))) - -(defun org-odt-end-list-item (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - ((ordered unordered) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - (prog1 "" - (setq org-odt-list-stack-stashed nil)) - ""))) - (description - (org-lparse-end-list-item-1) - (org-lparse-end-list 'description) - (org-lparse-end-list-item-1)) - (t (error "Unknown list type")))) - -(defun org-odt-discontinue-list () - (let ((stashed-stack org-lparse-list-stack)) - (loop for list-type in stashed-stack - do (org-lparse-end-list-item-1 list-type) - (org-lparse-end-list list-type)) - (setq org-odt-list-stack-stashed stashed-stack))) - -(defun org-odt-continue-list () - (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed)) - (loop for list-type in org-odt-list-stack-stashed - do (org-lparse-begin-list list-type) - (org-lparse-begin-list-item list-type))) - -;; Following variables are let bound when table emission is in -;; progress. See org-lparse.el. -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-rowgrp-info) -(defvar org-lparse-table-colalign-vector) - -(defvar org-odt-table-style nil - "Table style specified by \"#+ATTR_ODT: \" line. -This is set during `org-odt-begin-table'.") - -(defvar org-odt-table-style-spec nil - "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.") - -(defcustom org-export-odt-table-styles - '(("OrgEquation" "OrgEquation" - ((use-first-column-styles . t) - (use-last-column-styles . t)))) - "Specify how Table Styles should be derived from a Table Template. -This is a list where each element is of the -form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). - -TABLE-STYLE-NAME is the style associated with the table through -`org-odt-table-style'. - -TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic -TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined -below) that is included in -`org-export-odt-content-template-file'. - -TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableCell\" -PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableParagraph\" -TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | - \"FirstRow\" | \"LastRow\" | - \"EvenRow\" | \"OddRow\" | - \"EvenColumn\" | \"OddColumn\" | \"\" -where \"+\" above denotes string concatenation. - -TABLE-CELL-OPTIONS is an alist where each element is of the -form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). -TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | - `use-last-row-styles' | - `use-first-column-styles' | - `use-last-column-styles' | - `use-banding-rows-styles' | - `use-banding-columns-styles' | - `use-first-row-styles' -ON-OR-OFF := `t' | `nil' - -For example, with the following configuration - -\(setq org-export-odt-table-styles - '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" - \(\(use-first-row-styles . t\) - \(use-first-column-styles . t\)\)\) - \(\"TableWithHeaderColumns\" \"Custom\" - \(\(use-first-column-styles . t\)\)\)\)\) - -1. A table associated with \"TableWithHeaderRowsAndColumns\" - style will use the following table-cell styles - - \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", - \"CustomTableCell\" and the following paragraph styles - \"CustomFirstRowTableParagraph\", - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate. - -2. A table associated with \"TableWithHeaderColumns\" style will - use the following table-cell styles - - \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the - following paragraph styles - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate.. - -Note that TABLE-TEMPLATE-NAME corresponds to the -\"\" elements contained within -\"\". The entries (TABLE-STYLE-NAME -TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to -\"table:template-name\" and \"table:use-first-row-styles\" etc -attributes of \"\" element. Refer ODF-1.2 -specification for more information. Also consult the -implementation filed under `org-odt-get-table-cell-styles'. - -The TABLE-STYLE-NAME \"OrgEquation\" is used internally for -formatting of numbered display equations. Do not delete this -style from the list." - :group 'org-export-odt - :version "24.1" - :type '(choice - (const :tag "None" nil) - (repeat :tag "Table Styles" - (list :tag "Table Style Specification" - (string :tag "Table Style Name") - (string :tag "Table Template Name") - (alist :options (use-first-row-styles - use-last-row-styles - use-first-column-styles - use-last-column-styles - use-banding-rows-styles - use-banding-columns-styles) - :key-type symbol - :value-type (const :tag "True" t)))))) - -(defvar org-odt-table-style-format - " - - - -" - "Template for auto-generated Table styles.") - -(defvar org-odt-automatic-styles '() - "Registry of automatic styles for various OBJECT-TYPEs. -The variable has the following form: -\(\(OBJECT-TYPE-A - \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) - \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) - \(OBJECT-TYPE-B - \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) - \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) - ...\). - -OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'. - -Use `org-odt-add-automatic-style' to add update this variable.'") - -(defvar org-odt-object-counters nil - "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See -`org-odt-add-automatic-style'.") - -(defun org-odt-write-automatic-styles () - "Write automatic styles to \"content.xml\"." - (with-current-buffer - (find-file-noselect (expand-file-name "content.xml") t) - ;; position the cursor - (goto-char (point-min)) - (re-search-forward " " nil t) - (goto-char (match-beginning 0)) - ;; write automatic table styles - (loop for (style-name props) in - (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) 96)) - (insert (format org-odt-table-style-format style-name props)))))) - -(defun org-odt-add-automatic-style (object-type &optional object-props) - "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option of the object in question to -`org-lparse-get-block-params'. - -Use `org-odt-object-counters' to generate an automatic -OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a -new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME -. STYLE-NAME)." - (assert (stringp object-type)) - (let* ((object (intern object-type)) - (seqvar object) - (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) - (object-name (format "%s%d" object-type seqno)) style-name) - (setq org-odt-object-counters - (plist-put org-odt-object-counters seqvar seqno)) - (when object-props - (setq style-name (format "Org%s" object-name)) - (setq org-odt-automatic-styles - (plist-put org-odt-automatic-styles object - (append (list (list style-name object-props)) - (plist-get org-odt-automatic-styles object))))) - (cons object-name style-name))) - -(defvar org-odt-table-indentedp nil) -(defun org-odt-begin-table (caption label attributes short-caption) - (setq org-odt-table-indentedp (not (null org-lparse-list-stack))) - (when org-odt-table-indentedp - ;; Within the Org file, the table is appearing within a list item. - ;; OpenDocument doesn't allow table to appear within list items. - ;; Temporarily terminate the list, emit the table and then - ;; re-continue the list. - (org-odt-discontinue-list) - ;; Put the Table in an indented section. - (let ((level (length org-odt-list-stack-stashed))) - (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level)))) - (setq attributes (org-lparse-get-block-params attributes)) - (setq org-odt-table-style (plist-get attributes :style)) - (setq org-odt-table-style-spec - (assoc org-odt-table-style org-export-odt-table-styles)) - (when (or label caption) - (insert - (org-odt-format-stylized-paragraph - 'table (org-odt-format-entity-caption label caption "__Table__")))) - (let ((automatic-name (org-odt-add-automatic-style "Table" attributes))) - (org-lparse-insert-tag - "" - (or short-caption (car automatic-name)) - (or (nth 1 org-odt-table-style-spec) - (cdr automatic-name) "OrgTable"))) - (setq org-lparse-table-begin-marker (point))) - -(defvar org-lparse-table-colalign-info) -(defun org-odt-end-table () - (goto-char org-lparse-table-begin-marker) - (loop for level from 0 below org-lparse-table-ncols - do (let* ((col-cookie (and org-lparse-table-is-styled - (cdr (assoc (1+ level) - org-lparse-table-colalign-info)))) - (extra-columns (or (nth 1 col-cookie) 0))) - (dotimes (i (1+ extra-columns)) - (insert - (org-odt-format-tags - "" - "" (or (nth 1 org-odt-table-style-spec) "OrgTable")))) - (insert "\n"))) - ;; fill style attributes for table cells - (when org-lparse-table-is-styled - (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t) - (let* ((spec (match-string 1)) - (r (string-to-number (match-string 2))) - (c (string-to-number (match-string 3))) - (cell-styles (org-odt-get-table-cell-styles - r c org-odt-table-style-spec)) - (table-cell-style (car cell-styles)) - (table-cell-paragraph-style (cdr cell-styles))) - (cond - ((equal spec "table-cell:p") - (replace-match table-cell-paragraph-style t t)) - ((equal spec "table-cell:style-name") - (replace-match table-cell-style t t)))))) - (goto-char (point-max)) - (org-lparse-insert-tag "") - (when org-odt-table-indentedp - (org-odt-end-section) - (org-odt-continue-list))) - -(defun org-odt-begin-table-rowgroup (&optional is-header-row) - (when org-lparse-table-rowgrp-open - (org-lparse-end 'TABLE-ROWGROUP)) - (org-lparse-insert-tag (if is-header-row - "" - "")) - (setq org-lparse-table-rowgrp-open t) - (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row)) - -(defun org-odt-end-table-rowgroup () - (when org-lparse-table-rowgrp-open - (setq org-lparse-table-rowgrp-open nil) - (org-lparse-insert-tag - (if org-lparse-table-cur-rowgrp-is-hdr - "" "")))) - -(defun org-odt-format-table-row (row) - (org-odt-format-tags - '("" . "") row)) - -(defun org-odt-get-table-cell-styles (r c &optional style-spec) - "Retrieve styles applicable to a table cell. -R and C are (zero-based) row and column numbers of the table -cell. STYLE-SPEC is an entry in `org-export-odt-table-styles' -applicable to the current table. It is `nil' if the table is not -associated with any style attributes. - -Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). - -When STYLE-SPEC is nil, style the table cell the conventional way -- choose cell borders based on row and column groupings and -choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-odt-get-paragraph-style-cookie-for-table-cell'. - -When STYLE-SPEC is non-nil, ignore the above cookie and return -styles congruent with the ODF-1.2 specification." - (cond - (style-spec - - ;; LibreOffice - particularly the Writer - honors neither table - ;; templates nor custom table-cell styles. Inorder to retain - ;; inter-operability with LibreOffice, only automatic styles are - ;; used for styling of table-cells. The current implementation is - ;; congruent with ODF-1.2 specification and hence is - ;; future-compatible. - - ;; Additional Note: LibreOffice's AutoFormat facility for tables - - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration - ;; by hand. - - (let* ((template-name (nth 1 style-spec)) - (cell-style-selectors (nth 2 style-spec)) - (cell-type - (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) - (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) - (= c (1- org-lparse-table-ncols))) "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) - (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) - (= r org-lparse-table-rownum)) - "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 0)) "OddColumn") - (t "")))) - (cons - (concat template-name cell-type "TableCell") - (concat template-name cell-type "TableParagraph")))) - (t - (cons - (concat - "OrgTblCell" - (cond - ((= r 0) "T") - ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T") - (t "")) - (when (= r org-lparse-table-rownum) "B") - (cond - ((= c 0) "") - ((or (memq (nth c org-table-colgroup-info) '(:start :startend)) - (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L") - (t ""))) - (capitalize (aref org-lparse-table-colalign-vector c)))))) - -(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c) - (concat - (and (not org-odt-table-style-spec) - (cond - (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading") - ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS)) - "OrgTableHeading") - (t "OrgTableContents"))) - (and org-lparse-table-is-styled - (format "@@table-cell:p@@%03d@@%03d@@" r c)))) - -(defun org-odt-get-style-name-cookie-for-table-cell (r c) - (when org-lparse-table-is-styled - (format "@@table-cell:style-name@@%03d@@%03d@@" r c))) - -(defun org-odt-format-table-cell (data r c horiz-span) - (concat - (let* ((paragraph-style-cookie - (org-odt-get-paragraph-style-cookie-for-table-cell r c)) - (style-name-cookie - (org-odt-get-style-name-cookie-for-table-cell r c)) - (extra (and style-name-cookie - (format " table:style-name=\"%s\"" style-name-cookie))) - (extra (concat extra - (and (> horiz-span 0) - (format " table:number-columns-spanned=\"%d\"" - (1+ horiz-span)))))) - (org-odt-format-tags - '("" . "") - (if org-lparse-list-table-p data - (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra)) - (let (s) - (dotimes (i horiz-span) - (setq s (concat s "\n"))) s) - "\n")) - -(defun org-odt-begin-footnote-definition (n) - (org-lparse-begin-paragraph 'footnote)) - -(defun org-odt-end-footnote-definition (n) - (org-lparse-end-paragraph)) - -(defun org-odt-begin-toc (lang-specific-heading max-level) - ;; Strings in `org-export-language-setup' can contain named html - ;; entities. Replace those with utf-8 equivalents. - (let ((i 0) entity rpl) - (while (string-match "&\\([^#].*?\\);" lang-specific-heading i) - (setq entity (match-string 1 lang-specific-heading)) - (if (not (setq rpl (org-entity-get-representation entity 'utf8))) - (setq i (match-end 0)) - (setq i (+ (match-beginning 0) (length rpl))) - (setq lang-specific-heading - (replace-match rpl t t lang-specific-heading))))) - (insert - (format " - - - %s -" max-level lang-specific-heading)) - (loop for level from 1 upto 10 - do (insert (format - " - - - - - - -" level level))) - - (insert - (format " - - - - - %s - -" lang-specific-heading))) - -(defun org-odt-end-toc () - (insert " - - -")) - -(defun org-odt-format-toc-entry (snumber todo headline tags href) - (setq headline (concat - (and org-export-with-section-numbers - (concat snumber ". ")) - headline - (and tags - (concat - (org-lparse-format 'SPACES 3) - (org-lparse-format 'FONTIFY tags "tag"))))) - (when todo - (setq headline (org-lparse-format 'FONTIFY headline "todo"))) - - (let ((org-odt-suppress-xref t)) - (org-odt-format-link headline (concat "#" href)))) - -(defun org-odt-format-toc-item (toc-entry level org-last-level) - (let ((style (format "Contents_20_%d" - (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)))) - (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n"))) - -;; Following variable is let bound during 'ORG-LINK callback. See -;; org-html.el -(defvar org-lparse-link-description-is-image nil) -(defun org-odt-format-link (desc href &optional attr) - (cond - ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref)) - (setq href (substring href 1)) - (let ((xref-format "text")) - (when (numberp desc) - (setq desc (format "%d" desc) xref-format "number")) - (when (listp desc) - (setq desc (mapconcat 'identity desc ".") xref-format "chapter")) - (setq href (concat org-export-odt-bookmark-prefix href)) - (org-odt-format-tags - '("" . - "") - desc xref-format href))) - (org-lparse-link-description-is-image - (org-odt-format-tags - '("" . "") - desc href (or attr ""))) - (t - (org-odt-format-tags - '("" . "") - desc href (or attr ""))))) - -(defun org-odt-format-spaces (n) - (cond - ((= n 1) " ") - ((> n 1) (concat - " " (org-odt-format-tags "" "" (1- n)))) - (t ""))) - -(defun org-odt-format-tabs (&optional n) - (let ((tab "") - (n (or n 1))) - (insert tab))) - -(defun org-odt-format-line-break () - (org-odt-format-tags "" "")) - -(defun org-odt-format-horizontal-line () - (org-odt-format-stylized-paragraph 'horizontal-line "")) - -(defun org-odt-encode-plain-text (line &optional no-whitespace-filling) - (setq line (org-xml-encode-plain-text line)) - (if no-whitespace-filling line - (org-odt-fill-tabs-and-spaces line))) - -(defun org-odt-format-line (line) - (case org-lparse-dyn-current-environment - (fixedwidth (concat - (org-odt-format-stylized-paragraph - 'fixedwidth (org-odt-encode-plain-text line)) "\n")) - (t (concat line "\n")))) - -(defun org-odt-format-comment (fmt &rest args) - (let ((comment (apply 'format fmt args))) - (format "\n\n" comment))) - -(defun org-odt-format-org-entity (wd) - (org-entity-get-representation wd 'utf8)) - -(defun org-odt-fill-tabs-and-spaces (line) - (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s) - (cond - ((string= s "\t") (org-odt-format-tabs)) - (t (org-odt-format-spaces (length s))))) line)) - -(defcustom org-export-odt-fontify-srcblocks t - "Specify whether or not source blocks need to be fontified. -Turn this option on if you want to colorize the source code -blocks in the exported file. For colorization to work, you need -to make available an enhanced version of `htmlfontify' library." - :type 'boolean - :group 'org-export-odt - :version "24.1") - -(defun org-odt-format-source-line-with-line-number-and-label - (line rpllbl num fontifier par-style) - - (let ((keep-label (not (numberp rpllbl))) - (ref (org-find-text-property-in-string 'org-coderef line))) - (setq line (concat line (and keep-label ref (format "(%s)" ref)))) - (setq line (funcall fontifier line)) - (when ref - (setq line (org-odt-format-target line (concat "coderef-" ref)))) - (setq line (org-odt-format-stylized-paragraph par-style line)) - (if (not num) line - (org-odt-format-tags '("" . "") line)))) - -(defun org-odt-format-source-code-or-example-plain - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks much like fixedwidth blocks. -Use this when `org-export-odt-fontify-srcblocks' option is turned -off." - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'org-odt-encode-plain-text - (if (= i line-count) "OrgFixedWidthBlockLastLine" - "OrgFixedWidthBlock"))) - lines "\n"))) - -(defvar org-src-block-paragraph-format - " - - - - - " - "Custom paragraph style for colorized source and example blocks. -This style is much the same as that of \"OrgFixedWidthBlock\" -except that the foreground and background colors are set -according to the default face identified by the `htmlfontify'.") - -(defvar hfy-optimisations) -(declare-function hfy-face-to-style "htmlfontify" (fn)) -(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) - -(defun org-odt-hfy-face-to-css (fn) - "Create custom style for face FN. -When FN is the default face, use it's foreground and background -properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name -is obtained from FN. Currently all attributes of FN other than -color are ignored. - -The style name for a face FN is derived using the following -operations on the face name in that order - de-dash, CamelCase -and prefix with \"OrgSrc\". For example, -`font-lock-function-name-face' is associated with -\"OrgSrcFontLockFunctionNameFace\"." - (let* ((css-list (hfy-face-to-style fn)) - (style-name ((lambda (fn) - (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) fn)) - (color-val (cdr (assoc "color" css-list))) - (background-color-val (cdr (assoc "background" css-list))) - (style (and org-export-odt-create-custom-styles-for-srcblocks - (cond - ((eq fn 'default) - (format org-src-block-paragraph-format - background-color-val color-val)) - (t - (format - " - - - " style-name color-val)))))) - (cons style-name style))) - -(defun org-odt-insert-custom-styles-for-srcblocks (styles) - "Save STYLES used for colorizing of source blocks. -Update styles.xml with styles that were collected as part of -`org-odt-hfy-face-to-css' callbacks." - (when styles - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - (goto-char (point-min)) - (when (re-search-forward "" nil t) - (goto-char (match-beginning 0)) - (insert "\n\n" styles "\n"))))) - -(defun org-odt-format-source-code-or-example-colored - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks using `htmlfontify-string'. -Use this routine when `org-export-odt-fontify-srcblocks' option -is turned on." - (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang))) - (mode (and lang-m (intern (concat (if (symbolp lang-m) - (symbol-name lang-m) - lang-m) "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil) - (lines (with-temp-buffer - (insert lines) - (if (functionp mode) (funcall mode) (fundamental-mode)) - (font-lock-fontify-buffer) - (buffer-string))) - (hfy-html-quote-regex "\\([<\"&> ]\\)") - (hfy-html-quote-map '(("\"" """) - ("<" "<") - ("&" "&") - (">" ">") - (" " "") - (" " ""))) - (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-sequence hfy-optimisations)) - (hfy-optimisations (add-to-list 'hfy-optimisations-1 - 'body-text-only)) - (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) - (insert (format "" style)))) - (hfy-end-span-handler (lambda nil (insert "")))) - (when (fboundp 'htmlfontify-string) - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'htmlfontify-string - (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock"))) - lines "\n"))))) - -(defun org-odt-format-source-code-or-example (lines lang caption textareap - cols rows num cont - rpllbl fmt) - "Format source or example blocks for export. -Use `org-odt-format-source-code-or-example-plain' or -`org-odt-format-source-code-or-example-colored' depending on the -value of `org-export-odt-fontify-srcblocks." - (setq lines (org-export-number-lines - lines 0 0 num cont rpllbl fmt 'preprocess) - lines (funcall - (or (and org-export-odt-fontify-srcblocks - (or (featurep 'htmlfontify) - ;; htmlfontify.el was introduced in Emacs 23.2 - ;; So load it with some caution - (require 'htmlfontify nil t)) - (fboundp 'htmlfontify-string) - 'org-odt-format-source-code-or-example-colored) - 'org-odt-format-source-code-or-example-plain) - lines lang caption textareap cols rows num cont rpllbl fmt)) - (if (not num) lines - (let ((extra (format " text:continue-numbering=\"%s\"" - (if cont "true" "false")))) - (org-odt-format-tags - '("" - . "") lines extra)))) - -(defun org-odt-remap-stylenames (style-name) - (or - (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper") - ("timestamp" . "OrgTimestamp") - ("timestamp-kwd" . "OrgTimestampKeyword") - ("tag" . "OrgTag") - ("todo" . "OrgTodo") - ("done" . "OrgDone") - ("target" . "OrgTarget")))) - style-name)) - -(defun org-odt-format-fontify (text style &optional id) - (let* ((style-name - (cond - ((stringp style) - (org-odt-remap-stylenames style)) - ((symbolp style) - (org-odt-get-style-name-for-entity 'character style)) - ((listp style) - (assert (< 1 (length style))) - (let ((parent-style (pop style))) - (mapconcat (lambda (s) - ;; (assert (stringp s) t) - (org-odt-remap-stylenames s)) style "") - (org-odt-remap-stylenames parent-style))) - (t (error "Don't how to handle style %s" style))))) - (org-odt-format-tags - '("" . "") - text style-name))) - -(defun org-odt-relocate-relative-path (path dir) - (if (file-name-absolute-p path) path - (file-relative-name (expand-file-name path dir) - (expand-file-name "eyecandy" dir)))) - -(defun org-odt-format-inline-image (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "" "" - (if org-export-odt-embed-images - (org-odt-copy-image-file thefile) thelink)))) - (org-export-odt-format-image thefile href))) - -(defvar org-odt-entity-labels-alist nil - "Associate Labels with the Labeled entities. -Each element of the alist is of the form (LABEL-NAME -CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as -that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the -type of the entity that LABEL-NAME is attached to. CATEGORY-NAME -can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is -the unique number assigned to the referenced entity on a -per-CATEGORY basis. It is generated sequentially and is 1-based. -LABEL-STYLE-NAME is a key `org-odt-label-styles'. - -See `org-odt-add-label-definition' and -`org-odt-fixup-label-references'.") - -(defun org-export-odt-format-formula (src href) - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string 'org-latex-src src)) - (embed-as (or (and latex-frag - (org-find-text-property-in-string - 'org-latex-src-embed-type src)) - (if (or caption label) 'paragraph 'character))) - width height) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (cond - ((eq embed-as 'character) - (org-odt-format-entity "InlineFormula" href width height)) - (t - (org-lparse-end-paragraph) - (org-lparse-insert-list-table - `((,(org-odt-format-entity - (if (not (or caption label)) "DisplayFormula" - "CaptionedDisplayFormula") - href width height :caption caption :label label - :short-caption short-caption) - ,(if (not (or caption label)) "" - (let* ((label-props (car org-odt-entity-labels-alist))) - (setcar (last label-props) "math-label") - (apply 'org-odt-format-label-definition - caption label-props))))) - nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1))) - (throw 'nextline nil)))))) - -(defvar org-odt-embedded-formulas-count 0) -(defun org-odt-copy-formula-file (path) - "Returns the internal name of the file" - (let* ((src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir (format "Formula-%04d/" - (incf org-odt-embedded-formulas-count))) - (target-file (concat target-dir "content.xml"))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (make-directory target-dir) - (org-odt-create-manifest-file-entry - "application/vnd.oasis.opendocument.formula" target-dir "1.2") - - (case (org-odt-is-formula-link-p src-file) - (mathml - (copy-file src-file target-file 'overwrite)) - (odf - (org-odt-zip-extract-one src-file "content.xml" target-dir)) - (t - (error "%s is not a formula file" src-file))) - - (org-odt-create-manifest-file-entry "text/xml" target-file)) - target-file)) - -(defun org-odt-format-inline-formula (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "" "" - (file-name-directory (org-odt-copy-formula-file thefile))))) - (org-export-odt-format-formula thefile href))) - -(defun org-odt-is-formula-link-p (file) - (let ((case-fold-search nil)) - (cond - ((string-match "\\.\\(mathml\\|mml\\)\\'" file) - 'mathml) - ((string-match "\\.odf\\'" file) - 'odf)))) - -(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr - descp) - "Make a OpenDocument link. -OPT-PLIST is an options list. -TYPE-1 is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the a element." - (declare (special org-lparse-par-open)) - (save-match-data - (let* ((may-inline-p - (and (member type-1 '("http" "https" "file")) - (org-lparse-should-inline-p path descp) - (not fragment))) - (type (if (equal type-1 "id") "file" type-1)) - (filename path) - (thefile path) - sec-frag sec-nos) - (cond - ;; check for inlined images - ((and (member type '("file")) - (not fragment) - (org-file-image-p - filename org-export-odt-inline-image-extensions) - (or (eq t org-export-odt-inline-images) - (and org-export-odt-inline-images (not descp)))) - (org-odt-format-inline-image thefile)) - ;; check for embedded formulas - ((and (member type '("file")) - (not fragment) - (org-odt-is-formula-link-p filename) - (or (not descp))) - (org-odt-format-inline-formula thefile)) - ;; code references - ((string= type "coderef") - (let* ((ref fragment) - (lineno-or-ref (cdr (assoc ref org-export-code-refs))) - (desc (and descp desc)) - (org-odt-suppress-xref nil) - (href (org-xml-format-href (concat "#coderef-" ref)))) - (cond - ((and (numberp lineno-or-ref) (not desc)) - (org-odt-format-link lineno-or-ref href)) - ((and (numberp lineno-or-ref) desc - (string-match (regexp-quote (concat "(" ref ")")) desc)) - (format (replace-match "%s" t t desc) - (org-odt-format-link lineno-or-ref href))) - (t - (setq desc (format - (if (and desc (string-match - (regexp-quote (concat "(" ref ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")) - lineno-or-ref)) - (org-odt-format-link (org-xml-format-desc desc) href))))) - ;; links to headlines - ((and (string= type "") - (or (not thefile) (string= thefile "")) - (plist-get org-lparse-opt-plist :section-numbers) - (get-text-property 0 'org-no-description fragment) - (setq sec-frag fragment) - (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag) - (and (setq sec-frag - (loop for alias in org-export-target-aliases do - (when (member fragment (cdr alias)) - (return (car alias))))) - (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag))) - (setq sec-nos (org-split-string (match-string 1 sec-frag) "-")) - (<= (length sec-nos) (plist-get org-lparse-opt-plist - :headline-levels))) - (let ((org-odt-suppress-xref nil)) - (org-odt-format-link sec-nos (concat "#" sec-frag) attr))) - (t - (when (string= type "file") - (setq thefile - (cond - ((file-name-absolute-p path) - (concat "file://" (expand-file-name path))) - (t (org-odt-relocate-relative-path - thefile org-current-export-file))))) - - (when (and (member type '("" "http" "https" "file")) fragment) - (setq thefile (concat thefile "#" fragment))) - - (setq thefile (org-xml-format-href thefile)) - - (when (not (member type '("" "file"))) - (setq thefile (concat type ":" thefile))) - - (let ((org-odt-suppress-xref - ;; Typeset link to headlines with description, as a - ;; regular hyperlink. - (and (string= type "") - (not (get-text-property 0 'org-no-description fragment))))) - (org-odt-format-link - (org-xml-format-desc desc) thefile attr))))))) - -(defun org-odt-format-heading (text level &optional id) - (let* ((text (if id (org-odt-format-target text id) text))) - (org-odt-format-tags - '("" . - "") text level level))) - -(defun org-odt-format-headline (title extra-targets tags - &optional snumber level) - (concat - (org-lparse-format 'EXTRA-TARGETS extra-targets) - - ;; No need to generate section numbers. They are auto-generated by - ;; the application - - ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ") - title - (and tags (concat (org-lparse-format 'SPACES 3) - (org-lparse-format 'ORG-TAGS tags))))) - -(defun org-odt-format-anchor (text name &optional class) - (org-odt-format-target text name)) - -(defun org-odt-format-bookmark (text id) - (if id - (org-odt-format-tags "" text id) - text)) - -(defun org-odt-format-target (text id) - (let ((name (concat org-export-odt-bookmark-prefix id))) - (concat - (and id (org-odt-format-tags - "" "" name)) - (org-odt-format-bookmark text id) - (and id (org-odt-format-tags - "" "" name))))) - -(defun org-odt-format-footnote (n def) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (org-odt-format-tags - '("" . - "") - (concat - (org-odt-format-tags - '("" . "") - n) - (org-odt-format-tags - '("" . "") - def)) - id note-class))) - -(defun org-odt-format-footnote-reference (n def refcnt) - (if (= refcnt 1) - (org-odt-format-footnote n def) - (org-odt-format-footnote-ref n))) - -(defun org-odt-format-footnote-ref (n) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (org-odt-format-tags - '("" . "") - (org-odt-format-tags - '("" . "") - n note-class ref-format ref-name) - "OrgSuperscript"))) - -(defun org-odt-get-image-name (file-name) - (require 'sha1) - (file-relative-name - (expand-file-name - (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures"))) - -(defun org-export-odt-format-image (src href) - "Create image tag with source and attributes." - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string - 'org-latex-src src)) - (category (and latex-frag "__DvipngImage__")) - (attr-plist (org-lparse-get-block-params attr)) - (user-frame-anchor - (car (assoc-string (plist-get attr-plist :anchor) - '(("as-char") ("paragraph") ("page")) t))) - (user-frame-style - (and user-frame-anchor (plist-get attr-plist :style))) - (user-frame-attrs - (and user-frame-anchor (plist-get attr-plist :attributes))) - (user-frame-params - (list user-frame-style user-frame-attrs user-frame-anchor)) - (embed-as (cond - (latex-frag - (symbol-name - (case (org-find-text-property-in-string - 'org-latex-src-embed-type src) - (paragraph 'paragraph) - (t 'as-char)))) - (user-frame-anchor) - (t "paragraph"))) - (size (org-odt-image-size-from-file - src (plist-get attr-plist :width) - (plist-get attr-plist :height) - (plist-get attr-plist :scale) nil embed-as)) - (width (car size)) (height (cdr size))) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (let ((frame-style-handle (concat (and (or caption label) "Captioned") - embed-as "Image"))) - (org-odt-format-entity - frame-style-handle href width height - :caption caption :label label :category category - :short-caption short-caption - :user-frame-params user-frame-params))))) - -(defun org-odt-format-object-description (title description) - (concat (and title (org-odt-format-tags - '("" . "") - (org-odt-encode-plain-text title t))) - (and description (org-odt-format-tags - '("" . "") - (org-odt-encode-plain-text description t))))) - -(defun org-odt-format-frame (text width height style &optional - extra anchor-type) - (let ((frame-attrs - (concat - (if width (format " svg:width=\"%0.2fcm\"" width) "") - (if height (format " svg:height=\"%0.2fcm\"" height) "") - extra - (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) - (org-odt-format-tags - '("" . "") - (concat text (org-odt-format-object-description - (get-text-property 0 :title text) - (get-text-property 0 :description text))) - style frame-attrs))) - -(defun org-odt-format-textbox (text width height style &optional - extra anchor-type) - (org-odt-format-frame - (org-odt-format-tags - '("" . "") - text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) - (unless width - (format " fo:min-width=\"%0.2fcm\"" (or width .2))))) - width nil style extra anchor-type)) - -(defun org-odt-format-inlinetask (heading content - &optional todo priority tags) - (org-odt-format-stylized-paragraph - nil (org-odt-format-textbox - (concat (org-odt-format-stylized-paragraph - "OrgInlineTaskHeading" - (org-lparse-format - 'HEADLINE (concat (org-lparse-format-todo todo) " " heading) - nil tags)) - content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))) - -(defvar org-odt-entity-frame-styles - '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char")) - ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph")) - ("PageImage" "__Figure__" ("OrgPageImage" nil "page")) - ("CaptionedAs-CharImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgInlineImage" nil "as-char")) - ("CaptionedParagraphImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgImageCaptionFrame" nil "paragraph")) - ("CaptionedPageImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgPageImageCaptionFrame" nil "page")) - ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char")) - ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char")) - ("CaptionedDisplayFormula" "__MathFormula__" - ("OrgCaptionedFormula" nil "paragraph") - ("OrgFormulaCaptionFrame" nil "as-char")))) - -(defun org-odt-merge-frame-params(default-frame-params user-frame-params) - (if (not user-frame-params) default-frame-params - (assert (= (length default-frame-params) 3)) - (assert (= (length user-frame-params) 3)) - (loop for user-frame-param in user-frame-params - for default-frame-param in default-frame-params - collect (or user-frame-param default-frame-param)))) - -(defun* org-odt-format-entity (entity href width height - &key caption label category - user-frame-params short-caption) - (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t)) - default-frame-params frame-params) - (cond - ((not (or caption label)) - (setq default-frame-params (nth 2 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-frame href width height frame-params)) - (t - (setq default-frame-params (nth 3 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-textbox - (org-odt-format-stylized-paragraph - 'illustration - (concat - (apply 'org-odt-format-frame href width height - (let ((entity-style-1 (copy-sequence - (nth 2 entity-style)))) - (setcar (cdr entity-style-1) - (concat - (cadr entity-style-1) - (and short-caption - (format " draw:name=\"%s\" " - short-caption)))) - - entity-style-1)) - (org-odt-format-entity-caption - label caption (or category (nth 1 entity-style))))) - width height frame-params))))) - -(defvar org-odt-embedded-images-count 0) -(defun org-odt-copy-image-file (path) - "Returns the internal name of the file" - (let* ((image-type (file-name-extension path)) - (media-type (format "image/%s" image-type)) - (src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir "Images/") - (target-file - (format "%s%04d.%s" target-dir - (incf org-odt-embedded-images-count) image-type))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (when (= 1 org-odt-embedded-images-count) - (make-directory target-dir) - (org-odt-create-manifest-file-entry "" target-dir)) - - (copy-file src-file target-file 'overwrite) - (org-odt-create-manifest-file-entry media-type target-file)) - target-file)) - -(defvar org-export-odt-image-size-probe-method - (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 - '(emacs fixed)) - "Ordered list of methods for determining image sizes.") - -(defvar org-export-odt-default-image-sizes-alist - '(("as-char" . (5 . 0.4)) - ("paragraph" . (5 . 5))) - "Hardcoded image dimensions one for each of the anchor - methods.") - -;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So -;; the effective text area is 17.0 by 25.7 cm -(defvar org-export-odt-max-image-size '(17.0 . 20.0) - "Limiting dimensions for an embedded image.") - -(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type) - (let* ((dpi (or dpi org-export-odt-pixels-per-inch)) - (anchor-type (or anchor-type "paragraph")) - (--pixels-to-cms - (function - (lambda (pixels dpi) - (let* ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) - (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))) - (case probe-method - (emacs - (let ((size-in-pixels - (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) - (funcall --size-in-cms size-in-pixels dpi))) - (imagemagick - (let ((size-in-pixels - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (funcall --size-in-cms size-in-pixels dpi))) - (t (cdr (assoc-string anchor-type - org-export-odt-default-image-sizes-alist)))))) - -(defun org-odt-image-size-from-file (file &optional user-width - user-height scale dpi embed-as) - (unless (file-name-absolute-p file) - (setq file (expand-file-name - file (file-name-directory org-current-export-file)))) - (let* (size width height) - (unless (and user-height user-width) - (loop for probe-method in org-export-odt-image-size-probe-method - until size - do (setq size (org-odt-do-image-size - probe-method file dpi embed-as))) - (or size (error "Cannot determine image size, aborting")) - (setq width (car size) height (cdr size))) - (cond - (scale - (setq width (* width scale) height (* height scale))) - ((and user-height user-width) - (setq width user-width height user-height)) - (user-height - (setq width (* user-height (/ width height)) height user-height)) - (user-width - (setq height (* user-width (/ height width)) width user-width)) - (t (ignore))) - ;; ensure that an embedded image fits comfortably within a page - (let ((max-width (car org-export-odt-max-image-size)) - (max-height (cdr org-export-odt-max-image-size))) - (when (or (> width max-width) (> height max-height)) - (let* ((scale1 (/ max-width width)) - (scale2 (/ max-height height)) - (scale (min scale1 scale2))) - (setq width (* scale width) height (* scale height))))) - (cons width height))) - -(defvar org-odt-entity-counts-plist nil - "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs. -See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.") - -(defvar org-odt-label-styles - '(("math-formula" "%c" "text" "(%n)") - ("math-label" "(%n)" "text" "(%n)") - ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") - ("value" "%e %n: %c" "value" "%n")) - "Specify how labels are applied and referenced. -This is an alist where each element is of the -form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE -LABEL-REF-FMT). - -LABEL-ATTACH-FMT controls how labels and captions are attached to -an entity. It may contain following specifiers - %e, %n and %c. -%e is replaced with the CATEGORY-NAME. %n is replaced with -\" SEQNO \". %c is replaced -with CAPTION. See `org-odt-format-label-definition'. - -LABEL-REF-MODE and LABEL-REF-FMT controls how label references -are generated. The following XML is generated for a label -reference - \" LABEL-REF-FMT -\". LABEL-REF-FMT may contain following -specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-odt-format-label-reference'.") - -(defcustom org-export-odt-category-strings - '(("en" "Table" "Figure" "Equation" "Equation")) - "Specify category strings for various captionable entities. -Captionable entity can be one of a Table, an Embedded Image, a -LaTeX fragment (generated with dvipng) or a Math Formula. - -For example, when `org-export-default-language' is \"en\", an -embedded image will be captioned as \"Figure 1: Orgmode Logo\". -If you want the images to be captioned instead as \"Illustration -1: Orgmode Logo\", then modify the entry for \"en\" as shown -below. - - \(setq org-export-odt-category-strings - '\(\(\"en\" \"Table\" \"Illustration\" - \"Equation\" \"Equation\"\)\)\)" - :group 'org-export-odt - :version "24.1" - :type '(repeat (list (string :tag "Language tag") - (choice :tag "Table" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Figure" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Math Formula" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Dvipng Image" - (const :tag "Use Default" nil) - (string :tag "Category string"))))) - -(defvar org-odt-category-map-alist - '(("__Table__" "Table" "value") - ("__Figure__" "Illustration" "value") - ("__MathFormula__" "Text" "math-formula") - ("__DvipngImage__" "Equation" "value") - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) - "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. -This is a list where each entry is of the form \\(CATEGORY-HANDLE -OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the -captionable entity in question. OD-VARIABLE is the OpenDocument -sequence counter associated with the entity. These counters are -declared within -\"...\" block of -`org-export-odt-content-template-file'. LABEL-STYLE is a key -into `org-odt-label-styles' and specifies how a given entity -should be captioned and referenced. - -The position of a CATEGORY-HANDLE in this list is used as an -index in to per-language entry for -`org-export-odt-category-strings' to retrieve a CATEGORY-NAME. -This CATEGORY-NAME is then used for qualifying the user-specified -captions on export.") - -(defun org-odt-add-label-definition (label default-category) - "Create an entry in `org-odt-entity-labels-alist' and return it." - (let* ((label-props (assoc default-category org-odt-category-map-alist)) - ;; identify the sequence number - (counter (nth 1 label-props)) - (sequence-var (intern counter)) - (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var) - 0))) - ;; assign an internal label, if user has not provided one - (label (if label (substring-no-properties label) - (format "%s-%s" default-category seqno))) - ;; identify label style - (label-style (nth 2 label-props)) - ;; grok language setting - (en-strings (assoc-default "en" org-export-odt-category-strings)) - (lang (plist-get org-lparse-opt-plist :language)) - (lang-strings (assoc-default lang org-export-odt-category-strings)) - ;; retrieve localized category sting - (pos (- (length org-odt-category-map-alist) - (length (memq label-props org-odt-category-map-alist)))) - (category (or (nth pos lang-strings) (nth pos en-strings))) - (label-props (list label category counter seqno label-style))) - ;; synchronize internal counters - (setq org-odt-entity-counts-plist - (plist-put org-odt-entity-counts-plist sequence-var seqno)) - ;; stash label properties for later retrieval - (push label-props org-odt-entity-labels-alist) - label-props)) - -(defun org-odt-format-label-definition (caption label category counter - seqno label-style) - (assert label) - (format-spec - (cadr (assoc-string label-style org-odt-label-styles t)) - `((?e . ,category) - (?n . ,(org-odt-format-tags - '("" . "") - (format "%d" seqno) label counter counter)) - (?c . ,(or caption ""))))) - -(defun org-odt-format-label-reference (label category counter - seqno label-style) - (assert label) - (save-match-data - (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) - (fmt1 (car fmt)) - (fmt2 (cadr fmt))) - (org-odt-format-tags - '("" - . "") - (format-spec fmt2 `((?e . ,category) - (?n . ,(format "%d" seqno)))) fmt1 label)))) - -(defun org-odt-fixup-label-references () - (goto-char (point-min)) - (while (re-search-forward - "[ \t\n]*" - nil t) - (let* ((label (match-string 1)) - (label-def (assoc label org-odt-entity-labels-alist)) - (rpl (and label-def - (apply 'org-odt-format-label-reference label-def)))) - (if rpl (replace-match rpl t t) - (org-lparse-warn - (format "Unable to resolve reference to label \"%s\"" label)))))) - -(defun org-odt-format-entity-caption (label caption category) - (if (not (or label caption)) "" - (apply 'org-odt-format-label-definition caption - (org-odt-add-label-definition label category)))) - -(defun org-odt-format-tags (tag text &rest args) - (let ((prefix (when org-lparse-encode-pending "@")) - (suffix (when org-lparse-encode-pending "@"))) - (apply 'org-lparse-format-tags tag text prefix suffix args))) - -(defvar org-odt-manifest-file-entries nil) -(defun org-odt-init-outfile (filename) - (unless (executable-find "zip") - ;; Not at all OSes ship with zip by default - (error "Executable \"zip\" needed for creating OpenDocument files")) - - (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir))) - ;; init conten.xml - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect content-file t)) - - ;; reset variables - (setq org-odt-manifest-file-entries nil - org-odt-embedded-images-count 0 - org-odt-embedded-formulas-count 0 - org-odt-entity-labels-alist nil - org-odt-list-stack-stashed nil - org-odt-automatic-styles nil - org-odt-object-counters nil - org-odt-entity-counts-plist nil) - content-file)) - -(defcustom org-export-odt-prettify-xml nil - "Specify whether or not the xml output should be prettified. -When this option is turned on, `indent-region' is run on all -component xml buffers before they are saved. Turn this off for -regular use. Turn this on if you need to examine the xml -visually." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse -(defun org-odt-save-as-outfile (target opt-plist) - ;; write automatic styles - (org-odt-write-automatic-styles) - - ;; write meta file - (org-odt-update-meta-file opt-plist) - - ;; write styles file - (when (equal org-lparse-backend 'odt) - (org-odt-update-styles-file opt-plist)) - - ;; create mimetype file - (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend))) - (org-odt-create-manifest-file-entry mimetype "/" "1.2")) - - ;; create a manifest entry for content.xml - (org-odt-create-manifest-file-entry "text/xml" "content.xml") - - ;; write out the manifest entries before zipping - (org-odt-write-manifest-file) - - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml"))) - (when (equal org-lparse-backend 'odt) - (push "styles.xml" xml-files)) - - ;; save all xml files - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect (expand-file-name file) t) - ;; prettify output if needed - (when org-export-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))) - xml-files) - - (let* ((target-name (file-name-nondirectory target)) - (target-dir (file-name-directory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - (when (file-exists-p target) - ;; FIXME: If the file is locked this throws a cryptic error - (delete-file target)) - - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating odt file...") - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (ignore (message "%s" err-string)) - (error "Unable to create odt file (%S)" exitcode))) - cmds)) - - ;; move the file from outdir to target-dir - (rename-file target-name target-dir))) - - (message "Created %s" target) - (set-buffer (find-file-noselect target t))) - -(defconst org-odt-manifest-file-entry-tag - " -") - -(defun org-odt-create-manifest-file-entry (&rest args) - (push args org-odt-manifest-file-entries)) - -(defun org-odt-write-manifest-file () - (make-directory "META-INF") - (let ((manifest-file (expand-file-name "META-INF/manifest.xml"))) - (with-current-buffer - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect manifest-file t)) - (insert - " - \n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if version - (format " manifest:version=\"%s\"" version) - ""))) - (insert - (format org-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-odt-manifest-file-entries) - (insert "\n")))) - -(defun org-odt-update-meta-file (opt-plist) - (let ((date (org-odt-format-date (plist-get opt-plist :date))) - (author (or (plist-get opt-plist :author) "")) - (email (plist-get opt-plist :email)) - (keywords (plist-get opt-plist :keywords)) - (description (plist-get opt-plist :description)) - (title (plist-get opt-plist :title))) - (write-region - (concat - " - - " "\n" - (org-odt-format-author) - (org-odt-format-tags - '("\n" . "") author) - (org-odt-format-tags '("\n" . "") date) - (org-odt-format-tags - '("\n" . "") date) - (org-odt-format-tags '("\n" . "") - (when org-export-creator-info - (format "Org-%s/Emacs-%s" - (org-version) - emacs-version))) - (org-odt-format-tags '("\n" . "") keywords) - (org-odt-format-tags '("\n" . "") description) - (org-odt-format-tags '("\n" . "") title) - "\n" - " " "") - nil (expand-file-name "meta.xml"))) - - ;; create a manifest entry for meta.xml - (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) - -(defun org-odt-update-styles-file (opt-plist) - ;; write styles file - (let ((styles-file (plist-get opt-plist :odt-styles-file))) - (org-odt-copy-styles-file (and styles-file - (read (org-trim styles-file))))) - - ;; Update styles.xml - take care of outline numbering - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - ;; Don't make automatic backup of styles.xml file. This setting - ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative - ;; would be to fix the zip command so that the output odt file - ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that - ;; currently the zip command zips up the entire temp directory so - ;; that any auto-generated files created under the hood ends up in - ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) - - ;; Import local setting of `org-export-with-section-numbers' - (org-lparse-bind-local-variables opt-plist) - (org-odt-configure-outline-numbering - (if org-export-with-section-numbers org-export-headline-levels 0))) - - ;; Write custom styles for source blocks - (org-odt-insert-custom-styles-for-srcblocks - (mapconcat - (lambda (style) - (format " %s\n" (cddr style))) - hfy-user-sheet-assoc ""))) - -(defun org-odt-write-mimetype-file (format) - ;; create mimetype file - (let ((mimetype - (case format - (odt "application/vnd.oasis.opendocument.text") - (odf "application/vnd.oasis.opendocument.formula") - (t (error "Unknown OpenDocument backend %S" org-lparse-backend))))) - (write-region mimetype nil (expand-file-name "mimetype")) - mimetype)) - -(defun org-odt-finalize-outfile () - (org-odt-delete-empty-paragraphs)) - -(defun org-odt-delete-empty-paragraphs () - (goto-char (point-min)) - (let ((open "]*>") - (close "")) - (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t) - (replace-match "")))) - -(defcustom org-export-odt-convert-processes - '(("LibreOffice" - "soffice --headless --convert-to %f%x --outdir %d %i") - ("unoconv" - "unoconv -f %f -o %d %i")) - "Specify a list of document converters and their usage. -The converters in this list are offered as choices while -customizing `org-export-odt-convert-process'. - -This variable is a list where each element is of the -form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name -of the converter. CONVERTER-CMD is the shell command for the -converter and can contain format specifiers. These format -specifiers are interpreted as below: - -%i input file name in full -%I input file name as a URL -%f format of the output file -%o output file name in full -%O output file name as a URL -%d output dir in full -%D output dir as a URL. -%x extra options as set in `org-export-odt-convert-capabilities'." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Converters" - :key-type (string :tag "Converter Name") - :value-type (group (string :tag "Command line"))))) - -(defcustom org-export-odt-convert-process "LibreOffice" - "Use this converter to convert from \"odt\" format to other formats. -During customization, the list of converter names are populated -from `org-export-odt-convert-processes'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,(car c) ,(car c))) - org-export-odt-convert-processes)))) - -(defcustom org-export-odt-convert-capabilities - '(("Text" - ("odt" "ott" "doc" "rtf" "docx") - (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") - ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) - ("Web" - ("html") - (("pdf" "pdf") ("odt" "odt") ("html" "html"))) - ("Spreadsheet" - ("ods" "ots" "xls" "csv" "xlsx") - (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") - ("xls" "xls") ("xlsx" "xlsx"))) - ("Presentation" - ("odp" "otp" "ppt" "pptx") - (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") - ("pptx" "pptx") ("odg" "odg")))) - "Specify input and output formats of `org-export-odt-convert-process'. -More correctly, specify the set of input and output formats that -the user is actually interested in. - -This variable is an alist where each element is of the -form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). -INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an -alist where each element is of the form (OUTPUT-FMT -OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). - -The variable is interpreted as follows: -`org-export-odt-convert-process' can take any document that is in -INPUT-FMT-LIST and produce any document that is in the -OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have -OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT -serves dual purposes: -- It is used for populating completion candidates during - `org-export-odt-convert' commands. -- It is used as the value of \"%f\" specifier in - `org-export-odt-convert-process'. - -EXTRA-OPTIONS is used as the value of \"%x\" specifier in -`org-export-odt-convert-process'. - -DOCUMENT-CLASS is used to group a set of file formats in -INPUT-FMT-LIST in to a single class. - -Note that this variable inherently captures how LibreOffice based -converters work. LibreOffice maps documents of various formats -to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source -format) to be converted to any of the export formats associated -with that class. - -See default setting of this variable for an typical -configuration." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Capabilities" - :key-type (string :tag "Document Class") - :value-type - (group (repeat :tag "Input formats" (string :tag "Input format")) - (alist :tag "Output formats" - :key-type (string :tag "Output format") - :value-type - (group (string :tag "Output file extension") - (choice - (const :tag "None" nil) - (string :tag "Extra options")))))))) - -(declare-function org-create-math-formula "org" - (latex-frag &optional mathml-file)) - -;;;###autoload -(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg) - "Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-export-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." - (interactive - (append (org-lparse-convert-read-params) current-prefix-arg)) - (org-lparse-do-convert in-file out-fmt prefix-arg)) - -(defun org-odt-get (what &optional opt-plist) - (case what - (BACKEND 'odt) - (EXPORT-DIR (org-export-directory :html opt-plist)) - (FILE-NAME-EXTENSION "odt") - (EXPORT-BUFFER-NAME "*Org ODT Export*") - (ENTITY-CONTROL org-odt-entity-control-callbacks-alist) - (ENTITY-FORMAT org-odt-entity-format-callbacks-alist) - (INIT-METHOD 'org-odt-init-outfile) - (FINAL-METHOD 'org-odt-finalize-outfile) - (SAVE-METHOD 'org-odt-save-as-outfile) - (CONVERT-METHOD - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)))) - (CONVERT-CAPABILITIES - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)) - org-export-odt-convert-capabilities)) - (TOPLEVEL-HLEVEL 1) - (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps) - (INLINE-IMAGES 'maybe) - (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg")) - (PLAIN-TEXT-MAP '(("&" . "&") ("<" . "<") (">" . ">"))) - (TABLE-FIRST-COLUMN-AS-LABELS nil) - (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript)) - (CODING-SYSTEM-FOR-WRITE 'utf-8) - (CODING-SYSTEM-FOR-SAVE 'utf-8) - (t (error "Unknown property: %s" what)))) - -(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse -(defun org-export-odt-do-preprocess-latex-fragments () - "Convert LaTeX fragments to images." - (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments)) - (latex-frag-opt ; massage the options - (or (and (member latex-frag-opt '(mathjax t)) - (not (and (fboundp 'org-format-latex-mathml-available-p) - (org-format-latex-mathml-available-p))) - (prog1 org-lparse-latex-fragment-fallback - (org-lparse-warn - (concat - "LaTeX to MathML converter not available. " - (format "Using %S instead." - org-lparse-latex-fragment-fallback))))) - latex-frag-opt)) - cache-dir display-msg) - (cond - ((eq latex-frag-opt 'dvipng) - (setq cache-dir org-latex-preview-ltxpng-directory) - (setq display-msg "Creating LaTeX image %s")) - ((member latex-frag-opt '(mathjax t)) - (setq latex-frag-opt 'mathml) - (setq cache-dir "ltxmathml/") - (setq display-msg "Creating MathML formula %s"))) - (when (and org-current-export-file) - (org-format-latex - (concat cache-dir (file-name-sans-extension - (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil display-msg - nil nil latex-frag-opt)))) - -(defadvice org-format-latex-as-mathml - (after org-odt-protect-latex-fragment activate) - "Encode LaTeX fragment as XML. -Do this when translation to MathML fails." - (when (or (not (> (length ad-return-value) 0)) - (get-text-property 0 'org-protected ad-return-value)) - (setq ad-return-value - (org-propertize (org-odt-encode-plain-text (ad-get-arg 0)) - 'org-protected t)))) - -(defun org-export-odt-preprocess-latex-fragments () - (when (equal org-export-current-backend 'odt) - (org-export-odt-do-preprocess-latex-fragments))) - -(defun org-export-odt-preprocess-label-references () - (goto-char (point-min)) - (let (label label-components category value pretty-label) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match - (let ((org-lparse-encode-pending t) - (label (match-string 1))) - ;; markup generated below is mostly an eye-candy. At - ;; pre-processing stage, there is no information on which - ;; entity a label reference points to. The actual markup - ;; is generated as part of `org-odt-fixup-label-references' - ;; which gets called at the fag end of export. By this - ;; time we would have seen and collected all the label - ;; definitions in `org-odt-entity-labels-alist'. - (org-odt-format-tags - '("" . - "") - "" (org-add-props label '(org-protected t)))) t t))))) - -;; process latex fragments as part of -;; `org-export-preprocess-after-blockquote-hook'. Note that this hook -;; is the one that is closest and well before the call to -;; `org-export-attach-captions-and-attributes' in -;; `org-export-preprocess-string'. The above arrangement permits -;; captions, labels and attributes to be attached to png images -;; generated out of latex equations. -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - -(defun org-export-odt-preprocess (parameters) - (org-export-odt-preprocess-label-references)) - -(declare-function archive-zip-extract "arc-mode" (archive name)) -(defun org-odt-zip-extract-one (archive member &optional target) - (require 'arc-mode) - (let* ((target (or target default-directory)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - -(defun org-odt-zip-extract (archive members &optional target) - (when (atom members) (setq members (list members))) - (mapc (lambda (member) - (org-odt-zip-extract-one archive member target)) - members)) - -(defun org-odt-copy-styles-file (&optional styles-file) - ;; Non-availability of styles.xml is not a critical error. For now - ;; throw an error purely for aesthetic reasons. - (setq styles-file (or styles-file - org-export-odt-styles-file - (expand-file-name "OrgOdtStyles.xml" - org-odt-styles-dir) - (error "org-odt: Missing styles file?"))) - (cond - ((listp styles-file) - (let ((archive (nth 0 styles-file)) - (members (nth 1 styles-file))) - (org-odt-zip-extract archive members) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-odt-create-manifest-file-entry media-type member)))) - members))) - ((and (stringp styles-file) (file-exists-p styles-file)) - (let ((styles-file-type (file-name-extension styles-file))) - (cond - ((string= styles-file-type "xml") - (copy-file styles-file "styles.xml" t)) - ((member styles-file-type '("odt" "ott")) - (org-odt-zip-extract styles-file "styles.xml"))))) - (t - (error (format "Invalid specification of styles.xml file: %S" - org-export-odt-styles-file)))) - - ;; create a manifest entry for styles.xml - (org-odt-create-manifest-file-entry "text/xml" "styles.xml")) - -(defun org-odt-configure-outline-numbering (level) - "Outline numbering is retained only upto LEVEL. -To disable outline numbering pass a LEVEL of 0." - (goto-char (point-min)) - (let ((regex - "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") - (replacement - "")) - (while (re-search-forward regex nil t) - (when (> (string-to-number (match-string 2)) level) - (replace-match replacement t nil)))) - (save-buffer 0)) - -;;;###autoload -(defun org-export-as-odf (latex-frag &optional odf-file) - "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring, if `org-export-copy-to-kill-ring' is -non-nil." - (interactive - `(,(let (frag) - (setq frag (and (setq frag (and (org-region-active-p) - (buffer-substring (region-beginning) - (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) - (read-string "LaTeX Fragment: " frag nil frag)) - ,(let ((odf-filename (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (read-file-name "ODF filename: " nil odf-filename nil - (file-name-nondirectory odf-filename))))) - (org-odt-cleanup-xml-buffers - (let* ((org-lparse-backend 'odf) - org-lparse-opt-plist - (filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (buffer (find-file-noselect (org-odt-init-outfile filename))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done"))) - (org-odt-save-as-outfile filename nil)))) - -;;;###autoload -(defun org-export-as-odf-and-open () - "Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-export-as-odf' to read LaTeX fragment and OpenDocument -formula file." - (interactive) - (org-lparse-and-open - nil nil nil (call-interactively 'org-export-as-odf))) - -(provide 'org-odt) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-odt.el ends here diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index e2b5dd9fb3b..32dcaa6815b 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -1,6 +1,6 @@ ;;; org-pcomplete.el --- In-buffer completion code -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; John Wiegley @@ -35,9 +35,8 @@ (require 'pcomplete) (declare-function org-split-string "org" (string &optional separators)) -(declare-function org-get-current-options "org-exp" ()) (declare-function org-make-org-heading-search-string "org" - (&optional string heading)) + (&optional string)) (declare-function org-get-buffer-tags "org" ()) (declare-function org-get-tags "org" ()) (declare-function org-buffer-property-keys "org" @@ -109,11 +108,11 @@ When completing for #+STARTUP, for example, this function returns (let ((thing (org-thing-at-point))) (cond ((string= "file-option" (car thing)) - (concat (car thing) "/" (downcase (cdr thing)))) + (concat (car thing) + (and (cdr thing) (concat "/" (downcase (cdr thing)))))) ((string= "block-option" (car thing)) (concat (car thing) "/" (downcase (cdr thing)))) - (t - (car thing))))) + (t (car thing))))) (defun org-parse-arguments () "Parse whitespace separated arguments in the current region." @@ -140,21 +139,86 @@ When completing for #+STARTUP, for example, this function returns (car (org-thing-at-point))) pcomplete-default-completion-function)))) -(defvar org-options-keywords) ; From org.el -(defvar org-additional-option-like-keywords) ; From org.el +(defvar org-options-keywords) ; From org.el +(defvar org-element-block-name-alist) ; From org-element.el +(defvar org-element-affiliated-keywords) ; From org-element.el +(declare-function org-get-export-keywords "org" ()) (defun pcomplete/org-mode/file-option () "Complete against all valid file options." - (require 'org-exp) + (require 'org-element) (pcomplete-here (org-pcomplete-case-double - (mapcar (lambda (x) - (if (= ?: (aref x (1- (length x)))) - (concat x " ") - x)) - (append org-options-keywords - org-additional-option-like-keywords))) + (append (mapcar (lambda (keyword) (concat keyword " ")) + org-options-keywords) + (mapcar (lambda (keyword) (concat keyword ": ")) + org-element-affiliated-keywords) + (let (block-names) + (dolist (block-info org-element-block-name-alist block-names) + (let ((name (car block-info))) + (push (format "END_%s" name) block-names) + (push (concat "BEGIN_" + name + ;; Since language is compulsory in + ;; source blocks, add a space. + (and (equal name "SRC") " ")) + block-names) + (push (format "ATTR_%s: " name) block-names)))) + (mapcar (lambda (keyword) (concat keyword ": ")) + (org-get-export-keywords)))) (substring pcomplete-stub 2))) +(defun pcomplete/org-mode/file-option/author () + "Complete arguments for the #+AUTHOR file option." + (pcomplete-here (list user-full-name))) + +(defvar org-time-stamp-formats) +(defun pcomplete/org-mode/file-option/date () + "Complete arguments for the #+DATE file option." + (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) + +(defun pcomplete/org-mode/file-option/email () + "Complete arguments for the #+EMAIL file option." + (pcomplete-here (list user-mail-address))) + +(defvar org-export-exclude-tags) +(defun pcomplete/org-mode/file-option/exclude_tags () + "Complete arguments for the #+EXCLUDE_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-exclude-tags + (list (mapconcat 'identity org-export-exclude-tags " "))))) + +(defvar org-file-tags) +(defun pcomplete/org-mode/file-option/filetags () + "Complete arguments for the #+FILETAGS file option." + (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) + +(defvar org-export-default-language) +(defun pcomplete/org-mode/file-option/language () + "Complete arguments for the #+LANGUAGE file option." + (require 'ox) + (pcomplete-here + (pcomplete-uniqify-list + (list org-export-default-language "en")))) + +(defvar org-default-priority) +(defvar org-highest-priority) +(defvar org-lowest-priority) +(defun pcomplete/org-mode/file-option/priorities () + "Complete arguments for the #+PRIORITIES file option." + (pcomplete-here (list (format "%c %c %c" + org-highest-priority + org-lowest-priority + org-default-priority)))) + +(defvar org-export-select-tags) +(defun pcomplete/org-mode/file-option/select_tags () + "Complete arguments for the #+SELECT_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-select-tags + (list (mapconcat 'identity org-export-select-tags " "))))) + (defvar org-startup-options) (defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." @@ -169,37 +233,57 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) -(defmacro pcomplete/org-mode/file-option/x (option) - "Complete arguments for OPTION." - `(while - (pcomplete-here - (pcomplete-uniqify-list - (delq nil - (mapcar (lambda(o) - (when (string-match (concat "^[ \t]*#\\+" - ,option ":[ \t]+\\(.*\\)[ \t]*$") o) - (match-string 1 o))) - (split-string (org-get-current-options) "\n"))))))) - -(defun pcomplete/org-mode/file-option/options () - "Complete arguments for the #+OPTIONS file option." - (pcomplete/org-mode/file-option/x "OPTIONS")) +(defvar org-tag-alist) +(defun pcomplete/org-mode/file-option/tags () + "Complete arguments for the #+TAGS file option." + (pcomplete-here + (list + (mapconcat (lambda (x) + (cond + ((eq :startgroup (car x)) "{") + ((eq :endgroup (car x)) "}") + ((eq :grouptags (car x)) ":") + ((eq :newline (car x)) "\\n") + ((cdr x) (format "%s(%c)" (car x) (cdr x))) + (t (car x)))) + org-tag-alist " ")))) (defun pcomplete/org-mode/file-option/title () "Complete arguments for the #+TITLE file option." - (pcomplete/org-mode/file-option/x "TITLE")) + (pcomplete-here + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list (or (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file))) + (buffer-name (buffer-base-buffer))))))) -(defun pcomplete/org-mode/file-option/author () - "Complete arguments for the #+AUTHOR file option." - (pcomplete/org-mode/file-option/x "AUTHOR")) -(defun pcomplete/org-mode/file-option/email () - "Complete arguments for the #+EMAIL file option." - (pcomplete/org-mode/file-option/x "EMAIL")) +(declare-function org-export-backend-options "org-export" (cl-x)) +(defun pcomplete/org-mode/file-option/options () + "Complete arguments for the #+OPTIONS file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (append + ;; Hard-coded OPTION items always available. + '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:" + "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" + "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" + "|:" "tags:" "tasks:" "<:" "todo:") + ;; OPTION items from registered back-ends. + (let (items) + (dolist (backend (org-bound-and-true-p + org-export--registered-backends)) + (dolist (option (org-export-backend-options backend)) + (let ((item (nth 2 option))) + (when item (push (concat item ":") items))))) + items)))))) -(defun pcomplete/org-mode/file-option/date () - "Complete arguments for the #+DATE file option." - (pcomplete/org-mode/file-option/x "DATE")) +(defun pcomplete/org-mode/file-option/infojs_opt () + "Complete arguments for the #+INFOJS_OPT file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (mapcar (lambda (item) (format "%s:" (car item))) + (org-bound-and-true-p org-html-infojs-opts-table)))))) (defun pcomplete/org-mode/file-option/bind () "Complete arguments for the #+BIND file option, which are variable names." @@ -242,7 +326,7 @@ This needs more work, to handle headings with lots of spaces in them." (let (tbl) (while (re-search-forward org-todo-line-regexp nil t) (push (org-make-org-heading-search-string - (match-string-no-properties 3) t) + (match-string-no-properties 3)) tbl)) (pcomplete-uniqify-list tbl))) (substring pcomplete-stub 1)))) @@ -290,7 +374,7 @@ This needs more work, to handle headings with lots of spaces in them." (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) (pcomplete-here cpllist (substring pcomplete-stub 1) - (unless (or (not (delete + (unless (or (not (delq nil (mapcar (lambda(x) (string-match (substring pcomplete-stub 1) x)) @@ -312,16 +396,16 @@ Complete a language in the first field, the header arguments and switches." '("-n" "-r" "-l" ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" - ":session" ":shebang" ":tangle" ":var")))) + ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) (defun pcomplete/org-mode/block-option/clocktable () "Complete keywords in a clocktable line." - (while (pcomplete-here '(":maxlevel" ":scope" + (while (pcomplete-here '(":maxlevel" ":scope" ":lang" ":tstart" ":tend" ":block" ":step" ":stepskip0" ":fileskip0" ":emphasize" ":link" ":narrow" ":indent" ":tcolumns" ":level" ":compact" ":timestamp" - ":formula" ":formatter")))) + ":formula" ":formatter" ":wstart" ":mstart")))) (defun org-pcomplete-case-double (list) "Return list with both upcase and downcase version of all strings in LIST." diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 02d747d5441..556b9efc761 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -1,6 +1,6 @@ ;;; org-plot.el --- Support for plotting from Org-mode -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; ;; Author: Eric Schulte ;; Keywords: tables, plotting @@ -30,7 +30,6 @@ ;;; Code: (require 'org) -(require 'org-exp) (require 'org-table) (eval-when-compile (require 'cl)) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 18c6d6d70a4..0c6f2de3422 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -1,8 +1,8 @@ ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. ;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; -;; Authors: Bastien Guerry +;; Authors: Bastien Guerry ;; Daniel M German ;; Sebastian Rose ;; Ross Patterson @@ -91,11 +91,6 @@ ;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. ;; -;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". -;; This is provided for backward compatibility. -;; You may read `org-capture' as `org-remember' throughout this file if -;; you still use `org-remember'. -;; ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; @@ -155,8 +150,7 @@ for `org-protocol-the-protocol' and sub-protocols defined in ;;; Variables: (defconst org-protocol-protocol-alist-default - '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t) - ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) + '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) ("org-store-link" :protocol "store-link" :function org-protocol-store-link) ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) "Default protocols to use. @@ -271,12 +265,14 @@ Here is an example: This is usually a single character string but can also be a string with two characters." :group 'org-protocol - :type 'string) + :type '(choice (const nil) (string))) -(defcustom org-protocol-data-separator "/+" +(defcustom org-protocol-data-separator "/+\\|\\?" "The default data separator to use. This should be a single regexp string." :group 'org-protocol + :version "24.4" + :package-version '(Org . "8.0") :type 'string) ;;; Helper functions: @@ -297,7 +293,7 @@ nil, assume \"/+\". The results of that splitting are returned as a list. If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY is a function, use that function to decode each split part." - (let* ((sep (or separator "/+")) + (let* ((sep (or separator "/+\\|\\?")) (split-parts (split-string data sep))) (if unhexify (if (fboundp unhexify) @@ -391,32 +387,14 @@ The sub-protocol used to reach this function is set in uri)) nil) -(defun org-protocol-remember (info) - "Process an org-protocol://remember:// style url. - -The location for a browser's bookmark has to look like this: - - javascript:location.href='org-protocol://remember://'+ \\ - encodeURIComponent(location.href)+'/' \\ - encodeURIComponent(document.title)+'/'+ \\ - encodeURIComponent(window.getSelection()) - -See the docs for `org-protocol-capture' for more information." - - (if (and (boundp 'org-stored-links) - (fboundp 'org-capture) - (org-protocol-do-capture info 'org-remember)) - (message "Item remembered.")) - nil) - (defun org-protocol-capture (info) "Process an org-protocol://capture:// style url. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. -This function detects an URL, title and optional text, separated by '/' -The location for a browser's bookmark has to look like this: +This function detects an URL, title and optional text, separated +by '/'. The location for a browser's bookmark looks like this: javascript:location.href='org-protocol://capture://'+ \\ encodeURIComponent(location.href)+'/' \\ @@ -431,14 +409,20 @@ But you may prepend the encoded URL with a character and a slash like so: Now template ?b will be used." (if (and (boundp 'org-stored-links) - (fboundp 'org-capture) - (org-protocol-do-capture info 'org-capture)) + (org-protocol-do-capture info)) (message "Item captured.")) nil) -(defun org-protocol-do-capture (info capture-func) - "Support `org-capture' and `org-remember' alike. -CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." +(defun org-protocol-convert-query-to-plist (query) + "Convert query string that is part of url to property list." + (if query + (apply 'append (mapcar (lambda (x) + (let ((c (split-string x "="))) + (list (intern (concat ":" (car c))) (cadr c)))) + (split-string query "&"))))) + +(defun org-protocol-do-capture (info) + "Support `org-capture'." (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) (template (or (and (>= 2 (length (car parts))) (pop parts)) org-protocol-default-template-key)) @@ -449,8 +433,8 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." (region (or (caddr parts) "")) (orglink (org-make-link-string url (if (string-match "[^[:space:]]" title) title url))) - (org-capture-link-is-already-stored t) ;; avoid call to org-store-link - remember-annotation-functions) + (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) + (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link (setq org-stored-links (cons (list url title) org-stored-links)) (kill-new orglink) @@ -458,9 +442,10 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." :link url :description title :annotation orglink - :initial region) + :initial region + :query query) (raise-frame) - (funcall capture-func nil template))) + (funcall 'org-capture nil template))) (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -588,9 +573,9 @@ as filename." (defun org-protocol-create-for-org () "Create a org-protocol project for the current file's Org-mode project. -This works, if the file visited is part of a publishing project in -`org-publish-project-alist'. This function calls `org-protocol-create' to do -most of the work." +The visited file needs to be part of a publishing project in +`org-publish-project-alist' for this to work. The function +delegates most of the work to `org-protocol-create'." (interactive) (require 'org-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) @@ -600,10 +585,11 @@ most of the work." (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. -An org-protocol project is an entry in `org-protocol-project-alist' -which is used by `org-protocol-open-source'. -Optionally use project-plist to initialize the defaults for this project. If -project-plist is the CDR of an element in `org-publish-project-alist', reuse +An org-protocol project is an entry in +`org-protocol-project-alist' which is used by +`org-protocol-open-source'. Optionally use PROJECT-PLIST to +initialize the defaults for this project. If PROJECT-PLIST is +the cdr of an element in `org-publish-project-alist', reuse :base-directory, :html-extension and :base-extension." (interactive) (let ((working-dir (expand-file-name diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el deleted file mode 100644 index 20c6a6860aa..00000000000 --- a/lisp/org/org-publish.el +++ /dev/null @@ -1,1198 +0,0 @@ -;;; org-publish.el --- publish related org-mode files as a website -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: David O'Toole -;; Maintainer: Carsten Dominik -;; Keywords: hypermedia, outlines, wp - -;; 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 . - -;;; Commentary: - -;; This program allow configurable publishing of related sets of -;; Org-mode files as a complete website. -;; -;; org-publish.el can do the following: -;; -;; + Publish all one's org-files to HTML or PDF -;; + Upload HTML, images, attachments and other files to a web server -;; + Exclude selected private pages from publishing -;; + Publish a clickable sitemap of pages -;; + Manage local timestamps for publishing only changed files -;; + Accept plugin functions to extend range of publishable content -;; -;; Documentation for publishing is in the manual. - -;;; Code: - - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-exp) -(require 'format-spec) - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -(defvar org-publish-initial-buffer nil - "The buffer `org-publish' has been called from.") - -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - -;; Here, so you find the variable right before it's used the first time: -(defvar org-publish-cache nil - "This will cache timestamps and titles for files in publishing projects. -Blocks could hash sha1 values here.") - -(defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." - :tag "Org Publishing" - :group 'org) - -(defcustom org-publish-project-alist nil - "Association list to control publishing behavior. -Each element of the alist is a publishing 'project.' The CAR of -each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: - -1. A well-formed property list with an even number of elements, alternating - keys and values, specifying parameters for the publishing process. - - (:property value :property value ... ) - -2. A meta-project definition, specifying of a list of sub-projects: - - (:components (\"project-1\" \"project-2\" ...)) - -When the CDR of an element of org-publish-project-alist is in -this second form, the elements of the list after :components are -taken to be components of the project, which group together files -requiring different publishing options. When you publish such a -project with \\[org-publish], the components all publish. - -When a property is given a value in org-publish-project-alist, its -setting overrides the value of the corresponding user variable -\(if any) during publishing. However, options set within a file -override everything. - -Most properties are optional, but some should always be set: - - :base-directory Directory containing publishing source files - :base-extension Extension (without the dot!) of source files. - This can be a regular expression. If not given, - \"org\" will be used as default extension. - :publishing-directory Directory (possibly remote) where output - files will be published - -The :exclude property may be used to prevent certain files from -being published. Its value may be a string or regexp matching -file names you don't want to be published. - -The :include property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are -considered relative to the base directory. - -When both :include and :exclude properties are given values, the -exclusion step happens first. - -One special property controls which back-end function to use for -publishing files in the project. This can be used to extend the -set of file types publishable by org-publish, as well as the set -of output formats. - - :publishing-function Function to publish file. The default is - `org-publish-org-to-html', but other - values are possible. May also be a - list of functions, in which case - each function in the list is invoked - in turn. - -Another property allows you to insert code that prepares a -project for publishing. For example, you could call GNU Make on a -certain makefile, to ensure published files are built up to date. - - :preparation-function Function to be called before publishing - this project. This may also be a list - of functions. - :completion-function Function to be called after publishing - this project. This may also be a list - of functions. - -Some properties control details of the Org publishing process, -and are equivalent to the corresponding user variables listed in -the right column. See the documentation for those variables to -learn more about their use and default values. - - :language `org-export-default-language' - :headline-levels `org-export-headline-levels' - :section-numbers `org-export-with-section-numbers' - :table-of-contents `org-export-with-toc' - :emphasize `org-export-with-emphasize' - :sub-superscript `org-export-with-sub-superscripts' - :TeX-macros `org-export-with-TeX-macros' - :fixed-width `org-export-with-fixed-width' - :tables `org-export-with-tables' - :table-auto-headline `org-export-highlight-first-table-line' - :style `org-export-html-style' - :convert-org-links `org-export-html-link-org-files-as-html' - :inline-images `org-export-html-inline-images' - :expand-quoted-html `org-export-html-expand' - :timestamp `org-export-html-with-timestamp' - :publishing-directory `org-export-publishing-directory' - :html-preamble `org-export-html-preamble' - :html-postamble `org-export-html-postamble' - :author `user-full-name' - :email `user-mail-address' - -The following properties may be used to control publishing of a -sitemap of files or summary page for a given project. - - :auto-sitemap Whether to publish a sitemap during - `org-publish-current-project' or `org-publish-all'. - :sitemap-filename Filename for output of sitemap. Defaults - to 'sitemap.org' (which becomes 'sitemap.html'). - :sitemap-title Title of sitemap page. Defaults to name of file. - :sitemap-function Plugin function to use for generation of sitemap. - Defaults to `org-publish-org-sitemap', which - generates a plain list of links to all files - in the project. - :sitemap-style Can be `list' (sitemap is just an itemized list - of the titles of the files involved) or - `tree' (the directory structure of the source - files is reflected in the sitemap). Defaults to - `tree'. - :sitemap-sans-extension Remove extension from sitemap's - filenames. Useful to have cool - URIs (see - http://www.w3.org/Provider/Style/URI). - Defaults to nil. - - If you create a sitemap file, adjust the sorting like this: - - :sitemap-sort-folders Where folders should appear in the sitemap. - Set this to `first' (default) or `last' to - display folders first or last, respectively. - Any other value will mix files and folders. - :sitemap-sort-files The site map is normally sorted alphabetically. - You can change this behaviour setting this to - `chronologically', `anti-chronologically' or nil. - :sitemap-ignore-case Should sorting be case-sensitive? Default nil. - -The following properties control the creation of a concept index. - - :makeindex Create a concept index. - -Other properties affecting publication. - - :body-only Set this to 't' to publish only the body of the - documents, excluding everything outside and - including the tags in HTML, or - \begin{document}..\end{document} in LaTeX." - :group 'org-publish - :type 'alist) - -(defcustom org-publish-use-timestamps-flag t - "Non-nil means use timestamp checking to publish only changed files. -When nil, do no timestamp checking and always publish all files." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-timestamp-directory (convert-standard-filename - "~/.org-timestamps/") - "Name of directory in which to store publishing timestamps." - :group 'org-publish - :type 'directory) - -(defcustom org-publish-list-skipped-files t - "Non-nil means show message about files *not* published." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-before-export-hook nil - "Hook run before export on the Org file. -The hook may modify the file in arbitrary ways before publishing happens. -The original version of the buffer will be restored after publishing." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-after-export-hook nil - "Hook run after export on the exported buffer. -Any changes made by this hook will be saved." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-sitemap-sort-files 'alphabetically - "How sitemaps files should be sorted by default? -Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil. -If `alphabetically', files will be sorted alphabetically. -If `chronologically', files will be sorted with older modification time first. -If `anti-chronologically', files will be sorted with newer modification time first. -nil won't sort files. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-files'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. -If `first', folders will be sorted before files. -If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-ignore-case nil - "Sort sitemaps case insensitively by default? - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-ignore-case'." - :group 'org-publish - :version "24.1" - :type 'boolean) - -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for `format-time-string' which is used to print a date -in the sitemap." - :group 'org-publish - :version "24.1" - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "How a sitemap file entry is formatted. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-publish - :version "24.1" - :type 'string) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sanitize-plist (FIXME why?) - -(defun org-publish-sanitize-plist (plist) - ;; FIXME document - (mapcar (lambda (x) - (or (cdr (assq x '((:index-filename . :sitemap-filename) - (:index-title . :sitemap-title) - (:index-function . :sitemap-function) - (:index-style . :sitemap-style) - (:auto-index . :auto-sitemap)))) - x)) - plist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Timestamp-related functions - -(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) - "Return path to timestamp file for filename FILENAME." - (setq filename (concat filename "::" (or pub-dir "") "::" - (format "%s" (or pub-func "")))) - (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) - -(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) - "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is where the file will truly end up. Currently we are not using -this - maybe it can eventually be used to check if the file is present at -the target location, and how old it is. Right now we cannot do this, because -we do not know under what file name the file will be stored - the publishing -function can still decide about that independently." - (let ((rtn - (if org-publish-use-timestamps-flag - (org-publish-cache-file-needs-publishing - filename pub-dir pub-func base-dir) - ;; don't use timestamps, always return t - t))) - (if rtn - (message "Publishing file %s using `%s'" filename pub-func) - (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) - rtn)) - -(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) - "Update publishing timestamp for file FILENAME. -If there is no timestamp, create one." - (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (stamp (org-publish-cache-ctime-of-src filename))) - (org-publish-cache-set key stamp))) - -(defun org-publish-remove-all-timestamps () - "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) - (when (and (file-exists-p dir) - (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) - (org-publish-reset-cache)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatibility aliases - -;; Delete-dups is not in Emacs <22 -(if (fboundp 'delete-dups) - (defalias 'org-publish-delete-dups 'delete-dups) - (defun org-publish-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - -(declare-function org-publish-delete-dups "org-publish" (list)) -(declare-function find-lisp-find-files "find-lisp" (directory regexp)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Getting project information out of org-publish-project-alist - -(defun org-publish-expand-projects (projects-alist) - "Expand projects in PROJECTS-ALIST. -This splices all the components into the list." - (let ((rest projects-alist) rtn p components) - (while (setq p (pop rest)) - (if (setq components (plist-get (cdr p) :components)) - (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) - rest)) - (push p rtn))) - (nreverse (org-publish-delete-dups (delq nil rtn))))) - -(defvar org-sitemap-sort-files) -(defvar org-sitemap-sort-folders) -(defvar org-sitemap-ignore-case) -(defvar org-sitemap-requested) -(defvar org-sitemap-date-format) -(defvar org-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-sitemap-sort-files org-sitemap-sort-folders) - ;; First we sort files: - (when org-sitemap-sort-files - (cond ((equal org-sitemap-sort-files 'alphabetically) - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) - (A (if aorg - (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg - (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((or (equal org-sitemap-sort-files 'chronologically) - (equal org-sitemap-sort-files 'anti-chronologically)) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval (if (equal org-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (if org-sitemap-requested - (sort (directory-files base-dir t (unless recurse match)) - 'org-publish-compare-directory-files) - (directory-files base-dir t (unless recurse match))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (org-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) - "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-sitemap-sort-folders' has an accepted value - (unless (memq org-sitemap-sort-folders '(first last)) - (setq org-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (if org-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) - -(defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." - (let* ((filename (expand-file-name filename)) - project-name) - - (catch 'p-found - (dolist (prj org-publish-project-alist) - (unless (plist-get (cdr prj) :components) - ;; [[info:org:Selecting%20files]] shows how this is supposed to work: - (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (file-name-as-directory - (plist-get (cdr prj) :base-directory)))) - (x (or (plist-get (cdr prj) :base-extension) "org")) - (e (plist-get (cdr prj) :exclude)) - (i (plist-get (cdr prj) :include)) - (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or - (and - i (member filename - (mapcar - (lambda (file) (expand-file-name file b)) - i))) - (and - (not (and e (string-match e filename))) - (string-match xm filename))) - (setq project-name (car prj)) - (throw 'p-found project-name)))))) - (when up - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj))))) - (assoc project-name org-publish-project-alist))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Pluggable publishing back-end functions - -(defun org-publish-org-to (format plist filename pub-dir) - "Publish an org file to FORMAT. -PLIST is the property list for the given project. -FILENAME is the filename of the org file to be published. -PUB-DIR is the publishing directory." - (require 'org) - (unless (file-exists-p pub-dir) - (make-directory pub-dir t)) - (let ((visiting (find-buffer-visiting filename))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file filename))) - (let* ((plist (cons :buffer-will-be-killed (cons t plist))) - (init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - export-buf-or-file) - ;; run hooks before exporting - (run-hooks 'org-publish-before-export-hook) - ;; export the possibly modified buffer - (setq export-buf-or-file - (funcall (intern (concat "org-export-as-" format)) - (plist-get plist :headline-levels) - plist nil - (plist-get plist :body-only) - pub-dir)) - (when (and (bufferp export-buf-or-file) - (buffer-live-p export-buf-or-file)) - (set-buffer export-buf-or-file) - ;; run hooks after export and save export - (progn (run-hooks 'org-publish-after-export-hook) - (if (buffer-modified-p) (save-buffer))) - (kill-buffer export-buf-or-file)) - ;; maybe restore buffer's content - (set-buffer init-buf) - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - (unless visiting - (kill-buffer init-buf)))))) - -(defmacro org-publish-with-aux-preprocess-maybe (&rest body) - "Execute BODY with a modified hook to preprocess for index." - `(let ((org-export-preprocess-after-headline-targets-hook - (if (plist-get project-plist :makeindex) - (cons 'org-publish-aux-preprocess - org-export-preprocess-after-headline-targets-hook) - org-export-preprocess-after-headline-targets-hook))) - ,@body)) -(def-edebug-spec org-publish-with-aux-preprocess-maybe (body)) - -(defvar project-plist) -(defun org-publish-org-to-latex (plist filename pub-dir) - "Publish an org file to LaTeX. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latex" plist filename pub-dir))) - -(defun org-publish-org-to-pdf (plist filename pub-dir) - "Publish an org file to PDF (via LaTeX). -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "pdf" plist filename pub-dir))) - -(defun org-publish-org-to-html (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "html" plist filename pub-dir))) - -(defun org-publish-org-to-org (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "org" plist filename pub-dir)) - -(defun org-publish-org-to-ascii (plist filename pub-dir) - "Publish an org file to ASCII. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "ascii" plist filename pub-dir))) - -(defun org-publish-org-to-latin1 (plist filename pub-dir) - "Publish an org file to Latin-1. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latin1" plist filename pub-dir))) - -(defun org-publish-org-to-utf8 (plist filename pub-dir) - "Publish an org file to UTF-8. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "utf8" plist filename pub-dir))) - -(defun org-publish-attachment (plist filename pub-dir) - "Publish a file with no transformation of any kind. -See `org-publish-org-to' to the list of arguments." - ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename - (expand-file-name (file-name-nondirectory filename) pub-dir) - t))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices - -(defun org-publish-file (filename &optional project no-cache) - "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." - (let* ((project - (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) - (project-plist (cdr project)) - (ftname (expand-file-name filename)) - (publishing-function - (or (plist-get project-plist :publishing-function) - 'org-publish-org-to-html)) - (base-dir - (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir - (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) - - (unless no-cache - (org-publish-initialize-cache (car project))) - - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) - (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f base-dir))) - publishing-function) - (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) - (funcall publishing-function project-plist filename tmp-pub-dir) - (org-publish-update-timestamp - filename pub-dir publishing-function base-dir))) - (unless no-cache (org-publish-write-cache-file)))) - -(defun org-publish-projects (projects) - "Publish all files belonging to the PROJECTS alist. -If :auto-sitemap is set, publish the sitemap too. -If :makeindex is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* - ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) file) - (when preparation-function (run-hooks 'preparation-function)) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - (while (setq file (pop files)) - (org-publish-file file project t)) - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - (plist-get project-plist :base-directory)) - (org-publish-file (expand-file-name - "theindex.org" - (plist-get project-plist :base-directory)) - project t)) - (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) - -(defun org-publish-org-sitemap (project &optional sitemap-filename) - "Create a sitemap of pages in set defined by PROJECT. -Optionally set the filename of the sitemap with SITEMAP-FILENAME. -Default for SITEMAP-FILENAME is 'sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) - file sitemap-buffer) - (with-current-buffer (setq sitemap-buffer - (or visiting (find-file sitemap-filename))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry org-sitemap-file-entry-format - file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file))) - title) - (with-current-buffer buffer - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist)))) - (setq title - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting - (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. -If FILE provides a #+date keyword use it else use the file -system's modification time. - -It returns time in `current-time' format." - (let ((visiting (find-buffer-visiting file))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t))) - (let* ((plist (org-infile-export-plist)) - (date (plist-get plist :date))) - (unless visiting - (kill-buffer (current-buffer))) - (if date - (org-time-string-to-time date) - (when (file-exists-p file) - (nth 5 (file-attributes file)))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Interactive publishing functions - -;;;###autoload -(defalias 'org-publish-project 'org-publish) - -;;;###autoload -(defun org-publish (project &optional force) - "Publish PROJECT." - (interactive - (list - (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - current-prefix-arg)) - (setq org-publish-initial-buffer (current-buffer)) - (save-window-excursion - (let* ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects - (if (stringp project) - ;; If this function is called in batch mode, - ;; project is still a string here. - (list (assoc project org-publish-project-alist)) - (list project)))))) - -;;;###autoload -(defun org-publish-all (&optional force) - "Publish all projects. -With prefix argument, remove all files in the timestamp -directory and force publishing all files." - (interactive "P") - (when force - (org-publish-remove-all-timestamps)) - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects org-publish-project-alist)))) - -;;;###autoload -(defun org-publish-current-file (&optional force) - "Publish the current file. -With prefix argument, force publish the file." - (interactive "P") - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-file (buffer-file-name))))) - -;;;###autoload -(defun org-publish-current-project (&optional force) - "Publish the project associated with the current file. -With a prefix argument, force publishing of all files in -the project." - (interactive "P") - (save-window-excursion - (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up)) - (org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (if (not project) - (error "File %s is not part of any known project" (buffer-file-name))) - ;; FIXME: force is not used here? - (org-publish project)))) - - -;;; Index generation - -(defun org-publish-aux-preprocess () - "Find index entries and write them to an .orgx file." - (let ((case-fold-search t) - entry index target) - (goto-char (point-min)) - (while - (and - (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (> (match-end 1) (match-beginning 1))) - (setq entry (match-string 1)) - (when (eq org-export-current-backend 'latex) - (replace-match (format "\\index{%s}" entry) t t)) - (save-excursion - (ignore-errors (org-back-to-heading t)) - (setq target (get-text-property (point) 'target)) - (setq target (or (cdr (assoc target org-export-preferred-target-alist)) - (cdr (assoc target org-export-id-target-alist)) - target "")) - (push (cons entry target) index))) - (with-temp-file - (concat - (file-name-directory org-current-export-file) "." - (file-name-sans-extension - (file-name-nondirectory org-current-export-file)) ".orgx") - (dolist (entry (nreverse index)) - (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) - -(defun org-publish-index-generate-theindex (directory) - "Generate the index from all .orgx files in DIRECTORY." - (require 'find-lisp) - (let* ((fulldir (file-name-as-directory - (expand-file-name directory))) - (full-files (find-lisp-find-files directory "\\.orgx\\'")) - (re (concat "\\`" fulldir)) - (files (mapcar (lambda (f) (if (string-match re f) - (substring f (match-end 0)) - f)) - full-files)) - (default-directory directory) - index origfile buf target entry ibuffer - main last-main letter last-letter file sub link tgext) - ;; `files' contains the list of relative file names - (dolist (file files) - (setq origfile - (concat (file-name-directory file) - (substring (file-name-nondirectory file) 1 -1))) - (setq buf (find-file-noselect file)) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t) - (setq target (match-string 1) - entry (match-string 2)) - (push (list entry origfile target) index))) - (kill-buffer buf)) - (setq index (sort index (lambda (a b) (string< (downcase (car a)) - (downcase (car b)))))) - (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) - (with-current-buffer ibuffer - (erase-buffer) - (insert "* Index\n") - (setq last-letter nil) - (dolist (idx index) - (setq entry (car idx) file (nth 1 idx) target (nth 2 idx)) - (if (and (stringp target) (string-match "\\S-" target)) - (setq tgext (concat "::#" target)) - (setq tgext "")) - (setq letter (upcase (substring entry 0 1))) - (when (not (equal letter last-letter)) - (insert "** " letter "\n") - (setq last-letter letter)) - (if (string-match "!" entry) - (setq main (substring entry 0 (match-beginning 0)) - sub (substring entry (match-end 0))) - (setq main nil sub nil last-main nil)) - (when (and main (not (equal main last-main))) - (insert " - " main "\n") - (setq last-main main)) - (setq link (concat "[[file:" file tgext "]" - "[" (or sub entry) "]]")) - (if (and main sub) - (insert " - " link "\n") - (insert " - " link "\n"))) - (save-buffer)) - (kill-buffer ibuffer) - ;; Create theindex.org if it doesn't exist already - (let ((index-file (expand-file-name "theindex.org" directory))) - (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) - -;; Caching functions: - -(defun org-publish-write-cache-file (&optional free-cache) - "Write `org-publish-cache' to file. -If FREE-CACHE, empty the cache." - (or org-publish-cache - (error "`org-publish-write-cache-file' called, but no cache present")) - - (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (or cache-file - (error "Cannot find cache-file name in `org-publish-write-cache-file'")) - (with-temp-file cache-file - (let ((print-level nil) - (print-length nil)) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") - (maphash (lambda (k v) - (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) - org-publish-cache))) - (when free-cache (org-publish-reset-cache)))) - -(defun org-publish-initialize-cache (project-name) - "Initialize the projects cache if not initialized yet and return it." - - (or project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) - - (unless (file-exists-p org-publish-timestamp-directory) - (make-directory org-publish-timestamp-directory t)) - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory)) - - (unless (and org-publish-cache - (string= (org-publish-cache-get ":project:") project-name)) - (let* ((cache-file (concat - (expand-file-name org-publish-timestamp-directory) - project-name - ".cache")) - (cexists (file-exists-p cache-file))) - - (when org-publish-cache - (org-publish-reset-cache)) - - (if cexists - (load-file cache-file) - (setq org-publish-cache - (make-hash-table :test 'equal :weakness nil :size 100)) - (org-publish-cache-set ":project:" project-name) - (org-publish-cache-set ":cache-file:" cache-file)) - (unless cexists (org-publish-write-cache-file nil)))) - org-publish-cache) - -(defun org-publish-reset-cache () - "Empty org-publish-cache and reset it nil." - (message "%s" "Resetting org-publish-cache") - (if (hash-table-p org-publish-cache) - (clrhash org-publish-cache)) - (setq org-publish-cache nil)) - -(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) - "Check the timestamp of the last publishing of FILENAME. -Return `t', if the file needs publishing. The function also -checks if any included files have been more recently published, -so that the file including them will be republished as well." - (or org-publish-cache - (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) - (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-publish-cache-get key)) - (visiting (find-buffer-visiting filename)) - (case-fold-search t) - included-files-ctime buf) - - (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) - ;; FIXME don't kill current buffer - (unless visiting (kill-buffer buf))) - (if (null pstamp) - t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) - included-files-ctime)))))))))) - -(defun org-publish-cache-set-file-property (filename property value &optional project-name) - "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. -Use cache file of PROJECT-NAME. If the entry does not exist, it will be -created. Return VALUE." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename))) - (if pl - (progn - (plist-put pl property value) - value) - (org-publish-cache-get-file-property - filename property value nil project-name)))) - -(defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) - "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY or -DEFAULT, if the value does not yet exist. -If the entry will be created, unless NO-CREATE is not nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) - (retval nil)) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) - -(defun org-publish-cache-get (key) - "Return the value stored in `org-publish-cache' for key KEY. -Returns nil, if no value or nil is found, or the cache does not -exist." - (or org-publish-cache - (error "`org-publish-cache-get' called, but no cache present")) - (gethash key org-publish-cache)) - -(defun org-publish-cache-set (key value) - "Store KEY VALUE pair in `org-publish-cache'. -Returns value on success, else nil." - (or org-publish-cache - (error "`org-publish-cache-set' called, but no cache present")) - (puthash key value org-publish-cache)) - -(defun org-publish-cache-ctime-of-src (file) - "Get the ctime of filename F as an integer." - (let ((attr (file-attributes - (expand-file-name (or (file-symlink-p file) file) - (file-name-directory file))))) - (+ (lsh (car (nth 5 attr)) 16) - (cadr (nth 5 attr))))) - -(provide 'org-publish) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-publish.el ends here diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el deleted file mode 100644 index cb1fdbbb933..00000000000 --- a/lisp/org/org-remember.el +++ /dev/null @@ -1,1156 +0,0 @@ -;;; org-remember.el --- Fast note taking in Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the system to take fast notes with Org-mode. -;; This system is used together with John Wiegley's `remember.el'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-compat) -(require 'org-datetree) - -(declare-function remember-mode "remember" ()) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(declare-function remember-finalize "remember" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defvar remember-save-after-remembering) -(defvar remember-register) -(defvar remember-buffer) -(defvar remember-handler-functions) -(defvar remember-annotation-functions) -(defvar org-clock-heading) -(defvar org-clock-heading-for-remember) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-remember-store-without-prompt t - "Non-nil means \\\\[org-remember-finalize] \ -stores the remember note without further prompts. -It then uses the file and headline specified by the template or (if the -template does not specify them) by the variables `org-default-notes-file' -and `org-remember-default-headline'. To force prompting anyway, use -\\[universal-argument] \\[org-remember-finalize] to file the note. - -When this variable is nil, \\[org-remember-finalize] gives you the prompts, and -\\[universal-argument] \\[org-remember-finalize] triggers the fast track." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-interactive-interface 'refile - "The interface to be used for interactive filing of remember notes. -This is only used when the interactive mode for selecting a filing -location is used (see the variable `org-remember-store-without-prompt'). -Allowed values are: -outline The interface shows an outline of the relevant file - and the correct heading is found by moving through - the outline or by searching with incremental search. -outline-path-completion Headlines in the current buffer are offered via - completion. -refile Use the refile interface, and offer headlines, - possibly from different buffers." - :group 'org-remember - :type '(choice - (const :tag "Refile" refile) - (const :tag "Outline" outline) - (const :tag "Outline-path-completion" outline-path-completion))) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When non-nil, this is a list of (up to) 6-element lists. In each entry, -the first element is the name of the template, which should be a single -short word. The second element is a character, a unique key to select -this template. The third element is the template. - -The fourth element is optional and can specify a destination file for -remember items created with this template. The default file is given -by `org-default-notes-file'. If the file name is not an absolute path, -it will be interpreted relative to `org-directory'. - -An optional fifth element can specify the headline in that file that should -be offered first when the user is asked to file the entry. The default -headline is given in the variable `org-remember-default-headline'. When -this element is `top' or `bottom', the note will be placed as a level-1 -entry at the beginning or end of the file, respectively. - -An optional sixth element specifies the contexts in which the template -will be offered to the user. This element can be a list of major modes -or a function, and the template will only be offered if `org-remember' -is called from a mode in the list, or if the function returns t. -Templates that specify t or nil for the context will always be added -to the list of selectable templates. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{PROMPT} prompt the user for a string and replace this sequence with it. - A default value and a completion table can be specified like this: - %^{prompt|default|completion2|completion3|...} - The arrow keys access a prompt-specific history. - %a annotation, normally the link created with `org-store-link' - %A like %a, but prompt for the description part - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %c current kill ring head - %x content of the X clipboard - %:keyword specific information for certain link types, see below - %^C interactive selection of which kill or clip to use - %^L like %^C, but insert as link - %k title of the currently clocked task - %K link to the currently clocked task - %^g prompt for tags, completing tags in the target file - %^G prompt for tags, completing all tags in all agenda files - %^{PROP}p Prompt the user for a value for property PROP - %[PATHNAME] insert the contents of the file given by PATHNAME - %(SEXP) evaluate elisp `(SEXP)' and replace with the result - %! store this note immediately after completing the template\ - \\ - (skipping the \\[org-remember-finalize] that normally triggers storing) - %& jump to target location immediately after storing note - %? after completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:fromname and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields and - | %:org-date (the Date: header in Org format) -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have at least 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(nil))) - ((= (length x) 3) (append x '(nil nil))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice :tag "Destination file" - (file :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-default-notes-file'" nil)) - (choice :tag "Destin. headline" - (string :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "At beginning of file" top) - (const :tag "At end of file" bottom) - (const :tag "In a date tree" date-tree)) - (choice :tag "Context" - (const :tag "Use in all contexts" nil) - (const :tag "Use in all contexts" t) - (repeat :tag "Use only if in major mode" - (symbol :tag "Major mode")) - (function :tag "Perform a check against function"))))) - -(defcustom org-remember-delete-empty-lines-at-end t - "Non-nil means clean up final empty lines in remember buffer." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-before-finalize-hook nil - "Hook that is run right before a remember process is finalized. -The remember buffer is still current when this hook runs." - :group 'org-remember - :type 'hook) - -(defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for `org-remember-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used -for a Remember buffer.") -(defvar org-remember-mode-hook nil - "Hook for the minor `org-remember-mode'.") - -(define-minor-mode org-remember-mode - "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map - (run-hooks 'org-remember-mode-hook)) -(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) -(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) - -(defcustom org-remember-clock-out-on-exit 'query - "Non-nil means stop the clock when exiting a clocking remember buffer. -This only applies if the clock is running in the remember buffer. If the -clock is not stopped, it continues to run in the storage location. -Instead of nil or t, this may also be the symbol `query' to prompt the -user each time a remember buffer with a running clock is filed away." - :group 'org-remember - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Query user" query))) - -(defcustom org-remember-backup-directory nil - "Directory where to store all remember buffers, for backup purposes. -After a remember buffer has been stored successfully, the backup file -will be removed. However, if you forget to finish the remember process, -the file will remain there. -See also `org-remember-auto-remove-backup-files'." - :group 'org-remember - :type '(choice - (const :tag "No backups" nil) - (directory :tag "Directory"))) - -(defcustom org-remember-auto-remove-backup-files t - "Non-nil means remove remember backup files after successfully storage. -When remember is finished successfully, with storing the note at the -desired target, remove the backup files related to this remember process -and show a message about remaining backup files, from previous, unfinished -remember sessions. -Backup files will only be made at all, when `org-remember-backup-directory' -is set." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-warn-about-backups t - "Non-nil means warn about backup files in `org-remember-backup-directory'. - -Set this to nil if you find that you don't need the warning. - -If you cancel remember calls frequently and know when they -contain useful information (because you know that you made an -error or Emacs crashed, for example) nil is more useful. In the -opposite case, the default, t, is more useful." - :group 'org-remember - :type 'boolean) - -;;;###autoload -(defun org-remember-insinuate () - "Setup remember.el for use with Org-mode." - (org-require-remember) - (setq remember-annotation-functions '(org-remember-annotation)) - (setq remember-handler-functions '(org-remember-handler)) - (add-hook 'remember-mode-hook 'org-remember-apply-template)) - -;;;###autoload -(defun org-remember-annotation () - "Return a link to the current location as an annotation for remember.el. -If you are using Org-mode files as target for data storage with -remember.el, then the annotations should include a link compatible with the -conventions in Org-mode. This function returns such a link." - (org-store-link nil)) - -(defconst org-remember-help - "Select a destination location for the note. -UP/DOWN=headline TAB=cycle visibility [Q]uit RET//=Store -RET on headline -> Store as sublevel entry to current headline -RET at beg-of-buf -> Append to file as level 2 headline -/ -> before/after current headline, same headings level") - -(defvar org-jump-to-target-location nil) -(defvar org-remember-previous-location nil) -(defvar org-remember-reference-date nil) -(defvar org-force-remember-template-char) ;; dynamically scoped - -;; Save the major mode of the buffer we called remember from -(defvar org-select-template-temp-major-mode nil) - -;; Temporary store the buffer where remember was called from -(defvar org-select-template-original-buffer nil) - -(defun org-select-remember-template (&optional use-char) - (when org-remember-templates - (let* ((pre-selected-templates - (mapcar - (lambda (tpl) - (let ((ctxt (nth 5 tpl)) - (mode org-select-template-temp-major-mode) - (buf org-select-template-original-buffer)) - (and (or (not ctxt) (eq ctxt t) - (and (listp ctxt) (memq mode ctxt)) - (and (functionp ctxt) - (with-current-buffer buf - ;; Protect the user-defined function from error - (condition-case nil (funcall ctxt) (error nil))))) - tpl))) - org-remember-templates)) - ;; If no template at this point, add the default templates: - (pre-selected-templates1 - (if (not (delq nil pre-selected-templates)) - (mapcar (lambda(x) (if (not (nth 5 x)) x)) - org-remember-templates) - pre-selected-templates)) - ;; Then unconditionally add template for any contexts - (pre-selected-templates2 - (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x)) - org-remember-templates) - (delq nil pre-selected-templates1))) - (templates (mapcar (lambda (x) - (if (stringp (car x)) - (append (list (nth 1 x) (car x)) (cddr x)) - (append (list (car x) "") (cdr x)))) - (delq nil pre-selected-templates2))) - msg - (char (or use-char - (cond - ((= (length templates) 1) - (caar templates)) - ((and (boundp 'org-force-remember-template-char) - org-force-remember-template-char) - (if (stringp org-force-remember-template-char) - (string-to-char org-force-remember-template-char) - org-force-remember-template-char)) - (t - (setq msg (format - "Select template: %s%s" - (mapconcat - (lambda (x) - (cond - ((not (string-match "\\S-" (nth 1 x))) - (format "[%c]" (car x))) - ((equal (downcase (car x)) - (downcase (aref (nth 1 x) 0))) - (format "[%c]%s" (car x) - (substring (nth 1 x) 1))) - (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " ") - (if (assoc ?C templates) - "" - " [C]customize templates"))) - (let ((inhibit-quit t) char0) - (while (not char0) - (message msg) - (setq char0 (read-char-exclusive)) - (when (and (not (assoc char0 templates)) - (not (equal char0 ?\C-g)) - (not (equal char0 ?C))) - (message "No such template \"%c\"" char0) - (ding) (sit-for 1) - (setq char0 nil))) - (when (equal char0 ?\C-g) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (error "Abort")) - (when (not (assoc char0 templates)) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (customize-variable 'org-remember-templates) - (error "Customize templates")) - char0)))))) - (cddr (assoc char templates))))) - -;;;###autoload -(defun org-remember-apply-template (&optional use-char skip-interactive) - "Initialize *remember* buffer with template, invoke `org-mode'. -This function should be placed into `remember-mode-hook' and in fact requires -to be run from that hook to function properly." - (when (and (boundp 'initial) (stringp initial)) - (setq initial (org-no-properties initial))) - (if org-remember-templates - (let* ((entry (org-select-remember-template use-char)) - (ct (or org-overriding-default-time (org-current-time))) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (tpl (car entry)) - (plist-p (if org-store-link-plist t nil)) - (file (if (and (nth 1 entry) - (or (and (stringp (nth 1 entry)) - (string-match "\\S-" (nth 1 entry))) - (functionp (nth 1 entry)))) - (nth 1 entry) - org-default-notes-file)) - (headline (nth 2 entry)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) - (v-x (or (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' are bound in `remember'. - ;; But if the property list has them, we prefer those values - (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) (symbol-value 'initial)) - "")) - (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) (symbol-value 'annotation)) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) - (v-A (if (and v-a - (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) - (replace-match "[\\1[%^{Link description}]]" nil nil v-a) - v-a)) - (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) - (v-K (if (marker-buffer org-clock-marker) - (org-make-link-string - (buffer-file-name (marker-buffer org-clock-marker)) - org-clock-heading))) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar) - - (when (functionp file) - (setq file (funcall file))) - (when (functionp headline) - (setq headline (funcall headline))) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - - (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) - (erase-buffer) - (insert (substitute-command-keys - (format - "# %s \"%s\" -> \"* %s\" -# C-u C-c C-c like C-c C-c, and immediately visit note at target location -# C-0 C-c C-c \"%s\" -> \"* %s\" -# %s to select file and header location interactively. -# C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item -# To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n" - (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c") - (abbreviate-file-name (or file org-default-notes-file)) - (or headline "") - (or (car org-remember-previous-location) "???") - (or (cdr org-remember-previous-location) "???") - (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c")))) - (insert tpl) - - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-remember-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn't insert %s: %s]" - filename error))))))) - ;; Simple %-escapes - (goto-char (point-min)) - (let ((init (and (boundp 'initial) - (symbol-value 'initial)))) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and init (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string init "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)))) - - ;; %() embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\((.+)\\)" nil t) - (unless (org-remember-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let ((result - (condition-case error - (eval (read (current-buffer))) - (error (format "%%![Error: %s]" error))))) - (delete-region template-start (point)) - (insert result))))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) - - ;; Turn on org-mode in the remember buffer, set local variables - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) - (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (org-set-local 'org-default-notes-file file)) - (if headline - (org-set-local 'org-remember-default-headline headline)) - (org-set-local 'org-remember-reference-date - (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-remember-escaped-%) - (setq char (if (match-end 3) (match-string 3)) - prompt (if (match-end 2) (match-string 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-remember-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") (org-agenda-files) (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (let* - ((prop (org-no-properties prompt)) - (pall (concat prop "_ALL")) - (allowed - (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (or (cdr (assoc pall org-file-properties)) - (cdr (assoc pall org-global-properties)) - (cdr (assoc pall org-global-properties-fixed))))) - (existing (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (mapcar 'list (org-property-values prop)))) - (propprompt (concat "Value for " prop ": ")) - (val (if allowed - (org-completing-read - propprompt - (mapcar 'list (org-split-string allowed "[ \t]+")) - nil 'req-match) - (org-completing-read-no-i propprompt existing nil nil - "" nil "")))) - (org-set-property prop val))) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) "U") t nil - prompt)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (insert (org-without-partial-completion - (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default)))))))) - - (goto-char (point-min)) - (if (re-search-forward "%\\?" nil t) - (replace-match "") - (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%&" nil t)) - (replace-match "") - (org-set-local 'org-jump-to-target-location t)) - (when org-remember-backup-directory - (unless (file-directory-p org-remember-backup-directory) - (make-directory org-remember-backup-directory)) - (org-set-local 'auto-save-file-name-transforms nil) - (setq buffer-file-name - (expand-file-name - (format-time-string "remember-%Y-%m-%d-%H-%M-%S") - org-remember-backup-directory)) - (save-buffer) - (org-set-local 'auto-save-visited-file-name t) - (auto-save-mode 1)) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%!" nil t)) - (replace-match "") - (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) - -(defun org-remember-escaped-% () - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - - -(defun org-remember-finish-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (remove-hook 'post-command-hook 'org-remember-finish-immediately) - (org-remember-finalize)) - -(defun org-remember-visit-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (org-remember '(16)) - (goto-char (or (text-property-any - (point) (save-excursion (org-end-of-subtree t t)) - 'org-position-cursor t) - (point))) - (message "%s" - (format - (substitute-command-keys - "Restore window configuration with \\[jump-to-register] %c") - remember-register))) - -(defvar org-clock-marker) ; Defined in org.el -(defun org-remember-finalize () - "Finalize the remember process." - (interactive) - (unless org-remember-mode - (error "This does not seem to be a remember buffer for Org-mode")) - (run-hooks 'org-remember-before-finalize-hook) - (unless (fboundp 'remember-finalize) - (defalias 'remember-finalize 'remember-buffer)) - (when (and org-clock-marker - (equal (marker-buffer org-clock-marker) (current-buffer))) - ;; the clock is running in this buffer. - (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) - (or (eq org-remember-clock-out-on-exit t) - (and org-remember-clock-out-on-exit - (y-or-n-p "The clock is running in this buffer. Clock out now? ")))) - (let (org-log-note-clock-out) (org-clock-out)))) - (when buffer-file-name - (do-auto-save)) - (remember-finalize)) - -(defun org-remember-kill () - "Abort the current remember process." - (interactive) - (let ((org-note-abort t)) - (org-remember-finalize))) - -;;;###autoload -(defun org-remember (&optional goto org-force-remember-template-char) - "Call `remember'. If this is already a remember buffer, re-apply template. -If there is an active region, make sure remember uses it as initial content -of the remember buffer. - -When called interactively with a \\[universal-argument] \ -prefix argument GOTO, don't remember -anything, just go to the file/headline where the selected template usually -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last -note stored by remember. - -Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character -associated with a template in `org-remember-templates'." - (interactive "P") - (org-require-remember) - (cond - ((equal goto '(4)) (org-go-to-remember-target)) - ((equal goto '(16)) (org-remember-goto-last-stored)) - (t - ;; set temporary variables that will be needed in - ;; `org-select-remember-template' - (setq org-select-template-temp-major-mode major-mode) - (setq org-select-template-original-buffer (current-buffer)) - (if org-remember-mode - (progn - (when (< (length org-remember-templates) 2) - (error "No other template available")) - (erase-buffer) - (let ((annotation (plist-get org-store-link-plist :annotation)) - (initial (plist-get org-store-link-plist :initial))) - (org-remember-apply-template)) - (message "Press C-c C-c to remember data")) - (if (org-region-active-p) - (org-do-remember (buffer-substring (point) (mark))) - (org-do-remember)))))) - -(defvar org-remember-last-stored-marker (make-marker) - "Marker pointing to the entry most recently stored with `org-remember'.") - -(defun org-remember-goto-last-stored () - "Go to the location where the last remember note was stored." - (interactive) - (org-goto-marker-or-bmk org-remember-last-stored-marker - "org-remember-last-stored") - (message "This is the last note stored by remember")) - -(defun org-go-to-remember-target (&optional template-key) - "Go to the target location of a remember template. -The user is queried for the template." - (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-select-remember-template template-key)) - (file (nth 1 entry)) - (heading (nth 2 entry)) - visiting) - (unless (and file (stringp file) (string-match "\\S-" file)) - (setq file org-default-notes-file)) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - (unless (and heading (stringp heading) (string-match "\\S-" heading)) - (setq heading org-remember-default-headline)) - (setq visiting (org-find-base-buffer-visiting file)) - (if (not visiting) (find-file-noselect file)) - (org-pop-to-buffer-same-window (or visiting (get-file-buffer file))) - (widen) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format (regexp-quote heading)) - nil t) - (goto-char (match-beginning 0)) - (error "Target headline not found: %s" heading)))) - -;; FIXME (bzg): let's clean up of final empty lines happen only once -;; (see the org-remember-delete-empty-lines-at-end option below) -;;;###autoload -(defun org-remember-handler () - "Store stuff from remember.el into an org file. -When the template has specified a file and a headline, the entry is filed -there, or in the location defined by `org-default-notes-file' and -`org-remember-default-headline'. -\\ -If no defaults have been defined, or if the current prefix argument -is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive -process is used to select the target location. - -When the prefix is 0 (i.e. when remember is exited with \ -C-0 \\[org-remember-finalize]), -the entry is filed to the same location as the previous note. - -When the prefix is 2 (i.e. when remember is exited with \ -C-2 \\[org-remember-finalize]), -the entry is filed as a subentry of the entry where the clock is -currently running. - -When \\[universal-argument] has been used as prefix argument, the -note is stored and Emacs moves point to the new location of the -note, so that editing can be continued there (similar to -inserting \"%&\" into the template). - -Before storing the note, the function ensures that the text has an -org-mode-style headline, i.e. a first line that starts with -a \"*\". If not, a headline is constructed from the current date and -some additional data. - -If the variable `org-adapt-indentation' is non-nil, the entire text is -also indented so that it starts in the same column as the headline -\(i.e. after the stars). - -See also the variable `org-reverse-note-order'." - (when (and (equal current-prefix-arg 2) - (not (marker-buffer org-clock-marker))) - (error "No running clock")) - (when (org-bound-and-true-p org-jump-to-target-location) - (let* ((end (min (point-max) (1+ (point)))) - (beg (point))) - (if (= end beg) (setq beg (1- beg))) - (put-text-property beg end 'org-position-cursor t))) - (goto-char (point-min)) - (while (looking-at "^[ \t]*\n\\|^# .*\n") - (replace-match "")) - (when org-remember-delete-empty-lines-at-end - (goto-char (point-max)) - (beginning-of-line 1) - (while (and (looking-at "[ \t]*$\\|[ \t]*# .*") (> (point) 1)) - (delete-region (1- (point)) (point-max)) - (beginning-of-line 1))) - (catch 'quit - (if org-note-abort (throw 'quit t)) - (let* ((visitp (org-bound-and-true-p org-jump-to-target-location)) - (backup-file - (and buffer-file-name - (equal (file-name-directory buffer-file-name) - (file-name-as-directory - (expand-file-name org-remember-backup-directory))) - (string-match "^remember-[0-9]\\{4\\}" - (file-name-nondirectory buffer-file-name)) - buffer-file-name)) - - (dummy - (unless (string-match "\\S-" (buffer-string)) - (message "Nothing to remember") - (and backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (set-buffer-modified-p nil) - (throw 'quit t))) - (reference-date org-remember-reference-date) - (previousp (and (member current-prefix-arg '((16) 0)) - org-remember-previous-location)) - (clockp (equal current-prefix-arg 2)) - (clocksp (equal current-prefix-arg 3)) - (fastp (org-xor (equal current-prefix-arg 1) - org-remember-store-without-prompt)) - (file (cond - (fastp org-default-notes-file) - ((and (eq org-remember-interactive-interface 'refile) - org-refile-targets) - org-default-notes-file) - ((not previousp) - (org-get-org-file)))) - (heading org-remember-default-headline) - (visiting (and file (org-find-base-buffer-visiting file))) - (org-startup-folded nil) - (org-startup-align-all-tables nil) - (org-goto-start-pos 1) - spos exitcmd level reversed txt text-before-node-creation) - (when (equal current-prefix-arg '(4)) - (setq visitp t)) - (when previousp - (setq file (car org-remember-previous-location) - visiting (and file (org-find-base-buffer-visiting file)) - heading (cdr org-remember-previous-location) - fastp t)) - (when (or clockp clocksp) - (setq file (buffer-file-name (marker-buffer org-clock-marker)) - visiting (and file (org-find-base-buffer-visiting file)) - heading org-clock-heading-for-remember - fastp t)) - (setq current-prefix-arg nil) - ;; Modify text so that it becomes a nice subtree which can be inserted - ;; into an org tree. - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "[ \t\n]+\\'" nil t) - ;; remove empty lines at end - (replace-match ""))) - (goto-char (point-min)) - (setq text-before-node-creation (buffer-string)) - (unless (looking-at org-outline-regexp) - ;; add a headline - (insert (concat "* " (current-time-string) - " (" (remember-buffer-desc) ")\n")) - (backward-char 1) - (when org-adapt-indentation - (while (re-search-forward "^" nil t) - (insert " ")))) - ;; Delete final empty lines - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) - (replace-match "\n\n") - (if (re-search-forward "[ \t\n]*\\'") - (replace-match "\n")))) - (goto-char (point-min)) - (setq txt (buffer-string)) - (org-save-markers-in-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (when (and (eq org-remember-interactive-interface 'refile) - (not fastp)) - (org-refile nil (or visiting (find-file-noselect file))) - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (save-excursion - (bookmark-jump "org-refile-last-stored") - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (throw 'quit t)) - ;; Find the file - (with-current-buffer (or visiting (find-file-noselect file)) - (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom))) - (error "Target files for notes must be in Org-mode if not filing to top/bottom")) - (save-excursion - (save-restriction - (widen) - (setq reversed (org-notes-order-reversed-p)) - - ;; Find the default location - (when heading - (cond - ((not (derived-mode-p 'org-mode)) - (if (eq heading 'top) - (goto-char (point-min)) - (goto-char (point-max)) - (or (bolp) (newline))) - (insert text-before-node-creation) - (when remember-save-after-remembering - (save-buffer) - (if (not visiting) (kill-buffer (current-buffer)))) - (throw 'quit t)) - ((eq heading 'top) - (goto-char (point-min)) - (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp nil t)) - (setq org-goto-start-pos (or (match-beginning 0) (point-min)))) - ((eq heading 'bottom) - (goto-char (point-max)) - (or (bolp) (newline)) - (setq org-goto-start-pos (point))) - ((eq heading 'date-tree) - (org-datetree-find-date-create reference-date) - (setq reversed nil) - (setq org-goto-start-pos (point))) - ((and (stringp heading) (string-match "\\S-" heading)) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) - nil t) - (setq org-goto-start-pos (match-beginning 0)) - (when fastp - (goto-char (point-max)) - (unless (bolp) (newline)) - (insert "* " heading "\n") - (setq org-goto-start-pos (point-at-bol 0))))) - (t (goto-char (point-min)) (setq org-goto-start-pos (point) - heading 'top)))) - - ;; Ask the User for a location, using the appropriate interface - (cond - ((and fastp (memq heading '(top bottom))) - (setq spos org-goto-start-pos - exitcmd (if (eq heading 'top) 'left nil))) - (fastp (setq spos org-goto-start-pos - exitcmd 'return)) - ((eq org-remember-interactive-interface 'outline) - (setq spos (org-get-location (current-buffer) - org-remember-help) - exitcmd (cdr spos) - spos (car spos))) - ((eq org-remember-interactive-interface 'outline-path-completion) - (let ((org-refile-targets '((nil . (:maxlevel . 10)))) - (org-refile-use-outline-path t)) - (setq spos (org-refile-get-location "Heading") - exitcmd 'return - spos (nth 3 spos)))) - (t (error "This should not happen"))) - (if (not spos) (throw 'quit nil)) ; return nil to show we did - ; not handle this note - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (goto-char spos) - (cond ((org-at-heading-p t) - (org-back-to-heading t) - (setq level (funcall outline-level)) - (cond - ((eq exitcmd 'return) - ;; sublevel of current - (setq org-remember-previous-location - (cons (abbreviate-file-name file) - (org-get-heading 'notags))) - (if reversed - (outline-next-heading) - (org-end-of-subtree t) - (if (not (bolp)) - (if (looking-at "[ \t]*\n") - (beginning-of-line 2) - (end-of-line 1) - (insert "\n")))) - (org-paste-subtree (if clocksp - level - (org-get-valid-level level 1)) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'left) - ;; before current - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'right) - ;; after current - (org-end-of-subtree t) - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (t (error "This should not happen")))) - - ((eq heading 'bottom) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - - ((and (bobp) (not reversed)) - ;; Put it at the end, one level below level 1 - (save-restriction - (widen) - (goto-char (point-max)) - (if (not (bolp)) (newline)) - (org-paste-subtree (org-get-valid-level 1 1) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - ((and (bobp) reversed) - ;; Put it at the start, as level 1 - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward org-outline-regexp-bol nil t) - (beginning-of-line 1) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - (t - ;; Put it right there, with automatic level determined by - ;; org-paste-subtree or from prefix arg - (org-paste-subtree - (if (numberp current-prefix-arg) current-prefix-arg) - txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - (when remember-save-after-remembering - (save-buffer) - (if (and (not visiting) - (not (equal (marker-buffer org-clock-marker) - (current-buffer)))) - (kill-buffer (current-buffer)))) - (when org-remember-auto-remove-backup-files - (when backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (when org-remember-backup-directory - (let ((n (length - (directory-files - org-remember-backup-directory nil - "^remember-.*[0-9]$")))) - (when (and org-remember-warn-about-backups - (> n 0)) - (message - "%d backup files (unfinished remember calls) in %s" - n org-remember-backup-directory)))))))))) - - t) ;; return t to indicate that we took care of this note. - -(defun org-do-remember (&optional initial) - "Call remember." - (remember initial)) - -(defun org-require-remember () - "Make sure remember is loaded, or install our own emergency version of it." - (condition-case nil - (require 'remember) - (error - ;; Lets install our own micro version of remember - (defvar remember-register ?R) - (defvar remember-mode-hook nil) - (defvar remember-handler-functions nil) - (defvar remember-buffer "*Remember*") - (defvar remember-save-after-remembering t) - (defvar remember-annotation-functions '(buffer-file-name)) - (defun remember-finalize () - (run-hook-with-args-until-success 'remember-handler-functions) - (when (equal remember-buffer (buffer-name)) - (kill-buffer (current-buffer)) - (jump-to-register remember-register))) - (defun remember-mode () - (fundamental-mode) - (setq mode-name "Remember") - (run-hooks 'remember-mode-hook)) - (defun remember (&optional initial) - (window-configuration-to-register remember-register) - (let* ((annotation (run-hook-with-args-until-success - 'remember-annotation-functions))) - (switch-to-buffer-other-window (get-buffer-create remember-buffer)) - (remember-mode))) - (defun remember-buffer-desc () - (buffer-substring (point-min) (save-excursion (goto-char (point-min)) - (point-at-eol))))))) - -(provide 'org-remember) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-remember.el ends here diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index e2f9fbeef60..6859b659dde 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -1,6 +1,6 @@ ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -95,7 +95,10 @@ (defun org-rmail-follow-link (folder article) "Follow an Rmail link to FOLDER and ARTICLE." (require 'rmail) - (setq article (org-add-angle-brackets article)) + (cond ((null article) (setq article "")) + ((stringp article) + (setq article (org-add-angle-brackets article))) + (t (user-error "Wrong RMAIL link format"))) (let (message-number) (save-excursion (save-window-excursion @@ -105,8 +108,7 @@ (rmail-widen) (goto-char (point-max)) (if (re-search-backward - (concat "^Message-ID:\\s-+" (regexp-quote - (or article ""))) + (concat "^Message-ID:\\s-+" (regexp-quote article)) nil t) (rmail-what-message)))))) (if message-number diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el deleted file mode 100644 index bbf5fef4bc1..00000000000 --- a/lisp/org/org-special-blocks.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; org-special-blocks.el --- handle Org special blocks -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Chris Gray - -;; 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 . - -;;; Commentary: -;; - -;; This package generalizes the #+begin_foo and #+end_foo tokens. - -;; To use, put the following in your init file: -;; -;; (require 'org-special-blocks) - -;; The tokens #+begin_center, #+begin_verse, etc. existed previously. -;; This package generalizes them (at least for the LaTeX and html -;; exporters). When a #+begin_foo token is encountered by the LaTeX -;; exporter, it is expanded into \begin{foo}. The text inside the -;; environment is not protected, as text inside environments generally -;; is. When #+begin_foo is encountered by the html exporter, a div -;; with class foo is inserted into the HTML file. It is up to the -;; user to add this class to his or her stylesheet if this div is to -;; mean anything. - -(require 'org-html) -(require 'org-compat) - -(declare-function org-open-par "org-html" ()) -(declare-function org-close-par-maybe "org-html" ()) - -(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$" - "A regexp indicating the names of blocks that should be ignored -by org-special-blocks. These blocks will presumably be -interpreted by other mechanisms.") - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-special-blocks-make-special-cookies () - "Adds special cookies when #+begin_foo and #+end_foo tokens are -seen. This is run after a few special cases are taken care of." - (when (or (eq org-export-current-backend 'html) - (eq org-export-current-backend 'latex)) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) - (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (concat "ORG-" (match-string 2) "-START") - (concat "ORG-" (match-string 2) "-END")) - t t))))) - -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-special-blocks-make-special-cookies) - -(defun org-special-blocks-convert-latex-special-cookies () - "Converts the special cookies into LaTeX blocks." - (goto-char (point-min)) - (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t) - (replace-match - (if (equal (match-string 3) "START") - (concat "\\begin{" (match-string 1) "}" (match-string 2)) - (concat "\\end{" (match-string 1) "}")) - t t))) - - -(add-hook 'org-export-latex-after-blockquotes-hook - 'org-special-blocks-convert-latex-special-cookies) - -(defvar org-line) -(defun org-special-blocks-convert-html-special-cookies () - "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `org-line'. - (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)) - (message "%s" (match-string 1)) - (when (equal (match-string 2 org-line) "START") - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par)) - (when (equal (match-string 2 org-line) "END") - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par)) - (throw 'nextline nil))) - -(add-hook 'org-export-html-after-blockquotes-hook - 'org-special-blocks-convert-html-special-cookies) - -(provide 'org-special-blocks) - -;;; org-special-blocks.el ends here diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 501d30ab1d7..b8d7c672be9 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -1,9 +1,9 @@ ;;; org-src.el --- Source code examples in Org ;; -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik -;; Bastien Guerry +;; Bastien Guerry ;; Dan Davison ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org @@ -64,6 +64,30 @@ there are kept outside the narrowed region." (const :tag "from `lang' element") (const :tag "from `style' element"))))) +(defcustom org-edit-src-turn-on-auto-save nil + "Non-nil means turn `auto-save-mode' on when editing a source block. +This will save the content of the source code editing buffer into +a newly created file, not the base buffer for this source block. + +If you want to regularly save the base buffer instead of the source +code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-edit-src-auto-save-idle-delay 0 + "Delay before saving a source code buffer back into its base buffer. +When a positive integer N, save after N seconds of idle time. +When 0 (the default), don't auto-save. + +If you want to save the source code buffer itself, don't use this. +Check `org-edit-src-turn-on-auto-save' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + (defcustom org-coderef-label-format "(ref:%s)" "The default coderef format. This format string will be used to search for coderef labels in literal @@ -155,7 +179,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) - ("calc" . fundamental) ("C" . c) ("cpp" . c++) + ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) ("screen" . shell-script)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should @@ -174,6 +198,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort) (define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) @@ -186,11 +211,15 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-edit-src-block-indentation nil) (defvar org-edit-src-saved-temp-window-config nil) -(defvar org-src-ask-before-returning-to-edit-buffer t +(defcustom org-src-ask-before-returning-to-edit-buffer t "If nil, when org-edit-src code is used on a block that already has an active edit buffer, it will switch to that edit buffer immediately; otherwise it will ask whether you want to return to -the existing edit buffer.") +the existing edit buffer." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) (defvar org-src-babel-info nil) @@ -202,6 +231,7 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") +(defvar org-edit-src-code-timer nil) (defun org-edit-src-code (&optional context code edit-buffer-name) "Edit the source CODE block at point. The code is copied to a separate buffer and the appropriate mode @@ -241,8 +271,8 @@ the display of windows containing the Org buffer and the code buffer." end (move-marker end (nth 1 info)) msg (if allow-write-back-p (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)") - "Exit with C-c ' (C-c and single quote)") + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort") + "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort") code (or code (buffer-substring-no-properties beg end)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) (nth 2 info)) @@ -336,12 +366,33 @@ the display of windows containing the Org buffer and the code buffer." (org-src-mode) (set-buffer-modified-p nil) (setq buffer-file-name nil) + (when org-edit-src-turn-on-auto-save + (setq buffer-auto-save-file-name + (concat (make-temp-name "org-src-") + (format-time-string "-%Y-%d-%m") ".txt"))) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) (when (fboundp edit-prep-func) - (funcall edit-prep-func full-info)))) - t))) + (funcall edit-prep-func full-info))) + (or org-edit-src-code-timer + (setq org-edit-src-code-timer + (unless (zerop org-edit-src-auto-save-idle-delay) + (run-with-idle-timer + org-edit-src-auto-save-idle-delay t + (lambda () + (cond + ((and (string-match "\*Org Src" (buffer-name)) + (buffer-modified-p)) + (org-edit-src-save)) + ((not + (delq nil (mapcar + (lambda (b) + (string-match "\*Org Src" (buffer-name b))) + (buffer-list)))) + (cancel-timer org-edit-src-code-timer) + (setq org-edit-src-code-timer))))))))) + t))) (defun org-edit-src-continue (e) "Continue editing source blocks." ;; Fixme: be more accurate @@ -420,7 +471,7 @@ the fragment in the Org-mode buffer." (col (current-column)) (case-fold-search t) (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")) (org-mode-p (derived-mode-p 'org-mode)) (beg (make-marker)) (end (make-marker)) @@ -520,10 +571,8 @@ the language, a switch telling if the content should be in a single line." ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") - ("^[ \t]*#\\+docbook:" "\n" "xml" single-line) ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" "\n" "fundamental" macro-definition) - ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml") ))) (pos (point)) re1 re2 single beg end lang lfmt match-re1 ind entry) @@ -699,14 +748,19 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (if (eq context 'save) (save-buffer) + (with-current-buffer buffer + (set-buffer-modified-p nil)) (kill-buffer buffer)) (goto-char beg) (when allow-write-back-p - (delete-region beg (max beg end)) - (unless (string-match "\\`[ \t]*\\'" code) - (insert code)) - (goto-char beg) - (if single (just-one-space))) + (let ((buffer-undo-list t)) + (delete-region beg (max beg end)) + (unless (string-match "\\`[ \t]*\\'" code) + (insert code)) + ;; Make sure the overlay stays in place + (when (eq context 'save) (move-overlay ovl beg (point))) + (goto-char beg) + (if single (just-one-space)))) (if (memq t (mapcar (lambda (overlay) (eq (overlay-get overlay 'invisible) 'org-hide-block)) @@ -714,16 +768,26 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." ;; Block is hidden; put point at start of block (beginning-of-line 0) ;; Block is visible, put point where it was in the code buffer - (org-goto-line (1- (+ (org-current-line) line))) - (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))) + (when allow-write-back-p + (org-goto-line (1- (+ (org-current-line) line))) + (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))) (unless (eq context 'save) (move-marker beg nil) (move-marker end nil))) + (when org-edit-src-code-timer + (cancel-timer org-edit-src-code-timer) + (setq org-edit-src-code-timer nil)) (unless (eq context 'save) (when org-edit-src-saved-temp-window-config (set-window-configuration org-edit-src-saved-temp-window-config) (setq org-edit-src-saved-temp-window-config nil)))) +(defun org-edit-src-abort () + "Abort editing of the src code and return to the Org buffer." + (interactive) + (let (org-edit-src-allow-write-back-p) + (org-edit-src-exit 'exit))) + (defmacro org-src-in-org-buffer (&rest body) `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) (save-window-excursion @@ -743,9 +807,11 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (defun org-edit-src-save () "Save parent buffer with current state source-code buffer." (interactive) - (org-src-in-org-buffer (save-buffer))) + (if (string-match "Fixed Width" (buffer-name)) + (user-error "Use C-c ' to save and exit, C-c C-k to abort editing") + (org-src-in-org-buffer (save-buffer)))) -(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang)) +(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang)) (defun org-src-tangle (arg) "Tangle the parent buffer." @@ -778,8 +844,9 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (let ((session (cdr (assoc :session (nth 2 info))))) (and session (not (string= session "none")) (org-babel-comint-buffer-livep session) - ((lambda (f) (and (fboundp f) (funcall f session))) - (intern (format "org-babel-%s-associate-session" (nth 0 info))))))) + (let ((f (intern (format "org-babel-%s-associate-session" + (nth 0 info))))) + (and (fboundp f) (funcall f session)))))) (defun org-src-babel-configure-edit-buffer () (when org-src-babel-info @@ -829,9 +896,9 @@ issued in the language major mode buffer." (defun org-src-native-tab-command-maybe () "Perform language-specific TAB action. -Alter code block according to effect of TAB in the language major -mode." +Alter code block according to what TAB does in the language major mode." (and org-src-tab-acts-natively + (org-in-src-block-p) (not (equal this-command 'org-shifttab)) (let ((org-src-strip-leading-and-trailing-blank-lines nil)) (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) @@ -887,8 +954,9 @@ fontification of code blocks see `org-src-fontify-block' and LANG is a string, and the returned major mode is a symbol." (intern (concat - ((lambda (l) (if (symbolp l) (symbol-name l) l)) - (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) + (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) + (if (symbolp l) (symbol-name l) l)) + "-mode"))) (provide 'org-src) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 00b2eb4d028..261d62f9625 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1,6 +1,6 @@ ;;; org-table.el --- The table editor for Org-mode -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -38,13 +38,11 @@ (require 'cl)) (require 'org) -(declare-function org-table-clean-before-export "org-exp" - (lines &optional maybe-quoted)) -(declare-function org-format-org-table-html "org-html" (lines &optional splice)) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) (declare-function aa2u "ext:ascii-art-to-unicode" ()) (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar org-export-html-table-tag) ; defined in org-exp.el (defvar constants-unit-system) (defvar org-table-follow-field-mode) @@ -54,6 +52,8 @@ This can be used to add additional functionality after the table is sent to the receiver position, otherwise, if table is not sent, the functions are not run.") +(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") + (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) "Non-nil means use the optimized table editor version for `orgtbl-mode'. In the optimized version, the table editor takes over all simple keys that @@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective." | | | ")) "Templates for radio tables in different major modes. +Each template must define lines that will be treated as a comment and that +must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" +lines where \"%n\" will be replaced with the name of the table during +insertion of the template. The transformed table will later be inserted +between these lines. + +The template should also contain a minimal table in a multiline comment. +If multiline comments are not possible in the buffer language, +you can pack it into a string that will not be used when the code +is compiled or executed. Above the table will you need a line with +the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to +convert the table into a data structure useful in the +language of the buffer. Check the manual for the section on +\"Translator functions\", and more generally check out +http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax + All occurrences of %n in a template will be replaced with the name of the table, obtained by prompting the user." :group 'org-table @@ -112,7 +128,7 @@ table, obtained by prompting the user." :type 'string) (defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" "Regular expression for recognizing numbers in table columns. If a table column contains mostly numbers, it will be aligned to the right. If not, it will be aligned to the left. @@ -136,10 +152,10 @@ Other options offered by the customize interface are more restrictive." "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") (const :tag "Exponential, Floating point, Integer" "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (const :tag "Very General Number-Like, including hex, allows comma as decimal mark" - "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") (string :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 @@ -419,6 +435,40 @@ available parameters." (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) +(defvar org-table-clean-did-remove-column nil) ; dynamically scoped +(defun org-table-clean-before-export (lines &optional maybe-quoted) + "Check if the table has a marking column. +If yes remove the column and the special lines." + (let ((special (if maybe-quoted + "^[ \t]*| *\\\\?[\#!$*_^/ ] *|" + "^[ \t]*| *[\#!$*_^/ ] *|")) + (ignore (if maybe-quoted + "^[ \t]*| *\\\\?[!$_^/] *|" + "^[ \t]*| *[!$_^/] *|"))) + (setq org-table-clean-did-remove-column + (not (memq nil + (mapcar + (lambda (line) + (or (string-match org-table-hline-regexp line) + (string-match special line))) + lines)))) + (delq nil + (mapcar + (lambda (line) + (cond + ((or (org-table-colgroup-line-p line) ;; colgroup info + (org-table-cookie-line-p line) ;; formatting cookies + (and org-table-clean-did-remove-column + (string-match ignore line))) ;; non-exportable data + nil) + ((and org-table-clean-did-remove-column + (or (string-match "^\\([ \t]*\\)|-+\\+" line) + (string-match "^\\([ \t]*\\)|[^|]*|" line))) + ;; remove the first column + (replace-match "\\1|" t nil line)) + (t line))) + lines)))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -503,7 +553,7 @@ nil When nil, the command tries to be smart and figure out the - when each line contains a TAB, assume TAB-separated material - when each line contains a comma, assume CSV material - else, assume one or more SPACE characters as separator." - (interactive "rP") + (interactive "r\nP") (let* ((beg (min beg0 end0)) (end (max beg0 end0)) re) @@ -539,7 +589,7 @@ nil When nil, the command tries to be smart and figure out the ((equal separator '(16)) "^\\|\t") ((integerp separator) (if (< separator 1) - (error "Number of spaces in separator must be >= 1") + (user-error "Number of spaces in separator must be >= 1") (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) (t (error "This should not happen")))) (while (re-search-forward re end t) @@ -579,9 +629,7 @@ whether it is set locally or up in the hierarchy, then on the extension of the given file name, and finally on the variable `org-table-export-default-format'." (interactive) - (unless (org-at-table-p) - (error "No table at point")) - (require 'org-exp) + (unless (org-at-table-p) (user-error "No table at point")) (org-table-align) ;; make sure we have everything we need (let* ((beg (org-table-begin)) (end (org-table-end)) @@ -598,13 +646,13 @@ extension of the given file name, and finally on the variable (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort"))) + (user-error "File not written"))) (if (file-directory-p file) - (error "This is a directory path, not a file")) + (user-error "This is a directory path, not a file")) (if (and (buffer-file-name) (equal (file-truename file) (file-truename (buffer-file-name)))) - (error "Please specify a file name that is different from current")) + (user-error "Please specify a file name that is different from current")) (setq fileext (concat (file-name-extension file) "$")) (unless format (setq deffmt-readable @@ -641,7 +689,7 @@ extension of the given file name, and finally on the variable skipcols i0))) (unless (fboundp transform) - (error "No such transformation function %s" transform)) + (user-error "No such transformation function %s" transform)) (setq txt (funcall transform table params)) (with-current-buffer (find-file-noselect file) @@ -652,7 +700,7 @@ extension of the given file name, and finally on the variable (save-buffer)) (kill-buffer buf) (message "Export done.")) - (error "TABLE_EXPORT_FORMAT invalid")))) + (user-error "TABLE_EXPORT_FORMAT invalid")))) (defvar org-table-aligned-begin-marker (make-marker) "Marker at the beginning of the table last aligned. @@ -760,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (error (kill-region beg end) (org-table-create org-table-default-size) - (error "Empty table - created default table"))) + (user-error "Empty table - created default table"))) ;; A list of empty strings to fill any short rows on output (setq emptystrings (make-list maxfields "")) ;; Check for special formatting. @@ -787,7 +835,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" + (user-error "Cannot narrow field starting with wide link \"%s\"" (match-string 0 xx))) (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) (add-text-properties (- f1 2) f1 @@ -860,12 +908,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (org-goto-line winstartline) (setq winstart (point-at-bol)) (org-goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) + (when (eq (window-buffer (selected-window)) (current-buffer)) + (set-window-start (selected-window) winstart 'noforce)) (org-table-goto-column colpos) (and org-table-overlay-coordinates (org-table-overlay-coordinates)) (setq org-table-may-need-update nil) )) +;;;###autoload (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. With argument TABLE-TYPE, go to the beginning of a table.el-type table." @@ -879,6 +929,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table." (beginning-of-line 2) (point)))) +;;;###autoload (defun org-table-end (&optional table-type) "Find the end of the table and return its position. With argument TABLE-TYPE, go to the end of a table.el-type table." @@ -978,7 +1029,7 @@ Before doing so, re-align the table if necessary." (progn (re-search-backward "|" (org-table-begin)) (re-search-backward "|" (org-table-begin))) - (error (error "Cannot move to previous table field"))) + (error (user-error "Cannot move to previous table field"))) (while (looking-at "|\\(-\\|[ \t]*$\\)") (re-search-backward "|" (org-table-begin))) (if (looking-at "| ?") @@ -994,7 +1045,7 @@ With numeric argument N, move N-1 fields forward first." (setq n (1- n)) (org-table-previous-field)) (if (not (re-search-backward "|" (point-at-bol 0) t)) - (error "No more table fields before the current") + (user-error "No more table fields before the current") (goto-char (match-end 0)) (and (looking-at " ") (forward-char 1))) (if (>= (point) pos) (org-table-beginning-of-field 2)))) @@ -1055,7 +1106,7 @@ copying. In the case of a timestamp, increment by one day." (interactive "p") (let* ((colpos (org-table-current-column)) (col (current-column)) - (field (org-table-get-field)) + (field (save-excursion (org-table-get-field))) (non-empty (string-match "[^ \t]" field)) (beg (org-table-begin)) (orig-n n) @@ -1091,7 +1142,7 @@ copying. In the case of a timestamp, increment by one day." (org-table-maybe-recalculate-line)) (org-table-align) (org-move-to-column col)) - (error "No non-empty field found")))) + (user-error "No non-empty field found")))) (defun org-table-check-inside-data-field (&optional noerror) "Is point inside a table data field? @@ -1103,7 +1154,7 @@ This actually throws an error, so it aborts the current command." (looking-at "[ \t]*$")) (if noerror nil - (error "Not in table data field")) + (user-error "Not in table data field")) t)) (defvar org-table-clip nil @@ -1150,6 +1201,7 @@ Return t when the line exists, nil if it does not exist." (< (setq cnt (1+ cnt)) N))) (= cnt N))) +;;;###autoload (defun org-table-blank-field () "Blank the current table field or active region." (interactive) @@ -1286,7 +1338,7 @@ However, when FORCE is non-nil, create new columns if necessary." "Insert a new column into the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (let* ((col (max 1 (org-table-current-column))) (beg (org-table-begin)) @@ -1326,7 +1378,7 @@ However, when FORCE is non-nil, create new columns if necessary." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t - (error + (user-error "Please position cursor in a data line for column operations"))))) (defun org-table-line-to-dline (line &optional above) @@ -1356,7 +1408,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Delete a column from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1400,7 +1452,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Move the current column to the right. With arg LEFT, move to the left." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1411,9 +1463,9 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (linepos (org-current-line)) (colpos (if left (1- col) (1+ col)))) (if (and left (= col 1)) - (error "Cannot move column further left")) + (user-error "Cannot move column further left")) (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) + (user-error "Cannot move column further right")) (goto-char beg) (while (< (point) end) (if (org-at-table-hline-p) @@ -1461,7 +1513,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (beginning-of-line tonew) (unless (org-at-table-p) (goto-char pos) - (error "Cannot move row further")) + (user-error "Cannot move row further")) (setq hline2p (looking-at org-table-hline-regexp)) (goto-char pos) (beginning-of-line 1) @@ -1486,7 +1538,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." With prefix ARG, insert below the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) (new (org-table-clean-line line))) ;; Fix the first field if necessary @@ -1508,7 +1560,7 @@ With prefix ARG, insert below the current line." With prefix ABOVE, insert above the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (when (eobp) (insert "\n") (backward-char 1)) (if (not (string-match "|[ \t]*$" (org-current-line-string))) (org-table-align)) @@ -1558,7 +1610,7 @@ In particular, this does handle wide and invisible characters." "Delete the current row or horizontal line from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let ((col (current-column)) (dline (org-table-current-dline))) (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) @@ -1710,7 +1762,7 @@ the table is enlarged as needed. The process ignores horizontal separator lines." (interactive) (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) + (user-error "First cut/copy a region to paste!")) (org-table-check-inside-data-field) (let* ((clip org-table-clip) (line (org-current-line)) @@ -1796,11 +1848,16 @@ will be transposed as Note that horizontal lines disappeared." (interactive) - (let ((contents - (apply #'mapcar* #'list - ;; remove 'hline from list - (delq nil (mapcar (lambda (x) (when (listp x) x)) - (org-table-to-lisp)))))) + (let* ((table (delete 'hline (org-table-to-lisp))) + (contents (mapcar (lambda (p) + (let ((tp table)) + (mapcar + (lambda (rown) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) (delete-region (org-table-begin) (org-table-end)) (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) contents "")) @@ -1839,7 +1896,7 @@ blank, and the content is appended to the field above." nlines) (org-table-cut-region (region-beginning) (region-end)) (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) + (user-error "Region must be limited to single column")) (setq nlines (if arg (if (< arg 1) (+ (length org-table-clip) arg) @@ -2008,12 +2065,12 @@ If NLAST is a number, only the NLAST fields will actually be summed." (setq col (org-table-current-column)) (goto-char (org-table-begin)) (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq beg (point)) (goto-char (org-table-end)) (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq end (point)))) (let* ((items (apply 'append (org-table-copy-region beg end))) @@ -2031,7 +2088,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." h (floor (/ diff 3600)) diff (mod diff 3600) m (floor (/ diff 60)) diff (mod diff 60) s diff) - (format "%d:%02d:%02d" h m s)))) + (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) (if (org-called-interactively-p 'interactive) (message "%s" @@ -2098,7 +2155,7 @@ When NAMED is non-nil, look for a named equation." (int-to-string (org-table-current-column)))) (dummy (and (or nameass refass) (not named) (not (y-or-n-p "Replace existing field formula with column formula? " )) - (error "Abort"))) + (message "Formula not replaced"))) (name (or name ref)) (org-table-may-need-update nil) (stored (cdr (assoc scol stored-list))) @@ -2122,7 +2179,7 @@ When NAMED is non-nil, look for a named equation." ;; remove formula (setq stored-list (delq (assoc scol stored-list) stored-list)) (org-table-store-formulas stored-list) - (error "Formula removed")) + (user-error "Formula removed")) (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) (if (and name (not named)) @@ -2207,7 +2264,7 @@ When NAMED is non-nil, look for a named equation." (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) (ding) (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) + (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) (push scol seen)))))) (nreverse eq-alist))) @@ -2217,33 +2274,35 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (goto-char (org-table-end)) - (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) - (let ((msg "The formulas in #+TBLFM have been updated") - (re (concat key "\\([0-9]+\\)")) - (re2 - (when remove - (if (or (equal key "$") (equal key "$LR")) - (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" - (regexp-quote key) remove) - (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) - s n a) - (when remove - (while (re-search-forward re2 (point-at-eol) t) + (let ((case-fold-search t) + (s-end (save-excursion (re-search-forward "^\\S-*$\\|\\'" nil t)))) + (while (re-search-forward "[ \t]*#\\+tblfm:" s-end t) + (let ((msg "The formulas in #+TBLFM have been updated") + (re (concat key "\\([0-9]+\\)")) + (re2 + (when remove + (if (or (equal key "$") (equal key "$LR")) + (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" + (regexp-quote key) remove) + (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) + s n a) + (when remove + (while (re-search-forward re2 (point-at-eol) t) + (unless (save-match-data (org-in-regexp "remote([^)]+?)")) + (if (equal (char-before (match-beginning 0)) ?.) + (user-error "Change makes TBLFM term %s invalid, use undo to recover" + (match-string 0)) + (replace-match ""))))) + (while (re-search-forward re (point-at-eol) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) - (if (equal (char-before (match-beginning 0)) ?.) - (error "Change makes TBLFM term %s invalid, use undo to recover" - (match-string 0)) - (replace-match ""))))) - (while (re-search-forward re (point-at-eol) t) - (unless (save-match-data (org-in-regexp "remote([^)]+?)")) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t) - (message msg)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t) - (message msg))))))))) + (setq s (match-string 1) n (string-to-number s)) + (cond + ((setq a (assoc s replace)) + (replace-match (concat key (cdr a)) t t) + (message msg)) + ((and limit (> n limit)) + (replace-match (concat key (int-to-string (+ n delta))) t t) + (message msg)))))))))) (defun org-table-get-specials () "Get the column names and local parameters for this table." @@ -2338,7 +2397,7 @@ If yes, store the formula and apply it." (equal (substring eq 0 (min 2 (length eq))) "'(")) (org-table-eval-formula (if named '(4) nil) (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) (defvar org-recalc-commands nil "List of commands triggering the recalculation of a line. @@ -2363,7 +2422,7 @@ after prompting for the marking character. After each change, a message will be displayed indicating the meaning of the new mark." (interactive) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) (beg (org-table-begin)) (end (org-table-end)) @@ -2382,13 +2441,13 @@ of the new mark." (setq newchar (char-to-string (read-char-exclusive)) forcenew (car (assoc newchar org-recalc-marks)))) (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" + (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" newchar)) (if l1 (org-goto-line l1)) (save-excursion (beginning-of-line 1) (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) + (user-error "Not at a table data line"))) (unless have-col (org-table-goto-column 1) (org-table-insert-column) @@ -2483,7 +2542,7 @@ not overwrite the stored one." (or suppress-analysis (org-table-get-specials)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) + (or eq (user-error "No equation active for current field")) (org-table-get-field nil eq) (org-table-align) (setq org-table-may-need-update t)) @@ -2557,7 +2616,10 @@ not overwrite the stored one." fields))) (if (eq numbers t) (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) + (lambda (x) + (if (string-match "\\S-" x) + (number-to-string (string-to-number x)) + x)) fields))) (setq ndown (1- ndown)) (setq form (copy-sequence formula) @@ -2612,7 +2674,7 @@ not overwrite the stored one." (if (not (save-match-data (string-match (regexp-quote form) formrpl))) (setq form (replace-match formrpl t t form)) - (error "Spreadsheet error: invalid reference \"%s\"" form))) + (user-error "Spreadsheet error: invalid reference \"%s\"" form))) ;; Insert simple ranges (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) (setq form @@ -2630,11 +2692,12 @@ not overwrite the stored one." (setq n (+ (string-to-number (match-string 1 form)) (if (match-end 2) n0 0)) x (nth (1- (if (= n 0) n0 (max n 1))) fields)) - (unless x (error "Invalid field specifier \"%s\"" + (unless x (user-error "Invalid field specifier \"%s\"" (match-string 0 form))) (setq form (replace-match (save-match-data - (org-table-make-reference x nil numbers lispp)) + (org-table-make-reference + x keep-empty numbers lispp)) t t form))) (if lispp @@ -2646,12 +2709,23 @@ not overwrite the stored one." (string-to-number ev) duration-output-format) ev)) (or (fboundp 'calc-eval) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - ;; "Inactivate" time-stamps so that Calc can handle them + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) + ;; Use <...> time-stamps so that Calc can handle them (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) + ;; I18n-ize local time-stamps by setting (system-time-locale "C") + (when (string-match org-ts-regexp2 form) + (let* ((ts (match-string 0 form)) + (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) + (system-time-locale "C") + (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (cdr org-time-stamp-formats)) + (car org-time-stamp-formats)))) + (setq form (replace-match (format-time-string tf tsp) t t form)))) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form - (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) + (calc-eval (cons form org-tbl-calc-modes) + (when (and (not keep-empty) numbers) 'num))) ev (if duration (org-table-time-seconds-to-string (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) (string-to-number (org-table-time-string-to-seconds ev)) @@ -2667,7 +2741,7 @@ $xyz-> %s @r$c-> %s $1-> %s\n" orig formula form0 form)) (if (listp ev) - (princ (format " %s^\nError: %s" + (princ (format " %s^\nError: %s" (make-string (car ev) ?\-) (nth 1 ev))) (princ (format "Result: %s\nFormat: %s\nFinal: %s" ev (or fmt "NONE") @@ -2678,7 +2752,7 @@ $1-> %s\n" orig formula form0 form)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) - (error "Abort")) + (user-error "Abort")) (delete-window bw) (message ""))) (if (listp ev) (setq fmt nil ev "#ERROR")) @@ -2716,7 +2790,7 @@ in the buffer and column1 and column2 are table column numbers." (let ((thisline (org-current-line)) beg end c1 c2 r1 r2 rangep tmp) (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) + (user-error "Invalid table range specifier `%s'" desc)) (setq rangep (match-end 3) r1 (and (match-end 1) (match-string 1 desc)) r2 (and (match-end 4) (match-string 4 desc)) @@ -2784,7 +2858,7 @@ and TABLE is a vector with line types." ;; 1 2 3 4 5 6 (and (not (match-end 3)) (not (match-end 6))) (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "Invalid row descriptor `%s'" desc)) + (user-error "Invalid row descriptor `%s'" desc)) (let* ((hdir (and (match-end 2) (match-string 2 desc))) (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) (odir (and (match-end 5) (match-string 5 desc))) @@ -2798,7 +2872,7 @@ and TABLE is a vector with line types." (setq i 0 hdir "+") (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) (if (and (not hn) on (not odir)) - (error "Should never happen");;(aref org-table-dlines on) + (user-error "Should never happen");;(aref org-table-dlines on) (if (and hn (> hn 0)) (setq i (org-table-find-row-type table i 'hline (equal hdir "-") nil hn cline desc))) @@ -2818,41 +2892,56 @@ and TABLE is a vector with line types." (cond ((eq org-table-relative-ref-may-cross-hline t) t) ((eq org-table-relative-ref-may-cross-hline 'error) - (error "Row descriptor %s used in line %d crosses hline" desc cline)) + (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) (t (setq i (- i (if backwards -1 1)) n 1) nil)) t))) (setq n (1- n))) (if (or (< i 0) (>= i l)) - (error "Row descriptor %s used in line %d leads outside table" + (user-error "Row descriptor %s used in line %d leads outside table" desc cline) i))) (defun org-table-rewrite-old-row-references (s) (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") + (user-error "Formula contains old &row reference, please rewrite using @-syntax") s)) (defun org-table-make-reference (elements keep-empty numbers lispp) "Convert list ELEMENTS to something appropriate to insert into formula. KEEP-EMPTY indicated to keep empty fields, default is to skip them. NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val +LISPP non-nil means to return something appropriate for a Lisp +list, 'literal is for the format specifier L." + ;; Calc nan (not a number) is used for the conversion of the empty + ;; field to a reference for several reasons: (i) It is accepted in a + ;; Calc formula (e. g. "" or "()" would result in a Calc error). + ;; (ii) In a single field (not in range) it can be distinguished + ;; from "(nan)" which is the reference made from a single field + ;; containing "nan". + (if (stringp elements) + ;; field reference (if lispp (if (eq lispp 'literal) elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (setq elements (number-to-string (string-to-number elements)))) - (concat "(" elements ")")) + (if (and (eq elements "") (not keep-empty)) + "" + (prin1-to-string + (if numbers (string-to-number elements) elements)))) + (if (string-match "\\S-" elements) + (progn + (when numbers (setq elements (number-to-string + (string-to-number elements)))) + (concat "(" elements ")")) + (if (or (not keep-empty) numbers) "(0)" "nan"))) + ;; range reference (unless keep-empty (setq elements (delq nil (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) elements)))) - (setq elements (or elements '("0"))) + (setq elements (or elements '())) ; if delq returns nil then we need '() (if lispp (mapconcat (lambda (x) @@ -2862,10 +2951,32 @@ LISPP means to return something appropriate for a Lisp list." elements " ") (concat "[" (mapconcat (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) + (if (string-match "\\S-" x) + (if numbers + (number-to-string (string-to-number x)) + x) + (if (or (not keep-empty) numbers) "0" "nan"))) elements ",") "]")))) +;;;###autoload +(defun org-table-set-constants () + "Set `org-table-formula-constants-local' in the current buffer." + (let (cst consts const-str) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) + (setq const-str (substring-no-properties (match-string 1))) + (setq consts (append consts (org-split-string const-str "[ \t]+"))) + (when consts + (let (e) + (while (setq e (pop consts)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (if (assoc-string (match-string 1 e) cst) + (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))))))) + ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. @@ -2879,7 +2990,7 @@ known that the table will be realigned a little later anyway." (interactive "P") (or (memq this-command org-recalc-commands) (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) (org-table-get-specials) @@ -2902,7 +3013,7 @@ known that the table will be realigned a little later anyway." (car x)) 1) (cdr x))) (if (assoc (car x) eqlist1) - (error "\"%s=\" formula tries to overwrite existing formula for column %s" + (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" lhs1 (car x)))) (cons (org-table-formula-handle-first/last-rc (car x)) @@ -2947,7 +3058,7 @@ known that the table will be realigned a little later anyway." (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) (nth 2 a)))) (when (member name1 seen-fields) - (error "Several field/range formulas try to set %s" name1)) + (user-error "Several field/range formulas try to set %s" name1)) (push name1 seen-fields) (and (not a) @@ -2956,7 +3067,7 @@ known that the table will be realigned a little later anyway." (condition-case nil (aref org-table-dlines (string-to-number (match-string 1 name))) - (error (error "Invalid row number in %s" + (error (user-error "Invalid row number in %s" name))) (string-to-number (match-string 2 name))))) (when (and a (or all (equal (nth 1 a) thisline))) @@ -3026,7 +3137,7 @@ with the prefix ARG." (message "Convergence after %d iterations" i) (message "Table was already stable")) (throw 'exit t))) - (error "No convergence after %d iterations" i)))) + (user-error "No convergence after %d iterations" i)))) ;;;###autoload (defun org-table-recalculate-buffer-tables () @@ -3057,7 +3168,40 @@ with the prefix ARG." (message "Convergence after %d iterations" (- imax i)) (throw 'exit t)) (setq checksum c1))) - (error "No convergence after %d iterations" imax)))))) + (user-error "No convergence after %d iterations" imax)))))) + +(defun org-table-calc-current-TBLFM (&optional arg) + "Apply the #+TBLFM in the line at point to the table." + (interactive "P") + (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) + (let ((formula (buffer-substring + (point-at-bol) + (point-at-eol))) + s e) + (save-excursion + ;; Insert a temporary formula at right after the table + (goto-char (org-table-TBLFM-begin)) + (setq s (set-marker (make-marker) (point))) + (insert (concat formula "\n")) + (setq e (set-marker (make-marker) (point))) + ;; Recalculate the table + (beginning-of-line 0) ; move to the inserted line + (skip-chars-backward " \r\n\t") + (if (org-at-table-p) + (unwind-protect + (org-call-with-arg 'org-table-recalculate (or arg t)) + ;; delete the formula inserted temporarily + (delete-region s e)))))) + +(defun org-table-TBLFM-begin () + "Find the beginning of the TBLFM lines and return its position. +Return nil when the beginning of TBLFM line was not found." + (save-excursion + (when (progn (forward-line 1) + (re-search-backward + org-table-TBLFM-begin-regexp + nil t)) + (point-at-bol 2)))) (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. @@ -3115,7 +3259,7 @@ borders of the table using the @< @> $< $> makers." len (- nmax len -1))) (if (or (< n 1) (> n nmax)) - (error "Reference \"%s\" in expression \"%s\" points outside table" + (user-error "Reference \"%s\" in expression \"%s\" points outside table" (match-string 0 s) s)) (setq start (match-beginning 0)) (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) @@ -3214,7 +3358,7 @@ Parameters get priority." (interactive) (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-get-specials) (let ((key (org-table-current-field-formula 'key 'noerror)) (eql (sort (org-table-get-stored-formulas 'noerror) @@ -3436,7 +3580,7 @@ minutes or seconds." ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") (if (memq dir '(left right)) (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) + (user-error "Cannot shift reference in this direction"))) ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") ;; A B3-like reference (if (memq dir '(up down)) @@ -3451,7 +3595,7 @@ minutes or seconds." (defun org-rematch-and-replace (n &optional decr hline) "Re-match the group N, and replace it with the shifted reference." - (or (match-end n) (error "Cannot shift reference in this direction")) + (or (match-end n) (user-error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) (replace-match (org-table-shift-refpart (match-string 0) decr hline) @@ -3487,7 +3631,7 @@ a translation reference." (org-number-to-letters (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - (t (error "Cannot shift reference")))))) + (t (user-error "Cannot shift reference")))))) (defun org-table-fedit-toggle-coordinates () "Toggle the display of coordinates in the referenced table." @@ -3519,14 +3663,14 @@ With prefix ARG, apply the new formulas to the table." (while (string-match "[ \t]*\n[ \t]*" form) (setq form (replace-match " " t t form))) (when (assoc var eql) - (error "Double formulas for %s" var)) + (user-error "Double formulas for %s" var)) (push (cons var form) eql))) (setq org-pos nil) (set-window-configuration org-window-configuration) (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulas")) + (user-error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3556,14 +3700,14 @@ With prefix ARG, apply the new formulas to the table." (call-interactively 'lisp-indent-line)) ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available")) + (user-error "Cannot pretty-print. Command `pp-buffer' is not available")) ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") (goto-char (- (match-end 0) 2)) (setq beg (point)) (setq ind (make-string (current-column) ?\ )) (condition-case nil (forward-sexp 1) (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) + (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) (setq end (point)) (save-restriction (narrow-to-region beg end) @@ -3615,7 +3759,7 @@ With prefix ARG, apply the new formulas to the table." ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) ((org-at-regexp-p "\\$[0-9]+") 'column) ((not local) nil) - (t (error "No reference at point"))) + (t (user-error "No reference at point"))) match (and what (or match (match-string 0)))) (when (and match (not (equal (match-beginning 0) (point-at-bol)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) @@ -3682,7 +3826,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) + (user-error "Column name not found"))) ((eq what 'column) ;; column number (org-table-goto-column (string-to-number (substring match 1))) @@ -3695,10 +3839,10 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Local parameter.")) - (error "Parameter not found"))) + (user-error "Parameter not found"))) (t (cond - ((not var) (error "No reference at point")) + ((not var) (user-error "No reference at point")) ((setq e (assoc var org-table-formula-constants-local)) (message "Local Constant: $%s=%s in #+CONSTANTS line." var (cdr e))) @@ -3708,7 +3852,7 @@ With prefix ARG, apply the new formulas to the table." ((setq e (and (fboundp 'constants-get) (constants-get var))) (message "Constant: $%s=%s, from `constants.el'%s." var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) + (t (user-error "Undefined name $%s" var))))) (goto-char pos) (when (and org-show-positions (not (memq this-command '(org-table-fedit-scroll @@ -3734,7 +3878,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) p1 p2))) ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) + (t (user-error "No table dataline around here")))))) (defun org-table-fedit-line-up () "Move cursor one line up in the window showing the table." @@ -3982,7 +4126,7 @@ to execute outside of tables." '(arg) (concat "In tables, run `" (symbol-name fun) "'.\n" "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") + (mapconcat #'key-description keys "' or `") "'.") '(interactive "p") (list 'if @@ -3999,7 +4143,7 @@ to execute outside of tables." (defun orgtbl-error () "Error when there is no default binding for a table key." (interactive) - (error "This key has no function outside tables")) + (user-error "This key has no function outside tables")) (defun orgtbl-setup () "Setup orgtbl keymaps." @@ -4151,7 +4295,7 @@ to execute outside of tables." If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") - (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str) + (let ((case-fold-search t) (pos (point)) action) (save-excursion (beginning-of-line 1) (setq action (cond @@ -4169,17 +4313,7 @@ With prefix arg, also recompute table." (when (orgtbl-send-table 'maybe) (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) - (setq const-str (substring-no-properties (match-string 1))) - (setq consts (append consts (org-split-string const-str "[ \t]+"))) - (when consts - (let (e) - (while (setq e (pop consts)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))))) + (org-table-set-constants) (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") @@ -4264,31 +4398,6 @@ overwritten, and the table is not marked as requiring realignment." (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") -(defun orgtbl-export (table target) - (require 'org-exp) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - (defun orgtbl-gather-send-defs () "Gather a plist of :name, :transform, :params for each destination before a radio table." @@ -4311,15 +4420,15 @@ a radio table." (save-excursion (goto-char (point-min)) (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) + (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) + (user-error "Don't know where to insert translated table")) (goto-char (match-beginning 0)) (beginning-of-line 2) (save-excursion (let ((beg (point))) (unless (re-search-forward - (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) + (concat "END +RECEIVE +ORGTBL +" name) nil t) + (user-error "Cannot find end of insertion region")) (beginning-of-line 1) (delete-region beg (point)))) (insert txt "\n"))) @@ -4332,7 +4441,7 @@ for a horizontal separator line, or a list of field values as strings. The table is taken from the parameter TXT, or from the buffer at point." (unless txt (unless (org-at-table-p) - (error "No table at point"))) + (user-error "No table at point"))) (let* ((txt (or txt (buffer-substring-no-properties (org-table-begin) (org-table-end)))) @@ -4351,7 +4460,7 @@ With argument MAYBE, fail quietly if no transformation is defined for this table." (interactive) (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) ;; when non-interactive, we assume align has just happened. (when (org-called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) @@ -4359,7 +4468,7 @@ this table." (org-table-end))) (ntbl 0)) (unless dests (if maybe (throw 'exit nil) - (error "Don't know how to transform this table"))) + (user-error "Don't know how to transform this table"))) (dolist (dest dests) (let* ((name (plist-get dest :name)) (transform (plist-get dest :transform)) @@ -4392,7 +4501,7 @@ this table." skipcols i0)) (txt (if (fboundp transform) (funcall transform table params) - (error "No such transformation function %s" transform)))) + (user-error "No such transformation function %s" transform)))) (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" @@ -4422,7 +4531,7 @@ First element has index 0, or I0 if given." (commented (save-excursion (beginning-of-line 1) (cond ((looking-at re1) t) ((looking-at re2) nil) - (t (error "Not at an org table"))))) + (t (user-error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion @@ -4440,7 +4549,7 @@ First element has index 0, or I0 if given." (let* ((e (assq major-mode orgtbl-radio-table-templates)) (txt (nth 1 e)) name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) + (unless e (user-error "No radio table setup defined for %s" major-mode)) (setq name (read-string "Table name: ")) (while (string-match "%n" txt) (setq txt (replace-match name t t txt))) @@ -4474,7 +4583,8 @@ First element has index 0, or I0 if given." fmt)) (defsubst orgtbl-apply-fmt (fmt &rest args) - "Apply format FMT to the arguments. NIL FMTs return the first argument." + "Apply format FMT to arguments ARGS. +When FMT is nil, return the first argument from ARGS." (cond ((functionp fmt) (apply fmt args)) (fmt (apply 'format fmt args)) (args (car args)) @@ -4504,7 +4614,7 @@ First element has index 0, or I0 if given." f))) line))) (push (if *orgtbl-lfmt* - (orgtbl-apply-fmt *orgtbl-lfmt* line) + (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) (concat (orgtbl-eval-str *orgtbl-lstart*) (mapconcat 'identity line *orgtbl-sep*) (orgtbl-eval-str *orgtbl-lend*))) @@ -4523,12 +4633,15 @@ First element has index 0, or I0 if given." (orgtbl-format-line prevline)))))) ;;;###autoload -(defun orgtbl-to-generic (table params) +(defun orgtbl-to-generic (table params &optional backend) "Convert the orgtbl-mode TABLE to some other format. This generic routine can be used for many standard cases. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. +A third optional argument BACKEND can be used to convert the content of +the cells using a specific export back-end. + For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). @@ -4599,22 +4712,31 @@ directly by `orgtbl-send-table'. See manual." (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) (*orgtbl-fmt* (plist-get params :fmt)) *orgtbl-rtn*) - + ;; Convert cells content to backend BACKEND + (when backend + (setq *orgtbl-table* + (mapcar + (lambda(r) + (if (listp r) + (mapcar + (lambda (c) + (org-trim (org-export-string-as c backend t '(:with-tables t)))) + r) + r)) + *orgtbl-table*))) ;; Put header (unless splicep (when (plist-member params :tstart) (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) (if tstart (push tstart *orgtbl-rtn*))))) - - ;; Do we have a heading section? If so, format it and handle the - ;; trailing hline. + ;; If we have a heading, format it and handle the trailing hline. (if (and (not splicep) (or (consp (car *orgtbl-table*)) (consp (nth 1 *orgtbl-table*))) (memq 'hline (cdr *orgtbl-table*))) (progn (when (eq 'hline (car *orgtbl-table*)) - ;; there is a hline before the first data line + ;; There is a hline before the first data line (and hline (push hline *orgtbl-rtn*)) (pop *orgtbl-table*)) (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) @@ -4632,15 +4754,12 @@ directly by `orgtbl-send-table'. See manual." (orgtbl-format-section 'hline)) (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) (pop *orgtbl-table*))) - ;; Now format the main section. (orgtbl-format-section nil) - (unless splicep (when (plist-member params :tend) (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat (if remove-newlines (lambda (tend) (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) @@ -4698,7 +4817,8 @@ this function is called." :tend "\\end{tabular}" :lstart "" :lend " \\\\" :sep " & " :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-latex) + (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) ;;;###autoload (defun orgtbl-to-html (table params) @@ -4714,22 +4834,14 @@ Currently this function recognizes the following parameters: The general parameters :skip and :skipcols have already been applied when this function is called. The function does *not* use `orgtbl-to-generic', so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - (html-table-tag org-export-html-table-tag) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) + (require 'ox-html) + (let ((output (org-export-string-as + (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) + (if (not (plist-get params :splice)) output + (org-trim + (replace-regexp-in-string + "\\`
  • \n" "" + (replace-regexp-in-string "
    \n*\\'" "" output)))))) ;;;###autoload (defun orgtbl-to-texinfo (table params) @@ -4768,7 +4880,8 @@ this function is called." :tend "@end multitable" :lstart "@item " :lend "" :sep " @tab " :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-texinfo) + (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) ;;;###autoload (defun orgtbl-to-orgtbl (table params) @@ -4815,22 +4928,22 @@ it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" "Link to ascii-art-to-unicode.el") org-stored-links)) - (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) (buffer-string))) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. -NAME-OR-ID may be the name of a table in the current file as set by -a \"#+TBLNAME:\" directive. The first table following this line +NAME-OR-ID may be the name of a table in the current file as set +by a \"#+NAME:\" directive. The first table following this line will then be used. Alternatively, it may be an ID referring to -any entry, also in a different file. In this case, the first table -in that entry will be referenced. +any entry, also in a different file. In this case, the first +table in that entry will be referenced. FORM is a field or range descriptor like \"@2$3\" or \"B3\" or \"@I$2..@II$2\". All the references must be absolute, not relative. The return value is either a single string for a single field, or a -list of the fields in the rectangle ." +list of the fields in the rectangle." (save-match-data (let ((case-fold-search t) (id-loc nil) ;; Protect a bunch of variables from being overwritten @@ -4851,12 +4964,13 @@ list of the fields in the rectangle ." (save-excursion (goto-char (point-min)) (if (re-search-forward - (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" + (regexp-quote name-or-id) "[ \t]*$") nil t) (setq buffer (current-buffer) loc (match-beginning 0)) (setq id-loc (org-id-find name-or-id 'marker)) (unless (and id-loc (markerp id-loc)) - (error "Can't find remote table \"%s\"" name-or-id)) + (user-error "Can't find remote table \"%s\"" name-or-id)) (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) @@ -4868,7 +4982,7 @@ list of the fields in the rectangle ." (forward-char 1) (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) (not (match-beginning 1))) - (error "Cannot find a table at NAME or ID %s" name-or-id)) + (user-error "Cannot find a table at NAME or ID %s" name-or-id)) (setq tbeg (point-at-bol)) (org-table-get-specials) (setq form (org-table-formula-substitute-names @@ -4879,6 +4993,38 @@ list of the fields in the rectangle ." (org-table-get-range (match-string 0 form) tbeg 1)) form))))))))) +(defmacro org-define-lookup-function (mode) + (let ((mode-str (symbol-name mode)) + (first-p (equal mode 'first)) + (all-p (equal mode 'all))) + (let ((plural-str (if all-p "s" ""))) + `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) + ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. +If R-LIST is nil, return matching element%s of S-LIST. +If PREDICATE is not nil, use it instead of `equal' to match VAL. +Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. +This function is generated by a call to the macro `org-define-lookup-function'." + mode-str plural-str plural-str plural-str) + (let ,(let ((lvars '((p (or predicate 'equal)) + (sl s-list) + (rl (or r-list s-list)) + (ret nil)))) + (if first-p (add-to-list 'lvars '(match-p nil))) + lvars) + (while ,(if first-p '(and (not match-p) sl) 'sl) + (progn + (if (funcall p val (car sl)) + (progn + ,(if first-p '(setq match-p t)) + (let ((rval (car rl))) + (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) + (setq sl (cdr sl) rl (cdr rl)))) + ret))))) + +(org-define-lookup-function first) +(org-define-lookup-function last) +(org-define-lookup-function all) + (provide 'org-table) ;; Local variables: diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el deleted file mode 100644 index bd4c10b2ee5..00000000000 --- a/lisp/org/org-taskjuggler.el +++ /dev/null @@ -1,699 +0,0 @@ -;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-taskjuggler.el -;; Author: Christian Egli -;; Maintainer: Christian Egli -;; Keywords: org, taskjuggler, project planning -;; Description: Converts an org-mode buffer into a taskjuggler project plan -;; URL: - -;; 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 . - -;; Commentary: -;; -;; This library implements a TaskJuggler exporter for org-mode. -;; TaskJuggler uses a text format to define projects, tasks and -;; resources, so it is a natural fit for org-mode. It can produce all -;; sorts of reports for tasks or resources in either HTML, CSV or PDF. -;; The current version of TaskJuggler requires KDE but the next -;; version is implemented in Ruby and should therefore run on any -;; platform. -;; -;; The exporter is a bit different from other exporters, such as the -;; HTML and LaTeX exporters for example, in that it does not export -;; all the nodes of a document or strictly follow the order of the -;; nodes in the document. -;; -;; Instead the TaskJuggler exporter looks for a tree that defines the -;; tasks and a optionally tree that defines the resources for this -;; project. It then creates a TaskJuggler file based on these trees -;; and the attributes defined in all the nodes. -;; -;; * Installation -;; -;; Put this file into your load-path and the following line into your -;; ~/.emacs: -;; -;; (require 'org-taskjuggler) -;; -;; The interactive functions are similar to those of the HTML and LaTeX -;; exporters: -;; -;; M-x `org-export-as-taskjuggler' -;; M-x `org-export-as-taskjuggler-and-open' -;; -;; * Tasks -;; -;; Let's illustrate the usage with a small example. Create your tasks -;; as you usually do with org-mode. Assign efforts to each task using -;; properties (it's easiest to do this in the column view). You should -;; end up with something similar to the example by Peter Jones in -;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. -;; Now mark the top node of your tasks with a tag named -;; "taskjuggler_project" (or whatever you customized -;; `org-export-taskjuggler-project-tag' to). You are now ready to -;; export the project plan with `org-export-as-taskjuggler-and-open' -;; which will export the project plan and open a Gantt chart in -;; TaskJugglerUI. -;; -;; * Resources -;; -;; Next you can define resources and assign those to work on specific -;; tasks. You can group your resources hierarchically. Tag the top -;; node of the resources with "taskjuggler_resource" (or whatever you -;; customized `org-export-taskjuggler-resource-tag' to). You can -;; optionally assign an identifier (named "resource_id") to the -;; resources (using the standard org properties commands) or you can -;; let the exporter generate identifiers automatically (the exporter -;; picks the first word of the headline as the identifier as long as -;; it is unique, see the documentation of -;; `org-taskjuggler-get-unique-id'). Using that identifier you can -;; then allocate resources to tasks. This is again done with the -;; "allocate" property on the tasks. Do this in column view or when on -;; the task type -;; -;; C-c C-x p allocate RET RET -;; -;; Once the allocations are done you can again export to TaskJuggler -;; and check in the Resource Allocation Graph which person is working -;; on what task at what time. -;; -;; * Export of properties -;; -;; The exporter also takes TODO state information into consideration, -;; i.e. if a task is marked as done it will have the corresponding -;; attribute in TaskJuggler ("complete 100"). Also it will export any -;; property on a task resource or resource node which is known to -;; TaskJuggler, such as limits, vacation, shift, booking, efficiency, -;; journalentry, rate for resources or account, start, note, duration, -;; end, journalentry, milestone, reference, responsible, scheduling, -;; etc for tasks. -;; -;; * Dependencies -;; -;; The exporter will handle dependencies that are defined in the tasks -;; either with the ORDERED attribute (see TODO dependencies in the Org -;; mode manual) or with the BLOCKER attribute (see org-depend.el) or -;; alternatively with a depends attribute. Both the BLOCKER and the -;; depends attribute can be either "previous-sibling" or a reference -;; to an identifier (named "task_id") which is defined for another -;; task in the project. BLOCKER and the depends attribute can define -;; multiple dependencies separated by either space or comma. You can -;; also specify optional attributes on the dependency by simply -;; appending it. The following examples should illustrate this: -;; -;; * Training material -;; :PROPERTIES: -;; :task_id: training_material -;; :ORDERED: t -;; :END: -;; ** Markup Guidelines -;; :PROPERTIES: -;; :Effort: 2d -;; :END: -;; ** Workflow Guidelines -;; :PROPERTIES: -;; :Effort: 2d -;; :END: -;; * Presentation -;; :PROPERTIES: -;; :Effort: 2d -;; :BLOCKER: training_material { gapduration 1d } some_other_task -;; :END: -;; -;;;; * TODO -;; - Use SCHEDULED and DEADLINE information (not just start and end -;; properties). -;; - Look at org-file-properties, org-global-properties and -;; org-global-properties-fixed -;; - What about property inheritance and org-property-inherit-p? -;; - Use TYPE_TODO as an way to assign resources -;; - Make sure multiple dependency definitions (i.e. BLOCKER on -;; previous-sibling and on a specific task_id) in multiple -;; attributes are properly exported. -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'org) -(require 'org-exp) - -;;; User variables: - -(defgroup org-export-taskjuggler nil - "Options for exporting Org-mode files to TaskJuggler." - :tag "Org Export TaskJuggler" - :group 'org-export) - -(defcustom org-export-taskjuggler-extension ".tjp" - "Extension of TaskJuggler files." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-project-tag "taskjuggler_project" - "Tag, property or todo used to find the tree containing all -the tasks for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource" - "Tag, property or todo used to find the tree containing all the -resources for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-target-version 2.4 - "Which version of TaskJuggler the exporter is targeting." - :group 'org-export-taskjuggler - :version "24.1" - :type 'number) - -(defcustom org-export-taskjuggler-default-project-version "1.0" - "Default version string for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-default-project-duration 280 - "Default project duration if no start and end date have been defined -in the root node of the task tree, i.e. the tree that has been marked -with `org-export-taskjuggler-project-tag'" - :group 'org-export-taskjuggler - :version "24.1" - :type 'integer) - -(defcustom org-export-taskjuggler-default-reports - '("taskreport \"Gantt Chart\" { - headline \"Project Gantt Chart\" - columns hierarchindex, name, start, end, effort, duration, completed, chart - timeformat \"%Y-%m-%d\" - hideresource 1 - loadunit shortauto -}" - "resourcereport \"Resource Graph\" { - headline \"Resource Allocation Graph\" - columns no, name, utilization, freeload, chart - loadunit shortauto - sorttasks startup - hidetask ~isleaf() -}") - "Default reports for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type '(repeat (string :tag "Report"))) - -(defcustom org-export-taskjuggler-default-global-properties - "shift s40 \"Part time shift\" { - workinghours wed, thu, fri off -} -" - "Default global properties for the project. Here you typically -define global properties such as shifts, accounts, rates, -vacation, macros and flags. Any property that is allowed within -the TaskJuggler file can be inserted. You could for example -include another TaskJuggler file. - -The global properties are inserted after the project declaration -but before any resource and task declarations." - :group 'org-export-taskjuggler - :version "24.1" - :type '(string :tag "Preamble")) - -;;; Hooks - -(defvar org-export-taskjuggler-final-hook nil - "Hook run at the end of TaskJuggler export, in the new buffer.") - -;;; Autoload functions: - -;; avoid compiler warning about free variable -(defvar org-export-taskjuggler-old-level) - -;;;###autoload -(defun org-export-as-taskjuggler () - "Export parts of the current buffer as a TaskJuggler file. -The exporter looks for a tree with tag, property or todo that -matches `org-export-taskjuggler-project-tag' and takes this as -the tasks for this project. The first node of this tree defines -the project properties such as project name and project period. -If there is a tree with tag, property or todo that matches -`org-export-taskjuggler-resource-tag' this three is taken as -resources for the project. If no resources are specified, a -default resource is created and allocated to the project. Also -the taskjuggler project will be created with default reports as -defined in `org-export-taskjuggler-default-reports'." - (interactive) - - (message "Exporting...") - (setq-default org-done-keywords org-done-keywords) - (let* ((tasks - (org-taskjuggler-resolve-dependencies - (org-taskjuggler-assign-task-ids - (org-taskjuggler-compute-task-leafiness - (org-map-entries - 'org-taskjuggler-components - org-export-taskjuggler-project-tag nil 'archive 'comment))))) - (resources - (org-taskjuggler-assign-resource-ids - (org-map-entries - 'org-taskjuggler-components - org-export-taskjuggler-resource-tag nil 'archive 'comment))) - (filename (expand-file-name - (concat - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - org-export-taskjuggler-extension))) - (buffer (find-file-noselect filename)) - (old-buffer (current-buffer)) - (org-export-taskjuggler-old-level 0) - task resource) - (unless tasks - (error "No tasks specified")) - ;; add a default resource - (unless resources - (setq resources - `((("resource_id" . ,(user-login-name)) - ("headline" . ,user-full-name) - ("level" . 1))))) - ;; add a default allocation to the first task if none was given - (unless (assoc "allocate" (car tasks)) - (let ((task (car tasks)) - (resource-id (cdr (assoc "resource_id" (car resources))))) - (setcar tasks (push (cons "allocate" resource-id) task)))) - ;; add a default start date to the first task if none was given - (unless (assoc "start" (car tasks)) - (let ((task (car tasks)) - (time-string (format-time-string "%Y-%m-%d"))) - (setcar tasks (push (cons "start" time-string) task)))) - ;; add a default version if none was given - (unless (assoc "version" (car tasks)) - (let ((task (car tasks)) - (version org-export-taskjuggler-default-project-version)) - (setcar tasks (push (cons "version" version) task)))) - (with-current-buffer buffer - (erase-buffer) - (org-clone-local-variables old-buffer "^org-") - (org-taskjuggler-open-project (car tasks)) - (insert org-export-taskjuggler-default-global-properties) - (insert "\n") - (dolist (resource resources) - (let ((level (cdr (assoc "level" resource)))) - (org-taskjuggler-close-maybe level) - (org-taskjuggler-open-resource resource) - (setq org-export-taskjuggler-old-level level))) - (org-taskjuggler-close-maybe 1) - (setq org-export-taskjuggler-old-level 0) - (dolist (task tasks) - (let ((level (cdr (assoc "level" task)))) - (org-taskjuggler-close-maybe level) - (org-taskjuggler-open-task task) - (setq org-export-taskjuggler-old-level level))) - (org-taskjuggler-close-maybe 1) - (org-taskjuggler-insert-reports) - (save-buffer) - (or (org-export-push-to-kill-ring "TaskJuggler") - (message "Exporting... done")) - (current-buffer)))) - -;;;###autoload -(defun org-export-as-taskjuggler-and-open () - "Export the current buffer as a TaskJuggler file and open it -with the TaskJuggler GUI." - (interactive) - (let* ((file-name (buffer-file-name (org-export-as-taskjuggler))) - (process-name "TaskJugglerUI") - (command (concat process-name " " file-name))) - (start-process-shell-command process-name nil command))) - -(defun org-taskjuggler-targeting-tj3-p () - "Return true if we are targeting TaskJuggler III." - (>= org-export-taskjuggler-target-version 3.0)) - -(defun org-taskjuggler-parent-is-ordered-p () - "Return true if the parent of the current node has a property -\"ORDERED\". Return nil otherwise." - (save-excursion - (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) - -(defun org-taskjuggler-components () - "Return an alist containing all the pertinent information for -the current node such as the headline, the level, todo state -information, all the properties, etc." - (let* ((props (org-entry-properties)) - (components (org-heading-components)) - (level (nth 1 components)) - (headline - (replace-regexp-in-string - "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines - (parent-ordered (org-taskjuggler-parent-is-ordered-p))) - (push (cons "level" level) props) - (push (cons "headline" headline) props) - (push (cons "parent-ordered" parent-ordered) props))) - -(defun org-taskjuggler-assign-task-ids (tasks) - "Given a list of tasks return the same list assigning a unique id -and the full path to each task. Taskjuggler takes hierarchical ids. -For that reason we have to make ids locally unique and we have to keep -a path to the current task." - (let ((previous-level 0) - unique-ids unique-id - path - task resolved-tasks tmp) - (dolist (task tasks resolved-tasks) - (let ((level (cdr (assoc "level" task)))) - (cond - ((< previous-level level) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (dotimes (tmp (- level previous-level)) - (push (list unique-id) unique-ids) - (push unique-id path))) - ((= previous-level level) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (push unique-id (car unique-ids)) - (setcar path unique-id)) - ((> previous-level level) - (dotimes (tmp (- previous-level level)) - (pop unique-ids) - (pop path)) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (push unique-id (car unique-ids)) - (setcar path unique-id))) - (push (cons "unique-id" unique-id) task) - (push (cons "path" (mapconcat 'identity (reverse path) ".")) task) - (setq previous-level level) - (setq resolved-tasks (append resolved-tasks (list task))))))) - -(defun org-taskjuggler-compute-task-leafiness (tasks) - "Figure out if each task is a leaf by looking at it's level, -and the level of its successor. If the successor is higher (ie -deeper), then it's not a leaf." - (let (new-list) - (while (car tasks) - (let ((task (car tasks)) - (successor (car (cdr tasks)))) - (cond - ;; if a task has no successors it is a leaf - ((null successor) - (push (cons (cons "leaf-node" t) task) new-list)) - ;; if the successor has a lower level than task it is a leaf - ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task))) - (push (cons (cons "leaf-node" t) task) new-list)) - ;; otherwise examine the rest of the tasks - (t (push task new-list)))) - (setq tasks (cdr tasks))) - (nreverse new-list))) - -(defun org-taskjuggler-assign-resource-ids (resources) - "Given a list of resources return the same list, assigning a -unique id to each resource." - (let (unique-ids new-list) - (dolist (resource resources new-list) - (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids))) - (push (cons "unique-id" unique-id) resource) - (push unique-id unique-ids) - (push resource new-list))) - (nreverse new-list))) - -(defun org-taskjuggler-resolve-dependencies (tasks) - (let ((previous-level 0) - siblings - task resolved-tasks) - (dolist (task tasks resolved-tasks) - (let* ((level (cdr (assoc "level" task))) - (depends (cdr (assoc "depends" task))) - (parent-ordered (cdr (assoc "parent-ordered" task))) - (blocker (cdr (assoc "BLOCKER" task))) - (blocked-on-previous - (and blocker (string-match "previous-sibling" blocker))) - (dependencies - (org-taskjuggler-resolve-explicit-dependencies - (append - (and depends (org-taskjuggler-tokenize-dependencies depends)) - (and blocker (org-taskjuggler-tokenize-dependencies blocker))) - tasks)) - previous-sibling) - ; update previous sibling info - (cond - ((< previous-level level) - (dotimes (tmp (- level previous-level)) - (push task siblings))) - ((= previous-level level) - (setq previous-sibling (car siblings)) - (setcar siblings task)) - ((> previous-level level) - (dotimes (tmp (- previous-level level)) - (pop siblings)) - (setq previous-sibling (car siblings)) - (setcar siblings task))) - ; insert a dependency on previous sibling if the parent is - ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" - (when (or (and previous-sibling parent-ordered) blocked-on-previous) - (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) - ; store dependency information - (when dependencies - (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) - (setq previous-level level) - (setq resolved-tasks (append resolved-tasks (list task))))))) - -(defun org-taskjuggler-tokenize-dependencies (dependencies) - "Split a dependency property value DEPENDENCIES into the -individual dependencies and return them as a list while keeping -the optional arguments (such as gapduration) for the -dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." - (cond - ((string-match "^ *$" dependencies) nil) - ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) - (cons - (substring dependencies (match-beginning 1) (match-end 1)) - (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0))))) - (t (error (format "invalid dependency id %s" dependencies))))) - -(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks) - "For each dependency in DEPENDENCIES try to find a -corresponding task with a matching property \"task_id\" in TASKS. -Return a list containing the resolved links for all DEPENDENCIES -where a matching tasks was found. If the dependency is -\"previous-sibling\" it is ignored (as this is dealt with in -`org-taskjuggler-resolve-dependencies'). If there is no matching -task the dependency is ignored and a warning is displayed ." - (unless (null dependencies) - (let* - ;; the dependency might have optional attributes such as "{ - ;; gapduration 5d }", so only use the first string as id for the - ;; dependency - ((dependency (car dependencies)) - (id (car (split-string dependency))) - (optional-attributes - (mapconcat 'identity (cdr (split-string dependency)) " ")) - (path (org-taskjuggler-find-task-with-id id tasks))) - (cond - ;; ignore previous sibling dependencies - ((equal (car dependencies) "previous-sibling") - (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)) - ;; if the id is found in another task use its path - ((not (null path)) - (cons (mapconcat 'identity (list path optional-attributes) " ") - (org-taskjuggler-resolve-explicit-dependencies - (cdr dependencies) tasks))) - ;; warn about dangling dependency but otherwise ignore it - (t (display-warning - 'org-export-taskjuggler - (format "No task with matching property \"task_id\" found for id %s" id)) - (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) - -(defun org-taskjuggler-find-task-with-id (id tasks) - "Find ID in tasks. If found return the path of task. Otherwise -return nil." - (let ((task-id (cdr (assoc "task_id" (car tasks)))) - (path (cdr (assoc "path" (car tasks))))) - (cond - ((null tasks) nil) - ((equal task-id id) path) - (t (org-taskjuggler-find-task-with-id id (cdr tasks)))))) - -(defun org-taskjuggler-get-unique-id (item unique-ids) - "Return a unique id for an ITEM which can be a task or a resource. -The id is derived from the headline and made unique against -UNIQUE-IDS. If the (downcased) first token of the headline is not -unique try to add more (downcased) tokens of the headline or -finally add more underscore characters (\"_\")." - (let* ((headline (cdr (assoc "headline" item))) - (parts (split-string headline)) - (id (org-taskjuggler-clean-id (downcase (pop parts))))) - ; try to add more parts of the headline to make it unique - (while (and (member id unique-ids) (car parts)) - (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) - ; if its still not unique add "_" - (while (member id unique-ids) - (setq id (concat id "_"))) - id)) - -(defun org-taskjuggler-clean-id (id) - "Clean and return ID to make it acceptable for taskjuggler." - (and id - ;; replace non-ascii by _ - (replace-regexp-in-string - "[^a-zA-Z0-9_]" "_" - ;; make sure id doesn't start with a number - (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))) - -(defun org-taskjuggler-open-project (project) - "Insert the beginning of a project declaration. All valid -attributes from the PROJECT alist are inserted. If no end date is -specified it is calculated -`org-export-taskjuggler-default-project-duration' days from now." - (let* ((unique-id (cdr (assoc "unique-id" project))) - (headline (cdr (assoc "headline" project))) - (version (cdr (assoc "version" project))) - (start (cdr (assoc "start" project))) - (end (cdr (assoc "end" project)))) - (insert - (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n" - unique-id headline version start - org-export-taskjuggler-default-project-duration)))) - -(defun org-taskjuggler-filter-and-join (items) - "Filter all nil elements from ITEMS and join the remaining ones -with separator \"\n\"." - (let ((filtered-items (remq nil items))) - (and filtered-items (mapconcat 'identity filtered-items "\n")))) - -(defun org-taskjuggler-get-attributes (item attributes) - "Return all attribute as a single formatted string. ITEM is an -alist representing either a resource or a task. ATTRIBUTES is a -list of symbols. Only entries from ITEM are considered that are -listed in ATTRIBUTES." - (org-taskjuggler-filter-and-join - (mapcar - (lambda (attribute) - (org-taskjuggler-filter-and-join - (org-taskjuggler-get-attribute item attribute))) - attributes))) - -(defun org-taskjuggler-get-attribute (item attribute) - "Return a list of strings containing the properly formatted -taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist). -If the ATTRIBUTE is not in ITEM return nil." - (cond - ((null item) nil) - ((equal (symbol-name attribute) (car (car item))) - (cons (format "%s %s" (symbol-name attribute) (cdr (car item))) - (org-taskjuggler-get-attribute (cdr item) attribute))) - (t (org-taskjuggler-get-attribute (cdr item) attribute)))) - -(defun org-taskjuggler-open-resource (resource) - "Insert the beginning of a resource declaration. All valid -attributes from the RESOURCE alist are inserted. If the RESOURCE -defines a property \"resource_id\" it will be used as the id for -this resource. Otherwise it will use the ID property. If neither -is defined it will calculate a unique id for the resource using -`org-taskjuggler-get-unique-id'." - (let ((id (org-taskjuggler-clean-id - (or (cdr (assoc "resource_id" resource)) - (cdr (assoc "ID" resource)) - (cdr (assoc "unique-id" resource))))) - (headline (cdr (assoc "headline" resource))) - (attributes '(limits vacation shift booking efficiency journalentry rate))) - (insert - (concat - "resource " id " \"" headline "\" {\n " - (org-taskjuggler-get-attributes resource attributes) "\n")))) - -(defun org-taskjuggler-clean-effort (effort) - "Translate effort strings into a format acceptable to taskjuggler, -i.e. REAL UNIT. A valid effort string can be anything that is -accepted by `org-duration-string-to-minutes´." - (cond - ((null effort) effort) - (t (let* ((minutes (org-duration-string-to-minutes effort)) - (hours (/ minutes 60.0))) - (format "%.1fh" hours))))) - -(defun org-taskjuggler-get-priority (priority) - "Return a priority between 1 and 1000 based on PRIORITY, an -org-mode priority string." - (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) - (- org-lowest-priority org-highest-priority)))) - -(defun org-taskjuggler-open-task (task) - (let* ((unique-id (cdr (assoc "unique-id" task))) - (headline (cdr (assoc "headline" task))) - (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) - (depends (cdr (assoc "depends" task))) - (allocate (cdr (assoc "allocate" task))) - (priority-raw (cdr (assoc "PRIORITY" task))) - (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) - (state (cdr (assoc "TODO" task))) - (complete (or (and (member state org-done-keywords) "100") - (cdr (assoc "complete" task)))) - (parent-ordered (cdr (assoc "parent-ordered" task))) - (previous-sibling (cdr (assoc "previous-sibling" task))) - (milestone (or (cdr (assoc "milestone" task)) - (and (assoc "leaf-node" task) - (not (or effort - (cdr (assoc "duration" task)) - (cdr (assoc "end" task)) - (cdr (assoc "period" task))))))) - (attributes - '(account start note duration endbuffer endcredit end - flags journalentry length maxend maxstart minend - minstart period reference responsible scheduling - startbuffer startcredit statusnote))) - (insert - (concat - "task " unique-id " \"" headline "\" {\n" - (if (and parent-ordered previous-sibling) - (format " depends %s\n" previous-sibling) - (and depends (format " depends %s\n" depends))) - (and allocate (format " purge %s\n allocate %s\n" - (or (and (org-taskjuggler-targeting-tj3-p) "allocate") - "allocations") - allocate)) - (and complete (format " complete %s\n" complete)) - (and effort (format " effort %s\n" effort)) - (and priority (format " priority %s\n" priority)) - (and milestone (format " milestone\n")) - - (org-taskjuggler-get-attributes task attributes) - "\n")))) - -(defun org-taskjuggler-close-maybe (level) - (while (> org-export-taskjuggler-old-level level) - (insert "}\n") - (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level))) - (when (= org-export-taskjuggler-old-level level) - (insert "}\n"))) - -(defun org-taskjuggler-insert-reports () - (let (report) - (dolist (report org-export-taskjuggler-default-reports) - (insert report "\n")))) - -(provide 'org-taskjuggler) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-taskjuggler.el ends here diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 2351c4c1989..55540276ea2 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -1,6 +1,6 @@ ;;; org-timer.el --- The relative timer code for Org-mode -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp @@ -370,6 +370,8 @@ VALUE can be `on', `off', or `pause'." (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) +(defvar org-clock-sound) + ;;;###autoload (defun org-timer-set-timer (&optional opt) "Prompt for a duration and set a timer. @@ -429,7 +431,7 @@ replace any running timer." (run-with-timer secs nil `(lambda () (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) t) + (org-notify ,(format "%s: time out" hl) ,org-clock-sound) (setq org-timer-timer-is-countdown nil) (org-timer-set-mode-line 'off) (run-hooks 'org-timer-done-hook)))) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 4fa865308e9..7ccddb52a92 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of org-mode. Inserted by installing org-mode or when a release is made." - (let ((org-release "7.9.3f")) + (let ((org-release "8.2.5c")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing org-mode or when a release is made." - (let ((org-git-version "release_7.9.3f-17-g7524ef")) + (let ((org-git-version "release_8.2.5c")) org-git-version)) ;;;###autoload (defvar org-odt-data-dir "/usr/share/emacs/etc/org" diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el deleted file mode 100644 index fc2a34b8fe5..00000000000 --- a/lisp/org/org-vm.el +++ /dev/null @@ -1,180 +0,0 @@ -;;; org-vm.el --- Support for links to VM messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; Support for IMAP folders added -;; by Konrad Hinsen -;; Requires VM 8.2.0a or later. -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; This file implements links to VM messages and folders from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -;; Declare external functions and variables -(declare-function vm-preview-current-message "ext:vm-page" ()) -(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) -(declare-function vm-get-header-contents "ext:vm-summary" - (message header-name-regexp &optional clump-sep)) -(declare-function vm-isearch-narrow "ext:vm-search" ()) -(declare-function vm-isearch-update "ext:vm-search" ()) -(declare-function vm-select-folder-buffer "ext:vm-macro" ()) -(declare-function vm-su-message-id "ext:vm-summary" (m)) -(declare-function vm-su-subject "ext:vm-summary" (m)) -(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) -(declare-function vm-imap-folder-p "ext:vm-save" ()) -(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer)) -(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec)) -(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec)) -(declare-function vm-imap-spec-for-account "ext:vm-imap" (account)) -(defvar vm-message-pointer) -(defvar vm-folder-directory) - -;; Install the link type -(org-add-link-type "vm" 'org-vm-open) -(org-add-link-type "vm-imap" 'org-vm-imap-open) -(add-hook 'org-store-link-functions 'org-vm-store-link) - -;; Implementation -(defun org-vm-store-link () - "Store a link to a VM folder or message." - (when (and (or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) - (save-window-excursion - (vm-select-folder-buffer) buffer-file-name)) - (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) - (vm-follow-summary-cursor) - (save-excursion - (vm-select-folder-buffer) - (let* ((message (car vm-message-pointer)) - (subject (vm-su-subject message)) - (to (vm-get-header-contents message "To")) - (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message)) - (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) - (date (vm-get-header-contents message "Date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - folder desc link) - (if (vm-imap-folder-p) - (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) - (setq folder (vm-imap-folder-for-spec spec))) - (progn - (setq folder (abbreviate-file-name buffer-file-name)) - (if (and vm-folder-directory - (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder)) - (setq folder (replace-match "" t t folder))))) - (setq message-id (org-remove-angle-brackets message-id)) - (org-store-link-props :type link-type :from from :to to :subject subject - :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq desc (org-email-link-description)) - (setq link (concat (concat link-type ":") folder "#" message-id)) - (org-add-link-props :link link :description desc) - link)))) - -(defun org-vm-open (path) - "Follow a VM message link specified by PATH." - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in VM link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - ;; The prefix argument will be interpreted as read-only - (org-vm-follow-link folder article current-prefix-arg))) - -(defun org-vm-follow-link (&optional folder article readonly) - "Follow a VM link to FOLDER and ARTICLE." - (require 'vm) - (setq article (org-add-angle-brackets article)) - (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) - ;; ange-ftp or efs or tramp access - (let ((user (or (match-string 1 folder) (user-login-name))) - (host (match-string 2 folder)) - (file (match-string 3 folder))) - (cond - ((featurep 'tramp) - ;; use tramp to access the file - (if (featurep 'xemacs) - (setq folder (format "[%s@%s]%s" user host file)) - (setq folder (format "/%s@%s:%s" user host file)))) - (t - ;; use ange-ftp or efs - (require (if (featurep 'xemacs) 'efs 'ange-ftp)) - (setq folder (format "/%s@%s:%s" user host file)))))) - (when folder - (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) - (when article - (org-vm-select-message (org-add-angle-brackets article))))) - -(defun org-vm-imap-open (path) - "Follow a VM link to an IMAP folder." - (require 'vm-imap) - (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) - (let* ((account-name (match-string 1 path)) - (mailbox-name (match-string 2 path)) - (message-id (match-string 3 path)) - (account-spec (vm-imap-parse-spec-to-list - (vm-imap-spec-for-account account-name))) - (mailbox-spec (mapconcat 'identity - (append (butlast account-spec 4) - (cons mailbox-name - (last account-spec 3))) - ":"))) - (funcall (cdr (assq 'vm-imap org-link-frame-setup)) - mailbox-spec) - (when message-id - (org-vm-select-message (org-add-angle-brackets message-id)))))) - -(defun org-vm-select-message (message-id) - "Go to the message with message-id in the current folder." - (require 'vm-search) - (sit-for 0.1) - (vm-select-folder-buffer) - (widen) - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "^" "message-id: *" (regexp-quote message-id)))) - (error "Could not find the specified message in this folder")) - (vm-isearch-update) - (vm-isearch-narrow) - (vm-preview-current-message) - (vm-summarize))) - -(provide 'org-vm) - - - -;;; org-vm.el ends here diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index e1cc99627ea..c8ddc82daca 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -1,6 +1,6 @@ ;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: Andy Stewart ;; Keywords: outlines, hypermedia, calendar, wp @@ -8,12 +8,12 @@ ;; ;; This file is part of GNU Emacs. ;; -;; GNU Emacs 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 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; 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. @@ -43,6 +43,19 @@ (require 'org) +(defvar w3m-current-url) +(defvar w3m-current-title) + +(add-hook 'org-store-link-functions 'org-w3m-store-link) +(defun org-w3m-store-link () + "Store a link to a w3m buffer." + (when (eq major-mode 'w3m-mode) + (org-store-link-props + :type "w3m" + :link w3m-current-url + :url (url-view-url t) + :description (or w3m-current-title w3m-current-url)))) + (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el deleted file mode 100644 index b755c023e78..00000000000 --- a/lisp/org/org-wl.el +++ /dev/null @@ -1,316 +0,0 @@ -;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Tokuya Kameshima -;; David Maus -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements links to Wanderlust messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -(defgroup org-wl nil - "Options concerning the Wanderlust link." - :tag "Org Startup" - :group 'org-link) - -(defcustom org-wl-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-wl - :type 'boolean) - -(defcustom org-wl-link-remove-filter nil - "Remove filter condition if message is filter folder." - :group 'org-wl - :version "24.1" - :type 'boolean) - -(defcustom org-wl-shimbun-prefer-web-links nil - "If non-nil create web links for shimbun messages." - :group 'org-wl - :version "24.1" - :type 'boolean) - -(defcustom org-wl-nntp-prefer-web-links nil - "If non-nil create web links for nntp messages. -When folder name contains string \"gmane\" link to gmane, -googlegroups otherwise." - :type 'boolean - :version "24.1" - :group 'org-wl) - -(defcustom org-wl-disable-folder-check t - "Disable check for new messages when open a link." - :type 'boolean - :version "24.1" - :group 'org-wl) - -(defcustom org-wl-namazu-default-index nil - "Default namazu search index." - :type 'directory - :version "24.1" - :group 'org-wl) - -;; Declare external functions and variables -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" - (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" - (folder number field &optional type) t) -(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t) -;; Backward compatibility to old version of wl -(declare-function wl "ext:wl" () t) -(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) -(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" - (&optional id)) -(declare-function wl-summary-jump-to-msg "ext:wl-summary" - (&optional number beg end)) -(declare-function wl-summary-line-from "ext:wl-summary" ()) -(declare-function wl-summary-line-subject "ext:wl-summary" ()) -(declare-function wl-summary-message-number "ext:wl-summary" ()) -(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) -(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) -(declare-function wl-folder-goto-folder-subr "ext:wl-folder" - (&optional folder sticky)) -(declare-function wl-folder-get-petname "ext:wl-folder" (name)) -(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder" - (&optional getid)) -(declare-function wl-folder-buffer-group-p "ext:wl-folder") -(defvar wl-init) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(defvar wl-folder-group-regexp) -(defvar wl-auto-check-folder-name) -(defvar elmo-nntp-default-server) - -(defconst org-wl-folder-types - '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) - ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search) - ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal)) - "List of folder indicators. See Wanderlust manual, section 3.") - -;; Install the link type -(org-add-link-type "wl" 'org-wl-open) -(add-hook 'org-store-link-functions 'org-wl-store-link) - -;; Implementation - -(defun org-wl-folder-type (folder) - "Return symbol that indicates the type of FOLDER. -FOLDER is the wanderlust folder name. The first character of the -folder name determines the folder type." - (let* ((indicator (substring folder 0 1)) - (type (cdr (assoc indicator org-wl-folder-types)))) - ;; maybe access or file folder - (when (not type) - (setq type - (cond - ((and (>= (length folder) 5) - (string= (substring folder 0 5) "file:")) - 'file) - ((and (>= (length folder) 7) - (string= (substring folder 0 7) "access:")) - 'access) - (t - nil)))) - type)) - -(defun org-wl-message-field (field entity) - "Return content of FIELD in ENTITY. -FIELD is a symbol of a rfc822 message header field. -ENTITY is a message entity." - (let ((content (elmo-message-entity-field entity field 'string))) - (if (listp content) (car content) content))) - -(defun org-wl-store-link () - "Store a link to a WL message or folder." - (unless (eobp) - (cond - ((memq major-mode '(wl-summary-mode mime-view-mode)) - (org-wl-store-link-message)) - ((eq major-mode 'wl-folder-mode) - (org-wl-store-link-folder)) - (t - nil)))) - -(defun org-wl-store-link-folder () - "Store a link to a WL folder." - (let* ((folder (wl-folder-get-entity-from-buffer)) - (petname (wl-folder-get-petname folder)) - (link (concat "wl:" folder))) - (save-excursion - (beginning-of-line) - (unless (and (wl-folder-buffer-group-p) - (looking-at wl-folder-group-regexp)) - (org-store-link-props :type "wl" :description petname - :link link) - link)))) - -(defun org-wl-store-link-message () - "Store a link to a WL message." - (save-excursion - (let ((buf (if (eq major-mode 'wl-summary-mode) - (current-buffer) - (and (boundp 'wl-message-buffer-cur-summary-buffer) - wl-message-buffer-cur-summary-buffer)))) - (when buf - (with-current-buffer buf - (let* ((msgnum (wl-summary-message-number)) - (mark-info (wl-summary-registered-temp-mark msgnum)) - (folder-name - (if (and org-wl-link-to-refile-destination - mark-info - (equal (nth 1 mark-info) "o")) ; marked as refile - (nth 2 mark-info) - wl-summary-buffer-folder-name)) - (folder-type (org-wl-folder-type folder-name)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (message-id - (org-wl-message-field 'message-id wl-message-entity)) - (message-id-no-brackets - (org-remove-angle-brackets message-id)) - (from (org-wl-message-field 'from wl-message-entity)) - (to (org-wl-message-field 'to wl-message-entity)) - (xref (org-wl-message-field 'xref wl-message-entity)) - (subject (org-wl-message-field 'subject wl-message-entity)) - (date (org-wl-message-field 'date wl-message-entity)) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - desc link) - - ;; remove text properties of subject string to avoid possible bug - ;; when formatting the subject - ;; (Emacs bug #5306, fixed) - (set-text-properties 0 (length subject) nil subject) - - ;; maybe remove filter condition - (when (and (eq folder-type 'filter) org-wl-link-remove-filter) - (while (eq (org-wl-folder-type folder-name) 'filter) - (setq folder-name - (replace-regexp-in-string "^/[^/]+/" "" folder-name)))) - - ;; maybe create http link - (cond - ((and (eq folder-type 'shimbun) - org-wl-shimbun-prefer-web-links xref) - (org-store-link-props :type "http" :link xref :description subject - :from from :to to :message-id message-id - :message-id-no-brackets message-id-no-brackets - :subject subject)) - ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) - (setq link - (format - (if (string-match "gmane\\." folder-name) - "http://mid.gmane.org/%s" - "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http message-id))) - (org-store-link-props :type "http" :link link :description subject - :from from :to to :message-id message-id - :message-id-no-brackets message-id-no-brackets - :subject subject)) - (t - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id - :message-id-no-brackets message-id-no-brackets) - (setq desc (org-email-link-description)) - (setq link (concat "wl:" folder-name "#" message-id-no-brackets)) - (org-add-link-props :link link :description desc))) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (or link xref))))))) - -(defun org-wl-open-nntp (path) - "Follow the nntp: link specified by PATH." - (let* ((spec (split-string path "/")) - (server (split-string (nth 2 spec) "@")) - (group (nth 3 spec)) - (article (nth 4 spec))) - (org-wl-open - (concat "-" group ":" (if (cdr server) - (car (split-string (car server) ":")) - "") - (if (string= elmo-nntp-default-server (nth 2 spec)) - "" - (concat "@" (or (cdr server) (car server)))) - (if article (concat "#" article) ""))))) - -(defun org-wl-open (path) - "Follow the WL message link specified by PATH. -When called with one prefix, open message in namazu search folder -with `org-wl-namazu-default-index' as search index. When called -with two prefixes or `org-wl-namazu-default-index' is nil, ask -for namazu index." - (require 'wl) - (let ((wl-auto-check-folder-name - (if org-wl-disable-folder-check - 'none - wl-auto-check-folder-name))) - (unless wl-init (wl)) - ;; XXX: The imap-uw's MH folder names start with "%#". - (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (let ((folder (match-string 1 path)) - (article (match-string 3 path))) - ;; maybe open message in namazu search folder - (when current-prefix-arg - (setq folder (concat "[" article "]" - (if (and (equal current-prefix-arg '(4)) - org-wl-namazu-default-index) - org-wl-namazu-default-index - (read-directory-name "Namazu index: "))))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) - (error "No such folder: %s" folder)) - (let ((old-buf (current-buffer)) - (old-point (point-marker))) - (wl-folder-goto-folder-subr folder) - (with-current-buffer old-buf - ;; XXX: `wl-folder-goto-folder-subr' moves point to the - ;; beginning of the current line. So, restore the point - ;; in the old buffer. - (goto-char old-point)) - (when article - (if (org-string-match-p "@" article) - (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) - (or (wl-summary-jump-to-msg (string-to-number article)) - (error "No such message: %s" article))) - (wl-summary-redisplay)))))) - -(provide 'org-wl) - -;;; org-wl.el ends here diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el deleted file mode 100644 index 1083fe16c53..00000000000 --- a/lisp/org/org-xoxo.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; org-xoxo.el --- XOXO export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; XOXO export - -;;; Code: - -(require 'org-exp) - -(defvar org-export-xoxo-final-hook nil - "Hook run after XOXO export, in the new buffer.") - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -;;;###autoload -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-*" - (interactive (list (current-buffer))) - (run-hooks 'org-export-first-hook) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "
      \n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n
        \n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n")) - (org-export-as-xoxo-insert-into out "
      \n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "
    1. ") - (org-export-as-xoxo-insert-into out "
    2. " text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "
    3. \n")) - (org-export-as-xoxo-insert-into out "
    \n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (run-hooks 'org-export-xoxo-final-hook) - (save-buffer) - (goto-char (point-min)) - ))) - -(provide 'org-xoxo) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-xoxo.el ends here diff --git a/lisp/org/org.el b/lisp/org/org.el index cc4c93f22eb..edbcc09cd10 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1,10 +1,10 @@ ;;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik -;; Maintainer: Bastien Guerry +;; Maintainer: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; @@ -22,7 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; @@ -78,10 +77,13 @@ (require 'find-func) (require 'format-spec) -(load "org-loaddefs.el" t t) +(load "org-loaddefs.el" t t t) -;; `org-outline-regexp' ought to be a defconst but is let-binding in -;; some places -- e.g. see the macro org-with-limited-levels. +(require 'org-macs) +(require 'org-compat) + +;; `org-outline-regexp' ought to be a defconst but is let-bound in +;; some places -- e.g. see the macro `org-with-limited-levels'. ;; ;; In Org buffers, the value of `outline-regexp' is that of ;; `org-outline-regexp'. The only function still directly relying on @@ -96,42 +98,68 @@ This is similar to `org-outline-regexp' but additionally makes sure that we are at the beginning of the line.") (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Matches an headline, putting stars and text into groups. + "Matches a headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") ;; Emacs 22 calendar compatibility: Make sure the new variables are available -(when (fboundp 'defvaralias) - (unless (boundp 'calendar-view-holidays-initially-flag) - (defvaralias 'calendar-view-holidays-initially-flag - 'view-calendar-holidays-initially)) - (unless (boundp 'calendar-view-diary-initially-flag) - (defvaralias 'calendar-view-diary-initially-flag - 'view-diary-entries-initially)) - (unless (boundp 'diary-fancy-buffer) - (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) +(unless (boundp 'calendar-view-holidays-initially-flag) + (org-defvaralias 'calendar-view-holidays-initially-flag + 'view-calendar-holidays-initially)) +(unless (boundp 'calendar-view-diary-initially-flag) + (org-defvaralias 'calendar-view-diary-initially-flag + 'view-diary-entries-initially)) +(unless (boundp 'diary-fancy-buffer) + (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-clock-timestamps-up "org-clock" ()) -(declare-function org-clock-timestamps-down "org-clock" ()) +(declare-function org-clock-get-last-clock-out-time "org-clock" ()) +(declare-function org-clock-timestamps-up "org-clock" (&optional n)) +(declare-function org-clock-timestamps-down "org-clock" (&optional n)) (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) (declare-function orgtbl-mode "org-table" (&optional arg)) (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) -(declare-function org-beamer-mode "org-beamer" ()) +(declare-function org-beamer-mode "ox-beamer" ()) (declare-function org-table-edit-field "org-table" (arg)) (declare-function org-table-justify-field-maybe "org-table" (&optional new)) +(declare-function org-table-set-constants "org-table" ()) +(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) (declare-function org-id-get-create "org-id" (&optional force)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) +(declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-table-align "org-table" ()) (declare-function org-table-paste-rectangle "org-table" ()) (declare-function org-table-maybe-eval-formula "org-table" ()) (declare-function org-table-maybe-recalculate-line "org-table" ()) +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-interpret-data "org-element" + (data &optional parent)) +(declare-function org-element-map "org-element" + (data types fun &optional info first-match no-recursion)) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" + (element property value)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-type "org-element" (element)) + ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -151,6 +179,34 @@ Stars are put in group 1 and the trimmed body in group 2.") (intern (concat "org-babel-expand-body:" lang))))))) org-babel-load-languages)) +;;;###autoload +(defun org-babel-load-file (file &optional compile) + "Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using `org-babel-tangle' +and then loads the resulting file using `load-file'. With prefix +arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp +file to byte-code before it is loaded." + (interactive "fFile to load: \nP") + (require 'ob-core) + (let* ((age (lambda (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (funcall age file) (funcall age exported-file))) + (setq exported-file + (car (org-babel-tangle-file file exported-file "emacs-lisp")))) + (message "%s %s" + (if compile + (progn (byte-compile-file exported-file 'load) + "Compiled and loaded") + (progn (load-file exported-file) "Loaded")) + exported-file))) + (defcustom org-babel-load-languages '((emacs-lisp . t)) "Languages which can be evaluated in Org-mode buffers. This list can be used to load support for any of the languages @@ -188,6 +244,7 @@ requirements) is loaded." (const :tag "Ledger" ledger) (const :tag "Lilypond" lilypond) (const :tag "Lisp" lisp) + (const :tag "Makefile" makefile) (const :tag "Maxima" maxima) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) @@ -220,7 +277,6 @@ identifier." :group 'org-id) ;;; Version -(require 'org-compat) (org-check-version) ;;;###autoload @@ -231,11 +287,13 @@ When FULL is non-nil, use a verbose version string. When MESSAGE is non-nil, display a message with the version." (interactive "P") (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs.el"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) (org-trash (or (and (fboundp 'org-release) (fboundp 'org-git-version)) - (load (concat org-dir "org-version.el") - 'noerror 'nomessage 'nosuffix))) + (org-load-noerror-mustsuffix (concat org-dir "org-version")))) + (load-suffixes save-load-suffixes) (org-version (org-release)) (git-version (org-git-version)) (version (format "Org-mode version %s (%s @ %s)" @@ -246,13 +304,13 @@ When MESSAGE is non-nil, display a message with the version." org-install-dir (concat "mixed installation! " org-install-dir " and " org-dir)) "org-loaddefs.el can not be found!"))) - (_version (if full version org-version))) + (version1 (if full version org-version))) (if (org-called-interactively-p 'interactive) (if here (insert version) (message version)) - (if message (message _version)) - _version))) + (if message (message version1)) + version1))) (defconst org-version (org-version)) @@ -301,24 +359,25 @@ When MESSAGE is non-nil, display a message with the version." (when (featurep 'org) (org-load-modules-maybe 'force))) -(when (org-bound-and-true-p org-modules) - (let ((a (member 'org-infojs org-modules))) - (and a (setcar a 'org-jsinfo)))) - -(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl) +(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) "Modules that should always be loaded together with org.el. + If a description starts with , the file is not part of Emacs -and loading it will require that you have downloaded and properly installed -the org-mode distribution. +and loading it will require that you have downloaded and properly +installed the Org mode distribution. You can also use this system to load external packages (i.e. neither Org core modules, nor modules from the CONTRIB directory). Just add symbols to the end of the list. If the package is called org-xyz.el, then you need -to add the symbol `xyz', and the package must have a call to +to add the symbol `xyz', and the package must have a call to: - (provide 'org-xyz)" + \(provide 'org-xyz) + +For export specific modules, see also `org-export-backends'." :group 'org :set 'org-set-modules + :version "24.4" + :package-version '(Org . "8.0") :type '(set :greedy t (const :tag " bbdb: Links to BBDB entries" org-bbdb) @@ -327,26 +386,20 @@ to add the symbol `xyz', and the package must have a call to (const :tag " ctags: Access to Emacs tags with links" org-ctags) (const :tag " docview: Links to doc-view buffers" org-docview) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) + (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " id: Global IDs for identifying entries" org-id) (const :tag " info: Links to Info nodes" org-info) - (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) - (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) - (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) - (const :tag " mew Links to Mew folders/messages" org-mew) (const :tag " mhe: Links to MHE folders/messages" org-mhe) + (const :tag " mouse: Additional mouse support" org-mouse) (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) - (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) - (const :tag " vm: Links to VM folders/messages" org-vm) - (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) - (const :tag " mouse: Additional mouse support" org-mouse) - (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) + (const :tag "C bullets: Add overlays to headlines stars" org-bullets) (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) @@ -354,35 +407,137 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eshell Support for links to working directories in eshell" org-eshell) - (const :tag "C eval: Include command output as text" org-eval) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) + (const :tag "C eval: Include command output as text" org-eval) (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) - (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex) + (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) (const :tag "C git-link: Provide org links to specific file version" org-git-link) (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) - (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) - (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) - (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) - (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) - (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) + (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) + (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) (const :tag "C man: Support for links to manpages in Org-mode" org-man) + (const :tag "C mew: Links to Mew folders/messages" org-mew) (const :tag "C mtags: Support for muse-like tags" org-mtags) + (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C panel: Simple routines for us with bad memory" org-panel) (const :tag "C registry: A registry for Org-mode links" org-registry) - (const :tag "C org2rem: Convert org appointments into reminders" org2rem) (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) (const :tag "C secretary: Team management with org-mode" org-secretary) (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) + (const :tag "C vm: Links to VM folders/messages" org-vm) (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) + (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) +(defvar org-export--registered-backends) ; From ox.el. +(declare-function org-export-derived-backend-p "ox" (backend &rest backends)) +(declare-function org-export-backend-name "ox" (backend)) +(defcustom org-export-backends '(ascii html icalendar latex) + "List of export back-ends that should be always available. + +If a description starts with , the file is not part of Emacs +and loading it will require that you have downloaded and properly +installed the Org mode distribution. + +Unlike to `org-modules', libraries in this list will not be +loaded along with Org, but only once the export framework is +needed. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code, where VAL stands for the new +value of the variable, after updating it: + + \(progn + \(setq org-export--registered-backends + \(org-remove-if-not + \(lambda (backend) + \(let ((name (org-export-backend-name backend))) + \(or (memq name val) + \(catch 'parentp + \(dolist (b val) + \(and (org-export-derived-backend-p b name) + \(throw 'parentp t))))))) + org-export--registered-backends)) + \(let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) + \(dolist (backend val) + \(cond + \((not (load (format \"ox-%s\" backend) t t)) + \(message \"Problems while trying to load export back-end `%s'\" + backend)) + \((not (memq backend new-list)) (push backend new-list)))) + \(set-default 'org-export-backends new-list))) + +Adding a back-end to this list will also pull the back-end it +depends on, if any." + :group 'org + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0") + :initialize 'custom-initialize-set + :set (lambda (var val) + (if (not (featurep 'ox)) (set-default var val) + ;; Any back-end not required anymore (not present in VAL and not + ;; a parent of any back-end in the new value) is removed from the + ;; list of registered back-ends. + (setq org-export--registered-backends + (org-remove-if-not + (lambda (backend) + (let ((name (org-export-backend-name backend))) + (or (memq name val) + (catch 'parentp + (dolist (b val) + (and (org-export-derived-backend-p b name) + (throw 'parentp t))))))) + org-export--registered-backends)) + ;; Now build NEW-LIST of both new back-ends and required + ;; parents. + (let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) + (dolist (backend val) + (cond + ((not (load (format "ox-%s" backend) t t)) + (message "Problems while trying to load export back-end `%s'" + backend)) + ((not (memq backend new-list)) (push backend new-list)))) + ;; Set VAR to that list with fixed dependencies. + (set-default var new-list)))) + :type '(set :greedy t + (const :tag " ascii Export buffer to ASCII format" ascii) + (const :tag " beamer Export buffer to Beamer presentation" beamer) + (const :tag " html Export buffer to HTML format" html) + (const :tag " icalendar Export buffer to iCalendar format" icalendar) + (const :tag " latex Export buffer to LaTeX format" latex) + (const :tag " man Export buffer to MAN format" man) + (const :tag " md Export buffer to Markdown format" md) + (const :tag " odt Export buffer to ODT format" odt) + (const :tag " org Export buffer to Org format" org) + (const :tag " texinfo Export buffer to Texinfo format" texinfo) + (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) + (const :tag "C deck Export buffer to deck.js presentations" deck) + (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) + (const :tag "C groff Export buffer to Groff format" groff) + (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) + (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) + (const :tag "C s5 Export buffer to s5 presentations" s5) + (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) + +(eval-after-load 'ox + '(mapc + (lambda (backend) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend)))) + org-export-backends)) + (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -447,7 +602,7 @@ The list of commands is: `org-schedule', `org-deadline', already archived entries." :type '(choice (const :tag "Don't loop" nil) (const :tag "All headlines in active region" t) - (const :tag "In active region, headlines at the same level than the first one" 'start-level) + (const :tag "In active region, headlines at the same level than the first one" start-level) (string :tag "Tags/Property/Todo matcher")) :version "24.1" :group 'org-todo @@ -498,12 +653,18 @@ the following lines anywhere in the buffer: (const :tag "Globally (slow on startup in large files)" t))) (defcustom org-use-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. + "Non-nil means interpret \"_\" and \"^\" for display. + +If you want to control how Org exports those characters, see +`org-export-with-sub-superscripts'. `org-use-sub-superscripts' +used to be an alias for `org-export-with-sub-superscripts' in +Org <8.0, it is not anymore. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts within the buffer. Several characters after +\"_\" or \"^\" will be considered as a single item - so grouping +with {} is normally not needed. For example, the following things +will be parsed as single sub- or superscripts: 10^24 or 10^tau several digits will be considered 1 item. 10^-12 or 10^-tau a leading sign with digits or a word @@ -511,27 +672,19 @@ sub- or superscripts. terminated by almost any nonword/nondigit char. x_{i^2} or x^(2-i) braces or parenthesis do grouping. -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. If you set this variable to the symbol `{}', +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', the braces are *required* in order to trigger interpretations as sub/superscript. This can be helpful in documents that need \"_\" -frequently in plain text. - -Not all export backends support this, but HTML does. - -This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"." +frequently in plain text." :group 'org-startup - :group 'org-export-translation - :version "24.1" + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Always interpret" t) (const :tag "Only with braces" {}) (const :tag "Never interpret" nil))) -(if (fboundp 'defvaralias) - (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts)) - - (defcustom org-startup-with-beamer-mode nil "Non-nil means turn on `org-beamer-mode' on startup. This can also be configured on a per-file basis by adding one of @@ -563,6 +716,18 @@ the following lines anywhere in the buffer: :version "24.1" :type 'boolean) +(defcustom org-startup-with-latex-preview nil + "Non-nil means preview LaTeX fragments when loading a new Org file. + +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: latexpreview + #+STARTUP: nolatexpreview" + :group 'org-startup + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org-mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -602,8 +767,7 @@ it work for ESC." :group 'org-startup :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) +(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) (defcustom org-disputed-keys '(([(shift up)] . [(meta p)]) @@ -695,6 +859,14 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defcustom org-closed-keep-when-no-todo nil + "Remove CLOSED: time-stamp when switching back to a non-todo state?" + :group 'org-todo + :group 'org-keywords + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" org-scheduled-string "\\|" org-deadline-string "\\|" @@ -786,7 +958,7 @@ contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location :type org-context-choice) -(defcustom org-show-siblings '((default . nil) (isearch t)) +(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t)) "Non-nil means show all sibling heading when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the sibling of the current entry @@ -800,7 +972,9 @@ use the command \\[org-reveal] to show more context. Instead of t, this can also be an alist specifying this option for different contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location - :type org-context-choice) + :type org-context-choice + :version "24.4" + :package-version '(Org . "8.0")) (defcustom org-show-entry-below '((default . nil)) "Non-nil means show the entry below a headline when revealing a location. @@ -865,6 +1039,21 @@ commands in the Help buffer using the `?' speed command." (function) (sexp)))))) +(defcustom org-bookmark-names-plist + '(:last-capture "org-capture-last-stored" + :last-refile "org-refile-last-stored" + :last-capture-marker "org-capture-last-stored-marker") + "Names for bookmarks automatically set by some Org commands. +This can provide strings as names for a number of bookmarks Org sets +automatically. The following keys are currently implemented: + :last-capture + :last-capture-marker + :last-refile +When a key does not show up in the property list, the corresponding bookmark +is not set." + :group 'org-structure + :type 'plist) + (defgroup org-cycle nil "Options concerning visibility cycling in Org-mode." :tag "Org Cycle" @@ -957,8 +1146,7 @@ visibility is cycled." (const :tag "Only in completely white lines" white) (const :tag "Before first char in a line" whitestart) (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol) - )) + (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) (defcustom org-cycle-separator-lines 2 "Number of empty lines needed to keep an empty line between collapsed trees. @@ -990,6 +1178,7 @@ the values `folded', `children', or `subtree'." (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees org-cycle-hide-drawers + org-cycle-hide-inline-tasks org-cycle-show-empty-lines org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. @@ -1083,8 +1272,7 @@ This may also be a cons cell where the behavior for `C-a' and (const :tag "off" nil) (const :tag "on: before tags first" t) (const :tag "reversed: after tags first" reversed))))) -(if (fboundp 'defvaralias) - (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) +(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) (defcustom org-special-ctrl-k nil "Non-nil means `C-k' will behave specially in headlines. @@ -1111,6 +1299,11 @@ OK to kill that hidden subtree. When nil, kill without remorse." (const :tag "Protect hidden subtrees with a security query" t) (const :tag "Never kill a hidden subtree with C-k" error))) +(defcustom org-special-ctrl-o t + "Non-nil means, make `C-o' insert a row in tables." + :group 'org-edit-structure + :type 'boolean) + (defcustom org-catch-invisible-edits nil "Check if in invisible region before inserting or deleting a character. Valid values are: @@ -1180,9 +1373,8 @@ default the value to be used for all contexts not explicitly (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. When nil, the new heading is created directly after the current line. -The commands \\[org-insert-heading-respect-content] and -\\[org-insert-todo-heading-respect-content] turn this variable on -for the duration of the command." +The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn +this variable on for the duration of the command." :group 'org-structure :type 'boolean) @@ -1194,9 +1386,9 @@ and a boolean flag as CDR. The cdr may also be the symbol `auto', in which case Org will look at the surrounding headings/items and try to make an intelligent decision whether to insert a blank line or not. -For plain lists, if the variable `org-empty-line-terminates-plain-lists' is -set, the setting here is ignored and no empty line is inserted, to avoid -breaking the list structure." +For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, +the setting here is ignored and no empty line is inserted to avoid breaking +the list structure." :group 'org-edit-structure :type '(list (cons (const heading) @@ -1430,7 +1622,7 @@ two parameters: the first one is the link, the second one is the description generated by `org-insert-link'. The function should return the description to use." :group 'org-link - :type 'function) + :type '(choice (const nil) (function))) (defgroup org-link-store nil "Options concerning storing links in Org-mode." @@ -1519,7 +1711,7 @@ Org contains a function for this, so if you set this variable to `org-translate-link-from-planner', you should be able follow many links created by planner." :group 'org-link-follow - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-follow-link-hook nil "Hook that is run after a link has been followed." @@ -1535,7 +1727,8 @@ implementation is bad." :type 'boolean) (defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link." + "Non-nil means on links RET will follow the link. +In tables, the special behavior of RET has precedence." :group 'org-link-follow :type 'boolean) @@ -1545,7 +1738,12 @@ implementation is bad." A longer mouse click will still set point. Does not work on XEmacs. Needs to be set before org.el is loaded." :group 'org-link-follow - :type 'boolean) + :version "24.4" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "A double click follows the link" double) + (const :tag "Unconditionally follow the link with mouse-1" t) + (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) (defcustom org-mark-ring-length 4 "Number of different positions to be recorded in the ring. @@ -1600,6 +1798,11 @@ another window." (const vm-visit-folder) (const vm-visit-folder-other-window) (const vm-visit-folder-other-frame))) + (cons (const vm-imap) + (choice + (const vm-visit-imap-folder) + (const vm-visit-imap-folder-other-window) + (const vm-visit-imap-folder-other-frame))) (cons (const gnus) (choice (const gnus) @@ -1746,12 +1949,10 @@ The system \"open\" is used for most files. See `org-file-apps'.") (defcustom org-file-apps - '( - (auto-mode . emacs) + '((auto-mode . emacs) ("\\.mm\\'" . default) ("\\.x?html?\\'" . default) - ("\\.pdf\\'" . default) - ) + ("\\.pdf\\'" . default)) "External applications for opening `file:path' items in a document. Org-mode uses system defaults for different file types, but you can use this variable to set the application for a given file @@ -1865,16 +2066,14 @@ following situations: note buffer with `C-1 C-c C-c'. The user is prompted for an org file, with `org-directory' as the default path." :group 'org-refile - :group 'org-remember :group 'org-capture :type 'directory) (defcustom org-default-notes-file (convert-standard-filename "~/.notes") "Default target for storing notes. -Used as a fall back file for org-remember.el and org-capture.el, for -templates that do not specify a target file." +Used as a fall back file for org-capture.el, for templates that +do not specify a target file." :group 'org-refile - :group 'org-remember :group 'org-capture :type '(choice (const :tag "Default from remember-data-file" nil) @@ -1904,7 +2103,6 @@ outline-path-completion Headlines in the current buffer are offered via When nil, new notes will be filed to the end of a file or entry. This can also be a list with cons cells of regular expressions that are matched against file names, and values." - :group 'org-remember :group 'org-capture :group 'org-refile :type '(choice @@ -2000,7 +2198,9 @@ should be continued. For example, the function may decide that the entire subtree of the current entry should be excluded and move point to the end of the subtree." :group 'org-refile - :type 'function) + :type '(choice + (const nil) + (function))) (defcustom org-refile-use-cache nil "Non-nil means cache refile targets to speed up the process. @@ -2046,7 +2246,7 @@ fast, while still showing the whole path to the entry." "Non-nil means allow to create new nodes as refile targets. New nodes are then created by adding \"/new node name\" to the completion of an existing node. When the value of this variable is `confirm', -new node creation must be confirmed by the user (recommended) +new node creation must be confirmed by the user (recommended). When nil, the completion must match an existing entry. Note that, if the new heading is not seen by the criteria @@ -2157,7 +2357,12 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (defvar org-done-keywords-for-agenda nil) (defvar org-drawers-for-agenda nil) (defvar org-todo-keyword-alist-for-agenda nil) -(defvar org-tag-alist-for-agenda nil) +(defvar org-tag-alist-for-agenda nil + "Alist of all tags from all agenda files.") +(defvar org-tag-groups-alist-for-agenda nil + "Alist of all groups tags from all current agenda files.") +(defvar org-tag-groups-alist nil) +(make-variable-buffer-local 'org-tag-groups-alist) (defvar org-agenda-contributing-files nil) (defvar org-not-done-keywords nil) (make-variable-buffer-local 'org-not-done-keywords) @@ -2223,7 +2428,7 @@ current entry each time a todo state is changed." :group 'org-todo :type '(choice (const :tag "Yes, only for TODO entries" t) - (const :tag "Yes, including all entries" 'all-headlines) + (const :tag "Yes, including all entries" all-headlines) (repeat :tag "Yes, for TODOs in this list" (string :tag "TODO keyword")) (other :tag "No TODO statistics" nil))) @@ -2470,12 +2675,12 @@ agenda log mode depends on the format of these entries." "Heading when changing todo state (todo sequence only)" state) string) (cons (const :tag "Heading when just taking a note" note) string) - (cons (const :tag "Heading when clocking out" clock-out) string) - (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) (cons (const :tag "Heading when rescheduling" reschedule) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) (cons (const :tag "Heading when changing deadline" redeadline) string) (cons (const :tag "Heading when deleting a deadline" deldeadline) string) - (cons (const :tag "Heading when refiling" refile) string))) + (cons (const :tag "Heading when refiling" refile) string) + (cons (const :tag "Heading when clocking out" clock-out) string))) (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) @@ -2491,6 +2696,11 @@ also set this to a string to define the drawer of your choice. A value of t is also allowed, representing \"LOGBOOK\". +A value of t or nil can also be set with on a per-file-basis with + + #+STARTUP: logdrawer + #+STARTUP: nologdrawer + If this variable is set, `org-log-state-notes-insert-after-drawers' will be ignored. @@ -2503,8 +2713,7 @@ a subtree." (const :tag "LOGBOOK" t) (string :tag "Other"))) -(if (fboundp 'defvaralias) - (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)) +(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) (defun org-log-into-drawer () "Return the value of `org-log-into-drawer', but let properties overrule. @@ -2532,7 +2741,12 @@ set." (defcustom org-log-states-order-reversed t "Non-nil means the latest state note will be directly after heading. -When nil, the state change notes will be ordered according to time." +When nil, the state change notes will be ordered according to time. + +This option can also be set with on a per-file-basis with + + #+STARTUP: logstatesreversed + #+STARTUP: nologstatesreversed" :group 'org-todo :group 'org-progress :type 'boolean) @@ -2629,7 +2843,9 @@ The user can set a different function here, which should take a string as an argument and return the numeric priority." :group 'org-priorities :version "24.1" - :type 'function) + :type '(choice + (const nil) + (function))) (defgroup org-time nil "Options concerning time stamps and deadlines in Org-mode." @@ -2705,26 +2921,137 @@ commands, if custom time display is turned on at the time of export." (concat "[" (substring f 1 -1) "]") f))) -(defcustom org-time-clocksum-format "%d:%02d" +(defcustom org-time-clocksum-format + '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t) "The format string used when creating CLOCKSUM lines. -This is also used when org-mode generates a time duration." +This is also used when Org mode generates a time duration. + +The value can be a single format string containing two +%-sequences, which will be filled with the number of hours and +minutes in that order. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +format strings. The time duration is formatted using only the +time components that are needed and concatenating the results. +If a time unit in absent, it falls back to the next smallest +unit. + +The keys :require-years, :require-months, :require-days, +:require-weeks, :require-hours, :require-minutes are also +meaningful. A non-nil value for these keys indicates that the +corresponding time component should always be included, even if +its value is 0. + + +For example, + + \(:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" + :require-minutes t) + +means durations longer than a day will be expressed in days, +hours and minutes, and durations less than a day will always be +expressed in hours and minutes (even for durations less than an +hour). + +The value + + \(:days \"%dd\" :minutes \"%dm\") + +means durations longer than a day will be expressed in days and +minutes, and durations less than a day will be expressed entirely +in minutes (even for durations longer than an hour)." :group 'org-time - :type 'string) + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (string :tag "Format string") + (set :tag "Plist" + (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show years" :require-years) + (const t)) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show months" :require-months) + (const t)) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show weeks" :require-weeks) + (const t)) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show days" :require-days) + (const t)) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show hours" :require-hours) + (const t)) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show minutes" :require-minutes) + (const t))))) (defcustom org-time-clocksum-use-fractional nil - "If non-nil, \\[org-clock-display] uses fractional times. -org-mode generates a time duration." + "When non-nil, \\[org-clock-display] uses fractional times. +See `org-time-clocksum-format' for more on time clock formats." :group 'org-time + :group 'org-clock + :version "24.3" + :type 'boolean) + +(defcustom org-time-clocksum-use-effort-durations nil + "When non-nil, \\[org-clock-display] uses effort durations. +E.g. by default, one day is considered to be a 8 hours effort, +so a task that has been clocked for 16 hours will be displayed +as during 2 days in the clock display or in the clocktable. + +See `org-effort-durations' on how to set effort durations +and `org-time-clocksum-format' for more on time clock formats." + :group 'org-time + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) (defcustom org-time-clocksum-fractional-format "%.2f" - "The format string used when creating CLOCKSUM lines, or when -org-mode generates a time duration." + "The format string used when creating CLOCKSUM lines, +or when Org mode generates a time duration, if +`org-time-clocksum-use-fractional' is enabled. + +The value can be a single format string containing one +%-sequence, which will be filled with the number of hours as +a float. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +a format string. The time duration is formatted using the +largest time unit which gives a non-zero integer part. If all +specified formats have zero integer part, the smallest time unit +is used." :group 'org-time - :type 'string) + :type '(choice (string :tag "Format string") + (set (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string"))))) (defcustom org-deadline-warning-days 14 - "No. of days before expiration during which a deadline becomes active. + "Number of days before expiration during which a deadline becomes active. This variable governs the display in sparse trees and in the agenda. When 0 or negative, it means use this number (the absolute value of it) even if a deadline has a different individual lead time specified. @@ -2734,6 +3061,21 @@ Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type 'integer) +(defcustom org-scheduled-delay-days 0 + "Number of days before a scheduled item becomes active. +This variable governs the display in sparse trees and in the agenda. +The default value (i.e. 0) means: don't delay scheduled item. +When negative, it means use this number (the absolute value of it) +even if a scheduled item has a different individual delay time +specified. + +Custom commands can set this variable in the options section." + :group 'org-time + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + (defcustom org-read-date-prefer-future t "Non-nil means assume future for incomplete date input from user. This affects the following situations: @@ -2821,14 +3163,19 @@ minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." :group 'org-time :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-popup-calendar-for-date-prompt - 'org-read-date-popup-calendar)) +(org-defvaralias 'org-popup-calendar-for-date-prompt + 'org-read-date-popup-calendar) +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "Set `org-read-date-minibuffer-local-map' instead." "24.4") (defcustom org-read-date-minibuffer-setup-hook nil "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a temporary -copy." +Add key definitions to `minibuffer-local-map', which will be a +temporary copy. + +WARNING: This option is obsolete, you should use +`org-read-date-minibuffer-local-map' to set up keys." :group 'org-time :type 'hook) @@ -2856,6 +3203,15 @@ For example, if `org-extend-today-until' is 8, and it's 4am, then the :version "24.1" :type 'boolean) +(defcustom org-use-last-clock-out-time-as-effective-time nil + "When non-nil, use the last clock out time for `org-todo'. +Note that this option has precedence over the combined use of +`org-use-effective-time' and `org-extend-today-until'." + :group 'org-time + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-edit-timestamp-down-means-later nil "Non-nil means S-down will increase the time in a time stamp. When nil, S-up will increase." @@ -2890,6 +3246,8 @@ See the manual for details." (list :tag "Start radio group" (const :startgroup) (option (string :tag "Group description"))) + (list :tag "Group tags delimiter" + (const :grouptags)) (list :tag "End radio group" (const :endgroup) (option (string :tag "Group description"))) @@ -2912,6 +3270,7 @@ To disable these tags on a per-file basis, insert anywhere in the file: (cons (string :tag "Tag name") (character :tag "Access char")) (const :tag "Start radio group" (:startgroup)) + (const :tag "Group tags delimiter" (:grouptags)) (const :tag "End radio group" (:endgroup)) (const :tag "New line" (:newline))))) @@ -2949,7 +3308,7 @@ automatically if necessary." :type '(choice (const :tag "Always" t) (const :tag "Never" nil) - (const :tag "When selection characters are configured" 'auto))) + (const :tag "When selection characters are configured" auto))) (defcustom org-fast-tag-selection-single-key nil "Non-nil means fast tag selection exits after first change. @@ -3094,7 +3453,7 @@ and the clock summary: (let ((clocksum (org-clock-sum-current-item)) (effort (org-duration-string-to-minutes (org-entry-get (point) \"Effort\")))) - (org-minutes-to-hh:mm-string (- effort clocksum))))))" + (org-minutes-to-clocksum-string (- effort clocksum))))))" :group 'org-properties :version "24.1" :type '(alist :key-type (string :tag "Property") @@ -3170,7 +3529,7 @@ value The value that should be modified. The function should return the value that should be displayed, or nil if the normal value should be used." :group 'org-properties - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-effort-property "Effort" "The property that is being used to keep track of effort estimates. @@ -3263,23 +3622,22 @@ regular expression will be included." (defcustom org-agenda-text-search-extra-files nil "List of extra files to be searched by text search commands. -These files will be search in addition to the agenda files by the +These files will be searched in addition to the agenda files by the commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. Note that these files will only be searched for text search commands, not for the other agenda views like todo lists, tag searches or the weekly agenda. This variable is intended to list notes and possibly archive files that should also be searched by these two commands. In fact, if the first element in the list is the symbol `agenda-archives', -than all archive files of all agenda files will be added to the search +then all archive files of all agenda files will be added to the search scope." :group 'org-agenda :type '(set :greedy t (const :tag "Agenda Archives" agenda-archives) (repeat :inline t (file)))) -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-multi-occur-extra-files - 'org-agenda-text-search-extra-files)) +(org-defvaralias 'org-agenda-multi-occur-extra-files + 'org-agenda-text-search-extra-files) (defcustom org-agenda-skip-unavailable-files nil "Non-nil means to just skip non-reachable files in `org-agenda-files'. @@ -3340,8 +3698,10 @@ points to a file, `org-agenda-diary-entry' will be used instead." This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". `default' means use the foreground of the default face. + `auto' means use the foreground from the text face. :background the background color, or \"Transparent\". `default' means use the background of the default face. + `auto' means use the background from the text face. :scale a scaling factor for the size of the images, to get more pixels :html-foreground, :html-background, :html-scale the same numbers for HTML export. @@ -3408,9 +3768,10 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick (const :tag "imagemagick" imagemagick))) (defcustom org-latex-preview-ltxpng-directory "ltxpng/" - "Path to store latex preview images. A relative path here creates many - directories relative to the processed org files paths. An absolute path - puts all preview images at the same place." + "Path to store latex preview images. +A relative path here creates many directories relative to the +processed org files paths. An absolute path puts all preview +images at the same place." :group 'org-latex :version "24.3" :type 'string) @@ -3430,11 +3791,9 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick (defcustom org-format-latex-header "\\documentclass{article} \\usepackage[usenames]{color} -\\usepackage{amsmath} -\\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove \[PACKAGES] \[DEFAULT-PACKAGES] +\\pagestyle{empty} % do not remove % The settings below are copied from fullpage.sty \\setlength{\\textwidth}{\\paperwidth} \\addtolength{\\textwidth}{-3cm} @@ -3451,14 +3810,12 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick "The document header used for processing LaTeX fragments. It is imperative that this header make sure that no page number appears on the page. The package defined in the variables -`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist' -will either replace the placeholder \"[PACKAGES]\" in this header, or they -will be appended." +`org-latex-default-packages-alist' and `org-latex-packages-alist' +will either replace the placeholder \"[PACKAGES]\" in this +header, or they will be appended." :group 'org-latex :type 'string) -(defvar org-format-latex-header-extra nil) - (defun org-set-packages-alist (var val) "Set the packages alist and make sure it has 3 elements per entry." (set var (mapcar (lambda (x) @@ -3468,7 +3825,6 @@ will be appended." val))) (defun org-get-packages-alist (var) - "Get the packages alist and make sure it has 3 elements per entry." (mapcar (lambda (x) (if (and (consp x) (= (length x) 2)) @@ -3476,10 +3832,7 @@ will be appended." x)) (default-value var))) -;; The following variables are defined here because is it also used -;; when formatting latex fragments. Originally it was part of the -;; LaTeX exporter, which is why the name includes "export". -(defcustom org-export-latex-default-packages-alist +(defcustom org-latex-default-packages-alist '(("AUTO" "inputenc" t) ("T1" "fontenc" t) ("" "fixltx2e" nil) @@ -3487,36 +3840,44 @@ will be appended." ("" "longtable" nil) ("" "float" nil) ("" "wrapfig" nil) - ("" "soul" t) + ("" "rotating" nil) + ("normalem" "ulem" t) + ("" "amsmath" t) ("" "textcomp" t) ("" "marvosym" t) ("" "wasysym" t) - ("" "latexsym" t) ("" "amssymb" t) ("" "hyperref" nil) - "\\tolerance=1000" - ) + "\\tolerance=1000") "Alist of default packages to be inserted in the header. -Change this only if one of the packages here causes an incompatibility -with another package you are using. -The packages in this list are needed by one part or another of Org-mode -to function properly. + +Change this only if one of the packages here causes an +incompatibility with another package you are using. + +The packages in this list are needed by one part or another of +Org mode to function properly: - inputenc, fontenc: for basic font and character selection -- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used - for interpreting the entities in `org-entities'. You can skip some of these - packages if you don't use any of the symbols in it. +- fixltx2e: Important patches of LaTeX itself - graphicx: for including images +- longtable: For multipage tables - float, wrapfig: for figure placement -- longtable: for long tables +- rotating: for sideways figures and tables +- ulem: for underline and strike-through +- amsmath: for subscript and superscript and math environments +- textcomp, marvosymb, wasysym, amssymb: for various symbols used + for interpreting the entities in `org-entities'. You can skip + some of these packages if you don't use any of their symbols. - hyperref: for cross references -Therefore you should not modify this variable unless you know what you -are doing. The one reason to change it anyway is that you might be loading -some other package that conflicts with one of the default packages. -Each cell is of the format \( \"options\" \"package\" snippet-flag\). -If SNIPPET-FLAG is t, the package also needs to be included when -compiling LaTeX snippets into images for inclusion into HTML." +Therefore you should not modify this variable unless you know +what you are doing. The one reason to change it anyway is that +you might be loading some other package that conflicts with one +of the default packages. Each cell is of the format +\( \"options\" \"package\" snippet-flag). If SNIPPET-FLAG is t, +the package also needs to be included when compiling LaTeX +snippets into images for inclusion into non-LaTeX output." + :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist @@ -3529,17 +3890,25 @@ compiling LaTeX snippets into images for inclusion into HTML." (boolean :tag "Snippet")) (string :tag "A line of LaTeX")))) -(defcustom org-export-latex-packages-alist nil +(defcustom org-latex-packages-alist nil "Alist of packages to be inserted in every LaTeX header. -These will be inserted after `org-export-latex-default-packages-alist'. -Each cell is of the format \( \"options\" \"package\" snippet-flag \). -SNIPPET-FLAG, when t, indicates that this package is also needed when -turning LaTeX snippets into images for inclusion into HTML. + +These will be inserted after `org-latex-default-packages-alist'. +Each cell is of the format: + + \(\"options\" \"package\" snippet-flag) + +SNIPPET-FLAG, when t, indicates that this package is also needed +when turning LaTeX snippets into images for inclusion into +non-LaTeX output. + Make sure that you only list packages here which: -- you want in every file -- do not conflict with the default packages in - `org-export-latex-default-packages-alist' -- do not conflict with the setup in `org-format-latex-header'." + + - you want in every file + - do not conflict with the setup in `org-format-latex-header'. + - do not conflict with the default packages in + `org-latex-default-packages-alist'." + :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist @@ -3551,7 +3920,6 @@ Make sure that you only list packages here which: (boolean :tag "Snippet")) (string :tag "A line of LaTeX")))) - (defgroup org-appearance nil "Settings for Org-mode appearance." :tag "Org Appearance" @@ -3622,10 +3990,22 @@ org-level-* faces." :group 'org-appearance :type 'boolean) -(defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means fontify what is treated specially by the exporters." +(defcustom org-highlight-latex-and-related nil + "Non-nil means highlight LaTeX related syntax in the buffer. +When non nil, the value should be a list containing any of the +following symbols: + `latex' Highlight LaTeX snippets and environments. + `script' Highlight subscript and superscript. + `entities' Highlight entities." :group 'org-appearance - :type 'boolean) + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "No highlighting" nil) + (set :greedy t :tag "Highlight" + (const :tag "LaTeX snippets and environments" latex) + (const :tag "Subscript and superscript" script) + (const :tag "Entities" entities)))) (defcustom org-hide-emphasis-markers nil "Non-nil mean font-lock should hide the emphasis marker characters." @@ -3674,7 +4054,7 @@ After a match, the match groups contain these elements: (body1 (concat body "*?")) (markers (mapconcat 'car org-emphasis-alist "")) (vmarkers (mapconcat - (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) + (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) org-emphasis-alist ""))) ;; make sure special characters appear at the right position in the class (if (string-match "\\^" markers) @@ -3714,7 +4094,10 @@ After a match, the match groups contain these elements: "\\3\\)" "\\([" post "]\\|$\\)"))))) -(defcustom org-emphasis-regexp-components +;; This used to be a defcustom (Org <8.0) but allowing the users to +;; set this option proved cumbersome. See this message/thread: +;; http://article.gmane.org/gmane.emacs.orgmode/68681 +(defvar org-emphasis-regexp-components '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) "Components used to build the regular expression for emphasis. This is a list with five entries. Terminology: In an emphasis string @@ -3730,48 +4113,36 @@ body-regexp A regexp like \".\" to match a body character. Don't use non-shy groups here, and don't allow newline here. newline The maximum number of newlines allowed in an emphasis exp. -Use customize to modify this, or restart Emacs after changing it." - :group 'org-appearance - :set 'org-set-emph-re - :type '(list - (sexp :tag "Allowed chars in pre ") - (sexp :tag "Allowed chars in post ") - (sexp :tag "Forbidden chars in border ") - (sexp :tag "Regexp for body ") - (integer :tag "number of newlines allowed") - (option (boolean :tag "Please ignore this button")))) +You need to reload Org or to restart Emacs after customizing this.") (defcustom org-emphasis-alist - `(("*" bold "" "") - ("/" italic "" "") - ("_" underline "" "") - ("=" org-code "" "" verbatim) - ("~" org-verbatim "" "" verbatim) - ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)) - "" "") - ) - "Special syntax for emphasized text. -Text starting and ending with a special character will be emphasized, for -example *bold*, _underlined_ and /italic/. This variable sets the marker -characters, the face to be used by font-lock for highlighting in Org-mode -Emacs buffers, and the HTML tags to be used for this. -For LaTeX export, see the variable `org-export-latex-emphasis-alist'. -For DocBook export, see the variable `org-export-docbook-emphasis-alist'. -Use customize to modify this, or restart Emacs after changing it." + `(("*" bold) + ("/" italic) + ("_" underline) + ("=" org-code verbatim) + ("~" org-verbatim verbatim) + ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) + "Alist of characters and faces to emphasize text. +Text starting and ending with a special character will be emphasized, +for example *bold*, _underlined_ and /italic/. This variable sets the +marker characters and the face to be used by font-lock for highlighting +in Org-mode Emacs buffers. + +You need to reload Org or to restart Emacs after customizing this." :group 'org-appearance :set 'org-set-emph-re + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat (list (string :tag "Marker character") (choice (face :tag "Font-lock-face") (plist :tag "Face property list")) - (string :tag "HTML start tag") - (string :tag "HTML end tag") (option (const verbatim))))) (defvar org-protecting-blocks - '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R") + '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") "Blocks that contain text that is quoted, i.e. not processed as Org syntax. This is needed for font-lock setup.") @@ -3838,7 +4209,7 @@ Normal means, no org-mode-specific context." (declare-function org-agenda-skip "org-agenda" ()) (declare-function org-agenda-format-item "org-agenda" - (extra txt &optional category tags dotime noprefix remove-re habitp)) + (extra txt &optional level category tags dotime noprefix remove-re habitp)) (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) @@ -3856,16 +4227,12 @@ Normal means, no org-mode-specific context." (declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function org-attach-reveal "org-attach" (&optional if-exists)) -(declare-function org-export-latex-fix-inputenc "org-latex" ()) (declare-function orgtbl-send-table "org-table" (&optional maybe)) (defvar remember-data-file) (defvar texmathp-why) (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) -(defvar w3m-current-url) -(defvar w3m-current-title) - (defvar org-latex-regexps) ;;; Autoload and prepare some org modules @@ -3887,11 +4254,8 @@ Normal means, no org-mode-specific context." "Detect the first line outside a table when searching from within it. This works for both table types.") -;; Autoload the functions in org-table.el that are needed by functions here. - -(eval-and-compile - (org-autoload "org-table" - '(org-table-begin org-table-blank-field org-table-end))) +(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " + "Detect a #+TBLFM line.") ;;;###autoload (defun turn-on-orgtbl () @@ -3951,7 +4315,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (looking-at org-table-hline-regexp)) nil)) -(defvar org-table-clean-did-remove-column nil) (defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." (save-excursion @@ -3971,22 +4334,19 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (re-search-forward org-table-any-border-regexp nil 1)))) (unless quietly (message "Mapping tables: done"))) -;; Declare and autoload functions from org-exp.el & Co - -(declare-function org-default-export-plist "org-exp") -(declare-function org-infile-export-plist "org-exp") -(declare-function org-get-current-options "org-exp") - -;; Declare and autoload functions from org-agenda.el - -(eval-and-compile - (org-autoload "org-agenda" - '(org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) - (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) (declare-function org-clock-update-mode-line "org-clock" ()) (declare-function org-resolve-clocks "org-clock" (&optional also-non-dangling-p prompt last-valid)) + +(defun org-at-TBLFM-p (&optional pos) + "Return t when point (or POS) is in #+TBLFM line." + (save-excursion + (let ((pos pos))) + (goto-char (or pos (point))) + (beginning-of-line 1) + (looking-at org-TBLFM-regexp))) + (defvar org-clock-start-time) (defvar org-clock-marker (make-marker) "Marker recording the last clock-in.") @@ -3995,15 +4355,10 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-heading "" "The heading of the current clock entry.") (defun org-clock-is-active () - "Return non-nil if clock is currently running. -The return value is actually the clock marker." + "Return the buffer where the clock is currently running. +Return nil if no clock is running." (marker-buffer org-clock-marker)) -(eval-and-compile - (org-autoload "org-clock" '(org-clock-remove-overlays - org-clock-update-time-maybe - org-clocktable-shift))) - (defun org-check-running-clock () "Check if the current buffer contains the running clock. If yes, offer to stop it and to save the buffer with the changes." @@ -4150,12 +4505,13 @@ Otherwise, these types are allowed: inactive: only inactive timestamps (<...) scheduled: only scheduled timestamps deadline: only deadline timestamps" - :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline) + :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline) (const :tag "All timestamps" all) (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) (const :tag "Only scheduled timestamps" scheduled) - (const :tag "Only deadline timestamps" deadline)) + (const :tag "Only deadline timestamps" deadline) + (const :tag "Only closed timestamps" closed)) :version "24.3" :group 'org-sparse-trees) @@ -4202,33 +4558,18 @@ Otherwise, these types are allowed: (defalias 'org-advertized-archive-subtree 'org-archive-subtree) -(eval-and-compile - (org-autoload "org-archive" - '(org-add-archive-files))) - -;; Autoload Column View Code +;; Declare Column View Code (declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) (declare-function org-columns-get-format-and-top-level "org-colview" ()) (declare-function org-columns-compute "org-colview" (property)) -(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") - '(org-columns-number-to-string - org-columns-get-format-and-top-level - org-columns-compute - org-columns-remove-overlays)) - -;; Autoload ID code +;; Declare ID code (declare-function org-id-store-link "org-id") (declare-function org-id-locations-load "org-id") (declare-function org-id-locations-save "org-id") (defvar org-id-track-globally) -(org-autoload "org-id" - '(org-id-new - org-id-copy - org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling)) ;;; Variables for pre-computed regular expressions, all buffer local @@ -4274,6 +4615,9 @@ Also put tags into group 4 if tags are present.") (defvar org-deadline-time-regexp nil "Matches the DEADLINE keyword together with a time stamp.") (make-variable-buffer-local 'org-deadline-time-regexp) +(defvar org-deadline-time-hour-regexp nil + "Matches the DEADLINE keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-deadline-time-hour-regexp) (defvar org-deadline-line-regexp nil "Matches the DEADLINE keyword and the rest of the line.") (make-variable-buffer-local 'org-deadline-line-regexp) @@ -4283,6 +4627,9 @@ Also put tags into group 4 if tags are present.") (defvar org-scheduled-time-regexp nil "Matches the SCHEDULED keyword together with a time stamp.") (make-variable-buffer-local 'org-scheduled-time-regexp) +(defvar org-scheduled-time-hour-regexp nil + "Matches the SCHEDULED keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-scheduled-time-hour-regexp) (defvar org-closed-time-regexp nil "Matches the CLOSED keyword together with a time stamp.") (make-variable-buffer-local 'org-closed-time-regexp) @@ -4357,6 +4704,8 @@ After a match, the following groups carry important information: ("noalign" org-startup-align-all-tables nil) ("inlineimages" org-startup-with-inline-images t) ("noinlineimages" org-startup-with-inline-images nil) + ("latexpreview" org-startup-with-latex-preview t) + ("nolatexpreview" org-startup-with-latex-preview nil) ("customtime" org-display-custom-times t) ("logdone" org-log-done time) ("lognotedone" org-log-done note) @@ -4365,6 +4714,10 @@ After a match, the following groups carry important information: ("nolognoteclock-out" org-log-note-clock-out nil) ("logrepeat" org-log-repeat state) ("lognoterepeat" org-log-repeat note) + ("logdrawer" org-log-into-drawer t) + ("nologdrawer" org-log-into-drawer nil) + ("logstatesreversed" org-log-states-order-reversed t) + ("nologstatesreversed" org-log-states-order-reversed nil) ("nologrepeat" org-log-repeat nil) ("logreschedule" org-log-reschedule time) ("lognotereschedule" org-log-reschedule note) @@ -4413,19 +4766,121 @@ means to push this value onto the list in the variable.") "Regular expression for hiding blocks.") (defconst org-heading-keyword-regexp-format "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching an headline with some keyword. + "Printf format for a regexp matching a headline with some keyword. This regexp will match the headline of any node which has the exact keyword that is put into the format. The keyword isn't in any group by default, but the stars and the body are.") (defconst org-heading-keyword-maybe-regexp-format "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching an headline, possibly with some keyword. + "Printf format for a regexp matching a headline, possibly with some keyword. This regexp can match any headline with the specified keyword, or without a keyword. The keyword isn't in any group by default, but the stars and the body are.") +(defcustom org-group-tags t + "When non-nil (the default), use group tags. +This can be turned on/off through `org-toggle-tags-groups'." + :group 'org-tags + :group 'org-startup + :type 'boolean) + +(defvar org-inhibit-startup nil) ; Dynamically-scoped param. + +(defun org-toggle-tags-groups () + "Toggle support for group tags. +Support for group tags is controlled by the option +`org-group-tags', which is non-nil by default." + (interactive) + (setq org-group-tags (not org-group-tags)) + (cond ((and (derived-mode-p 'org-agenda-mode) + org-group-tags) + (org-agenda-redo)) + ((derived-mode-p 'org-mode) + (let ((org-inhibit-startup t)) (org-mode)))) + (message "Groups tags support has been turned %s" + (if org-group-tags "on" "off"))) + +(defun org-set-regexps-and-options-for-tags () + "Precompute variables used for tags." + (when (derived-mode-p 'org-mode) + (org-set-local 'org-file-tags nil) + (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) + (splitre "[ \t]+") + (start 0) + tags ftags key value) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq key (upcase (org-match-string-no-properties 1)) + value (org-match-string-no-properties 2)) + (if (stringp value) (setq value (org-trim value))) + (cond + ((equal key "TAGS") + (setq tags (append tags (if tags '("\\n") nil) + (org-split-string value splitre)))) + ((equal key "FILETAGS") + (when (string-match "\\S-" value) + (setq ftags + (append + ftags + (apply 'append + (mapcar (lambda (x) (org-split-string x ":")) + (org-split-string value))))))))))) + ;; Process the file tags. + (and ftags (org-set-local 'org-file-tags + (mapcar 'org-add-prop-inherited ftags))) + (org-set-local 'org-tag-groups-alist nil) + ;; Process the tags. + (when (and (not tags) org-tag-alist) + (setq tags + (mapcar + (lambda (tg) (cond ((eq (car tg) :startgroup) "{") + ((eq (car tg) :endgroup) "}") + ((eq (car tg) :grouptags) ":") + ((eq (car tg) :newline) "\n") + (t (concat (car tg) + (if (characterp (cdr tg)) + (format "(%s)" (char-to-string (cdr tg))) ""))))) + org-tag-alist))) + (let (e tgs g) + (while (setq e (pop tags)) + (cond + ((equal e "{") + (progn (push '(:startgroup) tgs) + (when (equal (nth 1 tags) ":") + (push (list (replace-regexp-in-string + "(.+)$" "" (nth 0 tags))) + org-tag-groups-alist) + (setq g 0)))) + ((equal e ":") (push '(:grouptags) tgs)) + ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) + ((equal e "\\n") (push '(:newline) tgs)) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) + (push (cons (match-string 1 e) + (string-to-char (match-string 2 e))) tgs) + (if (and g (> g 0)) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) + (list (match-string 1 e))))) + (if g (setq g (1+ g)))) + (t (push (list e) tgs) + (if (and g (> g 0)) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) (list e)))) + (if g (setq g (1+ g)))))) + (org-set-local 'org-tag-alist nil) + (while (setq e (pop tgs)) + (or (and (stringp (car e)) + (assoc (car e) org-tag-alist)) + (push e org-tag-alist))) + ;; Return a list with tag variables + (list org-file-tags org-tag-alist org-tag-groups-alist))))) + +(defvar org-ota nil) (defun org-set-regexps-and-options () - "Precompute regular expressions for current buffer." + "Precompute regular expressions used in the current buffer." (when (derived-mode-p 'org-mode) (org-set-local 'org-todo-kwd-alist nil) (org-set-local 'org-todo-key-alist nil) @@ -4436,27 +4891,43 @@ but the stars and the body are.") (org-set-local 'org-todo-sets nil) (org-set-local 'org-todo-log-states nil) (org-set-local 'org-file-properties nil) - (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp - '("CATEGORY" "TODO" "COLUMNS" - "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS" - "OPTIONS") + '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" + "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" + "SETUPFILE" "OPTIONS") "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) (splitre "[ \t]+") (scripts org-use-sub-superscripts) - kwds kws0 kwsa key log value cat arch tags const links hw dws - tail sep kws1 prio props ftags drawers beamer-p - ext-setup-or-nil setup-contents (start 0)) + kwds kws0 kwsa key log value cat arch const links hw dws + tail sep kws1 prio props drawers ext-setup-or-nil setup-contents + (start 0)) (save-excursion (save-restriction (widen) (goto-char (point-min)) - (while (or (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) + (while + (or (and + ext-setup-or-nil + (not org-ota) + (let (ret) + (with-temp-buffer + (insert ext-setup-or-nil) + (let ((major-mode 'org-mode) org-ota) + (setq ret (save-match-data + (org-set-regexps-and-options-for-tags))))) + ;; Append setupfile tags to existing tags + (setq org-ota t) + (setq org-file-tags + (delq nil (append org-file-tags (nth 0 ret))) + org-tag-alist + (delq nil (append org-tag-alist (nth 1 ret))) + org-tag-groups-alist + (delq nil (append org-tag-groups-alist (nth 2 ret)))))) + (and ext-setup-or-nil + (string-match re ext-setup-or-nil start) + (setq start (match-end 0))) + (and (setq ext-setup-or-nil nil start 0) + (re-search-forward re nil t))) (setq key (upcase (match-string 1 ext-setup-or-nil)) value (org-match-string-no-properties 2 ext-setup-or-nil)) (if (stringp value) (setq value (org-trim value))) @@ -4471,9 +4942,6 @@ but the stars and the body are.") ;; general TODO-like setup (push (cons (intern (downcase (match-string 1 key))) (org-split-string value splitre)) kwds)) - ((equal key "TAGS") - (setq tags (append tags (if tags '("\\n") nil) - (org-split-string value splitre)))) ((equal key "COLUMNS") (org-set-local 'org-columns-default-format value)) ((equal key "LINK") @@ -4488,18 +4956,10 @@ but the stars and the body are.") (setq props (org-update-property-plist (match-string 1 value) (match-string 2 value) props)))) - ((equal key "FILETAGS") - (when (string-match "\\S-" value) - (setq ftags - (append - ftags - (apply 'append - (mapcar (lambda (x) (org-split-string x ":")) - (org-split-string value))))))) ((equal key "DRAWERS") (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") - (setq const (append const (org-split-string value splitre)))) + (org-table-set-constants)) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) l var val) @@ -4516,12 +4976,12 @@ but the stars and the body are.") (setq arch value) (remove-text-properties 0 (length arch) '(face t fontified t) arch)) - ((equal key "LATEX_CLASS") - (setq beamer-p (equal value "beamer"))) ((equal key "OPTIONS") (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) (setq scripts (read (match-string 2 value))))) - ((equal key "SETUPFILE") + ((and (equal key "SETUPFILE") + ;; Prevent checking in Gnus messages + (not buffer-read-only)) (setq setup-contents (org-file-contents (expand-file-name (org-remove-double-quotes value)) @@ -4553,8 +5013,6 @@ but the stars and the body are.") (org-set-local 'org-lowest-priority (nth 1 prio)) (org-set-local 'org-default-priority (nth 2 prio))) (and props (org-set-local 'org-file-properties (nreverse props))) - (and ftags (org-set-local 'org-file-tags - (mapcar 'org-add-prop-inherited ftags))) (and drawers (org-set-local 'org-drawers drawers)) (and arch (org-set-local 'org-archive-location arch)) (and links (setq org-link-abbrev-alist-local (nreverse links))) @@ -4605,33 +5063,6 @@ but the stars and the body are.") org-todo-kwd-alist (nreverse org-todo-kwd-alist) org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) - ;; Process the constants - (when const - (let (e cst) - (while (setq e (pop const)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))) - - ;; Process the tags. - (when tags - (let (e tgs) - (while (setq e (pop tags)) - (cond - ((equal e "{") (push '(:startgroup) tgs)) - ((equal e "}") (push '(:endgroup) tgs)) - ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) - tgs)) - (t (push (list e) tgs)))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist))))) - ;; Compute the regular expressions and other local variables. ;; Using `org-outline-regexp-bol' would complicate them much, ;; because of the fixed white space at the end of that string. @@ -4688,12 +5119,18 @@ but the stars and the body are.") org-deadline-regexp (concat "\\<" org-deadline-string) org-deadline-time-regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") + org-deadline-time-hour-regexp + (concat "\\<" org-deadline-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") org-deadline-line-regexp (concat "\\<\\(" org-deadline-string "\\).*") org-scheduled-regexp (concat "\\<" org-scheduled-string) org-scheduled-time-regexp (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + org-scheduled-time-hour-regexp + (concat "\\<" org-scheduled-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") org-closed-time-regexp (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") org-keyword-time-regexp @@ -4717,20 +5154,16 @@ but the stars and the body are.") org-all-time-keywords (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string - org-clock-string org-closed-string)) - ) - (org-compute-latex-and-specials-regexp) - (org-set-font-lock-defaults)))) + org-clock-string org-closed-string))) + (setq org-ota nil) + (org-compute-latex-and-related-regexp)))) (defun org-file-contents (file &optional noerror) "Return the contents of FILE, as a string." (if (or (not file) (not (file-readable-p file))) (if noerror - (progn - (message "Cannot read file \"%s\"" file) - (ding) (sit-for 2) - "") + (message "Cannot read file \"%s\"" file) (error "Cannot read file \"%s\"" file)) (with-temp-buffer (insert-file-contents file) @@ -4763,7 +5196,7 @@ This will extract info from a string like \"WAIT(w@/!)\"." Respect keys that are already there." (let (new e (alt ?0)) (while (setq e (pop alist)) - (if (or (memq (car e) '(:newline :endgroup :startgroup)) + (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (cdr e)) ;; Key already assigned. (push e new) (let ((clist (string-to-list (downcase (car e)))) @@ -4813,7 +5246,6 @@ This variable is set by `org-before-change-function'. "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) (defvar org-mode-map) -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. (defvar org-inhibit-logging nil) ; Dynamically-scoped param. @@ -4834,7 +5266,7 @@ This variable is set by `org-before-change-function'. (require 'easymenu) (require 'overlay) -(require 'org-macs) +;; (require 'org-macs) moved higher up in the file before it is first used (require 'org-entities) ;; (require 'org-compat) moved higher up in the file before it is first used (require 'org-faces) @@ -4842,15 +5274,10 @@ This variable is set by `org-before-change-function'. (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) +(require 'org-macro) ;; babel (require 'ob) -(require 'ob-table) -(require 'ob-lob) -(require 'ob-ref) -(require 'ob-tangle) -(require 'ob-comint) -(require 'ob-keys) ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4910,13 +5337,17 @@ The following commands are available: org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) + (org-set-regexps-and-options-for-tags) (org-set-regexps-and-options) + (org-set-font-lock-defaults) (when (and org-tag-faces (not org-tags-special-faces-re)) ;; tag faces set outside customize.... force initialization. (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded (org-set-local 'calc-embedded-open-mode "# ") + ;; Modify a few syntax entries (modify-syntax-entry ?@ "w") + (modify-syntax-entry ?\" "\"") (if org-startup-truncated (setq truncate-lines t)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) (org-set-local 'font-lock-unfontify-region-function @@ -4927,18 +5358,20 @@ The following commands are available: 'local) ;; Check for running clock before killing a buffer (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) + ;; Initialize macros templates. + (org-macro-initialize-templates) + ;; Initialize radio targets. + (org-update-radio-target-regexp) ;; Indentation. (org-set-local 'indent-line-function 'org-indent-line) (org-set-local 'indent-region-function 'org-indent-region) - ;; Initialize radio targets. - (org-update-radio-target-regexp) ;; Filling and auto-filling. (org-setup-filling) ;; Comments. (org-setup-comments-handling) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-back-to-heading) - (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t))) + (org-set-local 'beginning-of-defun-function 'org-backward-element) + (org-set-local 'end-of-defun-function 'org-forward-element) ;; Next error for sparse trees (org-set-local 'next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it @@ -4994,18 +5427,32 @@ The following commands are available: (= (point-min) (point-max))) (insert "# -*- mode: org -*-\n\n")) (unless org-inhibit-startup - (and org-startup-with-beamer-mode (org-beamer-mode)) - (when org-startup-align-all-tables - (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align 'quietly) - (set-buffer-modified-p bmp))) - (when org-startup-with-inline-images - (org-display-inline-images)) - (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility))) + (org-unmodified + (and org-startup-with-beamer-mode (org-beamer-mode)) + (when org-startup-align-all-tables + (org-table-map-tables 'org-table-align 'quietly)) + (when org-startup-with-inline-images + (org-display-inline-images)) + (when org-startup-with-latex-preview + (org-preview-latex-fragment)) + (unless org-inhibit-startup-visibility-stuff + (org-set-startup-visibility)))) ;; Try to set org-hide correctly (set-face-foreground 'org-hide (org-find-invisible-foreground))) +;; Update `customize-package-emacs-version-alist' +(add-to-list 'customize-package-emacs-version-alist + '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") + ("7.8.11" . "24.1") ("7.9.4" . "24.3") + ("8.0" . "24.4"))) + +(defvar org-mode-transpose-word-syntax-table + (let ((st (make-syntax-table))) + (mapc (lambda(c) (modify-syntax-entry + (string-to-char (car c)) "w p" st)) + org-emphasis-alist) + st)) + (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table :parents (list text-mode-abbrev-table))) @@ -5029,15 +5476,23 @@ The following commands are available: (list (face-foreground 'org-hide)))))) (car (remove nil candidates)))) -(defun org-current-time () - "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." - (if (> (car org-time-stamp-rounding-minutes) 1) - (let ((r (car org-time-stamp-rounding-minutes)) - (time (decode-time))) - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (current-time))) +(defun org-current-time (&optional rounding-minutes past) + "Current time, possibly rounded to ROUNDING-MINUTES. +When ROUNDING-MINUTES is not an integer, fall back on the car of +`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure +the rounding returns a past time." + (let ((r (or (and (integerp rounding-minutes) rounding-minutes) + (car org-time-stamp-rounding-minutes))) + (time (decode-time)) res) + (if (< r 1) + (current-time) + (setq res + (apply 'encode-time + (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) + (nthcdr 2 time)))) + (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) + (seconds-to-time (- (org-float-time res) (* r 60))) + res)))) (defun org-today () "Return today date, considering `org-extend-today-until'." @@ -5088,11 +5543,8 @@ Here is what the match groups contain after a match: (defvar org-any-link-re nil "Regular expression matching any link.") -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation ; ??????????????????????????/ - :type 'integer) +(defconst org-match-sexp-depth 3 + "Number of stacked braces for sub/superscript matching.") (defun org-create-multibrace-regexp (left right n) "Create a regular expression which will match a balanced sexp. @@ -5114,7 +5566,7 @@ stacked delimiters is N. Escaping delimiters is not possible." (defvar org-match-substring-regexp (concat - "\\([^\\]\\|^\\)\\([_^]\\)\\(" + "\\(\\S-\\)\\([_^]\\)\\(" "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" "\\|" "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" @@ -5124,7 +5576,7 @@ stacked delimiters is N. Escaping delimiters is not possible." (defvar org-match-substring-with-braces-regexp (concat - "\\([^\\]\\|^\\)\\([_^]\\)\\(" + "\\(\\S-\\)\\([_^]\\)\\(" "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" "\\)") "The regular expression matching a sub- or superscript, forcing braces.") @@ -5231,7 +5683,7 @@ The time stamps may be either active or inactive.") (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 'face (nth 1 a)) - (and (nth 4 a) + (and (nth 2 a) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) @@ -5241,7 +5693,7 @@ The time stamps may be either active or inactive.") '(invisible org-link)) (add-text-properties (match-beginning 3) (match-end 3) '(invisible org-link))))) - (backward-char 1)) + (goto-char (1+ (match-beginning 0)))) rtn)) (defun org-emphasize (&optional char) @@ -5249,36 +5701,27 @@ The time stamps may be either active or inactive.") If there is an active region, change that region to a new emphasis. If there is no region, just insert the marker characters and position the cursor between them. -CHAR should be either the marker character, or the first character of the -HTML tag associated with that emphasis. If CHAR is a space, the means -to remove the emphasis of the selected region. -If char is not given (for example in an interactive call) it -will be prompted for." +CHAR should be the marker character. If it is a space, it means to +remove the emphasis of the selected region. +If CHAR is not given (for example in an interactive call) it will be +prompted for." (interactive) - (let ((eal org-emphasis-alist) e det - (erc org-emphasis-regexp-components) + (let ((erc org-emphasis-regexp-components) (prompt "") - (string "") beg end move tag c s) + (string "") beg end move c s) (if (org-region-active-p) (setq beg (region-beginning) end (region-end) string (buffer-substring beg end)) (setq move t)) - (while (setq e (pop eal)) - (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) - c (aref tag 0)) - (push (cons c (string-to-char (car e))) det) - (setq prompt (concat prompt (format " [%s%c]%s" (car e) c - (substring tag 1))))) - (setq det (nreverse det)) (unless char - (message "%s" (concat "Emphasis marker or tag:" prompt)) + (message "Emphasis marker or tag: [%s]" + (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) (setq char (read-char-exclusive))) - (setq char (or (cdr (assoc char det)) char)) (if (equal char ?\ ) (setq s "" move nil) (unless (assoc (char-to-string char) org-emphasis-alist) - (error "No such emphasis marker: \"%c\"" char)) + (user-error "No such emphasis marker: \"%c\"" char)) (setq s (char-to-string char))) (while (and (> (length string) 1) (equal (substring string 0 1) (substring string -1)) @@ -5305,17 +5748,19 @@ will be prompted for." (defun org-activate-plain-links (limit) "Run through the buffer and add overlays to links." - (let (f) + (let (f hl) (when (and (re-search-forward (concat org-plain-link-re) limit t) (not (org-in-src-block-p))) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (setq f (get-text-property (match-beginning 0) 'face)) - (unless (or (org-in-src-block-p) - (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) + (setq hl (org-match-string-no-properties 0)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight 'face 'org-link + 'htmlize-link `(:uri ,hl) 'keymap org-mouse-map)) (org-rear-nonsticky-at (match-end 0))) t))) @@ -5349,7 +5794,7 @@ by a #." (error (message "org-mode fontification error")))) (defun org-fontify-meta-lines-and-blocks-1 (limit) - "Fontify #+ lines and blocks, in the correct ways." + "Fontify #+ lines and blocks." (let ((case-fold-search t)) (if (re-search-forward "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" @@ -5363,7 +5808,7 @@ by a #." (dc3 (downcase (match-string 3))) end end1 quoting block-type ovl) (cond - ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:")) + ((member dc1 '("+html:" "+ascii:" "+latex:")) ;; a single line of backend-specific content (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) @@ -5482,17 +5927,16 @@ by a #." "Run through the buffer and add overlays to bracketed links." (if (and (re-search-forward org-bracket-link-regexp limit t) (not (org-in-src-block-p))) - (let* ((help (concat "LINK: " - (org-match-string-no-properties 1))) - ;; FIXME: above we should remove the escapes. - ;; but that requires another match, protecting match data, - ;; a lot of overhead for font-lock. + (let* ((hl (org-match-string-no-properties 1)) + (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) (ip (org-maybe-intangible (list 'invisible 'org-link 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) (vp (list 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) ;; We need to remove the invisible property here. Table narrowing ;; may have made some of this invisible. (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) @@ -5573,97 +6017,55 @@ by a #." (goto-char e) t))) -(defvar org-latex-and-specials-regexp nil - "Regular expression for highlighting export special stuff.") +(defvar org-latex-and-related-regexp nil + "Regular expression for highlighting LaTeX, entities and sub/superscript.") (defvar org-match-substring-regexp) (defvar org-match-substring-with-braces-regexp) -;; This should be with the exporter code, but we also use if for font-locking -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") +(defun org-compute-latex-and-related-regexp () + "Compute regular expression for LaTeX, entities and sub/superscript. +Result depends on variable `org-highlight-latex-and-related'." + (org-set-local + 'org-latex-and-related-regexp + (let* ((re-sub + (cond ((not (memq 'script org-highlight-latex-and-related)) nil) + ((eq org-use-sub-superscripts '{}) + (list org-match-substring-with-braces-regexp)) + (org-use-sub-superscripts (list org-match-substring-regexp)))) + (re-latex + (when (memq 'latex org-highlight-latex-and-related) + (let ((matchers (plist-get org-format-latex-options :matchers))) + (delq nil + (mapcar (lambda (x) + (and (member (car x) matchers) (nth 1 x))) + org-latex-regexps))))) + (re-entities + (when (memq 'entities org-highlight-latex-and-related) + (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")))) + (mapconcat 'identity (append re-latex re-entities re-sub) "\\|")))) - -(defun org-compute-latex-and-specials-regexp () - "Compute regular expression for stuff treated specially by exporters." - (if (not org-highlight-latex-fragments-and-specials) - (org-set-local 'org-latex-and-specials-regexp nil) - (require 'org-exp) - (let* - ((matchers (plist-get org-format-latex-options :matchers)) - (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) - org-latex-regexps))) - (org-export-allow-BIND nil) - (options (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (org-export-with-sub-superscripts (plist-get options :sub-superscript)) - (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) - (org-export-with-TeX-macros (plist-get options :TeX-macros)) - (org-export-html-expand (plist-get options :expand-quoted-html)) - (org-export-with-special-strings (plist-get options :special-strings)) - (re-sub - (cond - ((equal org-export-with-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-export-with-sub-superscripts - (list org-match-substring-regexp)))) - (re-latex - (if org-export-with-LaTeX-fragments - (mapcar (lambda (x) (nth 1 x)) latexs))) - (re-macros - (if org-export-with-TeX-macros - (list (concat "\\\\" - (regexp-opt - (append - - (delq nil - (mapcar 'car-safe - (append org-entities-user - org-entities))) - (if (boundp 'org-latex-entities) - (mapcar (lambda (x) - (or (car-safe x) x)) - org-latex-entities) - nil)) - 'words))) ; FIXME - )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) - (re-special (if org-export-with-special-strings - (mapcar (lambda (x) (car x)) - org-export-html-special-string-regexps))) - (re-rest - (delq nil - (list - (if org-export-html-expand "@<[^>\n]+>") - )))) - (org-set-local - 'org-latex-and-specials-regexp - (mapconcat 'identity (append re-latex re-sub re-macros re-special - re-rest) "\\|"))))) - -(defun org-do-latex-and-special-faces (limit) - "Run through the buffer and add overlays to links." - (when org-latex-and-specials-regexp - (let (rtn d) - (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp - limit t)) - (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline))) - (progn - (setq rtn t - d (cond ((member (char-after (1+ (match-beginning 0))) - '(?_ ?^)) 1) - (t 0))) - (font-lock-prepend-text-property - (+ d (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-export-specials) - (add-text-properties (+ d (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))))) - rtn))) +(defun org-do-latex-and-related (limit) + "Highlight LaTeX snippets and environments, entities and sub/superscript. +LIMIT bounds the search for syntax to highlight. Stop at first +highlighted object, if any. Return t if some highlighting was +done, nil otherwise." + (when (org-string-nw-p org-latex-and-related-regexp) + (catch 'found + (while (re-search-forward org-latex-and-related-regexp limit t) + (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) + 'face)) + '(org-code org-verbatim underline)) + (let ((offset (if (memq (char-after (1+ (match-beginning 0))) + '(?_ ?^)) + 1 + 0))) + (font-lock-prepend-text-property + (+ offset (match-beginning 0)) (match-end 0) + 'face 'org-latex-and-related) + (add-text-properties (+ offset (match-beginning 0)) (match-end 0) + '(font-lock-multiline t))) + (throw 'found t))) + nil))) (defun org-restart-font-lock () "Restart `font-lock-mode', to force refontification." @@ -5673,13 +6075,17 @@ by a #." (defun org-all-targets (&optional radio) "Return a list of all targets in this file. -With optional argument RADIO, only find radio targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) - rtn) +When optional argument RADIO is non-nil, only find radio +targets." + (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn) (save-excursion (goto-char (point-min)) (while (re-search-forward re nil t) - (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) + ;; Make sure point is really within the object. + (backward-char) + (let ((obj (org-element-context))) + (when (memq (org-element-type obj) '(radio-target target)) + (add-to-list 'rtn (downcase (org-element-property :value obj)))))) rtn))) (defun org-make-target-link-regexp (targets) @@ -5711,18 +6117,34 @@ between words." (defun org-outline-level () "Compute the outline level of the heading at point. -This function assumes that the cursor is at the beginning of a line matched -by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. Use `org-reduced-level' to remove the effect of `org-odd-levels'." (save-excursion - (looking-at org-outline-regexp) - (1- (- (match-end 0) (match-beginning 0))))) + (if (not (condition-case nil + (org-back-to-heading t) + (error nil))) + 0 + (looking-at org-outline-regexp) + (1- (- (match-end 0) (match-beginning 0)))))) (defvar org-font-lock-keywords nil) -(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)") - "Regular expression matching a property line.") +(defsubst org-re-property (property &optional literal) + "Return a regexp matching a PROPERTY line. +Match group 3 will be set to the value if it exists." + (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:" + (if literal property (regexp-quote property)) + "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$")) + +(defconst org-property-re + (org-re-property ".*?" 'literal) + "Regular expression matching a property line. +There are four matching groups: +1: :PROPKEY: including the leading and trailing colon, +2: PROPKEY without the leading and trailing colon, +3: PROPVAL without leading or trailing spaces, +4: the indentation of the current line, +5: trailing whitespace.") (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") @@ -5770,12 +6192,17 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Links (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links)) + (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) (if (memq 'footnote lk) '(org-activate-footnote-links)) + ;; Targets. + (list org-any-target-regexp '(0 'org-target t)) + ;; Diary sexps. '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) + ;; Macro + '("{{{.+}}}" (0 'org-macro t)) '(org-hide-wide-columns (0 nil append)) ;; TODO keyword (list (format org-heading-keyword-regexp-format @@ -5794,6 +6221,12 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-font-lock-add-priority-faces) ;; Tags '(org-font-lock-add-tag-faces) + ;; Tags groups + (if (and org-group-tags org-tag-groups-alist) + (list (concat org-outline-regexp-bol ".+\\(:" + (regexp-opt (mapcar 'car org-tag-groups-alist)) + ":\\).*$") + '(1 'org-tag-group prepend))) ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) @@ -5819,7 +6252,7 @@ needs to be inserted at a specific position in the font-lock sequence.") "\\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials - '(org-do-latex-and-special-faces) + '(org-do-latex-and-related) '(org-fontify-entities) '(org-raise-scripts) ;; Code @@ -5831,8 +6264,7 @@ needs to be inserted at a specific position in the font-lock sequence.") "\\)")) '(2 'org-special-keyword t)) ;; Blocks and meta lines - '(org-fontify-meta-lines-and-blocks) - ))) + '(org-fontify-meta-lines-and-blocks)))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords @@ -5847,11 +6279,11 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-set-local 'org-pretty-entities (not org-pretty-entities)) (org-restart-font-lock) (if org-pretty-entities - (message "Entities are displayed as UTF8 characters") + (message "Entities are now displayed as UTF8 characters") (save-restriction (widen) (org-decompose-region (point-min) (point-max)) - (message "Entities are displayed plain")))) + (message "Entities are now displayed as plain text")))) (defvar org-custom-properties-overlays nil "List of overlays used for custom properties.") @@ -5960,10 +6392,10 @@ When FACE-OR-COLOR is not a string, just return it." (add-text-properties (match-beginning 0) (match-end 0) (list 'face (or (org-face-from-face-or-color - 'priority 'org-special-keyword + 'priority 'org-priority (cdr (assoc (char-after (match-beginning 1)) org-priority-faces))) - 'org-special-keyword) + 'org-priority) 'font-lock-fontified t))))) (defun org-get-tag-face (kwd) @@ -6021,10 +6453,10 @@ and subscripts." (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) (goto-char (point-at-bol)) (setq table-p (org-looking-at-p org-table-dataline-regexp) - comment-p (org-looking-at-p "[ \t]*#")) + comment-p (org-looking-at-p "^[ \t]*#[ +]")) (goto-char pos) - ;; FIXME: Should we go back one character here, for a_b^c - ;; (goto-char (1- pos)) ;???????????????????? + ;; Handle a_b^c + (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) (if (or comment-p emph-p link-p keyw-p) t (put-text-property (match-beginning 3) (match-end 0) @@ -6052,11 +6484,18 @@ and subscripts." (defvar org-cycle-global-status nil) (make-variable-buffer-local 'org-cycle-global-status) +(put 'org-cycle-global-status 'org-state t) (defvar org-cycle-subtree-status nil) (make-variable-buffer-local 'org-cycle-subtree-status) +(put 'org-cycle-subtree-status 'org-state t) (defvar org-inlinetask-min-level) +(defun org-unlogged-message (&rest args) + "Display a message, but avoid logging it in the *Messages* buffer." + (let ((message-log-max nil)) + (apply 'message args))) + ;;;###autoload (defun org-cycle (&optional arg) "TAB-action and visibility cycling for Org-mode. @@ -6142,11 +6581,11 @@ in special contexts. ((equal arg '(16)) (setq last-command 'dummy) (org-set-startup-visibility) - (message "Startup visibility, plus VISIBILITY properties")) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) ((equal arg '(64)) (show-all) - (message "Entire buffer visible, including drawers")) + (org-unlogged-message "Entire buffer visible, including drawers")) ;; Table: enter it or move to the next field. ((org-at-table-p 'any) @@ -6233,9 +6672,9 @@ in special contexts. ;; We just created the overview - now do table of contents ;; This can be slow in very large buffers, so indicate action (run-hook-with-args 'org-pre-cycle-hook 'contents) - (unless ga (message "CONTENTS...")) + (unless ga (org-unlogged-message "CONTENTS...")) (org-content) - (unless ga (message "CONTENTS...done")) + (unless ga (org-unlogged-message "CONTENTS...done")) (setq org-cycle-global-status 'contents) (run-hook-with-args 'org-cycle-hook 'contents)) @@ -6244,7 +6683,7 @@ in special contexts. ;; We just showed the table of contents - now show everything (run-hook-with-args 'org-pre-cycle-hook 'all) (show-all) - (unless ga (message "SHOW ALL")) + (unless ga (org-unlogged-message "SHOW ALL")) (setq org-cycle-global-status 'all) (run-hook-with-args 'org-cycle-hook 'all)) @@ -6252,10 +6691,12 @@ in special contexts. ;; Default action: go to overview (run-hook-with-args 'org-pre-cycle-hook 'overview) (org-overview) - (unless ga (message "OVERVIEW")) + (unless ga (org-unlogged-message "OVERVIEW")) (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview))))) +(defvar org-called-with-limited-levels);Dyn-bound in ̀org-with-limited-levels'. + (defun org-cycle-internal-local () "Do the local cycling action." (let ((goal-column 0) eoh eol eos has-children children-skipped struct) @@ -6298,7 +6739,7 @@ in special contexts. ;; Nothing is hidden behind this heading (unless (org-before-first-heading-p) (run-hook-with-args 'org-pre-cycle-hook 'empty)) - (message "EMPTY ENTRY") + (org-unlogged-message "EMPTY ENTRY") (setq org-cycle-subtree-status nil) (save-excursion (goto-char eos) @@ -6332,8 +6773,8 @@ in special contexts. (end (org-list-get-bottom-point struct))) (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) (org-list-get-all-items (point) struct prevs)) - (goto-char end)))))) - (message "CHILDREN") + (goto-char (if (< end eos) end eos))))))) + (org-unlogged-message "CHILDREN") (save-excursion (goto-char eos) (outline-next-heading) @@ -6349,7 +6790,8 @@ in special contexts. (unless (org-before-first-heading-p) (run-hook-with-args 'org-pre-cycle-hook 'subtree)) (outline-flag-region eoh eos nil) - (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (org-unlogged-message + (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'subtree))) @@ -6357,7 +6799,7 @@ in special contexts. ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) (outline-flag-region eoh eos t) - (message "FOLDED") + (org-unlogged-message "FOLDED") (setq org-cycle-subtree-status 'folded) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'folded)))))) @@ -6377,7 +6819,7 @@ With a numeric prefix, show all headlines up to that level." (setq org-cycle-global-status 'contents)) ((equal arg '(4)) (org-set-startup-visibility) - (message "Startup visibility, plus VISIBILITY properties.")) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) (t (org-cycle '(4)))))) @@ -6385,10 +6827,12 @@ With a numeric prefix, show all headlines up to that level." "Set the visibility required by startup options and properties." (cond ((eq org-startup-folded t) - (org-cycle '(4))) + (org-overview)) ((eq org-startup-folded 'content) - (let ((this-command 'org-cycle) (last-command 'org-cycle)) - (org-cycle '(4)) (org-cycle '(4))))) + (org-content)) + ((or (eq org-startup-folded 'showeverything) + (eq org-startup-folded nil)) + (show-all))) (unless (eq org-startup-folded 'showeverything) (if org-hide-block-startup (org-hide-block-all)) (org-set-visibility-according-to-property 'no-cleanup) @@ -6438,7 +6882,7 @@ of the first headline in the buffer. This is important, because if the first headline is not level one, then (hide-sublevels 1) gives confusing results." (interactive) - (let ((l (org-current-line)) + (let ((pos (point)) (level (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" outline-regexp) nil t) @@ -6447,7 +6891,7 @@ results." (funcall outline-level)))))) (and level (hide-sublevels level)) (recenter '(4)) - (org-goto-line l))) + (goto-char pos))) (defun org-content (&optional arg) "Show all headlines in the buffer, like a table of contents. @@ -6468,7 +6912,6 @@ With numerical argument N, show content up to level N." (show-branches)) (if (bobp) (throw 'exit nil)))))) - (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. This function is the default value of the hook `org-cycle-hook'." @@ -6611,6 +7054,21 @@ open and agenda-wise Org files." (while (re-search-forward org-drawer-regexp end t) (org-flag-drawer t)))))) +(defun org-cycle-hide-inline-tasks (state) + "Re-hide inline tasks when switching to 'contents or 'children +visibility state." + (case state + (contents + (when (org-bound-and-true-p org-inlinetask-min-level) + (hide-sublevels (1- org-inlinetask-min-level)))) + (children + (when (featurep 'org-inlinetask) + (save-excursion + (while (and (outline-next-heading) + (org-inlinetask-at-task-p)) + (org-inlinetask-toggle-visibility) + (org-inlinetask-goto-end))))))) + (defun org-flag-drawer (flag) "When FLAG is non-nil, hide the drawer we are within. Otherwise make it visible." @@ -6622,7 +7080,7 @@ Otherwise make it visible." "^[ \t]*:END:" (save-excursion (outline-next-heading) (point)) t) (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing at position %s" b)))))) + (user-error ":END: line missing at position %s" b)))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" @@ -6754,7 +7212,7 @@ Optional arguments START and END can be used to limit the range." 'org-hide-block) (delete-overlay ov)))) (push ov org-hide-block-overlays))) - (error "Not looking at a source block")))) + (user-error "Not looking at a source block")))) ;; org-tab-after-check-for-cycling-hook (add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) @@ -6812,7 +7270,6 @@ RET=jump to location C-g=quit and return to previous location (defvar org-goto-start-pos) ; dynamically scoped parameter -;; FIXME: Docstring does not mention both interfaces (defun org-goto (&optional alternative-interface) "Look up a different location in the current file, keeping current visibility. @@ -6948,7 +7405,7 @@ or nil." (setq org-goto-selected-point (point) org-goto-exit-command 'left) (throw 'exit nil)) - (error "Not on a heading"))) + (user-error "Not on a heading"))) (defun org-goto-right () "Finish `org-goto' by going to the new location." @@ -6958,7 +7415,7 @@ or nil." (setq org-goto-selected-point (point) org-goto-exit-command 'right) (throw 'exit nil)) - (error "Not on a heading"))) + (user-error "Not on a heading"))) (defun org-goto-quit () "Finish `org-goto' without cursor motion." @@ -7060,132 +7517,171 @@ frame is not changed." ;;; Inserting headlines -(defun org-previous-line-empty-p () +(defun org-previous-line-empty-p (&optional next) + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." (save-excursion (and (not (bobp)) - (or (beginning-of-line 0) t) + (or (beginning-of-line (if next 2 0)) t) (save-match-data (looking-at "[ \t]*$"))))) -(defun org-insert-heading (&optional force-heading invisible-ok) +(defun org-insert-heading (&optional arg invisible-ok) "Insert a new heading or item with same depth at point. -If point is in a plain list and FORCE-HEADING is nil, create a new list item. -If point is at the beginning of a headline, insert a sibling before the -current headline. If point is not at the beginning, split the line, -create the new headline with the text in the current line after point -\(but see also the variable `org-M-RET-may-split-line'). +If point is in a plain list and ARG is nil, create a new list item. +With one universal prefix argument, insert a heading even in lists. +With two universal prefix arguments, insert the heading at the end +of the parent subtree. + +If point is at the beginning of a headline, insert a sibling before +the current headline. If point is not at the beginning, split the line +and create a new headline with the text in the current line after point +\(see `org-M-RET-may-split-line' on how to modify this behavior). + +If point is at the beginning of a normal line, turn this line into +a heading. When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command." (interactive "P") - (if (or (= (buffer-size) 0) + (if (org-called-interactively-p 'any) (org-reveal)) + (let ((itemp (org-in-item-p)) + (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) + (respect-content (or org-insert-heading-respect-content + (equal arg '(16)))) + (initial-content "") + (adjust-empty-lines t)) + + (cond + + ((or (= (buffer-size) 0) (and (not (save-excursion (and (ignore-errors (org-back-to-heading invisible-ok)) (org-at-heading-p)))) - (or force-heading (not (org-in-item-p))))) - (progn - (insert "\n* ") - (run-hooks 'org-insert-heading-hook)) - (when (or force-heading (not (org-insert-item))) - (let* ((empty-line-p nil) - (level nil) - (on-heading (org-at-heading-p)) - (head (save-excursion - (condition-case nil - (progn - (org-back-to-heading invisible-ok) - (when (and (not on-heading) - (featurep 'org-inlinetask) - (integerp org-inlinetask-min-level) - (>= (length (match-string 0)) - org-inlinetask-min-level)) - ;; Find a heading level before the inline task - (while (and (setq level (org-up-heading-safe)) - (>= level org-inlinetask-min-level))) - (if (org-at-heading-p) - (org-back-to-heading invisible-ok) - (error "This should not happen"))) - (setq empty-line-p (org-previous-line-empty-p)) - (match-string 0)) - (error "*")))) - (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) - (cond - ((and (org-at-heading-p) (bolp) - (or (bobp) - (save-excursion (backward-char 1) (not (outline-invisible-p))))) - ;; insert before the current line - (open-line (if blank 2 1))) - ((and (bolp) - (not org-insert-heading-respect-content) - (or (bobp) - (save-excursion - (backward-char 1) (not (outline-invisible-p))))) - ;; insert right here - nil) - (t - ;; somewhere in the line - (save-excursion - (setq previous-pos (point-at-bol)) - (end-of-line) - (setq hide-previous (outline-invisible-p))) - (and org-insert-heading-respect-content (org-show-subtree)) - (let ((split - (and (org-get-alist-option org-M-RET-may-split-line 'headline) - (save-excursion - (let ((p (point))) - (goto-char (point-at-bol)) - (and (looking-at org-complex-heading-regexp) - (match-beginning 4) - (> p (match-beginning 4))))))) - tags pos) - (cond - (org-insert-heading-respect-content - (org-end-of-subtree nil t) - (when (featurep 'org-inlinetask) - (while (and (not (eobp)) - (looking-at "\\(\\*+\\)[ \t]+") - (>= (length (match-string 1)) - org-inlinetask-min-level)) - (org-end-of-subtree nil t))) - (or (bolp) (newline)) - (or (org-previous-line-empty-p) - (and blank (newline))) - (open-line 1)) - ((org-at-heading-p) - (when hide-previous - (show-children) - (org-show-entry)) - (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") - (setq tags (and (match-end 2) (match-string 2))) - (and (match-end 1) - (delete-region (match-beginning 1) (match-end 1))) - (setq pos (point-at-bol)) - (or split (end-of-line 1)) - (delete-horizontal-space) - (if (string-match "\\`\\*+\\'" - (buffer-substring (point-at-bol) (point))) - (insert " ")) - (newline (if blank 2 1)) - (when tags + (or arg (not itemp)))) + ;; At beginning of buffer or so high up that only a heading + ;; makes sense. + (insert + (if (or (bobp) (org-previous-line-empty-p)) "" "\n") + (if (org-in-src-block-p) ",* " "* ")) + (run-hooks 'org-insert-heading-hook)) + + ((and itemp (not (equal arg '(4)))) + ;; Insert an item + (org-insert-item)) + + (t + ;; Insert a heading + (save-restriction + (widen) + (let* ((level nil) + (on-heading (org-at-heading-p)) + (empty-line-p (if on-heading + (org-previous-line-empty-p) + ;; We will decide later + nil)) + ;; Get a level string to fall back on + (fix-level (save-excursion - (goto-char pos) - (end-of-line 1) - (insert " " tags) - (org-set-tags nil 'align)))) - (t - (or split (end-of-line 1)) - (newline (if blank 2 1))))))) - (insert head) (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (when (and org-insert-heading-respect-content hide-previous) - (save-excursion - (goto-char previous-pos) - (hide-subtree))) - (run-hooks 'org-insert-heading-hook))))) + (org-back-to-heading t) + (if (org-previous-line-empty-p) (setq empty-line-p t)) + (looking-at org-outline-regexp) + (make-string (1- (length (match-string 0))) ?*))) + (stars + (save-excursion + (condition-case nil + (progn + (org-back-to-heading invisible-ok) + (when (and (not on-heading) + (featurep 'org-inlinetask) + (integerp org-inlinetask-min-level) + (>= (length (match-string 0)) + org-inlinetask-min-level)) + ;; Find a heading level before the inline task + (while (and (setq level (org-up-heading-safe)) + (>= level org-inlinetask-min-level))) + (if (org-at-heading-p) + (org-back-to-heading invisible-ok) + (error "This should not happen"))) + (unless (and (save-excursion + (save-match-data + (org-backward-heading-same-level + 1 invisible-ok)) + (= (point) (match-beginning 0))) + (not (org-previous-line-empty-p t))) + (setq empty-line-p (or empty-line-p + (org-previous-line-empty-p)))) + (match-string 0)) + (error (or fix-level "* "))))) + (blank-a (cdr (assq 'heading org-blank-before-new-entry))) + (blank (if (eq blank-a 'auto) empty-line-p blank-a)) + pos hide-previous previous-pos) + + ;; If we insert after content, move there and clean up whitespace + (when respect-content + (org-end-of-subtree nil t) + (skip-chars-backward " \r\n") + (and (looking-at "[ \t]+") (replace-match "")) + (unless (eobp) (forward-char 1)) + (when (looking-at "^\\*") + (unless (bobp) (backward-char 1)) + (insert "\n"))) + + ;; If we are splitting, grab the text that should be moved to the new headline + (when may-split + (if (org-on-heading-p) + ;; This is a heading, we split intelligently (keeping tags) + (let ((pos (point))) + (goto-char (point-at-bol)) + (unless (looking-at org-complex-heading-regexp) + (error "This should not happen")) + (when (and (match-beginning 4) + (> pos (match-beginning 4)) + (< pos (match-end 4))) + (setq initial-content (buffer-substring pos (match-end 4))) + (goto-char pos) + (delete-region (point) (match-end 4)) + (if (looking-at "[ \t]*$") + (replace-match "") + (insert (make-string (length initial-content) ?\ ))) + (setq initial-content (org-trim initial-content))) + (goto-char pos)) + ;; a normal line + (unless (bolp) + (setq initial-content (buffer-substring (point) (point-at-eol))) + (delete-region (point) (point-at-eol)) + (setq initial-content (org-trim initial-content))))) + + ;; If we are at the beginning of the line, insert before it. Else after + (cond + ((and (bolp) (looking-at "[ \t]*$"))) + ((and (bolp) (not (looking-at "[ \t]*$"))) + (open-line 1)) + (t + (goto-char (point-at-eol)) + (insert "\n"))) + + ;; Insert the new heading + (insert stars) + (just-one-space) + (insert initial-content) + (when adjust-empty-lines + (if (or (not blank) + (and blank (not (org-previous-line-empty-p)))) + (org-N-empty-lines-before-current (if blank 1 0)))) + (run-hooks 'org-insert-heading-hook))))))) + +(defun org-N-empty-lines-before-current (N) + "Make the number of empty lines before current exactly N. +So this will delete or add empty lines." + (save-excursion + (goto-char (point-at-bol)) + (if (looking-back "\\s-+" nil 'greedy) + (replace-match "")) + (or (bobp) (insert "\n")) + (while (> N 0) + (insert "\n") + (setq N (1- N))))) (defun org-get-heading (&optional no-tags no-todo) "Return the heading of the current entry, without the stars. @@ -7208,6 +7704,8 @@ When NO-TODO is non-nil, don't include TODO keywords." (t (looking-at org-heading-regexp) (match-string 2))))) +(defvar orgstruct-mode) ; defined below + (defun org-heading-components () "Return the components of the current heading. This is a list with the following elements: @@ -7219,13 +7717,24 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (let (case-fold-search) (looking-at org-complex-heading-regexp)) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5))))) + (if (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (org-match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (org-match-string-no-properties 4) + (org-match-string-no-properties 5)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -7241,25 +7750,27 @@ This is a list with the following elements: (org-move-subtree-down) (end-of-line 1)) -(defun org-insert-heading-respect-content (invisible-ok) +(defun org-insert-heading-respect-content (&optional arg invisible-ok) "Insert heading with `org-insert-heading-respect-content' set to t." (interactive "P") (let ((org-insert-heading-respect-content t)) - (org-insert-heading t invisible-ok))) + (org-insert-heading '(4) invisible-ok))) (defun org-insert-todo-heading-respect-content (&optional force-state) "Insert TODO heading with `org-insert-heading-respect-content' set to t." (interactive "P") (let ((org-insert-heading-respect-content t)) - (org-insert-todo-heading force-state t))) + (org-insert-todo-heading force-state '(4)))) (defun org-insert-todo-heading (arg &optional force-heading) "Insert a new heading with the same level and TODO state as current heading. If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with prefix arg, force first state." +state (TODO by default). Also one prefix arg, force first state. With two +prefix args, force inserting at the end of the parent subtree." (interactive "P") (when (or force-heading (not (org-insert-item 'checkbox))) - (org-insert-heading force-heading) + (org-insert-heading (or (and (equal arg '(16)) '(16)) + force-heading)) (save-excursion (org-back-to-heading) (outline-previous-heading) @@ -7417,8 +7928,6 @@ even level numbers will become the next higher odd number." (define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1"))) -(defvar org-called-with-limited-levels nil) ;; Dynamically bound in -;; ̀org-with-limited-levels' (defun org-promote () "Promote the current heading higher up the tree. If the region is active in `transient-mark-mode', promote all headings @@ -7433,7 +7942,7 @@ in the region." org-allow-promoting-top-level-subtree) (replace-match "# " nil t)) ((= level 1) - (error "Cannot promote to level 0. UNDO to recover if necessary")) + (user-error "Cannot promote to level 0. UNDO to recover if necessary")) (t (replace-match up-head nil t))) ;; Fixup tag positioning (unless (= level 1) @@ -7627,7 +8136,7 @@ case." (while (> cnt 0) (or (and (funcall movfunc) (looking-at org-outline-regexp)) (progn (goto-char beg0) - (error "Cannot move past superior level or buffer limit"))) + (user-error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) (if (> arg 0) ;; Moving forward - still need to move over subtree @@ -7687,9 +8196,9 @@ This is a short-hand for marking the subtree and then cutting it." (interactive "p") (org-copy-subtree n 'cut)) -(defun org-copy-subtree (&optional n cut force-store-markers) - "Cut the current subtree into the clipboard. -With prefix arg N, cut this many sequential subtrees. +(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) + "Copy the current subtree it in the clipboard. +With prefix arg N, copy this many sequential subtrees. This is a short-hand for marking the subtree and then copying it. If CUT is non-nil, actually cut the subtree. If FORCE-STORE-MARKERS is non-nil, store the relative locations @@ -7703,12 +8212,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (setq beg (point)) (skip-chars-forward " \t\r\n") (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (condition-case nil - (org-forward-heading-same-level (1- n) t) - (error nil)) - (org-end-of-subtree t t)) + (if nosubtrees + (outline-next-heading) + (save-excursion (outline-end-of-heading) + (setq folded (outline-invisible-p))) + (condition-case nil + (org-forward-heading-same-level (1- n) t) + (error nil)) + (org-end-of-subtree t t))) (setq end (point)) (goto-char beg0) (when (> end beg) @@ -7727,7 +8238,7 @@ The entire subtree is promoted or demoted in order to match a new headline level. If the cursor is at the beginning of a headline, the same level as -that headline is used to paste the tree +that headline is used to paste the tree. If not, the new level is derived from the *visible* headings before and after the insertion point, and taken to be the inferior headline @@ -7748,7 +8259,7 @@ the inserted text when done." (interactive "P") (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) - (error "%s" + (user-error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels @@ -7909,7 +8420,7 @@ If yes, remember the marker and the distance to BEG." "^[ \t]*#\\+end_.*"))) (if blockp (narrow-to-region (car blockp) (cdr blockp)) - (error "Not in a block")))) + (user-error "Not in a block")))) (eval-when-compile (defvar org-property-drawer-re)) @@ -7920,8 +8431,10 @@ If yes, remember the marker and the distance to BEG." The clones will be inserted as siblings. In interactive use, the user will be prompted for the number of -clones to be produced, and for a time SHIFT, which may be a -repeater as used in time stamps, for example `+3d'. +clones to be produced. If the entry has a timestamp, the user +will also be prompted for a time shift, which may be a repeater +as used in time stamps, for example `+3d'. To disable this, +you can call the function with a universal prefix argument. When a valid repeater is given and the entry contains any time stamps, the clones will become a sequence in time, with time @@ -7940,10 +8453,22 @@ the following will happen: to past the last clone. In this way you can spell out a number of instances of a repeating task, and still retain the repeater to cover future instances of the task." - (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ") - (let (beg end template task idprop - shift-n shift-what doshift nmin nmax (n-no-remove -1) - (drawer-re org-drawer-regexp)) + (interactive "nNumber of clones to produce: ") + (let ((shift + (or shift + (if (and (not (equal current-prefix-arg '(4))) + (save-excursion + (re-search-forward org-ts-regexp-both + (save-excursion + (org-end-of-subtree t) + (point)) t))) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ") + ""))) ;; No time shift + (n-no-remove -1) + (drawer-re org-drawer-regexp) + beg end template task idprop + shift-n shift-what doshift nmin nmax) (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) @@ -8015,11 +8540,16 @@ Optional argument WITH-CASE means sort case-sensitively." (org-call-with-arg 'org-sort-entries with-case)))) (defun org-sort-remove-invisible (s) + "Remove invisible links from string S." (remove-text-properties 0 (length s) org-rm-props s) (while (string-match org-bracket-link-regexp s) (setq s (replace-match (if (match-end 2) (match-string 3 s) (match-string 1 s)) t t s))) + (let ((st (format " %s " s))) + (while (string-match org-emph-re st) + (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) + (setq s (substring st 1 -1))) s) (defvar org-priority-regexp) ; defined later in the file @@ -8038,7 +8568,7 @@ Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. Sorting can be alphabetically, numerically, by date/time as given by -a time stamp, by a property or by priority. +a time stamp, by a property, by priority order, or by a custom function. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to be a character, @@ -8064,7 +8594,10 @@ called with point at the beginning of the record. It must return either a string or a number that should serve as the sorting key for that record. Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well." +WITH-CASE, the sorting considers case as well. + +Sorting is done against the visible part of the headlines, it ignores hidden +links." (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) (cmstr @@ -8115,7 +8648,7 @@ WITH-CASE, the sorting considers case as well." (show-all))) (setq beg (point)) - (if (>= beg end) (error "Nothing to sort")) + (if (>= beg end) (user-error "Nothing to sort")) (looking-at "\\(\\*+\\)") (setq stars (match-string 1) @@ -8124,7 +8657,7 @@ WITH-CASE, the sorting considers case as well." txt (buffer-substring beg end)) (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry")) + (user-error "Region to sort contains a level above the first entry")) (unless sorting-type (message @@ -8134,13 +8667,15 @@ WITH-CASE, the sorting considers case as well." what) (setq sorting-type (read-char-exclusive)) - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func))) + (unless getkey-func + (and (= (downcase sorting-type) ?f) + (setq getkey-func + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)) + (setq getkey-func (intern getkey-func)))) (and (= (downcase sorting-type) ?r) + (not property) (setq property (org-icompleting-read "Property: " (mapcar 'list (org-buffer-property-keys t)) @@ -8174,11 +8709,11 @@ WITH-CASE, the sorting considers case as well." (cond ((= dcst ?n) (if (looking-at org-complex-heading-regexp) - (string-to-number (match-string 4)) + (string-to-number (org-sort-remove-invisible (match-string 4))) nil)) ((= dcst ?a) (if (looking-at org-complex-heading-regexp) - (funcall case-func (match-string 4)) + (funcall case-func (org-sort-remove-invisible (match-string 4))) nil)) ((= dcst ?t) (let ((end (save-excursion (outline-next-heading) (point)))) @@ -8296,12 +8831,23 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ;; command. There might be problems if any of the keys is otherwise ;; used as a prefix key. -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. +(defcustom orgstruct-heading-prefix-regexp "" + "Regexp that matches the custom prefix of Org headlines in +orgstruct(++)-mode." + :group 'org + :version "24.4" + :package-version '(Org . "8.3") + :type 'regexp) +;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") +(defcustom orgstruct-setup-hook nil + "Hook run after orgstruct-mode-map is filled." + :group 'org + :version "24.4" + :package-version '(Org . "8.0") + :type 'hook) + +(defvar orgstruct-initialized nil) (defvar org-local-vars nil "List of local variables, for use by `orgstruct-mode'.") @@ -8312,26 +8858,17 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." This mode is for using Org-mode structure commands in other modes. The following keys behave as if Org-mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Checkbox item -C-c C-c Set tags / toggle checkbox" - nil " OrgStruct" nil - (org-load-modules-maybe) - (and (orgstruct-setup) (defun orgstruct-setup () nil))) +defined by Org-mode)." + nil " OrgStruct" (make-sparse-keymap) + (funcall (if orgstruct-mode + 'add-to-invisibility-spec + 'remove-from-invisibility-spec) + '(outline . t)) + (when orgstruct-mode + (org-load-modules-maybe) + (unless orgstruct-initialized + (orgstruct-setup) + (setq orgstruct-initialized t)))) ;;;###autoload (defun turn-on-orgstruct () @@ -8355,6 +8892,8 @@ buffer. It will also recognize item context in multiline items." org-fb-vars)) (orgstruct-mode 1) (setq org-fb-vars nil) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) (let (var val) (mapc (lambda (x) @@ -8379,107 +8918,163 @@ buffer. It will also recognize item context in multiline items." (defun orgstruct-error () "Error when there is no default binding for a structure key." (interactive) - (error "This key has no function outside structure elements")) + (funcall (if (fboundp 'user-error) + 'user-error + 'error) + "This key has no function outside structure elements")) (defun orgstruct-setup () - "Setup orgstruct keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta up)] org-metaup) - '([(meta down)] org-metadown) - '([(meta left)] org-metaleft) - '([(meta right)] org-metaright) - '([(meta shift up)] org-shiftmetaup) - '([(meta shift down)] org-shiftmetadown) - '([(meta shift left)] org-shiftmetaleft) - '([(meta shift right)] org-shiftmetaright) - '([?\e (up)] org-metaup) - '([?\e (down)] org-metadown) - '([?\e (left)] org-metaleft) - '([?\e (right)] org-metaright) - '([?\e (shift up)] org-shiftmetaup) - '([?\e (shift down)] org-shiftmetadown) - '([?\e (shift left)] org-shiftmetaleft) - '([?\e (shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '([(shift left)] org-shiftleft) - '([(shift right)] org-shiftright) - '("\C-c\C-c" org-ctrl-c-ctrl-c) - '("\M-q" fill-paragraph) - '("\C-c^" org-sort) - '("\C-c-" org-cycle-list-bullet))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgstruct-make-binding fun nfunc key)) - (org-defkey orgstruct-mode-map key cmd)) + "Setup orgstruct keymap." + (dolist (cell '((org-demote . t) + (org-metaleft . t) + (org-metaright . t) + (org-promote . t) + (org-shiftmetaleft . t) + (org-shiftmetaright . t) + org-backward-element + org-backward-heading-same-level + org-ctrl-c-ret + org-ctrl-c-minus + org-ctrl-c-star + org-cycle + org-forward-heading-same-level + org-insert-heading + org-insert-heading-respect-content + org-kill-note-or-show-branches + org-mark-subtree + org-meta-return + org-metadown + org-metaup + org-narrow-to-subtree + org-promote-subtree + org-reveal + org-shiftdown + org-shiftleft + org-shiftmetadown + org-shiftmetaup + org-shiftright + org-shifttab + org-shifttab + org-shiftup + org-show-subtree + org-sort + org-up-element + outline-demote + outline-next-visible-heading + outline-previous-visible-heading + outline-promote + outline-up-heading + show-children)) + (let ((f (or (car-safe cell) cell)) + (disable-when-heading-prefix (cdr-safe cell))) + (when (fboundp f) + (let ((new-bindings)) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (push binding new-bindings) + ;; TODO use local-function-key-map + (dolist (rep '(("" . "TAB") + ("" . "RET") + ("" . "ESC") + ("" . "DEL"))) + (setq binding (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (regexp-quote (cdr rep)) + (car rep) + (key-description binding))))) + (pushnew binding new-bindings :test 'equal))) + (dolist (binding new-bindings) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (condition-case nil + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding disable-when-heading-prefix)) + (error nil))))))))) + (run-hooks 'orgstruct-setup-hook)) - ;; Prevent an error for users who forgot to make autoloads - (require 'org-element) - - ;; Special treatment needed for TAB and RET - (org-defkey orgstruct-mode-map [(tab)] - (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) - (org-defkey orgstruct-mode-map "\C-i" - (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) - - (org-defkey orgstruct-mode-map "\M-\C-m" - (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgstruct-mode-map [(meta return)] - (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map [(shift meta return)] - (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map "\e\C-m" - (orgstruct-make-binding 'org-insert-heading 108 - "\e\C-m" [?\e (return)])) - (org-defkey orgstruct-mode-map [?\e (return)] - (orgstruct-make-binding 'org-insert-heading 109 - [?\e (return)] "\e\C-m")) - (org-defkey orgstruct-mode-map [?\e (shift return)] - (orgstruct-make-binding 'org-insert-todo-heading 110 - [?\e (return)] "\e\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) +(defun orgstruct-make-binding (fun key disable-when-heading-prefix) "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - `(org-context-p 'headline 'item - (and orgstruct-is-++ - ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t) - 'item-body)) - (list 'org-run-like-in-org-mode (list 'quote fun)) - (list 'let '(orgstruct-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgstruct-error)))))))) +FUN is the command to call inside a table. KEY is the key that +should be checked in for a command to execute outside of tables. +Non-nil `disable-when-heading-prefix' means to disable the command +if `orgstruct-heading-prefix-regexp' is not empty." + (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) + (let ((nname name) + (i 0)) + (while (fboundp (intern nname)) + (setq nname (format "%s-%d" name (setq i (1+ i))))) + (setq name (intern nname))) + (eval + (let ((bindings '((org-heading-regexp + (concat "^" + orgstruct-heading-prefix-regexp + "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) + (org-outline-regexp + (concat orgstruct-heading-prefix-regexp "\\*+ ")) + (org-outline-regexp-bol + (concat "^" org-outline-regexp)) + (outline-regexp org-outline-regexp) + (outline-heading-end-regexp "\n") + (outline-level 'org-outline-level) + (outline-heading-alist)))) + `(defun ,name (arg) + ,(concat "In Structure, run `" (symbol-name fun) "'.\n" + "Outside of structure, run the binding of `" + (key-description key) "'." + (when disable-when-heading-prefix + (concat + "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" + "back to the default binding due to limitations of Org's implementation of\n" + "`" (symbol-name fun) "'."))) + (interactive "p") + (let* ((disable + ,(and disable-when-heading-prefix + '(not (string= orgstruct-heading-prefix-regexp "")))) + (fallback + (or disable + (not + (let* ,bindings + (org-context-p 'headline 'item + ,(when (memq fun + '(org-insert-heading + org-insert-heading-respect-content + org-meta-return)) + '(when orgstruct-is-++ + 'item-body)))))))) + (if fallback + (let* ((orgstruct-mode) + (binding + (loop with key = ,key + for rep in + '(nil + ("<\\([^>]*\\)tab>" . "\\1TAB") + ("<\\([^>]*\\)return>" . "\\1RET") + ("<\\([^>]*\\)escape>" . "\\1ESC") + ("<\\([^>]*\\)delete>" . "\\1DEL")) + do + (when rep + (setq key (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (car rep) + (cdr rep) + (key-description key)))))) + thereis (key-binding key)))) + (if (keymapp binding) + (set-transient-map binding) + (let ((func (or binding + (unless disable + 'orgstruct-error)))) + (when func + (call-interactively func))))) + (org-run-like-in-org-mode + (lambda () + (interactive) + (let* ,bindings + (call-interactively ',fun))))))))) + name)) (defun org-contextualize-keys (alist contexts) "Return valid elements in ALIST depending on CONTEXTS. @@ -8543,11 +9138,15 @@ definitions." (string-match (cdr rr) (buffer-file-name))) (and (eq (car rr) 'in-mode) (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) (when (and (eq (car rr) 'not-in-file) (buffer-file-name)) (not (string-match (cdr rr) (buffer-file-name)))) (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode))))))) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) (push r res))) (car (last r)))) (delete-dups (delq nil res)))) @@ -8576,17 +9175,18 @@ Possible values in the list of contexts are `table', `headline', and `item'." (setq varlist (buffer-local-variables))) (kill-buffer "*Org tmp*") (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x))) - x nil)) - varlist)))) + (mapcar + (lambda (x) + (setq x + (if (symbolp x) + (list x) + (list (car x) (cdr x)))) + (if (and (not (get (car x) 'org-state)) + (string-match + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name (car x)))) + x nil)) + varlist)))) (defun org-clone-local-variables (from-buffer &optional regexp) "Clone local variables from FROM-BUFFER. @@ -8609,8 +9209,14 @@ call CMD." (org-load-modules-maybe) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) + (let (binds) + (dolist (var org-local-vars) + (when (or (not (boundp (car var))) + (eq (symbol-value (car var)) + (default-value (car var)))) + (push (list (car var) `(quote ,(cadr var))) binds))) + (eval `(let ,binds + (call-interactively (quote ,cmd)))))) ;;;; Archiving @@ -8636,7 +9242,7 @@ call CMD." ((symbolp org-category) (symbol-name org-category)) (t org-category))) beg end cat pos optionp) - (org-unmodified + (org-with-silent-modifications (save-excursion (save-restriction (widen) @@ -8661,7 +9267,7 @@ DPROP is the drawer property and TPROP is the corresponding text property to set." (let ((case-fold-search t) (inhibit-read-only t) p) - (org-unmodified + (org-with-silent-modifications (save-excursion (save-restriction (widen) @@ -8671,7 +9277,7 @@ property to set." (save-excursion (org-back-to-heading t) (put-text-property - (point-at-bol) (point-at-eol) tprop p)))))))) + (point-at-bol) (org-end-of-subtree t t) tprop p)))))))) ;;;; Link Stuff @@ -8692,7 +9298,9 @@ property to set." (cond ((symbolp rpl) (funcall rpl tag)) ((string-match "%(\\([^)]+\\))" rpl) - (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl)) + (replace-match + (save-match-data + (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%h" rpl) (replace-match (url-hexify-string (or tag "")) t t rpl)) @@ -8774,191 +9382,237 @@ type. For a simple example of an export function, see `org-bbdb.el'." This link is added to `org-stored-links' and can later be inserted into an org-buffer with \\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'." +For some link types, a prefix arg is interpreted. +For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. +For file links, arg negates `org-context-in-file-links'. + +A double prefix arg force skipping storing functions that are not +part of Org's core. + +A triple prefix arg force storing a link for each line in the +active region." (interactive "P") (org-load-modules-maybe) - (setq org-store-link-plist nil) ; reset - (org-with-limited-levels - (let (link cpltxt desc description search txt custom-id agenda-link) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((org-src-edit-buffer-p) - (let (label gc) - (while (or (not label) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t)))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line 1) - (setq link (format org-coderef-label-format label)) - (setq gc (- 79 (length link))) - (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) - (insert link) - (setq link (concat "(" label ")") desc nil))) - - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - ;; We are in the agenda, link to referenced location - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (org-called-interactively-p 'any) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (url-view-url t)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link w3m-current-url) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (if (and (equal arg '(64)) (org-region-active-p)) + (save-excursion + (let ((end (region-end))) + (goto-char (region-beginning)) + (set-mark (point)) + (while (< (point-at-eol) end) + (move-end-of-line 1) (activate-mark) + (let (current-prefix-arg) + (call-interactively 'org-store-link)) + (move-beginning-of-line 2) + (set-mark (point))))) + (org-with-limited-levels + (setq org-store-link-plist nil) + (let (link cpltxt desc description search + txt custom-id agenda-link sfuns sfunsn) (cond - ((org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::" (match-string 1)) - link cpltxt)) - ((and (featurep 'org-id) - (or (eq org-id-link-to-org-use-id t) - (and (org-called-interactively-p 'any) - (or (eq org-id-link-to-org-use-id 'create-if-interactive) - (and (eq org-id-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (not custom-id)))) - (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) - ;; We can make a link using the ID. - (setq link (condition-case nil - (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist :description))) - (error - ;; probably before first headline, link to file only - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer)))))))) - (t - ;; Just link to current headline + + ;; Store a link using an external link type + ((and (not (equal arg '(16))) + (setq sfuns + (delq + nil (mapcar (lambda (f) + (let (fs) (if (funcall f) (push f fs)))) + org-store-link-functions)) + sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) + (or (and (cdr sfuns) + (funcall (intern + (completing-read + "Which function for creating the link? " + sfunsn t (car sfunsn))))) + (funcall (caar sfuns))) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist + :description) link)))) + + ;; Store a link from a source code buffer + ((org-src-edit-buffer-p) + (let (label gc) + (while (or (not label) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (regexp-quote (format org-coderef-label-format label)) + nil t)))) + (when label (message "Label exists already") (sit-for 2)) + (setq label (read-string "Code line label: " label))) + (end-of-line 1) + (setq link (format org-coderef-label-format label)) + (setq gc (- 79 (length link))) + (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) + (insert link) + (setq link (concat "(" label ")") desc nil))) + + ;; We are in the agenda, link to referenced location + ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (org-called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (url-view-url t)) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link cpltxt) + (org-store-link-props :type "image" :file buffer-file-name)) + + ;; In dired, store a link to the file of the current line + ((eq major-mode 'dired-mode) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link cpltxt))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (cond + ;; Store a link using the target at point + ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) + (setq cpltxt + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) + "::" (match-string 1)) + link cpltxt)) + ((and (featurep 'org-id) + (or (eq org-id-link-to-org-use-id t) + (and (org-called-interactively-p 'any) + (or (eq org-id-link-to-org-use-id 'create-if-interactive) + (and (eq org-id-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not custom-id)))) + (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) + ;; Store a link using the ID at point + (setq link (condition-case nil + (prog1 (org-id-store-link) + (setq desc (plist-get org-store-link-plist + :description))) + (error + ;; Probably before first headline, link only to file + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) + (t + ;; Just link to current headline + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context search string + (when (org-xor org-context-in-file-links arg) + (let* ((ee (org-element-at-point)) + (et (org-element-type ee)) + (ev (plist-get (cadr ee) :value)) + (ek (plist-get (cadr ee) :key)) + (eok (and (stringp ek) (string-match "name" ek)))) + (setq txt (cond + ((org-at-heading-p) nil) + ((and (eq et 'keyword) eok) ev) + ((org-region-active-p) + (buffer-substring (region-beginning) (region-end))))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (condition-case nil + (org-make-org-heading-search-string txt) + (error ""))) + desc (or (and (eq et 'keyword) eok ev) + (nth 4 (ignore-errors (org-heading-components))) + "NONE"))))) + (if (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link cpltxt)))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. (setq cpltxt (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string + ;; Add a context string. (when (org-xor org-context-in-file-links arg) - (setq txt (cond - ((org-at-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))))) - (when (or (null txt) (string-match "\\S-" txt)) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-make-org-heading-search-string txt) - (error ""))) - desc (or (nth 4 (ignore-errors - (org-heading-components))) "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link cpltxt)))) + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link cpltxt)) - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link cpltxt)) + ((org-called-interactively-p 'interactive) + (user-error "No method for storing a link from this buffer")) - ((org-called-interactively-p 'interactive) - (error "Cannot link to a buffer which is not visiting a file")) + (t (setq link nil))) - (t (setq link nil))) + ;; We're done setting link and desc, clean up + (if (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (cond ((equal desc "NONE") (setq desc nil)) + ((string-match org-bracket-link-analytic-regexp desc) + (let ((d0 (match-string 3 desc)) + (p0 (match-string 5 desc))) + (setq desc + (replace-regexp-in-string + org-bracket-link-regexp + (concat (or p0 d0) + (if (equal (length (match-string 0 desc)) + (length desc)) "*" "")) desc))))) - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) - "::#" custom-id)) - (setq org-stored-links - (cons (list link desc) org-stored-links)))) - (or agenda-link (and link (org-make-link-string link desc))))))) + ;; Return the link + (if (not (and (or (org-called-interactively-p 'any) + executing-kbd-macro) link)) + (or agenda-link (and link (org-make-link-string link desc))) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name + (buffer-file-name)) "::#" custom-id)) + (push (list link desc) org-stored-links))))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -9015,24 +9669,16 @@ according to FMT (default from `org-email-link-description-format')." (setq fmt (replace-match "from %f" t t fmt)))) (org-replace-escapes fmt table))) -(defun org-make-org-heading-search-string (&optional string heading) - "Make search string for STRING or current headline." - (interactive) - (let ((s (or string (org-get-heading))) +(defun org-make-org-heading-search-string (&optional string) + "Make search string for the current headline or STRING." + (let ((s (or string + (and (derived-mode-p 'org-mode) + (save-excursion + (org-back-to-heading t) + (org-element-property :raw-value (org-element-at-point)))))) (lines org-context-in-file-links)) - (unless (and string (not heading)) - ;; We are using a headline, clean up garbage in there. - (if (string-match org-todo-regexp s) - (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s) - (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (if (string-match (concat "^\\(" org-quote-string "\\|" - org-comment-string "\\)") s) - (setq s (replace-match "" t t s))) - (while (string-match org-ts-regexp s) - (setq s (replace-match "" t t s)))) (or string (setq s (concat "*" s))) ; Add * for headlines + (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) (when (and string (integerp lines) (> lines 0)) (let ((slines (org-split-string s "\n"))) (when (< lines (length slines)) @@ -9079,7 +9725,7 @@ according to FMT (default from `org-email-link-description-format')." This is the list that is used for internal purposes.") (defconst org-link-escape-chars-browser - '(?\ ) + '(?\ ?\") "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") @@ -9202,7 +9848,7 @@ This command can be called in any mode to insert a link in Org-mode syntax." (let ((links (copy-sequence org-stored-links)) l) (while (setq l (if keep (pop links) (pop org-stored-links))) (insert "- ") - (org-insert-link nil (car l) (cadr l)) + (org-insert-link nil (car l) (or (cadr l) "")) (insert "\n")))) (defun org-link-fontify-links-to-this-file () @@ -9270,6 +9916,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used as the default description." (interactive "P") (let* ((wcf (current-window-configuration)) + (origbuf (current-buffer)) (region (if (org-region-active-p) (buffer-substring (region-beginning) (region-end)))) (remove (and region (list (region-beginning) (region-end)))) @@ -9324,20 +9971,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unwind-protect (progn (setq link - (let ((org-completion-use-ido nil) - (org-completion-use-iswitchb nil)) - (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat x ":"))) - all-prefixes) - (mapcar 'car org-stored-links) - (mapcar 'cadr org-stored-links)) - nil nil nil - 'tmphist - (caar org-stored-links)))) + (org-completing-read + "Link: " + (append + (mapcar (lambda (x) (concat x ":")) + all-prefixes) + (mapcar 'car org-stored-links)) + nil nil nil + 'tmphist + (caar org-stored-links))) (if (not (string-match "\\S-" link)) - (error "No link selected")) + (user-error "No link selected")) (mapc (lambda(l) (when (equal link (cadr l)) (setq link (car l) auto-desc t))) org-stored-links) @@ -9345,7 +9989,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) (setq link (substring link 0 -1)))) - (setq link (org-link-try-special-completion link)))) + (setq link (with-current-buffer origbuf + (org-link-try-special-completion link))))) (set-window-configuration wcf) (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) @@ -9357,7 +10002,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq org-stored-links (delq (assoc link org-stored-links) org-stored-links))) - (if (string-match org-plain-link-re link) + (if (and (string-match org-plain-link-re link) + (not (string-match org-ts-regexp link))) ;; URL-like link, normalize the use of angular brackets. (setq link (org-remove-angle-brackets link))) @@ -9429,7 +10075,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (defun org-file-complete-link (&optional arg) "Create a file link using completion." (let (file link) - (setq file (read-file-name "File: ")) + (setq file (org-iread-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name (expand-file-name "."))))) @@ -9447,6 +10093,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (t (setq link (concat "file:" file))))) link)) +(defun org-iread-file-name (&rest args) + "Read-file-name using `ido-mode' speedup if available. +ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. +See `read-file-name' for a description of parameters." + (org-without-partial-completion + (if (and org-completion-use-ido + (fboundp 'ido-read-file-name) + (boundp 'ido-mode) ido-mode + (listp (second args))) + (let ((ido-enter-matching-directory nil)) + (apply 'ido-read-file-name args)) + (apply 'read-file-name args)))) + (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." (let ((enable-recursive-minibuffers t) @@ -9507,23 +10166,6 @@ from." (org-add-props s nil 'org-attr attr)) s)) -(defun org-extract-attributes-from-string (tag) - (let (key value attr) - (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag) - (setq key (match-string 1 tag) value (match-string 2 tag) - tag (replace-match "" t t tag) - attr (plist-put attr (intern key) value))) - (cons tag attr))) - -(defun org-attributes-to-string (plist) - "Format a property list into an HTML attribute list." - (let ((s "") key value) - (while plist - (setq key (pop plist) value (pop plist)) - (and value - (setq s (concat s " " (symbol-name key) "=\"" value "\"")))) - s)) - ;;; Opening/following a link (defvar org-link-search-failed nil) @@ -9545,45 +10187,35 @@ If it decides that it is not responsible for this link, it must return nil to indicate that that Org-mode can continue with other options like exact and fuzzy text search.") -(defun org-next-link () +(defun org-next-link (&optional search-backward) "Move forward to the next link. If the link is in hidden text, expose it." - (interactive) + (interactive "P") (when (and org-link-search-failed (eq this-command last-command)) (goto-char (point-min)) (message "Link search wrapped back to beginning of buffer")) (setq org-link-search-failed nil) (let* ((pos (point)) (ct (org-context)) - (a (assoc :link ct))) - (if a (goto-char (nth 2 a))) - (if (re-search-forward org-any-link-re nil t) + (a (assoc :link ct)) + (srch-fun (if search-backward 're-search-backward 're-search-forward))) + (cond (a (goto-char (nth (if search-backward 1 2) a))) + ((looking-at org-any-link-re) + ;; Don't stay stuck at link without an org-link face + (forward-char (if search-backward -1 1)))) + (if (funcall srch-fun org-any-link-re nil t) (progn (goto-char (match-beginning 0)) (if (outline-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) - (error "No further link found")))) + (message "No further link found")))) (defun org-previous-link () "Move backward to the previous link. If the link is in hidden text, expose it." (interactive) - (when (and org-link-search-failed (eq this-command last-command)) - (goto-char (point-max)) - (message "Link search wrapped back to end of buffer")) - (setq org-link-search-failed nil) - (let* ((pos (point)) - (ct (org-context)) - (a (assoc :link ct))) - (if a (goto-char (nth 1 a))) - (if (re-search-backward org-any-link-re nil t) - (progn - (goto-char (match-beginning 0)) - (if (outline-invisible-p) (org-show-context))) - (goto-char pos) - (setq org-link-search-failed t) - (error "No further link found")))) + (funcall 'org-next-link t)) (defun org-translate-link (s) "Translate a link string if a translation function has been defined." @@ -9614,8 +10246,7 @@ This is still an experimental function, your mileage may vary." ;; A typical message link. Planner has the id after the final slash, ;; we separate it with a hash mark (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path))))) - ) + (org-remove-angle-brackets (match-string 2 path)))))) (cons type path)) (defun org-find-file-at-mouse (ev) @@ -9671,6 +10302,7 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") +(defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el (defun org-open-at-point (&optional arg reference-buffer) "Open link at or after point. @@ -9743,17 +10375,28 @@ application the system uses for this file type." (or (previous-single-property-change pos 'org-linked-text) (point-min)) (or (next-single-property-change pos 'org-linked-text) - (point-max)))) + (point-max))) + ;; Ensure we will search for a <<>> link, not + ;; a simple reference like <> + path (concat "<" path)) (throw 'match t)) (save-excursion - (let ((plinkpos (org-in-regexp org-plain-link-re))) - (when (or (org-in-regexp org-angle-link-re) - (and plinkpos (goto-char (car plinkpos)) - (save-match-data (not (looking-back "\\[\\["))))) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t)))) + (when (or (org-in-regexp org-angle-link-re) + (let ((match (org-in-regexp org-plain-link-re))) + ;; Check a plain link is not within a bracket link + (and match + (save-excursion + (progn + (goto-char (car match)) + (not (org-in-regexp org-bracket-link-regexp)))))) + (let ((line_ending (save-excursion (end-of-line) (point)))) + ;; We are in a line before a plain or bracket link + (or (re-search-forward org-plain-link-re line_ending t) + (re-search-forward org-bracket-link-regexp line_ending t)))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t))) (save-excursion (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" @@ -9814,16 +10457,24 @@ application the system uses for this file type." (apply cmd (nreverse args1)))) ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) + (browse-url + (concat type ":" + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) ((string= type "doi") - (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) + (browse-url + (concat org-doi-server-url + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) ((member type '("message")) (browse-url (concat type ":" path))) @@ -9879,8 +10530,15 @@ application the system uses for this file type." (error "Abort")))) ((and (string= type "thisfile") - (run-hook-with-args-until-success - 'org-open-link-functions path))) + (or (run-hook-with-args-until-success + 'org-open-link-functions path) + (and link + (string-match "^id:" link) + (or (featurep 'org-id) (require 'org-id)) + (progn + (funcall (nth 1 (assoc "id" org-link-protocols)) + (substring path 3)) + t))))) ((string= type "thisfile") (if arg @@ -9958,7 +10616,7 @@ there is one, return it." (setq nth (- c ?0)) (if have-zero (setq nth (1+ nth))) (unless (and (integerp nth) (>= (length links) nth)) - (error "Invalid link selection")) + (user-error "Invalid link selection")) (setq link (nth (1- nth) links))))) (cons link end)))))) @@ -9972,15 +10630,7 @@ there is one, return it." (defun org-open-file-with-emacs (path) "Open file at PATH in Emacs." (org-open-file path 'emacs)) -(defun org-remove-file-link-modifiers () - "Remove the file link modifiers in `file+sys:' and `file+emacs:' links." - (goto-char (point-min)) - (while (re-search-forward "\\>\\)") re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") "\\)" markers) - re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") + re2a_ (concat "\\(" (mapconcat 'downcase words + "[ \t\r\n]+") "\\)[ \t\r\n]") re2a (concat "[ \t\r\n]" re2a_) - re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re4_ (concat "\\(" (mapconcat 'downcase words + "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") re4 (concat "[^a-zA-Z_]" re4_) re1 (concat pre re2 post) @@ -10162,21 +10804,20 @@ visibility around point, thus ignoring re4 (concat pre (if pre re4_ re4)) reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)" - )) + re5 "\\)")) (cond ((eq type 'org-occur) (org-occur reall)) ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) (t (goto-char (point-min)) (setq type 'fuzzy) - (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated)) + (if (or (and (org-search-not-self 1 re0 nil t) + (setq type 'dedicated)) (org-search-not-self 1 re1 nil t) (org-search-not-self 1 re2 nil t) (org-search-not-self 1 re2a nil t) (org-search-not-self 1 re3 nil t) (org-search-not-self 1 re4 nil t) - (org-search-not-self 1 re5 nil t) - ) + (org-search-not-self 1 re5 nil t)) (goto-char (match-beginning 1)) (goto-char pos) (error "No match")))))) @@ -10416,7 +11057,7 @@ If the file does not exist, an error is thrown." (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files (not (file-exists-p file)) (not org-open-non-existing-files)) - (error "No such file: %s" file)) + (user-error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Remove quotes around the file name - we'll use shell-quote-argument. @@ -10442,9 +11083,9 @@ If the file does not exist, an error is thrown." (setq match-index (+ match-index 1))))) (save-window-excursion + (message "Running %s...done" cmd) (start-process-shell-command cmd nil cmd) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) ((or (stringp cmd) (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) @@ -10581,9 +11222,10 @@ on the system \"/user@host:\"." (let (marker) (catch 'exit (while (and set (setq marker (nth 3 (pop set)))) - ;; if org-refile-use-outline-path is 'file, marker may be nil + ;; If `org-refile-use-outline-path' is 'file, marker may be nil (when (and marker (null (marker-buffer marker))) - (message "not found") (sit-for 3) + (message "Please regenerate the refile cache with `C-0 C-c C-w'") + (sit-for 3) (throw 'exit nil))) t))) @@ -10701,8 +11343,7 @@ on the system \"/user@host:\"." (goto-char (point-at-eol)))))))) (when org-refile-use-cache (org-refile-cache-put tgs (buffer-file-name) descre)) - (setq targets (append tgs targets)) - )))) + (setq targets (append tgs targets)))))) (message "Getting targets...done") (nreverse targets))) @@ -10734,14 +11375,21 @@ avoiding backtracing. Refile target collection makes use of that." (widen) (while (org-up-heading-safe) (when (looking-at org-complex-heading-regexp) - (push (org-match-string-no-properties 4) rtn))) + (push (org-trim + (replace-regexp-in-string + ;; Remove statistical/checkboxes cookies + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-match-string-no-properties 4))) + rtn))) rtn))))) -(defun org-format-outline-path (path &optional width prefix) +(defun org-format-outline-path (path &optional width prefix separator) "Format the outline path PATH for display. -Width is the maximum number of characters that is available. -Prefix is a prefix to be included in the returned string, -such as the file name." +WIDTH is the maximum number of characters that is available. +PREFIX is a prefix to be included in the returned string, +such as the file name. +SEPARATOR is inserted between the different parts of the path, +the default is \"/\"." (setq width (or width 79)) (if prefix (setq width (- width (length prefix)))) (if (not path) @@ -10757,6 +11405,7 @@ such as the file name." (total (1+ (length prefix)))) (setq maxwidth (max maxwidth 10)) (concat prefix + (if prefix (or separator "/")) (mapconcat (lambda (h) (setq n (1+ n)) @@ -10773,24 +11422,35 @@ such as the file name." (nth (% (1- n) org-n-level-faces) org-level-faces)) h) - path "/"))))) + path (or separator "/")))))) -(defun org-display-outline-path (&optional file current) - "Display the current outline path in the echo area." +(defun org-display-outline-path (&optional file current separator just-return-string) + "Display the current outline path in the echo area. + +If FILE is non-nil, prepend the output with the file name. +If CURRENT is non-nil, append the current heading to the output. +SEPARATOR is passed through to `org-format-outline-path'. It separates +the different parts of the path and defaults to \"/\". +If JUST-RETURN-STRING is non-nil, return a string, don't display a message." (interactive "P") - (let* ((bfn (buffer-file-name (buffer-base-buffer))) - (case-fold-search nil) - (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))) + (let* (case-fold-search + (bfn (buffer-file-name (buffer-base-buffer))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) + res) (if current (setq path (append path (save-excursion (org-back-to-heading t) (if (looking-at org-complex-heading-regexp) (list (match-string 4))))))) - (message "%s" - (org-format-outline-path - path - (1- (frame-width)) - (and file bfn (concat (file-name-nondirectory bfn) "/")))))) + (setq res + (org-format-outline-path + path + (1- (frame-width)) + (and file bfn (concat (file-name-nondirectory bfn) separator)) + separator)) + (if just-return-string + (org-no-properties res) + (org-unlogged-message "%s" res)))) (defvar org-refile-history nil "History for refiling operations.") @@ -10801,7 +11461,16 @@ Note that this is still *before* the stuff will be removed from the *old* location.") (defvar org-capture-last-stored-marker) -(defun org-refile (&optional goto default-buffer rfloc) +(defvar org-refile-keep nil + "Non-nil means `org-refile' will copy instead of refile.") + +(defun org-copy () + "Like `org-refile', but copy." + (interactive) + (let ((org-refile-keep t)) + (funcall 'org-refile nil nil nil "Copy"))) + +(defun org-refile (&optional goto default-buffer rfloc msg) "Move the entry or entries at point to another heading. The list of target headings is compiled using the information in `org-refile-targets', which see. @@ -10820,10 +11489,19 @@ and not actually move anything. With a double prefix arg \\[universal-argument] \\[universal-argument], \ go to the location where the last refiling operation has put the subtree. -With a prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `3', emulate `org-refile-keep' +being set to `t' and copy to the target location, don't move it. +Beware that keeping refiled entries may result in duplicated ID +properties. RFLOC can be a refile location obtained in a different way. +MSG is a string to replace \"Refile\" in the default prompt with +another verb. E.g. `org-copy' sets this parameter to \"Copy\". + See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), @@ -10834,12 +11512,13 @@ prefix argument (`C-u C-u C-u C-c C-w')." (interactive "P") (if (member goto '(0 (64))) (org-refile-cache-clear) - (let* ((cbuf (current-buffer)) + (let* ((actionmsg (or msg "Refile")) + (cbuf (current-buffer)) (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) - (region-length (and regionp (- region-end region-start))) (filename (buffer-file-name (buffer-base-buffer cbuf))) + (org-refile-keep (if (equal goto 3) t org-refile-keep)) pos it nbuf file re level reversed) (setq last-command nil) (when regionp @@ -10849,8 +11528,10 @@ prefix argument (`C-u C-u C-u C-c C-w')." (unless (or (org-kill-is-subtree-p (buffer-substring region-start region-end)) (prog1 org-refile-active-region-within-subtree - (org-toggle-heading))) - (error "The region is not a (sequence of) subtree(s)"))) + (let ((s (point-at-eol))) + (org-toggle-heading) + (setq region-end (+ (- (point-at-eol) s) region-end))))) + (user-error "The region is not a (sequence of) subtree(s)"))) (if (equal goto '(16)) (org-refile-goto-last-stored) (when (or @@ -10870,10 +11551,11 @@ prefix argument (`C-u C-u C-u C-c C-w')." (org-back-to-heading t) (setq heading-text (nth 4 (org-heading-components)))) + (org-refile-get-location (cond (goto "Goto") - (regionp "Refile region to") - (t (concat "Refile subtree \"" + (regionp (concat actionmsg " region to")) + (t (concat actionmsg " subtree \"" heading-text "\" to"))) default-buffer (and (not (equal '(4) goto)) @@ -10895,7 +11577,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) - (if goto + (if (and goto (not (equal goto 3))) (progn (org-pop-to-buffer-same-window nbuf) (goto-char pos) @@ -10930,30 +11612,38 @@ prefix argument (`C-u C-u C-u C-c C-w')." (if (not (bolp)) (newline)) (org-paste-subtree level) (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos - org-log-refile) + (org-add-log-setup 'refile nil nil 'findpos org-log-refile) (unless (eq org-log-refile 'note) (save-excursion (org-add-log-note)))) (and org-auto-align-tags (let ((org-loop-over-headlines-in-active-region nil)) (org-set-tags nil t))) - (with-demoted-errors - (bookmark-set "org-refile-last-stored")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here (when (org-bound-and-true-p org-refile-for-capture) - (with-demoted-errors - (bookmark-set "org-capture-last-stored-marker")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))) (if (fboundp 'deactivate-mark) (deactivate-mark)) (run-hooks 'org-after-refile-insert-hook)))) - (if regionp - (delete-region (point) (+ (point) region-length)) - (org-cut-subtree)) + (unless org-refile-keep + (if regionp + (delete-region (point) (+ (point) (- region-end region-start))) + (delete-region + (and (org-back-to-heading t) (point)) + (min (buffer-size) (org-end-of-subtree t t) (point))))) (when (featurep 'org-inlinetask) (org-inlinetask-remove-END-maybe)) (setq org-markers-to-move nil) - (message "Refiled to \"%s\" in file %s" (car it) file))))))) + (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file))))))) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -10982,12 +11672,8 @@ this is used for the GOTO interface." (setq org-refile-target-table (org-refile-get-targets default-buffer excluded-entries))) (unless org-refile-target-table - (error "No refile targets")) - (let* ((prompt (concat prompt - (and (car org-refile-history) - (concat " (default " (car org-refile-history) ")")) - ": ")) - (cbuf (current-buffer)) + (user-error "No refile targets")) + (let* ((cbuf (current-buffer)) (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path @@ -10995,6 +11681,7 @@ this is used for the GOTO interface." 'org-olpath-completing-read 'org-icompleting-read)) (extra (if org-refile-use-outline-path "/" "")) + (cbnex (concat (buffer-name) extra)) (filename (and cfn (expand-file-name cfn))) (tbl (mapcar (lambda (x) @@ -11007,14 +11694,20 @@ this is used for the GOTO interface." (cons (concat (car x) extra) (cdr x)))) org-refile-target-table)) (completion-ignore-case t) + cdef + (prompt (concat prompt + (or (and (car org-refile-history) + (concat " (default " (car org-refile-history) ")")) + (and (assoc cbnex tbl) (setq cdef cbnex) + (concat " (default " cbnex ")"))) ": ")) pa answ parent-target child parent old-hist) (setq old-hist org-refile-history) (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history (car org-refile-history))) + nil 'org-refile-history (or cdef (car org-refile-history)))) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) - (org-refile-check-position pa) (if pa (progn + (org-refile-check-position pa) (when (or (not org-refile-history) (not (eq old-hist org-refile-history)) (not (equal (car pa) (car org-refile-history)))) @@ -11037,7 +11730,7 @@ this is used for the GOTO interface." (y-or-n-p (format "Create new node \"%s\"? " child))))) (org-refile-new-child parent-target child))) - (error "Invalid target location"))))) + (user-error "Invalid target location"))))) (declare-function org-string-nw-p "org-macs" (s)) (defun org-refile-check-position (refile-pointer) @@ -11047,7 +11740,7 @@ this is used for the GOTO interface." (pos (nth 3 refile-pointer)) buffer) (if (and (not (markerp pos)) (not file)) - (error "Please save the buffer to a file before refiling") + (user-error "Please save the buffer to a file before refiling") (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) @@ -11060,7 +11753,7 @@ this is used for the GOTO interface." (goto-char pos) (beginning-of-line 1) (unless (org-looking-at-p re) - (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) + (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -11161,7 +11854,7 @@ PLIST must contain a :name entry which is used as name of the block." This empties the block, puts the cursor at the insert position and returns the property list including an extra property :name with the block name." (unless (looking-at org-dblock-start-re) - (error "Not at a dynamic block")) + (user-error "Not at a dynamic block")) (let* ((begdel (1+ (match-end 0))) (name (org-no-properties (match-string 1))) (params (append (list :name name) @@ -11260,75 +11953,45 @@ This function can be used in a hook." ;;;; Completion -(defconst org-additional-option-like-keywords - '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:" - "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:" - "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" - "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:" - "BEGIN:" "END:" - "ORGTBL" "TBLFM:" "TBLNAME:" - "BEGIN_EXAMPLE" "END_EXAMPLE" - "BEGIN_VERBATIM" "END_VERBATIM" - "BEGIN_QUOTE" "END_QUOTE" - "BEGIN_VERSE" "END_VERSE" - "BEGIN_CENTER" "END_CENTER" - "BEGIN_SRC" "END_SRC" - "BEGIN_RESULT" "END_RESULT" - "BEGIN_lstlisting" "END_lstlisting" - "NAME:" "RESULTS:" - "HEADER:" "HEADERS:" - "COLUMNS:" "PROPERTY:" - "CAPTION:" "LABEL:" - "SETUPFILE:" - "INCLUDE:" "INDEX:" - "BIND:" - "MACRO:")) +(declare-function org-export-backend-name "org-export" (cl-x)) +(declare-function org-export-backend-options "org-export" (cl-x)) +(defun org-get-export-keywords () + "Return a list of all currently understood export keywords. +Export keywords include options, block names, attributes and +keywords relative to each registered export back-end." + (let (keywords) + (dolist (backend + (org-bound-and-true-p org-export--registered-backends) + (delq nil keywords)) + ;; Back-end name (for keywords, like #+LATEX:) + (push (upcase (symbol-name (org-export-backend-name backend))) keywords) + (dolist (option-entry (org-export-backend-options backend)) + ;; Back-end options. + (push (nth 1 option-entry) keywords))))) (defconst org-options-keywords - '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:" - "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:" - "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:" - "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:" - "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:" - "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:" - "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:")) - -(defconst org-additional-option-like-keywords-for-flyspell - (delete-dups - (split-string - (mapconcat (lambda(k) - (replace-regexp-in-string - "_\\|:" " " - (concat k " " (downcase k) " " (upcase k)))) - (append org-options-keywords org-additional-option-like-keywords) - " ") - " +" t))) + '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" + "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" + "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" + "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" + "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) (defcustom org-structure-template-alist - '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" - "\n\n") - ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" - "\n?\n") - ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" - "\n?\n") - ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" - "\n?\n") - ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" - "\n?\n") - ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" - "
    \n?\n
    ") + '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "\n\n") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "\n?\n") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "\n?\n") + ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "\n?\n") + ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "\n?\n") + ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "
    \n?\n
    ") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" "\n?\n") - ("L" "#+LaTeX: " - "?") + ("L" "#+LaTeX: " "?") ("h" "#+BEGIN_HTML\n?\n#+END_HTML" "\n?\n") - ("H" "#+HTML: " - "?") - ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") - ("A" "#+ASCII: ") - ("i" "#+INDEX: ?" - "#+INDEX: ?") + ("H" "#+HTML: " "?") + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "") + ("A" "#+ASCII: " "") + ("i" "#+INDEX: ?" "#+INDEX: ?") ("I" "#+INCLUDE: %file ?" "")) "Structure completion elements. @@ -11343,9 +12006,10 @@ the default when the /org-mtags.el/ module has been loaded. See also the variable `org-mtags-prefer-muse-templates'." :group 'org-completion :type '(repeat - (string :tag "Key") - (string :tag "Template") - (string :tag "Muse Template"))) + (list + (string :tag "Key") + (string :tag "Template") + (string :tag "Muse Template")))) (defun org-try-structure-completion () "Try to complete a structure template before point. @@ -11429,10 +12093,12 @@ nil or a string to be used for the todo mark." ) (let* ((ct (org-current-time)) (dct (decode-time ct)) (ct1 - (if (and org-use-effective-time - (< (nth 2 dct) org-extend-today-until)) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct))) + (cond + (org-use-last-clock-out-time-as-effective-time + (or (org-clock-get-last-clock-out-time) ct)) + ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) + (t ct)))) ct1)) (defun org-todo-yesterday (&optional arg) @@ -11445,6 +12111,9 @@ nil or a string to be used for the todo mark." ) (org-extend-today-until (1+ hour))) (org-todo arg)))) +(defvar org-block-entry-blocking "" + "First entry preventing the TODO state change.") + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -11536,8 +12205,7 @@ For calling through lisp, arg is also interpreted in the following way: (not org-todo-key-trigger))) ;; Read a state with completion (org-icompleting-read - "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords-1) + "State: " (mapcar 'list org-todo-keywords-1) nil t)) ((eq arg 'right) (if this @@ -11568,7 +12236,7 @@ For calling through lisp, arg is also interpreted in the following way: (car org-todo-heads)))) ((car (member arg org-todo-keywords-1))) ((stringp arg) - (error "State `%s' not valid in this file" arg)) + (user-error "State `%s' not valid in this file" arg)) ((nth (1- (prefix-numeric-value arg)) org-todo-keywords-1)))) ((null member) (or head (car org-todo-keywords-1))) @@ -11599,9 +12267,11 @@ For calling through lisp, arg is also interpreted in the following way: (run-hook-with-args-until-failure 'org-blocker-hook change-plist)))) (if (org-called-interactively-p 'interactive) - (error "TODO state change from %s to %s blocked" this org-state) + (user-error "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) ;; fail silently - (message "TODO state change from %s to %s blocked" this org-state) + (message "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) (throw 'exit nil)))) (store-match-data match-data) (replace-match next t t) @@ -11632,9 +12302,10 @@ For calling through lisp, arg is also interpreted in the following way: (nth 2 (assoc this org-todo-log-states)))) (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) (setq dolog 'time)) - (when (and org-state - (member org-state org-not-done-keywords) - (not (member this org-not-done-keywords))) + (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) + (and org-state + (member org-state org-not-done-keywords) + (not (member this org-not-done-keywords)))) ;; This is now a todo state and was not one before ;; If there was a CLOSED time stamp, get rid of it. (org-add-planning-info nil nil 'closed)) @@ -11715,7 +12386,8 @@ changes. Such blocking occurs when: ;; completed (if (and (not (org-entry-is-done-p)) (org-entry-is-todo-p)) - (throw 'dont-block nil)) + (progn (setq org-block-entry-blocking (org-get-heading)) + (throw 'dont-block nil))) (outline-next-heading) (setq child-level (funcall outline-level)))))) ;; Otherwise, if the task's parent has the :ORDERED: property, and @@ -11728,6 +12400,7 @@ changes. Such blocking occurs when: (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) + (setq org-block-entry-blocking (match-string 0)) (throw 'dont-block nil)) ; block, there is an older sibling not done. ;; Search further up the hierarchy, to see if an ancestor is blocked (while t @@ -11739,7 +12412,8 @@ changes. Such blocking occurs when: (if (not parent-pos) (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) - (re-search-forward org-not-done-heading-regexp pos t)) + (re-search-forward org-not-done-heading-regexp pos t) + (setq org-block-entry-blocking (org-get-heading))) (throw 'dont-block nil)))))))) ; block, older sibling not done. (defcustom org-track-ordered-property-with-tag nil @@ -11772,7 +12446,7 @@ See variable `org-track-ordered-property-with-tag'." (org-back-to-heading) (if (org-entry-get nil "ORDERED") (progn - (org-delete-property "ORDERED") + (org-delete-property "ORDERED" "PROPERTIES") (and tag (org-toggle-tag tag 'off)) (message "Subtasks can be completed in arbitrary order")) (org-entry-put nil "ORDERED" "t") @@ -11816,16 +12490,15 @@ changes because there are unchecked boxes in this entry." (defun org-entry-blocked-p () "Is the current entry blocked?" - (org-with-buffer-modified-unmodified + (org-with-silent-modifications (if (org-entry-get nil "NOBLOCKING") nil ;; Never block this entry - (not - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point) - :from 'todo - :to 'done)))))) + (not (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done)))))) (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. @@ -12088,6 +12761,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (member (org-get-todo-state) org-done-keywords)) (defun org-get-todo-state () + "Return the TODO keyword of the current subtree." (save-excursion (org-back-to-heading t) (and (looking-at org-todo-line-regexp) @@ -12180,7 +12854,7 @@ This function is run automatically after each state change to a DONE state." what (match-string 3 ts)) (if (equal what "w") (setq n (* n 7) what "d")) (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) - (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) + (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) ;; Preparation, see if we need to modify the start date for the change (when (match-end 1) (setq time (save-match-data (org-time-string-to-time ts))) @@ -12207,7 +12881,7 @@ This function is run automatically after each state change to a DONE state." (org-at-timestamp-p t) (setq ts (match-string 1)) (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) - (org-timestamp-change n (cdr (assoc what whata))) + (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) (setq msg (concat msg type " " org-last-changed-timestamp " ")))) (setq org-log-post-message msg) (message "%s" msg)))) @@ -12232,13 +12906,14 @@ of `org-todo-keywords-1'." ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) (regexp-quote (nth (1- (prefix-numeric-value arg)) org-todo-keywords-1))) - (t (error "Invalid prefix argument: %s" arg))))) + (t (user-error "Invalid prefix argument: %s" arg))))) (message "%d TODO entries found" (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) -(defun org-deadline (&optional remove time) +(defun org-deadline (arg &optional time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. -With argument REMOVE, remove any deadline from the item. +With one universal prefix argument, remove any deadline from the item. +With two universal prefix arguments, prompt for a warning delay. With argument TIME, set the deadline at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") @@ -12247,22 +12922,43 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 'region-start-level 'region)) org-loop-over-headlines-in-active-region) (org-map-entries - `(org-deadline ',remove ,time) + `(org-deadline ',arg ,time) org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "DEADLINE")) + (old-date-time (if old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) - (if remove - (progn - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date 'findpos - org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) + (cond + ((equal arg '(4)) + (when (and old-date org-log-redeadline) + (org-add-log-setup 'deldeadline nil old-date 'findpos + org-log-redeadline)) + (org-remove-timestamp-with-keyword org-deadline-string) + (message "Item no longer has a deadline.")) + ((equal arg '(16)) + (save-excursion + (org-back-to-heading t) + (if (re-search-forward + org-deadline-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-deadline-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Warn starting from" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No deadline information to update")))) + (t (org-add-planning-info 'deadline time 'closed) (when (and old-date org-log-redeadline (not (equal old-date @@ -12282,11 +12978,12 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp))))) + (message "Deadline on %s" org-last-inserted-timestamp)))))) -(defun org-schedule (&optional remove time) +(defun org-schedule (arg &optional time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. -With argument REMOVE, remove any scheduling date from the item. +With one universal prefix argument, remove any scheduling date from the item. +With two universal prefix arguments, prompt for a delay cookie. With argument TIME, scheduled at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") @@ -12295,22 +12992,44 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 'region-start-level 'region)) org-loop-over-headlines-in-active-region) (org-map-entries - `(org-schedule ',remove ,time) + `(org-schedule ',arg ,time) org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "SCHEDULED")) + (old-date-time (if old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) - (if remove - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date 'findpos - org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled.")) + (cond + ((equal arg '(4)) + (progn + (when (and old-date org-log-reschedule) + (org-add-log-setup 'delschedule nil old-date 'findpos + org-log-reschedule)) + (org-remove-timestamp-with-keyword org-scheduled-string) + (message "Item is no longer scheduled."))) + ((equal arg '(16)) + (save-excursion + (org-back-to-heading t) + (if (re-search-forward + org-scheduled-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-scheduled-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Delay until" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No scheduled information to update")))) + (t (org-add-planning-info 'scheduled time 'closed) (when (and old-date org-log-reschedule (not (equal old-date @@ -12330,7 +13049,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp))))) + (message "Scheduled to %s" org-last-inserted-timestamp)))))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable @@ -12366,6 +13085,9 @@ nil." (delete-region (point-at-bol) (min (point-max) (1+ (point-at-eol)))))))))) +(defvar org-time-was-given) ; dynamically scoped parameter +(defvar org-end-time-was-given) ; dynamically scoped parameter + (defun org-add-planning-info (what &optional time &rest remove) "Insert new timestamp with keyword in the line directly after the headline. WHAT indicates what kind of time stamp to add. TIME indicates the time to use. @@ -12578,7 +13300,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) (if (memq org-log-note-how '(time state)) - (let (current-prefix-arg) (org-store-log-note)) + (let (current-prefix-arg) (org-store-log-note)) (let ((org-inhibit-startup t)) (org-mode)) (insert (format "# Insert note for %s. # Finish with C-c C-c, or cancel with C-c C-k.\n\n" @@ -12609,10 +13331,10 @@ EXTRA is additional text that will be inserted into the notes buffer." (defvar org-note-abort nil) ; dynamically scoped (defun org-store-log-note () "Finish taking a log note, and insert it to where it belongs." - (let ((txt (buffer-string)) - (note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind bul) + (let ((txt (buffer-string))) (kill-buffer (current-buffer)) + (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) + lines ind bul) (while (string-match "\\`# .*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) (if (string-match "\\s-+\\'" txt) @@ -12679,12 +13401,19 @@ EXTRA is additional text that will be inserted into the notes buffer." (insert (pop lines)))) (message "Note stored") (org-back-to-heading t) - (org-cycle-hide-drawers 'children))))) - (set-window-configuration org-log-note-window-configuration) - (with-current-buffer (marker-buffer org-log-note-return-to) - (goto-char org-log-note-return-to)) - (move-marker org-log-note-return-to nil) - (and org-log-post-message (message "%s" org-log-post-message))) + (org-cycle-hide-drawers 'children)) + ;; Fix `buffer-undo-list' when `org-store-log-note' is called + ;; from within `org-add-log-note' because `buffer-undo-list' + ;; is then modified outside of `org-with-remote-undo'. + (when (eq this-command 'org-agenda-todo) + (setcdr buffer-undo-list (cddr buffer-undo-list))))))) + ;; Don't add undo information when called from `org-agenda-todo' + (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) + (set-window-configuration org-log-note-window-configuration) + (with-current-buffer (marker-buffer org-log-note-return-to) + (goto-char org-log-note-return-to)) + (move-marker org-log-note-return-to nil) + (and org-log-post-message (message "%s" org-log-post-message)))) (defun org-remove-empty-drawer-at (drawer pos) "Remove an empty drawer DRAWER at position POS. @@ -12725,11 +13454,14 @@ D Show deadlines and scheduled items between a date range." ((eq type 'active) "only active timestamps") ((eq type 'inactive) "only inactive timestamps") ((eq type 'scheduled-or-deadline) "scheduled/deadline") + ((eq type 'closed) "with a closed time-stamp") (t "scheduled/deadline"))) (setq ans (read-char-exclusive)) (cond ((equal ans ?c) - (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive))))) + (org-sparse-tree + arg (cadr (member type '(scheduled-or-deadline + all scheduled deadline active inactive closed))))) ((equal ans ?d) (call-interactively 'org-check-deadlines)) ((equal ans ?b) @@ -12754,7 +13486,7 @@ D Show deadlines and scheduled items between a date range." (org-match-sparse-tree arg (concat kwd "=" value))) ((member ans '(?r ?R ?/)) (call-interactively 'org-occur)) - (t (error "No such sparse tree command \"%c\"" ans))))) + (t (user-error "No such sparse tree command \"%c\"" ans))))) (defvar org-occur-highlights nil "List of overlays used for occur matches.") @@ -12783,7 +13515,7 @@ If CALLBACK is non-nil, it is a function which is called to confirm that the match should indeed be shown." (interactive "sRegexp: \nP") (when (equal regexp "") - (error "Regexp cannot be empty")) + (user-error "Regexp cannot be empty")) (unless keep-previous (org-remove-occur-highlights nil nil t)) (push (cons regexp callback) org-occur-parameters) @@ -12867,7 +13599,7 @@ How much context is shown depends upon the variables (not (bobp))) (org-flag-heading nil) (when siblings-p (org-show-siblings))))) - (org-fix-ellipsis-at-bol))) + (unless (eq key 'agenda) (org-fix-ellipsis-at-bol)))) (defvar org-reveal-start-hook nil "Hook run before revealing a location.") @@ -12940,7 +13672,7 @@ ACTION can be `set', `up', `down', or a character." (if (equal action '(4)) (org-show-priority) (unless org-enable-priority-commands - (error "Priority commands are disabled")) + (user-error "Priority commands are disabled")) (setq action (or action 'set)) (let (current new news have remove) (save-excursion @@ -12964,7 +13696,7 @@ ACTION can be `set', `up', `down', or a character." (setq new (upcase new))) (cond ((equal new ?\ ) (setq remove t)) ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) - (error "Priority must be between `%c' and `%c'" + (user-error "Priority must be between `%c' and `%c'" org-highest-priority org-lowest-priority)))) ((eq action 'up) (setq new (if have @@ -12986,7 +13718,7 @@ ACTION can be `set', `up', `down', or a character." (if org-priority-start-cycle-with-default org-default-priority (1+ org-default-priority)))))) - (t (error "Invalid action"))) + (t (user-error "Invalid action"))) (if (or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) (if (and (memq action '(up down)) @@ -13003,7 +13735,7 @@ ACTION can be `set', `up', `down', or a character." (replace-match "" t t nil 1) (replace-match news t t nil 2)) (if remove - (error "No priority cookie found in line") + (user-error "No priority cookie found in line") (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (if (match-end 2) @@ -13062,7 +13794,7 @@ a file becomes an N^2 operation - but with this variable set, it scales as N.") (defun org-scan-tags (action matcher todo-only &optional start-level) - "Scan headline tags with inheritance and produce output ACTION. + "Sca headline tags with inheritance and produce output ACTION. ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, or `agenda' to produce an entry list for an agenda view. It can also be @@ -13098,7 +13830,6 @@ headlines matching this string." (abbreviate-file-name (or (buffer-file-name (buffer-base-buffer)) (buffer-name (buffer-base-buffer))))))) - (case-fold-search nil) (org-map-continue-from nil) lspos tags tags-list (tags-alist (list (cons 0 org-file-tags))) @@ -13111,13 +13842,14 @@ headlines matching this string." (when (eq action 'sparse-tree) (org-overview) (org-remove-occur-highlights)) - (while (re-search-forward re nil t) + (while (let (case-fold-search) + (re-search-forward re nil t)) (setq org-map-continue-from nil) (catch :skip (setq todo (if (match-end 1) (org-match-string-no-properties 2)) tags (if (match-end 4) (org-match-string-no-properties 4))) (goto-char (setq lspos (match-beginning 0))) - (setq level (org-reduced-level (funcall outline-level)) + (setq level (org-reduced-level (org-outline-level)) category (org-get-category)) (setq i llast llast level) ;; remove tag lists from same and sublevels @@ -13182,7 +13914,7 @@ headlines matching this string." (if (eq org-tags-match-list-sublevels 'indented) (make-string (1- level) ?.) "") (org-get-heading)) - category + level category tags-list) priority (org-get-priority txt)) (goto-char lspos) @@ -13197,7 +13929,7 @@ headlines matching this string." (save-excursion (setq rtn1 (funcall action)) (push rtn1 rtn))) - (t (error "Invalid action"))) + (t (user-error "Invalid action"))) ;; if we are to skip sublevels, jump to end of subtree (unless org-tags-match-list-sublevels @@ -13300,11 +14032,14 @@ See also `org-scan-tags'. " (declare (special todo-only)) (unless (boundp 'todo-only) - (error "org-make-tags-matcher expects todo-only to be scoped in")) + (error "`org-make-tags-matcher' expects todo-only to be scoped in")) (unless match - ;; Get a new match request, with completion + ;; Get a new match request, with completion against the global + ;; tags table and the local tags in current buffer (let ((org-last-tags-completion-table - (org-global-tags-completion-table))) + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))))) (setq match (org-completing-read-no-i "Match: " 'org-tags-completion-function nil nil nil 'org-tags-history)))) @@ -13315,8 +14050,19 @@ See also `org-scan-tags'. minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p - prop-p pn pv po gv rest) - (if (string-match "/+" match) + prop-p pn pv po gv rest (start 0) (ss 0)) + ;; Expand group tags + (setq match (org-tags-expand match)) + + ;; Check if there is a TODO part of this match, which would be the + ;; part after a "/". TO make sure that this slash is not part of + ;; a property value to be matched against, we also check that there + ;; is no " after that slash. + ;; First, find the last slash + (while (string-match "/+" match ss) + (setq start (match-beginning 0) ss (match-end 0))) + (if (and (string-match "/+" match start) + (not (save-match-data (string-match "\"" match start)))) ;; match contains also a todo-matching request (progn (setq tagsmatch (substring match 0 (match-beginning 0)) @@ -13422,6 +14168,62 @@ See also `org-scan-tags'. matcher))) (cons match0 matcher))) +(defun org-tags-expand (match &optional single-as-list downcased) + "Expand group tags in MATCH. + +This replaces every group tag in MATCH with a regexp tag search. +For example, a group tag \"Work\" defined as { Work : Lab Conf } +will be replaced like this: + + Work => {\\(?:Work\\|Lab\\|Conf\\)} + +Work => +{\\(?:Work\\|Lab\\|Conf\\)} + -Work => -{\\(?:Work\\|Lab\\|Conf\\)} + +Replacing by a regexp preserves the structure of the match. +E.g., this expansion + + Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home + +will match anything tagged with \"Lab\" and \"Home\", or tagged +with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". + +When the optional argument SINGLE-AS-LIST is non-nil, MATCH is +assumed to be a single group tag, and the function will return +the list of tags in this group. + +When DOWNCASE is non-nil, expand downcased TAGS." + (if org-group-tags + (let* ((case-fold-search t) + (stable org-mode-syntax-table) + (tal (or org-tag-groups-alist-for-agenda + org-tag-groups-alist)) + (tal (if downcased + (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal)) + (tml (mapcar 'car tal)) + (rtnmatch match) rpl) + ;; @ and _ are allowed as word-components in tags + (modify-syntax-entry ?@ "w" stable) + (modify-syntax-entry ?_ "w" stable) + (while (and tml + (with-syntax-table stable + (string-match + (concat "\\(?1:[+-]?\\)\\(?2:\\<" + (regexp-opt tml) "\\>\\)") rtnmatch))) + (let* ((dir (match-string 1 rtnmatch)) + (tag (match-string 2 rtnmatch)) + (tag (if downcased (downcase tag) tag))) + (setq tml (delete tag tml)) + (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch))) + (setq rpl (append (org-uniquify rpl) (assoc tag tal))) + (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}")) + (if (stringp rpl) (org-add-props rpl '(grouptag t))) + (setq rtnmatch (replace-match rpl t t rtnmatch))))) + (if single-as-list + (or (reverse rpl) (list rtnmatch)) + rtnmatch)) + (if single-as-list (list (if downcased (downcase match) match)) + match))) + (defun org-op-to-function (op &optional stringp) "Turn an operator into the appropriate function." (setq op @@ -13600,7 +14402,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (insert (make-string (- ncol (current-column)) ?\ )) (setq ncol (current-column)) (when indent-tabs-mode (tabify p (point-at-eol))) - (org-move-to-column (min ncol col) t)) + (org-move-to-column (min ncol col) t nil t)) (goto-char pos)))) (defun org-set-tags-command (&optional arg just-align) @@ -13755,7 +14557,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) tags) (t (error "Tags alignment failed"))) - (org-move-to-column col) + (org-move-to-column col nil nil t) (unless just-align (run-hooks 'org-after-tags-change-hook)))))) @@ -13766,7 +14568,9 @@ This works in the agenda, and also in an org-mode buffer." (list (region-beginning) (region-end) (let ((org-last-tags-completion-table (if (derived-mode-p 'org-mode) - (org-get-buffer-tags) + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))) (org-global-tags-completion-table)))) (org-icompleting-read "Tag: " 'org-tags-completion-function nil nil nil @@ -13818,15 +14622,14 @@ This works in the agenda, and also in an org-mode buffer." rtn) ((eq flag t) ;; all-completions - (all-completions s2 ctable confirm) - ) + (all-completions s2 ctable confirm)) ((eq flag 'lambda) ;; exact match? - (assoc s2 ctable))) - )) + (assoc s2 ctable))))) (defun org-fast-tag-insert (kwd tags face &optional end) - "Insert KDW, and the TAGS, the latter with face FACE. Also insert END." + "Insert KDW, and the TAGS, the latter with face FACE. +Also insert END." (insert (format "%-12s" (concat kwd ":")) (org-add-props (mapconcat 'identity tags " ") nil 'face face) (or end ""))) @@ -13842,6 +14645,7 @@ This works in the agenda, and also in an org-mode buffer." (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) (defun org-set-current-tags-overlay (current prefix) + "Add an overlay to CURRENT tag with PREFIX." (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) (if (featurep 'xemacs) (org-overlay-display org-tags-overlay (concat prefix s) @@ -13924,6 +14728,7 @@ Returns the new tags string, or nil to not change the current settings." (while (equal (car tbl) '(:newline)) (insert "\n") (setq tbl (cdr tbl))))) + ((equal e '(:grouptags)) nil) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) @@ -13939,11 +14744,13 @@ Returns the new tags string, or nil to not change the current settings." (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face - (cond - ((not (assoc tg table)) - (org-get-todo-face tg)) - ((member tg current) c-face) - ((member tg inherited) i-face)))) + (cond + ((not (assoc tg table)) + (org-get-todo-face tg)) + ((member tg current) c-face) + ((member tg inherited) i-face)))) + (if (equal (caar tbl) :grouptags) + (org-add-props tg nil 'face 'org-tag-group)) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) @@ -14045,7 +14852,7 @@ Returns the new tags string, or nil to not change the current settings." (defun org-get-tags-string () "Get the TAGS string in the current headline." (unless (org-at-heading-p t) - (error "Not on a heading")) + (user-error "Not on a heading")) (save-excursion (beginning-of-line 1) (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) @@ -14153,7 +14960,7 @@ a *different* entry, you cannot use these techniques." ((eq match nil) (setq matcher t)) (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) - (save-excursion + (save-window-excursion (save-restriction (cond ((eq scope 'tree) (org-back-to-heading t) @@ -14248,16 +15055,6 @@ Being in this list makes sure that they are offered for completion.") org-property-end-re "\\)\n?") "Matches an entire clock drawer.") -(defsubst org-re-property (property) - "Return a regexp matching a PROPERTY line. -Match group 1 will be set to the value." - (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)")) - -(defsubst org-re-property-keyword (property) - "Return a regexp matching a PROPERTY line, possibly with no -value for the property." - (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?")) - (defun org-property-action () "Do an action on properties." (interactive) @@ -14274,13 +15071,15 @@ value for the property." (call-interactively 'org-delete-property-globally)) ((equal c ?c) (call-interactively 'org-compute-property-at-point)) - (t (error "No such property action %c" c))))) + (t (user-error "No such property action %c" c))))) (defun org-inc-effort () "Increment the value of the effort property in the current entry." (interactive) (org-set-effort nil t)) +(defvar org-clock-effort) ;; Defined in org-clock.el +(defvar org-clock-current-task) ;; Defined in org-clock.el (defun org-set-effort (&optional value increment) "Set the effort property of the current entry. With numerical prefix arg, use the nth allowed value, 0 stands for the @@ -14294,6 +15093,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (cur (org-entry-get nil prop)) (allowed (org-property-get-allowed-values nil prop 'table)) (existing (mapcar 'list (org-property-values prop))) + (heading (nth 4 (org-heading-components))) rpl (val (cond ((stringp value) value) @@ -14302,7 +15102,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (car (org-last allowed)))) ((and allowed increment) (or (caadr (member (list cur) allowed)) - (error "Allowed effort values are not set"))) + (user-error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" (if cur (concat "=" cur) "") @@ -14327,18 +15127,17 @@ When INCREMENT is non-nil, set the property to the next allowed value." (save-excursion (org-back-to-heading t) (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) + (when (string= heading org-clock-current-task) + (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort)) + (org-clock-update-mode-line)) (message "%s is now %s" prop val))) (defun org-at-property-p () "Is cursor inside a property drawer?" (save-excursion - (beginning-of-line 1) - (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")) - (save-match-data ;; Used by calling procedures - (let ((p (point)) - (range (unless (org-before-first-heading-p) - (org-get-property-block)))) - (and range (<= (car range) p) (< p (cdr range)))))))) + (when (equal 'node-property (car (org-element-at-point))) + (beginning-of-line 1) + (looking-at org-property-re)))) (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. @@ -14385,104 +15184,102 @@ is a string only get exactly this property. SPECIFIC can be a string, the specific property we are interested in. Specifying it can speed things up because then unnecessary parsing is avoided." (setq which (or which 'all)) - (org-with-point-at pom - (let ((clockstr (substring org-clock-string 0 -1)) - (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) - (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum clocksumt) - (save-excursion - (when (condition-case nil - (and (derived-mode-p 'org-mode) (org-back-to-heading t)) - (error nil)) - (setq beg (point)) - (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes) - clocksumt (get-text-property (point) :org-clock-minutes-today)) - (outline-next-heading) - (setq end (point)) - (when (memq which '(all special)) - ;; Get the special properties, like TODO and tags - (goto-char beg) - (when (and (or (not specific) (string= specific "TODO")) - (looking-at org-todo-line-regexp) (match-end 2)) - (push (cons "TODO" (org-match-string-no-properties 2)) props)) - (when (and (or (not specific) (string= specific "PRIORITY")) - (looking-at org-priority-regexp)) - (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (or (not specific) (string= specific "FILE")) - (push (cons "FILE" buffer-file-name) props)) - (when (and (or (not specific) (string= specific "TAGS")) - (setq value (org-get-tags-string)) - (string-match "\\S-" value)) - (push (cons "TAGS" value) props)) - (when (and (or (not specific) (string= specific "ALLTAGS")) - (setq value (org-get-tags-at))) - (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") - ":")) - props)) - (when (or (not specific) (string= specific "BLOCKED")) - (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) - (when (or (not specific) - (member specific - '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" - "TIMESTAMP" "TIMESTAMP_IA"))) - (catch 'match - (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) - (substring (org-match-string-no-properties 1) - 0 -1)) - string (if (equal key clockstr) - (org-trim - (buffer-substring-no-properties - (match-beginning 3) (goto-char - (point-at-eol)))) - (substring (org-match-string-no-properties 3) - 1 -1))) - ;; Get the correct property name from the key. This is - ;; necessary if the user has configured time keywords. - (setq key1 (concat key ":")) - (cond - ((not key) - (setq key - (if (= (char-after (match-beginning 3)) ?\[) - "TIMESTAMP_IA" "TIMESTAMP"))) - ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) - ((equal key1 org-deadline-string) (setq key "DEADLINE")) - ((equal key1 org-closed-string) (setq key "CLOSED")) - ((equal key1 org-clock-string) (setq key "CLOCK"))) - (if (and specific (equal key specific) (not (equal key "CLOCK"))) - (progn - (push (cons key string) props) - ;; no need to search further if match is found - (throw 'match t)) - (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props))))))) + (org-with-wide-buffer + (org-with-point-at pom + (let ((clockstr (substring org-clock-string 0 -1)) + (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) + (case-fold-search nil) + beg end range props sum-props key key1 value string clocksum clocksumt) + (when (and (derived-mode-p 'org-mode) + (ignore-errors (org-back-to-heading t))) + (setq beg (point)) + (setq sum-props (get-text-property (point) 'org-summaries)) + (setq clocksum (get-text-property (point) :org-clock-minutes) + clocksumt (get-text-property (point) :org-clock-minutes-today)) + (outline-next-heading) + (setq end (point)) + (when (memq which '(all special)) + ;; Get the special properties, like TODO and tags + (goto-char beg) + (when (and (or (not specific) (string= specific "TODO")) + (looking-at org-todo-line-regexp) (match-end 2)) + (push (cons "TODO" (org-match-string-no-properties 2)) props)) + (when (and (or (not specific) (string= specific "PRIORITY")) + (looking-at org-priority-regexp)) + (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) + (when (or (not specific) (string= specific "FILE")) + (push (cons "FILE" buffer-file-name) props)) + (when (and (or (not specific) (string= specific "TAGS")) + (setq value (org-get-tags-string)) + (string-match "\\S-" value)) + (push (cons "TAGS" value) props)) + (when (and (or (not specific) (string= specific "ALLTAGS")) + (setq value (org-get-tags-at))) + (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") + ":")) + props)) + (when (or (not specific) (string= specific "BLOCKED")) + (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) + (when (or (not specific) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) + (catch 'match + (while (re-search-forward org-maybe-keyword-time-regexp end t) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) + string (if (equal key clockstr) + (org-trim + (buffer-substring-no-properties + (match-beginning 3) (goto-char + (point-at-eol)))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (if (and specific (equal key specific) (not (equal key "CLOCK"))) + (progn + (push (cons key string) props) + ;; no need to search further if match is found + (throw 'match t)) + (when (or (equal key "CLOCK") (not (assoc key props))) + (push (cons key string) props))))))) - (when (memq which '(all standard)) - ;; Get the standard properties, like :PROP: ... - (setq range (org-get-property-block beg end)) - (when range - (goto-char (car range)) - (while (re-search-forward - (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?") - (cdr range) t) - (setq key (org-match-string-no-properties 1) - value (org-trim (or (org-match-string-no-properties 2) ""))) - (unless (member key excluded) - (push (cons key (or value "")) props))))) - (if clocksum - (push (cons "CLOCKSUM" - (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) - props)) - (if clocksumt - (push (cons "CLOCKSUM_T" - (org-columns-number-to-string (/ (float clocksumt) 60.) - 'add_times)) - props)) - (unless (assoc "CATEGORY" props) - (push (cons "CATEGORY" (org-get-category)) props)) - (append sum-props (nreverse props))))))) + (when (memq which '(all standard)) + ;; Get the standard properties, like :PROP: ... + (setq range (org-get-property-block beg end)) + (when range + (goto-char (car range)) + (while (re-search-forward org-property-re + (cdr range) t) + (setq key (org-match-string-no-properties 2) + value (org-trim (or (org-match-string-no-properties 3) ""))) + (unless (member key excluded) + (push (cons key (or value "")) props))))) + (if clocksum + (push (cons "CLOCKSUM" + (org-columns-number-to-string (/ (float clocksum) 60.) + 'add_times)) + props)) + (if clocksumt + (push (cons "CLOCKSUM_T" + (org-columns-number-to-string (/ (float clocksumt) 60.) + 'add_times)) + props)) + (unless (assoc "CATEGORY" props) + (push (cons "CATEGORY" (org-get-category)) props)) + (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry or content at point-or-marker POM. @@ -14493,6 +15290,8 @@ in `org-use-property-inheritance' selects PROPERTY for inheritance. If the property is present but empty, the return value is the empty string. If the property is not present at all, nil is returned. +Return the value as a string. + If LITERAL-NIL is set, return the string value \"nil\" as a string, do not interpret it as the list atom nil. This is used for inheritance when a \"nil\" value can supersede a non-nil value higher up the hierarchy." @@ -14502,30 +15301,32 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." t)) (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) - ;; We need a special property. Use `org-entry-properties' to - ;; retrieve it, but specify the wanted property + ;; We need a special property. Use `org-entry-properties' + ;; to retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (org-get-property-block))) - (when (and range (not (eq (car range) (cdr range)))) - (let* ((props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 1) - (org-match-string-no-properties 1) "") - props))))) - val) - (goto-char (car range)) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) + (org-with-wide-buffer + (let ((range (org-get-property-block))) + (when (and range (not (eq (car range) (cdr range)))) + (let* ((props + (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) + (when (re-search-forward + (org-re-property key) (cdr range) t) + (setq props + (org-update-property-plist + key + (if (match-end 3) + (org-match-string-no-properties 3) "") + props))))) + val) + (goto-char (car range)) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. @@ -14535,8 +15336,10 @@ If yes, return this value. If not, return the current value of the variable." (read prop) (symbol-value var)))) -(defun org-entry-delete (pom property) - "Delete the property PROPERTY from entry at point-or-marker POM." +(defun org-entry-delete (pom property &optional delete-empty-drawer) + "Delete the property PROPERTY from entry at point-or-marker POM. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." (org-with-point-at pom (if (member property org-special-properties) nil ; cannot delete these properties. @@ -14548,6 +15351,9 @@ If yes, return this value. If not, return the current value of the variable." (cdr range) t)) (progn (delete-region (match-beginning 0) (1+ (point-at-eol))) + (and delete-empty-drawer + (org-remove-empty-drawer-at + delete-empty-drawer (car range))) t) nil))))) @@ -14559,7 +15365,7 @@ If yes, return this value. If not, return the current value of the variable." (values (and old (org-split-string old "[ \t]")))) (setq value (org-entry-protect-space value)) (unless (member value values) - (setq values (cons value values)) + (setq values (append values (list value))) (org-entry-put pom property (mapconcat 'identity values " "))))) @@ -14651,25 +15457,39 @@ Each hook function should accept two arguments, the name of the property and the new value.") (defun org-entry-put (pom property value) - "Set PROPERTY to VALUE for entry at point-or-marker POM." + "Set PROPERTY to VALUE for entry at point-or-marker POM. +If the value is `nil', it is converted to the empty string. +If it is not a string, an error is raised." + (cond ((null value) (setq value "")) + ((not (stringp value)) + (error "Properties values should be strings."))) (org-with-point-at pom (org-back-to-heading t) (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) range) (cond ((equal property "TODO") - (when (and (stringp value) (string-match "\\S-" value) + (when (and (string-match "\\S-" value) (not (member value org-todo-keywords-1))) - (error "\"%s\" is not a valid TODO state" value)) + (user-error "\"%s\" is not a valid TODO state" value)) (if (or (not value) (not (string-match "\\S-" value))) (setq value 'none)) (org-todo value) (org-set-tags nil 'align)) ((equal property "PRIORITY") - (org-priority (if (and value (stringp value) (string-match "\\S-" value)) + (org-priority (if (and value (string-match "\\S-" value)) (string-to-char value) ?\ )) (org-set-tags nil 'align)) + ((equal property "CLOCKSUM") + (if (not (re-search-forward + (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t)) + (error "Cannot find a clock log") + (goto-char (- (match-end 1) 2)) + (cond + ((eq value 'earlier) (org-timestamp-down)) + ((eq value 'later) (org-timestamp-up))) + (org-clock-sum-current-item))) ((equal property "SCHEDULED") (if (re-search-forward org-scheduled-time-regexp end t) (cond @@ -14692,7 +15512,7 @@ and the new value.") (setq range (org-get-property-block beg end 'force)) (goto-char (car range)) (if (re-search-forward - (org-re-property-keyword property) (cdr range) t) + (org-re-property property) (cdr range) t) (progn (delete-region (match-beginning 0) (match-end 0)) (goto-char (match-beginning 0))) @@ -14722,10 +15542,9 @@ formats in the current buffer." (while (re-search-forward org-property-start-re nil t) (setq range (org-get-property-block)) (goto-char (car range)) - (while (re-search-forward - (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):") + (while (re-search-forward org-property-re (cdr range) t) - (add-to-list 'rtn (org-match-string-no-properties 1))) + (add-to-list 'rtn (org-match-string-no-properties 2))) (outline-next-heading)))) (when include-specials @@ -14763,7 +15582,7 @@ formats in the current buffer." (let ((re (org-re-property key)) values) (while (re-search-forward re nil t) - (add-to-list 'values (org-trim (match-string 1)))) + (add-to-list 'values (org-trim (match-string 3)))) (delete "" values))))) (defun org-insert-property-drawer () @@ -14792,7 +15611,9 @@ formats in the current buffer." (beginning-of-line 1))) (org-skip-over-state-notes) (skip-chars-backward " \t\n\r") - (if (eq (char-before) ?*) (forward-char 1)) + (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n))) + (forward-char 1)) + (goto-char (point-at-eol)) (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) (beginning-of-line 0) (org-indent-to-column indent) @@ -14849,7 +15670,7 @@ Point is left between drawer's boundaries." (beginning-of-line) (when (save-excursion (re-search-forward org-outline-regexp-bol rend t)) - (error "Drawers cannot contain headlines")) + (user-error "Drawers cannot contain headlines")) ;; Position point at the beginning of the first ;; non-blank line in region. Insert drawer's opening ;; there, then indent it. @@ -14907,6 +15728,7 @@ This is computed according to `org-property-set-functions-alist'." val))) (defvar org-last-set-property nil) +(defvar org-last-set-property-value nil) (defun org-read-property-name () "Read a property name." (let* ((completion-ignore-case t) @@ -14924,8 +15746,7 @@ This is computed according to `org-property-set-functions-alist'." ": ") (mapcar 'list keys) nil nil nil nil - default-prop - ))) + default-prop))) (if (member property keys) property (or (cdr (assoc (downcase property) @@ -14933,6 +15754,23 @@ This is computed according to `org-property-set-functions-alist'." keys))) property)))) +(defun org-set-property-and-value (use-last) + "Allow to set [PROPERTY]: [value] direction from prompt. +When use-default, don't even ask, just use the last +\"[PROPERTY]: [value]\" string from the history." + (interactive "P") + (let* ((completion-ignore-case t) + (pv (or (and use-last org-last-set-property-value) + (org-completing-read + "Enter a \"[Property]: [value]\" pair: " + nil nil nil nil nil + org-last-set-property-value))) + prop val) + (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) + (setq prop (match-string 1 pv) + val (match-string 2 pv)) + (org-set-property prop val)))) + (defun org-set-property (property value) "In the current entry, set PROPERTY to VALUE. When called interactively, this will prompt for a property name, offering @@ -14945,20 +15783,23 @@ in the current file." (value (or value (org-read-property-value property))) (fn (cdr (assoc property org-properties-postprocess-alist)))) (setq org-last-set-property property) + (setq org-last-set-property-value (concat property ": " value)) ;; Possibly postprocess the inserted value: (when fn (setq value (funcall fn value))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) -(defun org-delete-property (property) - "In the current entry, delete PROPERTY." +(defun org-delete-property (property &optional delete-empty-drawer) + "In the current entry, delete PROPERTY. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." (interactive (let* ((completion-ignore-case t) (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property - (if (org-entry-delete nil property) + (if (org-entry-delete nil property delete-empty-drawer) "deleted" "was not present in the entry"))) @@ -14990,11 +15831,11 @@ This looks for an enclosing column format, extracts the operator and then applies it to the property in the column format's scope." (interactive) (unless (org-at-property-p) - (error "Not at a property")) + (user-error "Not at a property")) (let ((prop (org-match-string-no-properties 2))) (org-columns-get-format-and-top-level) (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) - (error "No operator defined for property %s" prop)) + (user-error "No operator defined for property %s" prop)) (org-columns-compute prop))) (defvar org-property-allowed-value-functions nil @@ -15047,22 +15888,23 @@ completion." "Switch to the next allowed value for this property." (interactive) (unless (org-at-property-p) - (error "Not at a property")) + (user-error "Not at a property")) (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) (key (match-string 2)) (value (match-string 3)) (allowed (or (org-property-get-allowed-values (point) key) (and (member value '("[ ]" "[-]" "[X]")) '("[ ]" "[X]")))) + (heading (save-match-data (nth 4 (org-heading-components)))) nval) (unless allowed - (error "Allowed values for this property have not been defined")) + (user-error "Allowed values for this property have not been defined")) (if previous (setq allowed (reverse allowed))) (if (member value allowed) (setq nval (car (cdr (member value allowed))))) (setq nval (or nval (car allowed))) (if (equal nval value) - (error "Only one allowed value for this property")) + (user-error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) (org-indent-line) @@ -15071,7 +15913,10 @@ completion." (when (equal prop org-effort-property) (save-excursion (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)) + (when (string= org-clock-current-task heading) + (setq org-clock-effort nval) + (org-clock-update-mode-line))) (run-hook-with-args 'org-property-changed-functions key nval))) (defun org-find-olp (path &optional this-buffer) @@ -15182,8 +16027,6 @@ Return the position where this entry starts, or nil if there is no such entry." (defvar org-last-changed-timestamp nil) (defvar org-last-inserted-timestamp nil "The last time stamp inserted with `org-insert-time-stamp'.") -(defvar org-time-was-given) ; dynamically scoped parameter -(defvar org-end-time-was-given) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter (defun org-time-stamp (arg &optional inactive) @@ -15201,7 +16044,10 @@ If there is already a timestamp at the cursor, it will be modified. With two universal prefix arguments, insert an active timestamp -with the current time without prompting the user." +with the current time without prompting the user. + +When called from lisp, the timestamp is inactive if INACTIVE is +non-nil." (interactive "P") (let* ((ts nil) (default-time @@ -15248,7 +16094,7 @@ with the current time without prompting the user." " " repeater ">")))) (message "Timestamp updated")) ((equal arg '(16)) - (org-insert-time-stamp (current-time) t)) + (org-insert-time-stamp (current-time) t inactive)) (t (setq time (let ((this-command this-command)) (org-read-date arg 'totime nil nil default-time default-input inactive))) @@ -15270,7 +16116,7 @@ with the current time without prompting the user." (setq dh (- h2 h1) dm (- m2 m1)) (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) (concat t1 "+" (number-to-string dh) - (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) + (and (/= 0 dm) (format ":%02d" dm))))))) (defun org-time-stamp-inactive (&optional arg) "Insert an inactive time stamp. @@ -15299,6 +16145,80 @@ So these are more for recording a certain time/date." (defvar org-read-date-analyze-forced-year nil) (defvar org-read-date-inactive) +(defvar org-read-date-minibuffer-local-map + (let* ((org-replace-disputed-keys nil) + (map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (org-defkey map (kbd ".") + (lambda () (interactive) + ;; Are we at the beginning of the prompt? + (if (looking-back "^[^:]+: ") + (org-eval-in-calendar '(calendar-goto-today)) + (insert ".")))) + (org-defkey map (kbd "C-.") + (lambda () (interactive) + (org-eval-in-calendar '(calendar-goto-today)))) + (org-defkey map [(meta shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [(meta shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [(shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) + (org-defkey map [(shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) + (org-defkey map [(shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + (org-defkey map [(shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + (org-defkey map "!" + (lambda () (interactive) + (org-eval-in-calendar '(diary-view-entries)) + (message ""))) + (org-defkey map ">" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-left 1)))) + (org-defkey map "<" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-defkey map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) + map) + "Keymap for minibuffer commands when using `org-read-date'.") + +(defvar org-def) +(defvar org-defdecode) +(defvar org-with-time) + (defun org-read-date (&optional org-with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. @@ -15319,7 +16239,8 @@ mean next year. For details, see the manual. A few examples: 12:45 --> today 12:45 22 sept 0:34 --> currentyear-09-22 0:34 12 --> currentyear-currentmonth-12 - Fri --> nearest Friday (today or later) + Fri --> nearest Friday after today + -Tue --> last Tuesday etc. Furthermore you can specify a relative date by giving, as the *first* thing @@ -15391,61 +16312,11 @@ user." (org-eval-in-calendar nil t) (let* ((old-map (current-local-map)) (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map (copy-keymap minibuffer-local-map))) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) (org-defkey map (kbd "RET") 'org-calendar-select) (org-defkey map [mouse-1] 'org-calendar-select-mouse) (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (org-defkey minibuffer-local-map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey minibuffer-local-map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey minibuffer-local-map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey minibuffer-local-map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey minibuffer-local-map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) - (org-defkey minibuffer-local-map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) - (org-defkey minibuffer-local-map "\C-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-left-three-months 1)))) - (org-defkey minibuffer-local-map "\M-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-right-three-months 1)))) - (run-hooks 'org-read-date-minibuffer-setup-hook) (unwind-protect (progn (use-local-map map) @@ -15494,9 +16365,6 @@ user." (nth 2 final) (nth 1 final)) (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) -(defvar org-def) -(defvar org-defdecode) -(defvar org-with-time) (defun org-read-date-display () "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live @@ -15757,7 +16625,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (if wday1 (progn (setq delta (mod (+ 7 (- wday1 wday)) 7)) - (if (= dir ?-) (setq delta (- delta 7))) + (if (= delta 0) (setq delta 7)) + (if (= dir ?-) + (progn + (setq delta (- delta 7)) + (if (= delta 0) (setq delta -7)))) (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) (list delta "d" rel)) (list (* n (if (= dir ?-) -1 1)) what rel))))) @@ -15913,32 +16785,44 @@ Don't touch the rest." (let ((n 0)) (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) -(defun org-days-to-time (timestamp-string) - "Difference between TIMESTAMP-STRING and now in days." - (- (time-to-days (org-time-string-to-time timestamp-string)) - (time-to-days (current-time)))) +(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") + +(defun org-time-stamp-to-now (timestamp-string &optional seconds) + "Difference between TIMESTAMP-STRING and now in days. +If SECONDS is non-nil, return the difference in seconds." + (let ((fdiff (if seconds 'org-float-time 'time-to-days))) + (- (funcall fdiff (org-time-string-to-time timestamp-string)) + (funcall fdiff (current-time))))) (defun org-deadline-close (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" (setq ndays (or ndays (org-get-wdays timestamp-string))) - (and (< (org-days-to-time timestamp-string) ndays) + (and (< (org-time-stamp-to-now timestamp-string) ndays) (not (org-entry-is-done-p)))) -(defun org-get-wdays (ts) - "Get the deadline lead time appropriate for timestring TS." - (cond - ((<= org-deadline-warning-days 0) - ;; 0 or negative, enforce this value no matter what - (- org-deadline-warning-days)) - ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) - ;; lead time is specified. - (floor (* (string-to-number (match-string 1 ts)) - (cdr (assoc (match-string 2 ts) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25) - ("h" . 0.041667))))))) - ;; go for the default. - (t org-deadline-warning-days))) +(defun org-get-wdays (ts &optional delay zero-delay) + "Get the deadline lead time appropriate for timestring TS. +When DELAY is non-nil, get the delay time for scheduled items +instead of the deadline lead time. When ZERO-DELAY is non-nil +and `org-scheduled-delay-days' is 0, enforce 0 as the delay, +don't try to find the delay cookie in the scheduled timestamp." + (let ((tv (if delay org-scheduled-delay-days + org-deadline-warning-days))) + (cond + ((or (and delay (< tv 0)) + (and delay zero-delay (<= tv 0)) + (and (not delay) (<= tv 0))) + ;; Enforce this value no matter what + (- tv)) + ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) + ;; lead time is specified. + (floor (* (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . 1) ("w" . 7) + ("m" . 30.4) ("y" . 365.25) + ("h" . 0.041667))))))) + ;; go for the default. + (t tv)))) (defun org-calendar-select-mouse (ev) "Return to `org-read-date' with the date currently selected. @@ -15981,6 +16865,7 @@ Allowed values for TYPE are: inactive: only inactive timestamps ([...]) scheduled: only scheduled timestamps deadline: only deadline timestamps + closed: only closed time-stamps When TYPE is nil, fall back on returning a regexp that matches both scheduled and deadline timestamps." @@ -15989,6 +16874,7 @@ both scheduled and deadline timestamps." ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]") ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")) ((eq type 'scheduled-or-deadline) (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) @@ -16052,7 +16938,7 @@ days in order to avoid rounding problems." (goto-char (point-at-bol)) (re-search-forward org-tr-regexp-both (point-at-eol) t)) (if (not (org-at-date-range-p t)) - (error "Not at a time-stamp range, and none found in current line"))) + (user-error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) (ts2 (match-string 2)) (havetime (or (> (length ts1) 15) (> (length ts2) 15))) @@ -16129,10 +17015,10 @@ days in order to avoid rounding problems." (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) "Convert a time stamp to an absolute day number. -If there is a specifier for a cyclic time stamp, get the closest date to -DAYNR. +If there is a specifier for a cyclic time stamp, get the closest +date to DAYNR. PREFER and SHOW-ALL are passed through to `org-closest-date'. -The variable date is bound by the calendar when this is called." +The variable `date' is bound by the calendar when this is called." (cond ((and daynr (string-match "\\`%%\\((.*)\\)" s)) (if (org-diary-sexp-entry (match-string 1 s) "" date) @@ -16158,7 +17044,7 @@ The variable date is bound by the calendar when this is called." (defun org-small-year-to-year (year) "Convert 2-digit years into 4-digit years. -38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007. +38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037. The year 2000 cannot be abbreviated. Any year larger than 99 is returned unchanged." (if (< year 38) @@ -16256,7 +17142,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) - (error "Invalid change specifier: %s" change)) + (user-error "Invalid change specifier: %s" change)) (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) (cond ((eq dw 'hour) @@ -16323,17 +17209,19 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." This should be a lot faster than the normal `parse-time-string'. If time is not given, defaults to 0:00. However, with optional NODEFAULT, hour and minute fields will be nil if not given." - (if (string-match org-ts-regexp0 s) - (list 0 - (if (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (if (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) - (string-to-number (match-string 4 s)) - (string-to-number (match-string 3 s)) - (string-to-number (match-string 2 s)) - nil nil nil) - (error "Not a standard Org-mode time string: %s" s))) + (cond ((string-match org-ts-regexp0 s) + (list 0 + (if (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (if (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) + (string-to-number (match-string 4 s)) + (string-to-number (match-string 3 s)) + (string-to-number (match-string 2 s)) + nil nil nil)) + ((string-match "^<[^>]+>$" s) + (decode-time (seconds-to-time (org-matcher-time s)))) + (t (error "Not a standard Org-mode time string: %s" s)))) (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. @@ -16423,11 +17311,12 @@ With prefix ARG, change that many days." (defvar org-clock-history) ; defined in org-clock.el (defvar org-clock-adjust-closest nil) ; defined in org-clock.el -(defun org-timestamp-change (n &optional what updown) +(defun org-timestamp-change (n &optional what updown suppress-tmp-delay) "Change the date in the time stamp at point. The date will be changed by N times WHAT. WHAT can be `day', `month', `year', `minute', `second'. If WHAT is not given, the cursor position -in the timestamp determines what will be changed." +in the timestamp determines what will be changed. +When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (let ((origin (point)) origin-cat with-hm inactive (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) @@ -16435,7 +17324,7 @@ in the timestamp determines what will be changed." extra rem ts time time0 fixnext clrgx) (if (not (org-at-timestamp-p t)) - (error "Not at a timestamp")) + (user-error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) (org-toggle-timestamp-type) ;; Point isn't on brackets. Remember the part of the time-stamp @@ -16451,10 +17340,12 @@ in the timestamp determines what will be changed." inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) (replace-match "") - (if (string-match - "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" - ts) - (setq extra (match-string 1 ts))) + (when (string-match + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" + ts) + (setq extra (match-string 1 ts)) + (if suppress-tmp-delay + (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) @@ -16518,7 +17409,7 @@ in the timestamp determines what will be changed." ;; Maybe adjust the closest clock in `org-clock-history' (when org-clock-adjust-closest (if (not (and (org-at-clock-log-p) - (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m)) + (< 1 (length (delq nil (mapcar 'marker-position org-clock-history)))))) (message "No clock to adjust") (cond ((save-excursion ; fix previous clock? @@ -16637,27 +17528,6 @@ If there is already a time stamp at the cursor position, update it." (org-insert-time-stamp (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) -(defun org-minutes-to-hh:mm-string (m) - "Compute H:MM from a number of minutes." - (let ((h (/ m 60))) - (setq m (- m (* 60 h))) - (format org-time-clocksum-format h m))) - -(defun org-hh:mm-string-to-minutes (s) - "Convert a string H:MM to a number of minutes. -If the string is just a number, interpret it as minutes. -In fact, the first hh:mm or number in the string will be taken, -there can be extra stuff in the string. -If no number is found, the return value is 0." - (cond - ((integerp s) s) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (+ (* (string-to-number (match-string 1 s)) 60) - (string-to-number (match-string 2 s)))) - ((string-match "\\([0-9]+\\)" s) - (string-to-number (match-string 1 s))) - (t 0))) - (defcustom org-effort-durations `(("h" . 60) ("d" . ,(* 60 8)) @@ -16679,7 +17549,146 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defcustom org-agenda-inhibit-startup t +(defun org-minutes-to-clocksum-string (m) + "Format number of minutes as a clocksum string. +The format is determined by `org-time-clocksum-format', +`org-time-clocksum-use-fractional' and +`org-time-clocksum-fractional-format' and +`org-time-clocksum-use-effort-durations'." + (let ((clocksum "") + (m (round m)) ; Don't allow fractions of minutes + h d w mo y fmt n) + (setq h (if org-time-clocksum-use-effort-durations + (cdr (assoc "h" org-effort-durations)) 60) + d (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "d" org-effort-durations)) h) 24) + w (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7) + mo (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30) + y (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365)) + ;; fractional format + (if org-time-clocksum-use-fractional + (cond + ;; single format string + ((stringp org-time-clocksum-fractional-format) + (format org-time-clocksum-fractional-format (/ m (float h)))) + ;; choice of fractional formats for different time units + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (> (/ (truncate m) (* y d h)) 0)) + (format fmt (/ m (* y d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (> (/ (truncate m) (* mo d h)) 0)) + (format fmt (/ m (* mo d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (> (/ (truncate m) (* w d h)) 0)) + (format fmt (/ m (* w d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (> (/ (truncate m) (* d h)) 0)) + (format fmt (/ m (* d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (> (/ (truncate m) h) 0)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes)) + (format fmt m)) + ;; fall back to smallest time unit with a format + ((setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (format fmt (/ m (* d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (format fmt (/ m (* w d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (format fmt (/ m (* mo d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (format fmt (/ m (* y d (float h)))))) + ;; standard (non-fractional) format, with single format string + (if (stringp org-time-clocksum-format) + (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n))) + ;; separate formats components + (and (setq fmt (plist-get org-time-clocksum-format :years)) + (or (> (setq n (/ (truncate m) (* y d h))) 0) + (plist-get org-time-clocksum-format :require-years)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n y d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :months)) + (or (> (setq n (/ (truncate m) (* mo d h))) 0) + (plist-get org-time-clocksum-format :require-months)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n mo d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :weeks)) + (or (> (setq n (/ (truncate m) (* w d h))) 0) + (plist-get org-time-clocksum-format :require-weeks)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n w d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :days)) + (or (> (setq n (/ (truncate m) (* d h))) 0) + (plist-get org-time-clocksum-format :require-days)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :hours)) + (or (> (setq n (/ (truncate m) h)) 0) + (plist-get org-time-clocksum-format :require-hours)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n h)))) + (and (setq fmt (plist-get org-time-clocksum-format :minutes)) + (or (> m 0) (plist-get org-time-clocksum-format :require-minutes)) + (setq clocksum (concat clocksum (format fmt m)))) + ;; return formatted time duration + clocksum)))) + +(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) +(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string + "Org mode version 8.0") + +(defun org-hours-to-clocksum-string (n) + (org-minutes-to-clocksum-string (* n 60))) + +(defun org-hh:mm-string-to-minutes (s) + "Convert a string H:MM to a number of minutes. +If the string is just a number, interpret it as minutes. +In fact, the first hh:mm or number in the string will be taken, +there can be extra stuff in the string. +If no number is found, the return value is 0." + (cond + ((integerp s) s) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) + (+ (* (string-to-number (match-string 1 s)) 60) + (string-to-number (match-string 2 s)))) + ((string-match "\\([0-9]+\\)" s) + (string-to-number (match-string 1 s))) + (t 0))) + +(defcustom org-image-actual-width t + "Should we use the actual width of images when inlining them? + +When set to `t', always use the image width. + +When set to a number, use imagemagick (when available) to set +the image's width to this value. + +When set to a number in a list, try to get the width from any +#+ATTR.* keyword if it matches a width specification like + + #+ATTR_HTML: :width 300px + +and fall back on that number if none is found. + +When set to nil, try to get the width from an #+ATTR.* keyword +and fall back on the original width if none is found. + +This requires Emacs >= 24.1, build with imagemagick support." + :group 'org-appearance + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Use the image width" t) + (integer :tag "Use a number of pixels") + (list :tag "Use #+ATTR* or a number of pixels" (integer)) + (const :tag "Use #+ATTR* or don't resize" nil))) + +(defcustom org-agenda-inhibit-startup nil "Inhibit startup when preparing agenda buffers. When this variable is `t' (the default), the initialization of the Org agenda buffers is inhibited: e.g. the visibility state @@ -16688,6 +17697,21 @@ is not set, the tables are not re-aligned, etc." :version "24.3" :group 'org-agenda) +(defcustom org-agenda-ignore-drawer-properties nil + "Avoid updating text properties when building the agenda. +Properties are used to prepare buffers for effort estimates, appointments, +and subtree-local categories. +If you don't use these in the agenda, you can add them to this list and +agenda building will be a bit faster. +The value is a list, with zero or more of the symbols `effort', `appt', +or `category'." + :type '(set :greedy t + (const effort) + (const appt) + (const category)) + :version "24.3" + :group 'org-agenda) + (defun org-duration-string-to-minutes (s &optional output-to-string) "Convert a duration string S to minutes. @@ -16733,7 +17757,7 @@ changes from another. I believe the procedure must be like this: 3. M-x org-revert-all-org-buffers" (interactive) (unless (yes-or-no-p "Revert all Org buffers from their files? ") - (error "Abort")) + (user-error "Abort")) (save-excursion (save-window-excursion (mapc @@ -16923,7 +17947,7 @@ If the current buffer does not, find the first agenda file." (files (append fs (list (car fs)))) (tcf (if buffer-file-name (file-truename buffer-file-name))) file) - (unless files (error "No agenda files")) + (unless files (user-error "No agenda files")) (catch 'exit (while (setq file (pop files)) (if (equal (file-truename file) tcf) @@ -16945,7 +17969,7 @@ end of the list." (org-agenda-files t))) (ctf (file-truename (or buffer-file-name - (error "Please save the current buffer to a file")))) + (user-error "Please save the current buffer to a file")))) x had) (setq x (assoc ctf file-alist) had x) @@ -16965,7 +17989,7 @@ Optional argument FILE means use this file instead of the current." (interactive) (let* ((org-agenda-skip-unavailable-files nil) (file (or file buffer-file-name - (error "Current buffer does not visit a file"))) + (user-error "Current buffer does not visit a file"))) (true-file (file-truename file)) (afile (abbreviate-file-name file)) (files (delq nil (mapcar @@ -17029,8 +18053,10 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - bmp file re) - (save-excursion + file re pos) + (setq org-tag-alist-for-agenda nil + org-tag-groups-alist-for-agenda nil) + (save-window-excursion (save-restriction (while (setq file (pop files)) (catch 'nextfile @@ -17039,10 +18065,21 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (org-check-agenda-file file) (set-buffer (org-get-agenda-file-buffer file))) (widen) - (setq bmp (buffer-modified-p)) - (org-refresh-category-properties) - (org-refresh-properties org-effort-property 'org-effort) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) + (org-set-regexps-and-options-for-tags) + (setq pos (point)) + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (search-forward "#+setupfile" nil t) + ;; Don't set all regexps and options systematically as + ;; this is only run for setting agenda tags from setup + ;; file + (org-set-regexps-and-options))) + (or (memq 'category org-agenda-ignore-drawer-properties) + (org-refresh-category-properties)) + (or (memq 'effort org-agenda-ignore-drawer-properties) + (org-refresh-properties org-effort-property 'org-effort)) + (or (memq 'appt org-agenda-ignore-drawer-properties) + (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) (setq org-todo-keywords-for-agenda (append org-todo-keywords-for-agenda org-todo-keywords-1)) (setq org-done-keywords-for-agenda @@ -17052,29 +18089,36 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (setq org-drawers-for-agenda (append org-drawers-for-agenda org-drawers)) (setq org-tag-alist-for-agenda - (append org-tag-alist-for-agenda org-tag-alist)) - - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees - (goto-char (point-min)) - (while (re-search-forward rea nil t) - (if (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (format org-heading-keyword-regexp-format - org-comment-string)) - (while (re-search-forward re nil t) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc))) - (set-buffer-modified-p bmp))))) + (org-uniquify + (append org-tag-alist-for-agenda + org-tag-alist + org-tag-persistent-alist))) + (if org-group-tags + (setq org-tag-groups-alist-for-agenda + (org-uniquify-alist + (append org-tag-groups-alist-for-agenda org-tag-groups-alist)))) + (org-with-silent-modifications + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (goto-char (point-min)) + (setq re (format org-heading-keyword-regexp-format + org-comment-string)) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc)))) + (goto-char pos))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) (setq org-todo-keyword-alist-for-agenda - (org-uniquify org-todo-keyword-alist-for-agenda) - org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) + (org-uniquify org-todo-keyword-alist-for-agenda)))) -;;;; Embedded LaTeX + +;;;; CDLaTeX minor mode (defvar org-cdlatex-mode-map (make-sparse-keymap) "Keymap for the minor `org-cdlatex-mode'.") @@ -17124,6 +18168,58 @@ an embedded LaTeX fragment, let texmathp do its job. "Unconditionally turn on `org-cdlatex-mode'." (org-cdlatex-mode 1)) +(defun org-try-cdlatex-tab () + "Check if it makes sense to execute `cdlatex-tab', and do it if yes. +It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is + - inside a LaTeX fragment, or + - after the first word in a line, where an abbreviation expansion could + insert a LaTeX environment." + (when org-cdlatex-mode + (cond + ;; Before any word on the line: No expansion possible. + ((save-excursion (skip-chars-backward " \t") (bolp)) nil) + ;; Just after first word on the line: Expand it. Make sure it + ;; cannot happen on headlines, though. + ((save-excursion + (skip-chars-backward "a-zA-Z0-9*") + (skip-chars-backward " \t") + (and (bolp) (not (org-at-heading-p)))) + (cdlatex-tab) t) + ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) + +(defun org-cdlatex-underscore-caret (&optional arg) + "Execute `cdlatex-sub-superscript' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-sub-superscript) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defun org-cdlatex-math-modify (&optional arg) + "Execute `cdlatex-math-modify' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-math-modify) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + + + +;;;; LaTeX fragments + +(defvar org-latex-regexps + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) + "Regular expressions for matching embedded LaTeX.") + (defun org-inside-LaTeX-fragment-p () "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing @@ -17174,43 +18270,6 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defun org-try-cdlatex-tab () - "Check if it makes sense to execute `cdlatex-tab', and do it if yes. -It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is - - inside a LaTeX fragment, or - - after the first word in a line, where an abbreviation expansion could - insert a LaTeX environment." - (when org-cdlatex-mode - (cond - ;; Before any word on the line: No expansion possible. - ((save-excursion (skip-chars-backward " \t") (bolp)) nil) - ;; Just after first word on the line: Expand it. Make sure it - ;; cannot happen on headlines, though. - ((save-excursion - (skip-chars-backward "a-zA-Z0-9*") - (skip-chars-backward " \t") - (and (bolp) (not (org-at-heading-p)))) - (cdlatex-tab) t) - ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) - -(defun org-cdlatex-underscore-caret (&optional arg) - "Execute `cdlatex-sub-superscript' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-sub-superscript) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-cdlatex-math-modify (&optional arg) - "Execute `cdlatex-math-modify' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-math-modify) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - (defvar org-latex-fragment-image-overlays nil "List of overlays carrying the images of latex fragments.") (make-variable-buffer-local 'org-latex-fragment-image-overlays) @@ -17232,51 +18291,40 @@ display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") (unless buffer-file-name - (error "Can't preview LaTeX fragment in a non-file buffer")) - (org-remove-latex-fragment-image-overlays) - (save-excursion - (save-restriction - (let (beg end at msg) - (cond - ((or (equal subtree '(16)) - (not (save-excursion - (re-search-backward org-outline-regexp-bol nil t)))) - (setq beg (point-min) end (point-max) - msg "Creating images for buffer...%s")) - ((equal subtree '(4)) - (org-back-to-heading) - (setq beg (point) end (org-end-of-subtree t) - msg "Creating images for subtree...%s")) - (t - (if (setq at (org-inside-LaTeX-fragment-p)) - (goto-char (max (point-min) (- (cdr at) 2))) - (org-back-to-heading)) - (setq beg (point) end (progn (outline-next-heading) (point)) - msg (if at "Creating image...%s" - "Creating images for entry...%s")))) - (message msg "") - (narrow-to-region beg end) - (goto-char beg) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer - org-latex-create-formula-image-program) - (message msg "done. Use `C-c C-c' to remove images."))))) + (user-error "Can't preview LaTeX fragment in a non-file buffer")) + (when (display-graphic-p) + (org-remove-latex-fragment-image-overlays) + (save-excursion + (save-restriction + (let (beg end at msg) + (cond + ((or (equal subtree '(16)) + (not (save-excursion + (re-search-backward org-outline-regexp-bol nil t)))) + (setq beg (point-min) end (point-max) + msg "Creating images for buffer...%s")) + ((equal subtree '(4)) + (org-back-to-heading) + (setq beg (point) end (org-end-of-subtree t) + msg "Creating images for subtree...%s")) + (t + (if (setq at (org-inside-LaTeX-fragment-p)) + (goto-char (max (point-min) (- (cdr at) 2))) + (org-back-to-heading)) + (setq beg (point) end (progn (outline-next-heading) (point)) + msg (if at "Creating image...%s" + "Creating images for entry...%s")))) + (message msg "") + (narrow-to-region beg end) + (goto-char beg) + (org-format-latex + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at 'forbuffer + org-latex-create-formula-image-program) + (message msg "done. Use `C-c C-c' to remove images.")))))) -(defvar org-latex-regexps - '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) - ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) - ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) - "Regular expressions for matching embedded LaTeX.") - -(defvar org-export-have-math nil) ;; dynamic scoping (defun org-format-latex (prefix &optional dir overlays msg at forbuffer processing-type) "Replace LaTeX fragments with links to an image, and produce images. @@ -17287,12 +18335,11 @@ Some of the options can be changed using the variable (absprefix (expand-file-name prefix dir)) (todir (file-name-directory absprefix)) (opt org-format-latex-options) + (optnew org-format-latex-options) (matchers (plist-get opt :matchers)) (re-list org-latex-regexps) - (org-format-latex-header-extra - (plist-get (org-infile-export-plist) :latex-header-extra)) (cnt 0) txt hash link beg end re e checkdir - executables-checked string + string m n block-type block linkfile movefile ov) ;; Check the different regular expressions (while (setq e (pop re-list)) @@ -17302,71 +18349,58 @@ Some of the options can be changed using the variable (goto-char (point-min)) (while (re-search-forward re nil t) (when (and (or (not at) (equal (cdr at) (match-beginning n))) - (not (get-text-property (match-beginning n) - 'org-protected)) (or (not overlays) (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (setq org-export-have-math t) (cond - ((eq processing-type 'verbatim) - ;; Leave the text verbatim, just protect it - (add-text-properties (match-beginning n) (match-end n) - '(org-protected t))) + ((eq processing-type 'verbatim)) ((eq processing-type 'mathjax) - ;; Prepare for MathJax processing + ;; Prepare for MathJax processing. (setq string (match-string n)) - (if (member m '("$" "$1")) - (save-excursion - (delete-region (match-beginning n) (match-end n)) - (goto-char (match-beginning n)) - (insert (org-add-props (concat "\\(" (substring string 1 -1) - "\\)") - '(org-protected t)))) - (add-text-properties (match-beginning n) (match-end n) - '(org-protected t)))) + (when (member m '("$" "$1")) + (save-excursion + (delete-region (match-beginning n) (match-end n)) + (goto-char (match-beginning n)) + (insert (concat "\\(" (substring string 1 -1) "\\)"))))) ((or (eq processing-type 'dvipng) (eq processing-type 'imagemagick)) - ;; Process to an image + ;; Process to an image. (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt)) - (let (print-length print-level) ; make sure full list is printed + (let ((face (face-at-point)) + (fg (plist-get opt :foreground)) + (bg (plist-get opt :background)) + ;; Ensure full list is printed. + print-length print-level) + (when forbuffer + ;; Get the colors from the face at point. + (goto-char beg) + (when (eq fg 'auto) + (setq fg (face-attribute face :foreground nil 'default))) + (when (eq bg 'auto) + (setq bg (face-attribute face :background nil 'default))) + (setq optnew (copy-sequence opt)) + (plist-put optnew :foreground fg) + (plist-put optnew :background bg)) (setq hash (sha1 (prin1-to-string (list org-format-latex-header - org-format-latex-header-extra - org-export-latex-default-packages-alist - org-export-latex-packages-alist + org-latex-default-packages-alist + org-latex-packages-alist org-format-latex-options - forbuffer txt))) + forbuffer txt fg bg))) linkfile (format "%s_%s.png" prefix hash) movefile (format "%s_%s.png" absprefix hash))) (setq link (concat block "[[file:" linkfile "]]" block)) (if msg (message msg cnt)) (goto-char beg) - (unless checkdir ; make sure the directory exists + (unless checkdir ; Ensure the directory exists. (setq checkdir t) (or (file-directory-p todir) (make-directory todir t))) - (cond - ((eq processing-type 'dvipng) - (unless executables-checked - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - (setq executables-checked t)) - (unless (file-exists-p movefile) - (org-create-formula-image-with-dvipng - txt movefile opt forbuffer))) - ((eq processing-type 'imagemagick) - (unless executables-checked - (org-check-external-command - "convert" "you need to install imagemagick") - (setq executables-checked t)) - (unless (file-exists-p movefile) - (org-create-formula-image-with-imagemagick - txt movefile opt forbuffer)))) + (unless (file-exists-p movefile) + (org-create-formula-image + txt movefile optnew forbuffer processing-type)) (if overlays (progn (mapc (lambda (o) @@ -17396,10 +18430,8 @@ Some of the options can be changed using the variable (if block-type 'paragraph 'character)))))) ((eq processing-type 'mathml) ;; Process to MathML - (unless executables-checked - (unless (save-match-data (org-format-latex-mathml-available-p)) - (error "LaTeX to MathML converter not configured")) - (setq executables-checked t)) + (unless (save-match-data (org-format-latex-mathml-available-p)) + (user-error "LaTeX to MathML converter not configured")) (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt)) @@ -17409,7 +18441,7 @@ Some of the options can be changed using the variable (insert (org-format-latex-as-mathml txt block-type prefix dir))) (t - (error "Unknown conversion type %s for latex fragments" + (error "Unknown conversion type %s for LaTeX fragments" processing-type))))))))) (defun org-create-math-formula (latex-frag &optional mathml-file) @@ -17425,7 +18457,7 @@ inspection." (buffer-substring-no-properties (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) - (unless latex-frag (error "Invalid latex-frag")) + (unless latex-frag (error "Invalid LaTeX fragment")) (let* ((tmp-in-file (file-relative-name (make-temp-name (expand-file-name "ltxmathml-in")))) (ignore (write-region latex-frag nil tmp-in-file)) @@ -17440,7 +18472,7 @@ inspection." mathml shell-command-output) (when (org-called-interactively-p 'any) (unless (org-format-latex-mathml-available-p) - (error "LaTeX to MathML converter not configured"))) + (user-error "LaTeX to MathML converter not configured"))) (message "Running %s" cmd) (setq shell-command-output (shell-command-to-string cmd)) (setq mathml @@ -17497,14 +18529,57 @@ inspection." 'org-latex-src-embed-type (if latex-frag-type 'paragraph 'character))) ;; Failed conversion. Return the LaTeX fragment verbatim - (add-text-properties - 0 (1- (length latex-frag)) '(org-protected t) latex-frag) latex-frag))) +(defun org-create-formula-image (string tofile options buffer &optional type) + "Create an image from LaTeX source using dvipng or convert. +This function calls either `org-create-formula-image-with-dvipng' +or `org-create-formula-image-with-imagemagick' depending on the +value of `org-latex-create-formula-image-program' or on the value +of the optional TYPE variable. + +Note: ultimately these two function should be combined as they +share a good deal of logic." + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (funcall + (case (or type org-latex-create-formula-image-program) + ('dvipng + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + #'org-create-formula-image-with-dvipng) + ('imagemagick + (org-check-external-command + "convert" "you need to install imagemagick") + #'org-create-formula-image-with-imagemagick) + (t (error + "Invalid value of `org-latex-create-formula-image-program'"))) + string tofile options buffer)) + +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export--get-global-options "ox" (&optional backend)) +(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-latex-guess-babel-language "ox-latex" (header info)) +(defun org-create-formula--latex-header () + "Return LaTeX header appropriate for previewing a LaTeX snippet." + (let ((info (org-combine-plists (org-export--get-global-options + (org-export-get-backend 'latex)) + (org-export--get-inbuffer-options + (org-export-get-backend 'latex))))) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist t + (plist-get info :latex-header))) + info))) + ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image-with-dvipng (string tofile options buffer) "This calls dvipng." - (require 'org-latex) + (require 'ox-latex) (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) temporary-file-directory)) @@ -17522,17 +18597,14 @@ inspection." "Black")) (bg (or (plist-get options (if buffer :background :html-background)) "Transparent"))) - (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) - (if (eq bg 'default) (setq bg (org-dvipng-color :background))) - (with-temp-file texfile - (insert (org-splice-latex-header - org-format-latex-header - org-export-latex-default-packages-alist - org-export-latex-packages-alist t - org-format-latex-header-extra)) - (insert "\n\\begin{document}\n" string "\n\\end{document}\n") - (require 'org-latex) - (org-export-latex-fix-inputenc)) + (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) + (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) + (if (eq bg 'default) (setq bg (org-dvipng-color :background)) + (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) (let ((dir default-directory)) (condition-case nil (progn @@ -17569,10 +18641,10 @@ inspection." (delete-file (concat texfilebase e)))) pngfile)))) -(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el +(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) (defun org-create-formula-image-with-imagemagick (string tofile options buffer) "This calls convert, which is included into imagemagick." - (require 'org-latex) + (require 'ox-latex) (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) temporary-file-directory)) @@ -17585,7 +18657,7 @@ inspection." (font-height (face-font 'default)) (face-attribute 'default :height nil))) (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) (fg (or (plist-get options (if buffer :foreground :html-foreground)) "black")) (bg (or (plist-get options (if buffer :background :html-background)) @@ -17594,54 +18666,19 @@ inspection." (setq fg (org-latex-color-format fg))) (if (eq bg 'default) (setq bg (org-latex-color :background)) (setq bg (org-latex-color-format - (if (string= bg "Transparent")(setq bg "white"))))) - (with-temp-file texfile - (insert (org-splice-latex-header - org-format-latex-header - org-export-latex-default-packages-alist - org-export-latex-packages-alist t - org-format-latex-header-extra)) - (insert "\n\\begin{document}\n" - "\\definecolor{fg}{rgb}{" fg "}\n" - "\\definecolor{bg}{rgb}{" bg "}\n" - "\n\\pagecolor{bg}\n" - "\n{\\color{fg}\n" - string - "\n}\n" - "\n\\end{document}\n" ) - (require 'org-latex) - (org-export-latex-fix-inputenc)) - (let ((dir default-directory) cmd cmds latex-frags-cmds) - (condition-case nil - (progn - (cd tmpdir) - (setq cmds org-latex-to-pdf-process) - (while cmds - (setq latex-frags-cmds (pop cmds)) - (if (listp latex-frags-cmds) - (setq cmds nil) - (setq latex-frags-cmds (list (car org-latex-to-pdf-process))))) - (while latex-frags-cmds - (setq cmd (pop latex-frags-cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument texfile)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument (file-name-nondirectory texfile))) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument (file-name-directory texfile))) - t t cmd))) - (setq cmd (split-string cmd)) - (eval (append (list 'call-process (pop cmd) nil nil nil) cmd)))) - (error nil)) - (cd dir)) + (if (string= bg "Transparent") "white" bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n"))) + (org-latex-compile texfile t) (if (not (file-exists-p pdffile)) (progn (message "Failed to create pdf file from %s" texfile) nil) (condition-case nil @@ -17652,7 +18689,7 @@ inspection." "-antialias" pdffile "-quality" "100" - ;; "-sharpen" "0x1.0" + ;; "-sharpen" "0x1.0" pngfile) (call-process "convert" nil nil nil "-density" dpi @@ -17660,7 +18697,7 @@ inspection." "-antialias" pdffile "-quality" "100" - ; "-sharpen" "0x1.0" + ;; "-sharpen" "0x1.0" pngfile)) (error nil)) (if (not (file-exists-p pngfile)) @@ -17745,6 +18782,12 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ((eq attr :background) 'background)))) (color-values (face-attribute 'default attr nil)))))) +(defun org-dvipng-color-format (color-name) + "Convert COLOR-NAME to a RGB color value for dvipng." + (apply 'format "rgb %s %s %s" + (mapcar 'org-normalize-color + (color-values color-name)))) + (defun org-latex-color (attr) "Return a RGB color for the LaTeX color package." (apply 'format "%s,%s,%s" @@ -17766,8 +18809,9 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) -;; Image display + +;; Image display (defvar org-inline-image-overlays nil) (make-variable-buffer-local 'org-inline-image-overlays) @@ -17781,7 +18825,8 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (org-remove-inline-images) (message "Inline image display turned off")) (org-display-inline-images include-linked) - (if org-inline-image-overlays + (if (and (org-called-interactively-p) + org-inline-image-overlays) (message "%d images displayed inline" (length org-inline-image-overlays)) (message "No images to display inline")))) @@ -17805,35 +18850,54 @@ When REFRESH is set, refresh existing images between BEG and END. This will create new image displays only if necessary. BEG and END default to the buffer boundaries." (interactive "P") - (unless refresh - (org-remove-inline-images) - (if (fboundp 'clear-image-cache) (clear-image-cache))) - (save-excursion - (save-restriction - (widen) - (setq beg (or beg (point-min)) end (or end (point-max))) - (goto-char beg) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) - "\\)\\]" (if include-linked "" "\\]"))) - old file ov img) - (while (re-search-forward re end t) - (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay)) - (setq file (expand-file-name - (concat (or (match-string 3) "") (match-string 4)))) - (when (file-exists-p file) - (if (and (car-safe old) refresh) - (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file))) - (when img - (setq ov (make-overlay (match-beginning 0) (match-end 0))) - (overlay-put ov 'display img) - (overlay-put ov 'face 'default) - (overlay-put ov 'org-image-overlay t) - (overlay-put ov 'modification-hooks - (list 'org-display-inline-remove-overlay)) - (push ov org-inline-image-overlays))))))))) + (when (display-graphic-p) + (unless refresh + (org-remove-inline-images) + (if (fboundp 'clear-image-cache) (clear-image-cache))) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char beg) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + (case-fold-search t) + old file ov img type attrwidth width) + (while (re-search-forward re end t) + (setq old (get-char-property-and-overlay (match-beginning 1) + 'org-image-overlay) + file (expand-file-name + (concat (or (match-string 3) "") (match-string 4)))) + (when (image-type-available-p 'imagemagick) + (setq attrwidth (if (or (listp org-image-actual-width) + (null org-image-actual-width)) + (save-excursion + (save-match-data + (when (re-search-backward + "#\\+attr.*:width[ \t]+\\([^ ]+\\)" + (save-excursion + (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) + (string-to-number (match-string 1)))))) + width (cond ((eq org-image-actual-width t) nil) + ((null org-image-actual-width) attrwidth) + ((numberp org-image-actual-width) + org-image-actual-width) + ((listp org-image-actual-width) + (or attrwidth (car org-image-actual-width)))) + type (if width 'imagemagick))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (save-match-data (create-image file type nil :width width))) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-remove-overlay)) + (push ov org-inline-image-overlays)))))))))) (define-obsolete-function-alias 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") @@ -17996,6 +19060,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-_" 'org-down-element) (org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) (org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) +(org-defkey org-mode-map "\C-c\M-f" 'org-next-block) +(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) @@ -18003,6 +19069,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) +(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups) (org-defkey org-mode-map "\C-c\C-j" 'org-goto) (org-defkey org-mode-map "\C-c\C-t" 'org-todo) (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) @@ -18010,6 +19077,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) (org-defkey org-mode-map "\C-c\C-w" 'org-refile) +(org-defkey org-mode-map "\C-c\M-w" 'org-copy) (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) @@ -18044,6 +19112,9 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) +(org-defkey org-mode-map [remap open-line] 'org-open-line) +(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) +(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) (org-defkey org-mode-map "\C-m" 'org-return) (org-defkey org-mode-map "\C-j" 'org-return-indent) (org-defkey org-mode-map "\C-c?" 'org-table-field-info) @@ -18058,7 +19129,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-a" 'org-attach) (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) -(org-defkey org-mode-map "\C-c\C-e" 'org-export) +(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) @@ -18089,6 +19160,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) +(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value) (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) @@ -18123,6 +19195,8 @@ BEG and END default to the buffer boundaries." ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) + ("F" . org-next-block) + ("B" . org-previous-block) ("u" . (org-speed-move-safe 'outline-up-heading)) ("j" . org-goto) ("g" . (org-refile t)) @@ -18130,6 +19204,7 @@ BEG and END default to the buffer boundaries." ("c" . org-cycle) ("C" . org-shifttab) (" " . org-display-outline-path) + ("s" . org-narrow-to-subtree) ("=" . org-columns) ("Outline Structure Editing") ("U" . org-shiftmetaup) @@ -18143,7 +19218,7 @@ BEG and END default to the buffer boundaries." ("^" . org-sort) ("w" . org-refile) ("a" . org-archive-subtree-default-with-confirmation) - ("." . org-mark-subtree) + ("@" . org-mark-subtree) ("#" . org-toggle-comment) ("Clock Commands") ("I" . org-clock-in) @@ -18190,7 +19265,7 @@ BEG and END default to the buffer boundaries." "Show the available speed commands." (interactive) (if (not org-use-speed-commands) - (error "Speed commands are not activated, customize `org-use-speed-commands'") + (user-error "Speed commands are not activated, customize `org-use-speed-commands'") (with-output-to-temp-buffer "*Help*" (princ "User-defined Speed commands\n===========================\n") (mapc 'org-print-speed-command org-speed-commands-user) @@ -18338,7 +19413,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (when (or (memq invisible-at-point '(outline org-hide-block t)) (memq invisible-before-point '(outline org-hide-block t))) (if (eq org-catch-invisible-edits 'error) - (error "Editing in invisible areas is prohibited - make visible first")) + (user-error "Editing in invisible areas is prohibited, make them visible first")) (if (and org-custom-properties-overlays (y-or-n-p "Display invisible properties in this buffer? ")) (org-toggle-custom-properties-visibility) @@ -18359,7 +19434,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (message "Unfolding invisible region around point before editing")) (t ;; Don't do the edit, make the user repeat it in full visibility - (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () (when (and (equal (char-after (point-at-bol)) ?*) @@ -18411,9 +19486,8 @@ because, in this case the deletion might narrow the column." (let ((pos (point)) (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) - (replace-match (concat - (substring (match-string 0) 1 -1) - " |")) + (replace-match + (concat (substring (match-string 0) 1 -1) " |") nil t) (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. @@ -18423,8 +19497,14 @@ because, in this case the deletion might narrow the column." (org-fix-tags-on-the-fly)))) ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode -(put 'org-self-insert-command 'delete-selection t) -(put 'orgtbl-self-insert-command 'delete-selection t) +(put 'org-self-insert-command 'delete-selection + (lambda () + (not (run-hook-with-args-until-success + 'self-insert-uses-region-functions)))) +(put 'orgtbl-self-insert-command 'delete-selection + (lambda () + (not (run-hook-with-args-until-success + 'self-insert-uses-region-functions)))) (put 'org-delete-char 'delete-selection 'supersede) (put 'org-delete-backward-char 'delete-selection 'supersede) (put 'org-yank 'delete-selection 'yank) @@ -18439,9 +19519,6 @@ because, in this case the deletion might narrow the column." (put 'org-self-insert-command 'pabbrev-expand-after-command t) (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - (defun org-remap (map &rest commands) "In MAP, remap the functions given in COMMANDS. COMMANDS is a list of alternating OLDDEF NEWDEF command names." @@ -18452,6 +19529,16 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey map (vector 'remap old) new) (substitute-key-definition old new map global-map))))) +(defun org-transpose-words () + "Transpose words for Org. +This uses the `org-mode-transpose-word-syntax-table' syntax +table, which interprets characters in `org-emphasis-alist' as +word constituents." + (interactive) + (with-syntax-table org-mode-transpose-word-syntax-table + (call-interactively 'transpose-words))) +(org-remap org-mode-map 'transpose-words 'org-transpose-words) + (when (eq org-enable-table-editor 'optimized) ;; If the user wants maximum table support, we need to hijack ;; some standard editing functions @@ -18577,13 +19664,13 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-modifier-cursor-error () "Throw an error, a modified cursor command was applied in wrong context." - (error "This command is active in special context like tables, headlines or items")) + (user-error "This command is active in special context like tables, headlines or items")) (defun org-shiftselect-error () "Throw an error because Shift-Cursor command was applied in wrong context." (if (and (boundp 'shift-select-mode) shift-select-mode) - (error "To use shift-selection with Org-mode, customize `org-support-shift-select'") - (error "This command works only in special context like headlines or timestamps"))) + (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (user-error "This command works only in special context like headlines or timestamps"))) (defun org-call-for-shift-select (cmd) (let ((this-command-keys-shift-translated t)) @@ -18591,9 +19678,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-shifttab (&optional arg) "Global visibility cycling or move to previous table field. -Calls `org-cycle' with argument t, or `org-table-previous-field', depending -on context. -See the individual commands for more information." +Call `org-table-previous-field' within a table. +When ARG is nil, cycle globally through visibility states. +When ARG is a numeric prefix, show contents of this level." (interactive "P") (cond ((org-at-table-p) (call-interactively 'org-table-previous-field)) @@ -18601,6 +19688,7 @@ See the individual commands for more information." (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) (message "Content view to level: %d" arg) (org-content (prefix-numeric-value arg2)) + (org-cycle-show-empty-lines t) (setq org-cycle-global-status 'overview))) (t (call-interactively 'org-global-cycle)))) @@ -18649,7 +19737,7 @@ See the individual commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-up)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-up))) - (t (org-modifier-cursor-error)))) + (t (call-interactively 'org-drag-line-backward)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. @@ -18664,10 +19752,10 @@ See the individual commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-down)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-down))) - (t (org-modifier-cursor-error)))) + (t (call-interactively 'org-drag-line-forward)))) (defsubst org-hidden-tree-error () - (error + (user-error "Hidden subtree, open with TAB or use subtree command M-S-/")) (defun org-metaleft (&optional arg) @@ -18757,18 +19845,6 @@ this function returns t, nil otherwise." (throw 'exit t)))) nil)))) -(org-autoload "org-element" '(org-element-at-point org-element-type)) - -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion)) -(declare-function org-element-nested-p "org-element" (elem-a elem-b)) -(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) -(declare-function org-element--parse-objects "org-element" (beg end acc restriction)) -(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) - (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -18959,23 +20035,23 @@ Depending on context, this does one of the following: (org-call-for-shift-select 'backward-word)) (t (org-shiftselect-error)))) -(defun org-shiftcontrolup () - "Change timestamps synchronously up in CLOCK log lines." - (interactive) - (cond ((and (not org-support-shift-select) - (org-at-clock-log-p) - (org-at-timestamp-p t)) - (org-clock-timestamps-up)) - (t (org-shiftselect-error)))) +(defun org-shiftcontrolup (&optional n) + "Change timestamps synchronously up in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") + (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (let (org-support-shift-select) + (org-clock-timestamps-up n)) + (user-error "Not at a clock log"))) -(defun org-shiftcontroldown () - "Change timestamps synchronously down in CLOCK log lines." - (interactive) - (cond ((and (not org-support-shift-select) - (org-at-clock-log-p) - (org-at-timestamp-p t)) - (org-clock-timestamps-down)) - (t (org-shiftselect-error)))) +(defun org-shiftcontroldown (&optional n) + "Change timestamps synchronously down in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") + (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (let (org-support-shift-select) + (org-clock-timestamps-down n)) + (user-error "Not at a clock log"))) (defun org-ctrl-c-ret () "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." @@ -19040,38 +20116,51 @@ See the individual commands for more information." (eq 'fixed-width (org-element-type (org-element-at-point))))) (defun org-edit-special (&optional arg) - "Call a special editor for the stuff at point. + "Call a special editor for the element at point. When at a table, call the formula editor with `org-table-edit-formulas'. When in a source code block, call `org-edit-src-code'. When in a fixed-width region, call `org-edit-fixed-width-region'. -When in an #+include line, visit the included file. +When at an #+INCLUDE keyword, visit the included file. On a link, call `ffap' to visit the link at point. Otherwise, return a user error." - (interactive) - ;; possibly prep session before editing source - (when (and (org-in-src-block-p) arg) - (let* ((info (org-babel-get-src-block-info)) - (lang (nth 0 info)) - (params (nth 2 info)) - (session (cdr (assoc :session params)))) - (when (and info session) ;; we are in a source-code block with a session - (funcall - (intern (concat "org-babel-prep-session:" lang)) session params)))) - (cond ;; proceed with `org-edit-special' - ((save-excursion - (beginning-of-line 1) - (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*.*?file=\"\\)\\([^\"\n>]+\\)")) - (find-file (org-trim (match-string 1)))) - ((org-at-table.el-p) (org-edit-src-code)) - ((or (org-at-table-p) - (save-excursion - (beginning-of-line 1) - (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:")))) - (call-interactively 'org-table-edit-formulas)) - ((org-in-block-p '("src" "example" "latex" "html")) (org-edit-src-code)) - ((org-in-fixed-width-region-p) (org-edit-fixed-width-region)) - ((org-at-regexp-p org-any-link-re) (call-interactively 'ffap)) - (t (user-error "No special environment to edit here")))) + (interactive "P") + (let ((element (org-element-at-point))) + (assert (not buffer-read-only) nil + "Buffer is read-only: %s" (buffer-name)) + (case (org-element-type element) + (src-block + (if (not arg) (org-edit-src-code) + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assq :session params)))) + (if (not session) (org-edit-src-code) + ;; At a src-block with a session and function called with + ;; an ARG: switch to the buffer related to the inferior + ;; process. + (switch-to-buffer + (funcall (intern (concat "org-babel-prep-session:" lang)) + session params)))))) + (keyword + (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) + (find-file + (org-remove-double-quotes + (car (org-split-string (org-element-property :value element))))) + (user-error "No special environment to edit here"))) + (table + (if (eq (org-element-property :type element) 'table.el) + (org-edit-src-code) + (call-interactively 'org-table-edit-formulas))) + ;; Only Org tables contain `table-row' type elements. + (table-row (call-interactively 'org-table-edit-formulas)) + ((example-block export-block) (org-edit-src-code)) + (fixed-width (org-edit-fixed-width-region)) + (otherwise + ;; No notable element at point. Though, we may be at a link, + ;; which is an object. Thus, scan deeper. + (if (eq (org-element-type (org-element-context element)) 'link) + (call-interactively 'ffap) + (user-error "No special environment to edit here")))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el (defun org-ctrl-c-ctrl-c (&optional arg) @@ -19119,136 +20208,168 @@ This command does many different things, depending on context: evaluation requires confirmation. Code block evaluation can be inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") - (let ((org-enable-table-editor t)) - (cond - ((or (and (boundp 'org-clock-overlays) org-clock-overlays) - org-occur-highlights - org-latex-fragment-image-overlays) - (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) - ((org-in-regexp org-ts-regexp-both) - (org-timestamp-change 0 'day)) - ((or (looking-at org-property-start-re) - (org-at-property-p)) - (call-interactively 'org-property-action)) - ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp)) - ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") - (or (org-at-heading-p) (org-at-item-p))) - (call-interactively 'org-update-statistics-cookies)) - ((org-at-heading-p) (call-interactively 'org-set-tags)) - ((org-at-table.el-p) - (message "Use C-c ' to edit table.el tables")) - ((org-at-table-p) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) - ((or (org-footnote-at-reference-p) - (org-footnote-at-definition-p)) - (call-interactively 'org-footnote-action)) - ((org-at-item-checkbox-p) - ;; Cursor at a checkbox: repair list and update checkboxes. Send - ;; list only if at top item. - (let* ((cbox (match-string 1)) - (struct (org-list-struct)) - (old-struct (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (orderedp (org-entry-get nil "ORDERED")) - (firstp (= (org-list-get-top-point struct) (point-at-bol))) - block-item) - ;; Use a light version of `org-toggle-checkbox' to avoid - ;; computing list structure twice. - (let ((new-box (cond - ((equal arg '(16)) "[-]") - ((equal arg '(4)) nil) - ((equal "[X]" cbox) "[ ]") - (t "[X]")))) - (if (and firstp arg) - ;; If at first item of sub-list, remove check-box from - ;; every item at the same level. - (mapc - (lambda (pos) (org-list-set-checkbox pos struct new-box)) - (org-list-get-all-items - (point-at-bol) struct (org-list-prevs-alist struct))) - (org-list-set-checkbox (point-at-bol) struct new-box))) - ;; Replicate `org-list-write-struct', while grabbing a return - ;; value from `org-list-struct-fix-box'. - (org-list-struct-fix-ind struct parents 2) - (org-list-struct-fix-item-end struct) - (let ((prevs (org-list-prevs-alist struct))) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (setq block-item - (org-list-struct-fix-box struct parents prevs orderedp))) - (if (equal struct old-struct) - (user-error "Cannot toggle this checkbox (unchecked subitems?)") - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe)) - (when block-item - (message - "Checkboxes were removed due to unchecked box at line %d" - (org-current-line block-item))) - (when firstp (org-list-send-list 'maybe)))) - ((org-at-item-p) - ;; Cursor at an item: repair list. Do checkbox related actions - ;; only if function was called with an argument. Send list only - ;; if at top item. - (let* ((struct (org-list-struct)) - (firstp (= (org-list-get-top-point struct) (point-at-bol))) - old-struct) - (when arg - (setq old-struct (copy-tree struct)) - (if firstp - ;; If at first item of sub-list, add check-box to every - ;; item at the same level. - (mapc - (lambda (pos) - (unless (org-list-get-checkbox pos struct) - (org-list-set-checkbox pos struct "[ ]"))) - (org-list-get-all-items - (point-at-bol) struct (org-list-prevs-alist struct))) - (org-list-set-checkbox (point-at-bol) struct "[ ]"))) - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - (when arg (org-update-checkbox-count-maybe)) - (when firstp (org-list-send-list 'maybe)))) - ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) - ;; Dynamic block - (beginning-of-line 1) - (save-excursion (org-update-dblock))) - ((save-excursion - (let ((case-fold-search t)) - (beginning-of-line 1) - (looking-at "[ \t]*#\\+\\([a-z]+\\)"))) - (cond - ((or (equal (match-string 1) "TBLFM") - (equal (match-string 1) "tblfm")) - ;; Recalculate the table before this line - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate (or arg t))))) - (t - (let ((org-inhibit-startup-visibility-stuff t) - (org-startup-align-all-tables nil)) - (when (boundp 'org-table-coordinate-overlays) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil)) - (org-save-outline-visibility 'use-markers (org-mode-restart))) - (message "Local setup has been refreshed")))) - ((org-clock-update-time-maybe)) - (t - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (error "C-c C-c can do nothing useful at this location")))))) + (cond + ((or (and (boundp 'org-clock-overlays) org-clock-overlays) + org-occur-highlights + org-latex-fragment-image-overlays) + (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) + (org-remove-occur-highlights) + (org-remove-latex-fragment-image-overlays) + (message "Temporary highlights/overlays removed from current buffer")) + ((and (local-variable-p 'org-finish-function (current-buffer)) + (fboundp org-finish-function)) + (funcall org-finish-function)) + ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) + (t + (let* ((context (org-element-context)) (type (org-element-type context))) + ;; Test if point is within a blank line. + (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error "C-c C-c can do nothing useful at this location")) + (case type + ;; When at a link, act according to the parent instead. + (link (setq context (org-element-property :parent context)) + (setq type (org-element-type context))) + ;; Unsupported object types: check parent element instead. + ((bold code entity export-snippet inline-babel-call inline-src-block + italic latex-fragment line-break macro strike-through subscript + superscript underline verbatim) + (while (and (setq context (org-element-property :parent context)) + (not (memq (setq type (org-element-type context)) + '(paragraph verse-block))))))) + ;; For convenience: at the first line of a paragraph on the + ;; same line as an item, apply function on that item instead. + (when (eq type 'paragraph) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'item) + (= (point-at-bol) (org-element-property :begin parent))) + (setq context parent type 'item)))) + ;; Act according to type of element or object at point. + (case type + (clock (org-clock-update-time-maybe)) + (dynamic-block + (save-excursion + (goto-char (org-element-property :post-affiliated context)) + (org-update-dblock))) + (footnote-definition + (goto-char (org-element-property :post-affiliated context)) + (call-interactively 'org-footnote-action)) + (footnote-reference (call-interactively 'org-footnote-action)) + ((headline inlinetask) + (save-excursion (goto-char (org-element-property :begin context)) + (call-interactively 'org-set-tags))) + (item + ;; At an item: a double C-u set checkbox to "[-]" + ;; unconditionally, whereas a single one will toggle its + ;; presence. Without an universal argument, if the item + ;; has a checkbox, toggle it. Otherwise repair the list. + (let* ((box (org-element-property :checkbox context)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) + (org-list-set-checkbox + (org-element-property :begin context) struct + (cond ((equal arg '(16)) "[-]") + ((and (not box) (equal arg '(4))) "[ ]") + ((or (not box) (equal arg '(4))) nil) + ((eq box 'on) "[ ]") + (t "[X]"))) + ;; Mimic `org-list-write-struct' but with grabbing + ;; a return value from `org-list-struct-fix-box'. + (org-list-struct-fix-ind struct parents 2) + (org-list-struct-fix-item-end struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (let ((block-item + (org-list-struct-fix-box struct parents prevs orderedp))) + (if (and box (equal struct old-struct)) + (if (equal arg '(16)) + (message "Checkboxes already reset") + (user-error "Cannot toggle this checkbox: %s" + (if (eq box 'on) + "all subitems checked" + "unchecked subitems"))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) + (when block-item + (message "Checkboxes were removed due to empty box at line %d" + (org-current-line block-item)))))) + (keyword + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (when (boundp 'org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) + (message "Local setup has been refreshed")) + (plain-list + ;; At a plain list, with a double C-u argument, set + ;; checkboxes of each item to "[-]", whereas a single one + ;; will toggle their presence according to the state of the + ;; first item in the list. Without an argument, repair the + ;; list. + (let* ((begin (org-element-property :contents-begin context)) + (beginm (move-marker (make-marker) begin)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (first-box (save-excursion + (goto-char begin) + (looking-at org-list-full-item-re) + (match-string-no-properties 3))) + (new-box (cond ((equal arg '(16)) "[-]") + ((equal arg '(4)) (unless first-box "[ ]")) + ((equal first-box "[X]") "[ ]") + (t "[X]")))) + (cond + (arg + (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) + (org-list-get-all-items + begin struct (org-list-prevs-alist struct)))) + ((and first-box (eq (point) begin)) + ;; For convenience, when point is at bol on the first + ;; item of the list and no argument is provided, simply + ;; toggle checkbox of that item, if any. + (org-list-set-checkbox begin struct new-box))) + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + (org-update-checkbox-count-maybe) + (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) + ((property-drawer node-property) + (call-interactively 'org-property-action)) + ((radio-target target) + (call-interactively 'org-update-radio-target-regexp)) + (statistics-cookie + (call-interactively 'org-update-statistics-cookies)) + ((table table-cell table-row) + ;; At a table, recalculate every field and align it. Also + ;; send the table if necessary. If the table has + ;; a `table.el' type, just give up. At a table row or + ;; cell, maybe recalculate line but always align table. + (if (eq (org-element-property :type context) 'table.el) + (message "Use C-c ' to edit table.el tables") + (let ((org-enable-table-editor t)) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) + (progn (require 'org-table) + (org-table-calc-current-TBLFM)) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively 'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align))))))) + (timestamp (org-timestamp-change 0 'day)) + (otherwise + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + "C-c C-c can do nothing useful at this location"))))))))) (defun org-mode-restart () "Restart Org-mode, to scan again for special lines. @@ -19267,6 +20388,18 @@ Also updates the keyword regular expressions." (let ((org-note-abort t)) (funcall org-finish-function)))) +(defun org-open-line (n) + "Insert a new row in tables, call `open-line' elsewhere. +If `org-special-ctrl-o' is nil, just call `open-line' everywhere." + (interactive "*p") + (cond + ((not org-special-ctrl-o) + (open-line n)) + ((org-at-table-p) + (org-table-insert-row)) + (t + (open-line n)))) + (defun org-return (&optional indent) "Goto next table row or insert a newline. Calls `org-table-next-row' or `newline', depending on context. @@ -19347,13 +20480,13 @@ Calls `org-table-insert-hline', `org-toggle-item', or "Convert headings or normal lines to items, items to normal lines. If there is no active region, only the current line is considered. -If the first non blank line in the region is an headline, convert +If the first non blank line in the region is a headline, convert all headlines to items, shifting text accordingly. If it is an item, convert all items to normal lines. -If it is normal text, change region into an item. With a prefix -argument ARG, change each line in region into an item." +If it is normal text, change region into a list of items. +With a prefix argument ARG, change the region in a single item." (interactive "P") (let ((shift-text (function @@ -19446,19 +20579,10 @@ argument ARG, change each line in region into an item." (funcall shift-text (+ start-ind (* (1+ delta) bul-len)) (min end section-end))))))) - ;; Case 3. Normal line with ARG: turn each non-item line into - ;; an item. - (arg - (while (< (point) end) - (unless (or (org-at-heading-p) (org-at-item-p)) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (forward-line))) - ;; Case 4. Normal line without ARG: make the first line of - ;; region an item, and shift indentation of others - ;; lines to set them as item's body. - (t (let* ((bul (org-list-bullet-string "-")) + ;; Case 3. Normal line with ARG: make the first line of region + ;; an item, and shift indentation of others lines to + ;; set them as item's body. + (arg (let* ((bul (org-list-bullet-string "-")) (bul-len (length bul)) (ref-ind (org-get-indentation))) (skip-chars-forward " \t") @@ -19471,29 +20595,40 @@ argument ARG, change each line in region into an item." (+ ref-ind bul-len) (min end (save-excursion (or (outline-next-heading) (point))))) - (forward-line))))))))) + (forward-line)))) + ;; Case 4. Normal line without ARG: turn each non-item line + ;; into an item. + (t + (while (< (point) end) + (unless (or (org-at-heading-p) (org-at-item-p)) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line)))))))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. -If there is no active region, only the current line is considered. +If there is no active region, only convert the current line. With a \\[universal-argument] prefix, convert the whole list at point into heading. In a region: -- If the first non blank line is an headline, remove the stars +- If the first non blank line is a headline, remove the stars from all headlines in the region. -- If it is a normal line turn each and every normal line (i.e. not an - heading or an item) in the region into a heading. +- If it is a normal line, turn each and every normal line (i.e., + not an heading or an item) in the region into headings. If you + want to convert only the first line of this region, use one + universal prefix argument. - If it is a plain list item, turn all plain list items into headings. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, -when a prefix argument is given, its value determines the number of -stars to add." +when a numeric prefix argument is given, its value determines the +number of stars to add." (interactive "P") (let ((skip-blanks (function @@ -19511,7 +20646,7 @@ stars to add." ;; do not consider the last line to be in the region. (when (and current-prefix-arg (org-at-item-p)) - (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1)) + (if (listp current-prefix-arg) (setq current-prefix-arg 1)) (org-mark-element)) (if (org-region-active-p) @@ -19537,10 +20672,9 @@ stars to add." ;; One star will be added by `org-list-to-subtree'. ((org-at-item-p) (let* ((stars (make-string - (if nstars - ;; subtract the star that will be added again by - ;; `org-list-to-subtree' - (1- (prefix-numeric-value current-prefix-arg)) + ;; subtract the star that will be added again by + ;; `org-list-to-subtree' + (if (numberp nstars) (1- nstars) (or (org-current-level) 0)) ?*)) (add-stars @@ -19564,18 +20698,17 @@ stars to add." (forward-line)))) ;; Case 3. Started at normal text: make every line an heading, ;; skipping headlines and items. - (t (let* ((stars (make-string - (if nstars - (prefix-numeric-value current-prefix-arg) - (or (org-current-level) 0)) - ?*)) + (t (let* ((stars + (make-string + (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) (add-stars (cond (nstars "") ; stars from prefix only ((equal stars "") "*") ; before first heading (org-odd-levels-only "**") ; inside heading, odd (t "*"))) ; inside heading, oddeven - (rpl (concat stars add-stars " "))) - (while (< (point) end) + (rpl (concat stars add-stars " ")) + (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) + (while (< (point) (if (equal nstars '(4)) lend end)) (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) (replace-match (concat rpl (match-string 2))) (setq toggled t)) @@ -19584,16 +20717,22 @@ stars to add." (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending on context. -See the individual commands for more information." +Calls `org-insert-heading' or `org-table-wrap-region', depending +on context. See the individual commands for more information." (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-metareturn-hook)) - ((or (org-at-drawer-p) (org-at-property-p)) - (newline-and-indent)) - ((org-at-table-p) - (call-interactively 'org-table-wrap-region)) - (t (call-interactively 'org-insert-heading)))) + (org-check-before-invisible-edit 'insert) + (or (run-hook-with-args-until-success 'org-metareturn-hook) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (when (eq type 'table-row) + (setq element (org-element-property :parent element)) + (setq type 'table)) + (if (and (eq type 'table) + (eq (org-element-property :type element) 'org) + (>= (point) (org-element-property :contents-begin element)) + (< (point) (org-element-property :contents-end element))) + (call-interactively 'org-table-wrap-region) + (call-interactively 'org-insert-heading))))) ;;; Menu entries @@ -19826,7 +20965,7 @@ See the individual commands for more information." ["Timeline" org-timeline t] ["Tags/Property tree" org-match-sparse-tree t]) "--" - ["Export/Publish..." org-export t] + ["Export/Publish..." org-export-dispatch t] ("LaTeX" ["Org CDLaTeX mode" org-cdlatex-mode :style toggle :selected org-cdlatex-mode] @@ -19836,8 +20975,7 @@ See the individual commands for more information." (org-inside-LaTeX-fragment-p)] ["Insert citation" org-reftex-citation t] "--" - ["Template for BEAMER" (progn (require 'org-beamer) - (org-insert-beamer-options-template)) t]) + ["Template for BEAMER" (org-beamer-insert-options-template) t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -19952,55 +21090,63 @@ Your bug report will be posted to the Org-mode mailing list. (defun org-require-autoloaded-modules () (interactive) (mapc 'require - '(org-agenda org-archive org-ascii org-attach org-clock org-colview - org-docbook org-exp org-html org-icalendar - org-id org-latex - org-publish org-remember org-table - org-timer org-xoxo))) + '(org-agenda org-archive org-attach org-clock org-colview org-id + org-table org-timer))) ;;;###autoload (defun org-reload (&optional uncompiled) "Reload all org lisp files. With prefix arg UNCOMPILED, load the uncompiled versions." (interactive "P") - (require 'find-func) - (let* ((file-re "^org\\(-.*\\)?\\.el") - (dir-org (file-name-directory (org-find-library-dir "org"))) - (dir-org-contrib (ignore-errors - (file-name-directory - (org-find-library-dir "org-contribdir")))) - (babel-files - (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el")) - (append (list nil "comint" "eval" "exp" "keys" - "lob" "ref" "table" "tangle") - (delq nil - (mapcar - (lambda (lang) - (when (cdr lang) (symbol-name (car lang)))) - org-babel-load-languages))))) - (files - (append babel-files - (and dir-org-contrib - (directory-files dir-org-contrib t file-re)) - (directory-files dir-org t file-re))) - (remove-re (concat (if (featurep 'xemacs) - "org-colview" "org-colview-xemacs") - "\\'"))) - (setq files (mapcar 'file-name-sans-extension files)) - (setq files (mapcar - (lambda (x) (if (string-match remove-re x) nil x)) - files)) - (setq files (delq nil files)) - (mapc - (lambda (f) - (when (featurep (intern (file-name-nondirectory f))) - (if (and (not uncompiled) - (file-exists-p (concat f ".elc"))) - (load (concat f ".elc") nil nil 'nosuffix) - (load (concat f ".el") nil nil 'nosuffix)))) - files) - (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix)) - (org-version nil 'full 'message)) + (require 'loadhist) + (let* ((org-dir (org-find-library-dir "org")) + (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) + (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") + (remove-re (mapconcat 'identity + (mapcar (lambda (f) (concat "^" f "$")) + (list (if (featurep 'xemacs) + "org-colview" + "org-colview-xemacs") + "org" "org-loaddefs" "org-version")) + "\\|")) + (feats (delete-dups + (mapcar 'file-name-sans-extension + (mapcar 'file-name-nondirectory + (delq nil + (mapcar 'feature-file + features)))))) + (lfeat (append + (sort + (setq feats + (delq nil (mapcar + (lambda (f) + (if (and (string-match feature-re f) + (not (string-match remove-re f))) + f nil)) + feats))) + 'string-lessp) + (list "org-version" "org"))) + (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) + load-uncore load-misses) + (setq load-misses + (delq 't + (mapcar (lambda (f) + (or (org-load-noerror-mustsuffix (concat org-dir f)) + (and (string= org-dir contrib-dir) + (org-load-noerror-mustsuffix (concat contrib-dir f))) + (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) + (add-to-list 'load-uncore f 'append) + 't) + f)) + lfeat))) + (if load-uncore + (message "The following feature%s found in load-path, please check if that's correct:\n%s" + (if (> (length load-uncore) 1) "s were" " was") load-uncore)) + (if load-misses + (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" + (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) + (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) ;;;###autoload (defun org-customize () @@ -20088,7 +21234,10 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (defun org-in-verbatim-emphasis () (save-match-data - (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) + (and (org-in-regexp org-emph-re 2) + (>= (point) (match-beginning 3)) + (<= (point) (match-end 4)) + (member (match-string 3) '("=" "~"))))) (defun org-goto-marker-or-bmk (marker &optional bookmark) "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." @@ -20543,6 +21692,17 @@ block from point." names)) nil))) +(defun org-in-drawer-p () + "Is point within a drawer?" + (save-match-data + (let ((case-fold-search t) + (lim-up (save-excursion (outline-previous-heading))) + (lim-down (save-excursion (outline-next-heading)))) + (org-between-regexps-p + (concat "^[ \t]*:" (regexp-opt org-drawers) ":") + "^[ \t]*:end:.*$" + lim-up lim-down)))) + (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." (interactive "sOrg-files matching: \np") @@ -20598,11 +21758,36 @@ for the search purpose." (error "Unable to create a link to here")))) (org-occur-in-agenda-files (regexp-quote link)))) -(defun org-uniquify (list) - "Remove duplicate elements from LIST." - (let (res) - (mapc (lambda (x) (add-to-list 'res x 'append)) list) - res)) +(defun org-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + +(defun org-uniquify-alist (alist) + "Merge elements of ALIST with the same key. + +For example, in this alist: + +\(org-uniquify-alist '((a 1) (b 2) (a 3))) + => '((a 1 3) (b 2)) + +merge (a 1) and (a 3) into (a 1 3). + +The function returns the new ALIST." + (let (rtn) + (mapc + (lambda (e) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))) + alist) + rtn)) (defun org-delete-all (elts list) "Remove all elements in ELTS from LIST." @@ -20649,6 +21834,20 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) cl-accum)) +(defun org-every (pred seq) + "Return true if PREDICATE is true of every element of SEQ. +Adapted from `every' in cl.el." + (catch 'org-every + (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) + t)) + +(defun org-some (pred seq) + "Return true if PREDICATE is true of any element of SEQ. +Adapted from `some' in cl.el." + (catch 'org-some + (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) + nil)) + (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." @@ -20764,21 +21963,31 @@ If EXTENSIONS is given, only match these." (save-match-data (string-match (org-image-file-name-regexp extensions) file))) -(defun org-get-cursor-date () +(defun org-get-cursor-date (&optional with-time) "Return the date at cursor in as a time. This works in the calendar and in the agenda, anywhere else it just -returns the current time." - (let (date day defd) +returns the current time. +If WITH-TIME is non-nil, returns the time of the event at point (in +the agenda) or the current time of the day." + (let (date day defd tp tm hod mod) + (when with-time + (setq tp (get-text-property (point) 'time)) + (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) + (setq hod (string-to-number (match-string 1 tp)) + mod (string-to-number (match-string 2 tp)))) + (or tp (setq hod (nth 2 (decode-time (current-time))) + mod (nth 1 (decode-time (current-time)))))) (cond ((eq major-mode 'calendar-mode) (setq date (calendar-cursor-to-date) - defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))) ((eq major-mode 'org-agenda-mode) (setq day (get-text-property (point) 'day)) (if day (setq date (calendar-gregorian-from-absolute day) - defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))))) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))))) (or defd (current-time)))) (defun org-mark-subtree (&optional up) @@ -20789,13 +21998,14 @@ hierarchy of headlines by UP levels before marking the subtree." (interactive "P") (org-with-limited-levels (cond ((org-at-heading-p) (beginning-of-line)) - ((org-before-first-heading-p) (error "Not in a subtree")) + ((org-before-first-heading-p) (user-error "Not in a subtree")) (t (outline-previous-visible-heading 1)))) (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) (if (org-called-interactively-p 'any) (call-interactively 'org-mark-element) (org-mark-element))) + ;;; Indentation (defun org-indent-line () @@ -20817,8 +22027,6 @@ hierarchy of headlines by UP levels before marking the subtree." (cond ;; Headings ((looking-at org-outline-regexp) (setq column 0)) - ;; Included files - ((looking-at "#\\+include:") (setq column 0)) ;; Footnote definition ((looking-at org-footnote-definition-re) (setq column 0)) ;; Literal examples @@ -20874,15 +22082,16 @@ hierarchy of headlines by UP levels before marking the subtree." (re-search-backward "[ \t]*#\\+begin_"nil t)) (looking-at "[ \t]*[\n:#|]") (looking-at org-footnote-definition-re) - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct)))) (and (not inline-task-p) (featurep 'org-inlinetask) (org-inlinetask-in-task-p) (or (org-inlinetask-goto-beginning) t)))) (beginning-of-line 0)) (cond + ;; There was a list item above. + ((ignore-errors (goto-char (org-in-item-p))) + (goto-char (org-list-get-top-point (org-list-struct))) + (setq column (org-get-indentation))) ;; There was an heading above. ((looking-at "\\*+[ \t]+") (if (not org-adapt-indentation) @@ -20903,11 +22112,10 @@ hierarchy of headlines by UP levels before marking the subtree." ;; Special polishing for properties, see `org-property-format' (setq column (current-column)) (beginning-of-line 1) - (if (looking-at - "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat (match-string 1) + (if (looking-at org-property-re) + (replace-match (concat (match-string 4) (format org-property-format - (match-string 2) (match-string 3))) + (match-string 1) (match-string 3))) t t)) (org-move-to-column column)))) @@ -20959,7 +22167,7 @@ hierarchy of headlines by UP levels before marking the subtree." (let ((line-end (org-current-line end))) (goto-char start) (while (< (org-current-line) line-end) - (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe)) + (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe)) (t (call-interactively 'org-indent-line))) (move-beginning-of-line 2))))) @@ -20980,102 +22188,115 @@ hierarchy of headlines by UP levels before marking the subtree." ;; `org-setup-filling' installs filling and auto-filling related ;; variables during `org-mode' initialization. +(defvar org-element-paragraph-separate) ; org-element.el (defun org-setup-filling () - (interactive) + (require 'org-element) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) (org-set-local 'fill-nobreak-predicate (org-uniquify (append fill-nobreak-predicate - '(org-fill-paragraph-separate-nobreak-p - org-fill-line-break-nobreak-p + '(org-fill-line-break-nobreak-p org-fill-paragraph-with-timestamp-nobreak-p))))) + (let ((paragraph-ending (substring org-element-paragraph-separate 1))) + (org-set-local 'paragraph-start paragraph-ending) + (org-set-local 'paragraph-separate paragraph-ending)) (org-set-local 'fill-paragraph-function 'org-fill-paragraph) (org-set-local 'auto-fill-inhibit-regexp nil) (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) -(defvar org-element-paragraph-separate) ; org-element.el -(defun org-fill-paragraph-separate-nobreak-p () - "Non-nil when a line break at point would insert a new item." - (looking-at (substring org-element-paragraph-separate 1))) - (defun org-fill-line-break-nobreak-p () - "Non-nil when a line break at point would create an Org line break." + "Non-nil when a new line at point would create an Org line break." (save-excursion (skip-chars-backward "[ \t]") (skip-chars-backward "\\\\") (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) (defun org-fill-paragraph-with-timestamp-nobreak-p () - "Non-nil when a line break at point would insert a new item." + "Non-nil when a new line at point would split a timestamp." (and (org-at-timestamp-p t) (not (looking-at org-ts-regexp-both)))) (declare-function message-in-body-p "message" ()) -(defvar org-element--affiliated-re) ; From org-element.el (defvar orgtbl-line-start-regexp) ; From org-table.el (defun org-adaptive-fill-function () "Compute a fill prefix for the current line. Return fill prefix, as a string, or nil if current line isn't -meant to be filled." - (let (prefix) - (catch 'exit - (when (derived-mode-p 'message-mode) - (save-excursion - (beginning-of-line) - (cond ((or (not (message-in-body-p)) - (looking-at orgtbl-line-start-regexp)) - (throw 'exit nil)) - ((looking-at message-cite-prefix-regexp) - (throw 'exit (match-string-no-properties 0))) - ((looking-at org-outline-regexp) - (throw 'exit (make-string (length (match-string 0)) ? )))))) - (org-with-wide-buffer - (let* ((p (line-beginning-position)) - (element (save-excursion (beginning-of-line) (org-element-at-point))) - (type (org-element-type element)) - (post-affiliated - (save-excursion - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) (forward-line)) - (point)))) - (unless (< p post-affiliated) - (case type - (comment (looking-at "[ \t]*# ?") (match-string 0)) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column post-affiliated) ? )) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; except if the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) +meant to be filled. For convenience, if `adaptive-fill-regexp' +matches in paragraphs or comments, use it." + (catch 'exit + (when (derived-mode-p 'message-mode) + (save-excursion + (beginning-of-line) + (cond ((or (not (message-in-body-p)) + (looking-at orgtbl-line-start-regexp)) + (throw 'exit nil)) + ((looking-at message-cite-prefix-regexp) + (throw 'exit (match-string-no-properties 0))) + ((looking-at org-outline-regexp) + (throw 'exit (make-string (length (match-string 0)) ? )))))) + (org-with-wide-buffer + (let* ((p (line-beginning-position)) + (element (save-excursion + (beginning-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point)))))) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (and post-affiliated (< p post-affiliated)) + (case type + (comment + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*") + (concat (match-string 0) "# "))) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column + (or post-affiliated + (org-element-property :begin element))) + ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; unless the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (save-excursion + (beginning-of-line) (cond ((eq (org-element-type parent) 'item) (make-string (org-list-item-body-column (org-element-property :begin parent)) ? )) - ((save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0)) - (t "")))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - ""))))))))))) + ((and adaptive-fill-regexp + ;; Locally disable + ;; `adaptive-fill-function' to let + ;; `fill-context-prefix' handle + ;; `adaptive-fill-regexp' variable. + (let (adaptive-fill-function) + (fill-context-prefix + post-affiliated + (org-element-property :end element))))) + ((looking-at "[ \t]+") (match-string 0)) + (t ""))))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el -(defvar org-element-all-objects) ; From org-element.el (defun org-fill-paragraph (&optional justify) "Fill element at point, when applicable. @@ -21104,94 +22325,120 @@ a footnote definition, try to fill the first paragraph within." (paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars)))) (fill-paragraph nil)) - (save-excursion + (with-syntax-table org-mode-transpose-word-syntax-table ;; Move to end of line in order to get the first paragraph ;; within a plain list or a footnote definition. - (end-of-line) - (let ((element (org-element-at-point))) + (let ((element (save-excursion + (end-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point))))))) ;; First check if point is in a blank line at the beginning of ;; the buffer. In that case, ignore filling. - (if (< (point) (org-element-property :begin element)) t - (case (org-element-type element) - ;; Use major mode filling function is src blocks. - (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) - (org-table-align)) - t) - (paragraph - ;; Paragraphs may contain `line-break' type objects. - (let ((beg (max (point-min) - (org-element-property :contents-begin element))) - (end (min (point-max) - (org-element-property :contents-end element)))) - ;; Do nothing if point is at an affiliated keyword. - (if (< (point) beg) t - (when (derived-mode-p 'message-mode) - ;; In `message-mode', do not fill following - ;; citation in current paragraph nor text before - ;; message body. - (let ((body-start (save-excursion (message-goto-body)))) - (when body-start (setq beg (max body-start beg)))) - (when (save-excursion - (re-search-forward - (concat "^" message-cite-prefix-regexp) end t)) - (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into - ;; consideration. For that, slice the paragraph - ;; using line breaks as separators, and fill the - ;; parts in reverse order to avoid messing with - ;; markers. - (save-excursion - (goto-char end) - (mapc - (lambda (pos) - (fill-region-as-paragraph pos (point) justify) - (goto-char pos)) - ;; Find the list of ending positions for line - ;; breaks in the current paragraph. Add paragraph - ;; beginning to include first slice. - (nreverse - (cons - beg - (org-element-map - (org-element--parse-objects - beg end nil org-element-all-objects) - 'line-break - (lambda (lb) (org-element-property :end lb))))))) - t))) - ;; Contents of `comment-block' type elements should be - ;; filled as plain text, but only if point is within block - ;; markers. - (comment-block - (let* ((case-fold-search t) - (beg (save-excursion - (goto-char (org-element-property :begin element)) - (re-search-forward "^[ \t]*#\\+begin_comment" nil t) - (forward-line) - (point))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (re-search-backward "^[ \t]*#\\+end_comment" nil t) - (line-beginning-position)))) - (when (and (>= (point) beg) (< (point) end)) - (fill-region-as-paragraph - (save-excursion - (end-of-line) - (re-search-backward "^[ \t]*$" beg 'move) - (line-beginning-position)) - (save-excursion - (beginning-of-line) - (re-search-forward "^[ \t]*$" end 'move) - (line-beginning-position)) - justify))) - t) - ;; Fill comments. - (comment (fill-comment-paragraph justify)) - ;; Ignore every other element. - (otherwise t))))))) + (case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (org-table-align))) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (line-end-position) beg) t + (when (derived-mode-p 'message-mode) + ;; In `message-mode', do not fill following citation + ;; in current paragraph nor text before message body. + (let ((body-start (save-excursion (message-goto-body)))) + (when body-start (setq beg (max body-start beg)))) + (when (save-excursion + (re-search-forward + (concat "^" message-cite-prefix-regexp) end t)) + (setq end (match-beginning 0)))) + ;; Fill paragraph, taking line breaks into account. + ;; For that, slice the paragraph using line breaks as + ;; separators, and fill the parts in reverse order to + ;; avoid messing with markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line breaks + ;; in the current paragraph. Add paragraph + ;; beginning to include first slice. + (nreverse + (cons beg + (org-element-map + (org-element--parse-objects + beg end nil (org-element-restriction 'paragraph)) + 'line-break + (lambda (lb) (org-element-property :end lb))))))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (if (or (< (point) beg) (> (point) end)) t + (fill-region-as-paragraph + (save-excursion (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify)))) + ;; Fill comments. + (comment + (let ((begin (org-element-property :post-affiliated element)) + (end (org-element-property :end element))) + (when (and (>= (point) begin) (<= (point) end)) + (let ((begin (save-excursion + (end-of-line) + (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) + (progn (forward-line) (point)) + begin))) + (end (save-excursion + (end-of-line) + (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) + (1- (line-beginning-position)) + (skip-chars-backward " \r\t\n") + (line-end-position))))) + ;; Do not fill comments when at a blank line. + (when (> end begin) + (let ((fill-prefix + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#") + (let ((comment-prefix (match-string 0))) + (goto-char (match-end 0)) + (if (looking-at adaptive-fill-regexp) + (concat comment-prefix (match-string 0)) + (concat comment-prefix " ")))))) + (save-excursion + (fill-region-as-paragraph begin end justify)))))) + t)) + ;; Ignore every other element. + (otherwise t)))))) (defun org-auto-fill-function () "Auto-fill function." @@ -21298,11 +22545,102 @@ contains commented lines. Otherwise, comment them." (goto-char (point-min)) (while (not (eobp)) (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - (org-move-to-column min-indent t) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) (insert comment-start)) (forward-line)))))))) +;;; Planning + +;; This section contains tools to operate on timestamp objects, as +;; returned by, e.g. `org-element-context'. + +(defun org-timestamp-has-time-p (timestamp) + "Non-nil when TIMESTAMP has a time specified." + (org-element-property :hour-start timestamp)) + +(defun org-timestamp-format (timestamp format &optional end utc) + "Format a TIMESTAMP element into a string. + +FORMAT is a format specifier to be passed to +`format-time-string'. + +When optional argument END is non-nil, use end of date-range or +time-range, if possible. + +When optional argument UTC is non-nil, time will be expressed as +Universal Time." + (format-time-string + format + (apply 'encode-time + (cons 0 + (mapcar + (lambda (prop) (or (org-element-property prop timestamp) 0)) + (if end '(:minute-end :hour-end :day-end :month-end :year-end) + '(:minute-start :hour-start :day-start :month-start + :year-start))))) + utc)) + +(defun org-timestamp-split-range (timestamp &optional end) + "Extract a timestamp object from a date or time range. + +TIMESTAMP is a timestamp object. END, when non-nil, means extract +the end of the range. Otherwise, extract its start. + +Return a new timestamp object sharing the same parent as +TIMESTAMP." + (let ((type (org-element-property :type timestamp))) + (if (memq type '(active inactive diary)) timestamp + (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp))))) + ;; Set new type. + (org-element-put-property + split-ts :type (if (eq type 'active-range) 'active 'inactive)) + ;; Copy start properties over end properties if END is + ;; non-nil. Otherwise, copy end properties over `start' ones. + (let ((p-alist '((:minute-start . :minute-end) + (:hour-start . :hour-end) + (:day-start . :day-end) + (:month-start . :month-end) + (:year-start . :year-end)))) + (dolist (p-cell p-alist) + (org-element-put-property + split-ts + (funcall (if end 'car 'cdr) p-cell) + (org-element-property + (funcall (if end 'cdr 'car) p-cell) split-ts))) + ;; Eventually refresh `:raw-value'. + (org-element-put-property split-ts :raw-value nil) + (org-element-put-property + split-ts :raw-value (org-element-interpret-data split-ts))))))) + +(defun org-timestamp-translate (timestamp &optional boundary) + "Apply `org-translate-time' on a TIMESTAMP object. +When optional argument BOUNDARY is non-nil, it is either the +symbol `start' or `end'. In this case, only translate the +starting or ending part of TIMESTAMP if it is a date or time +range. Otherwise, translate both parts." + (if (and (not boundary) + (memq (org-element-property :type timestamp) + '(active-range inactive-range))) + (concat + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp))) + "--" + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp t)))) + (org-translate-time + (org-element-property + :raw-value + (if (not boundary) timestamp + (org-timestamp-split-range timestamp (eq boundary 'end))))))) + + + ;;; Other stuff. (defun org-toggle-fixed-width-section (arg) @@ -21365,7 +22703,7 @@ to work in this buffer and calls `reftex-citation' to insert a citation into the buffer. Export of such citations to both LaTeX and HTML is handled by the contributed -package org-exp-bibtex by Taru Karttunen." +package ox-bibtex by Taru Karttunen." (interactive) (let ((reftex-docstruct-symbol 'rds) (reftex-cite-format "\\cite{%l}") @@ -21396,7 +22734,7 @@ beyond the end of the headline." (special (if (consp org-special-ctrl-a/e) (car org-special-ctrl-a/e) org-special-ctrl-a/e)) - refpos) + deactivate-mark refpos) (if (org-bound-and-true-p visual-line-mode) (beginning-of-visual-line 1) (beginning-of-line 1)) @@ -21448,7 +22786,10 @@ beyond the end of the headline." (when (and (= (point) pos) (eq last-command this-command)) (goto-char after-bullet)))))))) (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t))))) + (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) (defun org-end-of-line (&optional arg) "Go to the end of the line. @@ -21461,7 +22802,8 @@ the cursor is already beyond the end of the headline." (move-fun (cond ((org-bound-and-true-p visual-line-mode) 'end-of-visual-line) ((fboundp 'move-end-of-line) 'move-end-of-line) - (t 'end-of-line)))) + (t 'end-of-line))) + deactivate-mark) (if (or (not special) arg) (call-interactively move-fun) (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) @@ -21485,7 +22827,10 @@ the cursor is already beyond the end of the headline." ;; after it. Use `end-of-line' to stay on current line. (call-interactively 'end-of-line)) (t (call-interactively move-fun))))) - (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))) + (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) @@ -21522,7 +22867,7 @@ depending on context." org-ctrl-k-protect-subtree) (if (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? "))) - (error "C-k aborted - would kill hidden subtree"))) + (user-error "C-k aborted as it would kill a hidden subtree"))) (call-interactively (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) @@ -21741,7 +23086,7 @@ make a significant difference in outlines with very many siblings." (let ((re org-outline-regexp-bol) level l) (unless (org-at-heading-p t) - (error "Not at a heading")) + (user-error "Not at a heading")) (setq level (funcall outline-level)) (save-excursion (if (not (re-search-backward re nil t)) @@ -21899,77 +23244,248 @@ clocking lines, and drawers." (point))) (defun org-forward-heading-same-level (arg &optional invisible-ok) - "Move forward to the arg'th subheading at same level as this one. + "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") - (org-back-to-heading invisible-ok) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (forward-char 1) - (while (> arg 0) - (while (and (re-search-forward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (progn (backward-char 1) (outline-invisible-p))) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))) + (if (not (ignore-errors (org-back-to-heading invisible-ok))) + (if (and arg (< arg 0)) + (goto-char (point-min)) + (outline-next-heading)) + (org-at-heading-p) + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if (and arg (< arg 0)) + 're-search-backward + 're-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (while (and (prog1 (> count 0) + (forward-char (if (and arg (< arg 0)) -1 1))) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (progn + (goto-char (line-beginning-position)) + (not (outline-invisible-p))))) + (setq count (1- count)) + (when (eq l level) + (setq result (point))))))) + (goto-char result)) (beginning-of-line 1))) (defun org-backward-heading-same-level (arg &optional invisible-ok) - "Move backward to the arg'th subheading at same level as this one. + "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") - (org-back-to-heading) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (while (> arg 0) - (while (and (re-search-backward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (outline-invisible-p)) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))))) + (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) + +(defun org-next-block (arg &optional backward block-regexp) + "Jump to the next block. +With a prefix argument ARG, jump forward ARG many source blocks. +When BACKWARD is non-nil, jump to the previous block. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (let ((re (or block-regexp org-block-regexp)) + (re-search-fn (or (and backward 're-search-backward) + 're-search-forward))) + (if (looking-at re) (forward-char 1)) + (condition-case nil + (funcall re-search-fn re nil nil arg) + (error (error "No %s code blocks" (if backward "previous" "further" )))) + (goto-char (match-beginning 0)) (org-show-context))) + +(defun org-previous-block (arg &optional block-regexp) + "Jump to the previous block. +With a prefix argument ARG, jump backward ARG many source blocks. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (org-next-block arg t block-regexp)) + +(defun org-forward-paragraph () + "Move forward to beginning of next paragraph or equivalent. + +The function moves point to the beginning of the next visible +structural element, which can be a paragraph, a table, a list +item, etc. It also provides some special moves for convenience: + + - On an affiliated keyword, jump to the beginning of the + relative element. + - On an item or a footnote definition, move to the second + element inside, if any. + - On a table or a property drawer, jump after it. + - On a verse or source block, stop after blank lines." + (interactive) + (when (eobp) (user-error "Cannot move further down")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (end (let ((end (org-element-property :end element)) (parent element)) + (while (and (setq parent (org-element-property :parent parent)) + (= (org-element-property :contents-end parent) end)) + (setq end (org-element-property :end parent))) + end))) + (cond ((not element) + (skip-chars-forward " \r\t\n") + (or (eobp) (beginning-of-line))) + ;; On affiliated keywords, move to element's beginning. + ((and post-affiliated (< (point) post-affiliated)) + (goto-char post-affiliated)) + ;; At a table row, move to the end of the table. Similarly, + ;; at a node property, move to the end of the property + ;; drawer. + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :end (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char end)) + ;; Consider blank lines as separators in verse and source + ;; blocks to ease editing. + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-end + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (beginning-of-line) + (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) + (if (not (re-search-forward "^[ \t]*$" contents-end t)) + (goto-char end) + (skip-chars-forward " \r\t\n") + (if (= (point) contents-end) (goto-char end) + (beginning-of-line)))) + ;; With no contents, just skip element. + ((not contents-begin) (goto-char end)) + ;; If contents are invisible, skip the element altogether. + ((outline-invisible-p (line-end-position)) + (case type + (headline + (org-with-limited-levels (outline-next-visible-heading 1))) + ;; At a plain list, make sure we move to the next item + ;; instead of skipping the whole list. + (plain-list (forward-char) + (org-forward-paragraph)) + (otherwise (goto-char end)))) + ((>= (point) contents-end) (goto-char end)) + ((>= (point) contents-begin) + ;; This can only happen on paragraphs and plain lists. + (case type + (paragraph (goto-char end)) + ;; At a plain list, try to move to second element in + ;; first item, if possible. + (plain-list (end-of-line) + (org-forward-paragraph)))) + ;; When contents start on the middle of a line (e.g. in + ;; items and footnote definitions), try to reach first + ;; element starting after current line. + ((> (line-end-position) contents-begin) + (end-of-line) + (org-forward-paragraph)) + (t (goto-char contents-begin))))) + +(defun org-backward-paragraph () + "Move backward to start of previous paragraph or equivalent. + +The function moves point to the beginning of the current +structural element, which can be a paragraph, a table, a list +item, etc., or to the beginning of the previous visible one if +point is already there. It also provides some special moves for +convenience: + + - On an affiliated keyword, jump to the first one. + - On a table or a property drawer, move to its beginning. + - On a verse or source block, stop before blank lines." + (interactive) + (when (bobp) (user-error "Cannot move further up")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (post-affiliated (org-element-property :post-affiliated element)) + (begin (org-element-property :begin element))) + (cond + ((not element) (goto-char (point-min))) + ((= (point) begin) + (backward-char) + (org-backward-paragraph)) + ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin)) + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :post-affiliated (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char begin)) + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-begin + (save-excursion (goto-char begin) (forward-line) (point)))) + (if (= (point) contents-begin) (goto-char post-affiliated) + ;; Inside a verse block, see blank lines as paragraph + ;; separators. + (let ((origin (point))) + (skip-chars-backward " \r\t\n" contents-begin) + (when (re-search-backward "^[ \t]*$" contents-begin 'move) + (skip-chars-forward " \r\t\n" origin) + (if (= (point) origin) (goto-char contents-begin) + (beginning-of-line)))))) + ((not contents-begin) (goto-char (or post-affiliated begin))) + ((eq type 'paragraph) + (goto-char contents-begin) + ;; When at first paragraph in an item or a footnote definition, + ;; move directly to beginning of line. + (let ((parent-contents + (org-element-property + :contents-begin (org-element-property :parent element)))) + (when (and parent-contents (= parent-contents contents-begin)) + (beginning-of-line)))) + ;; At the end of a greater element, move to the beginning of the + ;; last element within. + ((>= (point) contents-end) + (goto-char (1- contents-end)) + (org-backward-paragraph)) + (t (goto-char (or post-affiliated begin)))) + ;; Ensure we never leave point invisible. + (when (outline-invisible-p (point)) (beginning-of-visual-line)))) (defun org-forward-element () "Move forward by one element. Move to the next element at the same level, when possible." (interactive) - (cond ((eobp) (error "Cannot move further down")) + (cond ((eobp) (user-error "Cannot move further down")) ((org-with-limited-levels (org-at-heading-p)) (let ((origin (point))) - (org-forward-heading-same-level 1) + (goto-char (org-end-of-subtree nil t)) (unless (org-with-limited-levels (org-at-heading-p)) (goto-char origin) - (error "Cannot move further down")))) + (user-error "Cannot move further down")))) (t (let* ((elem (org-element-at-point)) (end (org-element-property :end elem)) (parent (org-element-property :parent elem))) - (if (and parent (= (org-element-property :contents-end parent) end)) - (goto-char (org-element-property :end parent)) - (goto-char end)))))) + (cond ((and parent (= (org-element-property :contents-end parent) end)) + (goto-char (org-element-property :end parent))) + ((integer-or-marker-p end) (goto-char end)) + (t (message "No element at point"))))))) (defun org-backward-element () "Move backward by one element. Move to the previous element at the same level, when possible." (interactive) - (cond ((bobp) (error "Cannot move further up")) + (cond ((bobp) (user-error "Cannot move further up")) ((org-with-limited-levels (org-at-heading-p)) - ;; At an headline, move to the previous one, if any, or stay + ;; At a headline, move to the previous one, if any, or stay ;; here. (let ((origin (point))) - (org-backward-heading-same-level 1) - (unless (org-with-limited-levels (org-at-heading-p)) - (goto-char origin) - (error "Cannot move further up")))) + (org-with-limited-levels (org-backward-heading-same-level 1)) + ;; When current headline has no sibling above, move to its + ;; parent. + (when (= (point) origin) + (or (org-with-limited-levels (org-up-heading-safe)) + (progn (goto-char origin) + (user-error "Cannot move further up")))))) (t (let* ((trail (org-element-at-point 'keep-trail)) (elem (car trail)) @@ -21978,6 +23494,7 @@ Move to the previous element at the same level, when possible." (cond ;; Move to beginning of current element if point isn't ;; there already. + ((null beg) (message "No element at point")) ((/= (point) beg) (goto-char beg)) (prev-elem (goto-char (org-element-property :begin prev-elem))) ((org-before-first-heading-p) (goto-char (point-min))) @@ -21987,12 +23504,12 @@ Move to the previous element at the same level, when possible." "Move to upper element." (interactive) (if (org-with-limited-levels (org-at-heading-p)) - (unless (org-up-heading-safe) (error "No surrounding element")) + (unless (org-up-heading-safe) (user-error "No surrounding element")) (let* ((elem (org-element-at-point)) (parent (org-element-property :parent elem))) (if parent (goto-char (org-element-property :begin parent)) (if (org-with-limited-levels (org-before-first-heading-p)) - (error "No surrounding element") + (user-error "No surrounding element") (org-with-limited-levels (org-back-to-heading))))))) (defvar org-element-greater-elements) @@ -22008,8 +23525,8 @@ Move to the previous element at the same level, when possible." ;; If contents are hidden, first disclose them. (when (org-element-property :hiddenp element) (org-cycle)) (goto-char (or (org-element-property :contents-begin element) - (error "No content for this element")))) - (t (error "No inner element"))))) + (user-error "No content for this element")))) + (t (user-error "No inner element"))))) (defun org-drag-element-backward () "Move backward element at point." @@ -22021,7 +23538,7 @@ Move to the previous element at the same level, when possible." ;; Error out if no previous element or previous element is ;; a parent of the current one. (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) - (error "Cannot drag element backward") + (user-error "Cannot drag element backward") (let ((pos (point))) (org-element-swap-A-B prev-elem elem) (goto-char (+ (org-element-property :begin prev-elem) @@ -22033,14 +23550,14 @@ Move to the previous element at the same level, when possible." (let* ((pos (point)) (elem (org-element-at-point))) (when (= (point-max) (org-element-property :end elem)) - (error "Cannot drag element forward")) + (user-error "Cannot drag element forward")) (goto-char (org-element-property :end elem)) (let ((next-elem (org-element-at-point))) (when (or (org-element-nested-p elem next-elem) (and (eq (org-element-type next-elem) 'headline) (not (eq (org-element-type elem) 'headline)))) (goto-char pos) - (error "Cannot drag element forward")) + (user-error "Cannot drag element forward")) ;; Compute new position of point: it's shifted by NEXT-ELEM ;; body's length (without final blanks) and by the length of ;; blanks between ELEM and NEXT-ELEM. @@ -22061,6 +23578,25 @@ Move to the previous element at the same level, when possible." (org-element-swap-A-B elem next-elem) (goto-char (+ pos size-next size-blank)))))) +(defun org-drag-line-forward (arg) + "Drag the line at point ARG lines forward." + (interactive "p") + (dotimes (n (abs arg)) + (let ((c (current-column))) + (if (< 0 arg) + (progn + (beginning-of-line 2) + (transpose-lines 1) + (beginning-of-line 0)) + (transpose-lines 1) + (beginning-of-line -1)) + (org-move-to-column c)))) + +(defun org-drag-line-backward (arg) + "Drag the line at point ARG lines backward." + (interactive "p") + (org-drag-line-forward (- arg))) + (defun org-mark-element () "Put point at beginning of this element, mark at end. @@ -22114,7 +23650,7 @@ Relative indentation (between items, inside blocks, etc.) isn't modified." (interactive) (unless (eq major-mode 'org-mode) - (error "Cannot un-indent a buffer not in Org mode")) + (user-error "Cannot un-indent a buffer not in Org mode")) (let* ((parse-tree (org-element-parse-buffer 'greater-element)) unindent-tree ; For byte-compiler. (unindent-tree @@ -22244,8 +23780,8 @@ Show the heading too, if it is currently invisible." (org-show-context 'org-goto)))))) (defun org-link-display-format (link) - "Replace a link with either the description, or the link target -if no description is present" + "Replace a link with its the description. +If there is no description, use the link target." (save-match-data (if (string-match org-bracket-link-analytic-regexp link) (replace-match (if (match-end 5) @@ -22302,14 +23838,16 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (let ((default-directory dir)) (expand-file-name txt))) (unless (derived-mode-p 'org-mode) - (error "Cannot restrict to non-Org-mode file")) + (user-error "Cannot restrict to non-Org-mode file")) (org-agenda-set-restriction-lock 'file))) - (t (error "Don't know how to restrict Org-mode's agenda"))) + (t (user-error "Don't know how to restrict Org-mode's agenda"))) (move-overlay org-speedbar-restriction-lock-overlay (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) (org-agenda-maybe-redo))) +(defvar speedbar-file-key-map) +(declare-function speedbar-add-supported-extension "speedbar" (extension)) (eval-after-load "speedbar" '(progn (speedbar-add-supported-extension ".org") @@ -22323,9 +23861,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;;; Fixes and Hacks for problems with other packages ;; Make flyspell not check words in links, to not mess up our keymap +(defvar org-element-affiliated-keywords) ; From org-element.el +(defvar org-element-block-name-alist) ; From org-element.el (defun org-mode-flyspell-verify () "Don't let flyspell put overlays at active buttons, or on {todo,all-time,additional-option-like}-keywords." + (require 'org-element) ; For `org-element-affiliated-keywords' (let ((pos (max (1- (point)) (point-min))) (word (thing-at-point 'word))) (and (not (get-text-property pos 'keymap)) @@ -22334,7 +23875,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (not (member word org-all-time-keywords)) (not (member word org-options-keywords)) (not (member word (mapcar 'car org-startup-options))) - (not (member word org-additional-option-like-keywords-for-flyspell))))) + (not (member-ignore-case word org-element-affiliated-keywords)) + (not (member-ignore-case word (org-get-export-keywords))) + (not (member-ignore-case + word (mapcar 'car org-element-block-name-alist))) + (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) + (not (org-in-src-block-p))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -22375,32 +23921,10 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (org-show-context 'bookmark-jump))) ;; Make session.el ignore our circular variable +(defvar session-globals-exclude) (eval-after-load "session" '(add-to-list 'session-globals-exclude 'org-mark-ring)) -;;;; Experimental code - -(defun org-closed-in-range () - "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the future." - (interactive) - ;; Get the time interval from the user. - (let* ((time1 (org-float-time - (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (org-float-time - (org-read-date nil 'to-time nil "End date:"))) - ;; callback function - (callback (lambda () - (let ((time - (org-float-time - (apply 'encode-time - (org-parse-time-string - (match-string 1)))))) - ;; check if time in interval - (and (>= time time1) (<= time time2)))))) - ;; make tree, check each match with the callback - (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - ;;;; Finish up (provide 'org) diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el new file mode 100644 index 00000000000..dc238adc781 --- /dev/null +++ b/lisp/org/ox-ascii.el @@ -0,0 +1,1944 @@ +;;; ox-ascii.el --- ASCII Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements an ASCII back-end for Org generic exporter. +;; See Org manual for more information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) +(require 'ox-publish) + +(declare-function aa2u "ext:ascii-art-to-unicode" ()) + +;;; Define Back-End +;; +;; The following setting won't allow to modify preferred charset +;; through a buffer keyword or an option item, but, since the property +;; will appear in communication channel nonetheless, it allows to +;; override `org-ascii-charset' variable on the fly by the ext-plist +;; mechanism. +;; +;; We also install a filter for headlines and sections, in order to +;; control blank lines separating them in output string. + +(org-export-define-backend 'ascii + '((bold . org-ascii-bold) + (center-block . org-ascii-center-block) + (clock . org-ascii-clock) + (code . org-ascii-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-ascii-drawer) + (dynamic-block . org-ascii-dynamic-block) + (entity . org-ascii-entity) + (example-block . org-ascii-example-block) + (export-block . org-ascii-export-block) + (export-snippet . org-ascii-export-snippet) + (fixed-width . org-ascii-fixed-width) + (footnote-reference . org-ascii-footnote-reference) + (headline . org-ascii-headline) + (horizontal-rule . org-ascii-horizontal-rule) + (inline-src-block . org-ascii-inline-src-block) + (inlinetask . org-ascii-inlinetask) + (inner-template . org-ascii-inner-template) + (italic . org-ascii-italic) + (item . org-ascii-item) + (keyword . org-ascii-keyword) + (latex-environment . org-ascii-latex-environment) + (latex-fragment . org-ascii-latex-fragment) + (line-break . org-ascii-line-break) + (link . org-ascii-link) + (paragraph . org-ascii-paragraph) + (plain-list . org-ascii-plain-list) + (plain-text . org-ascii-plain-text) + (planning . org-ascii-planning) + (quote-block . org-ascii-quote-block) + (quote-section . org-ascii-quote-section) + (radio-target . org-ascii-radio-target) + (section . org-ascii-section) + (special-block . org-ascii-special-block) + (src-block . org-ascii-src-block) + (statistics-cookie . org-ascii-statistics-cookie) + (strike-through . org-ascii-strike-through) + (subscript . org-ascii-subscript) + (superscript . org-ascii-superscript) + (table . org-ascii-table) + (table-cell . org-ascii-table-cell) + (table-row . org-ascii-table-row) + (target . org-ascii-target) + (template . org-ascii-template) + (timestamp . org-ascii-timestamp) + (underline . org-ascii-underline) + (verbatim . org-ascii-verbatim) + (verse-block . org-ascii-verse-block)) + :export-block "ASCII" + :menu-entry + '(?t "Export to Plain Text" + ((?A "As ASCII buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii)))) + (?a "As ASCII file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii)))) + (?L "As Latin1 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1)))) + (?l "As Latin1 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1)))) + (?U "As UTF-8 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8)))) + (?u "As UTF-8 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8)))))) + :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines) + (:filter-parse-tree org-ascii-filter-paragraph-spacing + org-ascii-filter-comment-spacing) + (:filter-section . org-ascii-filter-headline-blank-lines)) + :options-alist '((:ascii-charset nil nil org-ascii-charset))) + + + +;;; User Configurable Variables + +(defgroup org-export-ascii nil + "Options for exporting Org mode files to ASCII." + :tag "Org Export ASCII" + :group 'org-export) + +(defcustom org-ascii-text-width 72 + "Maximum width of exported text. +This number includes margin size, as set in +`org-ascii-global-margin'." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-global-margin 0 + "Width of the left margin, in number of characters." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-inner-margin 2 + "Width of the inner margin, in number of characters. +Inner margin is applied between each headline." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-quote-margin 6 + "Width of margin used for quoting text, in characters. +This margin is applied on both sides of the text." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-inlinetask-width 30 + "Width of inline tasks, in number of characters. +This number ignores any margin." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-headline-spacing '(1 . 2) + "Number of blank lines inserted around headlines. + +This variable can be set to a cons cell. In that case, its car +represents the number of blank lines present before headline +contents whereas its cdr reflects the number of blank lines after +contents. + +A nil value replicates the number of blank lines found in the +original Org buffer at the same place." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Replicate original spacing" nil) + (cons :tag "Set an uniform spacing" + (integer :tag "Number of blank lines before contents") + (integer :tag "Number of blank lines after contents")))) + +(defcustom org-ascii-indented-line-width 'auto + "Additional indentation width for the first line in a paragraph. +If the value is an integer, indent the first line of each +paragraph by this number. If it is the symbol `auto' preserve +indentation from original document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of white spaces characters") + (const :tag "Preserve original width" auto))) + +(defcustom org-ascii-paragraph-spacing 'auto + "Number of white lines between paragraphs. +If the value is an integer, add this number of blank lines +between contiguous paragraphs. If is it the symbol `auto', keep +the same number of blank lines as in the original document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of blank lines") + (const :tag "Preserve original spacing" auto))) + +(defcustom org-ascii-charset 'ascii + "The charset allowed to represent various elements and objects. +Possible values are: +`ascii' Only use plain ASCII characters +`latin1' Include Latin-1 characters +`utf-8' Use all UTF-8 characters" + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "ASCII" ascii) + (const :tag "Latin-1" latin1) + (const :tag "UTF-8" utf-8))) + +(defcustom org-ascii-underline '((ascii ?= ?~ ?-) + (latin1 ?= ?~ ?-) + (utf-8 ?═ ?─ ?╌ ?┄ ?┈)) + "Characters for underlining headings in ASCII export. + +Alist whose key is a symbol among `ascii', `latin1' and `utf-8' +and whose value is a list of characters. + +For each supported charset, this variable associates a sequence +of underline characters. In a sequence, the characters will be +used in order for headlines level 1, 2, ... If no character is +available for a given level, the headline won't be underlined." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (cons :tag "Underline characters sequence" + (const :tag "ASCII charset" ascii) + (repeat character)) + (cons :tag "Underline characters sequence" + (const :tag "Latin-1 charset" latin1) + (repeat character)) + (cons :tag "Underline characters sequence" + (const :tag "UTF-8 charset" utf-8) + (repeat character)))) + +(defcustom org-ascii-bullets '((ascii ?* ?+ ?-) + (latin1 ?§ ?¶) + (utf-8 ?◊)) + "Bullet characters for headlines converted to lists in ASCII export. + +Alist whose key is a symbol among `ascii', `latin1' and `utf-8' +and whose value is a list of characters. + +The first character is used for the first level considered as low +level, and so on. If there are more levels than characters given +here, the list will be repeated. + +Note that this variable doesn't affect plain lists +representation." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (cons :tag "Bullet characters for low level headlines" + (const :tag "ASCII charset" ascii) + (repeat character)) + (cons :tag "Bullet characters for low level headlines" + (const :tag "Latin-1 charset" latin1) + (repeat character)) + (cons :tag "Bullet characters for low level headlines" + (const :tag "UTF-8 charset" utf-8) + (repeat character)))) + +(defcustom org-ascii-links-to-notes t + "Non-nil means convert links to notes before the next headline. +When nil, the link will be exported in place. If the line +becomes long in this way, it will be wrapped." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-keep-all-vertical-lines nil + "Non-nil means keep all vertical lines in ASCII tables. +When nil, vertical lines will be removed except for those needed +for column grouping." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-widen-columns t + "Non-nil means widen narrowed columns for export. +When nil, narrowed columns will look in ASCII export just like in +Org mode, i.e. with \"=>\" as ellipsis." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-use-ascii-art nil + "Non-nil means table.el tables are turned into ascii-art. + +It only makes sense when export charset is `utf-8'. It is nil by +default since it requires ascii-art-to-unicode.el package. You +can download it here: + + http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-caption-above nil + "When non-nil, place caption string before the element. +Otherwise, place it right after it." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-verbatim-format "`%s'" + "Format string used for verbatim text and inline code." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-ascii-format-drawer-function + (lambda (name contents width) contents) + "Function called to format a drawer in ASCII. + +The function must accept three parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + WIDTH the text width within the drawer. + +The function should return either the string to be exported or +nil to ignore the drawer. + +The default value simply returns the value of CONTENTS." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +(defcustom org-ascii-format-inlinetask-function + 'org-ascii-format-inlinetask-default + "Function called to format an inlinetask in ASCII. + +The function must accept nine parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + WIDTH the width of the inlinetask, as a number. + INLINETASK the inlinetask itself. + INFO the info channel. + +The function should return either the string to be exported or +nil to ignore the inline task." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + + +;;; Internal Functions + +;; Internal functions fall into three categories. + +;; The first one is about text formatting. The core function is +;; `org-ascii--current-text-width', which determines the current +;; text width allowed to a given element. In other words, it helps +;; keeping each line width within maximum text width defined in +;; `org-ascii-text-width'. Once this information is known, +;; `org-ascii--fill-string', `org-ascii--justify-string', +;; `org-ascii--box-string' and `org-ascii--indent-string' can +;; operate on a given output string. + +;; The second category contains functions handling elements listings, +;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc' +;; returns a complete table of contents, `org-ascii--list-listings' +;; returns a list of referenceable src-block elements, and +;; `org-ascii--list-tables' does the same for table elements. + +;; The third category includes general helper functions. +;; `org-ascii--build-title' creates the title for a given headline +;; or inlinetask element. `org-ascii--build-caption' returns the +;; caption string associated to a table or a src-block. +;; `org-ascii--describe-links' creates notes about links for +;; insertion at the end of a section. It uses +;; `org-ascii--unique-links' to get the list of links to describe. +;; Eventually, `org-ascii--translate' translates a string according +;; to language and charset specification. + + +(defun org-ascii--fill-string (s text-width info &optional justify) + "Fill a string with specified text-width and return it. + +S is the string being filled. TEXT-WIDTH is an integer +specifying maximum length of a line. INFO is the plist used as +a communication channel. + +Optional argument JUSTIFY can specify any type of justification +among `left', `center', `right' or `full'. A nil value is +equivalent to `left'. For a justification that doesn't also fill +string, see `org-ascii--justify-string'. + +Return nil if S isn't a string." + ;; Don't fill paragraph when break should be preserved. + (cond ((not (stringp s)) nil) + ((plist-get info :preserve-breaks) s) + (t (let ((double-space-p sentence-end-double-space)) + (with-temp-buffer + (let ((fill-column text-width) + (use-hard-newlines t) + (sentence-end-double-space double-space-p)) + (insert s) + (fill-region (point-min) (point-max) justify)) + (buffer-string)))))) + +(defun org-ascii--justify-string (s text-width how) + "Justify string S. +TEXT-WIDTH is an integer specifying maximum length of a line. +HOW determines the type of justification: it can be `left', +`right', `full' or `center'." + (with-temp-buffer + (insert s) + (goto-char (point-min)) + (let ((fill-column text-width) + ;; Disable `adaptive-fill-mode' so it doesn't prevent + ;; filling lines matching `adaptive-fill-regexp'. + (adaptive-fill-mode nil)) + (while (< (point) (point-max)) + (justify-current-line how) + (forward-line))) + (buffer-string))) + +(defun org-ascii--indent-string (s width) + "Indent string S by WIDTH white spaces. +Empty lines are not indented." + (when (stringp s) + (replace-regexp-in-string + "\\(^\\)\\(?:.*\\S-\\)" (make-string width ? ) s nil nil 1))) + +(defun org-ascii--box-string (s info) + "Return string S with a partial box to its left. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (format (if utf8p "╭────\n%s\n╰────" ",----\n%s\n`----") + (replace-regexp-in-string + "^" (if utf8p "│ " "| ") + ;; Remove last newline character. + (replace-regexp-in-string "\n[ \t]*\\'" "" s))))) + +(defun org-ascii--current-text-width (element info) + "Return maximum text width for ELEMENT's contents. +INFO is a plist used as a communication channel." + (case (org-element-type element) + ;; Elements with an absolute width: `headline' and `inlinetask'. + (inlinetask org-ascii-inlinetask-width) + ('headline + (- org-ascii-text-width + (let ((low-level-rank (org-export-low-level-p element info))) + (if low-level-rank (* low-level-rank 2) org-ascii-global-margin)))) + ;; Elements with a relative width: store maximum text width in + ;; TOTAL-WIDTH. + (otherwise + (let* ((genealogy (cons element (org-export-get-genealogy element))) + ;; Total width is determined by the presence, or not, of an + ;; inline task among ELEMENT parents. + (total-width + (if (loop for parent in genealogy + thereis (eq (org-element-type parent) 'inlinetask)) + org-ascii-inlinetask-width + ;; No inlinetask: Remove global margin from text width. + (- org-ascii-text-width + org-ascii-global-margin + (let ((parent (org-export-get-parent-headline element))) + ;; Inner margin doesn't apply to text before first + ;; headline. + (if (not parent) 0 + (let ((low-level-rank + (org-export-low-level-p parent info))) + ;; Inner margin doesn't apply to contents of + ;; low level headlines, since they've got their + ;; own indentation mechanism. + (if low-level-rank (* low-level-rank 2) + org-ascii-inner-margin)))))))) + (- total-width + ;; Each `quote-block', `quote-section' and `verse-block' above + ;; narrows text width by twice the standard margin size. + (+ (* (loop for parent in genealogy + when (memq (org-element-type parent) + '(quote-block quote-section verse-block)) + count parent) + 2 org-ascii-quote-margin) + ;; Text width within a plain-list is restricted by + ;; indentation of current item. If that's the case, + ;; compute it with the help of `:structure' property from + ;; parent item, if any. + (let ((parent-item + (if (eq (org-element-type element) 'item) element + (loop for parent in genealogy + when (eq (org-element-type parent) 'item) + return parent)))) + (if (not parent-item) 0 + ;; Compute indentation offset of the current item, + ;; that is the sum of the difference between its + ;; indentation and the indentation of the top item in + ;; the list and current item bullet's length. Also + ;; remove checkbox length, and tag length (for + ;; description lists) or bullet length. + (let ((struct (org-element-property :structure parent-item)) + (beg-item (org-element-property :begin parent-item))) + (+ (- (org-list-get-ind beg-item struct) + (org-list-get-ind + (org-list-get-top-point struct) struct)) + (length (org-ascii--checkbox parent-item info)) + (length + (or (org-list-get-tag beg-item struct) + (org-list-get-bullet beg-item struct))))))))))))) + +(defun org-ascii--build-title + (element info text-width &optional underline notags toc) + "Format ELEMENT title and return it. + +ELEMENT is either an `headline' or `inlinetask' element. INFO is +a plist used as a communication channel. TEXT-WIDTH is an +integer representing the maximum length of a line. + +When optional argument UNDERLINE is non-nil, underline title, +without the tags, according to `org-ascii-underline' +specifications. + +If optional argument NOTAGS is non-nil, no tags will be added to +the title. + +When optional argument TOC is non-nil, use optional title if +possible. It doesn't apply to `inlinetask' elements." + (let* ((headlinep (eq (org-element-type element) 'headline)) + (numbers + ;; Numbering is specific to headlines. + (and headlinep (org-export-numbered-headline-p element info) + ;; All tests passed: build numbering string. + (concat + (mapconcat + 'number-to-string + (org-export-get-headline-number element info) ".") + " "))) + (text + (org-trim + (org-export-data + (if (and toc headlinep) (org-export-get-alt-title element info) + (org-element-property :title element)) + info))) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword element))) + (and todo (concat (org-export-data todo info) " "))))) + (tags (and (not notags) + (plist-get info :with-tags) + (let ((tag-list (org-export-get-tags element info))) + (and tag-list + (format ":%s:" + (mapconcat 'identity tag-list ":")))))) + (priority + (and (plist-get info :with-priority) + (let ((char (org-element-property :priority element))) + (and char (format "(#%c) " char))))) + (first-part (concat numbers todo priority text))) + (concat + first-part + ;; Align tags, if any. + (when tags + (format + (format " %%%ds" + (max (- text-width (1+ (length first-part))) (length tags))) + tags)) + ;; Maybe underline text, if ELEMENT type is `headline' and an + ;; underline character has been defined. + (when (and underline headlinep) + (let ((under-char + (nth (1- (org-export-get-relative-level element info)) + (cdr (assq (plist-get info :ascii-charset) + org-ascii-underline))))) + (and under-char + (concat "\n" + (make-string (length first-part) under-char)))))))) + +(defun org-ascii--has-caption-p (element info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal'." + (org-element-property :caption element)) + +(defun org-ascii--build-caption (element info) + "Return caption string for ELEMENT, if applicable. + +INFO is a plist used as a communication channel. + +The caption string contains the sequence number of ELEMENT along +with its real caption. Return nil when ELEMENT has no affiliated +caption keyword." + (let ((caption (org-export-get-caption element))) + (when caption + ;; Get sequence number of current src-block among every + ;; src-block with a caption. + (let ((reference + (org-export-get-ordinal + element info nil 'org-ascii--has-caption-p)) + (title-fmt (org-ascii--translate + (case (org-element-type element) + (table "Table %d:") + (src-block "Listing %d:")) + info))) + (org-ascii--fill-string + (concat (format title-fmt reference) + " " + (org-export-data caption info)) + (org-ascii--current-text-width element info) info))))) + +(defun org-ascii--build-toc (info &optional n keyword) + "Return a table of contents. + +INFO is a plist used as a communication channel. + +Optional argument N, when non-nil, is an integer specifying the +depth of the table. + +Optional argument KEYWORD specifies the TOC keyword, if any, from +which the table of contents generation has been initiated." + (let ((title (org-ascii--translate "Table of Contents" info))) + (concat + title "\n" + (make-string (length title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin)))) + (mapconcat + (lambda (headline) + (let* ((level (org-export-get-relative-level headline info)) + (indent (* (1- level) 3))) + (concat + (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) + (org-ascii--build-title + headline info (- text-width indent) nil + (or (not (plist-get info :with-tags)) + (eq (plist-get info :with-tags) 'not-in-toc)) + 'toc)))) + (org-export-collect-headlines info n) "\n"))))) + +(defun org-ascii--list-listings (keyword info) + "Return a list of listings. + +KEYWORD is the keyword that initiated the list of listings +generation. INFO is a plist used as a communication channel." + (let ((title (org-ascii--translate "List of Listings" info))) + (concat + title "\n" + (make-string (length title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) + ;; Use a counter instead of retrieving ordinal of each + ;; src-block. + (count 0)) + (mapconcat + (lambda (src-block) + ;; Store initial text so its length can be computed. This is + ;; used to properly align caption right to it in case of + ;; filling (like contents of a description list item). + (let ((initial-text + (format (org-ascii--translate "Listing %d:" info) + (incf count)))) + (concat + initial-text " " + (org-trim + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption src-block t) + (org-export-get-caption src-block)))) + (org-export-data caption info)) + (- text-width (length initial-text)) info) + (length initial-text)))))) + (org-export-collect-listings info) "\n"))))) + +(defun org-ascii--list-tables (keyword info) + "Return a list of tables. + +KEYWORD is the keyword that initiated the list of tables +generation. INFO is a plist used as a communication channel." + (let ((title (org-ascii--translate "List of Tables" info))) + (concat + title "\n" + (make-string (length title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) + ;; Use a counter instead of retrieving ordinal of each + ;; src-block. + (count 0)) + (mapconcat + (lambda (table) + ;; Store initial text so its length can be computed. This is + ;; used to properly align caption right to it in case of + ;; filling (like contents of a description list item). + (let ((initial-text + (format (org-ascii--translate "Table %d:" info) + (incf count)))) + (concat + initial-text " " + (org-trim + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption table t) + (org-export-get-caption table)))) + (org-export-data caption info)) + (- text-width (length initial-text)) info) + (length initial-text)))))) + (org-export-collect-tables info) "\n"))))) + +(defun org-ascii--unique-links (element info) + "Return a list of unique link references in ELEMENT. + +ELEMENT is either a headline element or a section element. INFO +is a plist used as a communication channel." + (let* (seen + (unique-link-p + (function + ;; Return LINK if it wasn't referenced so far, or nil. + ;; Update SEEN links along the way. + (lambda (link) + (let ((footprint + (cons (org-element-property :raw-link link) + (org-element-contents link)))) + ;; Ignore LINK if it hasn't been translated already. + ;; It can happen if it is located in an affiliated + ;; keyword that was ignored. + (when (and (org-string-nw-p + (gethash link (plist-get info :exported-data))) + (not (member footprint seen))) + (push footprint seen) link))))) + ;; If at a section, find parent headline, if any, in order to + ;; count links that might be in the title. + (headline + (if (eq (org-element-type element) 'headline) element + (or (org-export-get-parent-headline element) element)))) + ;; Get all links in HEADLINE. + (org-element-map headline 'link + (lambda (l) (funcall unique-link-p l)) info nil nil t))) + +(defun org-ascii--describe-links (links width info) + "Return a string describing a list of links. + +LINKS is a list of link type objects, as returned by +`org-ascii--unique-links'. WIDTH is the text width allowed for +the output string. INFO is a plist used as a communication +channel." + (mapconcat + (lambda (link) + (let ((type (org-element-property :type link)) + (anchor (let ((desc (org-element-contents link))) + (if desc (org-export-data desc info) + (org-element-property :raw-link link))))) + (cond + ;; Coderefs, radio links and fuzzy links are ignored. + ((member type '("coderef" "radio" "fuzzy")) nil) + ;; Id and custom-id links: Headlines refer to their numbering. + ((member type '("custom-id" "id")) + (let ((dest (org-export-resolve-id-link link info))) + (concat + (org-ascii--fill-string + (format + "[%s] %s" + anchor + (if (not dest) (org-ascii--translate "Unknown reference" info) + (format + (org-ascii--translate "See section %s" info) + (mapconcat 'number-to-string + (org-export-get-headline-number dest info) ".")))) + width info) "\n\n"))) + ;; Do not add a link that cannot be resolved and doesn't have + ;; any description: destination is already visible in the + ;; paragraph. + ((not (org-element-contents link)) nil) + (t + (concat + (org-ascii--fill-string + (format "[%s] %s" anchor (org-element-property :raw-link link)) + width info) + "\n\n"))))) + links "")) + +(defun org-ascii--checkbox (item info) + "Return checkbox string for ITEM or nil. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (case (org-element-property :checkbox item) + (on (if utf8p "☑ " "[X] ")) + (off (if utf8p "☐ " "[ ] ")) + (trans (if utf8p "☒ " "[-] "))))) + + + +;;; Template + +(defun org-ascii-template--document-title (info) + "Return document title, as a string. +INFO is a plist used as a communication channel." + (let* ((text-width org-ascii-text-width) + ;; Links in the title will not be resolved later, so we make + ;; sure their path is located right after them. + (org-ascii-links-to-notes nil) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info))) + (date (and (plist-get info :with-date) + (org-export-data (org-export-get-date info) info)))) + ;; There are two types of title blocks depending on the presence + ;; of a title to display. + (if (string= title "") + ;; Title block without a title. DATE is positioned at the top + ;; right of the document, AUTHOR to the top left and EMAIL + ;; just below. + (cond + ((and (org-string-nw-p date) (org-string-nw-p author)) + (concat + author + (make-string (- text-width (length date) (length author)) ? ) + date + (when (org-string-nw-p email) (concat "\n" email)) + "\n\n\n")) + ((and (org-string-nw-p date) (org-string-nw-p email)) + (concat + email + (make-string (- text-width (length date) (length email)) ? ) + date "\n\n\n")) + ((org-string-nw-p date) + (concat + (org-ascii--justify-string date text-width 'right) + "\n\n\n")) + ((and (org-string-nw-p author) (org-string-nw-p email)) + (concat author "\n" email "\n\n\n")) + ((org-string-nw-p author) (concat author "\n\n\n")) + ((org-string-nw-p email) (concat email "\n\n\n"))) + ;; Title block with a title. Document's TITLE, along with the + ;; AUTHOR and its EMAIL are both overlined and an underlined, + ;; centered. Date is just below, also centered. + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + ;; Format TITLE. It may be filled if it is too wide, + ;; that is wider than the two thirds of the total width. + (title-len (min (length title) (/ (* 2 text-width) 3))) + (formatted-title (org-ascii--fill-string title title-len info)) + (line + (make-string + (min (+ (max title-len (length author) (length email)) 2) + text-width) (if utf8p ?━ ?_)))) + (org-ascii--justify-string + (concat line "\n" + (unless utf8p "\n") + (upcase formatted-title) + (cond + ((and (org-string-nw-p author) (org-string-nw-p email)) + (concat (if utf8p "\n\n\n" "\n\n") author "\n" email)) + ((org-string-nw-p author) + (concat (if utf8p "\n\n\n" "\n\n") author)) + ((org-string-nw-p email) + (concat (if utf8p "\n\n\n" "\n\n") email))) + "\n" line + (when (org-string-nw-p date) (concat "\n\n\n" date)) + "\n\n\n") text-width 'center))))) + +(defun org-ascii-inner-template (contents info) + "Return complete document string after ASCII conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (org-element-normalize-string + (org-ascii--indent-string + (concat + ;; 1. Document's body. + contents + ;; 2. Footnote definitions. + (let ((definitions (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + ;; Insert full links right inside the footnote definition + ;; as they have no chance to be inserted later. + (org-ascii-links-to-notes nil)) + (when definitions + (concat + "\n\n\n" + (let ((title (org-ascii--translate "Footnotes" info))) + (concat + title "\n" + (make-string + (length title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) + "\n\n" + (let ((text-width (- org-ascii-text-width org-ascii-global-margin))) + (mapconcat + (lambda (ref) + (let ((id (format "[%s] " (car ref)))) + ;; Distinguish between inline definitions and + ;; full-fledged definitions. + (org-trim + (let ((def (nth 2 ref))) + (if (eq (org-element-type def) 'org-data) + ;; Full-fledged definition: footnote ID is + ;; inserted inside the first parsed paragraph + ;; (FIRST), if any, to be sure filling will + ;; take it into consideration. + (let ((first (car (org-element-contents def)))) + (if (not (eq (org-element-type first) 'paragraph)) + (concat id "\n" (org-export-data def info)) + (push id (nthcdr 2 first)) + (org-export-data def info))) + ;; Fill paragraph once footnote ID is inserted + ;; in order to have a correct length for first + ;; line. + (org-ascii--fill-string + (concat id (org-export-data def info)) + text-width info)))))) + definitions "\n\n")))))) + org-ascii-global-margin))) + +(defun org-ascii-template (contents info) + "Return complete document string after ASCII conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; 1. Build title block. + (org-ascii--indent-string + (concat (org-ascii-template--document-title info) + ;; 2. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (org-ascii--build-toc info (and (wholenump depth) depth)) + "\n\n\n")))) + org-ascii-global-margin) + ;; 3. Document's body. + contents + ;; 4. Creator. Ignore `comment' value as there are no comments in + ;; ASCII. Justify it to the bottom right. + (org-ascii--indent-string + (let ((creator-info (plist-get info :with-creator)) + (text-width (- org-ascii-text-width org-ascii-global-margin))) + (unless (or (not creator-info) (eq creator-info 'comment)) + (concat + "\n\n\n" + (org-ascii--fill-string + (plist-get info :creator) text-width info 'right)))) + org-ascii-global-margin))) + +(defun org-ascii--translate (s info) + "Translate string S according to specified language and charset. +INFO is a plist used as a communication channel." + (let ((charset (intern (format ":%s" (plist-get info :ascii-charset))))) + (org-export-translate s charset info))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-ascii-bold (bold contents info) + "Transcode BOLD from Org to ASCII. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "*%s*" contents)) + + +;;;; Center Block + +(defun org-ascii-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-ascii--justify-string + contents (org-ascii--current-text-width center-block info) 'center)) + + +;;;; Clock + +(defun org-ascii-clock (clock contents info) + "Transcode a CLOCK object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat org-clock-string " " + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string time ":"))))))) + + +;;;; Code + +(defun org-ascii-code (code contents info) + "Return a CODE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format org-ascii-verbatim-format (org-element-property :value code))) + + +;;;; Drawer + +(defun org-ascii-drawer (drawer contents info) + "Transcode a DRAWER element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((name (org-element-property :drawer-name drawer)) + (width (org-ascii--current-text-width drawer info))) + (funcall org-ascii-format-drawer-function name contents width))) + + +;;;; Dynamic Block + +(defun org-ascii-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Entity + +(defun org-ascii-entity (entity contents info) + "Transcode an ENTITY object from Org to ASCII. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property + (intern (concat ":" (symbol-name (plist-get info :ascii-charset)))) + entity)) + + +;;;; Example Block + +(defun org-ascii-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii--box-string + (org-export-format-code-default example-block info) info)) + + +;;;; Export Snippet + +(defun org-ascii-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'ascii) + (org-element-property :value export-snippet))) + + +;;;; Export Block + +(defun org-ascii-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "ASCII") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Fixed Width + +(defun org-ascii-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii--box-string + (org-remove-indentation + (org-element-property :value fixed-width)) info)) + + +;;;; Footnote Definition + +;; Footnote Definitions are ignored. They are compiled at the end of +;; the document, by `org-ascii-inner-template'. + + +;;;; Footnote Reference + +(defun org-ascii-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "[%s]" (org-export-get-footnote-number footnote-reference info))) + + +;;;; Headline + +(defun org-ascii-headline (headline contents info) + "Transcode a HEADLINE element from Org to ASCII. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Don't export footnote section, which will be handled at the end + ;; of the template. + (unless (org-element-property :footnote-section-p headline) + (let* ((low-level-rank (org-export-low-level-p headline info)) + (width (org-ascii--current-text-width headline info)) + ;; Blank lines between headline and its contents. + ;; `org-ascii-headline-spacing', when set, overwrites + ;; original buffer's spacing. + (pre-blanks + (make-string + (if org-ascii-headline-spacing (car org-ascii-headline-spacing) + (org-element-property :pre-blank headline)) ?\n)) + ;; Even if HEADLINE has no section, there might be some + ;; links in its title that we shouldn't forget to describe. + (links + (unless (or (eq (caar (org-element-contents headline)) 'section)) + (let ((title (org-element-property :title headline))) + (when (consp title) + (org-ascii--describe-links + (org-ascii--unique-links title info) width info)))))) + ;; Deep subtree: export it as a list item. + (if low-level-rank + (concat + ;; Bullet. + (let ((bullets (cdr (assq (plist-get info :ascii-charset) + org-ascii-bullets)))) + (char-to-string + (nth (mod (1- low-level-rank) (length bullets)) bullets))) + " " + ;; Title. + (org-ascii--build-title headline info width) "\n" + ;; Contents, indented by length of bullet. + pre-blanks + (org-ascii--indent-string + (concat contents + (when (org-string-nw-p links) (concat "\n\n" links))) + 2)) + ;; Else: Standard headline. + (concat + (org-ascii--build-title headline info width 'underline) + "\n" pre-blanks + (concat (when (org-string-nw-p links) links) contents)))))) + + +;;;; Horizontal Rule + +(defun org-ascii-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((text-width (org-ascii--current-text-width horizontal-rule info)) + (spec-width + (org-export-read-attribute :attr_ascii horizontal-rule :width))) + (org-ascii--justify-string + (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width)) + (string-to-number spec-width) + text-width) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-)) + text-width 'center))) + + +;;;; Inline Src Block + +(defun org-ascii-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (format org-ascii-verbatim-format + (org-element-property :value inline-src-block))) + + +;;;; Inlinetask + +(defun org-ascii-format-inlinetask-default + (todo type priority name tags contents width inlinetask info) + "Format an inline task element for ASCII export. +See `org-ascii-format-inlinetask-function' for a description +of the parameters." + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (width (or width org-ascii-inlinetask-width))) + (org-ascii--indent-string + (concat + ;; Top line, with an additional blank line if not in UTF-8. + (make-string width (if utf8p ?━ ?_)) "\n" + (unless utf8p (concat (make-string width ? ) "\n")) + ;; Add title. Fill it if wider than inlinetask. + (let ((title (org-ascii--build-title inlinetask info width))) + (if (<= (length title) width) title + (org-ascii--fill-string title width info))) + "\n" + ;; If CONTENTS is not empty, insert it along with + ;; a separator. + (when (org-string-nw-p contents) + (concat (make-string width (if utf8p ?─ ?-)) "\n" contents)) + ;; Bottom line. + (make-string width (if utf8p ?━ ?_))) + ;; Flush the inlinetask to the right. + (- org-ascii-text-width org-ascii-global-margin + (if (not (org-export-get-parent-headline inlinetask)) 0 + org-ascii-inner-margin) + (org-ascii--current-text-width inlinetask info))))) + +(defun org-ascii-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((width (org-ascii--current-text-width inlinetask info))) + (funcall org-ascii-format-inlinetask-function + ;; todo. + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property + :todo-keyword inlinetask))) + (and todo (org-export-data todo info)))) + ;; todo-type + (org-element-property :todo-type inlinetask) + ;; priority + (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)) + ;; title + (org-export-data (org-element-property :title inlinetask) info) + ;; tags + (and (plist-get info :with-tags) + (org-element-property :tags inlinetask)) + ;; contents and width + contents width inlinetask info))) + + +;;;; Italic + +(defun org-ascii-italic (italic contents info) + "Transcode italic from Org to ASCII. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "/%s/" contents)) + + +;;;; Item + +(defun org-ascii-item (item contents info) + "Transcode an ITEM element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (checkbox (org-ascii--checkbox item info)) + (list-type (org-element-property :type (org-export-get-parent item))) + (bullet + ;; First parent of ITEM is always the plain-list. Get + ;; `:type' property from it. + (org-list-bullet-string + (case list-type + (descriptive + (concat checkbox + (org-export-data (org-element-property :tag item) info) + ": ")) + (ordered + ;; Return correct number for ITEM, paying attention to + ;; counters. + (let* ((struct (org-element-property :structure item)) + (bul (org-element-property :bullet item)) + (num (number-to-string + (car (last (org-list-get-item-number + (org-element-property :begin item) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct))))))) + (replace-regexp-in-string "[0-9]+" num bul))) + (t (let ((bul (org-element-property :bullet item))) + ;; Change bullets into more visible form if UTF-8 is active. + (if (not utf8p) bul + (replace-regexp-in-string + "-" "•" + (replace-regexp-in-string + "+" "⁃" + (replace-regexp-in-string "*" "‣" bul)))))))))) + (concat + bullet + (unless (eq list-type 'descriptive) checkbox) + ;; Contents: Pay attention to indentation. Note: check-boxes are + ;; already taken care of at the paragraph level so they don't + ;; interfere with indentation. + (let ((contents (org-ascii--indent-string contents (length bullet)))) + (if (eq (org-element-type (car (org-element-contents item))) 'paragraph) + (org-trim contents) + (concat "\n" contents)))))) + + +;;;; Keyword + +(defun org-ascii-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "ASCII") value) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (org-ascii--build-toc + info (and (wholenump depth) depth) keyword))) + ((string= "tables" value) + (org-ascii--list-tables keyword info)) + ((string= "listings" value) + (org-ascii--list-listings keyword info)))))))) + + +;;;; Latex Environment + +(defun org-ascii-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (plist-get info :with-latex) + (org-remove-indentation (org-element-property :value latex-environment)))) + + +;;;; Latex Fragment + +(defun org-ascii-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) + + +;;;; Line Break + +(defun org-ascii-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual + information." hard-newline) + + +;;;; Link + +(defun org-ascii-link (link desc info) + "Transcode a LINK object from Org to ASCII. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information." + (let ((raw-link (org-element-property :raw-link link)) + (type (org-element-property :type link))) + (cond + ((string= type "coderef") + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref desc) + (org-export-resolve-coderef ref info)))) + ;; Do not apply a special syntax on radio links. Though, use + ;; transcoded target's contents as output. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (org-export-data (org-element-contents destination) info)))) + ;; Do not apply a special syntax on fuzzy links pointing to + ;; targets. + ((string= type "fuzzy") + (let ((destination (org-export-resolve-fuzzy-link link info))) + (if (org-string-nw-p desc) desc + (when destination + (let ((number + (org-export-get-ordinal + destination info nil 'org-ascii--has-caption-p))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) + (t + (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) + (concat + (format "[%s]" desc) + (unless org-ascii-links-to-notes (format " (%s)" raw-link)))))))) + + +;;;; Paragraph + +(defun org-ascii-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to ASCII. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let ((contents (if (not (wholenump org-ascii-indented-line-width)) contents + (concat + (make-string org-ascii-indented-line-width ? ) + (replace-regexp-in-string "\\`[ \t]+" "" contents))))) + (org-ascii--fill-string + contents (org-ascii--current-text-width paragraph info) info))) + + +;;;; Plain List + +(defun org-ascii-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to ASCII. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + contents) + + +;;;; Plain Text + +(defun org-ascii-plain-text (text info) + "Transcode a TEXT string from Org to ASCII. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (when (and utf8p (plist-get info :with-smart-quotes)) + (setq text (org-export-activate-smart-quotes text :utf-8 info))) + (if (not (plist-get info :with-special-strings)) text + (setq text (replace-regexp-in-string "\\\\-" "" text)) + (if (not utf8p) text + ;; Usual replacements in utf-8 with proper option set. + (replace-regexp-in-string + "\\.\\.\\." "…" + (replace-regexp-in-string + "--" "–" + (replace-regexp-in-string "---" "—" text))))))) + + +;;;; Planning + +(defun org-ascii-planning (planning contents info) + "Transcode a PLANNING element from Org to ASCII. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (mapconcat + 'identity + (delq nil + (list (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-translate-time + (org-element-property :raw-value closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-translate-time + (org-element-property :raw-value deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " " + (org-translate-time + (org-element-property :raw-value scheduled))))))) + " ")) + + +;;;; Quote Block + +(defun org-ascii-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-ascii--indent-string contents org-ascii-quote-margin)) + + +;;;; Quote Section + +(defun org-ascii-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((width (org-ascii--current-text-width quote-section info)) + (value + (org-export-data + (org-remove-indentation (org-element-property :value quote-section)) + info))) + (org-ascii--indent-string + value + (+ org-ascii-quote-margin + ;; Don't apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline quote-section))) + (if (org-export-low-level-p headline info) 0 + org-ascii-inner-margin)))))) + + +;;;; Radio Target + +(defun org-ascii-radio-target (radio-target contents info) + "Transcode a RADIO-TARGET object from Org to ASCII. +CONTENTS is the contents of the target. INFO is a plist holding +contextual information." + contents) + + +;;;; Section + +(defun org-ascii-section (section contents info) + "Transcode a SECTION element from Org to ASCII. +CONTENTS is the contents of the section. INFO is a plist holding +contextual information." + (org-ascii--indent-string + (concat + contents + (when org-ascii-links-to-notes + ;; Add list of links at the end of SECTION. + (let ((links (org-ascii--describe-links + (org-ascii--unique-links section info) + (org-ascii--current-text-width section info) info))) + ;; Separate list of links and section contents. + (when (org-string-nw-p links) (concat "\n\n" links))))) + ;; Do not apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline section))) + (if (or (not headline) (org-export-low-level-p headline info)) 0 + org-ascii-inner-margin)))) + + +;;;; Special Block + +(defun org-ascii-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Src Block + +(defun org-ascii-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let ((caption (org-ascii--build-caption src-block info)) + (code (org-export-format-code-default src-block info))) + (if (equal code "") "" + (concat + (when (and caption org-ascii-caption-above) (concat caption "\n")) + (org-ascii--box-string code info) + (when (and caption (not org-ascii-caption-above)) + (concat "\n" caption)))))) + + +;;;; Statistics Cookie + +(defun org-ascii-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;;; Subscript + +(defun org-ascii-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to ASCII. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (if (org-element-property :use-brackets-p subscript) + (format "_{%s}" contents) + (format "_%s" contents))) + + +;;;; Superscript + +(defun org-ascii-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to ASCII. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (if (org-element-property :use-brackets-p superscript) + (format "_{%s}" contents) + (format "_%s" contents))) + + +;;;; Strike-through + +(defun org-ascii-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to ASCII. +CONTENTS is text with strike-through markup. INFO is a plist +holding contextual information." + (format "+%s+" contents)) + + +;;;; Table + +(defun org-ascii-table (table contents info) + "Transcode a TABLE element from Org to ASCII. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (let ((caption (org-ascii--build-caption table info))) + (concat + ;; Possibly add a caption string above. + (when (and caption org-ascii-caption-above) (concat caption "\n")) + ;; Insert table. Note: "table.el" tables are left unmodified. + (cond ((eq (org-element-property :type table) 'org) contents) + ((and org-ascii-table-use-ascii-art + (eq (plist-get info :ascii-charset) 'utf-8) + (require 'ascii-art-to-unicode nil t)) + (with-temp-buffer + (insert (org-remove-indentation + (org-element-property :value table))) + (goto-char (point-min)) + (aa2u) + (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (buffer-substring (point-min) (point)))) + (t (org-remove-indentation (org-element-property :value table)))) + ;; Possible add a caption string below. + (and (not org-ascii-caption-above) caption)))) + + +;;;; Table Cell + +(defun org-ascii--table-cell-width (table-cell info) + "Return width of TABLE-CELL. + +INFO is a plist used as a communication channel. + +Width of a cell is determined either by a width cookie in the +same column as the cell, or by the maximum cell's length in that +column. + +When `org-ascii-table-widen-columns' is non-nil, width cookies +are ignored." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (col (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells))))) + (cache + (or (plist-get info :ascii-table-cell-width-cache) + (plist-get (setq info + (plist-put info :ascii-table-cell-width-cache + (make-hash-table :test 'equal))) + :ascii-table-cell-width-cache))) + (key (cons table col))) + (or (gethash key cache) + (puthash + key + (or (and (not org-ascii-table-widen-columns) + (org-export-table-cell-width table-cell info)) + (let* ((max-width 0)) + (org-element-map table 'table-row + (lambda (row) + (setq max-width + (max (length + (org-export-data + (org-element-contents + (elt (org-element-contents row) col)) + info)) + max-width))) + info) + max-width)) + cache)))) + +(defun org-ascii-table-cell (table-cell contents info) + "Transcode a TABLE-CELL object from Org to ASCII. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + ;; Determine column width. When `org-ascii-table-widen-columns' + ;; is nil and some width cookie has set it, use that value. + ;; Otherwise, compute the maximum width among transcoded data of + ;; each cell in the column. + (let ((width (org-ascii--table-cell-width table-cell info))) + ;; When contents are too large, truncate them. + (unless (or org-ascii-table-widen-columns (<= (length contents) width)) + (setq contents (concat (substring contents 0 (- width 2)) "=>"))) + ;; Align contents correctly within the cell. + (let* ((indent-tabs-mode nil) + (data + (when contents + (org-ascii--justify-string + contents width + (org-export-table-cell-alignment table-cell info))))) + (setq contents (concat data (make-string (- width (length data)) ? )))) + ;; Return cell. + (concat (format " %s " contents) + (when (memq 'right (org-export-table-cell-borders table-cell info)) + (if (eq (plist-get info :ascii-charset) 'utf-8) "│" "|"))))) + + +;;;; Table Row + +(defun org-ascii-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to ASCII. +CONTENTS is the row contents. INFO is a plist used as +a communication channel." + (when (eq (org-element-property :type table-row) 'standard) + (let ((build-hline + (function + (lambda (lcorner horiz vert rcorner) + (concat + (apply + 'concat + (org-element-map table-row 'table-cell + (lambda (cell) + (let ((width (org-ascii--table-cell-width cell info)) + (borders (org-export-table-cell-borders cell info))) + (concat + ;; In order to know if CELL starts the row, do + ;; not compare it with the first cell in the + ;; row as there might be a special column. + ;; Instead, compare it with first exportable + ;; cell, obtained with `org-element-map'. + (when (and (memq 'left borders) + (eq (org-element-map table-row 'table-cell + 'identity info t) + cell)) + lcorner) + (make-string (+ 2 width) (string-to-char horiz)) + (cond + ((not (memq 'right borders)) nil) + ((eq (car (last (org-element-contents table-row))) cell) + rcorner) + (t vert))))) + info)) "\n")))) + (utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (borders (org-export-table-cell-borders + (org-element-map table-row 'table-cell 'identity info t) + info))) + (concat (cond + ((and (memq 'top borders) (or utf8p (memq 'above borders))) + (if utf8p (funcall build-hline "┍" "━" "┯" "┑") + (funcall build-hline "+" "-" "+" "+"))) + ((memq 'above borders) + (if utf8p (funcall build-hline "├" "─" "┼" "┤") + (funcall build-hline "+" "-" "+" "+")))) + (when (memq 'left borders) (if utf8p "│" "|")) + contents "\n" + (when (and (memq 'bottom borders) (or utf8p (memq 'below borders))) + (if utf8p (funcall build-hline "┕" "━" "┷" "┙") + (funcall build-hline "+" "-" "+" "+"))))))) + + +;;;; Timestamp + +(defun org-ascii-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii-plain-text (org-timestamp-translate timestamp) info)) + + +;;;; Underline + +(defun org-ascii-underline (underline contents info) + "Transcode UNDERLINE from Org to ASCII. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-ascii-verbatim (verbatim contents info) + "Return a VERBATIM object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (format org-ascii-verbatim-format + (org-element-property :value verbatim))) + + +;;;; Verse Block + +(defun org-ascii-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to ASCII. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (let ((verse-width (org-ascii--current-text-width verse-block info))) + (org-ascii--indent-string + (org-ascii--justify-string contents verse-width 'left) + org-ascii-quote-margin))) + + + +;;; Filters + +(defun org-ascii-filter-headline-blank-lines (headline back-end info) + "Filter controlling number of blank lines after a headline. + +HEADLINE is a string representing a transcoded headline. +BACK-END is symbol specifying back-end used for export. INFO is +plist containing the communication channel. + +This function only applies to `ascii' back-end. See +`org-ascii-headline-spacing' for information." + (if (not org-ascii-headline-spacing) headline + (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))) + +(defun org-ascii-filter-paragraph-spacing (tree back-end info) + "Filter controlling number of blank lines between paragraphs. + +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel. + +See `org-ascii-paragraph-spacing' for information." + (when (wholenump org-ascii-paragraph-spacing) + (org-element-map tree 'paragraph + (lambda (p) + (when (eq (org-element-type (org-export-get-next-element p info)) + 'paragraph) + (org-element-put-property + p :post-blank org-ascii-paragraph-spacing))))) + tree) + +(defun org-ascii-filter-comment-spacing (tree backend info) + "Filter removing blank lines between comments. +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel." + (org-element-map tree '(comment comment-block) + (lambda (c) + (when (memq (org-element-type (org-export-get-next-element c info)) + '(comment comment-block)) + (org-element-put-property c :post-blank 0)))) + tree) + + + +;;; End-user functions + +;;;###autoload +(defun org-ascii-export-as-ascii + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ASCII Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'ascii "*Org ASCII Export*" + async subtreep visible-only body-only ext-plist (lambda () (text-mode)))) + +;;;###autoload +(defun org-ascii-export-to-ascii + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((file (org-export-output-file-name ".txt" subtreep))) + (org-export-to-file 'ascii file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-ascii-publish-to-ascii (plist filename pub-dir) + "Publish an Org file to ASCII. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-latin1 (plist filename pub-dir) + "Publish an Org file to Latin-1. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-utf8 (plist filename pub-dir) + "Publish an org file to UTF-8. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir)) + + +(provide 'ox-ascii) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; coding: utf-8-emacs +;; End: + +;;; ox-ascii.el ends here diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el new file mode 100644 index 00000000000..7fd70739b9f --- /dev/null +++ b/lisp/org/ox-beamer.el @@ -0,0 +1,1181 @@ +;;; ox-beamer.el --- Beamer Back-End for Org Export Engine + +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Nicolas Goaziou +;; Keywords: org, wp, tex + +;; 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 . + +;;; Commentary: +;; +;; This library implements both a Beamer back-end, derived from the +;; LaTeX one and a minor mode easing structure edition of the +;; document. See Org manual for more information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-latex) + +;; Install a default set-up for Beamer export. +(unless (assoc "beamer" org-latex-classes) + (add-to-list 'org-latex-classes + '("beamer" + "\\documentclass[presentation]{beamer} +\[DEFAULT-PACKAGES] +\[PACKAGES] +\[EXTRA]" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))) + + + +;;; User-Configurable Variables + +(defgroup org-export-beamer nil + "Options specific for using the beamer class in LaTeX export." + :tag "Org Beamer" + :group 'org-export + :version "24.2") + +(defcustom org-beamer-frame-level 1 + "The level at which headlines become frames. + +Headlines at a lower level will be translated into a sectioning +structure. At a higher level, they will be translated into +blocks. + +If a headline with a \"BEAMER_env\" property set to \"frame\" is +found within a tree, its level locally overrides this number. + +This variable has no effect on headlines with the \"BEAMER_env\" +property set to either \"ignoreheading\", \"appendix\", or +\"note\", which will respectively, be invisible, become an +appendix or a note. + +This integer is relative to the minimal level of a headline +within the parse tree, defined as 1." + :group 'org-export-beamer + :type 'integer) + +(defcustom org-beamer-frame-default-options "" + "Default options string to use for frames. +For example, it could be set to \"allowframebreaks\"." + :group 'org-export-beamer + :type '(string :tag "[options]")) + +(defcustom org-beamer-column-view-format + "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)" + "Column view format that should be used to fill the template." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not insert Beamer column view format" nil) + (string :tag "Beamer column view format"))) + +(defcustom org-beamer-theme "default" + "Default theme used in Beamer presentations." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not insert a Beamer theme" nil) + (string :tag "Beamer theme"))) + +(defcustom org-beamer-environments-extra nil + "Environments triggered by tags in Beamer export. +Each entry has 4 elements: + +name Name of the environment +key Selection key for `org-beamer-select-environment' +open The opening template for the environment, with the following escapes + %a the action/overlay specification + %A the default action/overlay specification + %o the options argument of the template + %h the headline text + %r the raw headline text (i.e. without any processing) + %H if there is headline text, that raw text in {} braces + %U if there is headline text, that raw text in [] brackets +close The closing string of the environment." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.1") + :type '(repeat + (list + (string :tag "Environment") + (string :tag "Selection key") + (string :tag "Begin") + (string :tag "End")))) + +(defcustom org-beamer-outline-frame-title "Outline" + "Default title of a frame containing an outline." + :group 'org-export-beamer + :type '(string :tag "Outline frame title")) + +(defcustom org-beamer-outline-frame-options "" + "Outline frame options appended after \\begin{frame}. +You might want to put e.g. \"allowframebreaks=0.9\" here." + :group 'org-export-beamer + :type '(string :tag "Outline frame options")) + + + +;;; Internal Variables + +(defconst org-beamer-column-widths + "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" +"The column widths that should be installed as allowed property values.") + +(defconst org-beamer-environments-special + '(("againframe" "A") + ("appendix" "x") + ("column" "c") + ("columns" "C") + ("frame" "f") + ("fullframe" "F") + ("ignoreheading" "i") + ("note" "n") + ("noteNH" "N")) + "Alist of environments treated in a special way by the back-end. +Keys are environment names, as strings, values are bindings used +in `org-beamer-select-environment'. Environments listed here, +along with their binding, are hard coded and cannot be modified +through `org-beamer-environments-extra' variable.") + +(defconst org-beamer-environments-default + '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}") + ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}") + ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}") + ("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}") + ("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}") + ("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}") + ("theorem" "t" "\\begin{theorem}%a%U" "\\end{theorem}") + ("definition" "d" "\\begin{definition}%a%U" "\\end{definition}") + ("example" "e" "\\begin{example}%a%U" "\\end{example}") + ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}") + ("proof" "p" "\\begin{proof}%a%U" "\\end{proof}") + ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}")) + "Environments triggered by properties in Beamer export. +These are the defaults - for user definitions, see +`org-beamer-environments-extra'.") + +(defconst org-beamer-verbatim-elements + '(code example-block fixed-width inline-src-block src-block verbatim) + "List of element or object types producing verbatim text. +This is used internally to determine when a frame should have the +\"fragile\" option.") + + + +;;; Internal functions + +(defun org-beamer--normalize-argument (argument type) + "Return ARGUMENT string with proper boundaries. + +TYPE is a symbol among the following: +`action' Return ARGUMENT within angular brackets. +`defaction' Return ARGUMENT within both square and angular brackets. +`option' Return ARGUMENT within square brackets." + (if (not (string-match "\\S-" argument)) "" + (case type + (action (if (string-match "\\`<.*>\\'" argument) argument + (format "<%s>" argument))) + (defaction (cond + ((string-match "\\`\\[<.*>\\]\\'" argument) argument) + ((string-match "\\`<.*>\\'" argument) + (format "[%s]" argument)) + ((string-match "\\`\\[\\(.*\\)\\]\\'" argument) + (format "[<%s>]" (match-string 1 argument))) + (t (format "[<%s>]" argument)))) + (option (if (string-match "\\`\\[.*\\]\\'" argument) argument + (format "[%s]" argument))) + (otherwise argument)))) + +(defun org-beamer--element-has-overlay-p (element) + "Non-nil when ELEMENT has an overlay specified. +An element has an overlay specification when it starts with an +`beamer' export-snippet whose value is between angular brackets. +Return overlay specification, as a string, or nil." + (let ((first-object (car (org-element-contents element)))) + (when (eq (org-element-type first-object) 'export-snippet) + (let ((value (org-element-property :value first-object))) + (and (string-match "\\`<.*>\\'" value) value))))) + + + +;;; Define Back-End + +(org-export-define-derived-backend 'beamer 'latex + :export-block "BEAMER" + :menu-entry + '(?l 1 + ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) + (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex) + (?P "As PDF file (Beamer)" org-beamer-export-to-pdf) + (?O "As PDF file and open (Beamer)" + (lambda (a s v b) + (if a (org-beamer-export-to-pdf t s v b) + (org-open-file (org-beamer-export-to-pdf nil s v b))))))) + :options-alist + '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme) + (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) + (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) + (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) + (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) + (:beamer-header-extra "BEAMER_HEADER" nil nil newline) + ;; Modify existing properties. + (:headline-levels nil "H" org-beamer-frame-level) + (:latex-class "LATEX_CLASS" nil "beamer" t)) + :translate-alist '((bold . org-beamer-bold) + (export-block . org-beamer-export-block) + (export-snippet . org-beamer-export-snippet) + (headline . org-beamer-headline) + (item . org-beamer-item) + (keyword . org-beamer-keyword) + (link . org-beamer-link) + (plain-list . org-beamer-plain-list) + (radio-target . org-beamer-radio-target) + (target . org-beamer-target) + (template . org-beamer-template))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-beamer-bold (bold contents info) + "Transcode BLOCK object into Beamer code. +CONTENTS is the text being bold. INFO is a plist used as +a communication channel." + (format "\\alert%s{%s}" + (or (org-beamer--element-has-overlay-p bold) "") + contents)) + + +;;;; Export Block + +(defun org-beamer-export-block (export-block contents info) + "Transcode an EXPORT-BLOCK element into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (when (member (org-element-property :type export-block) '("BEAMER" "LATEX")) + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Export Snippet + +(defun org-beamer-export-snippet (export-snippet contents info) + "Transcode an EXPORT-SNIPPET object into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((backend (org-export-snippet-backend export-snippet)) + (value (org-element-property :value export-snippet))) + ;; Only "latex" and "beamer" snippets are retained. + (cond ((eq backend 'latex) value) + ;; Ignore "beamer" snippets specifying overlays. + ((and (eq backend 'beamer) + (or (org-export-get-previous-element export-snippet info) + (not (string-match "\\`<.*>\\'" value)))) + value)))) + + +;;;; Headline +;; +;; The main function to translate a headline is +;; `org-beamer-headline'. +;; +;; Depending on the level at which a headline is considered as +;; a frame (given by `org-beamer--frame-level'), the headline is +;; either a section (`org-beamer--format-section'), a frame +;; (`org-beamer--format-frame') or a block +;; (`org-beamer--format-block'). +;; +;; `org-beamer-headline' also takes care of special environments +;; like "ignoreheading", "note", "noteNH", "appendix" and +;; "againframe". + +(defun org-beamer--get-label (headline info) + "Return label for HEADLINE, as a string. + +INFO is a plist used as a communication channel. + +The value is either the label specified in \"BEAMER_opt\" +property, or a fallback value built from headline's number. This +function assumes HEADLINE will be treated as a frame." + (let ((opt (org-element-property :BEAMER_OPT headline))) + (if (and (org-string-nw-p opt) + (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) + (match-string 1 opt) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))))) + +(defun org-beamer--frame-level (headline info) + "Return frame level in subtree containing HEADLINE. +INFO is a plist used as a communication channel." + (or + ;; 1. Look for "frame" environment in parents, starting from the + ;; farthest. + (catch 'exit + (mapc (lambda (parent) + (let ((env (org-element-property :BEAMER_ENV parent))) + (when (and env (member-ignore-case env '("frame" "fullframe"))) + (throw 'exit (org-export-get-relative-level parent info))))) + (nreverse (org-export-get-genealogy headline))) + nil) + ;; 2. Look for "frame" environment in HEADLINE. + (let ((env (org-element-property :BEAMER_ENV headline))) + (and env (member-ignore-case env '("frame" "fullframe")) + (org-export-get-relative-level headline info))) + ;; 3. Look for "frame" environment in sub-tree. + (org-element-map headline 'headline + (lambda (hl) + (let ((env (org-element-property :BEAMER_ENV hl))) + (when (and env (member-ignore-case env '("frame" "fullframe"))) + (org-export-get-relative-level hl info)))) + info 'first-match) + ;; 4. No "frame" environment in tree: use default value. + (plist-get info :headline-levels))) + +(defun org-beamer--format-section (headline contents info) + "Format HEADLINE as a sectioning part. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let ((latex-headline + (org-export-with-backend + ;; We create a temporary export back-end which behaves the + ;; same as current one, but adds "\protect" in front of the + ;; output of some objects. + (org-export-create-backend + :parent 'latex + :transcoders + (let ((protected-output + (function + (lambda (object contents info) + (let ((code (org-export-with-backend + 'beamer object contents info))) + (if (org-string-nw-p code) (concat "\\protect" code) + code)))))) + (mapcar #'(lambda (type) (cons type protected-output)) + '(bold footnote-reference italic strike-through timestamp + underline)))) + headline + contents + info)) + (mode-specs (org-element-property :BEAMER_ACT headline))) + (if (and mode-specs + (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{" + latex-headline)) + ;; Insert overlay specifications. + (replace-match (concat (match-string 1 latex-headline) + (format "<%s>" mode-specs)) + nil nil latex-headline 1) + latex-headline))) + +(defun org-beamer--format-frame (headline contents info) + "Format HEADLINE as a frame. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let ((fragilep + ;; FRAGILEP is non-nil when HEADLINE contains an element + ;; among `org-beamer-verbatim-elements'. + (org-element-map headline org-beamer-verbatim-elements 'identity + info 'first-match))) + (concat "\\begin{frame}" + ;; Overlay specification, if any. When surrounded by + ;; square brackets, consider it as a default + ;; specification. + (let ((action (org-element-property :BEAMER_ACT headline))) + (cond + ((not action) "") + ((string-match "\\`\\[.*\\]\\'" action ) + (org-beamer--normalize-argument action 'defaction)) + (t (org-beamer--normalize-argument action 'action)))) + ;; Options, if any. + (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) + (options + ;; Collect options from default value and headline's + ;; properties. Also add a label for links. + (append + (org-split-string org-beamer-frame-default-options ",") + (and beamer-opt + (org-split-string + ;; Remove square brackets if user provided + ;; them. + (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) + (match-string 1 beamer-opt)) + ",")) + ;; Provide an automatic label for the frame + ;; unless the user specified one. + (unless (and beamer-opt + (string-match "\\(^\\|,\\)label=" beamer-opt)) + (list + (format "label=%s" + (org-beamer--get-label headline info))))))) + ;; Change options list into a string. + (org-beamer--normalize-argument + (mapconcat + 'identity + (if (or (not fragilep) (member "fragile" options)) options + (cons "fragile" options)) + ",") + 'option)) + ;; Title. + (let ((env (org-element-property :BEAMER_ENV headline))) + (format "{%s}" + (if (and env (equal (downcase env) "fullframe")) "" + (org-export-data + (org-element-property :title headline) info)))) + "\n" + ;; The following workaround is required in fragile frames + ;; as Beamer will append "\par" to the beginning of the + ;; contents. So we need to make sure the command is + ;; separated from the contents by at least one space. If + ;; it isn't, it will create "\parfirst-word" command and + ;; remove the first word from the contents in the PDF + ;; output. + (if (not fragilep) contents + (replace-regexp-in-string "\\`\n*" "\\& " (or contents ""))) + "\\end{frame}"))) + +(defun org-beamer--format-block (headline contents info) + "Format HEADLINE as a block. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let* ((column-width (org-element-property :BEAMER_COL headline)) + ;; ENVIRONMENT defaults to "block" if none is specified and + ;; there is no column specification. If there is a column + ;; specified but still no explicit environment, ENVIRONMENT + ;; is "column". + (environment (let ((env (org-element-property :BEAMER_ENV headline))) + (cond + ;; "block" is the fallback environment. + ((and (not env) (not column-width)) "block") + ;; "column" only. + ((not env) "column") + ;; Use specified environment. + (t env)))) + (raw-title (org-element-property :raw-value headline)) + (env-format + (cond ((member environment '("column" "columns")) nil) + ((assoc environment + (append org-beamer-environments-extra + org-beamer-environments-default))) + (t (user-error "Wrong block type at a headline named \"%s\"" + raw-title)))) + (title (org-export-data (org-element-property :title headline) info)) + (options (let ((options (org-element-property :BEAMER_OPT headline))) + (if (not options) "" + (org-beamer--normalize-argument options 'option)))) + ;; Start a "columns" environment when explicitly requested or + ;; when there is no previous headline or the previous + ;; headline do not have a BEAMER_column property. + (parent-env (org-element-property + :BEAMER_ENV (org-export-get-parent-headline headline))) + (start-columns-p + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-first-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-previous-element + headline info))))))) + ;; End the "columns" environment when explicitly requested or + ;; when there is no next headline or the next headline do not + ;; have a BEAMER_column property. + (end-columns-p + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-last-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-next-element headline info)))))))) + (concat + (when start-columns-p + ;; Column can accept options only when the environment is + ;; explicitly defined. + (if (not (equal environment "columns")) "\\begin{columns}\n" + (format "\\begin{columns}%s\n" options))) + (when column-width + (format "\\begin{column}%s{%s}\n" + ;; One can specify placement for column only when + ;; HEADLINE stands for a column on its own. + (if (equal environment "column") options "") + (format "%s\\textwidth" column-width))) + ;; Block's opening string. + (when (nth 2 env-format) + (concat + (org-fill-template + (nth 2 env-format) + (nconc + ;; If BEAMER_act property has its value enclosed in square + ;; brackets, it is a default overlay specification and + ;; overlay specification is empty. Otherwise, it is an + ;; overlay specification and the default one is nil. + (let ((action (org-element-property :BEAMER_ACT headline))) + (cond + ((not action) (list (cons "a" "") (cons "A" ""))) + ((string-match "\\`\\[.*\\]\\'" action) + (list + (cons "A" (org-beamer--normalize-argument action 'defaction)) + (cons "a" ""))) + (t + (list (cons "a" (org-beamer--normalize-argument action 'action)) + (cons "A" ""))))) + (list (cons "o" options) + (cons "h" title) + (cons "r" raw-title) + (cons "H" (if (equal raw-title "") "" + (format "{%s}" raw-title))) + (cons "U" (if (equal raw-title "") "" + (format "[%s]" raw-title)))))) + "\n")) + contents + ;; Block's closing string, if any. + (and (nth 3 env-format) (concat (nth 3 env-format) "\n")) + (when column-width "\\end{column}\n") + (when end-columns-p "\\end{columns}")))) + +(defun org-beamer-headline (headline contents info) + "Transcode HEADLINE element into Beamer code. +CONTENTS is the contents of the headline. INFO is a plist used +as a communication channel." + (unless (org-element-property :footnote-section-p headline) + (let ((level (org-export-get-relative-level headline info)) + (frame-level (org-beamer--frame-level headline info)) + (environment (let ((env (org-element-property :BEAMER_ENV headline))) + (or (org-string-nw-p env) "block")))) + (cond + ;; Case 1: Resume frame specified by "BEAMER_ref" property. + ((equal environment "againframe") + (let ((ref (org-element-property :BEAMER_REF headline))) + ;; Reference to frame being resumed is mandatory. Ignore + ;; the whole headline if it isn't provided. + (when (org-string-nw-p ref) + (concat "\\againframe" + ;; Overlay specification. + (let ((overlay (org-element-property :BEAMER_ACT headline))) + (when overlay + (org-beamer--normalize-argument + overlay + (if (string-match "^\\[.*\\]$" overlay) 'defaction + 'action)))) + ;; Options. + (let ((options (org-element-property :BEAMER_OPT headline))) + (when options + (org-beamer--normalize-argument options 'option))) + ;; Resolve reference provided by "BEAMER_ref" + ;; property. This is done by building a minimal fake + ;; link and calling the appropriate resolve function, + ;; depending on the reference syntax. + (let* ((type + (progn + (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) + (cond + ((or (not (match-string 1 ref)) + (equal (match-string 1 ref) "*")) 'fuzzy) + ((equal (match-string 1 ref) "id:") 'id) + (t 'custom-id)))) + (link (list 'link (list :path (match-string 2 ref)))) + (target (if (eq type 'fuzzy) + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + ;; Now use user-defined label provided in TARGET + ;; headline, or fallback to standard one. + (format "{%s}" (org-beamer--get-label target info))))))) + ;; Case 2: Creation of an appendix is requested. + ((equal environment "appendix") + (concat "\\appendix" + (org-element-property :BEAMER_ACT headline) + "\n" + (make-string (org-element-property :pre-blank headline) ?\n) + contents)) + ;; Case 3: Ignore heading. + ((equal environment "ignoreheading") + (concat (make-string (org-element-property :pre-blank headline) ?\n) + contents)) + ;; Case 4: HEADLINE is a note. + ((member environment '("note" "noteNH")) + (format "\\note{%s}" + (concat (and (equal environment "note") + (concat + (org-export-data + (org-element-property :title headline) info) + "\n")) + (org-trim contents)))) + ;; Case 5: HEADLINE is a frame. + ((= level frame-level) + (org-beamer--format-frame headline contents info)) + ;; Case 6: Regular section, extracted from + ;; `org-latex-classes'. + ((< level frame-level) + (org-beamer--format-section headline contents info)) + ;; Case 7: Otherwise, HEADLINE is a block. + (t (org-beamer--format-block headline contents info)))))) + + +;;;; Item + +(defun org-beamer-item (item contents info) + "Transcode an ITEM element into Beamer code. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let ((action (let ((first-element (car (org-element-contents item)))) + (and (eq (org-element-type first-element) 'paragraph) + (org-beamer--element-has-overlay-p first-element)))) + (output (org-export-with-backend 'latex item contents info))) + (if (not action) output + ;; If the item starts with a paragraph and that paragraph starts + ;; with an export snippet specifying an overlay, insert it after + ;; \item command. + (replace-regexp-in-string "\\\\item" (concat "\\\\item" action) output)))) + + +;;;; Keyword + +(defun org-beamer-keyword (keyword contents info) + "Transcode a KEYWORD element into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + ;; Handle specifically BEAMER and TOC (headlines only) keywords. + ;; Otherwise, fallback to `latex' back-end. + (cond + ((equal key "BEAMER") value) + ((and (equal key "TOC") (string-match "\\" value)) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc))) + (options (and (string-match "\\[.*?\\]" value) + (match-string 0 value)))) + (concat + (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents" options))) + (t (org-export-with-backend 'latex keyword contents info))))) + + +;;;; Link + +(defun org-beamer-link (link contents info) + "Transcode a LINK object into Beamer code. +CONTENTS is the description part of the link. INFO is a plist +used as a communication channel." + (let ((type (org-element-property :type link)) + (path (org-element-property :path link))) + ;; Use \hyperlink command for all internal links. + (cond + ((equal type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + (org-export-solidify-link-text path) + (org-export-data (org-element-contents destination) info))))) + ((and (member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + (headline + (let ((label + (format "sec-%s" + (mapconcat + 'number-to-string + (org-export-get-headline-number + destination info) + "-")))) + (if (and (plist-get info :section-numbers) (not contents)) + (format "\\ref{%s}" label) + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + label + contents)))) + (target + (let ((path (org-export-solidify-link-text path))) + (if (not contents) (format "\\ref{%s}" path) + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + path + contents)))))))) + ;; Otherwise, use `latex' back-end. + (t (org-export-with-backend 'latex link contents info))))) + + +;;;; Plain List +;; +;; Plain lists support `:environment', `:overlay' and `:options' +;; attributes. + +(defun org-beamer-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element into Beamer code. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attributes (org-combine-plists + (org-export-read-attribute :attr_latex plain-list) + (org-export-read-attribute :attr_beamer plain-list))) + (latex-type (let ((env (plist-get attributes :environment))) + (cond (env) + ((eq type 'ordered) "enumerate") + ((eq type 'descriptive) "description") + (t "itemize"))))) + (org-latex--wrap-label + plain-list + (format "\\begin{%s}%s%s\n%s\\end{%s}" + latex-type + ;; Default overlay specification, if any. + (org-beamer--normalize-argument + (or (plist-get attributes :overlay) "") + 'defaction) + ;; Second optional argument depends on the list type. + (org-beamer--normalize-argument + (or (plist-get attributes :options) "") + 'option) + ;; Eventually insert contents and close environment. + contents + latex-type)))) + + +;;;; Radio Target + +(defun org-beamer-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object into Beamer code. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "\\hypertarget%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p radio-target) "") + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + + +;;;; Target + +(defun org-beamer-target (target contents info) + "Transcode a TARGET object into Beamer code. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\hypertarget{%s}{}" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;;; Template +;; +;; Template used is similar to the one used in `latex' back-end, +;; excepted for the table of contents and Beamer themes. + +(defun org-beamer-template (contents info) + "Return complete document string after Beamer conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info))) + (concat + ;; 1. Time-stamp. + (and (plist-get info :time-stamp-file) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; 2. Document class and packages. + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (org-element-normalize-string + (plist-get info :latex-header-extra)) + (plist-get info :beamer-header-extra))))) + info))) + ;; 3. Insert themes. + (let ((format-theme + (function + (lambda (prop command) + (let ((theme (plist-get info prop))) + (when theme + (concat command + (if (not (string-match "\\[.*\\]" theme)) + (format "{%s}\n" theme) + (format "%s{%s}\n" + (match-string 0 theme) + (org-trim + (replace-match "" nil nil theme))))))))))) + (mapconcat (lambda (args) (apply format-theme args)) + '((:beamer-theme "\\usetheme") + (:beamer-color-theme "\\usecolortheme") + (:beamer-font-theme "\\usefonttheme") + (:beamer-inner-theme "\\useinnertheme") + (:beamer-outer-theme "\\useoutertheme")) + "")) + ;; 4. Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; 5. Author. + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info)))) + (cond ((and author email (not (string= "" email))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + (author (format "\\author{%s}\n" author)) + (t "\\author{}\n"))) + ;; 6. Date. + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) + ;; 7. Title + (format "\\title{%s}\n" title) + ;; 8. Hyperref options. + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) + ;; 9. Document start. + "\\begin{document}\n\n" + ;; 10. Title command. + (org-element-normalize-string + (cond ((string= "" title) nil) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) + ;; 11. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (format "\\begin{frame}%s{%s}\n" + (org-beamer--normalize-argument + org-beamer-outline-frame-options 'option) + org-beamer-outline-frame-title) + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + "\\tableofcontents\n" + "\\end{frame}\n\n"))) + ;; 12. Document's body. + contents + ;; 13. Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; 14. Document end. + "\\end{document}"))) + + + +;;; Minor Mode + + +(defvar org-beamer-mode-map (make-sparse-keymap) + "The keymap for `org-beamer-mode'.") +(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) + +;;;###autoload +(define-minor-mode org-beamer-mode + "Support for editing Beamer oriented Org mode files." + nil " Bm" 'org-beamer-mode-map) + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords + 'org-mode + '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) + 'prepend)) + +(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) + "The special face for beamer tags." + :group 'org-export-beamer) + +(defun org-beamer-property-changed (property value) + "Track the BEAMER_env property with tags. +PROPERTY is the name of the modified property. VALUE is its new +value." + (cond + ((equal property "BEAMER_env") + (save-excursion + (org-back-to-heading t) + ;; Filter out Beamer-related tags and install environment tag. + (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) + (org-get-tags))) + (env-tag (and (org-string-nw-p value) (concat "B_" value)))) + (org-set-tags-to (if env-tag (cons env-tag tags) tags)) + (when env-tag (org-toggle-tag env-tag 'on))))) + ((equal property "BEAMER_col") + (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off))))) + +(add-hook 'org-property-changed-functions 'org-beamer-property-changed) + +(defun org-beamer-allowed-property-values (property) + "Supply allowed values for PROPERTY." + (cond + ((and (equal property "BEAMER_env") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_env have been defined, + ;; supply all defined environments + (mapcar 'car (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default))) + ((and (equal property "BEAMER_col") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_col have been defined, + ;; supply some + (org-split-string org-beamer-column-widths " ")))) + +(add-hook 'org-property-allowed-value-functions + 'org-beamer-allowed-property-values) + + + +;;; Commands + +;;;###autoload +(defun org-beamer-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org BEAMER Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'beamer "*Org BEAMER Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +;;;###autoload +(defun org-beamer-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer presentation (tex). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-beamer-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer presentation (PDF). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +;;;###autoload +(defun org-beamer-select-environment () + "Select the environment to be used by beamer for this entry. +While this uses (for convenience) a tag selection interface, the +result of this command will be that the BEAMER_env *property* of +the entry is set. + +In addition to this, the command will also set a tag as a visual +aid, but the tag does not have any semantic meaning." + (interactive) + ;; Make sure `org-beamer-environments-special' has a higher + ;; priority than `org-beamer-environments-extra'. + (let* ((envs (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default)) + (org-tag-alist + (append '((:startgroup)) + (mapcar (lambda (e) (cons (concat "B_" (car e)) + (string-to-char (nth 1 e)))) + envs) + '((:endgroup)) + '(("BMCOL" . ?|)))) + (org-fast-tag-selection-single-key t)) + (org-set-tags) + (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) + (cond + ;; For a column, automatically ask for its width. + ((eq org-last-tag-selection-key ?|) + (if (string-match ":BMCOL:" tags) + (org-set-property "BEAMER_col" (read-string "Column width: ")) + (org-delete-property "BEAMER_col"))) + ;; For an "againframe" section, automatically ask for reference + ;; to resumed frame and overlay specifications. + ((eq org-last-tag-selection-key ?A) + (if (equal (org-entry-get nil "BEAMER_env") "againframe") + (progn (org-entry-delete nil "BEAMER_env") + (org-entry-delete nil "BEAMER_ref") + (org-entry-delete nil "BEAMER_act")) + (org-entry-put nil "BEAMER_env" "againframe") + (org-set-property + "BEAMER_ref" + (read-string "Frame reference (*Title, #custom-id, id:...): ")) + (org-set-property "BEAMER_act" + (read-string "Overlay specification: ")))) + ((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags) + (org-entry-put nil "BEAMER_env" (match-string 1 tags))) + (t (org-entry-delete nil "BEAMER_env")))))) + +;;;###autoload +(defun org-beamer-insert-options-template (&optional kind) + "Insert a settings template, to make sure users do this right." + (interactive (progn + (message "Current [s]ubtree or [g]lobal?") + (if (eq (read-char-exclusive) ?g) (list 'global) + (list 'subtree)))) + (if (eq kind 'subtree) + (progn + (org-back-to-heading t) + (org-reveal) + (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer") + (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]") + (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") + (when org-beamer-column-view-format + (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) + (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths)) + (insert "#+LaTeX_CLASS: beamer\n") + (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") + (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n")) + (when org-beamer-column-view-format + (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) + (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n"))) + +;;;###autoload +(defun org-beamer-publish-to-latex (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'beamer filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-beamer-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (PDF, via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in + ;; working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile (org-publish-org-to 'beamer filename ".tex" plist)) + pub-dir)) + + +(provide 'ox-beamer) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-beamer.el ends here diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el new file mode 100644 index 00000000000..d5e4b7876b7 --- /dev/null +++ b/lisp/org/ox-html.el @@ -0,0 +1,3450 @@ +;;; ox-html.el --- HTML Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Jambunathan K +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: + +;; This library implements a HTML back-end for Org generic exporter. +;; See Org manual for more information. + +;;; Code: + +;;; Dependencies + +(require 'ox) +(require 'ox-publish) +(require 'format-spec) +(eval-when-compile (require 'cl) (require 'table nil 'noerror)) + + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function htmlize-region "ext:htmlize" (beg end)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) +(declare-function mm-url-decode-entities "mm-url" ()) + +;;; Define Back-End + +(org-export-define-backend 'html + '((bold . org-html-bold) + (center-block . org-html-center-block) + (clock . org-html-clock) + (code . org-html-code) + (drawer . org-html-drawer) + (dynamic-block . org-html-dynamic-block) + (entity . org-html-entity) + (example-block . org-html-example-block) + (export-block . org-html-export-block) + (export-snippet . org-html-export-snippet) + (fixed-width . org-html-fixed-width) + (footnote-definition . org-html-footnote-definition) + (footnote-reference . org-html-footnote-reference) + (headline . org-html-headline) + (horizontal-rule . org-html-horizontal-rule) + (inline-src-block . org-html-inline-src-block) + (inlinetask . org-html-inlinetask) + (inner-template . org-html-inner-template) + (italic . org-html-italic) + (item . org-html-item) + (keyword . org-html-keyword) + (latex-environment . org-html-latex-environment) + (latex-fragment . org-html-latex-fragment) + (line-break . org-html-line-break) + (link . org-html-link) + (paragraph . org-html-paragraph) + (plain-list . org-html-plain-list) + (plain-text . org-html-plain-text) + (planning . org-html-planning) + (property-drawer . org-html-property-drawer) + (quote-block . org-html-quote-block) + (quote-section . org-html-quote-section) + (radio-target . org-html-radio-target) + (section . org-html-section) + (special-block . org-html-special-block) + (src-block . org-html-src-block) + (statistics-cookie . org-html-statistics-cookie) + (strike-through . org-html-strike-through) + (subscript . org-html-subscript) + (superscript . org-html-superscript) + (table . org-html-table) + (table-cell . org-html-table-cell) + (table-row . org-html-table-row) + (target . org-html-target) + (template . org-html-template) + (timestamp . org-html-timestamp) + (underline . org-html-underline) + (verbatim . org-html-verbatim) + (verse-block . org-html-verse-block)) + :export-block "HTML" + :filters-alist '((:filter-options . org-html-infojs-install-script) + (:filter-final-output . org-html-final-function)) + :menu-entry + '(?h "Export to HTML" + ((?H "As HTML buffer" org-html-export-as-html) + (?h "As HTML file" org-html-export-to-html) + (?o "As HTML file and open" + (lambda (a s v b) + (if a (org-html-export-to-html t s v b) + (org-open-file (org-html-export-to-html nil s v b))))))) + :options-alist + '((:html-extension nil nil org-html-extension) + (:html-link-org-as-html nil nil org-html-link-org-files-as-html) + (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) + (:html-container "HTML_CONTAINER" nil org-html-container-element) + (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) + (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) + (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) + (:html-link-up "HTML_LINK_UP" nil org-html-link-up) + (:html-mathjax "HTML_MATHJAX" nil "" space) + (:html-postamble nil "html-postamble" org-html-postamble) + (:html-preamble nil "html-preamble" org-html-preamble) + (:html-head "HTML_HEAD" nil org-html-head newline) + (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) + (:html-head-include-default-style nil "html-style" org-html-head-include-default-style) + (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts) + (:html-table-attributes nil nil org-html-table-default-attributes) + (:html-table-row-tags nil nil org-html-table-row-tags) + (:html-xml-declaration nil nil org-html-xml-declaration) + (:html-inline-images nil nil org-html-inline-images) + (:infojs-opt "INFOJS_OPT" nil nil) + ;; Redefine regular options. + (:creator "CREATOR" nil org-html-creator-string) + (:with-latex nil "tex" org-html-with-latex) + ;; Retrieve LaTeX header for fragments. + (:latex-header "LATEX_HEADER" nil nil newline))) + + +;;; Internal Variables + +(defvar org-html-format-table-no-css) +(defvar htmlize-buffer-places) ; from htmlize.el + +(defvar org-html--pre/postamble-class "status" + "CSS class used for pre/postamble") + +(defconst org-html-doctype-alist + '(("html4-strict" . "") + ("html4-transitional" . "") + ("html4-frameset" . "") + + ("xhtml-strict" . "") + ("xhtml-transitional" . "") + ("xhtml-frameset" . "") + ("xhtml-11" . "") + + ("html5" . "") + ("xhtml5" . "")) + "An alist mapping (x)html flavors to specific doctypes.") + +(defconst org-html-html5-elements + '("article" "aside" "audio" "canvas" "details" "figcaption" + "figure" "footer" "header" "menu" "meter" "nav" "output" + "progress" "section" "video") + "New elements in html5. + +
    is not included because it's currently impossible to +wrap special blocks around multiple headlines. For other blocks +that should contain headlines, use the HTML_CONTAINER property on +the headline itself.") + +(defconst org-html-special-string-regexps + '(("\\\\-" . "­") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-html-scripts + "" + "Basic JavaScript that is needed by HTML files produced by Org mode.") + +(defconst org-html-style-default + "" + "The default style specification for exported HTML files. +You can use `org-html-head' and `org-html-head-extra' to add to +this style. If you don't want to include this default style, +customize `org-html-head-include-default-style'.") + + +;;; User Configuration Variables + +(defgroup org-export-html nil + "Options for exporting Org mode files to HTML." + :tag "Org Export HTML" + :group 'org-export) + +;;;; Handle infojs + +(defvar org-html-infojs-opts-table + '((path PATH "http://orgmode.org/org-info.js") + (view VIEW "info") + (toc TOC :with-toc) + (ftoc FIXED_TOC "0") + (tdepth TOC_DEPTH "max") + (sdepth SECTION_DEPTH "max") + (mouse MOUSE_HINT "underline") + (buttons VIEW_BUTTONS "0") + (ltoc LOCAL_TOC "1") + (up LINK_UP :html-link-up) + (home LINK_HOME :html-link-home)) + "JavaScript options, long form for script, default values.") + +(defcustom org-html-use-infojs 'when-configured + "Non-nil when Sebastian Rose's Java Script org-info.js should be active. +This option can be nil or t to never or always use the script. +It can also be the symbol `when-configured', meaning that the +script will be linked into the export file if and only if there +is a \"#+INFOJS_OPT:\" line in the buffer. See also the variable +`org-html-infojs-options'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Never" nil) + (const :tag "When configured in buffer" when-configured) + (const :tag "Always" t))) + +(defcustom org-html-infojs-options + (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table) + "Options settings for the INFOJS JavaScript. +Each of the options must have an entry in `org-html-infojs-opts-table'. +The value can either be a string that will be passed to the script, or +a property. This property is then assumed to be a property that is defined +by the Export/Publishing setup of Org. +The `sdepth' and `tdepth' parameters can also be set to \"max\", which +means to use the maximum value consistent with other options." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type + `(set :greedy t :inline t + ,@(mapcar + (lambda (x) + (list 'cons (list 'const (car x)) + '(choice + (symbol :tag "Publishing/Export property") + (string :tag "Value")))) + org-html-infojs-opts-table))) + +(defcustom org-html-infojs-template + " + +" + "The template for the export style additions when org-info.js is used. +Option settings will replace the %MANAGER-OPTIONS cookie." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defun org-html-infojs-install-script (exp-plist backend) + "Install script in export options when appropriate. +EXP-PLIST is a plist containing export options. BACKEND is the +export back-end currently used." + (unless (or (memq 'body-only (plist-get exp-plist :export-options)) + (not org-html-use-infojs) + (and (eq org-html-use-infojs 'when-configured) + (or (not (plist-get exp-plist :infojs-opt)) + (string-match "\\" + (plist-get exp-plist :infojs-opt))))) + (let* ((template org-html-infojs-template) + (ptoc (plist-get exp-plist :with-toc)) + (hlevels (plist-get exp-plist :headline-levels)) + (sdepth hlevels) + (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels)) + (options (plist-get exp-plist :infojs-opt)) + (table org-html-infojs-opts-table) + style) + (dolist (entry table) + (let* ((opt (car entry)) + (var (nth 1 entry)) + ;; Compute default values for script option OPT from + ;; `org-html-infojs-options' variable. + (default + (let ((default (cdr (assq opt org-html-infojs-options)))) + (if (and (symbolp default) (not (memq default '(t nil)))) + (plist-get exp-plist default) + default))) + ;; Value set through INFOJS_OPT keyword has precedence + ;; over the default one. + (val (if (and options + (string-match (format "\\<%s:\\(\\S-+\\)" opt) + options)) + (match-string 1 options) + default))) + (case opt + (path (setq template + (replace-regexp-in-string + "%SCRIPT_PATH" val template t t))) + (sdepth (when (integerp (read val)) + (setq sdepth (min (read val) sdepth)))) + (tdepth (when (integerp (read val)) + (setq tdepth (min (read val) tdepth)))) + (otherwise (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) style))))) + ;; Now we set the depth of the *generated* TOC to SDEPTH, + ;; because the toc will actually determine the splitting. How + ;; much of the toc will actually be displayed is governed by the + ;; TDEPTH option. + (setq exp-plist (plist-put exp-plist :with-toc sdepth)) + ;; The table of contents should not show more sections than we + ;; generate. + (setq tdepth (min tdepth sdepth)) + (push (cons "TOC_DEPTH" tdepth) style) + ;; Build style string. + (setq style (mapconcat + (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) + (cdr x))) + style "\n")) + (when (and style (> (length style) 0)) + (and (string-match "%MANAGER_OPTIONS" template) + (setq style (replace-match style t t template)) + (setq exp-plist + (plist-put + exp-plist :html-head-extra + (concat (or (plist-get exp-plist :html-head-extra) "") + "\n" + style))))) + ;; This script absolutely needs the table of contents, so we + ;; change that setting. + (unless (plist-get exp-plist :with-toc) + (setq exp-plist (plist-put exp-plist :with-toc t))) + ;; Return the modified property list. + exp-plist))) + +;;;; Bold, etc. + +(defcustom org-html-text-markup-alist + '((bold . "%s") + (code . "%s") + (italic . "%s") + (strike-through . "%s") + (underline . "%s") + (verbatim . "%s")) + "Alist of HTML expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (symbol :tag "Markup type") + :value-type (string :tag "Format string")) + :options '(bold code italic strike-through underline verbatim)) + +(defcustom org-html-indent nil + "Non-nil means to indent the generated HTML. +Warning: non-nil may break indentation of source code blocks." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-html-use-unicode-chars nil + "Non-nil means to use unicode characters instead of HTML entities." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Drawers + +(defcustom org-html-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in HTML code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +The default value simply returns the value of CONTENTS." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; Footnotes + +(defcustom org-html-footnotes-section "
    +

    %s:

    +
    +%s +
    +
    " + "Format for the footnotes section. +Should contain a two instances of %s. The first will be replaced with the +language-specific word for \"Footnotes\", the second one will be replaced +by the footnotes themselves." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-format "%s" + "The format for the footnote reference. +%s will be replaced by the footnote reference itself." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-separator ", " + "Text used to separate footnotes." + :group 'org-export-html + :type 'string) + +;;;; Headline + +(defcustom org-html-toplevel-hlevel 2 + "The level for level 1 headings in HTML export. +This is also important for the classes that will be wrapped around headlines +and outline structure. If this variable is 1, the top-level headlines will +be

    , and the corresponding classes will be outline-1, section-number-1, +and outline-text-1. If this is 2, all of these will get a 2 instead. +The default for this variable is 2, because we use

    for formatting the +document title." + :group 'org-export-html + :type 'integer) + +(defcustom org-html-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags (string or nil). + +The function result will be used in the section format string." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; HTML-specific + +(defcustom org-html-allow-name-attribute-in-anchors t + "When nil, do not set \"name\" attribute in anchors. +By default, anchors are formatted with both \"id\" and \"name\" +attributes, when appropriate." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Inlinetasks + +(defcustom org-html-format-inlinetask-function 'ignore + "Function called to format an inlinetask in HTML code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; LaTeX + +(defcustom org-html-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + +;;;; Links :: Generic + +(defcustom org-html-link-org-files-as-html t + "Non-nil means make file links to `file.org' point to `file.html'. +When `org-mode' is exporting an `org-mode' file to HTML, links to +non-html files are directly put into a href tag in HTML. +However, links to other Org-mode files (recognized by the +extension `.org.) should become links to the corresponding html +file, assuming that the linked `org-mode' file will also be +converted to HTML. +When nil, the links still point to the plain `.org' file." + :group 'org-export-html + :type 'boolean) + +;;;; Links :: Inline images + +(defcustom org-html-inline-images t + "Non-nil means inline images into exported HTML pages. +This is done using an tag. When nil, an anchor with href is used to +link to the image." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + +(defcustom org-html-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) + "Rules characterizing image files that can be inlined into HTML. +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +;;;; Plain Text + +(defcustom org-html-protect-char-alist + '(("&" . "&") + ("<" . "<") + (">" . ">")) + "Alist of characters to be converted by `org-html-protect'." + :group 'org-export-html + :type '(repeat (cons (string :tag "Character") + (string :tag "HTML equivalent")))) + +;;;; Src Block + +(defcustom org-html-htmlize-output-type 'inline-css + "Output type to be used by htmlize when formatting code snippets. +Choices are `css', to export the CSS selectors only, or `inline-css', to +export the CSS attribute values inline in the HTML. We use as default +`inline-css', in order to make the resulting HTML self-containing. + +However, this will fail when using Emacs in batch mode for export, because +then no rich font definitions are in place. It will also not be good if +people with different Emacs setup contribute HTML files to a website, +because the fonts will represent the individual setups. In these cases, +it is much better to let Org/Htmlize assign classes only, and to use +a style file to define the look of these classes. +To get a start for your css file, start Emacs session and make sure that +all the faces you are interested in are defined, for example by loading files +in all modes you want. Then, use the command +\\[org-html-htmlize-generate-css] to extract class definitions." + :group 'org-export-html + :type '(choice (const css) (const inline-css))) + +(defcustom org-html-htmlize-font-prefix "org-" + "The prefix for CSS class names for htmlize font specifications." + :group 'org-export-html + :type 'string) + +;;;; Table + +(defcustom org-html-table-default-attributes + '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides") + "Default attributes and values which will be used in table tags. +This is a plist where attributes are symbols, starting with +colons, and values are strings. + +When exporting to HTML5, these values will be disregarded." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(plist :key-type (symbol :tag "Property") + :value-type (string :tag "Value"))) + +(defcustom org-html-table-header-tags '("" . "") + "The opening tag for table header fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-use-header-tags-for-first-column'. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-data-tags '("" . "") + "The opening tag for table data fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-row-tags '("" . "") + "The opening and ending tags for table rows. +This is customizable so that alignment options can be specified. +Instead of strings, these can be Lisp forms that will be +evaluated for each row in order to construct the table row tags. + +During evaluation, these variables will be dynamically bound so that +you can reuse them: + + `row-number': row number (0 is the first row) + `rowgroup-number': group number of current row + `start-rowgroup-p': non-nil means the row starts a group + `end-rowgroup-p': non-nil means the row ends a group + `top-row-p': non-nil means this is the top row + `bottom-row-p': non-nil means this is the bottom row + +For example: + +\(setq org-html-table-row-tags + (cons '(cond (top-row-p \"\") + (bottom-row-p \"\") + (t (if (= (mod row-number 2) 1) + \"\" + \"\"))) + \"\")) + +will use the \"tr-top\" and \"tr-bottom\" classes for the top row +and the bottom row, and otherwise alternate between \"tr-odd\" and +\"tr-even\" for odd and even rows." + :group 'org-export-html + :type '(cons + (choice :tag "Opening tag" + (string :tag "Specify") + (sexp)) + (choice :tag "Closing tag" + (string :tag "Specify") + (sexp)))) + +(defcustom org-html-table-align-individual-fields t + "Non-nil means attach style attributes for alignment to each table field. +When nil, alignment will only be specified in the column tags, but this +is ignored by some browsers (like Firefox, Safari). Opera does it right +though." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-use-header-tags-for-first-column nil + "Non-nil means format column one in tables with header tags. +When nil, also column one will use data tags." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-html + :type 'boolean) + +;;;; Tags + +(defcustom org-html-tag-class-prefix "" + "Prefix to class names for TODO keywords. +Each tag gets a class given by the tag itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + +;;;; Template :: Generic + +(defcustom org-html-extension "html" + "The extension for exported HTML files." + :group 'org-export-html + :type 'string) + +(defcustom org-html-xml-declaration + '(("html" . "") + ("php" . "\"; ?>")) + "The extension for exported HTML files. +%s will be replaced with the charset of the exported file. +This may be a string, or an alist with export extensions +and corresponding declarations. + +This declaration only applies when exporting to XHTML." + :group 'org-export-html + :type '(choice + (string :tag "Single declaration") + (repeat :tag "Dependent on extension" + (cons (string :tag "Extension") + (string :tag "Declaration"))))) + +(defcustom org-html-coding-system 'utf-8 + "Coding system for HTML export. +Use utf-8 as the default value." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-html-doctype "xhtml-strict" + "Document type definition to use for exported HTML files. +Can be set with the in-buffer HTML_DOCTYPE property or for +publishing, with :html-doctype." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-html5-fancy nil + "Non-nil means using new HTML5 elements. +This variable is ignored for anything other than HTML5 export. + +For compatibility with Internet Explorer, it's probably a good +idea to download some form of the html5shiv (for instance +https://code.google.com/p/html5shiv/) and add it to your +HTML_HEAD_EXTRA, so that your pages don't break for users of IE +versions 8 and below." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-html-container-element "div" + "HTML element to use for wrapping top level sections. +Can be set with the in-buffer HTML_CONTAINER property or for +publishing, with :html-container. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-divs + '((preamble "div" "preamble") + (content "div" "content") + (postamble "div" "postamble")) + "Alist of the three section elements for HTML export. +The car of each entry is one of 'preamble, 'content or 'postamble. +The cdrs of each entry are the ELEMENT_TYPE and ID for each +section of the exported document. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(list :greedy t + (list :tag "Preamble" + (const :format "" preamble) + (string :tag "element") (string :tag " id")) + (list :tag "Content" + (const :format "" content) + (string :tag "element") (string :tag " id")) + (list :tag "Postamble" (const :format "" postamble) + (string :tag " id") (string :tag "element")))) + +(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M" + "Format used for timestamps in preamble, postamble and metadata. +See `format-time-string' for more information on its components." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +;;;; Template :: Mathjax + +(defcustom org-html-mathjax-options + '((path "http://orgmode.org/mathjax/MathJax.js") + (scale "100") + (align "center") + (indent "2em") + (mathml nil)) + "Options for MathJax setup. + +path The path where to find MathJax +scale Scaling for the HTML-CSS backend, usually between 100 and 133 +align How to align display math: left, center, or right +indent If align is not center, how far from the left/right side? +mathml Should a MathML player be used if available? + This is faster and reduces bandwidth use, but currently + sometimes has lower spacing quality. Therefore, the default is + nil. When browsers get better, this switch can be flipped. + +You can also customize this for each buffer, using something like + +#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" + :group 'org-export-html + :type '(list :greedy t + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) + +(defcustom org-html-mathjax-template + " +" + "The MathJax setup for XHTML files." + :group 'org-export-html + :type 'string) + +;;;; Template :: Postamble + +(defcustom org-html-postamble 'auto + "Non-nil means insert a postamble in HTML export. + +When set to 'auto, check against the +`org-export-with-author/email/creator/date' variables to set the +content of the postamble. When set to a string, use this string +as the postamble. When t, insert a string as defined by the +formatting string in `org-html-postamble-format'. + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-postamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No postamble" nil) + (const :tag "Auto postamble" auto) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-postamble-format + '(("en" "

    Author: %a (%e)

    +

    Date: %d

    +

    %c

    +

    %v

    ")) + "Alist of languages and format strings for the HTML postamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +postamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\"." + :group 'org-export-html + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) + +(defcustom org-html-validation-link + "Validate" + "Link to HTML validation service." + :group 'org-export-html + :type 'string) + +(defcustom org-html-creator-string + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the HTML document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(string :tag "Creator string")) + +;;;; Template :: Preamble + +(defcustom org-html-preamble t + "Non-nil means insert a preamble in HTML export. + +When t, insert a string as defined by the formatting string in +`org-html-preamble-format'. When set to a string, use this +formatting string instead (see `org-html-postamble-format' for an +example of such a formatting string). + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-preamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No preamble" nil) + (const :tag "Default preamble" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-preamble-format '(("en" "")) + "Alist of languages and format strings for the HTML preamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +preamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\". + +See the default value of `org-html-postamble-format' for an +example." + :group 'org-export-html + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) + +(defcustom org-html-link-up "" + "Where should the \"UP\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-link-home "" + "Where should the \"HOME\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-link-use-abs-url nil + "Should we prepend relative links with HTML_LINK_HOME?" + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + +(defcustom org-html-home/up-format + "
    + UP + | + HOME +
    " + "Snippet used to insert the HOME and UP links. +This is a format string, the first %s will receive the UP link, +the second the HOME link. If both `org-html-link-up' and +`org-html-link-home' are empty, the entire snippet will be +ignored." + :group 'org-export-html + :type 'string) + +;;;; Template :: Scripts + +(define-obsolete-variable-alias + 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") +(defcustom org-html-head-include-scripts t + "Non-nil means include the JavaScript snippets in exported HTML files. +The actual script is defined in `org-html-scripts' and should +not be modified." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Template :: Styles + +(define-obsolete-variable-alias + 'org-html-style-include-default 'org-html-head-include-default-style "24.4") +(defcustom org-html-head-include-default-style t + "Non-nil means include the default style in exported HTML files. +The actual style is defined in `org-html-style-default' and +should not be modified. Use `org-html-head' to use your own +style information." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) +;;;###autoload +(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) + +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(defcustom org-html-head "" + "Org-wide head definitions for exported HTML files. + +This variable can contain the full HTML structure to provide a +style, including the surrounding HTML tags. You can consider +including definitions for the following classes: title, todo, +done, timestamp, timestamp-kwd, tag, target. + +For example, a valid value would be: + + + +If you want to refer to an external style, use something like + + + +As the value of this option simply gets inserted into the HTML + header, you can use it to add any arbitrary text to the +header. + +You can set this on a per-file basis using #+HTML_HEAD:, +or for publication projects using the :html-head property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head 'safe-local-variable 'stringp) + +(defcustom org-html-head-extra "" + "More head information to add in the HTML output. + +You can set this on a per-file basis using #+HTML_HEAD_EXTRA:, +or for publication projects using the :html-head-extra property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head-extra 'safe-local-variable 'stringp) + +;;;; Todos + +(defcustom org-html-todo-kwd-class-prefix "" + "Prefix to class names for TODO keywords. +Each TODO keyword gets a class given by the keyword itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + + +;;; Internal Functions + +(defun org-html-xhtml-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (string-match-p "xhtml" dt))) + +(defun org-html-html5-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (member dt '("html5" "xhtml5" "")))) + +(defun org-html-close-tag (tag attr info) + (concat "<" tag " " attr + (if (org-html-xhtml-p info) " />" ">"))) + +(defun org-html-doctype (info) + "Return correct html doctype tag from `org-html-doctype-alist', +or the literal value of :html-doctype from INFO if :html-doctype +is not found in the alist. +INFO is a plist used as a communication channel." + (let ((dt (plist-get info :html-doctype))) + (or (cdr (assoc dt org-html-doctype-alist)) dt))) + +(defun org-html--make-attribute-string (attributes) + "Return a list of attributes, as a string. +ATTRIBUTES is a plist where values are either strings or nil. An +attributes with a nil value will be omitted from the result." + (let (output) + (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) + (cond ((null item) (pop output)) + ((symbolp item) (push (substring (symbol-name item) 1) output)) + (t (let ((key (car output)) + (value (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text item)))) + (setcar output (format "%s=\"%s\"" key value)))))))) + +(defun org-html--wrap-image (contents info &optional caption label) + "Wrap CONTENTS string within an appropriate environment for images. +INFO is a plist used as a communication channel. When optional +arguments CAPTION and LABEL are given, use them for caption and +\"id\" attribute." + (let ((html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)))) + (format (if html5-fancy "\n%s%s\n" + "\n%s%s\n

    ") + ;; ID. + (if (not (org-string-nw-p label)) "" + (format " id=\"%s\"" (org-export-solidify-link-text label))) + ;; Contents. + (format "\n

    %s

    " contents) + ;; Caption. + (if (not (org-string-nw-p caption)) "" + (format (if html5-fancy "\n
    %s
    " + "\n

    %s

    ") + caption))))) + +(defun org-html--format-image (source attributes info) + "Return \"img\" tag with given SOURCE and ATTRIBUTES. +SOURCE is a string specifying the location of the image. +ATTRIBUTES is a plist, as returned by +`org-export-read-attribute'. INFO is a plist used as +a communication channel." + (org-html-close-tag + "img" + (org-html--make-attribute-string + (org-combine-plists + (list :src source + :alt (if (string-match-p "^ltxpng/" source) + (org-html-encode-plain-text + (org-find-text-property-in-string 'org-latex-src source)) + (file-name-nondirectory source))) + attributes)) + info)) + +(defun org-html--textarea-block (element) + "Transcode ELEMENT into a textarea block. +ELEMENT is either a src block or an example block." + (let* ((code (car (org-export-unravel-code element))) + (attr (org-export-read-attribute :attr_html element))) + (format "

    \n\n

    " + (or (plist-get attr :width) 80) + (or (plist-get attr :height) (org-count-lines code)) + code))) + +(defun org-html--has-caption-p (element &optional info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal' or +a value to `org-html-standalone-image-predicate'." + (org-element-property :caption element)) + +;;;; Table + +(defun org-html-htmlize-region-for-paste (beg end) + "Convert the region between BEG and END to HTML, using htmlize.el. +This is much like `htmlize-region-for-paste', only that it uses +the settings define in the org-... variables." + (let* ((htmlize-output-type org-html-htmlize-output-type) + (htmlize-css-name-prefix org-html-htmlize-font-prefix) + (htmlbuf (htmlize-region beg end))) + (unwind-protect + (with-current-buffer htmlbuf + (buffer-substring (plist-get htmlize-buffer-places 'content-start) + (plist-get htmlize-buffer-places 'content-end))) + (kill-buffer htmlbuf)))) + +;;;###autoload +(defun org-html-htmlize-generate-css () + "Create the CSS for all font definitions in the current Emacs session. +Use this to create face definitions in your CSS style file that can then +be used by code snippets transformed by htmlize. +This command just produces a buffer that contains class definitions for all +faces used in the current Emacs session. You can copy and paste the ones you +need into your CSS file. + +If you then set `org-html-htmlize-output-type' to `css', calls +to the function `org-html-htmlize-region-for-paste' will +produce code that uses these same face definitions." + (interactive) + (require 'htmlize) + (and (get-buffer "*html*") (kill-buffer "*html*")) + (with-temp-buffer + (let ((fl (face-list)) + (htmlize-css-name-prefix "org-") + (htmlize-output-type 'css) + f i) + (while (setq f (pop fl) + i (and f (face-attribute f :inherit))) + (when (and (symbolp f) (or (not i) (not (listp i)))) + (insert (org-add-props (copy-sequence "1") nil 'face f)))) + (htmlize-region (point-min) (point-max)))) + (org-pop-to-buffer-same-window "*html*") + (goto-char (point-min)) + (if (re-search-forward "" nil t) + (delete-region (1+ (match-end 0)) (point-max))) + (beginning-of-line 1) + (if (looking-at " +") (replace-match "")) + (goto-char (point-min))) + +(defun org-html--make-string (n string) + "Build a string by concatenating N times STRING." + (let (out) (dotimes (i n out) (setq out (concat string out))))) + +(defun org-html-fix-class-name (kwd) ; audit callers of this function + "Turn todo keyword KWD into a valid class name. +Replaces invalid characters with \"_\"." + (save-match-data + (while (string-match "[^a-zA-Z0-9_]" kwd) + (setq kwd (replace-match "_" t t kwd)))) + kwd) + +(defun org-html-format-footnote-reference (n def refcnt) + "Format footnote reference N with definition DEF into HTML." + (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt)))) + (format org-html-footnote-format + (let* ((id (format "fnr.%s%s" n extra)) + (href (format " href=\"#fn.%s\"" n)) + (attributes (concat " class=\"footref\"" href))) + (org-html--anchor id n attributes))))) + +(defun org-html-format-footnotes-section (section-name definitions) + "Format footnotes section SECTION-NAME." + (if (not definitions) "" + (format org-html-footnotes-section section-name definitions))) + +(defun org-html-format-footnote-definition (fn) + "Format the footnote definition FN." + (let ((n (car fn)) (def (cdr fn))) + (format + "
    %s %s
    \n" + (format org-html-footnote-format + (let* ((id (format "fn.%s" n)) + (href (format " href=\"#fnr.%s\"" n)) + (attributes (concat " class=\"footnum\"" href))) + (org-html--anchor id n attributes))) + def))) + +(defun org-html-footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + (fn-alist + (loop for (n type raw) in fn-alist collect + (cons n (if (eq (org-element-type raw) 'org-data) + (org-trim (org-export-data raw info)) + (format "

    %s

    " + (org-trim (org-export-data raw info)))))))) + (when fn-alist + (org-html-format-footnotes-section + (org-html--translate "Footnotes" info) + (format + "\n%s\n" + (mapconcat 'org-html-format-footnote-definition fn-alist "\n")))))) + + +;;; Template + +(defun org-html--build-meta-info (info) + "Return meta tags for exported document. +INFO is a plist used as a communication channel." + (let ((protect-string + (lambda (str) + (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text str)))) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth + ;; Return raw Org syntax, skipping non + ;; exportable objects. + (org-element-interpret-data + (org-element-map auth + (cons 'plain-text org-element-all-objects) + 'identity info)))))) + (description (plist-get info :description)) + (keywords (plist-get info :keywords)) + (charset (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system + 'mime-charset)) + "iso-8859-1"))) + (concat + (format "%s\n" title) + (when (plist-get info :time-stamp-file) + (format-time-string + (concat "\n"))) + (format + (if (org-html-html5-p info) + (org-html-close-tag "meta" " charset=\"%s\"" info) + (org-html-close-tag + "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" + info)) + charset) "\n" + (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) + "\n" + (and (org-string-nw-p author) + (concat + (org-html-close-tag "meta" + (format " name=\"author\" content=\"%s\"" + (funcall protect-string author)) + info) + "\n")) + (and (org-string-nw-p description) + (concat + (org-html-close-tag "meta" + (format " name=\"description\" content=\"%s\"\n" + (funcall protect-string description)) + info) + "\n")) + (and (org-string-nw-p keywords) + (concat + (org-html-close-tag "meta" + (format " name=\"keywords\" content=\"%s\"" + (funcall protect-string keywords)) + info) + "\n"))))) + +(defun org-html--build-head (info) + "Return information for the .. of the HTML output. +INFO is a plist used as a communication channel." + (org-element-normalize-string + (concat + (when (plist-get info :html-head-include-default-style) + (org-element-normalize-string org-html-style-default)) + (org-element-normalize-string (plist-get info :html-head)) + (org-element-normalize-string (plist-get info :html-head-extra)) + (when (and (plist-get info :html-htmlized-css-url) + (eq org-html-htmlize-output-type 'css)) + (org-html-close-tag "link" + (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" + (plist-get info :html-htmlized-css-url)) + info)) + (when (plist-get info :html-head-include-scripts) org-html-scripts)))) + +(defun org-html--build-mathjax-config (info) + "Insert the user setup into the mathjax template. +INFO is a plist used as a communication channel." + (when (and (memq (plist-get info :with-latex) '(mathjax t)) + (org-element-map (plist-get info :parse-tree) + '(latex-fragment latex-environment) 'identity info t)) + (let ((template org-html-mathjax-template) + (options org-html-mathjax-options) + (in-buffer (or (plist-get info :html-mathjax) "")) + name val (yes " ") (no "// ") x) + (mapc + (lambda (e) + (setq name (car e) val (nth 1 e)) + (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + (if (not (stringp val)) (setq val (format "%s" val))) + (if (string-match (concat "%" (upcase (symbol-name name))) template) + (setq template (replace-match val t t template)))) + options) + (setq val (nth 1 (assq 'mathml options))) + (if (string-match (concat "\\%s" e e)) + (split-string (plist-get info :email) ",+ *") + ", ")) + (?c . ,(plist-get info :creator)) + (?C . ,(let ((file (plist-get info :input-file))) + (format-time-string org-html-metadata-timestamp-format + (if file (nth 5 (file-attributes file)) + (current-time))))) + (?v . ,(or org-html-validation-link "")))) + +(defun org-html--build-pre/postamble (type info) + "Return document preamble or postamble as a string, or nil. +TYPE is either 'preamble or 'postamble, INFO is a plist used as a +communication channel." + (let ((section (plist-get info (intern (format ":html-%s" type)))) + (spec (org-html-format-spec info))) + (when section + (let ((section-contents + (if (functionp section) (funcall section info) + (cond + ((stringp section) (format-spec section spec)) + ((eq section 'auto) + (let ((date (cdr (assq ?d spec))) + (author (cdr (assq ?a spec))) + (email (cdr (assq ?e spec))) + (creator (cdr (assq ?c spec))) + (timestamp (cdr (assq ?T spec))) + (validation-link (cdr (assq ?v spec)))) + (concat + (when (and (plist-get info :with-date) + (org-string-nw-p date)) + (format "

    %s: %s

    \n" + (org-html--translate "Date" info) + date)) + (when (and (plist-get info :with-author) + (org-string-nw-p author)) + (format "

    %s: %s

    \n" + (org-html--translate "Author" info) + author)) + (when (and (plist-get info :with-email) + (org-string-nw-p email)) + (format "

    %s: %s

    \n" + (org-html--translate "Email" info) + email)) + (when (plist-get info :time-stamp-file) + (format + "

    %s: %s

    \n" + (org-html--translate "Created" info) + (format-time-string org-html-metadata-timestamp-format))) + (when (plist-get info :with-creator) + (format "

    %s

    \n" creator)) + (format "

    %s

    \n" + validation-link)))) + (t (format-spec + (or (cadr (assoc + (plist-get info :language) + (eval (intern + (format "org-html-%s-format" type))))) + (cadr + (assoc + "en" + (eval + (intern (format "org-html-%s-format" type)))))) + spec)))))) + (when (org-string-nw-p section-contents) + (concat + (format "<%s id=\"%s\" class=\"%s\">\n" + (nth 1 (assq type org-html-divs)) + (nth 2 (assq type org-html-divs)) + org-html--pre/postamble-class) + (org-element-normalize-string section-contents) + (format "\n" (nth 1 (assq type org-html-divs))))))))) + +(defun org-html-inner-template (contents info) + "Return body of document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-html-toc depth info))) + ;; Document contents. + contents + ;; Footnotes section. + (org-html-footnote-section info))) + +(defun org-html-template (contents info) + "Return complete document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info)) + (let ((decl (or (and (stringp org-html-xml-declaration) + org-html-xml-declaration) + (cdr (assoc (plist-get info :html-extension) + org-html-xml-declaration)) + (cdr (assoc "html" org-html-xml-declaration)) + + ""))) + (when (not (or (eq nil decl) (string= "" decl))) + (format "%s\n" + (format decl + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")))))) + (org-html-doctype info) + "\n" + (concat "\n") + "\n" + (org-html--build-meta-info info) + (org-html--build-head info) + (org-html--build-mathjax-config info) + "\n" + "\n" + (let ((link-up (org-trim (plist-get info :html-link-up))) + (link-home (org-trim (plist-get info :html-link-home)))) + (unless (and (string= link-up "") (string= link-home "")) + (format org-html-home/up-format + (or link-up link-home) + (or link-home link-up)))) + ;; Preamble. + (org-html--build-pre/postamble 'preamble info) + ;; Document contents. + (format "<%s id=\"%s\">\n" + (nth 1 (assq 'content org-html-divs)) + (nth 2 (assq 'content org-html-divs))) + ;; Document title. + (let ((title (plist-get info :title))) + (format "

    %s

    \n" (org-export-data (or title "") info))) + contents + (format "\n" + (nth 1 (assq 'content org-html-divs))) + ;; Postamble. + (org-html--build-pre/postamble 'postamble info) + ;; Closing document. + "\n")) + +(defun org-html--translate (s info) + "Translate string S according to specified language. +INFO is a plist used as a communication channel." + (org-export-translate s :html info)) + +;;;; Anchor + +(defun org-html--anchor (&optional id desc attributes) + "Format a HTML anchor." + (let* ((name (and org-html-allow-name-attribute-in-anchors id)) + (attributes (concat (and id (format " id=\"%s\"" id)) + (and name (format " name=\"%s\"" name)) + attributes))) + (format "%s" attributes (or desc "")))) + +;;;; Todo + +(defun org-html--todo (todo) + "Format TODO keywords into HTML." + (when todo + (format "%s" + (if (member todo org-done-keywords) "done" "todo") + org-html-todo-kwd-class-prefix (org-html-fix-class-name todo) + todo))) + +;;;; Tags + +(defun org-html--tags (tags) + "Format TAGS into HTML." + (when tags + (format "%s" + (mapconcat + (lambda (tag) + (format "%s" + (concat org-html-tag-class-prefix + (org-html-fix-class-name tag)) + tag)) + tags " ")))) + +;;;; Headline + +(defun* org-html-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + "Format a headline in HTML." + (let ((section-number + (when section-number + (format "%s " + level section-number))) + (todo (org-html--todo todo)) + (tags (org-html--tags tags))) + (concat section-number todo (and todo " ") text + (and tags "   ") tags))) + +;;;; Src Code + +(defun org-html-fontify-code (code lang) + "Color CODE with htmlize library. +CODE is a string representing the source code to colorize. LANG +is the language used for CODE, as a string, or nil." + (when code + (cond + ;; Case 1: No lang. Possibly an example block. + ((not lang) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: No htmlize or an inferior version of htmlize + ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) + ;; Emit a warning. + (message "Cannot fontify src block (htmlize.el >= 1.34 required)") + ;; Simple transcoding. + (org-html-encode-plain-text code)) + (t + ;; Map language + (setq lang (or (assoc-default lang org-src-lang-modes) lang)) + (let* ((lang-mode (and lang (intern (format "%s-mode" lang))))) + (cond + ;; Case 1: Language is not associated with any Emacs mode + ((not (functionp lang-mode)) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: Default. Fontify code. + (t + ;; htmlize + (setq code (with-temp-buffer + ;; Switch to language-specific mode. + (funcall lang-mode) + (insert code) + ;; Fontify buffer. + (font-lock-fontify-buffer) + ;; Remove formatting on newline characters. + (save-excursion + (let ((beg (point-min)) + (end (point-max))) + (goto-char beg) + (while (progn (end-of-line) (< (point) end)) + (put-text-property (point) (1+ (point)) 'face nil) + (forward-char 1)))) + (org-src-mode) + (set-buffer-modified-p nil) + ;; Htmlize region. + (org-html-htmlize-region-for-paste + (point-min) (point-max)))) + ;; Strip any enclosing
     tags.
    +	  (let* ((beg (and (string-match "\\`]*>\n*" code) (match-end 0)))
    +		 (end (and beg (string-match "\\'" code))))
    +	    (if (and beg end) (substring code beg end) code)))))))))
    +
    +(defun org-html-do-format-code
    +  (code &optional lang refs retain-labels num-start)
    +  "Format CODE string as source code.
    +Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
    +respectively, the language of the source code, as a string, an
    +alist between line numbers and references (as returned by
    +`org-export-unravel-code'), a boolean specifying if labels should
    +appear in the source code, and the number associated to the first
    +line of code."
    +  (let* ((code-lines (org-split-string code "\n"))
    +	 (code-length (length code-lines))
    +	 (num-fmt
    +	  (and num-start
    +	       (format "%%%ds: "
    +		       (length (number-to-string (+ code-length num-start))))))
    +	 (code (org-html-fontify-code code lang)))
    +    (org-export-format-code
    +     code
    +     (lambda (loc line-num ref)
    +       (setq loc
    +	     (concat
    +	      ;; Add line number, if needed.
    +	      (when num-start
    +		(format "%s"
    +			(format num-fmt line-num)))
    +	      ;; Transcoded src line.
    +	      loc
    +	      ;; Add label, if needed.
    +	      (when (and ref retain-labels) (format " (%s)" ref))))
    +       ;; Mark transcoded line as an anchor, if needed.
    +       (if (not ref) loc
    +	 (format "%s"
    +		 ref loc)))
    +     num-start refs)))
    +
    +(defun org-html-format-code (element info)
    +  "Format contents of ELEMENT as source code.
    +ELEMENT is either an example block or a src block.  INFO is
    +a plist used as a communication channel."
    +  (let* ((lang (org-element-property :language element))
    +	 ;; Extract code and references.
    +	 (code-info (org-export-unravel-code element))
    +	 (code (car code-info))
    +	 (refs (cdr code-info))
    +	 ;; Does the src block contain labels?
    +	 (retain-labels (org-element-property :retain-labels element))
    +	 ;; Does it have line numbers?
    +	 (num-start (case (org-element-property :number-lines element)
    +		      (continued (org-export-get-loc element info))
    +		      (new 0))))
    +    (org-html-do-format-code code lang refs retain-labels num-start)))
    +
    +
    +;;; Tables of Contents
    +
    +(defun org-html-toc (depth info)
    +  "Build a table of contents.
    +DEPTH is an integer specifying the depth of the table.  INFO is a
    +plist used as a communication channel.  Return the table of
    +contents as a string, or nil if it is empty."
    +  (let ((toc-entries
    +	 (mapcar (lambda (headline)
    +		   (cons (org-html--format-toc-headline headline info)
    +			 (org-export-get-relative-level headline info)))
    +		 (org-export-collect-headlines info depth)))
    +	(outer-tag (if (and (org-html-html5-p info)
    +			    (plist-get info :html-html5-fancy))
    +		       "nav"
    +		     "div")))
    +    (when toc-entries
    +      (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
    +	      (format "%s\n"
    +		      org-html-toplevel-hlevel
    +		      (org-html--translate "Table of Contents" info)
    +		      org-html-toplevel-hlevel)
    +	      "
    " + (org-html--toc-text toc-entries) + "
    \n" + (format "\n" outer-tag))))) + +(defun org-html--toc-text (toc-entries) + "Return innards of a table of contents, as a string. +TOC-ENTRIES is an alist where key is an entry title, as a string, +and value is its relative level, as an integer." + (let* ((prev-level (1- (cdar toc-entries))) + (start-level prev-level)) + (concat + (mapconcat + (lambda (entry) + (let ((headline (car entry)) + (level (cdr entry))) + (concat + (let* ((cnt (- level prev-level)) + (times (if (> cnt 0) (1- cnt) (- cnt))) + rtn) + (setq prev-level level) + (concat + (org-html--make-string + times (cond ((> cnt 0) "\n
      \n
    • ") + ((< cnt 0) "
    • \n
    \n"))) + (if (> cnt 0) "\n
      \n
    • " "
    • \n
    • "))) + headline))) + toc-entries "") + (org-html--make-string (- prev-level start-level) "
    • \n
    \n")))) + +(defun org-html--format-toc-headline (headline info) + "Return an appropriate table of contents entry for HEADLINE. +INFO is a plist used as a communication channel." + (let* ((headline-number (org-export-get-headline-number headline info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data-with-backend + (org-export-get-alt-title headline info) + ;; Create an anonymous back-end that will ignore any + ;; footnote-reference, link, radio-target and target + ;; in table of contents. + (org-export-create-backend + :parent 'html + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info)) + (tags (and (eq (plist-get info :with-tags) t) + (org-export-get-tags headline info)))) + (format "%s" + ;; Label. + (org-export-solidify-link-text + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" + (mapconcat #'number-to-string headline-number "-")))) + ;; Body. + (concat + (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (concat (mapconcat #'number-to-string headline-number ".") + ". ")) + (apply (if (not (eq org-html-format-headline-function 'ignore)) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags)) + #'org-html-format-headline) + todo todo-type priority text tags :section-number nil))))) + +(defun org-html-list-of-listings (info) + "Build a list of listings. +INFO is a plist used as a communication channel. Return the list +of listings as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-listings info))) + (when lol-entries + (concat "
    \n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Listings" info) + org-html-toplevel-hlevel) + "
    \n
      \n" + (let ((count 0) + (initial-fmt (format "%s" + (org-html--translate "Listing %d:" info)))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
    • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
    • "))) + lol-entries "\n")) + "\n
    \n
    \n
    ")))) + +(defun org-html-list-of-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. Return the list +of tables as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-tables info))) + (when lol-entries + (concat "
    \n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Tables" info) + org-html-toplevel-hlevel) + "
    \n
      \n" + (let ((count 0) + (initial-fmt (format "%s" + (org-html--translate "Table %d:" info)))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
    • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
    • "))) + lol-entries "\n")) + "\n
    \n
    \n
    ")))) + + +;;; Transcode Functions + +;;;; Bold + +(defun org-html-bold (bold contents info) + "Transcode BOLD from Org to HTML. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s") + contents)) + +;;;; Center Block + +(defun org-html-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s
    " contents)) + +;;;; Clock + +(defun org-html-clock (clock contents info) + "Transcode a CLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "

    + +%s %s%s + +

    " + org-clock-string + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + +;;;; Code + +(defun org-html-code (code contents info) + "Transcode CODE from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s") + (org-html-encode-plain-text (org-element-property :value code)))) + +;;;; Drawer + +(defun org-html-drawer (drawer contents info) + "Transcode a DRAWER element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (if (functionp org-html-format-drawer-function) + (funcall org-html-format-drawer-function + (org-element-property :drawer-name drawer) + contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents)) + +;;;; Dynamic Block + +(defun org-html-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + +;;;; Entity + +(defun org-html-entity (entity contents info) + "Transcode an ENTITY object from Org to HTML. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :html entity)) + +;;;; Example Block + +(defun org-html-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (if (org-export-read-attribute :attr_html example-block :textarea) + (org-html--textarea-block example-block) + (format "
    \n%s
    " + (org-html-format-code example-block info)))) + +;;;; Export Snippet + +(defun org-html-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (eq (org-export-snippet-backend export-snippet) 'html) + (org-element-property :value export-snippet))) + +;;;; Export Block + +(defun org-html-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "HTML") + (org-remove-indentation (org-element-property :value export-block)))) + +;;;; Fixed Width + +(defun org-html-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "
    \n%s
    " + (org-html-do-format-code + (org-remove-indentation + (org-element-property :value fixed-width))))) + +;;;; Footnote Reference + +(defun org-html-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-html-footnote-separator)) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 100)) + ;; Inline definitions are secondary strings. + ((eq (org-element-property :type footnote-reference) 'inline) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1)) + ;; Non-inline footnotes definitions are full Org data. + (t (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1))))) + +;;;; Headline + +(defun org-html-format-headline--wrap + (headline info &optional format-function &rest extra-keys) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (+ (org-export-get-relative-level headline info) + (1- org-html-toplevel-hlevel))) + (headline-number (org-export-get-headline-number headline info)) + (section-number (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data (org-element-property :title headline) info)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" (mapconcat 'number-to-string + headline-number "-")))) + (format-function + (cond ((functionp format-function) format-function) + ((not (eq org-html-format-headline-function 'ignore)) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags))) + (t 'org-html-format-headline)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-html-headline (headline contents info) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Empty contents? + (setq contents (or contents "")) + (let* ((numberedp (org-export-numbered-headline-p headline info)) + (level (org-export-get-relative-level headline info)) + (text (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (section-number (and (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "."))) + ;; Create the headline text. + (full-text (org-html-format-headline--wrap headline info))) + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((org-export-low-level-p headline info) + ;; Build the real contents of the sub-tree. + (let* ((type (if numberedp 'ordered 'unordered)) + (itemized-body (org-html-format-list-item + contents type nil info nil full-text))) + (concat + (and (org-export-first-sibling-p headline info) + (org-html-begin-plain-list type)) + itemized-body + (and (org-export-last-sibling-p headline info) + (org-html-end-plain-list type))))) + ;; Case 3. Standard headline. Export it as a section. + (t + (let* ((section-number (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-")) + (ids (remove 'nil + (list (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number) + (org-element-property :ID headline)))) + (preferred-id (car ids)) + (extra-ids (cdr ids)) + (extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) + (level1 (+ level (1- org-html-toplevel-hlevel))) + (first-content (car (org-element-contents headline)))) + (format "<%s id=\"%s\" class=\"%s\">%s%s\n" + (org-html--container headline info) + (format "outline-container-%s" + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number))) + (concat (format "outline-%d" level1) (and extra-class " ") + extra-class) + (format "\n%s%s\n" + level1 + preferred-id + (mapconcat + (lambda (x) + (let ((id (org-export-solidify-link-text + (if (org-uuidgen-p x) (concat "ID-" x) + x)))) + (org-html--anchor id))) + extra-ids "") + full-text + level1) + ;; When there is no section, pretend there is an empty + ;; one to get the correct
    \n" class extra) text "
    \n"))) + +(defun org-html-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-html-format-inlinetask-function' is not 'ignore, call it + ;; with appropriate arguments. + ((not (eq org-html-format-inlinetask-function 'ignore)) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-html-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-html-format-headline--wrap + inlinetask info format-function :contents contents))) + ;; Otherwise, use a default template. + (t (format "
    \n%s%s\n%s
    " + (org-html-format-headline--wrap inlinetask info) + (org-html-close-tag "br" nil info) + contents)))) + +;;;; Italic + +(defun org-html-italic (italic contents info) + "Transcode ITALIC from Org to HTML. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents)) + +;;;; Item + +(defun org-html-checkbox (checkbox) + "Format CHECKBOX into HTML." + (case checkbox (on "[X]") + (off "[ ]") + (trans "[-]") + (t ""))) + +(defun org-html-format-list-item (contents type checkbox info + &optional term-counter-id + headline) + "Format a list item into HTML." + (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " "))) + (br (org-html-close-tag "br" nil info))) + (concat + (case type + (ordered + (let* ((counter term-counter-id) + (extra (if counter (format " value=\"%s\"" counter) ""))) + (concat + (format "" extra) + (when headline (concat headline br))))) + (unordered + (let* ((id term-counter-id) + (extra (if id (format " id=\"%s\"" id) ""))) + (concat + (format "" extra) + (when headline (concat headline br))))) + (descriptive + (let* ((term term-counter-id)) + (setq term (or term "(no term)")) + ;; Check-boxes in descriptive lists are associated to tag. + (concat (format "
    %s
    " + (concat checkbox term)) + "
    ")))) + (unless (eq type 'descriptive) checkbox) + contents + (case type + (ordered "") + (unordered "") + (descriptive "
    "))))) + +(defun org-html-item (item contents info) + "Transcode an ITEM element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (checkbox (org-element-property :checkbox item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-export-data tag info))))) + (org-html-format-list-item + contents type checkbox info (or tag counter)))) + +;;;; Keyword + +(defun org-html-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "HTML") value) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (org-html-toc depth info))) + ((string= "listings" value) (org-html-list-of-listings info)) + ((string= "tables" value) (org-html-list-of-tables info)))))))) + +;;;; Latex Environment + +(defun org-html-format-latex (latex-frag processing-type info) + "Format a LaTeX fragment LATEX-FRAG into HTML. +PROCESSING-TYPE designates the tool used for conversion. It is +a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil +and t. See `org-html-with-latex' for more information. INFO is +a plist containing export properties." + (let ((cache-relpath "") (cache-dir "")) + (unless (eq processing-type 'mathjax) + (let ((bfn (or (buffer-file-name) + (make-temp-name + (expand-file-name "latex" temporary-file-directory)))) + (latex-header + (let ((header (plist-get info :latex-header))) + (and header + (concat (mapconcat + (lambda (line) (concat "#+LATEX_HEADER: " line)) + (org-split-string header "\n") + "\n") + "\n"))))) + (setq cache-relpath + (concat "ltxpng/" + (file-name-sans-extension + (file-name-nondirectory bfn))) + cache-dir (file-name-directory bfn)) + ;; Re-create LaTeX environment from original buffer in + ;; temporary buffer so that dvipng/imagemagick can properly + ;; turn the fragment into an image. + (setq latex-frag (concat latex-header latex-frag)))) + (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..." + nil nil processing-type) + (buffer-string)))) + +(defun org-html-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((processing-type (plist-get info :with-latex)) + (latex-frag (org-remove-indentation + (org-element-property :value latex-environment))) + (attributes (org-export-read-attribute :attr_html latex-environment))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax info)) + ((dvipng imagemagick) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + ;; Do not provide a caption or a name to be consistent with + ;; `mathjax' handling. + (org-html--wrap-image + (org-html--format-image + (match-string 1 formula-link) attributes info) info)))) + (t latex-frag)))) + +;;;; Latex Fragment + +(defun org-html-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax info)) + ((dvipng imagemagick) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + (org-html--format-image (match-string 1 formula-link) nil info)))) + (t latex-frag)))) + +;;;; Line Break + +(defun org-html-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat (org-html-close-tag "br" nil info) "\n")) + +;;;; Link + +(defun org-html-inline-image-p (link info) + "Non-nil when LINK is meant to appear as an image. +INFO is a plist used as a communication channel. LINK is an +inline image when it has no description and targets an image +file (see `org-html-inline-image-rules' for more information), or +if its description is a single link targeting an image file." + (if (not (org-element-contents link)) + (org-export-inline-image-p link org-html-inline-image-rules) + (not + (let ((link-count 0)) + (org-element-map (org-element-contents link) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link (if (= link-count 1) t + (incf link-count) + (not (org-export-inline-image-p + obj org-html-inline-image-rules)))) + (otherwise t))) + info t))))) + +(defvar org-html-standalone-image-predicate) +(defun org-html-standalone-image-p (element info) + "Test if ELEMENT is a standalone image. + +INFO is a plist holding contextual information. + +Return non-nil, if ELEMENT is of type paragraph and its sole +content, save for white spaces, is a link that qualifies as an +inline image. + +Return non-nil, if ELEMENT is of type link and its containing +paragraph has no other content save white spaces. + +Return nil, otherwise. + +Bind `org-html-standalone-image-predicate' to constrain paragraph +further. For example, to check for only captioned standalone +images, set it to: + + \(lambda (paragraph) (org-element-property :caption paragraph))" + (let ((paragraph (case (org-element-type element) + (paragraph element) + (link (org-export-get-parent element))))) + (and (eq (org-element-type paragraph) 'paragraph) + (or (not (and (boundp 'org-html-standalone-image-predicate) + (functionp org-html-standalone-image-predicate))) + (funcall org-html-standalone-image-predicate paragraph)) + (not (let ((link-count 0)) + (org-element-map (org-element-contents paragraph) + (cons 'plain-text org-element-all-objects) + (lambda (obj) (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link + (or (> (incf link-count) 1) + (not (org-html-inline-image-p obj info)))) + (otherwise t))) + info 'first-match 'link)))))) + +(defun org-html-link (link desc info) + "Transcode a LINK object from Org to HTML. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((home (when (plist-get info :html-link-home) + (org-trim (plist-get info :html-link-home)))) + (use-abs-url (plist-get info :html-link-use-abs-url)) + (link-org-files-as-html-maybe + (function + (lambda (raw-path info) + "Treat links to `file.org' as links to `file.html', if needed. + See `org-html-link-org-files-as-html'." + (cond + ((and org-html-link-org-files-as-html + (string= ".org" + (downcase (file-name-extension raw-path ".")))) + (concat (file-name-sans-extension raw-path) "." + (plist-get info :html-extension))) + (t raw-path))))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (org-string-nw-p desc)) + (path + (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + ;; Treat links to ".org" files as ".html", if needed. + (setq raw-path + (funcall link-org-files-as-html-maybe raw-path info)) + ;; If file path is absolute, prepend it with protocol + ;; component - "file://". + (cond ((file-name-absolute-p raw-path) + (setq raw-path + (concat "file://" (expand-file-name + raw-path)))) + ((and home use-abs-url) + (setq raw-path (concat (file-name-as-directory home) raw-path)))) + ;; Add search option, if any. A search option can be + ;; relative to a custom-id or a headline title. Any other + ;; option is ignored. + (let ((option (org-element-property :search-option link))) + (cond ((not option) raw-path) + ((eq (aref option 0) ?#) (concat raw-path option)) + ;; External fuzzy link: try to resolve it if path + ;; belongs to current project, if any. + ((eq (aref option 0) ?*) + (concat + raw-path + (let ((numbers + (org-publish-resolve-external-fuzzy-link + (org-element-property :path link) option))) + (and numbers (concat "#sec-" + (mapconcat 'number-to-string + numbers "-")))))) + (t raw-path)))) + (t raw-path))) + ;; Extract attributes from parent's paragraph. HACK: Only do + ;; this for the first link in parent (inner image link for + ;; inline images). This is needed as long as attributes + ;; cannot be set on a per link basis. + (attributes-plist + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq (org-element-type container) 'link) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq (org-element-map parent 'link 'identity info t) link) + (org-export-read-attribute :attr_html parent)))) + (attributes + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) ""))) + protocol) + (cond + ;; Image file. + ((and org-html-inline-images + (org-export-inline-image-p link org-html-inline-image-rules)) + (org-html--format-image path attributes-plist info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "%s" + (org-export-solidify-link-text path) + attributes + (org-export-data (org-element-contents destination) info))))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; ID link points to an external file. + (plain-text + (let ((fragment (concat "ID-" path)) + ;; Treat links to ".org" files as ".html", if needed. + (path (funcall link-org-files-as-html-maybe + destination info))) + (format "%s" + path fragment attributes (or desc destination)))) + ;; Fuzzy link points nowhere. + ((nil) + (format "%s" + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; Link points to a headline. + (headline + (let ((href + ;; What href to use? + (cond + ;; Case 1: Headline is linked via it's CUSTOM_ID + ;; property. Use CUSTOM_ID. + ((string= type "custom-id") + (org-element-property :CUSTOM_ID destination)) + ;; Case 2: Headline is linked via it's ID property + ;; or through other means. Use the default href. + ((member type '("id" "fuzzy")) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (t (error "Shouldn't reach here")))) + ;; What description to use? + (desc + ;; Case 1: Headline is numbered and LINK has no + ;; description. Display section number. + (if (and (org-export-numbered-headline-p destination info) + (not desc)) + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) ".") + ;; Case 2: Either the headline is un-numbered or + ;; LINK has a custom description. Display LINK's + ;; description or headline's title. + (or desc (org-export-data (org-element-property + :title destination) info))))) + (format "%s" + (org-export-solidify-link-text href) attributes desc))) + ;; Fuzzy link points to a target or an element. + (t + (let* ((path (org-export-solidify-link-text path)) + (org-html-standalone-image-predicate 'org-html--has-caption-p) + (number (cond + (desc nil) + ((org-html-standalone-image-p destination info) + (org-export-get-ordinal + (org-element-map destination 'link + 'identity info t) + info 'link 'org-html-standalone-image-p)) + (t (org-export-get-ordinal + destination info nil 'org-html--has-caption-p)))) + (desc (cond (desc) + ((not number) "No description for this link") + ((numberp number) (number-to-string number)) + (t (mapconcat 'number-to-string number "."))))) + (format "%s" path attributes desc)))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let ((fragment (concat "coderef-" path))) + (format "%s" + fragment + (org-trim + (format (concat "class=\"coderef\"" + " onmouseover=\"CodeHighlightOn(this, '%s');\"" + " onmouseout=\"CodeHighlightOff(this, '%s');\"") + fragment fragment)) + attributes + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'html)) + ;; External link with a description part. + ((and path desc) (format "%s" path attributes desc)) + ;; External link without a description part. + (path (format "%s" path attributes path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" desc))))) + +;;;; Paragraph + +(defun org-html-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to HTML. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let* ((parent (org-export-get-parent paragraph)) + (parent-type (org-element-type parent)) + (style '((footnote-definition " class=\"footpara\""))) + (extra (or (cadr (assoc parent-type style)) ""))) + (cond + ((and (eq (org-element-type parent) 'item) + (= (org-element-property :begin paragraph) + (org-element-property :contents-begin parent))) + ;; Leading paragraph in a list item have no tags. + contents) + ((org-html-standalone-image-p paragraph info) + ;; Standalone image. + (let ((caption + (let ((raw (org-export-data + (org-export-get-caption paragraph) info)) + (org-html-standalone-image-predicate + 'org-html--has-caption-p)) + (if (not (org-string-nw-p raw)) raw + (concat + "" + (format (org-html--translate "Figure %d:" info) + (org-export-get-ordinal + (org-element-map paragraph 'link + 'identity info t) + info nil 'org-html-standalone-image-p)) + " " raw)))) + (label (org-element-property :name paragraph))) + (org-html--wrap-image contents info caption label))) + ;; Regular paragraph. + (t (format "\n%s

    " extra contents))))) + +;;;; Plain List + +;; FIXME Maybe arg1 is not needed because
  • already sets +;; the correct value for the item counter +(defun org-html-begin-plain-list (type &optional arg1) + "Insert the beginning of the HTML list depending on TYPE. +When ARG1 is a string, use it as the start parameter for ordered +lists." + (case type + (ordered + (format "
      " + (if arg1 (format " start=\"%d\"" arg1) ""))) + (unordered "
        ") + (descriptive "
        "))) + +(defun org-html-end-plain-list (type) + "Insert the end of the HTML list depending on TYPE." + (case type + (ordered "
    ") + (unordered "") + (descriptive ""))) + +(defun org-html-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to HTML. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item + (type (org-element-property :type plain-list))) + (format "%s\n%s%s" + (org-html-begin-plain-list type) + contents (org-html-end-plain-list type)))) + +;;;; Plain Text + +(defun org-html-convert-special-strings (string) + "Convert special characters in STRING to HTML." + (let ((all org-html-special-string-regexps) + e a re rpl start) + (while (setq a (pop all)) + (setq re (car a) rpl (cdr a) start 0) + (while (string-match re string start) + (setq string (replace-match rpl t nil string)))) + string)) + +(defun org-html-encode-plain-text (text) + "Convert plain text characters from TEXT to HTML equivalent. +Possible conversions are set in `org-html-protect-char-alist'." + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + org-html-protect-char-alist) + text) + +(defun org-html-plain-text (text info) + "Transcode a TEXT string from Org to HTML. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect following characters: <, >, &. + (setq output (org-html-encode-plain-text output)) + ;; Handle smart quotes. Be sure to provide original string since + ;; OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :html info text))) + ;; Handle special strings. + (when (plist-get info :with-special-strings) + (setq output (org-html-convert-special-strings output))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" + (concat (org-html-close-tag "br" nil info) "\n") output))) + ;; Return value. + output)) + + +;; Planning + +(defun org-html-planning (planning contents info) + "Transcode a PLANNING element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((span-fmt "%s %s")) + (format + "

    %s

    " + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (format span-fmt org-closed-string + (org-translate-time + (org-element-property :raw-value closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (format span-fmt org-deadline-string + (org-translate-time + (org-element-property :raw-value deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (format span-fmt org-scheduled-string + (org-translate-time + (org-element-property :raw-value scheduled))))))) + " ")))) + +;;;; Property Drawer + +(defun org-html-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;;; Quote Block + +(defun org-html-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s
    " contents)) + +;;;; Quote Section + +(defun org-html-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "
    \n%s
    " value)))) + +;;;; Section + +(defun org-html-section (section contents info) + "Transcode a SECTION element from Org to HTML. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + (let ((parent (org-export-get-parent-headline section))) + ;; Before first headline: no container, just return CONTENTS. + (if (not parent) contents + ;; Get div's class and id references. + (let* ((class-num (+ (org-export-get-relative-level parent info) + (1- org-html-toplevel-hlevel))) + (section-number + (mapconcat + 'number-to-string + (org-export-get-headline-number parent info) "-"))) + ;; Build return value. + (format "
    \n%s
    " + class-num + (or (org-element-property :CUSTOM_ID parent) section-number) + contents))))) + +;;;; Radio Target + +(defun org-html-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to HTML. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (let ((id (org-export-solidify-link-text + (org-element-property :value radio-target)))) + (org-html--anchor id text))) + +;;;; Special Block + +(defun org-html-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((block-type (downcase + (org-element-property :type special-block))) + (contents (or contents "")) + (html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy) + (member block-type org-html-html5-elements))) + (attributes (org-export-read-attribute :attr_html special-block))) + (unless html5-fancy + (let ((class (plist-get attributes :class))) + (setq attributes (plist-put attributes :class + (if class (concat class " " block-type) + block-type))))) + (setq attributes (org-html--make-attribute-string attributes)) + (when (not (equal attributes "")) + (setq attributes (concat " " attributes))) + (if html5-fancy + (format "<%s%s>\n%s" block-type attributes + contents block-type) + (format "\n%s\n
  • " attributes contents)))) + +;;;; Src Block + +(defun org-html-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (if (org-export-read-attribute :attr_html src-block :textarea) + (org-html--textarea-block src-block) + (let ((lang (org-element-property :language src-block)) + (caption (org-export-get-caption src-block)) + (code (org-html-format-code src-block info)) + (label (let ((lbl (org-element-property :name src-block))) + (if (not lbl) "" + (format " id=\"%s\"" + (org-export-solidify-link-text lbl)))))) + (if (not lang) (format "
    \n%s
    " label code) + (format + "
    \n%s%s\n
    " + (if (not caption) "" + (format "" + (org-export-data caption info))) + (format "\n
    %s
    " lang label code)))))) + +;;;; Statistics Cookie + +(defun org-html-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" cookie-value))) + +;;;; Strike-Through + +(defun org-html-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to HTML. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s") + contents)) + +;;;; Subscript + +(defun org-html-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Superscript + +(defun org-html-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Table Cell + +(defun org-html-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + (cell-attrs + (if (not org-html-table-align-individual-fields) "" + (format (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + " align=\"%s\"" " class=\"%s\"") + (org-export-table-cell-alignment table-cell info))))) + (when (or (not contents) (string= "" (org-trim contents))) + (setq contents " ")) + (cond + ((and (org-export-table-has-header-p table info) + (= 1 (org-export-table-row-group table-row info))) + (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs) + contents (cdr org-html-table-header-tags))) + ((and org-html-table-use-header-tags-for-first-column + (zerop (cdr (org-export-table-cell-address table-cell info)))) + (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs) + contents (cdr org-html-table-header-tags))) + (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs) + contents (cdr org-html-table-data-tags)))))) + +;;;; Table Row + +(defun org-html-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to HTML. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-number (org-export-table-row-group table-row info)) + (row-number (org-export-table-row-number table-row info)) + (start-rowgroup-p + (org-export-table-row-starts-rowgroup-p table-row info)) + (end-rowgroup-p + (org-export-table-row-ends-rowgroup-p table-row info)) + ;; `top-row-p' and `end-rowgroup-p' are not used directly + ;; but should be set so that `org-html-table-row-tags' can + ;; use them (see the docstring of this variable.) + (top-row-p (and (equal start-rowgroup-p '(top)) + (equal end-rowgroup-p '(below top)))) + (bottom-row-p (and (equal start-rowgroup-p '(above)) + (equal end-rowgroup-p '(bottom above)))) + (rowgroup-tags + (cond + ;; Case 1: Row belongs to second or subsequent rowgroups. + ((not (= 1 rowgroup-number)) + '("" . "\n")) + ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ((org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + '("" . "\n")) + ;; Case 2: Row is from first and only row group. + (t '("" . "\n"))))) + (concat + ;; Begin a rowgroup? + (when start-rowgroup-p (car rowgroup-tags)) + ;; Actual table row + (concat "\n" (eval (car org-html-table-row-tags)) + contents + "\n" + (eval (cdr org-html-table-row-tags))) + ;; End a rowgroup? + (when end-rowgroup-p (cdr rowgroup-tags)))))) + +;;;; Table + +(defun org-html-table-first-row-data-cells (table info) + "Transcode the first row of TABLE. +INFO is a plist used as a communication channel." + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-html-table--table.el-table (table info) + "Format table.el tables into HTML. +INFO is a plist used as a communication channel." + (when (eq (org-element-property :type table) 'table.el) + (require 'table) + (let ((outbuf (with-current-buffer + (get-buffer-create "*org-export-table*") + (erase-buffer) (current-buffer)))) + (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'html outbuf)) + (with-current-buffer outbuf + (prog1 (org-trim (buffer-string)) + (kill-buffer) ))))) + +(defun org-html-table (table contents info) + "Transcode a TABLE element from Org to HTML. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el table. Convert it using appropriate tools. + (table.el (org-html-table--table.el-table table info)) + ;; Case 2: Standard table. + (t + (let* ((label (org-element-property :name table)) + (caption (org-export-get-caption table)) + (number (org-export-get-ordinal + table info nil 'org-html--has-caption-p)) + (attributes + (org-html--make-attribute-string + (org-combine-plists + (and label (list :id (org-export-solidify-link-text label))) + (and (not (org-html-html5-p info)) + (plist-get info :html-table-attributes)) + (org-export-read-attribute :attr_html table)))) + (alignspec + (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + "align=\"%s\"" "class=\"%s\"")) + (table-column-specs + (function + (lambda (table info) + (mapconcat + (lambda (table-cell) + (let ((alignment (org-export-table-cell-alignment + table-cell info))) + (concat + ;; Begin a colgroup? + (when (org-export-table-cell-starts-colgroup-p + table-cell info) + "\n") + ;; Add a column. Also specify it's alignment. + (format "\n%s" + (org-html-close-tag + "col" (concat " " (format alignspec alignment)) info)) + ;; End a colgroup? + (when (org-export-table-cell-ends-colgroup-p + table-cell info) + "\n")))) + (org-html-table-first-row-data-cells table info) "\n"))))) + (format "\n%s\n%s\n%s" + (if (equal attributes "") "" (concat " " attributes)) + (if (not caption) "" + (format (if org-html-table-caption-above + "%s" + "%s") + (concat + "" + (format (org-html--translate "Table %d:" info) number) + " " (org-export-data caption info)))) + (funcall table-column-specs table info) + contents))))) + +;;;; Target + +(defun org-html-target (target contents info) + "Transcode a TARGET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((id (org-export-solidify-link-text + (org-element-property :value target)))) + (org-html--anchor id))) + +;;;; Timestamp + +(defun org-html-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-html-plain-text + (org-timestamp-translate timestamp) info))) + (format "%s" + (replace-regexp-in-string "--" "–" value)))) + +;;;; Underline + +(defun org-html-underline (underline contents info) + "Transcode UNDERLINE from Org to HTML. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s") + contents)) + +;;;; Verbatim + +(defun org-html-verbatim (verbatim contents info) + "Transcode VERBATIM from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s") + (org-html-encode-plain-text (org-element-property :value verbatim)))) + +;;;; Verse Block + +(defun org-html-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to HTML. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Replace each newline character with line break. Also replace + ;; each blank line with a line break. + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info)) + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" + (format "%s\n" (org-html-close-tag "br" nil info)) contents))) + ;; Replace each white space at beginning of a line with a + ;; non-breaking space. + (while (string-match "^[ \t]+" contents) + (let* ((num-ws (length (match-string 0 contents))) + (ws (let (out) (dotimes (i num-ws out) + (setq out (concat out " ")))))) + (setq contents (replace-match ws nil t contents)))) + (format "

    \n%s

    " contents)) + + +;;; Filter Functions + +(defun org-html-final-function (contents backend info) + "Filter to indent the HTML and convert HTML entities." + (with-temp-buffer + (insert contents) + (set-auto-mode t) + (if org-html-indent + (indent-region (point-min) (point-max))) + (when org-html-use-unicode-chars + (require 'mm-url) + (mm-url-decode-entities)) + (buffer-substring-no-properties (point-min) (point-max)))) + + +;;; End-user functions + +;;;###autoload +(defun org-html-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org HTML Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'html "*Org HTML Export*" + async subtreep visible-only body-only ext-plist + (lambda () (set-auto-mode t)))) + +;;;###autoload +(defun org-html-convert-region-to-html () + "Assume the current region has org-mode syntax, and convert it to HTML. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an HTML buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'html)) + +;;;###autoload +(defun org-html-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let* ((extension (concat "." org-html-extension)) + (file (org-export-output-file-name extension subtreep)) + (org-export-coding-system org-html-coding-system)) + (org-export-to-file 'html file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-html-publish-to-html (plist filename pub-dir) + "Publish an org file to HTML. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'html filename + (concat "." (or (plist-get plist :html-extension) + org-html-extension "html")) + plist pub-dir)) + + +(provide 'ox-html) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-html.el ends here diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el new file mode 100644 index 00000000000..a60c2f92f39 --- /dev/null +++ b/lisp/org/ox-icalendar.el @@ -0,0 +1,979 @@ +;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; This library implements an iCalendar back-end for Org generic +;; exporter. See Org manual for more information. +;; +;; It is expected to conform to RFC 5545. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-ascii) +(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) + + + +;;; User-Configurable Variables + +(defgroup org-export-icalendar nil + "Options specific for iCalendar export back-end." + :tag "Org Export iCalendar" + :group 'org-export) + +(defcustom org-icalendar-combined-agenda-file "~/org.ics" + "The file name for the iCalendar file covering all agenda files. +This file is created with the command \\[org-icalendar-combine-agenda-files]. +The file name should be absolute. It will be overwritten without warning." + :group 'org-export-icalendar + :type 'file) + +(defcustom org-icalendar-alarm-time 0 + "Number of minutes for triggering an alarm for exported timed events. + +A zero value (the default) turns off the definition of an alarm trigger +for timed events. If non-zero, alarms are created. + +- a single alarm per entry is defined +- The alarm will go off N minutes before the event +- only a DISPLAY action is defined." + :group 'org-export-icalendar + :version "24.1" + :type 'integer) + +(defcustom org-icalendar-combined-name "OrgMode" + "Calendar name for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-combined-description "" + "Calendar description for the combined iCalendar (all agenda files)." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-exclude-tags nil + "Tags that exclude a tree from export. +This variable allows to specify different exclude tags from other +back-ends. It can also be set with the ICAL_EXCLUDE_TAGS +keyword." + :group 'org-export-icalendar + :type '(repeat (string :tag "Tag"))) + +(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) + "Contexts where iCalendar export should use a deadline time stamp. + +This is a list with several symbols in it. Valid symbol are: +`event-if-todo' Deadlines in TODO entries become calendar events. +`event-if-not-todo' Deadlines in non-TODO entries become calendar events. +`todo-due' Use deadlines in TODO entries as due-dates" + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag "Deadlines in non-TODO entries become events" + event-if-not-todo) + (const :tag "Deadline in TODO entries become events" + event-if-todo) + (const :tag "Deadlines in TODO entries become due-dates" + todo-due))) + +(defcustom org-icalendar-use-scheduled '(todo-start) + "Contexts where iCalendar export should use a scheduling time stamp. + +This is a list with several symbols in it. Valid symbol are: +`event-if-todo' Scheduling time stamps in TODO entries become an event. +`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event. +`todo-start' Scheduling time stamps in TODO entries become start date. + Some calendar applications show TODO entries only after + that date." + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag + "SCHEDULED timestamps in non-TODO entries become events" + event-if-not-todo) + (const :tag "SCHEDULED timestamps in TODO entries become events" + event-if-todo) + (const :tag "SCHEDULED in TODO entries become start date" + todo-start))) + +(defcustom org-icalendar-categories '(local-tags category) + "Items that should be entered into the \"categories\" field. + +This is a list of symbols, the following are valid: +`category' The Org mode category of the current file or tree +`todo-state' The todo state, if any +`local-tags' The tags, defined in the current line +`all-tags' All tags, including inherited ones." + :group 'org-export-icalendar + :type '(repeat + (choice + (const :tag "The file or tree category" category) + (const :tag "The TODO state" todo-state) + (const :tag "Tags defined in current line" local-tags) + (const :tag "All tags, including inherited ones" all-tags)))) + +(defcustom org-icalendar-with-timestamps 'active + "Non-nil means make an event from plain time stamps. + +It can be set to `active', `inactive', t or nil, in order to make +an event from, respectively, only active timestamps, only +inactive ones, all of them or none. + +This variable has precedence over `org-export-with-timestamps'. +It can also be set with the #+OPTIONS line, e.g. \"<:t\"." + :group 'org-export-icalendar + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-icalendar-include-todo nil + "Non-nil means create VTODO components from TODO items. + +Valid values are: +nil don't include any task. +t include tasks that are not in DONE state. +`unblocked' include all TODO items that are not blocked. +`all' include both done and not done items." + :group 'org-export-icalendar + :type '(choice + (const :tag "None" nil) + (const :tag "Unfinished" t) + (const :tag "Unblocked" unblocked) + (const :tag "All" all) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-icalendar-include-bbdb-anniversaries nil + "Non-nil means a combined iCalendar file should include anniversaries. +The anniversaries are defined in the BBDB database." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-sexps t + "Non-nil means export to iCalendar files should also cover sexp entries. +These are entries like in the diary, but directly in an Org mode +file." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-body t + "Amount of text below headline to be included in iCalendar export. +This is a number of characters that should maximally be included. +Properties, scheduling and clocking lines will always be removed. +The text will be inserted into the DESCRIPTION field." + :group 'org-export-icalendar + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Everything" t) + (integer :tag "Max characters"))) + +(defcustom org-icalendar-store-UID nil + "Non-nil means store any created UIDs in properties. + +The iCalendar standard requires that all entries have a unique identifier. +Org will create these identifiers as needed. When this variable is non-nil, +the created UIDs will be stored in the ID property of the entry. Then the +next time this entry is exported, it will be exported with the same UID, +superseding the previous form of it. This is essential for +synchronization services. + +This variable is not turned on by default because we want to avoid creating +a property drawer in every entry if people are only playing with this feature, +or if they are only using it locally." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-timezone (getenv "TZ") + "The time zone string for iCalendar export. +When nil or the empty string, use output +from (current-time-zone)." + :group 'org-export-icalendar + :type '(choice + (const :tag "Unspecified" nil) + (string :tag "Time zone"))) + +(defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S" + "Format-string for exporting icalendar DATE-TIME. + +See `format-time-string' for a full documentation. The only +difference is that `org-icalendar-timezone' is used for %Z. + +Interesting value are: + - \":%Y%m%dT%H%M%S\" for local time + - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone + - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" + :group 'org-export-icalendar + :version "24.1" + :type '(choice + (const :tag "Local time" ":%Y%m%dT%H%M%S") + (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") + (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") + (string :tag "Explicit format"))) + +(defvar org-icalendar-after-save-hook nil + "Hook run after an iCalendar file has been saved. +This hook is run with the name of the file as argument. A good +way to use this is to tell a desktop calendar application to +re-read the iCalendar file.") + + + +;;; Define Back-End + +(org-export-define-derived-backend 'icalendar 'ascii + :translate-alist '((clock . ignore) + (footnote-definition . ignore) + (footnote-reference . ignore) + (headline . org-icalendar-entry) + (inlinetask . ignore) + (planning . ignore) + (section . ignore) + (inner-template . (lambda (c i) c)) + (template . org-icalendar-template)) + :options-alist + '((:exclude-tags + "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split) + (:with-timestamps nil "<" org-icalendar-with-timestamps) + (:with-vtodo nil nil org-icalendar-include-todo) + ;; The following property will be non-nil when export has been + ;; started from org-agenda-mode. In this case, any entry without + ;; a non-nil "ICALENDAR_MARK" property will be ignored. + (:icalendar-agenda-view nil nil nil)) + :filters-alist + '((:filter-headline . org-icalendar-clear-blank-lines)) + :menu-entry + '(?c "Export to iCalendar" + ((?f "Current file" org-icalendar-export-to-ics) + (?a "All agenda files" + (lambda (a s v b) (org-icalendar-export-agenda-files a))) + (?c "Combine all agenda files" + (lambda (a s v b) (org-icalendar-combine-agenda-files a)))))) + + + +;;; Internal Functions + +(defun org-icalendar-create-uid (file &optional bell h-markers) + "Set ID property on headlines missing it in FILE. +When optional argument BELL is non-nil, inform the user with +a message if the file was modified. With optional argument +H-MARKERS non-nil, it is a list of markers for the headlines +which will be updated." + (let ((pt (if h-markers (goto-char (car h-markers)) (point-min))) + modified-flag) + (org-map-entries + (lambda () + (let ((entry (org-element-at-point))) + (unless (or (< (point) pt) (org-element-property :ID entry)) + (org-id-get-create) + (setq modified-flag t) + (forward-line)) + (when h-markers (setq org-map-continue-from (pop h-markers))))) + nil nil 'comment) + (when (and bell modified-flag) + (message "ID properties created in file \"%s\"" file) + (sit-for 2)))) + +(defun org-icalendar-blocked-headline-p (headline info) + "Non-nil when HEADLINE is considered to be blocked. + +INFO is a plist used as a communication channel. + +a headline is blocked when either: + + - It has children which are not all in a completed state. + + - It has a parent with the property :ORDERED:, and there are + siblings prior to it with incomplete status. + + - Its parent is blocked because it has siblings that should be + done first or is a child of a blocked grandparent entry." + (or + ;; Check if any child is not done. + (org-element-map headline 'headline + (lambda (hl) (eq (org-element-property :todo-type hl) 'todo)) + info 'first-match) + ;; Check :ORDERED: node property. + (catch 'blockedp + (let ((current headline)) + (mapc (lambda (parent) + (cond + ((not (org-element-property :todo-keyword parent)) + (throw 'blockedp nil)) + ((org-not-nil (org-element-property :ORDERED parent)) + (let ((sibling current)) + (while (setq sibling (org-export-get-previous-element + sibling info)) + (when (eq (org-element-property :todo-type sibling) 'todo) + (throw 'blockedp t))))) + (t (setq current parent)))) + (org-export-get-genealogy headline)) + nil)))) + +(defun org-icalendar-use-UTC-date-time-p () + "Non-nil when `org-icalendar-date-time-format' requires UTC time." + (char-equal (elt org-icalendar-date-time-format + (1- (length org-icalendar-date-time-format))) ?Z)) + +(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. +(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) + "Convert TIMESTAMP to iCalendar format. + +TIMESTAMP is a timestamp object. KEYWORD is added in front of +it, in order to make a complete line (e.g. \"DTSTART\"). + +When optional argument END is non-nil, use end of time range. +Also increase the hour by two (if time string contains a time), +or the day by one (if it does not contain a time) when no +explicit ending time is specified. + +When optional argument UTC is non-nil, time will be expressed in +Universal Time, ignoring `org-icalendar-date-time-format'." + (let* ((year-start (org-element-property :year-start timestamp)) + (year-end (org-element-property :year-end timestamp)) + (month-start (org-element-property :month-start timestamp)) + (month-end (org-element-property :month-end timestamp)) + (day-start (org-element-property :day-start timestamp)) + (day-end (org-element-property :day-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (with-time-p minute-start) + (equal-bounds-p + (equal (list year-start month-start day-start hour-start minute-start) + (list year-end month-end day-end hour-end minute-end))) + (mi (cond ((not with-time-p) 0) + ((not end) minute-start) + ((and org-agenda-default-appointment-duration equal-bounds-p) + (+ minute-end org-agenda-default-appointment-duration)) + (t minute-end))) + (h (cond ((not with-time-p) 0) + ((not end) hour-start) + ((or (not equal-bounds-p) + org-agenda-default-appointment-duration) + hour-end) + (t (+ hour-end 2)))) + (d (cond ((not end) day-start) + ((not with-time-p) (1+ day-end)) + (t day-end))) + (m (if end month-end month-start)) + (y (if end year-end year-start))) + (concat + keyword + (format-time-string + (cond (utc ":%Y%m%dT%H%M%SZ") + ((not with-time-p) ";VALUE=DATE:%Y%m%d") + (t (replace-regexp-in-string "%Z" + org-icalendar-timezone + org-icalendar-date-time-format + t))) + ;; Convert timestamp into internal time in order to use + ;; `format-time-string' and fix any mistake (i.e. MI >= 60). + (encode-time 0 mi h d m y) + (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) + +(defun org-icalendar-dtstamp () + "Return DTSTAMP property, as a string." + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + +(defun org-icalendar-get-categories (entry info) + "Return categories according to `org-icalendar-categories'. +ENTRY is a headline or an inlinetask element. INFO is a plist +used as a communication channel." + (mapconcat + 'identity + (org-uniquify + (let (categories) + (mapc (lambda (type) + (case type + (category + (push (org-export-get-category entry info) categories)) + (todo-state + (let ((todo (org-element-property :todo-keyword entry))) + (and todo (push todo categories)))) + (local-tags + (setq categories + (append (nreverse (org-export-get-tags entry info)) + categories))) + (all-tags + (setq categories + (append (nreverse (org-export-get-tags entry info nil t)) + categories))))) + org-icalendar-categories) + ;; Return list of categories, following specified order. + (nreverse categories))) ",")) + +(defun org-icalendar-transcode-diary-sexp (sexp uid summary) + "Transcode a diary sexp into iCalendar format. +SEXP is the diary sexp being transcoded, as a string. UID is the +unique identifier for the entry. SUMMARY defines a short summary +or subject for the event." + (when (require 'icalendar nil t) + (org-element-normalize-string + (with-temp-buffer + (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp + (concat (substring sexp 1 -1) " " summary)))) + (put-text-property 0 1 'uid uid sexp) + (insert sexp "\n")) + (org-diary-to-ical-string (current-buffer)))))) + +(defun org-icalendar-cleanup-string (s) + "Cleanup string S according to RFC 5545." + (when s + ;; Protect "\", "," and ";" characters. and replace newline + ;; characters with literal \n. + (replace-regexp-in-string + "[ \t]*\n" "\\n" + (replace-regexp-in-string "[\\,;]" "\\\&" s) + nil t))) + +(defun org-icalendar-fold-string (s) + "Fold string S according to RFC 5545." + (org-element-normalize-string + (mapconcat + (lambda (line) + ;; Limit each line to a maximum of 75 characters. If it is + ;; longer, fold it by using "\n " as a continuation marker. + (let ((len (length line))) + (if (<= len 75) line + (let ((folded-line (substring line 0 75)) + (chunk-start 75) + chunk-end) + ;; Since continuation marker takes up one character on the + ;; line, real contents must be split at 74 chars. + (while (< (setq chunk-end (+ chunk-start 74)) len) + (setq folded-line + (concat folded-line "\n " + (substring line chunk-start chunk-end)) + chunk-start chunk-end)) + (concat folded-line "\n " (substring line chunk-start)))))) + (org-split-string s "\n") "\n"))) + + + +;;; Filters + +(defun org-icalendar-clear-blank-lines (headline back-end info) + "Remove trailing blank lines in HEADLINE export. +HEADLINE is a string representing a transcoded headline. +BACK-END and INFO are ignored." + (replace-regexp-in-string "^\\(?:[ \t]*\n\\)*" "" headline)) + + + +;;; Transcode Functions + +;;;; Headline and Inlinetasks + +;; The main function is `org-icalendar-entry', which extracts +;; information from a headline or an inlinetask (summary, +;; description...) and then delegates code generation to +;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending +;; on the component needed. + +;; Obviously, `org-icalendar--valarm' handles alarms, which can +;; happen within a VTODO component. + +(defun org-icalendar-entry (entry contents info) + "Transcode ENTRY element into iCalendar format. + +ENTRY is either a headline or an inlinetask. CONTENTS is +ignored. INFO is a plist used as a communication channel. + +This function is called on every headline, the section below +it (minus inlinetasks) being its contents. It tries to create +VEVENT and VTODO components out of scheduled date, deadline date, +plain timestamps, diary sexps. It also calls itself on every +inlinetask within the section." + (unless (org-element-property :footnote-section-p entry) + (let* ((type (org-element-type entry)) + ;; Determine contents really associated to the entry. For + ;; a headline, limit them to section, if any. For an + ;; inlinetask, this is every element within the task. + (inside + (if (eq type 'inlinetask) + (cons 'org-data (cons nil (org-element-contents entry))) + (let ((first (car (org-element-contents entry)))) + (and (eq (org-element-type first) 'section) + (cons 'org-data + (cons nil (org-element-contents first)))))))) + (concat + (unless (and (plist-get info :icalendar-agenda-view) + (not (org-element-property :ICALENDAR-MARK entry))) + (let ((todo-type (org-element-property :todo-type entry)) + (uid (or (org-element-property :ID entry) (org-id-new))) + (summary (org-icalendar-cleanup-string + (or (org-element-property :SUMMARY entry) + (org-export-data + (org-element-property :title entry) info)))) + (loc (org-icalendar-cleanup-string + (org-element-property :LOCATION entry))) + ;; Build description of the entry from associated + ;; section (headline) or contents (inlinetask). + (desc + (org-icalendar-cleanup-string + (or (org-element-property :DESCRIPTION entry) + (let ((contents (org-export-data inside info))) + (cond + ((not (org-string-nw-p contents)) nil) + ((wholenump org-icalendar-include-body) + (let ((contents (org-trim contents))) + (substring + contents 0 (min (length contents) + org-icalendar-include-body)))) + (org-icalendar-include-body (org-trim contents))))))) + (cat (org-icalendar-get-categories entry info))) + (concat + ;; Events: Delegate to `org-icalendar--vevent' to + ;; generate "VEVENT" component from scheduled, deadline, + ;; or any timestamp in the entry. + (let ((deadline (org-element-property :deadline entry))) + (and deadline + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-deadline) + (org-icalendar--vevent + entry deadline (concat "DL-" uid) + (concat "DL: " summary) loc desc cat))) + (let ((scheduled (org-element-property :scheduled entry))) + (and scheduled + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-scheduled) + (org-icalendar--vevent + entry scheduled (concat "SC-" uid) + (concat "S: " summary) loc desc cat))) + ;; When collecting plain timestamps from a headline and + ;; its title, skip inlinetasks since collection will + ;; happen once ENTRY is one of them. + (let ((counter 0)) + (mapconcat + 'identity + (org-element-map (cons (org-element-property :title entry) + (org-element-contents inside)) + 'timestamp + (lambda (ts) + (let ((uid (format "TS%d-%s" (incf counter) uid))) + (org-icalendar--vevent entry ts uid summary loc desc cat))) + info nil (and (eq type 'headline) 'inlinetask)) + "")) + ;; Task: First check if it is appropriate to export it. + ;; If so, call `org-icalendar--vtodo' to transcode it + ;; into a "VTODO" component. + (when (and todo-type + (case (plist-get info :with-vtodo) + (all t) + (unblocked + (and (eq type 'headline) + (not (org-icalendar-blocked-headline-p + entry info)))) + ('t (eq todo-type 'todo)))) + (org-icalendar--vtodo entry uid summary loc desc cat)) + ;; Diary-sexp: Collect every diary-sexp element within + ;; ENTRY and its title, and transcode them. If ENTRY is + ;; a headline, skip inlinetasks: they will be handled + ;; separately. + (when org-icalendar-include-sexps + (let ((counter 0)) + (mapconcat 'identity + (org-element-map + (cons (org-element-property :title entry) + (org-element-contents inside)) + 'diary-sexp + (lambda (sexp) + (org-icalendar-transcode-diary-sexp + (org-element-property :value sexp) + (format "DS%d-%s" (incf counter) uid) + summary)) + info nil (and (eq type 'headline) 'inlinetask)) + "")))))) + ;; If ENTRY is a headline, call current function on every + ;; inlinetask within it. In agenda export, this is independent + ;; from the mark (or lack thereof) on the entry. + (when (eq type 'headline) + (mapconcat 'identity + (org-element-map inside 'inlinetask + (lambda (task) (org-icalendar-entry task nil info)) + info) "")) + ;; Don't forget components from inner entries. + contents)))) + +(defun org-icalendar--vevent + (entry timestamp uid summary location description categories) + "Create a VEVENT component. + +ENTRY is either a headline or an inlinetask element. TIMESTAMP +is a timestamp object defining the date-time of the event. UID +is the unique identifier for the event. SUMMARY defines a short +summary or subject for the event. LOCATION defines the intended +venue for the event. DESCRIPTION provides the complete +description of the event. CATEGORIES defines the categories the +event belongs to. + +Return VEVENT component as a string." + (org-icalendar-fold-string + (if (eq (org-element-property :type timestamp) 'diary) + (org-icalendar-transcode-diary-sexp + (org-element-property :raw-value timestamp) uid summary) + (concat "BEGIN:VEVENT\n" + (org-icalendar-dtstamp) "\n" + "UID:" uid "\n" + (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" + (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" + ;; RRULE. + (when (org-element-property :repeater-type timestamp) + (format "RRULE:FREQ=%s;INTERVAL=%d\n" + (case (org-element-property :repeater-unit timestamp) + (hour "HOURLY") (day "DAILY") (week "WEEKLY") + (month "MONTHLY") (year "YEARLY")) + (org-element-property :repeater-value timestamp))) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + ;; VALARM. + (org-icalendar--valarm entry timestamp summary) + "END:VEVENT")))) + +(defun org-icalendar--vtodo + (entry uid summary location description categories) + "Create a VTODO component. + +ENTRY is either a headline or an inlinetask element. UID is the +unique identifier for the task. SUMMARY defines a short summary +or subject for the task. LOCATION defines the intended venue for +the task. DESCRIPTION provides the complete description of the +task. CATEGORIES defines the categories the task belongs to. + +Return VTODO component as a string." + (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) + (org-element-property :scheduled entry)) + ;; If we can't use a scheduled time for some + ;; reason, start task now. + (let ((now (decode-time (current-time)))) + (list 'timestamp + (list :type 'active + :minute-start (nth 1 now) + :hour-start (nth 2 now) + :day-start (nth 3 now) + :month-start (nth 4 now) + :year-start (nth 5 now))))))) + (org-icalendar-fold-string + (concat "BEGIN:VTODO\n" + "UID:TODO-" uid "\n" + (org-icalendar-dtstamp) "\n" + (org-icalendar-convert-timestamp start "DTSTART") "\n" + (and (memq 'todo-due org-icalendar-use-deadline) + (org-element-property :deadline entry) + (concat (org-icalendar-convert-timestamp + (org-element-property :deadline entry) "DUE") + "\n")) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + "SEQUENCE:1\n" + (format "PRIORITY:%d\n" + (let ((pri (or (org-element-property :priority entry) + org-default-priority))) + (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) + (- org-lowest-priority + org-highest-priority))))))) + (format "STATUS:%s\n" + (if (eq (org-element-property :todo-type entry) 'todo) + "NEEDS-ACTION" + "COMPLETED")) + "END:VTODO")))) + +(defun org-icalendar--valarm (entry timestamp summary) + "Create a VALARM component. + +ENTRY is the calendar entry triggering the alarm. TIMESTAMP is +the start date-time of the entry. SUMMARY defines a short +summary or subject for the task. + +Return VALARM component as a string, or nil if it isn't allowed." + ;; Create a VALARM entry if the entry is timed. This is not very + ;; general in that: + ;; (a) only one alarm per entry is defined, + ;; (b) only minutes are allowed for the trigger period ahead of the + ;; start time, + ;; (c) only a DISPLAY action is defined. [ESF] + (let ((alarm-time + (let ((warntime + (org-element-property :APPT_WARNTIME entry))) + (if warntime (string-to-number warntime) 0)))) + (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) + (org-element-property :hour-start timestamp) + (format "BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:%s +TRIGGER:-P0DT0H%dM0S +END:VALARM\n" + summary + (if (zerop alarm-time) org-icalendar-alarm-time alarm-time))))) + + +;;;; Template + +(defun org-icalendar-template (contents info) + "Return complete document string after iCalendar conversion. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + (org-icalendar--vcalendar + ;; Name. + (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer)) + (file-name-nondirectory + (file-name-sans-extension (plist-get info :input-file)))) + ;; Owner. + (if (not (plist-get info :with-author)) "" + (org-export-data (plist-get info :author) info)) + ;; Timezone. + (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone + (cadr (current-time-zone))) + ;; Description. + (org-export-data (plist-get info :title) info) + contents)) + +(defun org-icalendar--vcalendar (name owner tz description contents) + "Create a VCALENDAR component. +NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving, +respectively, the name of the calendar, its owner, the timezone +used, a short description and the other components included." + (concat (format "BEGIN:VCALENDAR +VERSION:2.0 +X-WR-CALNAME:%s +PRODID:-//%s//Emacs with Org mode//EN +X-WR-TIMEZONE:%s +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" + (org-icalendar-cleanup-string name) + (org-icalendar-cleanup-string owner) + (org-icalendar-cleanup-string tz) + (org-icalendar-cleanup-string description)) + contents + "END:VCALENDAR\n")) + + + +;;; Interactive Functions + +;;;###autoload +(defun org-icalendar-export-to-ics + (&optional async subtreep visible-only body-only) + "Export current buffer to an iCalendar file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". + +Return ICS file name." + (interactive) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (when (and file org-icalendar-store-UID) + (org-icalendar-create-uid file 'warn-user))) + ;; Export part. Since this back-end is backed up by `ascii', ensure + ;; links will not be collected at the end of sections. + (let ((outfile (org-export-output-file-name ".ics" subtreep))) + (org-export-to-file 'icalendar outfile + async subtreep visible-only body-only '(:ascii-charset utf-8) + (lambda (file) + (run-hook-with-args 'org-icalendar-after-save-hook file) nil)))) + +;;;###autoload +(defun org-icalendar-export-agenda-files (&optional async) + "Export all agenda files to iCalendar files. +When optional argument ASYNC is non-nil, export happens in an +external process." + (interactive) + (if async + ;; Asynchronous export is not interactive, so we will not call + ;; `org-check-agenda-file'. Instead we remove any non-existent + ;; agenda file from the list. + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (results) + (mapc (lambda (f) (org-export-add-to-stack f 'icalendar)) + results)) + `(let (output-files) + (mapc (lambda (file) + (with-current-buffer (org-get-agenda-file-buffer file) + (push (expand-file-name (org-icalendar-export-to-ics)) + output-files))) + ',files) + output-files))) + (let ((files (org-agenda-files t))) + (org-agenda-prepare-buffers files) + (unwind-protect + (mapc (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (org-icalendar-export-to-ics)))) + files) + (org-release-buffers org-agenda-new-buffers))))) + +;;;###autoload +(defun org-icalendar-combine-agenda-files (&optional async) + "Combine all agenda files into a single iCalendar file. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +The file is stored under the name chosen in +`org-icalendar-combined-agenda-file'." + (interactive) + (if async + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (dummy) + (org-export-add-to-stack + (expand-file-name org-icalendar-combined-agenda-file) + 'icalendar)) + `(apply 'org-icalendar--combine-files nil ',files))) + (apply 'org-icalendar--combine-files nil (org-agenda-files t)))) + +(defun org-icalendar-export-current-agenda (file) + "Export current agenda view to an iCalendar FILE. +This function assumes major mode for current buffer is +`org-agenda-mode'." + (let (org-export-babel-evaluate ; Don't evaluate Babel block + (org-icalendar-combined-agenda-file file) + (marker-list + ;; Collect the markers pointing to entries in the current + ;; agenda buffer. + (let (markers) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (and m (push m markers))) + (beginning-of-line 2))) + (nreverse markers)))) + (apply 'org-icalendar--combine-files + ;; Build restriction alist. + (let (restriction) + ;; Sort markers in each association within RESTRICTION. + (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) + (dolist (m marker-list restriction) + (let* ((pos (marker-position m)) + (file (buffer-file-name + (org-base-buffer (marker-buffer m)))) + (file-markers (assoc file restriction))) + ;; Add POS in FILE association if one exists + ;; or create a new association for FILE. + (if file-markers (push pos (cdr file-markers)) + (push (list file pos) restriction)))))) + (org-agenda-files nil 'ifmode)))) + +(defun org-icalendar--combine-files (restriction &rest files) + "Combine entries from multiple files into an iCalendar file. +RESTRICTION, when non-nil, is an alist where key is a file name +and value a list of buffer positions pointing to entries that +should appear in the calendar. It only makes sense if the +function was called from an agenda buffer. FILES is a list of +files to build the calendar from." + (org-agenda-prepare-buffers files) + (unwind-protect + (progn + (with-temp-file org-icalendar-combined-agenda-file + (insert + (org-icalendar--vcalendar + ;; Name. + org-icalendar-combined-name + ;; Owner. + user-full-name + ;; Timezone. + (or (org-string-nw-p org-icalendar-timezone) + (cadr (current-time-zone))) + ;; Description. + org-icalendar-combined-description + ;; Contents. + (concat + ;; Agenda contents. + (mapconcat + (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (let ((marks (cdr (assoc (expand-file-name file) + restriction)))) + ;; Create ID if necessary. + (when org-icalendar-store-UID + (org-icalendar-create-uid file t marks)) + (unless (and restriction (not marks)) + ;; Add a hook adding :ICALENDAR_MARK: property + ;; to each entry appearing in agenda view. + ;; Use `apply-partially' because the function + ;; still has to accept one argument. + (let ((org-export-before-processing-hook + (cons (apply-partially + (lambda (m-list dummy) + (mapc (lambda (m) + (org-entry-put + m "ICALENDAR-MARK" "t")) + m-list)) + (sort marks '>)) + org-export-before-processing-hook))) + (org-export-as + 'icalendar nil nil t + (list :ascii-charset 'utf-8 + :icalendar-agenda-view restriction)))))))) + files "") + ;; BBDB anniversaries. + (when (and org-icalendar-include-bbdb-anniversaries + (require 'org-bbdb nil t)) + (with-output-to-string (org-bbdb-anniv-export-ical))))))) + (run-hook-with-args 'org-icalendar-after-save-hook + org-icalendar-combined-agenda-file)) + (org-release-buffers org-agenda-new-buffers))) + + +(provide 'ox-icalendar) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-icalendar.el ends here diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el new file mode 100644 index 00000000000..9fc1031d391 --- /dev/null +++ b/lisp/org/ox-latex.el @@ -0,0 +1,2916 @@ +;;; ox-latex.el --- LaTeX Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; See Org manual for details. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) +(require 'ox-publish) + +(defvar org-latex-default-packages-alist) +(defvar org-latex-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'latex + '((bold . org-latex-bold) + (center-block . org-latex-center-block) + (clock . org-latex-clock) + (code . org-latex-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-latex-drawer) + (dynamic-block . org-latex-dynamic-block) + (entity . org-latex-entity) + (example-block . org-latex-example-block) + (export-block . org-latex-export-block) + (export-snippet . org-latex-export-snippet) + (fixed-width . org-latex-fixed-width) + (footnote-definition . org-latex-footnote-definition) + (footnote-reference . org-latex-footnote-reference) + (headline . org-latex-headline) + (horizontal-rule . org-latex-horizontal-rule) + (inline-src-block . org-latex-inline-src-block) + (inlinetask . org-latex-inlinetask) + (italic . org-latex-italic) + (item . org-latex-item) + (keyword . org-latex-keyword) + (latex-environment . org-latex-latex-environment) + (latex-fragment . org-latex-latex-fragment) + (line-break . org-latex-line-break) + (link . org-latex-link) + (paragraph . org-latex-paragraph) + (plain-list . org-latex-plain-list) + (plain-text . org-latex-plain-text) + (planning . org-latex-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-latex-quote-block) + (quote-section . org-latex-quote-section) + (radio-target . org-latex-radio-target) + (section . org-latex-section) + (special-block . org-latex-special-block) + (src-block . org-latex-src-block) + (statistics-cookie . org-latex-statistics-cookie) + (strike-through . org-latex-strike-through) + (subscript . org-latex-subscript) + (superscript . org-latex-superscript) + (table . org-latex-table) + (table-cell . org-latex-table-cell) + (table-row . org-latex-table-row) + (target . org-latex-target) + (template . org-latex-template) + (timestamp . org-latex-timestamp) + (underline . org-latex-underline) + (verbatim . org-latex-verbatim) + (verse-block . org-latex-verse-block)) + :export-block '("LATEX" "TEX") + :menu-entry + '(?l "Export to LaTeX" + ((?L "As LaTeX buffer" org-latex-export-as-latex) + (?l "As LaTeX file" org-latex-export-to-latex) + (?p "As PDF file" org-latex-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-latex-export-to-pdf t s v b) + (org-open-file (org-latex-export-to-pdf nil s v b))))))) + :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) + (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) + (:latex-header "LATEX_HEADER" nil nil newline) + (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline) + (:latex-hyperref-p nil "texht" org-latex-with-hyperref t) + ;; Redefine regular options. + (:date "DATE" nil "\\today" t))) + + + +;;; Internal Variables + +(defconst org-latex-babel-language-alist + '(("af" . "afrikaans") + ("bg" . "bulgarian") + ("bt-br" . "brazilian") + ("ca" . "catalan") + ("cs" . "czech") + ("cy" . "welsh") + ("da" . "danish") + ("de" . "germanb") + ("de-at" . "naustrian") + ("de-de" . "ngerman") + ("el" . "greek") + ("en" . "english") + ("en-au" . "australian") + ("en-ca" . "canadian") + ("en-gb" . "british") + ("en-ie" . "irish") + ("en-nz" . "newzealand") + ("en-us" . "american") + ("es" . "spanish") + ("et" . "estonian") + ("eu" . "basque") + ("fi" . "finnish") + ("fr" . "frenchb") + ("fr-ca" . "canadien") + ("gl" . "galician") + ("hr" . "croatian") + ("hu" . "hungarian") + ("id" . "indonesian") + ("is" . "icelandic") + ("it" . "italian") + ("la" . "latin") + ("ms" . "malay") + ("nl" . "dutch") + ("nb" . "norsk") + ("nn" . "nynorsk") + ("no" . "norsk") + ("pl" . "polish") + ("pt" . "portuguese") + ("ro" . "romanian") + ("ru" . "russian") + ("sa" . "sanskrit") + ("sb" . "uppersorbian") + ("sk" . "slovak") + ("sl" . "slovene") + ("sq" . "albanian") + ("sr" . "serbian") + ("sv" . "swedish") + ("ta" . "tamil") + ("tr" . "turkish") + ("uk" . "ukrainian")) + "Alist between language code and corresponding Babel option.") + +(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr") + ("qbordermatrix" . "\\cr") + ("kbordermatrix" . "\\\\")) + "Alist between matrix macros and their row ending.") + + + +;;; User Configurable Variables + +(defgroup org-export-latex nil + "Options for exporting Org mode files to LaTeX." + :tag "Org Export LaTeX" + :group 'org-export) + + +;;;; Preamble + +(defcustom org-latex-default-class "article" + "The default LaTeX class." + :group 'org-export-latex + :type '(string :tag "LaTeX class")) + +(defcustom org-latex-classes + '(("article" + "\\documentclass[11pt]{article}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) + ("report" + "\\documentclass[11pt]{report}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) + ("book" + "\\documentclass[11pt]{book}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) + "Alist of LaTeX classes and associated header and structure. +If #+LATEX_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + \(numbered-section . unnumbered-section) + ...) + +The header string +----------------- + +The HEADER-STRING is the header that will be inserted into the +LaTeX file. It should contain the \\documentclass macro, and +anything else that is needed for this setup. To this header, the +following commands will be added: + +- Calls to \\usepackage for all packages mentioned in the + variables `org-latex-default-packages-alist' and + `org-latex-packages-alist'. Thus, your header definitions + should avoid to also request these packages. + +- Lines specified via \"#+LATEX_HEADER:\" and + \"#+LATEX_HEADER_EXTRA:\" keywords. + +If you need more control about the sequence in which the header +is built up, or if you want to exclude one of these building +blocks for a particular class, you can use the following +macro-like placeholders. + + [DEFAULT-PACKAGES] \\usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \\usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LATEX_HEADER(_EXTRA) + [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) stuff + +So a header like + + \\documentclass{article} + [NO-DEFAULT-PACKAGES] + [EXTRA] + \\providecommand{\\alert}[1]{\\textbf{#1}} + [PACKAGES] + +will omit the default packages, and will include the +#+LATEX_HEADER and #+LATEX_HEADER_EXTRA lines, then have a call +to \\providecommand, and then place \\usepackage commands based +on the content of `org-latex-packages-alist'. + +If your header, `org-latex-default-packages-alist' or +`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\", +AUTO will automatically be replaced with a coding system derived +from `buffer-file-coding-system'. See also the variable +`org-latex-inputenc-alist' for a way to influence this mechanism. + +Likewise, if your header contains \"\\usepackage[AUTO]{babel}\", +AUTO will be replaced with the language related to the language +code specified by `org-export-default-language', which see. Note +that constructions such as \"\\usepackage[french,AUTO,english]{babel}\" +are permitted. + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. + +Instead of a cons cell (numbered . unnumbered), you can also +provide a list of 2 or 4 elements, + + \(numbered-open numbered-close) + +or + + \(numbered-open numbered-close unnumbered-open unnumbered-close) + +providing opening and closing strings for a LaTeX environment +that should represent the document section. The opening clause +should have a %s to represent the section title. + +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the (reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-latex + :type '(repeat + (list (string :tag "LaTeX class") + (string :tag "LaTeX header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (list :tag "Environment" + (string :tag "Opening (numbered)") + (string :tag "Closing (numbered)") + (string :tag "Opening (unnumbered)") + (string :tag "Closing (unnumbered)")) + (function :tag "Hook computing sectioning")))))) + +(defcustom org-latex-inputenc-alist nil + "Alist of inputenc coding system names, and what should really be used. +For example, adding an entry + + (\"utf8\" . \"utf8x\") + +will cause \\usepackage[utf8x]{inputenc} to be used for buffers that +are written as utf8 files." + :group 'org-export-latex + :type '(repeat + (cons + (string :tag "Derived from buffer") + (string :tag "Use this instead")))) + +(defcustom org-latex-title-command "\\maketitle" + "The command used to insert the title just after \\begin{document}. +If this string contains the formatting specification \"%s\" then +it will be used as a formatting string, passing the title as an +argument." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-toc-command "\\tableofcontents\n\n" + "LaTeX command to set the table of contents, list of figures, etc. +This command only applies to the table of contents generated with +the toc:nil option, not to those generated with #+TOC keyword." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-with-hyperref t + "Toggle insertion of \\hypersetup{...} in the preamble." + :group 'org-export-latex + :type 'boolean) + +;;;; Headline + +(defcustom org-latex-format-headline-function + 'org-latex-format-headline-default-function + "Function for formatting the headline's text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +Use `org-latex-format-headline-default-function' by default, +which format headlines like for Org version prior to 8.0." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Footnotes + +(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\," + "Text used to separate footnotes." + :group 'org-export-latex + :type 'string) + + +;;;; Timestamps + +(defcustom org-latex-active-timestamp-format "\\textit{%s}" + "A printf format string to be applied to active timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inactive-timestamp-format "\\textit{%s}" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-diary-timestamp-format "\\textit{%s}" + "A printf format string to be applied to diary timestamps." + :group 'org-export-latex + :type 'string) + + +;;;; Links + +(defcustom org-latex-image-default-option "" + "Default option for images." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-width ".9\\linewidth" + "Default width for images. +This value will not be used if a height is provided." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-height "" + "Default height for images. +This value will not be used if a width is provided, or if the +image is wrapped within a \"figure\" or \"wrapfigure\" +environment." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-figure-position "htb" + "Default position for latex figures." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inline-image-rules + '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) + "Rules characterizing image files that can be inlined into LaTeX. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path. + +Note that, by default, the image extension *actually* allowed +depend on the way the LaTeX file is processed. When used with +pdflatex, pdf, jpg and png images are OK. When processing +through dvi to Postscript, only ps and eps are allowed. The +default we use here encompasses both." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-latex-link-with-unknown-path-format "\\texttt{%s}" + "Format string for links with unknown path type." + :group 'org-export-latex + :type 'string) + + +;;;; Tables + +(defcustom org-latex-default-table-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-table-mode 'table + "Default mode for tables. + +Value can be a symbol among: + + `table' Regular LaTeX table. + + `math' In this mode, every cell is considered as being in math + mode and the complete table will be wrapped within a math + environment. It is particularly useful to write matrices. + + `inline-math' This mode is almost the same as `math', but the + math environment will be inlined. + + `verbatim' The table is exported as it appears in the Org + buffer, within a verbatim environment. + +This value can be overridden locally with, i.e. \":mode math\" in +LaTeX attributes. + +When modifying this variable, it may be useful to change +`org-latex-default-table-environment' accordingly." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (const :tag "Table" table) + (const :tag "Matrix" math) + (const :tag "Inline matrix" inline-math) + (const :tag "Verbatim" verbatim))) + +(defcustom org-latex-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-tables-booktabs nil + "When non-nil, display tables in a formal \"booktabs\" style. +This option assumes that the \"booktabs\" package is properly +loaded in the header of the document. This value can be ignored +locally with \":booktabs t\" and \":booktabs nil\" LaTeX +attributes." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-latex-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-table-scientific-notation "%s\\,(%s)" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e., \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + + +;;;; Text markup + +(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}") + (code . verb) + (italic . "\\emph{%s}") + (strike-through . "\\sout{%s}") + (underline . "\\uline{%s}") + (verbatim . protectedtexttt)) + "Alist of LaTeX expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +Value can also be set to the following symbols: `verb' and +`protectedtexttt'. For the former, Org will use \"\\verb\" to +create a format string and select a delimiter character that +isn't in the string. For the latter, Org will use \"\\texttt\" +to typeset and try to protect special characters. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-latex + :type 'alist + :options '(bold code italic strike-through underline verbatim)) + + +;;;; Drawers + +(defcustom org-latex-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in LaTeX code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default function simply returns the value of CONTENTS." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-latex-format-inlinetask-function 'ignore + "Function called to format an inlinetask in LaTeX code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behavior: + +\(defun org-latex-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for LaTeX export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) + \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) + title + \(when tags + \(format \"\\\\hfill{}\\\\textsc{:%s:}\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \"\\\\begin{center}\\n\" + \"\\\\fbox{\\n\" + \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" + \"%s\\n\\n\" + \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" + \"%s\" + \"\\\\end{minipage}}\" + \"\\\\end{center}\") + full-title contents))" + :group 'org-export-latex + :type 'function) + + +;; Src blocks + +(defcustom org-latex-listings nil + "Non-nil means export source code using the listings package. + +This package will fontify source code, possibly even with color. +If you want to use this, you also need to make LaTeX use the +listings package, and if you want to have color, the color +package. Just add these to `org-latex-packages-alist', for +example using customize, or with something like: + + \(require 'ox-latex) + \(add-to-list 'org-latex-packages-alist '(\"\" \"listings\")) + \(add-to-list 'org-latex-packages-alist '(\"\" \"color\")) + +Alternatively, + + \(setq org-latex-listings 'minted) + +causes source code to be exported using the minted package as +opposed to listings. If you want to use minted, you need to add +the minted package to `org-latex-packages-alist', for example +using customize, or with + + \(require 'ox-latex) + \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\")) + +In addition, it is necessary to install pygments +\(http://pygments.org), and to configure the variable +`org-latex-pdf-process' so that the -shell-escape option is +passed to pdflatex. + +The minted choice has possible repercussions on the preview of +latex fragments (see `org-preview-latex-fragment'). If you run +into previewing problems, please consult + + http://orgmode.org/worg/org-tutorials/org-latex-preview.html" + :group 'org-export-latex + :type '(choice + (const :tag "Use listings" t) + (const :tag "Use minted" minted) + (const :tag "Export verbatim" nil))) + +(defcustom org-latex-listings-langs + '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") + (c "C") (cc "C++") + (fortran "fortran") + (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") + (html "HTML") (xml "XML") + (tex "TeX") (latex "[LaTeX]TeX") + (shell-script "bash") + (gnuplot "Gnuplot") + (ocaml "Caml") (caml "Caml") + (sql "SQL") (sqlite "sql")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + +(defcustom org-latex-listings-options nil + "Association list of options for the latex listings package. + +These options are supplied as a comma-separated list to the +\\lstset command. Each element of the association list should be +a list containing two strings: the name of the option, and the +value. For example, + + (setq org-latex-listings-options + '((\"basicstyle\" \"\\\\small\") + (\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\"))) + +will typeset the code in a small size font with underlined, bold +black keywords. + +Note that the same options will be applied to blocks of all +languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) + +(defcustom org-latex-minted-langs + '((emacs-lisp "common-lisp") + (cc "c++") + (cperl "perl") + (shell-script "bash") + (caml "ocaml")) + "Alist mapping languages to their minted language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the minted package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present. + +Note that minted uses all lower case for language identifiers, +and that the full list of language identifiers can be obtained +with: + + pygmentize -L lexers" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Minted language")))) + +(defcustom org-latex-minted-options nil + "Association list of options for the latex minted package. + +These options are supplied within square brackets in +\\begin{minted} environments. Each element of the alist should +be a list containing two strings: the name of the option, and the +value. For example, + + \(setq org-latex-minted-options + '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) + +will result in src blocks being exported with + +\\begin{minted}[bgcolor=bg,frame=lines]{} + +as the start of the minted environment. Note that the same +options will be applied to blocks of all languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Minted option name ") + (string :tag "Minted option value")))) + +(defvar org-latex-custom-lang-environments nil + "Alist mapping languages to language-specific LaTeX environments. + +It is used during export of src blocks by the listings and minted +latex packages. For example, + + \(setq org-latex-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during latex export it will output + + \\begin{pythoncode} + + \\end{pythoncode}") + + +;;;; Compilation + +(defcustom org-latex-pdf-process + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") + "Commands to process a LaTeX file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + +The reason why this is a list is that it usually takes several +runs of `pdflatex', maybe mixed with a call to `bibtex'. Org +does not have a clever mechanism to detect which of these +commands have to be run to get to a stable result, and it also +does not do any error checking. + +By default, Org uses 3 runs of `pdflatex' to do the processing. +If you have texi2dvi on your system and if that does not cause +the infamous egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice as it automates the LaTeX +build process by calling the \"correct\" combinations of +auxiliary programs. Org does offer `texi2dvi' as one of the +customize options. Alternatively, `rubber' and `latexmk' also +provide similar functionality. The latter supports `biber' out +of the box. + +Alternatively, this may be a Lisp function that does the +processing, so you could use this to apply the machinery of +AUCTeX or the Emacs LaTeX mode. This function should accept the +file name as its single argument." + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "2 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "xelatex,bibtex,xelatex,xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (const :tag "latexmk" + ("latexmk -g -pdf %f")) + (function))) + +(defcustom org-latex-logfiles-extensions + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as LaTeX logfiles. +The logfiles will be remove if `org-latex-remove-logfiles' is +non-nil." + :group 'org-export-latex + :type '(repeat (string :tag "Extension"))) + +(defcustom org-latex-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +By default, logfiles are files with these extensions: .aux, .idx, +.log, .out, .toc, .nav, .snm and .vrb. To define the set of +logfiles to remove, set `org-latex-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-known-errors + '(("Reference.*?undefined" . "[undefined reference]") + ("Citation.*?undefined" . "[undefined citation]") + ("Undefined control sequence" . "[undefined control sequence]") + ("^! LaTeX.*?Error" . "[LaTeX error]") + ("^! Package.*?Error" . "[package error]") + ("Runaway argument" . "Runaway argument")) + "Alist of regular expressions and associated messages for the user. +The regular expressions are used to find possible errors in the +log of a latex-run." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons + (string :tag "Regexp") + (string :tag "Message")))) + + + +;;; Internal Functions + +(defun org-latex--caption/label-string (element info) + "Return caption and label LaTeX string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-latex--wrap-label'." + (let* ((label (org-element-property :name element)) + (label-str (if (not (org-string-nw-p label)) "" + (format "\\label{%s}" + (org-export-solidify-link-text label)))) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t)) + (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption))) + (cond + ((org-string-nw-p caption-from-attr-latex) + (concat caption-from-attr-latex "\n")) + ((and (not main) (equal label-str "")) "") + ((not main) (concat label-str "\n")) + ;; Option caption format with short name. + (short (format "\\caption[%s]{%s%s}\n" + (org-export-data short info) + label-str + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\caption{%s%s}\n" label-str (org-export-data main info)))))) + +(defun org-latex-guess-inputenc (header) + "Set the coding system in inputenc to what the buffer is. + +HEADER is the LaTeX header string. This function only applies +when specified inputenc option is \"AUTO\". + +Return the new header, as a string." + (let* ((cs (or (ignore-errors + (latexenc-coding-system-to-inputenc + (or org-export-coding-system buffer-file-coding-system))) + "utf8"))) + (if (not cs) header + ;; First translate if that is requested. + (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs)) + ;; Then find the \usepackage statement and replace the option. + (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" + cs header t nil 1)))) + +(defun org-latex-guess-babel-language (header info) + "Set Babel's language according to LANGUAGE keyword. + +HEADER is the LaTeX header string. INFO is the plist used as +a communication channel. + +Insertion of guessed language only happens when Babel package has +explicitly been loaded. Then it is added to the rest of +package's options. + +The argument to Babel may be \"AUTO\" which is then replaced with +the language of the document or `org-export-default-language' +unless language in question is already loaded. + +Return the new header." + (let ((language-code (plist-get info :language))) + ;; If no language is set or Babel package is not loaded, return + ;; HEADER as-is. + (if (or (not (stringp language-code)) + (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) + header + (let ((options (save-match-data + (org-split-string (match-string 1 header) ",[ \t]*"))) + (language (cdr (assoc language-code + org-latex-babel-language-alist)))) + ;; If LANGUAGE is already loaded, return header without AUTO. + ;; Otherwise, replace AUTO with language or append language if + ;; AUTO is not present. + (replace-match + (mapconcat (lambda (option) (if (equal "AUTO" option) language option)) + (cond ((member language options) (delete "AUTO" options)) + ((member "AUTO" options) options) + (t (append options (list language)))) + ", ") + t nil header 1))))) + +(defun org-latex--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-latex--make-option-string (options) + "Return a comma separated string of keywords and values. +OPTIONS is an alist where the key is the options keyword as +a string, and the value a list containing the keyword value, or +nil." + (mapconcat (lambda (pair) + (concat (first pair) + (when (> (length (second pair)) 0) + (concat "=" (second pair))))) + options + ",")) + +(defun org-latex--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-latex--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output + (concat (format "\\label{%s}\n" (org-export-solidify-link-text label)) + output)))) + +(defun org-latex--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-latex-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-latex-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ;; Handle the `verb' special case: Find and appropriate separator + ;; and use "\\verb" command. + ((eq 'verb fmt) + (let ((separator (org-latex--find-verb-separator text))) + (concat "\\verb" separator text separator))) + ;; Handle the `protectedtexttt' special case: Protect some + ;; special chars and use "\texttt{%s}" format string. + ((eq 'protectedtexttt fmt) + (let ((start 0) + (trans '(("\\" . "\\textbackslash{}") + ("~" . "\\textasciitilde{}") + ("^" . "\\textasciicircum{}"))) + (rtn "") + char) + (while (string-match "[\\{}$%&_#~^]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq text (concat rtn text) + fmt "\\texttt{%s}") + (while (string-match "--" text) + (setq text (replace-match "-{}-" t t text))) + (format fmt text))) + ;; Else use format string. + (t (format fmt text))))) + +(defun org-latex--delayed-footnotes-definitions (element info) + "Return footnotes definitions in ELEMENT as a string. + +INFO is a plist used as a communication channel. + +Footnotes definitions are returned within \"\\footnotetxt{}\" +commands. + +This function is used within constructs that don't support +\"\\footnote{}\" command (i.e. an item's tag). In that case, +\"\\footnotemark\" is used within the construct and the function +just outside of it." + (mapconcat + (lambda (ref) + (format + "\\footnotetext[%s]{%s}" + (org-export-get-footnote-number ref info) + (org-trim + (org-export-data + (org-export-get-footnote-definition ref info) info)))) + ;; Find every footnote reference in ELEMENT. + (let* (all-refs + search-refs ; For byte-compiler. + (search-refs + (function + (lambda (data) + ;; Return a list of all footnote references never seen + ;; before in DATA. + (org-element-map data 'footnote-reference + (lambda (ref) + (when (org-export-footnote-first-reference-p ref info) + (push ref all-refs) + (when (eq (org-element-property :type ref) 'standard) + (funcall search-refs + (org-export-get-footnote-definition ref info))))) + info) + (reverse all-refs))))) + (funcall search-refs element)) + "")) + + + +;;; Template + +(defun org-latex-template (contents info) + "Return complete document string after LaTeX conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info))) + (concat + ;; Time-stamp. + (and (plist-get info :time-stamp-file) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; Document class and packages. + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (plist-get info :latex-header-extra))))) + info))) + ;; Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; Author. + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info)))) + (cond ((and author email (not (string= "" email))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + ((or author email) (format "\\author{%s}\n" (or author email))))) + ;; Date. + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) + ;; Title + (format "\\title{%s}\n" title) + ;; Hyperref options. + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) + ;; Document start. + "\\begin{document}\n\n" + ;; Title command. + (org-element-normalize-string + (cond ((string= "" title) nil) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + org-latex-toc-command))) + ;; Document's body. + contents + ;; Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; Document end. + "\\end{document}"))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-latex-bold (bold contents info) + "Transcode BOLD from Org to LaTeX. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'bold)) + + +;;;; Center Block + +(defun org-latex-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + center-block + (format "\\begin{center}\n%s\\end{center}" contents))) + + +;;;; Clock + +(defun org-latex-clock (clock contents info) + "Transcode a CLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (format "\\textbf{%s} " org-clock-string) + (format org-latex-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + "\\\\")) + + +;;;; Code + +(defun org-latex-code (code contents info) + "Transcode a CODE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value code) 'code)) + + +;;;; Drawer + +(defun org-latex-drawer (drawer contents info) + "Transcode a DRAWER element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-latex-format-drawer-function + name contents))) + (org-latex--wrap-label drawer output))) + + +;;;; Dynamic Block + +(defun org-latex-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-latex--wrap-label dynamic-block contents)) + + +;;;; Entity + +(defun org-latex-entity (entity contents info) + "Transcode an ENTITY object from Org to LaTeX. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) + + +;;;; Example Block + +(defun org-latex-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (org-string-nw-p (org-element-property :value example-block)) + (org-latex--wrap-label + example-block + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default example-block info))))) + + +;;;; Export Block + +(defun org-latex-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (member (org-element-property :type export-block) '("LATEX" "TEX")) + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Export Snippet + +(defun org-latex-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'latex) + (org-element-property :value export-snippet))) + + +;;;; Fixed Width + +(defun org-latex-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-latex--wrap-label + fixed-width + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;;; Footnote Reference + +(defun org-latex-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-latex-footnote-separator)) + (cond + ;; Use \footnotemark if the footnote has already been defined. + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (format "\\footnotemark[%s]{}" + (org-export-get-footnote-number footnote-reference info))) + ;; Use \footnotemark if reference is within another footnote + ;; reference, footnote definition or table cell. + ((loop for parent in (org-export-get-genealogy footnote-reference) + thereis (memq (org-element-type parent) + '(footnote-reference footnote-definition table-cell))) + "\\footnotemark") + ;; Otherwise, define it with \footnote command. + (t + (let ((def (org-export-get-footnote-definition footnote-reference info))) + (concat + (format "\\footnote{%s}" (org-trim (org-export-data def info))) + ;; Retrieve all footnote references within the footnote and + ;; add their definition after it, since LaTeX doesn't support + ;; them inside. + (org-latex--delayed-footnotes-definitions def info))))))) + + +;;;; Headline + +(defun org-latex-headline (headline contents info) + "Transcode a HEADLINE element from Org to LaTeX. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (unless (org-element-property :footnote-section-p headline) + (let* ((class (plist-get info :latex-class)) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + (class-sectioning (assoc class org-latex-classes)) + ;; Section formatting will set two placeholders: one for + ;; the title and the other for the contents. + (section-fmt + (let ((sec (if (functionp (nth 2 class-sectioning)) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. Add + ;; placeholder for contents. + ((stringp sec) (concat sec "\n%s")) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) + ;; (numbered-open numbered-close) + ((= (length sec) 2) + (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) + ;; (num-in num-out no-num-in no-num-out) + ((= (length sec) 4) + (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) + (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) + (text (org-export-data (org-element-property :title headline) info)) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + ;; Create the headline text along with a no-tag version. + ;; The latter is required to remove tags from toc. + (full-text (funcall org-latex-format-headline-function + todo todo-type priority text tags)) + ;; Associate \label to the headline for internal links. + (headline-label + (format "\\label{sec-%s}\n" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))) + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) + (if (or (not section-fmt) (org-export-low-level-p headline info)) + ;; This is a deep sub-tree: export it as a list item. Also + ;; export as items headlines for which no section format has + ;; been found. + (let ((low-level-body + (concat + ;; If headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) + ;; Itemize headline + "\\item " full-text "\n" headline-label pre-blanks contents))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before + ;; any blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) + low-level-body))) + ;; This is a standard headline. Export it as a section. Add + ;; an alternative heading when possible, and when this is not + ;; identical to the usual heading. + (let ((opt-title + (funcall org-latex-format-headline-function + todo todo-type priority + (org-export-data + (org-export-get-alt-title headline info) info) + (and (eq (plist-get info :with-tags) t) tags)))) + (if (and numberedp opt-title + (not (equal opt-title full-text)) + (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt)) + (format (replace-match "\\1[%s]" nil nil section-fmt 1) + ;; Replace square brackets with parenthesis + ;; since square brackets are not supported in + ;; optional arguments. + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string "\\]" ")" opt-title)) + full-text + (concat headline-label pre-blanks contents)) + ;; Impossible to add an alternative heading. Fallback to + ;; regular sectioning format string. + (format section-fmt full-text + (concat headline-label pre-blanks contents)))))))) + +(defun org-latex-format-headline-default-function + (todo todo-type priority text tags) + "Default format function for a headline. +See `org-latex-format-headline-function' for details." + (concat + (and todo (format "{\\bfseries\\sffamily %s} " todo)) + (and priority (format "\\framebox{\\#%c} " priority)) + text + (and tags + (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":"))))) + + +;;;; Horizontal Rule + +(defun org-latex-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) + (prev (org-export-get-previous-element horizontal-rule info))) + (concat + ;; Make sure the rule doesn't start at the end of the current + ;; line by separating it with a blank line from previous element. + (when (and prev + (let ((prev-blank (org-element-property :post-blank prev))) + (or (not prev-blank) (zerop prev-blank)))) + "\n") + (org-latex--wrap-label + horizontal-rule + (format "\\rule{%s}{%s}" + (or (plist-get attr :width) "\\linewidth") + (or (plist-get attr :thickness) "0.5pt")))))) + + +;;;; Inline Src Block + +(defun org-latex-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block)) + (separator (org-latex--find-verb-separator code))) + (cond + ;; Do not use a special package: transcode it verbatim. + ((not org-latex-listings) + (concat "\\verb" separator code separator)) + ;; Use minted package. + ((eq org-latex-listings 'minted) + (let* ((org-lang (org-element-property :language inline-src-block)) + (mint-lang (or (cadr (assq (intern org-lang) + org-latex-minted-langs)) + org-lang)) + (options (org-latex--make-option-string + org-latex-minted-options))) + (concat (format "\\mint%s{%s}" + (if (string= options "") "" (format "[%s]" options)) + mint-lang) + separator code separator))) + ;; Use listings package. + (t + ;; Maybe translate language's name. + (let* ((org-lang (org-element-property :language inline-src-block)) + (lst-lang (or (cadr (assq (intern org-lang) + org-latex-listings-langs)) + org-lang)) + (options (org-latex--make-option-string + (append org-latex-listings-options + `(("language" ,lst-lang)))))) + (concat (format "\\lstinline[%s]" options) + separator code separator)))))) + + +;;;; Inlinetask + +(defun org-latex-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-latex-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (not (eq org-latex-format-inlinetask-function 'ignore)) + (funcall org-latex-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (org-latex--wrap-label + inlinetask + (let ((full-title + (concat + (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) + (when priority (format "\\framebox{\\#%c} " priority)) + title + (when tags (format "\\hfill{}\\textsc{:%s:}" + (mapconcat 'identity tags ":")))))) + (format (concat "\\begin{center}\n" + "\\fbox{\n" + "\\begin{minipage}[c]{.6\\textwidth}\n" + "%s\n\n" + "\\rule[.8em]{\\textwidth}{2pt}\n\n" + "%s" + "\\end{minipage}\n" + "}\n" + "\\end{center}") + full-title contents)))))) + + +;;;; Italic + +(defun org-latex-italic (italic contents info) + "Transcode ITALIC from Org to LaTeX. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'italic)) + + +;;;; Item + +(defun org-latex-item (item contents info) + "Transcode an ITEM element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((counter + (let ((count (org-element-property :counter item)) + (level + ;; Determine level of current item to determine the + ;; correct LaTeX counter to use (enumi, enumii...). + (let ((parent item) (level 0)) + (while (memq (org-element-type + (setq parent (org-export-get-parent parent))) + '(plain-list item)) + (when (and (eq (org-element-type parent) 'plain-list) + (eq (org-element-property :type parent) + 'ordered)) + (incf level))) + level))) + (and count + (< level 5) + (format "\\setcounter{enum%s}{%s}\n" + (nth (1- level) '("i" "ii" "iii" "iv")) + (1- count))))) + (checkbox (case (org-element-property :checkbox item) + (on "$\\boxtimes$ ") + (off "$\\square$ ") + (trans "$\\boxminus$ "))) + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "[{%s}] " + (concat checkbox + (org-export-data tag info))))))) + (concat counter "\\item" (or tag (concat " " checkbox)) + (and contents (org-trim contents)) + ;; If there are footnotes references in tag, be sure to + ;; add their definition at the end of the item. This + ;; workaround is necessary since "\footnote{}" command is + ;; not supported in tags. + (and tag + (org-latex--delayed-footnotes-definitions + (org-element-property :tag item) info))))) + + +;;;; Keyword + +(defun org-latex-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "LATEX") value) + ((string= key "INDEX") (format "\\index{%s}" value)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (concat + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents"))) + ((string= "tables" value) "\\listoftables") + ((string= "listings" value) + (cond + ((eq org-latex-listings 'minted) "\\listoflistings") + (org-latex-listings "\\lstlistoflistings") + ;; At the moment, src blocks with a caption are wrapped + ;; into a figure environment. + (t "\\listoffigures"))))))))) + + +;;;; Latex Environment + +(defun org-latex-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (let ((label (org-element-property :name latex-environment)) + (value (org-remove-indentation + (org-element-property :value latex-environment)))) + (if (not (org-string-nw-p label)) value + ;; Environment is labeled: label must be within the environment + ;; (otherwise, a reference pointing to that element will count + ;; the section instead). + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (forward-line) + (insert + (format "\\label{%s}\n" (org-export-solidify-link-text label))) + (buffer-string)))))) + + +;;;; Latex Fragment + +(defun org-latex-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) + + +;;;; Line Break + +(defun org-latex-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + "\\\\\n") + + +;;;; Link + +(defun org-latex--inline-image (link info) + "Return LaTeX code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (let* ((parent (org-export-get-parent-element link)) + (path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) + (filetype (file-name-extension path)) + (caption (org-latex--caption/label-string parent info)) + ;; Retrieve latex attributes from the element around. + (attr (org-export-read-attribute :attr_latex parent)) + (float (let ((float (plist-get attr :float))) + (cond ((and (not float) (plist-member attr :float)) nil) + ((string= float "wrap") 'wrap) + ((string= float "multicolumn") 'multicolumn) + ((or float + (org-element-property :caption parent) + (org-string-nw-p (plist-get attr :caption))) + 'figure)))) + (placement + (let ((place (plist-get attr :placement))) + (cond (place (format "%s" place)) + ((eq float 'wrap) "{l}{0.5\\textwidth}") + ((eq float 'figure) + (format "[%s]" org-latex-default-figure-position)) + (t "")))) + (comment-include (if (plist-get attr :comment-include) "%" "")) + ;; It is possible to specify width and height in the + ;; ATTR_LATEX line, and also via default variables. + (width (cond ((plist-get attr :width)) + ((plist-get attr :height) "") + ((eq float 'wrap) "0.48\\textwidth") + (t org-latex-image-default-width))) + (height (cond ((plist-get attr :height)) + ((or (plist-get attr :width) + (memq float '(figure wrap))) "") + (t org-latex-image-default-height))) + (options (let ((opt (or (plist-get attr :options) + org-latex-image-default-option))) + (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt + (match-string 1 opt)))) + image-code) + (if (member filetype '("tikz" "pgf")) + ;; For tikz images: + ;; - use \input to read in image file. + ;; - if options are present, wrap in a tikzpicture environment. + ;; - if width or height are present, use \resizebox to change + ;; the image size. + (progn + (setq image-code (format "\\input{%s}" path)) + (when (org-string-nw-p options) + (setq image-code + (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}" + options + image-code))) + (when (or (org-string-nw-p width) (org-string-nw-p height)) + (setq image-code (format "\\resizebox{%s}{%s}{%s}" + (if (org-string-nw-p width) width "!") + (if (org-string-nw-p height) height "!") + image-code)))) + ;; For other images: + ;; - add width and height to options. + ;; - include the image with \includegraphics. + (when (org-string-nw-p width) + (setq options (concat options ",width=" width))) + (when (org-string-nw-p height) + (setq options (concat options ",height=" height))) + (setq image-code + (format "\\includegraphics%s{%s}" + (cond ((not (org-string-nw-p options)) "") + ((= (aref options 0) ?,) + (format "[%s]"(substring options 1))) + (t (format "[%s]" options))) + path)) + (when (equal filetype "svg") + (setq image-code (replace-regexp-in-string "^\\\\includegraphics" + "\\includesvg" + image-code + nil t)) + (setq image-code (replace-regexp-in-string "\\.svg}" + "}" + image-code + nil t)))) + ;; Return proper string, depending on FLOAT. + (case float + (wrap (format "\\begin{wrapfigure}%s +\\centering +%s%s +%s\\end{wrapfigure}" placement comment-include image-code caption)) + (multicolumn (format "\\begin{figure*}%s +\\centering +%s%s +%s\\end{figure*}" placement comment-include image-code caption)) + (figure (format "\\begin{figure}%s +\\centering +%s%s +%s\\end{figure}" placement comment-include image-code caption)) + (otherwise image-code)))) + +(defun org-latex-link (link desc info) + "Transcode a LINK object from Org to LaTeX. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-latex-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (if (not (file-name-absolute-p raw-path)) raw-path + (concat "file://" (expand-file-name raw-path)))) + (t raw-path))) + protocol) + (cond + ;; Image file. + (imagep (org-latex--inline-image link info)) + ;; Radio link: Transcode target's contents and use them as link's + ;; description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "\\hyperref[%s]{%s}" + (org-export-solidify-link-text path) + (org-export-data (org-element-contents destination) info))))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "\\href{%s}{%s}" destination desc) + (format "\\url{%s}" destination))) + ;; Fuzzy link points nowhere. + ('nil + (format org-latex-link-with-unknown-path-format + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; LINK points to a headline. If headlines are numbered + ;; and the link has no description, display headline's + ;; number. Otherwise, display description or headline's + ;; title. + (headline + (let ((label + (format "sec-%s" + (mapconcat + 'number-to-string + (org-export-get-headline-number destination info) + "-")))) + (if (and (plist-get info :section-numbers) (not desc)) + (format "\\ref{%s}" label) + (format "\\hyperref[%s]{%s}" label + (or desc + (org-export-data + (org-element-property :title destination) info)))))) + ;; Fuzzy link points to a target. Do as above. + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "\\ref{%s}" path) + (format "\\hyperref[%s]{%s}" path desc))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'latex)) + ;; External link with a description part. + ((and path desc) (format "\\href{%s}{%s}" path desc)) + ;; External link without a description part. + (path (format "\\url{%s}" path)) + ;; No path, only description. Try to do something useful. + (t (format org-latex-link-with-unknown-path-format desc))))) + + +;;;; Paragraph + +(defun org-latex-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to LaTeX. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + contents) + + +;;;; Plain List + +(defun org-latex-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to LaTeX. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attr (org-export-read-attribute :attr_latex plain-list)) + (latex-type (let ((env (plist-get attr :environment))) + (cond (env (format "%s" env)) + ((eq type 'ordered) "enumerate") + ((eq type 'unordered) "itemize") + ((eq type 'descriptive) "description"))))) + (org-latex--wrap-label + plain-list + (format "\\begin{%s}%s\n%s\\end{%s}" + latex-type + ;; Put optional arguments, if any inside square brackets + ;; when necessary. + (let ((options (format "%s" (or (plist-get attr :options) "")))) + (cond ((equal options "") "") + ((string-match "\\`\\[.*\\]\\'" options) options) + (t (format "[%s]" options)))) + contents + latex-type)))) + + +;;;; Plain Text + +(defun org-latex-plain-text (text info) + "Transcode a TEXT string from Org to LaTeX. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((specialp (plist-get info :with-special-strings)) + (output text)) + ;; Protect %, #, &, $, _, { and }. + (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output) + (setq output + (replace-match + (format "\\%s" (match-string 2 output)) nil t output 2))) + ;; Protect ^. + (setq output + (replace-regexp-in-string + "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2)) + ;; Protect \. If special strings are used, be careful not to + ;; protect "\" in "\-" constructs. + (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\"))) + (setq output + (replace-regexp-in-string + (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols) + "$\\backslash$" output nil t 1))) + ;; Protect ~. + (setq output + (replace-regexp-in-string + "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :latex info text))) + ;; LaTeX into \LaTeX{} and TeX into \TeX{}. + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start) + (setq output (replace-match + (format "\\%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when specialp + (setq output + (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-latex-planning (planning contents info) + "Transcode a PLANNING element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "\\textbf{%s} " org-closed-string) + (format org-latex-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "\\textbf{%s} " org-deadline-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "\\textbf{%s} " org-scheduled-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) + " ") + "\\\\")) + + +;;;; Quote Block + +(defun org-latex-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + quote-block + (format "\\begin{quote}\n%s\\end{quote}" contents))) + + +;;;; Quote Section + +(defun org-latex-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) + + +;;;; Radio Target + +(defun org-latex-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to LaTeX. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "\\label{%s}%s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + + +;;;; Section + +(defun org-latex-section (section contents info) + "Transcode a SECTION element from Org to LaTeX. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;;; Special Block + +(defun org-latex-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (opt (org-export-read-attribute :attr_latex special-block :options))) + (concat (format "\\begin{%s}%s\n" type (or opt "")) + ;; Insert any label or caption within the block + ;; (otherwise, a reference pointing to that element will + ;; count the section instead). + (org-latex--caption/label-string special-block info) + contents + (format "\\end{%s}" type)))) + + +;;;; Src Block + +(defun org-latex-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (when (org-string-nw-p (org-element-property :value src-block)) + (let* ((lang (org-element-property :language src-block)) + (caption (org-element-property :caption src-block)) + (label (org-element-property :name src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-latex-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block)) + (attributes (org-export-read-attribute :attr_latex src-block)) + (float (plist-get attributes :float))) + (cond + ;; Case 1. No source fontification. + ((not org-latex-listings) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}" + org-latex-default-figure-position + caption-str)) + ((or caption float) + (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}" + caption-str)) + (t "%s")))) + (format + float-env + (concat (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default src-block info)))))) + ;; Case 2. Custom environment. + (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" + custom-env + (org-export-format-code-default src-block info) + custom-env)) + ;; Case 3. Use minted package. + ((eq org-latex-listings 'minted) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{listing*}\n%%s\n%s\\end{listing*}" + caption-str)) + ((or caption float) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + caption-str)) + (t "%s"))) + (body + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + ;; Options. + (org-latex--make-option-string + (if (or (not num-start) + (assoc "linenos" org-latex-minted-options)) + org-latex-minted-options + (append + `(("linenos") + ("firstnumber" ,(number-to-string (1+ num-start)))) + org-latex-minted-options))) + ;; Language. + (or (cadr (assq (intern lang) org-latex-minted-langs)) lang) + ;; Source code. + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) + "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line + ;; of code. + (concat (make-string (+ (- max-width (length loc)) 6) + ?\s) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))) + ;; Return value. + (format float-env body))) + ;; Case 4. Use listings package. + (t + (let ((lst-lang + (or (cadr (assq (intern lang) org-latex-listings-langs)) lang)) + (caption-str + (when caption + (let ((main (org-export-get-caption src-block)) + (secondary (org-export-get-caption src-block t))) + (if (not secondary) + (format "{%s}" (org-export-data main info)) + (format "{[%s]%s}" + (org-export-data secondary info) + (org-export-data main info))))))) + (concat + ;; Options. + (format + "\\lstset{%s}\n" + (org-latex--make-option-string + (append + org-latex-listings-options + (cond + ((and (not float) (plist-member attributes :float)) nil) + ((string= "multicolumn" float) '(("float" "*"))) + ((and float (not (assoc "float" org-latex-listings-options))) + `(("float" ,org-latex-default-figure-position)))) + `(("language" ,lst-lang)) + (when label `(("label" ,label))) + (when caption-str `(("caption" ,caption-str))) + (cond ((assoc "numbers" org-latex-listings-options) nil) + ((not num-start) '(("numbers" "none"))) + ((zerop num-start) '(("numbers" "left"))) + (t `(("numbers" "left") + ("firstnumber" + ,(number-to-string (1+ num-start))))))))) + ;; Source code. + (format + "\\begin{lstlisting}\n%s\\end{lstlisting}" + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line of + ;; code + (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info)))))))))))) + + +;;;; Statistics Cookie + +(defun org-latex-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (replace-regexp-in-string + "%" "\\%" (org-element-property :value statistics-cookie) nil t)) + + +;;;; Strike-Through + +(defun org-latex-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to LaTeX. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'strike-through)) + + +;;;; Subscript + +(defun org-latex--script-size (object info) + "Transcode a subscript or superscript object. +OBJECT is an Org object. INFO is a plist used as a communication +channel." + (let ((in-script-p + ;; Non-nil if object is already in a sub/superscript. + (let ((parent object)) + (catch 'exit + (while (setq parent (org-export-get-parent parent)) + (let ((type (org-element-type parent))) + (cond ((memq type '(subscript superscript)) + (throw 'exit t)) + ((memq type org-element-all-elements) + (throw 'exit nil)))))))) + (type (org-element-type object)) + (output "")) + (org-element-map (org-element-contents object) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + ((entity latex-fragment) + (let ((data (org-trim (org-export-data obj info)))) + (string-match + "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" + data) + (setq output + (concat output + (match-string 1 data) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ ")))))) + (plain-text + (setq output + (format "%s\\text{%s}" output (org-export-data obj info)))) + (otherwise + (setq output + (concat output + (org-export-data obj info) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ "))))))) + info nil org-element-recursive-objects) + ;; Result. Do not wrap into math mode if already in a subscript + ;; or superscript. Do not wrap into curly brackets if OUTPUT is + ;; a single character. Also merge consecutive subscript and + ;; superscript into the same math snippet. + (concat (and (not in-script-p) + (let ((prev (org-export-get-previous-element object info))) + (or (not prev) + (not (eq (org-element-type prev) + (if (eq type 'subscript) 'superscript + 'subscript))) + (let ((blank (org-element-property :post-blank prev))) + (and blank (> blank 0))))) + "$") + (if (eq (org-element-type object) 'subscript) "_" "^") + (and (> (length output) 1) "{") + output + (and (> (length output) 1) "}") + (and (not in-script-p) + (or (let ((blank (org-element-property :post-blank object))) + (and blank (> blank 0))) + (not (eq (org-element-type + (org-export-get-next-element object info)) + (if (eq type 'subscript) 'superscript + 'subscript)))) + "$")))) + +(defun org-latex-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size subscript info)) + + +;;;; Superscript + +(defun org-latex-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size superscript info)) + + +;;;; Table +;; +;; `org-latex-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" mode. Otherwise, it +;; delegates the job to either `org-latex--table.el-table', +;; `org-latex--org-table' or `org-latex--math-table' functions, +;; depending of the type of the table and the mode requested. +;; +;; `org-latex--align-string' is a subroutine used to build alignment +;; string for Org tables. + +(defun org-latex-table (table contents info) + "Transcode a TABLE element from Org to LaTeX. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (if (eq (org-element-property :type table) 'table.el) + ;; "table.el" table. Convert it using appropriate tools. + (org-latex--table.el-table table info) + (let ((type (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode))) + (cond + ;; Case 1: Verbatim table. + ((string= type "verbatim") + (format "\\begin{verbatim}\n%s\n\\end{verbatim}" + ;; Re-create table, without affiliated keywords. + (org-trim (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Matrix. + ((or (string= type "math") (string= type "inline-math")) + (org-latex--math-table table info)) + ;; Case 3: Standard table. + (t (concat (org-latex--org-table table contents info) + ;; When there are footnote references within the + ;; table, insert their definition just after it. + (org-latex--delayed-footnotes-definitions table info))))))) + +(defun org-latex--align-string (table info) + "Return an appropriate LaTeX alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (or (org-export-read-attribute :attr_latex table :align) + (let (align) + ;; Extract column groups and alignment from first (non-rule) + ;; row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let ((borders (org-export-table-cell-borders cell info))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not align)) + (push "|" align)) + (push (case (org-export-table-cell-alignment cell info) + (left "l") + (right "r") + (center "c")) + align) + (when (memq 'right borders) (push "|" align)))) + info) + (apply 'concat (nreverse align))))) + +(defun org-latex--org-table (table contents info) + "Return appropriate LaTeX code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' property and +`table' as its `:mode' attribute." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + ;; Determine alignment string. + (alignment (org-latex--align-string table info)) + ;; Determine environment for the table: longtable, tabular... + (table-env (or (plist-get attr :environment) + org-latex-default-table-environment)) + ;; If table is a float, determine environment: table, table* + ;; or sidewaystable. + (float-env (unless (member table-env '("longtable" "longtabu")) + (let ((float (plist-get attr :float))) + (cond + ((and (not float) (plist-member attr :float)) nil) + ((string= float "sidewaystable") "sidewaystable") + ((string= float "multicolumn") "table*") + ((or float + (org-element-property :caption table) + (org-string-nw-p (plist-get attr :caption))) + "table"))))) + ;; Extract others display options. + (fontsize (let ((font (plist-get attr :font))) + (and font (concat font "\n")))) + (width (plist-get attr :width)) + (spreadp (plist-get attr :spread)) + (placement (or (plist-get attr :placement) + (format "[%s]" org-latex-default-figure-position))) + (centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + ;; Prepare the final format string for the table. + (cond + ;; Longtable. + ((equal "longtable" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtable}{%s}\n" alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtable}\n" + (and fontsize "}"))) + ;; Longtabu + ((equal "longtabu" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtabu}%s{%s}\n" + (if width + (format " %s %s " + (if spreadp "spread" "to") width) "") + alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtabu}\n" + (and fontsize "}"))) + ;; Others. + (t (concat (cond + (float-env + (concat (format "\\begin{%s}%s\n" float-env placement) + (if org-latex-table-caption-above caption "") + (when centerp "\\centering\n") + fontsize)) + (centerp (concat "\\begin{center}\n" fontsize)) + (fontsize (concat "{" fontsize))) + (cond ((equal "tabu" table-env) + (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}" + (if width (format + (if spreadp " spread %s " " to %s ") + width) "") + alignment + contents)) + (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}" + table-env + (if width (format "{%s}" width) "") + alignment + contents + table-env))) + (cond + (float-env + (concat (if org-latex-table-caption-above "" caption) + (format "\n\\end{%s}" float-env))) + (centerp "\n\\end{center}") + (fontsize "}"))))))) + +(defun org-latex--table.el-table (table info) + "Return appropriate LaTeX code for a table.el table. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `table.el' as its `:type' +property." + (require 'table) + ;; Ensure "*org-export-table*" buffer is empty. + (with-current-buffer (get-buffer-create "*org-export-table*") + (erase-buffer)) + (let ((output (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'latex "*org-export-table*") + (with-current-buffer "*org-export-table*" + (org-trim (buffer-string)))))) + (kill-buffer (get-buffer "*org-export-table*")) + ;; Remove left out comments. + (while (string-match "^%.*\n" output) + (setq output (replace-match "" t t output))) + (let ((attr (org-export-read-attribute :attr_latex table))) + (when (plist-get attr :rmlines) + ;; When the "rmlines" attribute is provided, remove all hlines + ;; but the the one separating heading from the table body. + (let ((n 0) (pos 0)) + (while (and (< (length output) pos) + (setq pos (string-match "^\\\\hline\n?" output pos))) + (incf n) + (unless (= n 2) (setq output (replace-match "" nil nil output)))))) + (let ((centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + (if (not centerp) output + (format "\\begin{center}\n%s\n\\end{center}" output)))))) + +(defun org-latex--math-table (table info) + "Return appropriate LaTeX code for a matrix. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `org' as its `:type' property and +`inline-math' or `math' as its `:mode' attribute.." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + (inlinep (equal (plist-get attr :mode) "inline-math")) + (env (or (plist-get attr :environment) + org-latex-default-table-environment)) + (contents + (mapconcat + (lambda (row) + ;; Ignore horizontal rules. + (when (eq (org-element-property :type row) 'standard) + ;; Return each cell unmodified. + (concat + (mapconcat + (lambda (cell) + (substring (org-element-interpret-data cell) 0 -1)) + (org-element-map row 'table-cell 'identity info) "&") + (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\") + "\n"))) + (org-element-map table 'table-row 'identity info) "")) + ;; Variables related to math clusters (contiguous math tables + ;; of the same type). + (mode (org-export-read-attribute :attr_latex table :mode)) + (prev (org-export-get-previous-element table info)) + (next (org-export-get-next-element table info)) + (same-mode-p + (lambda (table) + ;; Non-nil when TABLE has the same mode as current table. + (string= (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode) + mode)))) + (concat + ;; Opening string. If TABLE is in the middle of a table cluster, + ;; do not insert any. + (cond ((and prev + (eq (org-element-type prev) 'table) + (memq (org-element-property :post-blank prev) '(0 nil)) + (funcall same-mode-p prev)) + nil) + (inlinep "\\(") + ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption)) + (t "\\[")) + ;; Prefix. + (or (plist-get attr :math-prefix) "") + ;; Environment. Also treat special cases. + (cond ((equal env "array") + (let ((align (org-latex--align-string table info))) + (format "\\begin{array}{%s}\n%s\\end{array}" align contents))) + ((assoc env org-latex-table-matrix-macros) + (format "\\%s%s{\n%s}" + env + (or (plist-get attr :math-arguments) "") + contents)) + (t (format "\\begin{%s}\n%s\\end{%s}" env contents env))) + ;; Suffix. + (or (plist-get attr :math-suffix) "") + ;; Closing string. If TABLE is in the middle of a table cluster, + ;; do not insert any. If it closes such a cluster, be sure to + ;; close the cluster with a string matching the opening string. + (cond ((and next + (eq (org-element-type next) 'table) + (memq (org-element-property :post-blank table) '(0 nil)) + (funcall same-mode-p next)) + nil) + (inlinep "\\)") + ;; Find cluster beginning to know which environment to use. + ((let ((cluster-beg table) prev) + (while (and (setq prev (org-export-get-previous-element + cluster-beg info)) + (memq (org-element-property :post-blank prev) + '(0 nil)) + (funcall same-mode-p prev)) + (setq cluster-beg prev)) + (and (or (org-element-property :caption cluster-beg) + (org-element-property :name cluster-beg)) + "\n\\end{equation}"))) + (t "\\]"))))) + + +;;;; Table Cell + +(defun org-latex-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to LaTeX. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-latex-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-latex-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents) + (when (org-export-get-next-element table-cell info) " & "))) + + +;;;; Table Row + +(defun org-latex-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to LaTeX. +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (org-export-read-attribute :attr_latex + (org-export-get-parent table-row))) + (longtablep (member (or (plist-get attr :environment) + org-latex-default-table-environment) + '("longtable" "longtabu"))) + (booktabsp (if (plist-member attr :booktabs) + (plist-get attr :booktabs) + org-latex-tables-booktabs)) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; When BOOKTABS are activated enforce top-rule even when no + ;; hline was specifically marked. + (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") + ((and (memq 'top borders) (memq 'above borders)) "\\hline\n")) + contents "\\\\\n" + (cond + ;; Special case for long tables. Define header and footers. + ((and longtablep (org-export-table-row-ends-header-p table-row info)) + (format "%s +\\endhead +%s\\multicolumn{%d}{r}{Continued on next page} \\\\ +\\endfoot +\\endlastfoot" + (if booktabsp "\\midrule" "\\hline") + (if booktabsp "\\midrule" "\\hline") + ;; Number of columns. + (cdr (org-export-table-dimensions + (org-export-get-parent-table table-row) info)))) + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and booktabsp (memq 'bottom borders)) "\\bottomrule") + ((and (memq 'bottom borders) (memq 'below borders)) "\\hline") + ((memq 'below borders) (if booktabsp "\\midrule" "\\hline"))))))) + + +;;;; Target + +(defun org-latex-target (target contents info) + "Transcode a TARGET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\label{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;;; Timestamp + +(defun org-latex-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-latex-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) (format org-latex-active-timestamp-format value)) + ((inactive inactive-range) + (format org-latex-inactive-timestamp-format value)) + (otherwise (format org-latex-diary-timestamp-format value))))) + + +;;;; Underline + +(defun org-latex-underline (underline contents info) + "Transcode UNDERLINE from Org to LaTeX. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'underline)) + + +;;;; Verbatim + +(defun org-latex-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value verbatim) 'verbatim)) + + +;;;; Verse Block + +(defun org-latex-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to LaTeX. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (org-latex--wrap-label + verse-block + ;; In a verse environment, add a line break to each newline + ;; character and change each white space at beginning of a line + ;; into a space of 1 em. Also change each blank line with + ;; a vertical space of 1 em. + (progn + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" "\\\\vspace*{1em}" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) + (while (string-match "^[ \t]+" contents) + (let ((new-str (format "\\hspace*{%dem}" + (length (match-string 0 contents))))) + (setq contents (replace-match new-str nil t contents)))) + (format "\\begin{verse}\n%s\\end{verse}" contents)))) + + + +;;; End-user functions + +;;;###autoload +(defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a LaTeX buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org LATEX Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'latex "*Org LATEX Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +;;;###autoload +(defun org-latex-convert-region-to-latex () + "Assume the current region has org-mode syntax, and convert it to LaTeX. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an LaTeX buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'latex)) + +;;;###autoload +(defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a LaTeX file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-latex-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to LaTeX then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +(defun org-latex-compile (texfile &optional snippet) + "Compile a TeX file. + +TEXFILE is the name of the file being compiled. Processing is +done through the command specified in `org-latex-pdf-process'. + +When optional argument SNIPPET is non-nil, TEXFILE is a temporary +file used to preview a LaTeX snippet. In this case, do not +create a log buffer and do not bother removing log files. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile))) + (full-name (file-truename texfile)) + (out-dir (file-name-directory texfile)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p texfile) + (file-name-directory full-name) + default-directory)) + errors) + (unless snippet (message (format "Processing LaTeX file %s..." texfile))) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-latex-pdf-process) + (funcall org-latex-pdf-process (shell-quote-argument texfile))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF LaTeX Output*" buffer. + ((consp org-latex-pdf-process) + (let ((outbuf (and (not snippet) + (get-buffer-create "*Org PDF LaTeX Output*")))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-latex-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (and (not snippet) (org-latex--collect-errors outbuf))))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when (and (not snippet) org-latex-remove-logfiles) + (dolist (file (directory-files + out-dir t + (concat (regexp-quote base-name) + "\\(?:\\.[0-9]+\\)?" + "\\." + (regexp-opt org-latex-logfiles-extensions)))) + (delete-file file))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-latex--collect-errors (buffer) + "Collect some kind of errors from \"pdflatex\" command output. + +BUFFER is the buffer containing output. + +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t) + (let ((case-fold-search t) + (errors "")) + (dolist (latex-error org-latex-known-errors) + (when (save-excursion (re-search-forward (car latex-error) nil t)) + (setq errors (concat errors " " (cdr latex-error))))) + (and (org-string-nw-p errors) (org-trim errors))))))) + +;;;###autoload +(defun org-latex-publish-to-latex (plist filename pub-dir) + "Publish an Org file to LaTeX. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'latex filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-latex-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to PDF (via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-latex-publish-to-latex', PDF file is generated + ;; in working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile (org-publish-org-to 'latex filename ".tex" plist)) + pub-dir)) + + +(provide 'ox-latex) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-latex.el ends here diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el new file mode 100644 index 00000000000..f5653f1a2c2 --- /dev/null +++ b/lisp/org/ox-man.el @@ -0,0 +1,1260 @@ +;; ox-man.el --- Man Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Luis R Anaya +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements a Man back-end for Org generic exporter. +;; +;; To test it, run +;; +;; M-: (org-export-to-buffer 'man "*Test Man*") RET +;; +;; in an org-mode buffer then switch to the buffer to see the Man +;; export. See ox.el for more details on how this exporter works. +;; +;; It introduces one new buffer keywords: +;; "MAN_CLASS_OPTIONS". + +;;; Code: + +(require 'ox) + +(eval-when-compile (require 'cl)) + +(defvar org-export-man-default-packages-alist) +(defvar org-export-man-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'man + '((babel-call . org-man-babel-call) + (bold . org-man-bold) + (center-block . org-man-center-block) + (clock . org-man-clock) + (code . org-man-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-man-drawer) + (dynamic-block . org-man-dynamic-block) + (entity . org-man-entity) + (example-block . org-man-example-block) + (export-block . org-man-export-block) + (export-snippet . org-man-export-snippet) + (fixed-width . org-man-fixed-width) + (footnote-definition . org-man-footnote-definition) + (footnote-reference . org-man-footnote-reference) + (headline . org-man-headline) + (horizontal-rule . org-man-horizontal-rule) + (inline-babel-call . org-man-inline-babel-call) + (inline-src-block . org-man-inline-src-block) + (inlinetask . org-man-inlinetask) + (italic . org-man-italic) + (item . org-man-item) + (keyword . org-man-keyword) + (line-break . org-man-line-break) + (link . org-man-link) + (paragraph . org-man-paragraph) + (plain-list . org-man-plain-list) + (plain-text . org-man-plain-text) + (planning . org-man-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-man-quote-block) + (quote-section . org-man-quote-section) + (radio-target . org-man-radio-target) + (section . org-man-section) + (special-block . org-man-special-block) + (src-block . org-man-src-block) + (statistics-cookie . org-man-statistics-cookie) + (strike-through . org-man-strike-through) + (subscript . org-man-subscript) + (superscript . org-man-superscript) + (table . org-man-table) + (table-cell . org-man-table-cell) + (table-row . org-man-table-row) + (target . org-man-target) + (template . org-man-template) + (timestamp . org-man-timestamp) + (underline . org-man-underline) + (verbatim . org-man-verbatim) + (verse-block . org-man-verse-block)) + :export-block "MAN" + :menu-entry + '(?m "Export to MAN" + ((?m "As MAN file" org-man-export-to-man) + (?p "As PDF file" org-man-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-man-export-to-pdf t s v b) + (org-open-file (org-man-export-to-pdf nil s v b))))))) + :options-alist + '((:man-class "MAN_CLASS" nil nil t) + (:man-class-options "MAN_CLASS_OPTIONS" nil nil t) + (:man-header-extra "MAN_HEADER" nil nil newline))) + + + +;;; User Configurable Variables + +(defgroup org-export-man nil + "Options for exporting Org mode files to Man." + :tag "Org Export Man" + :group 'org-export) + +;;; Tables + +(defcustom org-man-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-man-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-table-scientific-notation "%sE%s" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e. \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + + +;;; Inlinetasks +;; Src blocks + +(defcustom org-man-source-highlight nil + "Use GNU source highlight to embellish source blocks " + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-source-highlight-langs + '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") + (scheme "scheme") + (c "c") (cc "cpp") (csharp "csharp") (d "d") + (fortran "fortran") (cobol "cobol") (pascal "pascal") + (ada "ada") (asm "asm") + (perl "perl") (cperl "perl") + (python "python") (ruby "ruby") (tcl "tcl") (lua "lua") + (java "java") (javascript "javascript") + (tex "latex") + (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4") + (ocaml "caml") (caml "caml") + (sql "sql") (sqlite "sql") + (html "html") (css "css") (xml "xml") + (bat "bat") (bison "bison") (clipper "clipper") + (ldap "ldap") (opa "opa") + (php "php") (postscript "postscript") (prolog "prolog") + (properties "properties") (makefile "makefile") + (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + + + +(defvar org-man-custom-lang-environments nil + "Alist mapping languages to language-specific Man environments. + +It is used during export of src blocks by the listings and +man packages. For example, + + \(setq org-man-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during man export." +) + + +;;; Compilation + +(defcustom org-man-pdf-process + '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf") + + "Commands to process a Man file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + + +By default, Org uses 3 runs of to do the processing. + +Alternatively, this may be a Lisp function that does the +processing. This function should accept the file name as +its single argument." + :group 'org-export-pdf + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" )) + (const :tag "3 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) + (function))) + +(defcustom org-man-logfiles-extensions + '("log" "out" "toc") + "The list of file extensions to consider as Man logfiles." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat (string :tag "Extension"))) + +(defcustom org-man-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +These are the .aux, .log, .out, and .toc files." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Internal Functions + +(defun org-man--caption/label-string (element info) + "Return caption and label Man string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-man--wrap-label'." + (let ((label (org-element-property :label element)) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t))) + (cond ((and (not main) (not label)) "") + ((not main) (format "\\fI%s\\fP" label)) + ;; Option caption format with short name. + (short (format "\\fR%s\\fP - \\fI\\P - %s\n" + (org-export-data short info) + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\fR%s\\fP" (org-export-data main info)))))) + +(defun org-man--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-man--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (or (not output) (not label) (string= output "") (string= label "")) + output + (concat (format "%s\n.br\n" label) output)))) + + + +;;; Template + +(defun org-man-template (contents info) + "Return complete document string after Man conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let* ((title (org-export-data (plist-get info :title) info)) + (attr (read (format "(%s)" + (mapconcat + #'identity + (list (plist-get info :man-class-options)) + " ")))) + (section-item (plist-get attr :section-id))) + + (concat + + (cond + ((and title (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" title section-item)) + ((and (string= "" title) (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" " " section-item)) + (title + (format ".TH \"%s\" \"1\" \n" title)) + (t + ".TH \" \" \"1\" ")) + contents))) + + + + +;;; Transcode Functions + +;;; Babel Call +;; +;; Babel Calls are ignored. + + +;;; Bold + +(defun org-man-bold (bold contents info) + "Transcode BOLD from Org to Man. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "\\fB%s\\fP" contents)) + + +;;; Center Block + +(defun org-man-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Man. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-man--wrap-label + center-block + (format ".ce %d\n.nf\n%s\n.fi" + (- (length (split-string contents "\n")) 1 ) + contents))) + + +;;; Clock + +(defun org-man-clock (clock contents info) + "Transcode a CLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + "" ) + + +;;; Code + +(defun org-man-code (code contents info) + "Transcode a CODE object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\\fC%s\\fP" code)) + + +;;; Comment +;; +;; Comments are ignored. + + +;;; Comment Block +;; +;; Comment Blocks are ignored. + + +;;; Drawer + +(defun org-man-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Man. + DRAWER holds the drawer information + CONTENTS holds the contents of the block. + INFO is a plist holding contextual information. " + contents) + + +;;; Dynamic Block + +(defun org-man-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-man--wrap-label dynamic-block contents)) + + +;;; Entity + +(defun org-man-entity (entity contents info) + "Transcode an ENTITY object from Org to Man. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;; Example Block + +(defun org-man-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (org-man--wrap-label + example-block + (format ".RS\n.nf\n%s\n.fi\n.RE" + (org-export-format-code-default example-block info)))) + + +;;; Export Block + +(defun org-man-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "MAN") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;; Export Snippet + +(defun org-man-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'man) + (org-element-property :value export-snippet))) + + +;;; Fixed Width + +(defun org-man-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-man--wrap-label + fixed-width + (format "\\fC\n%s\\fP" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;; Footnote Definition +;; +;; Footnote Definitions are ignored. + +;;; Footnote References +;; +;; Footnote References are Ignored + + +;;; Headline + +(defun org-man-headline (headline contents info) + "Transcode a HEADLINE element from Org to Man. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (case level + (1 ".SH \"%s\"\n%s") + (2 ".SS \"%s\"\n%s") + (3 ".SS \"%s\"\n%s") + (t nil))) + (text (org-export-data (org-element-property :title headline) info))) + + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((or (not section-fmt) (org-export-low-level-p headline info)) + ;; Build the real contents of the sub-tree. + (let ((low-level-body + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "%s\n" ".RS")) + ;; Itemize headline + ".TP\n.ft I\n" text "\n.ft\n" + contents ".RE"))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" "" + low-level-body)))) + + ;; Case 3. Standard headline. Export it as a section. + (t (format section-fmt text contents ))))) + +;;; Horizontal Rule +;; Not supported + +;;; Inline Babel Call +;; +;; Inline Babel Calls are ignored. + +;;; Inline Src Block + +(defun org-man-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block))) + (cond + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + (org-lang (org-element-property :language inline-src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat (expand-file-name "source-highlight") + " -s " lst-lang + " -f groff_man" + " -i " in-file + " -o " out-file ))) + + (if lst-lang + (let ((code-block "" )) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n" + code)))) + + ;; Do not use a special package: transcode it verbatim. + (t + (concat ".RS\n.nf\n" "\\fC" "\n" code "\n" + "\\fP\n.fi\n.RE\n"))))) + + +;;; Inlinetask +;;; Italic + +(defun org-man-italic (italic contents info) + "Transcode ITALIC from Org to Man. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Item + + +(defun org-man-item (item contents info) + + "Transcode an ITEM element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + + (let* ((bullet (org-element-property :bullet item)) + (type (org-element-property :type (org-element-property :parent item))) + (checkbox (case (org-element-property :checkbox item) + (on "\\o'\\(sq\\(mu'") ;; + (off "\\(sq ") ;; + (trans "\\o'\\(sq\\(mi'" ))) ;; + + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "\\fB%s\\fP" + (concat checkbox + (org-export-data tag info))))))) + + (if (and (null tag ) + (null checkbox)) + (let* ((bullet (org-trim bullet)) + (marker (cond ((string= "-" bullet) "\\(em") + ((string= "*" bullet) "\\(bu") + ((eq type 'ordered) + (format "%s " (org-trim bullet))) + (t "\\(dg")))) + (concat ".IP " marker " 4\n" + (org-trim (or contents " " )))) + ; else + (concat ".TP\n" (or tag (concat " " checkbox)) "\n" + (org-trim (or contents " " )))))) + +;;; Keyword + + +(defun org-man-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "MAN") value) + ((string= key "INDEX") nil) + ((string= key "TOC" ) nil)))) + + +;;; Line Break + +(defun org-man-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + ".br\n") + + +;;; Link + + +(defun org-man-link (link desc info) + "Transcode a LINK object from Org to Man. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (when (string-match "\\(.+\\)::.+" raw-path) + (setq raw-path (match-string 1 raw-path))) + (if (file-name-absolute-p raw-path) + (concat "file://" (expand-file-name raw-path)) + (concat "file://" raw-path))) + (t raw-path))) + protocol) + (cond + ;; External link with a description part. + ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) + ;; External link without a description part. + (path (format "\\fI%s\\fP" path)) + ;; No path, only description. Try to do something useful. + (t (format "\\fI%s\\fP" desc))))) + + +;;; Paragraph + +(defun org-man-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Man. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let ((parent (plist-get (nth 1 paragraph) :parent))) + (when parent + (let ((parent-type (car parent)) + (fixed-paragraph "")) + (cond ((and (eq parent-type 'item) + (plist-get (nth 1 parent) :bullet )) + (setq fixed-paragraph (concat "" contents))) + ((eq parent-type 'section) + (setq fixed-paragraph (concat ".PP\n" contents))) + ((eq parent-type 'footnote-definition) + (setq fixed-paragraph contents)) + (t (setq fixed-paragraph (concat "" contents)))) + fixed-paragraph )))) + + +;;; Plain List + +(defun org-man-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Man. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + contents) + +;;; Plain Text + +(defun org-man-plain-text (text info) + "Transcode a TEXT string from Org to Man. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect various chars. + (setq output (replace-regexp-in-string + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\" output nil t 1)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" + output))) + ;; Return value. + output)) + + + +;;; Planning + + +;;; Property Drawer + + +;;; Quote Block + +(defun org-man-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-man--wrap-label + quote-block + (format ".RS\n%s\n.RE" contents))) + +;;; Quote Section + +(defun org-man-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format ".RS\\fI%s\\fP\n.RE\n" value)))) + + +;;; Radio Target + +(defun org-man-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Man. +TEXT is the text of the target. INFO is a plist holding +contextual information." + text ) + + +;;; Section + +(defun org-man-section (section contents info) + "Transcode a SECTION element from Org to Man. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;; Special Block + +(defun org-man-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block)))) + (org-man--wrap-label + special-block + (format "%s\n" contents)))) + + +;;; Src Block + +(defun org-man-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (code (org-element-property :value src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-man-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block))) + (cond + ;; Case 1. No source fontification. + ((not org-man-source-highlight) + (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" + (org-export-format-code-default src-block info))) + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + + (org-lang (org-element-property :language src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_man " + " -i " in-file + " -o " out-file))) + + (if lst-lang + (let ((code-block "")) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))) + + +;;; Statistics Cookie + +(defun org-man-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;; Strike-Through + +(defun org-man-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to Man. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + +;;; Subscript + +(defun org-man-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\d\\s-2%s\\s+2\\u" contents)) + +;;; Superscript "^_%s$ + +(defun org-man-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\u\\s-2%s\\s+2\\d" contents)) + + +;;; Table +;; +;; `org-man-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" attribute. Otherwise, it +;; delegates the job to either `org-man-table--table.el-table' or +;; `org-man-table--org-table' functions, depending of the type of +;; the table. +;; +;; `org-man-table--align-string' is a subroutine used to build +;; alignment string for Org tables. + +(defun org-man-table (table contents info) + "Transcode a TABLE element from Org to Man. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (cond + ;; Case 1: verbatim table. + ((or org-man-tables-verbatim + (let ((attr (read (format "(%s)" + (mapconcat + #'identity + (org-element-property :attr_man table) + " "))))) + + (and attr (plist-get attr :verbatim)))) + + (format ".nf\n\\fC%s\\fP\n.fi" + ;; Re-create table, without affiliated keywords. + (org-trim + (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Standard table. + (t (org-man-table--org-table table contents info)))) + +(defun org-man-table--align-string (divider table info) + "Return an appropriate Man alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (let (alignment) + ;; Extract column groups and alignment from first (non-rule) row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let* ((borders (org-export-table-cell-borders cell info)) + (raw-width (org-export-table-cell-width cell info)) + (width-cm (when raw-width (/ raw-width 5))) + (width (if raw-width (format "w(%dc)" + (if (< width-cm 1) 1 width-cm)) ""))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not alignment)) + (push "|" alignment)) + (push + (case (org-export-table-cell-alignment cell info) + (left (concat "l" width divider)) + (right (concat "r" width divider)) + (center (concat "c" width divider))) + alignment) + (when (memq 'right borders) (push "|" alignment)))) + info) + (apply 'concat (reverse alignment)))) + +(defun org-man-table--org-table (table contents info) + "Return appropriate Man code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' attribute." + (let* ((attr (org-export-read-attribute :attr_man table)) + (label (org-element-property :name table)) + (caption (and (not (plist-get attr :disable-caption)) + (org-man--caption/label-string table info))) + (divider (if (plist-get attr :divider) "|" " ")) + + ;; Determine alignment string. + (alignment (org-man-table--align-string divider table info)) + ;; Extract others display options. + + (lines (org-split-string contents "\n")) + + (attr-list + (delq nil + (list + (and (plist-get attr :expand) "expand") + (let ((placement (plist-get attr :placement))) + (cond ((string= placement 'center) "center") + ((string= placement 'left) nil) + (t (if org-man-tables-centered "center" "")))) + (or (plist-get attr :boxtype) "box")))) + + (title-line (plist-get attr :title-line)) + (long-cells (plist-get attr :long-cells)) + + (table-format (concat + (format "%s" (or (car attr-list) "" )) + (or + (let ((output-list '())) + (when (cdr attr-list) + (dolist (attr-item (cdr attr-list)) + (setq output-list (concat output-list (format ",%s" attr-item))))) + output-list) + ""))) + + (first-line (when lines (org-split-string (car lines) "\t")))) + ;; Prepare the final format string for the table. + + + (cond + ;; Others. + (lines (concat ".TS\n " table-format ";\n" + + (format "%s.\n" + (let ((final-line "")) + (when title-line + (dotimes (i (length first-line)) + (setq final-line (concat final-line "cb" divider)))) + + (setq final-line (concat final-line "\n")) + + (if alignment + (setq final-line (concat final-line alignment)) + (dotimes (i (length first-line)) + (setq final-line (concat final-line "c" divider)))) + final-line )) + + (format "%s.TE\n" + (let ((final-line "") + (long-line "") + (lines (org-split-string contents "\n"))) + + (dolist (line-item lines) + (setq long-line "") + + (if long-cells + (progn + (if (string= line-item "_") + (setq long-line (format "%s\n" line-item)) + ;; else string = + (let ((cell-item-list (org-split-string line-item "\t"))) + (dolist (cell-item cell-item-list) + + (cond ((eq cell-item (car (last cell-item-list))) + (setq long-line (concat long-line + (format "T{\n%s\nT}\t\n" cell-item )))) + (t + (setq long-line (concat long-line + (format "T{\n%s\nT}\t" cell-item )))))) + long-line)) + ;; else long cells + (setq final-line (concat final-line long-line ))) + + (setq final-line (concat final-line line-item "\n")))) + final-line)) + + (and caption (format ".TB \"%s\"" caption))))))) + +;;; Table Cell + +(defun org-man-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Man +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-man-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-man-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents ) + (when (org-export-get-next-element table-cell info) "\t"))) + + +;;; Table Row + +(defun org-man-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Man +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (mapconcat 'identity + (org-element-property + :attr_man (org-export-get-parent table-row)) + " ")) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders + (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; Mark horizontal lines + (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) + contents + + (cond + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and (memq 'bottom borders) (memq 'below borders)) "\n_") + ((memq 'below borders) "\n_")))))) + + +;;; Target + +(defun org-man-target (target contents info) + "Transcode a TARGET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\fI%s\\fP" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;; Timestamp + +(defun org-man-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Man. + CONTENTS is nil. INFO is a plist holding contextual + information." + "" ) + + +;;; Underline + +(defun org-man-underline (underline contents info) + "Transcode UNDERLINE from Org to Man. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Verbatim + +(defun org-man-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format ".nf\n%s\n.fi" contents)) + + +;;; Verse Block + +(defun org-man-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Man. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (format ".RS\n.ft I\n%s\n.ft\n.RE" contents)) + + + +;;; Interactive functions + +(defun org-man-export-to-man + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a Man file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only the body +without any markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist))) + +(defun org-man-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to Groff then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write between +markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +(defun org-man-compile (file) + "Compile a Groff file. + +FILE is the name of the file being compiled. Processing is done +through the command specified in `org-man-pdf-process'. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p file) + (file-name-directory full-name) + default-directory)) + errors) + (message (format "Processing Groff file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-man-pdf-process) + (funcall org-man-pdf-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF Groff Output*" buffer. + ((consp org-man-pdf-process) + (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-man-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-man-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-man-remove-logfiles + (dolist (ext org-man-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-man-collect-errors (buffer) + "Collect some kind of errors from \"groff\" output +BUFFER is the buffer containing output. +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + ;; Find final run + nil ))) + + +(provide 'ox-man) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-man.el ends here diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el new file mode 100644 index 00000000000..50982add568 --- /dev/null +++ b/lisp/org/ox-md.el @@ -0,0 +1,485 @@ +;;; ox-md.el --- Markdown Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: org, wp, markdown + +;; 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 . + +;;; Commentary: + +;; This library implements a Markdown back-end (vanilla flavor) for +;; Org exporter, based on `html' back-end. See Org manual for more +;; information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-html) + + + +;;; User-Configurable Variables + +(defgroup org-export-md nil + "Options specific to Markdown export back-end." + :tag "Org Markdown" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(defcustom org-md-headline-style 'atx + "Style used to format headlines. +This variable can be set to either `atx' or `setext'." + :group 'org-export-md + :type '(choice + (const :tag "Use \"atx\" style" atx) + (const :tag "Use \"Setext\" style" setext))) + + + +;;; Define Back-End + +(org-export-define-derived-backend 'md 'html + :export-block '("MD" "MARKDOWN") + :filters-alist '((:filter-parse-tree . org-md-separate-elements)) + :menu-entry + '(?m "Export to Markdown" + ((?M "To temporary buffer" + (lambda (a s v b) (org-md-export-as-markdown a s v))) + (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v))) + (?o "To file and open" + (lambda (a s v b) + (if a (org-md-export-to-markdown t s v) + (org-open-file (org-md-export-to-markdown nil s v))))))) + :translate-alist '((bold . org-md-bold) + (code . org-md-verbatim) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (example-block . org-md-example-block) + (fixed-width . org-md-example-block) + (footnote-definition . ignore) + (footnote-reference . ignore) + (headline . org-md-headline) + (horizontal-rule . org-md-horizontal-rule) + (inline-src-block . org-md-verbatim) + (italic . org-md-italic) + (item . org-md-item) + (line-break . org-md-line-break) + (link . org-md-link) + (paragraph . org-md-paragraph) + (plain-list . org-md-plain-list) + (plain-text . org-md-plain-text) + (quote-block . org-md-quote-block) + (quote-section . org-md-example-block) + (section . org-md-section) + (src-block . org-md-example-block) + (template . org-md-template) + (verbatim . org-md-verbatim))) + + + +;;; Filters + +(defun org-md-separate-elements (tree backend info) + "Make sure elements are separated by at least one blank line. + +TREE is the parse tree being exported. BACKEND is the export +back-end used. INFO is a plist used as a communication channel. + +Assume BACKEND is `md'." + (org-element-map tree org-element-all-elements + (lambda (elem) + (unless (eq (org-element-type elem) 'org-data) + (org-element-put-property + elem :post-blank + (let ((post-blank (org-element-property :post-blank elem))) + (if (not post-blank) 1 (max 1 post-blank))))))) + ;; Return updated tree. + tree) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-md-bold (bold contents info) + "Transcode BOLD object into Markdown format. +CONTENTS is the text within bold markup. INFO is a plist used as +a communication channel." + (format "**%s**" contents)) + + +;;;; Code and Verbatim + +(defun org-md-verbatim (verbatim contents info) + "Transcode VERBATIM object into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((value (org-element-property :value verbatim))) + (format (cond ((not (string-match "`" value)) "`%s`") + ((or (string-match "\\``" value) + (string-match "`\\'" value)) + "`` %s ``") + (t "``%s``")) + value))) + + +;;;; Example Block and Src Block + +(defun org-md-example-block (example-block contents info) + "Transcode EXAMPLE-BLOCK element into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (replace-regexp-in-string + "^" " " + (org-remove-indentation + (org-element-property :value example-block)))) + + +;;;; Headline + +(defun org-md-headline (headline contents info) + "Transcode HEADLINE element into Markdown format. +CONTENTS is the headline contents. INFO is a plist used as +a communication channel." + (unless (org-element-property :footnote-section-p headline) + (let* ((level (org-export-get-relative-level headline info)) + (title (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword + headline))) + (and todo (concat (org-export-data todo info) " "))))) + (tags (and (plist-get info :with-tags) + (let ((tag-list (org-export-get-tags headline info))) + (and tag-list + (format " :%s:" + (mapconcat 'identity tag-list ":")))))) + (priority + (and (plist-get info :with-priority) + (let ((char (org-element-property :priority headline))) + (and char (format "[#%c] " char))))) + ;; Headline text without tags. + (heading (concat todo priority title))) + (cond + ;; Cannot create a headline. Fall-back to a list. + ((or (org-export-low-level-p headline info) + (not (memq org-md-headline-style '(atx setext))) + (and (eq org-md-headline-style 'atx) (> level 6)) + (and (eq org-md-headline-style 'setext) (> level 2))) + (let ((bullet + (if (not (org-export-numbered-headline-p headline info)) "-" + (concat (number-to-string + (car (last (org-export-get-headline-number + headline info)))) + ".")))) + (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags + "\n\n" + (and contents + (replace-regexp-in-string "^" " " contents))))) + ;; Use "Setext" style. + ((eq org-md-headline-style 'setext) + (concat heading tags "\n" + (make-string (length heading) (if (= level 1) ?= ?-)) + "\n\n" + contents)) + ;; Use "atx" style. + (t (concat (make-string level ?#) " " heading tags "\n\n" contents)))))) + + +;;;; Horizontal Rule + +(defun org-md-horizontal-rule (horizontal-rule contents info) + "Transcode HORIZONTAL-RULE element into Markdown format. +CONTENTS is the horizontal rule contents. INFO is a plist used +as a communication channel." + "---") + + +;;;; Italic + +(defun org-md-italic (italic contents info) + "Transcode ITALIC object into Markdown format. +CONTENTS is the text within italic markup. INFO is a plist used +as a communication channel." + (format "*%s*" contents)) + + +;;;; Item + +(defun org-md-item (item contents info) + "Transcode ITEM element into Markdown format. +CONTENTS is the item contents. INFO is a plist used as +a communication channel." + (let* ((type (org-element-property :type (org-export-get-parent item))) + (struct (org-element-property :structure item)) + (bullet (if (not (eq type 'ordered)) "-" + (concat (number-to-string + (car (last (org-list-get-item-number + (org-element-property :begin item) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct))))) + ".")))) + (concat bullet + (make-string (- 4 (length bullet)) ? ) + (case (org-element-property :checkbox item) + (on "[X] ") + (trans "[-] ") + (off "[ ] ")) + (let ((tag (org-element-property :tag item))) + (and tag (format "**%s:** "(org-export-data tag info)))) + (org-trim (replace-regexp-in-string "^" " " contents))))) + + +;;;; Line Break + +(defun org-md-line-break (line-break contents info) + "Transcode LINE-BREAK object into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + " \n") + + +;;;; Link + +(defun org-md-link (link contents info) + "Transcode LINE-BREAK object into Markdown format. +CONTENTS is the link's description. INFO is a plist used as +a communication channel." + (let ((--link-org-files-as-html-maybe + (function + (lambda (raw-path info) + ;; Treat links to `file.org' as links to `file.html', if + ;; needed. See `org-html-link-org-files-as-html'. + (cond + ((and org-html-link-org-files-as-html + (string= ".org" + (downcase (file-name-extension raw-path ".")))) + (concat (file-name-sans-extension raw-path) "." + (plist-get info :html-extension))) + (t raw-path))))) + (type (org-element-property :type link))) + (cond ((member type '("custom-id" "id")) + (let ((destination (org-export-resolve-id-link link info))) + (if (stringp destination) ; External file. + (let ((path (funcall --link-org-files-as-html-maybe + destination info))) + (if (not contents) (format "<%s>" path) + (format "[%s](%s)" contents path))) + (concat + (and contents (concat contents " ")) + (format "(%s)" + (format (org-export-translate "See section %s" :html info) + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) + "."))))))) + ((org-export-inline-image-p link org-html-inline-image-rules) + (let ((path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path))))) + (format "![%s](%s)" + (let ((caption (org-export-get-caption + (org-export-get-parent-element link)))) + (when caption (org-export-data caption info))) + path))) + ((string= type "coderef") + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref contents) + (org-export-resolve-coderef ref info)))) + ((equal type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (org-export-data (org-element-contents destination) info))) + ((equal type "fuzzy") + (let ((destination (org-export-resolve-fuzzy-link link info))) + (if (org-string-nw-p contents) contents + (when destination + (let ((number (org-export-get-ordinal destination info))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) + (t (let* ((raw-path (org-element-property :path link)) + (path (cond + ((member type '("http" "https" "ftp")) + (concat type ":" raw-path)) + ((equal type "file") + ;; Treat links to ".org" files as ".html", + ;; if needed. + (setq raw-path + (funcall --link-org-files-as-html-maybe + raw-path info)) + ;; If file path is absolute, prepend it + ;; with protocol component - "file://". + (if (not (file-name-absolute-p raw-path)) raw-path + (concat "file://" (expand-file-name raw-path)))) + (t raw-path)))) + (if (not contents) (format "<%s>" path) + (format "[%s](%s)" contents path))))))) + + +;;;; Paragraph + +(defun org-md-paragraph (paragraph contents info) + "Transcode PARAGRAPH element into Markdown format. +CONTENTS is the paragraph contents. INFO is a plist used as +a communication channel." + (let ((first-object (car (org-element-contents paragraph)))) + ;; If paragraph starts with a #, protect it. + (if (and (stringp first-object) (string-match "\\`#" first-object)) + (replace-regexp-in-string "\\`#" "\\#" contents nil t) + contents))) + + +;;;; Plain List + +(defun org-md-plain-list (plain-list contents info) + "Transcode PLAIN-LIST element into Markdown format. +CONTENTS is the plain-list contents. INFO is a plist used as +a communication channel." + contents) + + +;;;; Plain Text + +(defun org-md-plain-text (text info) + "Transcode a TEXT string into Markdown format. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (when (plist-get info :with-smart-quotes) + (setq text (org-export-activate-smart-quotes text :html info))) + ;; Protect ambiguous #. This will protect # at the beginning of + ;; a line, but not at the beginning of a paragraph. See + ;; `org-md-paragraph'. + (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text)) + ;; Protect ambiguous ! + (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1)) + ;; Protect `, *, _ and \ + (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text)) + ;; Handle special strings, if required. + (when (plist-get info :with-special-strings) + (setq text (org-html-convert-special-strings text))) + ;; Handle break preservation, if required. + (when (plist-get info :preserve-breaks) + (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text))) + ;; Return value. + text) + + +;;;; Quote Block + +(defun org-md-quote-block (quote-block contents info) + "Transcode QUOTE-BLOCK element into Markdown format. +CONTENTS is the quote-block contents. INFO is a plist used as +a communication channel." + (replace-regexp-in-string + "^" "> " + (replace-regexp-in-string "\n\\'" "" contents))) + + +;;;; Section + +(defun org-md-section (section contents info) + "Transcode SECTION element into Markdown format. +CONTENTS is the section contents. INFO is a plist used as +a communication channel." + contents) + + +;;;; Template + +(defun org-md-template (contents info) + "Return complete document string after Markdown conversion. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + contents) + + + +;;; Interactive function + +;;;###autoload +(defun org-md-export-as-markdown (&optional async subtreep visible-only) + "Export current buffer to a Markdown buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Export is done in a buffer named \"*Org MD Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (org-export-to-buffer 'md "*Org MD Export*" + async subtreep visible-only nil nil (lambda () (text-mode)))) + +;;;###autoload +(defun org-md-convert-region-to-md () + "Assume the current region has org-mode syntax, and convert it to Markdown. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in a Markdown buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'md)) + + +;;;###autoload +(defun org-md-export-to-markdown (&optional async subtreep visible-only) + "Export current buffer to a Markdown file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".md" subtreep))) + (org-export-to-file 'md outfile async subtreep visible-only))) + + +(provide 'ox-md) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-md.el ends here diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el new file mode 100644 index 00000000000..1e966fe108c --- /dev/null +++ b/lisp/org/ox-odt.el @@ -0,0 +1,4376 @@ +;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Jambunathan K +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'table nil 'noerror)) +(require 'format-spec) +(require 'ox) +(require 'org-compat) + +;;; Define Back-End + +(org-export-define-backend 'odt + '((bold . org-odt-bold) + (center-block . org-odt-center-block) + (clock . org-odt-clock) + (code . org-odt-code) + (drawer . org-odt-drawer) + (dynamic-block . org-odt-dynamic-block) + (entity . org-odt-entity) + (example-block . org-odt-example-block) + (export-block . org-odt-export-block) + (export-snippet . org-odt-export-snippet) + (fixed-width . org-odt-fixed-width) + (footnote-definition . org-odt-footnote-definition) + (footnote-reference . org-odt-footnote-reference) + (headline . org-odt-headline) + (horizontal-rule . org-odt-horizontal-rule) + (inline-src-block . org-odt-inline-src-block) + (inlinetask . org-odt-inlinetask) + (italic . org-odt-italic) + (item . org-odt-item) + (keyword . org-odt-keyword) + (latex-environment . org-odt-latex-environment) + (latex-fragment . org-odt-latex-fragment) + (line-break . org-odt-line-break) + (link . org-odt-link) + (paragraph . org-odt-paragraph) + (plain-list . org-odt-plain-list) + (plain-text . org-odt-plain-text) + (planning . org-odt-planning) + (property-drawer . org-odt-property-drawer) + (quote-block . org-odt-quote-block) + (quote-section . org-odt-quote-section) + (radio-target . org-odt-radio-target) + (section . org-odt-section) + (special-block . org-odt-special-block) + (src-block . org-odt-src-block) + (statistics-cookie . org-odt-statistics-cookie) + (strike-through . org-odt-strike-through) + (subscript . org-odt-subscript) + (superscript . org-odt-superscript) + (table . org-odt-table) + (table-cell . org-odt-table-cell) + (table-row . org-odt-table-row) + (target . org-odt-target) + (template . org-odt-template) + (timestamp . org-odt-timestamp) + (underline . org-odt-underline) + (verbatim . org-odt-verbatim) + (verse-block . org-odt-verse-block)) + :export-block "ODT" + :filters-alist '((:filter-parse-tree + . (org-odt--translate-latex-fragments + org-odt--translate-description-lists + org-odt--translate-list-tables))) + :menu-entry + '(?o "Export to ODT" + ((?o "As ODT file" org-odt-export-to-odt) + (?O "As ODT file and open" + (lambda (a s v b) + (if a (org-odt-export-to-odt t s v) + (org-open-file (org-odt-export-to-odt nil s v) 'system)))))) + :options-alist + '((:odt-styles-file "ODT_STYLES_FILE" nil nil t) + ;; Redefine regular option. + (:with-latex nil "tex" org-odt-with-latex))) + + +;;; Dependencies + +;;; Hooks + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function hfy-face-to-style "htmlfontify" (fn)) +(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) +(declare-function archive-zip-extract "arc-mode" (archive name)) +(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) +(declare-function browse-url-file-url "browse-url" (file)) + + + +;;; Internal Variables + +(defconst org-odt-lib-dir + (file-name-directory load-file-name) + "Location of ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defvar org-odt-data-dir + (expand-file-name "../../etc/" org-odt-lib-dir) + "Data directory for ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defconst org-odt-special-string-regexps + '(("\\\\-" . "­\\1") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-odt-schema-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./schema/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./schema/" org-odt-data-dir)))) + "List of directories to search for OpenDocument schema files. +Use this list to set the default value of +`org-odt-schema-dir'. The entries in this list are +populated heuristically based on the values of `org-odt-lib-dir' +and `org-odt-data-dir'.") + +(defconst org-odt-styles-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./styles/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./styles/" org-odt-data-dir))) + (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git + (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa + (expand-file-name "./org/" data-directory) ; system + ) + "List of directories to search for OpenDocument styles files. +See `org-odt-styles-dir'. The entries in this list are populated +heuristically based on the values of `org-odt-lib-dir' and +`org-odt-data-dir'.") + +(defconst org-odt-styles-dir + (let* ((styles-dir + (catch 'styles-dir + (message "Debug (ox-odt): Searching for OpenDocument styles files...") + (mapc (lambda (styles-dir) + (when styles-dir + (message "Debug (ox-odt): Trying %s..." styles-dir) + (when (and (file-readable-p + (expand-file-name + "OrgOdtContentTemplate.xml" styles-dir)) + (file-readable-p + (expand-file-name + "OrgOdtStyles.xml" styles-dir))) + (message "Debug (ox-odt): Using styles under %s" + styles-dir) + (throw 'styles-dir styles-dir)))) + org-odt-styles-dir-list) + nil))) + (unless styles-dir + (error "Error (ox-odt): Cannot find factory styles files, aborting")) + styles-dir) + "Directory that holds auxiliary XML files used by the ODT exporter. + +This directory contains the following XML files - + \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These + XML files are used as the default values of + `org-odt-styles-file' and + `org-odt-content-template-file'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-styles-dir-list'. Note that the user could be using org +from one of: org's own private git repository, GNU ELPA tar or +standard Emacs.") + +(defconst org-odt-bookmark-prefix "OrgXref.") + +(defconst org-odt-manifest-file-entry-tag + "\n") + +(defconst org-odt-file-extensions + '(("odt" . "OpenDocument Text") + ("ott" . "OpenDocument Text Template") + ("odm" . "OpenDocument Master Document") + ("ods" . "OpenDocument Spreadsheet") + ("ots" . "OpenDocument Spreadsheet Template") + ("odg" . "OpenDocument Drawing (Graphics)") + ("otg" . "OpenDocument Drawing Template") + ("odp" . "OpenDocument Presentation") + ("otp" . "OpenDocument Presentation Template") + ("odi" . "OpenDocument Image") + ("odf" . "OpenDocument Formula") + ("odc" . "OpenDocument Chart"))) + +(defconst org-odt-table-style-format + " + + + +" + "Template for auto-generated Table styles.") + +(defvar org-odt-automatic-styles '() + "Registry of automatic styles for various OBJECT-TYPEs. +The variable has the following form: +\(\(OBJECT-TYPE-A + \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) + \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) + \(OBJECT-TYPE-B + \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) + \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) + ...\). + +OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option to `org-odt-parse-block-attributes'. + +Use `org-odt-add-automatic-style' to add update this variable.'") + +(defvar org-odt-object-counters nil + "Running counters for various OBJECT-TYPEs. +Use this to generate automatic names and style-names. See +`org-odt-add-automatic-style'.") + +(defvar org-odt-src-block-paragraph-format + " + + + + + " + "Custom paragraph style for colorized source and example blocks. +This style is much the same as that of \"OrgFixedWidthBlock\" +except that the foreground and background colors are set +according to the default face identified by the `htmlfontify'.") + +(defvar hfy-optimisations) +(defvar org-odt-embedded-formulas-count 0) +(defvar org-odt-embedded-images-count 0) +(defvar org-odt-image-size-probe-method + (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 + '(emacs fixed)) + "Ordered list of methods for determining image sizes.") + +(defvar org-odt-default-image-sizes-alist + '(("as-char" . (5 . 0.4)) + ("paragraph" . (5 . 5))) + "Hardcoded image dimensions one for each of the anchor + methods.") + +;; A4 page size is 21.0 by 29.7 cms +;; The default page settings has 2cm margin on each of the sides. So +;; the effective text area is 17.0 by 25.7 cm +(defvar org-odt-max-image-size '(17.0 . 20.0) + "Limiting dimensions for an embedded image.") + +(defconst org-odt-label-styles + '(("math-formula" "%c" "text" "(%n)") + ("math-label" "(%n)" "text" "(%n)") + ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") + ("value" "%e %n: %c" "value" "%n")) + "Specify how labels are applied and referenced. + +This is an alist where each element is of the form: + + \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT) + +ATTACH-FMT controls how labels and captions are attached to an +entity. It may contain following specifiers - %e and %c. %e is +replaced with the CATEGORY-NAME. %n is replaced with +\" SEQNO \". %c is replaced +with CAPTION. + +REF-MODE and REF-FMT controls how label references are generated. +The following XML is generated for a label reference - +\" +REF-FMT \". REF-FMT may contain following +specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. +%n is replaced with SEQNO. + +See also `org-odt-format-label'.") + +(defvar org-odt-category-map-alist + '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p) + ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p) + ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p) + ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p) + ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)) + "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. + +This is a list where each entry is of the form: + + \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE) + +CATEGORY_HANDLE identifies the captionable entity in question. + +OD-VARIABLE is the OpenDocument sequence counter associated with +the entity. These counters are declared within +\"...\" block of +`org-odt-content-template-file'. + +LABEL-STYLE is a key into `org-odt-label-styles' and specifies +how a given entity should be captioned and referenced. + +CATEGORY-NAME is used for qualifying captions on export. + +ENUMERATOR-PREDICATE is used for assigning a sequence number to +the entity. See `org-odt--enumerate'.") + +(defvar org-odt-manifest-file-entries nil) +(defvar hfy-user-sheet-assoc) + +(defvar org-odt-zip-dir nil + "Temporary work directory for OpenDocument exporter.") + + + +;;; User Configuration Variables + +(defgroup org-export-odt nil + "Options for exporting Org mode files to ODT." + :tag "Org Export ODT" + :group 'org-export) + + +;;;; Debugging + +(defcustom org-odt-prettify-xml nil + "Specify whether or not the xml output should be prettified. +When this option is turned on, `indent-region' is run on all +component xml buffers before they are saved. Turn this off for +regular use. Turn this on if you need to examine the xml +visually." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + + +;;;; Document schema + +(require 'rng-loc) +(defcustom org-odt-schema-dir + (let* ((schema-dir + (catch 'schema-dir + (message "Debug (ox-odt): Searching for OpenDocument schema files...") + (mapc + (lambda (schema-dir) + (when schema-dir + (message "Debug (ox-odt): Trying %s..." schema-dir) + (when (and (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" + schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" + schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + (message "Debug (ox-odt): Using schema files under %s" + schema-dir) + (throw 'schema-dir schema-dir)))) + org-odt-schema-dir-list) + (message "Debug (ox-odt): No OpenDocument schema files installed") + nil))) + schema-dir) + "Directory that contains OpenDocument schema files. + +This directory contains: +1. rnc files for OpenDocument schema +2. a \"schemas.xml\" file that specifies locating rules needed + for auto validation of OpenDocument XML files. + +Use the customize interface to set this variable. This ensures +that `rng-schema-locating-files' is updated and auto-validation +of OpenDocument XML takes place based on the value +`rng-nxml-auto-validate-flag'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-schema-dir-list'. The OASIS schema files are available +only in the org's private git repository. It is *not* bundled +with GNU ELPA tar or standard Emacs distribution." + :type '(choice + (const :tag "Not set" nil) + (directory :tag "Schema directory")) + :group 'org-export-odt + :version "24.1" + :set + (lambda (var value) + "Set `org-odt-schema-dir'. +Also add it to `rng-schema-locating-files'." + (let ((schema-dir value)) + (set var + (if (and + (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + schema-dir + (when value + (message "Error (ox-odt): %s has no OpenDocument schema files" + value)) + nil))) + (when org-odt-schema-dir + (eval-after-load 'rng-loc + '(add-to-list 'rng-schema-locating-files + (expand-file-name "schemas.xml" + org-odt-schema-dir)))))) + + +;;;; Document styles + +(defcustom org-odt-content-template-file nil + "Template file for \"content.xml\". +The exporter embeds the exported content just before +\"\" element. + +If unspecified, the file named \"OrgOdtContentTemplate.xml\" +under `org-odt-styles-dir' is used." + :type '(choice (const nil) + (file)) + :group 'org-export-odt + :version "24.3") + +(defcustom org-odt-styles-file nil + "Default styles file for use with ODT export. +Valid values are one of: +1. nil +2. path to a styles.xml file +3. path to a *.odt or a *.ott file +4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 +...)) + +In case of option 1, an in-built styles.xml is used. See +`org-odt-styles-dir' for more information. + +In case of option 3, the specified file is unzipped and the +styles.xml embedded therein is used. + +In case of option 4, the specified ODT-OR-OTT-FILE is unzipped +and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the +generated odt file. Use relative path for specifying the +FILE-MEMBERS. styles.xml must be specified as one of the +FILE-MEMBERS. + +Use options 1, 2 or 3 only if styles.xml alone suffices for +achieving the desired formatting. Use option 4, if the styles.xml +references additional files like header and footer images for +achieving the desired formatting. + +Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on +a per-file basis. For example, + +#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or +#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "Factory settings" nil) + (file :must-match t :tag "styles.xml") + (file :must-match t :tag "ODT or OTT file") + (list :tag "ODT or OTT file + Members" + (file :must-match t :tag "ODF Text or Text Template file") + (cons :tag "Members" + (file :tag " Member" "styles.xml") + (repeat (file :tag "Member")))))) + +(defcustom org-odt-display-outline-level 2 + "Outline levels considered for enumerating captioned entities." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +;;;; Document conversion + +(defcustom org-odt-convert-processes + '(("LibreOffice" + "soffice --headless --convert-to %f%x --outdir %d %i") + ("unoconv" + "unoconv -f %f -o %d %i")) + "Specify a list of document converters and their usage. +The converters in this list are offered as choices while +customizing `org-odt-convert-process'. + +This variable is a list where each element is of the +form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name +of the converter. CONVERTER-CMD is the shell command for the +converter and can contain format specifiers. These format +specifiers are interpreted as below: + +%i input file name in full +%I input file name as a URL +%f format of the output file +%o output file name in full +%O output file name as a URL +%d output dir in full +%D output dir as a URL. +%x extra options as set in `org-odt-convert-capabilities'." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Converters" + :key-type (string :tag "Converter Name") + :value-type (group (string :tag "Command line"))))) + +(defcustom org-odt-convert-process "LibreOffice" + "Use this converter to convert from \"odt\" format to other formats. +During customization, the list of converter names are populated +from `org-odt-convert-processes'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,(car c) ,(car c))) + org-odt-convert-processes)))) + +(defcustom org-odt-convert-capabilities + '(("Text" + ("odt" "ott" "doc" "rtf" "docx") + (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") + ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) + ("Web" + ("html") + (("pdf" "pdf") ("odt" "odt") ("html" "html"))) + ("Spreadsheet" + ("ods" "ots" "xls" "csv" "xlsx") + (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") + ("xls" "xls") ("xlsx" "xlsx"))) + ("Presentation" + ("odp" "otp" "ppt" "pptx") + (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") + ("pptx" "pptx") ("odg" "odg")))) + "Specify input and output formats of `org-odt-convert-process'. +More correctly, specify the set of input and output formats that +the user is actually interested in. + +This variable is an alist where each element is of the +form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). +INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an +alist where each element is of the form (OUTPUT-FMT +OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). + +The variable is interpreted as follows: +`org-odt-convert-process' can take any document that is in +INPUT-FMT-LIST and produce any document that is in the +OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have +OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT +serves dual purposes: +- It is used for populating completion candidates during + `org-odt-convert' commands. +- It is used as the value of \"%f\" specifier in + `org-odt-convert-process'. + +EXTRA-OPTIONS is used as the value of \"%x\" specifier in +`org-odt-convert-process'. + +DOCUMENT-CLASS is used to group a set of file formats in +INPUT-FMT-LIST in to a single class. + +Note that this variable inherently captures how LibreOffice based +converters work. LibreOffice maps documents of various formats +to classes like Text, Web, Spreadsheet, Presentation etc and +allow document of a given class (irrespective of its source +format) to be converted to any of the export formats associated +with that class. + +See default setting of this variable for an typical +configuration." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Capabilities" + :key-type (string :tag "Document Class") + :value-type + (group (repeat :tag "Input formats" (string :tag "Input format")) + (alist :tag "Output formats" + :key-type (string :tag "Output format") + :value-type + (group (string :tag "Output file extension") + (choice + (const :tag "None" nil) + (string :tag "Extra options")))))))) + +(defcustom org-odt-preferred-output-format nil + "Automatically post-process to this format after exporting to \"odt\". +Command `org-odt-export-to-odt' exports first to \"odt\" format +and then uses `org-odt-convert-process' to convert the +resulting document to this format. During customization of this +variable, the list of valid values are populated based on +`org-odt-convert-capabilities'. + +You can set this option on per-file basis using file local +values. See Info node `(emacs) File Variables'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,c ,c)) + (org-odt-reachable-formats "odt"))))) +;;;###autoload +(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) + + +;;;; Drawers + +(defcustom org-odt-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in ODT code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default value simply returns the value of CONTENTS." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + +;;;; Headline + +(defcustom org-odt-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword \(string or nil\). +TODO-TYPE the type of todo \(symbol: `todo', `done', nil\) +PRIORITY the priority of the headline \(integer or nil\) +TEXT the main headline text \(string\). +TAGS the tags string, separated with colons \(string or nil\). + +The function result will be used as headline text." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-odt-format-inlinetask-function 'ignore + "Function called to format an inlinetask in ODT code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a string. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; LaTeX + +(defcustom org-odt-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + + +;;;; Links + +(defcustom org-odt-inline-formula-rules + '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'")) + "Rules characterizing formula files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'")) + "Rules characterizing image files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-pixels-per-inch 96.0 + "Scaling factor for converting images pixels to inches. +Use this for sizing of embedded images. See Info node `(org) +Images in ODT export' for more information." + :type 'float + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.1")) + + +;;;; Src Block + +(defcustom org-odt-create-custom-styles-for-srcblocks t + "Whether custom styles for colorized source blocks be automatically created. +When this option is turned on, the exporter creates custom styles +for source blocks based on the advice of `htmlfontify'. Creation +of custom styles happen as part of `org-odt-hfy-face-to-css'. + +When this option is turned off exporter does not create such +styles. + +Use the latter option if you do not want the custom styles to be +based on your current display settings. It is necessary that the +styles.xml already contains needed styles for colorizing to work. + +This variable is effective only if +`org-odt-fontify-srcblocks' is turned on." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + +(defcustom org-odt-fontify-srcblocks t + "Specify whether or not source blocks need to be fontified. +Turn this option on if you want to colorize the source code +blocks in the exported file. For colorization to work, you need +to make available an enhanced version of `htmlfontify' library." + :type 'boolean + :group 'org-export-odt + :version "24.1") + + +;;;; Table + +(defcustom org-odt-table-styles + '(("OrgEquation" "OrgEquation" + ((use-first-column-styles . t) + (use-last-column-styles . t))) + ("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t))) + ("GriddedTable" "Custom" nil)) + "Specify how Table Styles should be derived from a Table Template. +This is a list where each element is of the +form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). + +TABLE-STYLE-NAME is the style associated with the table through +\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line. + +TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic +TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined +below) that is included in +`org-odt-content-template-file'. + +TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableCell\" +PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableParagraph\" +TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | + \"FirstRow\" | \"LastRow\" | + \"EvenRow\" | \"OddRow\" | + \"EvenColumn\" | \"OddColumn\" | \"\" +where \"+\" above denotes string concatenation. + +TABLE-CELL-OPTIONS is an alist where each element is of the +form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). +TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | + `use-last-row-styles' | + `use-first-column-styles' | + `use-last-column-styles' | + `use-banding-rows-styles' | + `use-banding-columns-styles' | + `use-first-row-styles' +ON-OR-OFF := `t' | `nil' + +For example, with the following configuration + +\(setq org-odt-table-styles + '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" + \(\(use-first-row-styles . t\) + \(use-first-column-styles . t\)\)\) + \(\"TableWithHeaderColumns\" \"Custom\" + \(\(use-first-column-styles . t\)\)\)\)\) + +1. A table associated with \"TableWithHeaderRowsAndColumns\" + style will use the following table-cell styles - + \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", + \"CustomTableCell\" and the following paragraph styles + \"CustomFirstRowTableParagraph\", + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate. + +2. A table associated with \"TableWithHeaderColumns\" style will + use the following table-cell styles - + \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the + following paragraph styles + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate.. + +Note that TABLE-TEMPLATE-NAME corresponds to the +\"\" elements contained within +\"\". The entries (TABLE-STYLE-NAME +TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to +\"table:template-name\" and \"table:use-first-row-styles\" etc +attributes of \"\" element. Refer ODF-1.2 +specification for more information. Also consult the +implementation filed under `org-odt-get-table-cell-styles'. + +The TABLE-STYLE-NAME \"OrgEquation\" is used internally for +formatting of numbered display equations. Do not delete this +style from the list." + :group 'org-export-odt + :version "24.1" + :type '(choice + (const :tag "None" nil) + (repeat :tag "Table Styles" + (list :tag "Table Style Specification" + (string :tag "Table Style Name") + (string :tag "Table Template Name") + (alist :options (use-first-row-styles + use-last-row-styles + use-first-column-styles + use-last-column-styles + use-banding-rows-styles + use-banding-columns-styles) + :key-type symbol + :value-type (const :tag "True" t)))))) + +;;;; Timestamps + +(defcustom org-odt-use-date-fields nil + "Non-nil, if timestamps should be exported as date fields. + +When nil, export timestamps as plain text. + +When non-nil, map `org-time-stamp-custom-formats' to a pair of +OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\" +respectively. A timestamp with no time component is formatted +with style \"OrgDate1\" while one with explicit hour and minutes +is formatted with style \"OrgDate2\". + +This feature is experimental. Most (but not all) of the common +%-specifiers in `format-time-string' are supported. +Specifically, locale-dependent specifiers like \"%c\", \"%x\" are +formatted as canonical Org timestamps. For finer control, avoid +these %-specifiers. + +Textual specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" +etc., are displayed by the application in the default language +and country specified in `org-odt-styles-file'. Note that the +default styles file uses language \"en\" and country \"GB\". You +can localize the week day and month strings in the exported +document by setting the default language and country either using +the application UI or through a custom styles file. + +See `org-odt--build-date-styles' for implementation details." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Internal functions + +;;;; Date + +(defun org-odt--format-timestamp (timestamp &optional end iso-date-p) + (let* ((format-timestamp + (lambda (timestamp format &optional end utc) + (if timestamp + (org-timestamp-format timestamp format end utc) + (format-time-string format nil utc)))) + (has-time-p (or (not timestamp) + (org-timestamp-has-time-p timestamp))) + (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" + "%Y-%m-%dT%H:%M:%S"))) + (funcall format-timestamp timestamp format end)))) + (if iso-date-p iso-date + (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) + ;; LibreOffice does not care about end goes as content + ;; within the "..." field. The + ;; displayed date is automagically corrected to match the + ;; format requested by "style:data-style-name" attribute. So + ;; don't bother about formatting the date contents to be + ;; compatible with "OrgDate1" and "OrgDateTime" styles. A + ;; simple Org-style date should suffice. + (date (let* ((formats + (if org-display-custom-times + (cons (substring + (car org-time-stamp-custom-formats) 1 -1) + (substring + (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M"))) + (format (if has-time-p (cdr formats) (car formats)))) + (funcall format-timestamp timestamp format end))) + (repeater (let ((repeater-type (org-element-property + :repeater-type timestamp)) + (repeater-value (org-element-property + :repeater-value timestamp)) + (repeater-unit (org-element-property + :repeater-unit timestamp))) + (concat + (case repeater-type + (catchup "++") (restart ".+") (cumulate "+")) + (when repeater-value + (number-to-string repeater-value)) + (case repeater-unit + (hour "h") (day "d") (week "w") (month "m") + (year "y")))))) + (concat + (format "%s" + iso-date style date) + (and (not (string= repeater "")) " ") + repeater))))) + +;;;; Frame + +(defun org-odt--frame (text width height style &optional extra + anchor-type &rest title-and-desc) + (let ((frame-attrs + (concat + (if width (format " svg:width=\"%0.2fcm\"" width) "") + (if height (format " svg:height=\"%0.2fcm\"" height) "") + extra + (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")) + (format " draw:name=\"%s\"" + (car (org-odt-add-automatic-style "Frame")))))) + (format + "\n\n%s\n" + style frame-attrs + (concat text + (let ((title (car title-and-desc)) + (desc (cadr title-and-desc))) + (concat (when title + (format "%s" + (org-odt--encode-plain-text title t))) + (when desc + (format "%s" + (org-odt--encode-plain-text desc t))))))))) + + +;;;; Library wrappers + +(defun org-odt--zip-extract (archive members target) + (when (atom members) (setq members (list members))) + (mapc (lambda (member) + (require 'arc-mode) + (let* ((--quote-file-name + ;; This is shamelessly stolen from `archive-zip-extract'. + (lambda (name) + (if (or (not (memq system-type '(windows-nt ms-dos))) + (and (boundp 'w32-quote-process-args) + (null w32-quote-process-args))) + (shell-quote-argument name) + name))) + (target (funcall --quote-file-name target)) + (archive (expand-file-name archive)) + (archive-zip-extract + (list "unzip" "-qq" "-o" "-d" target)) + exit-code command-output) + (setq command-output + (with-temp-buffer + (setq exit-code (archive-zip-extract archive member)) + (buffer-string))) + (unless (zerop exit-code) + (message command-output) + (error "Extraction failed")))) + members)) + +;;;; Target + +(defun org-odt--target (text id) + (if (not id) text + (concat + (format "\n" id) + (format "\n" id) text + (format "\n" id)))) + +;;;; Textbox + +(defun org-odt--textbox (text width height style &optional + extra anchor-type) + (org-odt--frame + (format "\n%s\n" + (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) + (and (not width) + (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) + text) + width nil style extra anchor-type)) + + + +;;;; Table of Contents + +(defun org-odt-begin-toc (index-title depth) + (concat + (format " + + + %s +" depth index-title) + + (let ((levels (number-sequence 1 10))) + (mapconcat + (lambda (level) + (format + " + + + + + + +" level level)) levels "")) + + (format " + + + + + %s + + " index-title))) + +(defun org-odt-end-toc () + (format " + + +")) + +(defun* org-odt-format-toc-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (setq text + (concat + ;; Section number. + (when section-number (concat section-number ". ")) + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) + "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + (format " [%s]" + "OrgTags" + (mapconcat + (lambda (tag) + (format + "%s" + "OrgTag" tag)) tags " : ")))))) + (format "%s" + headline-label text)) + +(defun org-odt-toc (depth info) + (assert (wholenump depth)) + ;; When a headline is marked as a radio target, as in the example below: + ;; + ;; ** <<>> + ;; Some text. + ;; + ;; suppress generation of radio targets. i.e., Radio targets are to + ;; be marked as targets within /document body/ and *not* within + ;; /TOC/, as otherwise there will be duplicated anchors one in TOC + ;; and one in the document body. + ;; + ;; FIXME-1: Currently exported headings are memoized. `org-export.el' + ;; doesn't provide a way to disable memoization. So this doesn't + ;; work. + ;; + ;; FIXME-2: Are there any other objects that need to be suppressed + ;; within TOC? + (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) + (headlines (org-export-collect-headlines + info (and (wholenump depth) depth))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders (mapcar + (lambda (type) (cons type (lambda (d c i) c))) + (list 'radio-target))))) + (when headlines + (concat + (org-odt-begin-toc title depth) + (mapconcat + (lambda (headline) + (let* ((entry (org-odt-format-headline--wrap + headline backend info 'org-odt-format-toc-headline)) + (level (org-export-get-relative-level headline info)) + (style (format "Contents_20_%d" level))) + (format "\n%s" + style entry))) + headlines "\n") + (org-odt-end-toc))))) + + +;;;; Document styles + +(defun org-odt-add-automatic-style (object-type &optional object-props) + "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option of the object in question to +`org-odt-parse-block-attributes'. + +Use `org-odt-object-counters' to generate an automatic +OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a +new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME +. STYLE-NAME)." + (assert (stringp object-type)) + (let* ((object (intern object-type)) + (seqvar object) + (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) + (object-name (format "%s%d" object-type seqno)) style-name) + (setq org-odt-object-counters + (plist-put org-odt-object-counters seqvar seqno)) + (when object-props + (setq style-name (format "Org%s" object-name)) + (setq org-odt-automatic-styles + (plist-put org-odt-automatic-styles object + (append (list (list style-name object-props)) + (plist-get org-odt-automatic-styles object))))) + (cons object-name style-name))) + +;;;; Checkbox + +(defun org-odt--checkbox (item) + "Return check-box string associated to ITEM." + (let ((checkbox (org-element-property :checkbox item))) + (if (not checkbox) "" + (format "%s" + "OrgCode" (case checkbox + (on "[✓] ") ; CHECK MARK + (off "[ ] ") + (trans "[-] ")))))) + +;;; Template + +(defun org-odt--build-date-styles (fmt style) + ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way + ;; to modify the date fields. A date could be modified by + ;; offsetting in days. That's about it. Also, date and time may + ;; have to be emitted as two fields - a date field and a time field + ;; - separately. + + ;; One can add Form Controls to date and time fields so that they + ;; can be easily modified. But then, the exported document will + ;; become tightly coupled with LibreOffice and may not function + ;; properly with other OpenDocument applications. + + ;; I have a strange feeling that Date styles are a bit flaky at the + ;; moment. + + ;; The feature is experimental. + (when (and fmt style) + (let* ((fmt-alist + '(("%A" . "") + ("%B" . "") + ("%H" . "") + ("%M" . "") + ("%S" . "") + ("%V" . "") + ("%Y" . "") + ("%a" . "") + ("%b" . "") + ("%d" . "") + ("%e" . "") + ("%h" . "") + ("%k" . "") + ("%m" . "") + ("%p" . "") + ("%y" . ""))) + (case-fold-search nil) + (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|")) + match rpl (start 0) (filler-beg 0) filler-end filler output) + (mapc + (lambda (pair) + (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) + '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns + ("%C" . "Y") ; replace century with year + ("%D" . "%m/%d/%y") + ("%G" . "Y") ; year corresponding to iso week + ("%I" . "%H") ; hour on a 12-hour clock + ("%R" . "%H:%M") + ("%T" . "%H:%M:%S") + ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. + ("%Z" . "") ; time zone name + ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format + ("%g" . "%y") + ("%X" . "%x" ) ; locale's pref. time format + ("%j" . "") ; day of the year + ("%l" . "%k") ; like %I blank-padded + ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 + ("%n" . "") + ("%r" . "%I:%M:%S %p") + ("%t" . "") + ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) + ("%x" . "%Y-%M-%d %a") ; locale's pref. time format + ("%z" . "") ; time zone in numeric form + )) + (while (string-match re fmt start) + (setq match (match-string 0 fmt)) + (setq rpl (assoc-default match fmt-alist)) + (setq start (match-end 0)) + (setq filler-end (match-beginning 0)) + (setq filler (substring fmt (prog1 filler-beg + (setq filler-beg (match-end 0))) + filler-end)) + (setq filler (and (not (string= filler "")) + (format "%s" + (org-odt--encode-plain-text filler)))) + (setq output (concat output "\n" filler "\n" rpl))) + (setq filler (substring fmt filler-beg)) + (unless (string= filler "") + (setq output (concat output + (format "\n%s" + (org-odt--encode-plain-text filler))))) + (format "\n%s\n" + style + (concat " number:automatic-order=\"true\"" + " number:format-source=\"fixed\"") + output )))) + +(defun org-odt-template (contents info) + "Return complete document string after ODT conversion. +CONTENTS is the transcoded contents string. RAW-DATA is the +original parsed data. INFO is a plist holding export options." + ;; Write meta file. + (let ((title (org-export-data (plist-get info :title) info)) + (author (let ((author (plist-get info :author))) + (if (not author) "" (org-export-data author info)))) + (email (plist-get info :email)) + (keywords (plist-get info :keywords)) + (description (plist-get info :description))) + (write-region + (concat + " + + \n" + (format "%s\n" author) + (format "%s\n" author) + ;; Date, if required. + (when (plist-get info :with-date) + ;; Check if DATE is specified as an Org-timestamp. If yes, + ;; include it as meta information. Otherwise, just use + ;; today's date. + (let* ((date (let ((date (plist-get info :date))) + (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date))))) + (let ((iso-date (org-odt--format-timestamp date nil 'iso-date))) + (concat + (format "%s\n" iso-date) + (format "%s\n" + iso-date))))) + (format "%s\n" + (let ((creator-info (plist-get info :with-creator))) + (if (or (not creator-info) (eq creator-info 'comment)) "" + (plist-get info :creator)))) + (format "%s\n" keywords) + (format "%s\n" description) + (format "%s\n" title) + "\n" + " \n" "") + nil (concat org-odt-zip-dir "meta.xml")) + ;; Add meta.xml in to manifest. + (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) + + ;; Update styles file. + ;; Copy styles.xml. Also dump htmlfontify styles, if there is any. + ;; Write styles file. + (let* ((styles-file (plist-get info :odt-styles-file)) + (styles-file (and styles-file (read (org-trim styles-file)))) + ;; Non-availability of styles.xml is not a critical + ;; error. For now, throw an error. + (styles-file (or styles-file + org-odt-styles-file + (expand-file-name "OrgOdtStyles.xml" + org-odt-styles-dir) + (error "org-odt: Missing styles file?")))) + (cond + ((listp styles-file) + (let ((archive (nth 0 styles-file)) + (members (nth 1 styles-file))) + (org-odt--zip-extract archive members org-odt-zip-dir) + (mapc + (lambda (member) + (when (org-file-image-p member) + (let* ((image-type (file-name-extension member)) + (media-type (format "image/%s" image-type))) + (org-odt-create-manifest-file-entry media-type member)))) + members))) + ((and (stringp styles-file) (file-exists-p styles-file)) + (let ((styles-file-type (file-name-extension styles-file))) + (cond + ((string= styles-file-type "xml") + (copy-file styles-file (concat org-odt-zip-dir "styles.xml") t)) + ((member styles-file-type '("odt" "ott")) + (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir))))) + (t + (error (format "Invalid specification of styles.xml file: %S" + org-odt-styles-file)))) + + ;; create a manifest entry for styles.xml + (org-odt-create-manifest-file-entry "text/xml" "styles.xml") + + ;; FIXME: Who is opening an empty styles.xml before this point? + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "styles.xml") t) + (revert-buffer t t) + + ;; Write custom styles for source blocks + ;; Save STYLES used for colorizing of source blocks. + ;; Update styles.xml with styles that were collected as part of + ;; `org-odt-hfy-face-to-css' callbacks. + (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style))) + hfy-user-sheet-assoc ""))) + (when styles + (goto-char (point-min)) + (when (re-search-forward "" nil t) + (goto-char (match-beginning 0)) + (insert "\n\n" styles "\n")))) + + ;; Update styles.xml - take care of outline numbering + + ;; Don't make automatic backup of styles.xml file. This setting + ;; prevents the backed-up styles.xml file from being zipped in to + ;; odt file. This is more of a hackish fix. Better alternative + ;; would be to fix the zip command so that the output odt file + ;; includes only the needed files and excludes any auto-generated + ;; extra files like backups and auto-saves etc etc. Note that + ;; currently the zip command zips up the entire temp directory so + ;; that any auto-generated files created under the hood ends up in + ;; the resulting odt file. + (set (make-local-variable 'backup-inhibited) t) + + ;; Outline numbering is retained only upto LEVEL. + ;; To disable outline numbering pass a LEVEL of 0. + + (goto-char (point-min)) + (let ((regex + "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") + (replacement + "")) + (while (re-search-forward regex nil t) + (unless (let ((sec-num (plist-get info :section-numbers)) + (level (string-to-number (match-string 2)))) + (if (wholenump sec-num) (<= level sec-num) sec-num)) + (replace-match replacement t nil)))) + (save-buffer 0))) + ;; Update content.xml. + + (let* ( ;; `org-display-custom-times' should be accessed right + ;; within the context of the Org buffer. So obtain its + ;; value before moving on to temp-buffer context down below. + (custom-time-fmts + (if org-display-custom-times + (cons (substring (car org-time-stamp-custom-formats) 1 -1) + (substring (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M")))) + (with-temp-buffer + (insert-file-contents + (or org-odt-content-template-file + (expand-file-name "OrgOdtContentTemplate.xml" + org-odt-styles-dir))) + ;; Write automatic styles. + ;; - Position the cursor. + (goto-char (point-min)) + (re-search-forward " " nil t) + (goto-char (match-beginning 0)) + ;; - Dump automatic table styles. + (loop for (style-name props) in + (plist-get org-odt-automatic-styles 'Table) do + (when (setq props (or (plist-get props :rel-width) "96")) + (insert (format org-odt-table-style-format style-name props)))) + ;; - Dump date-styles. + (when org-odt-use-date-fields + (insert (org-odt--build-date-styles (car custom-time-fmts) + "OrgDate1") + (org-odt--build-date-styles (cdr custom-time-fmts) + "OrgDate2"))) + ;; Update display level. + ;; - Remove existing sequence decls. Also position the cursor. + (goto-char (point-min)) + (when (re-search-forward "" nil nil))) + ;; Update sequence decls according to user preference. + (insert + (format + "\n\n%s\n" + (mapconcat + (lambda (x) + (format + "" + org-odt-display-outline-level (nth 1 x))) + org-odt-category-map-alist "\n"))) + ;; Position the cursor to document body. + (goto-char (point-min)) + (re-search-forward "" nil nil) + (goto-char (match-beginning 0)) + + ;; Preamble - Title, Author, Date etc. + (insert + (let* ((title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (plist-get info :email)) + ;; Switch on or off above vars based on user settings + (author (and (plist-get info :with-author) (or author email))) + (email (and (plist-get info :with-email) email))) + (concat + ;; Title. + (when title + (concat + (format "\n%s" + "OrgTitle" (format "\n%s" title)) + ;; Separator. + "\n")) + (cond + ((and author (not email)) + ;; Author only. + (concat + (format "\n%s" + "OrgSubtitle" + (format "%s" author)) + ;; Separator. + "\n")) + ((and author email) + ;; Author and E-mail. + (concat + (format + "\n%s" + "OrgSubtitle" + (format + "%s" + (concat "mailto:" email) + (format "%s" author))) + ;; Separator. + "\n"))) + ;; Date, if required. + (when (plist-get info :with-date) + (let* ((date (plist-get info :date)) + ;; Check if DATE is specified as a timestamp. + (timestamp (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date)))) + (concat + (format "\n%s" + "OrgSubtitle" + (if (and org-odt-use-date-fields timestamp) + (org-odt--format-timestamp (car date)) + (org-export-data (plist-get info :date) info))) + ;; Separator + "")))))) + ;; Table of Contents + (let* ((with-toc (plist-get info :with-toc)) + (depth (and with-toc (if (wholenump with-toc) + with-toc + (plist-get info :headline-levels))))) + (when depth (insert (or (org-odt-toc depth info) "")))) + ;; Contents. + (insert contents) + ;; Return contents. + (buffer-substring-no-properties (point-min) (point-max))))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-odt-bold (bold contents info) + "Transcode BOLD from Org to ODT. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "%s" + "Bold" contents)) + + +;;;; Center Block + +(defun org-odt-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to ODT. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + contents) + + +;;;; Clock + +(defun org-odt-clock (clock contents info) + "Transcode a CLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((timestamp (org-element-property :value clock)) + (duration (org-element-property :duration clock))) + (format "\n%s" + (if (eq (org-element-type (org-export-get-next-element clock info)) + 'clock) "OrgClock" "OrgClockLastLine") + (concat + (format "%s" + "OrgClockKeyword" org-clock-string) + (org-odt-timestamp timestamp contents info) + (and duration (format " (%s)" duration)))))) + + +;;;; Code + +(defun org-odt-code (code contents info) + "Transcode a CODE object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value code)))) + + +;;;; Comment + +;; Comments are ignored. + + +;;;; Comment Block + +;; Comment Blocks are ignored. + + +;;;; Drawer + +(defun org-odt-drawer (drawer contents info) + "Transcode a DRAWER element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-odt-format-drawer-function + name contents))) + output)) + + +;;;; Dynamic Block + +(defun org-odt-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + + +;;;; Entity + +(defun org-odt-entity (entity contents info) + "Transcode an ENTITY object from Org to ODT. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;;; Example Block + +(defun org-odt-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-format-code example-block info)) + + +;;;; Export Snippet + +(defun org-odt-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'odt) + (org-element-property :value export-snippet))) + + +;;;; Export Block + +(defun org-odt-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "ODT") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Fixed Width + +(defun org-odt-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-do-format-code (org-element-property :value fixed-width))) + + +;;;; Footnote Definition + +;; Footnote Definitions are ignored. + + +;;;; Footnote Reference + +(defun org-odt-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((--format-footnote-definition + (function + (lambda (n def) + (setq n (format "%d" n)) + (let ((id (concat "fn" n)) + (note-class "footnote") + (par-style "Footnote")) + (format + "%s" + id note-class + (concat + (format "%s" n) + (format "%s" def))))))) + (--format-footnote-reference + (function + (lambda (n) + (setq n (format "%d" n)) + (let ((note-class "footnote") + (ref-format "text") + (ref-name (concat "fn" n))) + (format + "%s" + "OrgSuperscript" + (format "%s" + note-class ref-format ref-name n))))))) + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (and (eq (org-element-type prev) 'footnote-reference) + (format "%s" + "OrgSuperscript" ","))) + ;; Transcode footnote reference. + (let ((n (org-export-get-footnote-number footnote-reference info))) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (funcall --format-footnote-reference n)) + ;; Inline definitions are secondary strings. + ;; Non-inline footnotes definitions are full Org data. + (t + (let* ((raw (org-export-get-footnote-definition + footnote-reference info)) + (def + (let ((def (org-trim + (org-export-data-with-backend + raw + (org-export-create-backend + :parent 'odt + :transcoders + '((paragraph . (lambda (p c i) + (org-odt--format-paragraph + p c "Footnote" + "OrgFootnoteCenter" + "OrgFootnoteQuotations"))))) + info)))) + (if (eq (org-element-type raw) 'org-data) def + (format "\n%s" + "Footnote" def))))) + (funcall --format-footnote-definition n def)))))))) + + +;;;; Headline + +(defun* org-odt-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (concat + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + "" + (format "[%s]" + "OrgTags" (mapconcat + (lambda (tag) + (format + "%s" + "OrgTag" tag)) tags " : ")))))) + +(defun org-odt-format-headline--wrap (headline backend info + &optional format-function + &rest extra-keys) + "Transcode a HEADLINE element using BACKEND. +INFO is a plist holding contextual information." + (setq backend (or backend (plist-get info :back-end))) + (let* ((level (+ (org-export-get-relative-level headline info))) + (headline-number (org-export-get-headline-number headline info)) + (section-number (and (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo + (org-export-data-with-backend todo backend info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data-with-backend + (org-element-property :title headline) backend info)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (concat "sec-" (mapconcat 'number-to-string + headline-number "-"))) + (format-function (cond + ((functionp format-function) format-function) + ((not (eq org-odt-format-headline-function 'ignore)) + (function* + (lambda (todo todo-type priority text tags + &allow-other-keys) + (funcall org-odt-format-headline-function + todo todo-type priority text tags)))) + (t 'org-odt-format-headline)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-odt-headline (headline contents info) + "Transcode a HEADLINE element from Org to ODT. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Case 1: This is a footnote section: ignore it. + (unless (org-element-property :footnote-section-p headline) + (let* ((text (org-export-data (org-element-property :title headline) info)) + ;; Create the headline text. + (full-text (org-odt-format-headline--wrap headline nil info)) + ;; Get level relative to current parsed data. + (level (org-export-get-relative-level headline info)) + ;; Get canonical label for the headline. + (id (concat "sec-" (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-"))) + ;; Get user-specified labels for the headline. + (extra-ids (list (org-element-property :CUSTOM_ID headline) + (org-element-property :ID headline))) + ;; Extra targets. + (extra-targets + (mapconcat (lambda (x) + (when x + (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x))) + (org-odt--target + "" (org-export-solidify-link-text x))))) + extra-ids "")) + ;; Title. + (anchored-title (org-odt--target full-text id))) + (cond + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((org-export-low-level-p headline info) + ;; Build the real contents of the sub-tree. + (concat + (and (org-export-first-sibling-p headline info) + (format "\n" + ;; Choose style based on list type. + (if (org-export-numbered-headline-p headline info) + "OrgNumberedList" "OrgBulletedList") + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent-headline + headline))) + (if (and parent + (org-export-low-level-p parent info)) + "true" "false"))))) + (let ((headline-has-table-p + (let ((section (assq 'section (org-element-contents headline)))) + (assq 'table (and section (org-element-contents section)))))) + (format "\n\n%s\n%s" + (concat + (format "\n%s" + "Text_20_body" + (concat extra-targets anchored-title)) + contents) + (if headline-has-table-p + "" + ""))) + (and (org-export-last-sibling-p headline info) + ""))) + ;; Case 3. Standard headline. Export it as a section. + (t + (concat + (format + "\n%s" + (format "Heading_20_%s" level) + level + (concat extra-targets anchored-title)) + contents)))))) + + +;;;; Horizontal Rule + +(defun org-odt-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "\n%s" + "Horizontal_20_Line" "")) + + +;;;; Inline Babel Call + +;; Inline Babel Calls are ignored. + + +;;;; Inline Src Block + +(defun org-odt--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-odt-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((org-lang (org-element-property :language inline-src-block)) + (code (org-element-property :value inline-src-block)) + (separator (org-odt--find-verb-separator code))) + (error "FIXME"))) + + +;;;; Inlinetask + +(defun org-odt-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it + ;; with appropriate arguments. + ((not (eq org-odt-format-inlinetask-function 'ignore)) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-odt-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-odt-format-headline--wrap + inlinetask nil info format-function :contents contents))) + ;; Otherwise, use a default template. + (t + (format "\n%s" + "Text_20_body" + (org-odt--textbox + (concat + (format "\n%s" + "OrgInlineTaskHeading" + (org-odt-format-headline--wrap inlinetask nil info)) + contents) + nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))))) + +;;;; Italic + +(defun org-odt-italic (italic contents info) + "Transcode ITALIC from Org to ODT. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "%s" + "Emphasis" contents)) + + +;;;; Item + +(defun org-odt-item (item contents info) + "Transcode an ITEM element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag + (concat (org-odt--checkbox item) + (org-export-data tag info)))))) + (case type + ((ordered unordered descriptive-1 descriptive-2) + (format "\n\n%s\n%s" + contents + (let* ((--element-has-a-table-p + (function + (lambda (element info) + (loop for el in (org-element-contents element) + thereis (eq (org-element-type el) 'table)))))) + (cond + ((funcall --element-has-a-table-p item info) + "") + (t ""))))) + (t (error "Unknown list type: %S" type))))) + +;;;; Keyword + +(defun org-odt-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "ODT") value) + ((string= key "INDEX") + ;; FIXME + (ignore)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (when (wholenump depth) (org-odt-toc depth info)))) + ((member value '("tables" "figures" "listings")) + ;; FIXME + (ignore)))))))) + + +;;;; Latex Environment + + +;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml)) +;; (defadvice org-format-latex-as-mathml ; FIXME +;; (after org-odt-protect-latex-fragment activate) +;; "Encode LaTeX fragment as XML. +;; Do this when translation to MathML fails." +;; (unless (> (length ad-return-value) 0) +;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0))))) + +(defun org-odt-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-remove-indentation + (org-element-property :value latex-environment)))) + (org-odt-do-format-code latex-frag))) + + +;;;; Latex Fragment + +;; (when latex-frag ; FIXME +;; (setq href (org-propertize href :title "LaTeX Fragment" +;; :description latex-frag))) +;; handle verbatim +;; provide descriptions + +(defun org-odt-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (format "%s" + "OrgCode" (org-odt--encode-plain-text latex-frag t)))) + + +;;;; Line Break + +(defun org-odt-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + "") + + +;;;; Link + +;;;; Links :: Label references + +(defun org-odt--enumerate (element info &optional predicate n) + (when predicate (assert (funcall predicate element info))) + (let* ((--numbered-parent-headline-at-<=-n + (function + (lambda (element n info) + (loop for x in (org-export-get-genealogy element) + thereis (and (eq (org-element-type x) 'headline) + (<= (org-export-get-relative-level x info) n) + (org-export-numbered-headline-p x info) + x))))) + (--enumerate + (function + (lambda (element scope info &optional predicate) + (let ((counter 0)) + (org-element-map (or scope (plist-get info :parse-tree)) + (org-element-type element) + (lambda (el) + (and (or (not predicate) (funcall predicate el info)) + (incf counter) + (eq element el) + counter)) + info 'first-match))))) + (scope (funcall --numbered-parent-headline-at-<=-n + element (or n org-odt-display-outline-level) info)) + (ordinal (funcall --enumerate element scope info predicate)) + (tag + (concat + ;; Section number. + (and scope + (mapconcat 'number-to-string + (org-export-get-headline-number scope info) ".")) + ;; Separator. + (and scope ".") + ;; Ordinal. + (number-to-string ordinal)))) + tag)) + +(defun org-odt-format-label (element info op) + "Return a label for ELEMENT. + +ELEMENT is a `link', `table', `src-block' or `paragraph' type +element. INFO is a plist used as a communication channel. OP is +either `definition' or `reference', depending on the purpose of +the generated string. + +Return value is a string if OP is set to `reference' or a cons +cell like CAPTION . SHORT-CAPTION) where CAPTION and +SHORT-CAPTION are strings." + (assert (memq (org-element-type element) '(link table src-block paragraph))) + (let* ((caption-from + (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Get label and caption. + (label (org-element-property :name caption-from)) + (caption (org-export-get-caption caption-from)) + (caption (and caption (org-export-data caption info))) + ;; FIXME: We don't use short-caption for now + (short-caption nil)) + (when (or label caption) + (let* ((default-category + (case (org-element-type element) + (table "__Table__") + (src-block "__Listing__") + ((link paragraph) + (cond + ((org-odt--enumerable-latex-image-p element info) + "__DvipngImage__") + ((org-odt--enumerable-image-p element info) + "__Figure__") + ((org-odt--enumerable-formula-p element info) + "__MathFormula__") + (t (error "Don't know how to format label for link: %S" + element)))) + (t (error "Don't know how to format label for element type: %s" + (org-element-type element))))) + seqno) + (assert default-category) + (destructuring-bind (counter label-style category predicate) + (assoc-default default-category org-odt-category-map-alist) + ;; Compute sequence number of the element. + (setq seqno (org-odt--enumerate element info predicate)) + ;; Localize category string. + (setq category (org-export-translate category :utf-8 info)) + (case op + ;; Case 1: Handle Label definition. + (definition + ;; Assign an internal label, if user has not provided one + (setq label (org-export-solidify-link-text + (or label (format "%s-%s" default-category seqno)))) + (cons + (concat + ;; Sneak in a bookmark. The bookmark is used when the + ;; labeled element is referenced with a link that + ;; provides its own description. + (format "\n" label) + ;; Label definition: Typically formatted as below: + ;; CATEGORY SEQ-NO: LONG CAPTION + ;; with translation for correct punctuation. + (format-spec + (org-export-translate + (cadr (assoc-string label-style org-odt-label-styles t)) + :utf-8 info) + `((?e . ,category) + (?n . ,(format + "%s" + label counter counter seqno)) + (?c . ,(or caption ""))))) + short-caption)) + ;; Case 2: Handle Label reference. + (reference + (assert label) + (setq label (org-export-solidify-link-text label)) + (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) + (fmt1 (car fmt)) + (fmt2 (cadr fmt))) + (format "%s" + fmt1 label (format-spec fmt2 `((?e . ,category) + (?n . ,seqno)))))) + (t (error "Unknown %S on label" op)))))))) + + +;;;; Links :: Inline Images + +(defun org-odt--copy-image-file (path) + "Returns the internal name of the file" + (let* ((image-type (file-name-extension path)) + (media-type (format "image/%s" image-type)) + (target-dir "Images/") + (target-file + (format "%s%04d.%s" target-dir + (incf org-odt-embedded-images-count) image-type))) + (message "Embedding %s as %s..." + (substring-no-properties path) target-file) + + (when (= 1 org-odt-embedded-images-count) + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry "" target-dir)) + + (copy-file path (concat org-odt-zip-dir target-file) 'overwrite) + (org-odt-create-manifest-file-entry media-type target-file) + target-file)) + +(defun org-odt--image-size (file &optional user-width + user-height scale dpi embed-as) + (let* ((--pixels-to-cms + (function (lambda (pixels dpi) + (let ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches))))) + (--size-in-cms + (function + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) + (dpi (or dpi org-odt-pixels-per-inch)) + (anchor-type (or embed-as "paragraph")) + (user-width (and (not scale) user-width)) + (user-height (and (not scale) user-height)) + (size + (and + (not (and user-height user-width)) + (or + ;; Use Imagemagick. + (and (executable-find "identify") + (let ((size-in-pixels + (let ((dim (shell-command-to-string + (format "identify -format \"%%w:%%h\" \"%s\"" + file)))) + (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) + (cons (string-to-number (match-string 1 dim)) + (string-to-number (match-string 2 dim))))))) + (funcall --size-in-cms size-in-pixels dpi))) + ;; Use Emacs. + (let ((size-in-pixels + (ignore-errors ; Emacs could be in batch mode + (clear-image-cache) + (image-size (create-image file) 'pixels)))) + (funcall --size-in-cms size-in-pixels dpi)) + ;; Use hard-coded values. + (cdr (assoc-string anchor-type + org-odt-default-image-sizes-alist)) + ;; Error out. + (error "Cannot determine image size, aborting")))) + (width (car size)) (height (cdr size))) + (cond + (scale + (setq width (* width scale) height (* height scale))) + ((and user-height user-width) + (setq width user-width height user-height)) + (user-height + (setq width (* user-height (/ width height)) height user-height)) + (user-width + (setq height (* user-width (/ height width)) width user-width)) + (t (ignore))) + ;; ensure that an embedded image fits comfortably within a page + (let ((max-width (car org-odt-max-image-size)) + (max-height (cdr org-odt-max-image-size))) + (when (or (> width max-width) (> height max-height)) + (let* ((scale1 (/ max-width width)) + (scale2 (/ max-height height)) + (scale (min scale1 scale2))) + (setq width (* scale width) height (* scale height))))) + (cons width height))) + +(defun org-odt-link--inline-image (element info) + "Return ODT code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (assert (eq (org-element-type element) 'link)) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond ((member type '("http" "https")) + (concat type ":" raw-path)) + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href (format + "\n" + (org-odt--copy-image-file src-expanded))) + ;; Extract attributes from #+ATTR_ODT line. + (attr-from (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Convert attributes to a plist. + (attr-plist (org-export-read-attribute :attr_odt attr-from)) + ;; Handle `:anchor', `:style' and `:attributes' properties. + (user-frame-anchor + (car (assoc-string (plist-get attr-plist :anchor) + '(("as-char") ("paragraph") ("page")) t))) + (user-frame-style + (and user-frame-anchor (plist-get attr-plist :style))) + (user-frame-attrs + (and user-frame-anchor (plist-get attr-plist :attributes))) + (user-frame-params + (list user-frame-style user-frame-attrs user-frame-anchor)) + ;; (embed-as (or embed-as user-frame-anchor "paragraph")) + ;; + ;; Handle `:width', `:height' and `:scale' properties. Read + ;; them as numbers since we need them for computations. + (size (org-odt--image-size + src-expanded + (let ((width (plist-get attr-plist :width))) + (and width (read width))) + (let ((length (plist-get attr-plist :length))) + (and length (read length))) + (let ((scale (plist-get attr-plist :scale))) + (and scale (read scale))) + nil ; embed-as + "paragraph" ; FIXME + )) + (width (car size)) (height (cdr size)) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p "paragraph" "as-char")) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (entity (concat (and caption "Captioned") embed-as "Image")) + ;; Check if this link was created by LaTeX-to-PNG converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down its contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces)))) + (org-odt--render-image/formula entity href width height + captions user-frame-params title desc))) + + +;;;; Links :: Math formula + +(defun org-odt-link--inline-formula (element info) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href + (format + "\n" + " xlink:show=\"embed\" xlink:actuate=\"onLoad\"" + (file-name-directory (org-odt--copy-formula-file src-expanded)))) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p 'paragraph 'character)) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + ;; Check if this link was created by LaTeX-to-MathML + ;; converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down its contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces))) + width height) + (cond + ((eq embed-as 'character) + (org-odt--render-image/formula "InlineFormula" href width height + nil nil title desc)) + (t + (let* ((equation (org-odt--render-image/formula + "CaptionedDisplayFormula" href width height + captions nil title desc)) + (label + (let* ((org-odt-category-map-alist + '(("__MathFormula__" "Text" "math-label" "Equation" + org-odt--enumerable-formula-p)))) + (car (org-odt-format-label element info 'definition))))) + (concat equation "" label)))))) + +(defun org-odt--copy-formula-file (src-file) + "Returns the internal name of the file" + (let* ((target-dir (format "Formula-%04d/" + (incf org-odt-embedded-formulas-count))) + (target-file (concat target-dir "content.xml"))) + ;; Create a directory for holding formula file. Also enter it in + ;; to manifest. + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry + "application/vnd.oasis.opendocument.formula" target-dir "1.2") + ;; Copy over the formula file from user directory to zip + ;; directory. + (message "Embedding %s as %s..." src-file target-file) + (let ((case-fold-search nil)) + (cond + ;; Case 1: Mathml. + ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) + (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite)) + ;; Case 2: OpenDocument formula. + ((string-match "\\.odf\\'" src-file) + (org-odt--zip-extract src-file "content.xml" + (concat org-odt-zip-dir target-dir))) + (t (error "%s is not a formula file" src-file)))) + ;; Enter the formula file in to manifest. + (org-odt-create-manifest-file-entry "text/xml" target-file) + target-file)) + +;;;; Targets + +(defun org-odt--render-image/formula (cfg-key href width height &optional + captions user-frame-params + &rest title-and-desc) + (let* ((frame-cfg-alist + ;; Each element of this alist is of the form (CFG-HANDLE + ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS). + + ;; CFG-HANDLE is the key to the alist. + + ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the + ;; frame params for INNER-FRAME and OUTER-FRAME + ;; respectively. See below. + + ;; Configurations that are meant to be applied to + ;; non-captioned image/formula specifies no + ;; OUTER-FRAME-PARAMS. + + ;; TERMINOLOGY + ;; =========== + ;; INNER-FRAME :: Frame that directly surrounds an + ;; image/formula. + + ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This + ;; frame also contains the caption, if any. + + ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME + ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note + ;; that these are the last three arguments + ;; to `org-odt--frame'. + + ;; Note that an un-captioned image/formula requires just an + ;; INNER-FRAME, while a captioned image/formula requires + ;; both an INNER and an OUTER-FRAME. + '(("As-CharImage" ("OrgInlineImage" nil "as-char")) + ("ParagraphImage" ("OrgDisplayImage" nil "paragraph")) + ("PageImage" ("OrgPageImage" nil "page")) + ("CaptionedAs-CharImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgInlineImage" nil "as-char")) + ("CaptionedParagraphImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgImageCaptionFrame" nil "paragraph")) + ("CaptionedPageImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgPageImageCaptionFrame" nil "page")) + ("InlineFormula" ("OrgInlineFormula" nil "as-char")) + ("DisplayFormula" ("OrgDisplayFormula" nil "as-char")) + ("CaptionedDisplayFormula" + ("OrgCaptionedFormula" nil "paragraph") + ("OrgFormulaCaptionFrame" nil "paragraph")))) + (caption (car captions)) (short-caption (cdr captions)) + ;; Retrieve inner and outer frame params, from configuration. + (frame-cfg (assoc-string cfg-key frame-cfg-alist t)) + (inner (nth 1 frame-cfg)) + (outer (nth 2 frame-cfg)) + ;; User-specified frame params (from #+ATTR_ODT spec) + (user user-frame-params) + (--merge-frame-params (function + (lambda (default user) + "Merge default and user frame params." + (if (not user) default + (assert (= (length default) 3)) + (assert (= (length user) 3)) + (loop for u in user + for d in default + collect (or u d))))))) + (cond + ;; Case 1: Image/Formula has no caption. + ;; There is only one frame, one that surrounds the image + ;; or formula. + ((not caption) + ;; Merge user frame params with that from configuration. + (setq inner (funcall --merge-frame-params inner user)) + (apply 'org-odt--frame href width height + (append inner title-and-desc))) + ;; Case 2: Image/Formula is captioned or labeled. + ;; There are two frames: The inner one surrounds the + ;; image or formula. The outer one contains the + ;; caption/sequence number. + (t + ;; Merge user frame params with outer frame params. + (setq outer (funcall --merge-frame-params outer user)) + ;; Short caption, if specified, goes as part of inner frame. + (setq inner (let ((frame-params (copy-sequence inner))) + (setcar (cdr frame-params) + (concat + (cadr frame-params) + (when short-caption + (format " draw:name=\"%s\" " short-caption)))) + frame-params)) + (apply 'org-odt--textbox + (format "\n%s" + "Illustration" + (concat + (apply 'org-odt--frame href width height + (append inner title-and-desc)) + caption)) + width height outer))))) + +(defun org-odt--enumerable-p (element info) + ;; Element should have a caption or label. + (or (org-element-property :caption element) + (org-element-property :name element))) + +(defun org-odt--enumerable-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD NOT be a + ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX + ;; processing.) + (lambda (p) + (and (not (org-element-property :replaces p)) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-latex-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD also be a + ;; replacement element. (i.e., It SHOULD be a result of LaTeX + ;; processing.) + (lambda (p) + (and (org-element-property :replaces p) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-formula-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. + (lambda (p) + (or (org-element-property :caption p) + (org-element-property :name p))) + ;; Link should point to a MathML or ODF file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-formula-rules)))) + +(defun org-odt--standalone-link-p (element info &optional + paragraph-predicate + link-predicate) + "Test if ELEMENT is a standalone link for the purpose ODT export. +INFO is a plist holding contextual information. + +Return non-nil, if ELEMENT is of type paragraph satisfying +PARAGRAPH-PREDICATE and its sole content, save for whitespaces, +is a link that satisfies LINK-PREDICATE. + +Return non-nil, if ELEMENT is of type link satisfying +LINK-PREDICATE and its containing paragraph satisfies +PARAGRAPH-PREDICATE in addition to having no other content save for +leading and trailing whitespaces. + +Return nil, otherwise." + (let ((p (case (org-element-type element) + (paragraph element) + (link (and (or (not link-predicate) + (funcall link-predicate element)) + (org-export-get-parent element))) + (t nil)))) + (when (and p (eq (org-element-type p) 'paragraph)) + (when (or (not paragraph-predicate) + (funcall paragraph-predicate p)) + (let ((contents (org-element-contents p))) + (loop for x in contents + with inline-image-count = 0 + always (case (org-element-type x) + (plain-text + (not (org-string-nw-p x))) + (link + (and (or (not link-predicate) + (funcall link-predicate x)) + (= (incf inline-image-count) 1))) + (t nil)))))))) + +(defun org-odt-link--infer-description (destination info) + ;; DESTINATION is a HEADLINE, a "<>" or an element (like + ;; paragraph, verse-block etc) to which a "#+NAME: label" can be + ;; attached. Note that labels that are attached to captioned + ;; entities - inline images, math formulae and tables - get resolved + ;; as part of `org-odt-format-label' and `org-odt--enumerate'. + + ;; Create a cross-reference to DESTINATION but make best-efforts to + ;; create a *meaningful* description. Check item numbers, section + ;; number and section title in that order. + + ;; NOTE: Counterpart of `org-export-get-ordinal'. + ;; FIXME: Handle footnote-definition footnote-reference? + (let* ((genealogy (org-export-get-genealogy destination)) + (data (reverse genealogy)) + (label (case (org-element-type destination) + (headline + (format "sec-%s" (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (target + (org-element-property :value destination)) + (t (error "FIXME: Resolve %S" destination))))) + (or + (let* ( ;; Locate top-level list. + (top-level-list + (loop for x on data + when (eq (org-element-type (car x)) 'plain-list) + return x)) + ;; Get list item nos. + (item-numbers + (loop for (plain-list item . rest) on top-level-list by #'cddr + until (not (eq (org-element-type plain-list) 'plain-list)) + collect (when (eq (org-element-property :type + plain-list) + 'ordered) + (1+ (length (org-export-get-previous-element + item info t)))))) + ;; Locate top-most listified headline. + (listified-headlines + (loop for x on data + when (and (eq (org-element-type (car x)) 'headline) + (org-export-low-level-p (car x) info)) + return x)) + ;; Get listified headline numbers. + (listified-headline-nos + (loop for el in listified-headlines + when (eq (org-element-type el) 'headline) + collect (when (org-export-numbered-headline-p el info) + (1+ (length (org-export-get-previous-element + el info t))))))) + ;; Combine item numbers from both the listified headlines and + ;; regular list items. + + ;; Case 1: Check if all the parents of list item are numbered. + ;; If yes, link to the item proper. + (let ((item-numbers (append listified-headline-nos item-numbers))) + (when (and item-numbers (not (memq nil item-numbers))) + (format "%s" + (org-export-solidify-link-text label) + (mapconcat (lambda (n) (if (not n) " " + (concat (number-to-string n) "."))) + item-numbers ""))))) + ;; Case 2: Locate a regular and numbered headline in the + ;; hierarchy. Display its section number. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info)) + (org-export-numbered-headline-p el info)) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (mapconcat 'number-to-string (org-export-get-headline-number + headline info) ".")))) + ;; Case 4: Locate a regular headline in the hierarchy. Display + ;; its title. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info))) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (let ((title (org-element-property :title headline))) + (org-export-data title info))))) + (error "FIXME?")))) + +(defun org-odt-link (link desc info) + "Transcode a LINK object from Org to ODT. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-odt-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (if (file-name-absolute-p raw-path) + (concat "file://" (expand-file-name raw-path)) + (concat "file://" raw-path))) + (t raw-path))) + ;; Convert & to & for correct XML representation + (path (replace-regexp-in-string "&" "&" path)) + protocol) + (cond + ;; Image file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-image-rules)) + (org-odt-link--inline-image link info)) + ;; Formula file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-formula-rules)) + (org-odt-link--inline-formula link info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (let ((desc (org-export-data (org-element-contents destination) info)) + (href (org-export-solidify-link-text path))) + (format + "%s" + href desc))))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Case 1: Fuzzy link points nowhere. + ('nil + (format "%s" + "Emphasis" + (or desc + (org-export-data (org-element-property :raw-link link) + info)))) + ;; Case 2: Fuzzy link points to a headline. + (headline + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (if (not desc) (org-odt-link--infer-description destination info) + (let* ((headline-no + (org-export-get-headline-number destination info)) + (label + (format "sec-%s" + (mapconcat 'number-to-string headline-no "-")))) + (format + "%s" + label desc)))) + ;; Case 3: Fuzzy link points to a target. + (target + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (if (not desc) (org-odt-link--infer-description destination info) + (let ((label (org-element-property :value destination))) + (format "%s" + (org-export-solidify-link-text label) + desc)))) + ;; Case 4: Fuzzy link points to some element (e.g., an + ;; inline image, a math formula or a table). + (otherwise + (let ((label-reference + (ignore-errors (org-odt-format-label + destination info 'reference)))) + (cond ((not label-reference) + (org-odt-link--infer-description destination info)) + ;; LINK has no description. Create + ;; a cross-reference showing entity's sequence + ;; number. + ((not desc) label-reference) + ;; LINK has description. Insert a hyperlink with + ;; user-provided description. + (t + (let ((label (org-element-property :name destination))) + (format "%s" + (org-export-solidify-link-text label) + desc))))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let* ((line-no (format "%d" (org-export-resolve-coderef path info))) + (href (concat "coderef-" path))) + (format + (org-export-get-coderef-format path desc) + (format + "%s" + href line-no)))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'odt)) + ;; External link with a description part. + ((and path desc) + (let ((link-contents (org-element-contents link))) + ;; Check if description is a link to an inline image. + (if (and (not (cdr link-contents)) + (let ((desc-element (car link-contents))) + (and (eq (org-element-type desc-element) 'link) + (org-export-inline-image-p + desc-element org-odt-inline-image-rules)))) + ;; Format link as a clickable image. + (format "\n\n%s\n" + path desc) + ;; Otherwise, format it as a regular link. + (format "%s" + path desc)))) + ;; External link without a description part. + (path + (format "%s" + path path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" + "Emphasis" desc))))) + + +;;;; Paragraph + +(defun org-odt--format-paragraph (paragraph contents default center quote) + "Format paragraph according to given styles. +PARAGRAPH is a paragraph type element. CONTENTS is the +transcoded contents of that paragraph, as a string. DEFAULT, +CENTER and QUOTE are, respectively, style to use when paragraph +belongs to no special environment, a center block, or a quote +block." + (let* ((parent (org-export-get-parent paragraph)) + (parent-type (org-element-type parent)) + (style (case parent-type + (quote-block quote) + (center-block center) + (t default)))) + ;; If this paragraph is a leading paragraph in an item and the + ;; item has a checkbox, splice the checkbox and paragraph contents + ;; together. + (when (and (eq (org-element-type parent) 'item) + (eq paragraph (car (org-element-contents parent)))) + (setq contents (concat (org-odt--checkbox parent) contents))) + (format "\n%s" style contents))) + +(defun org-odt-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to ODT. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (org-odt--format-paragraph + paragraph contents + (or (org-element-property :style paragraph) "Text_20_body") + "OrgCenter" + "Quotations")) + + +;;;; Plain List + +(defun org-odt-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to ODT. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (format "\n\n%s" + ;; Choose style based on list type. + (case (org-element-property :type plain-list) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent plain-list))) + (if (and parent (eq (org-element-type parent) 'item)) + "true" "false"))) + contents)) + +;;;; Plain Text + +(defun org-odt--encode-tabs-and-spaces (line) + (replace-regexp-in-string + "\\([\t]\\|\\([ ]+\\)\\)" + (lambda (s) + (cond + ((string= s "\t") "") + (t (let ((n (length s))) + (cond + ((= n 1) " ") + ((> n 1) (concat " " (format "" (1- n)))) + (t "")))))) + line)) + +(defun org-odt--encode-plain-text (text &optional no-whitespace-filling) + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + '(("&" . "&") ("<" . "<") (">" . ">"))) + (if no-whitespace-filling text + (org-odt--encode-tabs-and-spaces text))) + +(defun org-odt-plain-text (text info) + "Transcode a TEXT string from Org to ODT. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect &, < and >. + (setq output (org-odt--encode-plain-text output t)) + ;; Handle smart quotes. Be sure to provide original string since + ;; OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (mapc + (lambda (pair) + (setq output + (replace-regexp-in-string (car pair) (cdr pair) output t nil))) + org-odt-special-string-regexps)) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" "" output t))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-odt-planning (planning contents info) + "Transcode a PLANNING element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\n%s" + "OrgPlanning" + (concat + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "%s" + "OrgClosedKeyword" org-closed-string) + (org-odt-timestamp closed contents info)))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "%s" + "OrgDeadlineKeyword" org-deadline-string) + (org-odt-timestamp deadline contents info)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "%s" + "OrgScheduledKeyword" org-deadline-string) + (org-odt-timestamp scheduled contents info))))))) + + +;;;; Property Drawer + +(defun org-odt-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + + +;;;; Quote Block + +(defun org-odt-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Quote Section + +(defun org-odt-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (org-odt-do-format-code value)))) + + +;;;; Section + +(defun org-odt-format-section (text style &optional name) + (let ((default-name (car (org-odt-add-automatic-style "Section")))) + (format "\n\n%s\n" + style + (format "text:name=\"%s\"" (or name default-name)) + text))) + + +(defun org-odt-section (section contents info) ; FIXME + "Transcode a SECTION element from Org to ODT. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + +;;;; Radio Target + +(defun org-odt-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to ODT. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (org-odt--target + text (org-export-solidify-link-text + (org-element-property :value radio-target)))) + + +;;;; Special Block + +(defun org-odt-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (attributes (org-export-read-attribute :attr_odt special-block))) + (cond + ;; Annotation. + ((string= type "annotation") + (let* ((author (or (plist-get attributes :author) + (let ((author (plist-get info :author))) + (and author (org-export-data author info))))) + (date (or (plist-get attributes :date) + ;; FIXME: Is `car' right thing to do below? + (car (plist-get info :date))))) + (format "\n%s" + (format "\n%s\n" + (concat + (and author + (format "%s" author)) + (and date + (format "%s" + (org-odt--format-timestamp date nil 'iso-date))) + contents))))) + ;; Textbox. + ((string= type "textbox") + (let ((width (plist-get attributes :width)) + (height (plist-get attributes :height)) + (style (plist-get attributes :style)) + (extra (plist-get attributes :extra)) + (anchor (plist-get attributes :anchor))) + (format "\n%s" + "Text_20_body" (org-odt--textbox contents width height + style extra anchor)))) + (t contents)))) + + +;;;; Src Block + +(defun org-odt-hfy-face-to-css (fn) + "Create custom style for face FN. +When FN is the default face, use its foreground and background +properties to create \"OrgSrcBlock\" paragraph style. Otherwise +use its color attribute to create a character style whose name +is obtained from FN. Currently all attributes of FN other than +color are ignored. + +The style name for a face FN is derived using the following +operations on the face name in that order - de-dash, CamelCase +and prefix with \"OrgSrc\". For example, +`font-lock-function-name-face' is associated with +\"OrgSrcFontLockFunctionNameFace\"." + (let* ((css-list (hfy-face-to-style fn)) + (style-name (concat "OrgSrc" + (mapconcat + 'capitalize (split-string + (hfy-face-or-def-to-name fn) "-") + ""))) + (color-val (cdr (assoc "color" css-list))) + (background-color-val (cdr (assoc "background" css-list))) + (style (and org-odt-create-custom-styles-for-srcblocks + (cond + ((eq fn 'default) + (format org-odt-src-block-paragraph-format + background-color-val color-val)) + (t + (format + " + + + " style-name color-val)))))) + (cons style-name style))) + +(defun org-odt-htmlfontify-string (line) + (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") + (hfy-html-quote-map '(("\"" """) + ("<" "<") + ("&" "&") + (">" ">") + (" " "") + (" " ""))) + (hfy-face-to-css 'org-odt-hfy-face-to-css) + (hfy-optimisations-1 (copy-sequence hfy-optimisations)) + (hfy-optimisations (add-to-list 'hfy-optimisations-1 + 'body-text-only)) + (hfy-begin-span-handler + (lambda (style text-block text-id text-begins-block-p) + (insert (format "" style)))) + (hfy-end-span-handler (lambda nil (insert "")))) + (org-no-warnings (htmlfontify-string line)))) + +(defun org-odt-do-format-code + (code &optional lang refs retain-labels num-start) + (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) + (lang-mode (and lang (intern (format "%s-mode" lang)))) + (code-lines (org-split-string code "\n")) + (code-length (length code-lines)) + (use-htmlfontify-p (and (functionp lang-mode) + org-odt-fontify-srcblocks + (require 'htmlfontify nil t) + (fboundp 'htmlfontify-string))) + (code (if (not use-htmlfontify-p) code + (with-temp-buffer + (insert code) + (funcall lang-mode) + (font-lock-fontify-buffer) + (buffer-string)))) + (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string + 'org-odt--encode-plain-text)) + (par-style (if use-htmlfontify-p "OrgSrcBlock" + "OrgFixedWidthBlock")) + (i 0)) + (assert (= code-length (length (org-split-string code "\n")))) + (setq code + (org-export-format-code + code + (lambda (loc line-num ref) + (setq par-style + (concat par-style (and (= (incf i) code-length) "LastLine"))) + + (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) + (setq loc (funcall fontifier loc)) + (when ref + (setq loc (org-odt--target loc (concat "coderef-" ref)))) + (assert par-style) + (setq loc (format "\n%s" + par-style loc)) + (if (not line-num) loc + (format "\n%s\n" loc))) + num-start refs)) + (cond + ((not num-start) code) + ((= num-start 0) + (format + "\n%s" + " text:continue-numbering=\"false\"" code)) + (t + (format + "\n%s" + " text:continue-numbering=\"true\"" code))))) + +(defun org-odt-format-code (element info) + (let* ((lang (org-element-property :language element)) + ;; Extract code and references. + (code-info (org-export-unravel-code element)) + (code (car code-info)) + (refs (cdr code-info)) + ;; Does the src block contain labels? + (retain-labels (org-element-property :retain-labels element)) + ;; Does it have line numbers? + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0)))) + (org-odt-do-format-code code lang refs retain-labels num-start))) + +(defun org-odt-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (attributes (org-export-read-attribute :attr_odt src-block)) + (captions (org-odt-format-label src-block info 'definition)) + (caption (car captions)) (short-caption (cdr captions))) + (concat + (and caption + (format "\n%s" + "Listing" caption)) + (let ((--src-block (org-odt-format-code src-block info))) + (if (not (plist-get attributes :textbox)) --src-block + (format "\n%s" + "Text_20_body" + (org-odt--textbox --src-block nil nil nil))))))) + + +;;;; Statistics Cookie + +(defun org-odt-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" + "OrgCode" cookie-value))) + + +;;;; Strike-Through + +(defun org-odt-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to ODT. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "%s" + "Strikethrough" contents)) + + +;;;; Subscript + +(defun org-odt-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSubscript" contents)) + + +;;;; Superscript + +(defun org-odt-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSuperscript" contents)) + + +;;;; Table Cell + +(defun org-odt-table-style-spec (element info) + (let* ((table (org-export-get-parent-table element)) + (table-attributes (org-export-read-attribute :attr_odt table)) + (table-style (plist-get table-attributes :style))) + (assoc table-style org-odt-table-styles))) + +(defun org-odt-get-table-cell-styles (table-cell info) + "Retrieve styles applicable to a table cell. +R and C are (zero-based) row and column numbers of the table +cell. STYLE-SPEC is an entry in `org-odt-table-styles' +applicable to the current table. It is `nil' if the table is not +associated with any style attributes. + +Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). + +When STYLE-SPEC is nil, style the table cell the conventional way +- choose cell borders based on row and column groupings and +choose paragraph alignment based on `org-col-cookies' text +property. See also +`org-odt-get-paragraph-style-cookie-for-table-cell'. + +When STYLE-SPEC is non-nil, ignore the above cookie and return +styles congruent with the ODF-1.2 specification." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) (c (cdr table-cell-address)) + (style-spec (org-odt-table-style-spec table-cell info)) + (table-dimensions (org-export-table-dimensions + (org-export-get-parent-table table-cell) + info))) + (when style-spec + ;; LibreOffice - particularly the Writer - honors neither table + ;; templates nor custom table-cell styles. Inorder to retain + ;; inter-operability with LibreOffice, only automatic styles are + ;; used for styling of table-cells. The current implementation is + ;; congruent with ODF-1.2 specification and hence is + ;; future-compatible. + + ;; Additional Note: LibreOffice's AutoFormat facility for tables - + ;; which recognizes as many as 16 different cell types - is much + ;; richer. Unfortunately it is NOT amenable to easy configuration + ;; by hand. + (let* ((template-name (nth 1 style-spec)) + (cell-style-selectors (nth 2 style-spec)) + (cell-type + (cond + ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) + (= c 0)) "FirstColumn") + ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) + (= (1+ c) (cdr table-dimensions))) + "LastColumn") + ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) + (= r 0)) "FirstRow") + ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) + (= (1+ r) (car table-dimensions))) + "LastRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 1)) "EvenRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 0)) "OddRow") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 1)) "EvenColumn") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 0)) "OddColumn") + (t "")))) + (concat template-name cell-type))))) + +(defun org-odt-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) + (c (cdr table-cell-address)) + (horiz-span (or (org-export-table-cell-width table-cell info) 0)) + (table-row (org-export-get-parent table-cell)) + (custom-style-prefix (org-odt-get-table-cell-styles + table-cell info)) + (paragraph-style + (or + (and custom-style-prefix + (format "%sTableParagraph" custom-style-prefix)) + (concat + (cond + ((and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + "OrgTableHeading") + ((let* ((table (org-export-get-parent-table table-cell)) + (table-attrs (org-export-read-attribute :attr_odt table)) + (table-header-columns + (let ((cols (plist-get table-attrs :header-columns))) + (and cols (read cols))))) + (<= c (cond ((wholenump table-header-columns) + (- table-header-columns 1)) + (table-header-columns 0) + (t -1)))) + "OrgTableHeading") + (t "OrgTableContents")) + (capitalize (symbol-name (org-export-table-cell-alignment + table-cell info)))))) + (cell-style-name + (or + (and custom-style-prefix (format "%sTableCell" + custom-style-prefix)) + (concat + "OrgTblCell" + (when (or (org-export-table-row-starts-rowgroup-p table-row info) + (zerop r)) "T") + (when (org-export-table-row-ends-rowgroup-p table-row info) "B") + (when (and (org-export-table-cell-starts-colgroup-p table-cell info) + (not (zerop c)) ) "L")))) + (cell-attributes + (concat + (format " table:style-name=\"%s\"" cell-style-name) + (and (> horiz-span 0) + (format " table:number-columns-spanned=\"%d\"" + (1+ horiz-span)))))) + (unless contents (setq contents "")) + (concat + (assert paragraph-style) + (format "\n\n%s\n" + cell-attributes + (let ((table-cell-contents (org-element-contents table-cell))) + (if (memq (org-element-type (car table-cell-contents)) + org-element-all-elements) + contents + (format "\n%s" + paragraph-style contents)))) + (let (s) + (dotimes (i horiz-span s) + (setq s (concat s "\n")))) + "\n"))) + + +;;;; Table Row + +(defun org-odt-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to ODT. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-tags + (if (and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + ;; If the row belongs to the first rowgroup and the + ;; table has more than one row groups, then this row + ;; belongs to the header row group. + '("\n" . "\n") + ;; Otherwise, it belongs to non-header row group. + '("\n" . "\n")))) + (concat + ;; Does this row begin a rowgroup? + (when (org-export-table-row-starts-rowgroup-p table-row info) + (car rowgroup-tags)) + ;; Actual table row + (format "\n\n%s\n" contents) + ;; Does this row end a rowgroup? + (when (org-export-table-row-ends-rowgroup-p table-row info) + (cdr rowgroup-tags)))))) + + +;;;; Table + +(defun org-odt-table-first-row-data-cells (table info) + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-odt--table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el doesn't support export to OD format. Strip + ;; such tables from export. + (table.el + (prog1 nil + (message + (concat + "(ox-odt): Found table.el-type table in the source Org file." + " table.el doesn't support export to ODT format." + " Stripping the table from export.")))) + ;; Case 2: Native Org tables. + (otherwise + (let* ((captions (org-odt-format-label table info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (attributes (org-export-read-attribute :attr_odt table)) + (custom-table-style (nth 1 (org-odt-table-style-spec table info))) + (table-column-specs + (function + (lambda (table info) + (let* ((table-style (or custom-table-style "OrgTable")) + (column-style (format "%sColumn" table-style))) + (mapconcat + (lambda (table-cell) + (let ((width (1+ (or (org-export-table-cell-width + table-cell info) 0))) + (s (format + "\n" + column-style)) + out) + (dotimes (i width out) (setq out (concat s out))))) + (org-odt-table-first-row-data-cells table info) "\n")))))) + (concat + ;; caption. + (when caption + (format "\n%s" + "Table" caption)) + ;; begin table. + (let* ((automatic-name + (org-odt-add-automatic-style "Table" attributes))) + (format + "\n" + (or custom-table-style (cdr automatic-name) "OrgTable") + (concat (when short-caption + (format " table:name=\"%s\"" short-caption))))) + ;; column specification. + (funcall table-column-specs table info) + ;; actual contents. + "\n" contents + ;; end table. + ""))))) + +(defun org-odt-table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information. + +Use `org-odt--table' to typeset the table. Handle details +pertaining to indentation here." + (let* ((--element-preceded-by-table-p + (function + (lambda (element info) + (loop for el in (org-export-get-previous-element element info t) + thereis (eq (org-element-type el) 'table))))) + (--walk-list-genealogy-and-collect-tags + (function + (lambda (table info) + (let* ((genealogy (org-export-get-genealogy table)) + (list-genealogy + (when (eq (org-element-type (car genealogy)) 'item) + (loop for el in genealogy + when (memq (org-element-type el) + '(item plain-list)) + collect el))) + (llh-genealogy + (apply 'nconc + (loop for el in genealogy + when (and (eq (org-element-type el) 'headline) + (org-export-low-level-p el info)) + collect + (list el + (assq 'headline + (org-element-contents + (org-export-get-parent el))))))) + parent-list) + (nconc + ;; Handle list genealogy. + (loop for el in list-genealogy collect + (case (org-element-type el) + (plain-list + (setq parent-list el) + (cons "" + (format "\n" + (case (org-element-property :type el) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + "text:continue-numbering=\"true\""))) + (item + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((funcall --element-preceded-by-table-p + parent-list info) + '("" . "")) + (t '("" . "")))))) + ;; Handle low-level headlines. + (loop for el in llh-genealogy + with step = 'item collect + (case step + (plain-list + (setq step 'item) ; Flip-flop + (setq parent-list el) + (cons "" + (format "\n" + (if (org-export-numbered-headline-p + el info) + "OrgNumberedList" + "OrgBulletedList") + "text:continue-numbering=\"true\""))) + (item + (setq step 'plain-list) ; Flip-flop + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((let ((section? (org-export-get-previous-element + parent-list info))) + (and section? + (eq (org-element-type section?) 'section) + (assq 'table (org-element-contents section?)))) + '("" . "")) + (t + '("" . ""))))))))))) + (close-open-tags (funcall --walk-list-genealogy-and-collect-tags + table info))) + ;; OpenDocument schema does not permit table to occur within a + ;; list item. + + ;; One solution - the easiest and lightweight, in terms of + ;; implementation - is to put the table in an indented text box + ;; and make the text box part of the list-item. Unfortunately if + ;; the table is big and spans multiple pages, the text box could + ;; overflow. In this case, the following attribute will come + ;; handy. + + ;; ,---- From OpenDocument-v1.1.pdf + ;; | 15.27.28 Overflow behavior + ;; | + ;; | For text boxes contained within text document, the + ;; | style:overflow-behavior property specifies the behavior of text + ;; | boxes where the containing text does not fit into the text + ;; | box. + ;; | + ;; | If the attribute's value is clip, the text that does not fit + ;; | into the text box is not displayed. + ;; | + ;; | If the attribute value is auto-create-new-frame, a new frame + ;; | will be created on the next page, with the same position and + ;; | dimensions of the original frame. + ;; | + ;; | If the style:overflow-behavior property's value is + ;; | auto-create-new-frame and the text box has a minimum width or + ;; | height specified, then the text box will grow until the page + ;; | bounds are reached before a new frame is created. + ;; `---- + + ;; Unfortunately, LibreOffice-3.4.6 doesn't honor + ;; auto-create-new-frame property and always resorts to clipping + ;; the text box. This results in table being truncated. + + ;; So we solve the problem the hard (and fun) way using list + ;; continuations. + + ;; The problem only becomes more interesting if you take in to + ;; account the following facts: + ;; + ;; - Description lists are simulated as plain lists. + ;; - Low-level headlines can be listified. + ;; - In Org-mode, a table can occur not only as a regular list + ;; item, but also within description lists and low-level + ;; headlines. + + ;; See `org-odt-translate-description-lists' and + ;; `org-odt-translate-low-level-headlines' for how this is + ;; tackled. + + (concat "\n" + ;; Discontinue the list. + (mapconcat 'car close-open-tags "\n") + ;; Put the table in an indented section. + (let* ((table (org-odt--table table contents info)) + (level (/ (length (mapcar 'car close-open-tags)) 2)) + (style (format "OrgIndentedSection-Level-%d" level))) + (when table (org-odt-format-section table style))) + ;; Continue the list. + (mapconcat 'cdr (nreverse close-open-tags) "\n")))) + + +;;;; Target + +(defun org-odt-target (target contents info) + "Transcode a TARGET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-element-property :value target))) + (org-odt--target "" (org-export-solidify-link-text value)))) + + +;;;; Timestamp + +(defun org-odt-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((raw-value (org-element-property :raw-value timestamp)) + (type (org-element-property :type timestamp))) + (if (not org-odt-use-date-fields) + (let ((value (org-odt-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format "%s" + "OrgActiveTimestamp" value)) + ((inactive inactive-range) + (format "%s" + "OrgInactiveTimestamp" value)) + (otherwise value))) + (case type + (active + (format "%s" + "OrgActiveTimestamp" + (format "<%s>" (org-odt--format-timestamp timestamp)))) + (inactive + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]" (org-odt--format-timestamp timestamp)))) + (active-range + (format "%s" + "OrgActiveTimestamp" + (format "<%s>–<%s>" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (inactive-range + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]–[%s]" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (otherwise + (format "%s" + "OrgDiaryTimestamp" + (org-odt-plain-text (org-timestamp-translate timestamp) + info))))))) + + +;;;; Underline + +(defun org-odt-underline (underline contents info) + "Transcode UNDERLINE from Org to ODT. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "%s" + "Underline" contents)) + + +;;;; Verbatim + +(defun org-odt-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value verbatim)))) + + +;;;; Verse Block + +(defun org-odt-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to ODT. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Add line breaks to each line of verse. + (setq contents (replace-regexp-in-string + "\\(\\)?[ \t]*\n" + "" contents)) + ;; Replace tabs and spaces. + (setq contents (org-odt--encode-tabs-and-spaces contents)) + ;; Surround it in a verse environment. + (format "\n%s" + "OrgVerse" contents)) + + + +;;; Filters + +;;;; LaTeX fragments + +(defun org-odt--translate-latex-fragments (tree backend info) + (let ((processing-type (plist-get info :with-latex)) + (count 0)) + ;; Normalize processing-type to one of dvipng, mathml or verbatim. + ;; If the desired converter is not available, force verbatim + ;; processing. + (case processing-type + ((t mathml) + (if (and (fboundp 'org-format-latex-mathml-available-p) + (org-format-latex-mathml-available-p)) + (setq processing-type 'mathml) + (message "LaTeX to MathML converter not available.") + (setq processing-type 'verbatim))) + ((dvipng imagemagick) + (unless (and (org-check-external-command "latex" "" t) + (org-check-external-command + (if (eq processing-type 'dvipng) "dvipng" "convert") "" t)) + (message "LaTeX to PNG converter not available.") + (setq processing-type 'verbatim))) + (otherwise + (message "Unknown LaTeX option. Forcing verbatim.") + (setq processing-type 'verbatim))) + + ;; Store normalized value for later use. + (when (plist-get info :with-latex) + (plist-put info :with-latex processing-type)) + (message "Formatting LaTeX using %s" processing-type) + + ;; Convert `latex-fragment's and `latex-environment's. + (when (memq processing-type '(mathml dvipng imagemagick)) + (org-element-map tree '(latex-fragment latex-environment) + (lambda (latex-*) + (incf count) + (let* ((latex-frag (org-element-property :value latex-*)) + (input-file (plist-get info :input-file)) + (cache-dir (file-name-directory input-file)) + (cache-subdir (concat + (case processing-type + ((dvipng imagemagick) "ltxpng/") + (mathml "ltxmathml/")) + (file-name-sans-extension + (file-name-nondirectory input-file)))) + (display-msg + (case processing-type + ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) + (mathml (format "Creating MathML snippet %d..." count)))) + ;; Get an Org-style link to PNG image or the MathML + ;; file. + (org-link + (let ((link (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-subdir cache-dir + nil display-msg + nil nil processing-type) + (buffer-substring-no-properties + (point-min) (point-max))))) + (if (not (string-match "file:\\([^]]*\\)" link)) + (prog1 nil (message "LaTeX Conversion failed.")) + link)))) + (when org-link + ;; Conversion succeeded. Parse above Org-style link to a + ;; `link' object. + (let* ((link (car (org-element-map (with-temp-buffer + (org-mode) + (insert org-link) + (org-element-parse-buffer)) + 'link 'identity)))) + ;; Orphan the link. + (org-element-put-property link :parent nil) + (let* ( + (replacement + (case (org-element-type latex-*) + ;; Case 1: LaTeX environment. + ;; Mimic a "standalone image or formula" by + ;; enclosing the `link' in a `paragraph'. + ;; Copy over original attributes, captions to + ;; the enclosing paragraph. + (latex-environment + (org-element-adopt-elements + (list 'paragraph + (list :style "OrgFormula" + :name (org-element-property :name + latex-*) + :caption (org-element-property :caption + latex-*))) + link)) + ;; Case 2: LaTeX fragment. + ;; No special action. + (latex-fragment link)))) + ;; Note down the object that link replaces. + (org-element-put-property replacement :replaces + (list (org-element-type latex-*) + (list :value latex-frag))) + ;; Replace now. + (org-element-set-element latex-* replacement)))))) + info))) + tree) + + +;;;; Description lists + +;; This translator is necessary to handle indented tables in a uniform +;; manner. See comment in `org-odt--table'. + +(defun org-odt--translate-description-lists (tree backend info) + ;; OpenDocument has no notion of a description list. So simulate it + ;; using plain lists. Description lists in the exported document + ;; are typeset in the same manner as they are in a typical HTML + ;; document. + ;; + ;; Specifically, a description list like this: + ;; + ;; ,---- + ;; | - term-1 :: definition-1 + ;; | - term-2 :: definition-2 + ;; `---- + ;; + ;; gets translated in to the following form: + ;; + ;; ,---- + ;; | - term-1 + ;; | - definition-1 + ;; | - term-2 + ;; | - definition-2 + ;; `---- + ;; + ;; Further effect is achieved by fixing the OD styles as below: + ;; + ;; 1. Set the :type property of the simulated lists to + ;; `descriptive-1' and `descriptive-2'. Map these to list-styles + ;; that has *no* bullets whatsoever. + ;; + ;; 2. The paragraph containing the definition term is styled to be + ;; in bold. + ;; + (org-element-map tree 'plain-list + (lambda (el) + (when (equal (org-element-property :type el) 'descriptive) + (org-element-set-element + el + (apply 'org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-1)) + (mapcar + (lambda (item) + (org-element-adopt-elements + (list 'item (list :checkbox (org-element-property + :checkbox item))) + (list 'paragraph (list :style "Text_20_body_20_bold") + (or (org-element-property :tag item) "(no term)")) + (org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-2)) + (apply 'org-element-adopt-elements + (list 'item nil) + (org-element-contents item))))) + (org-element-contents el))))) + nil) + info) + tree) + +;;;; List tables + +;; Lists that are marked with attribute `:list-table' are called as +;; list tables. They will be rendered as a table within the exported +;; document. + +;; Consider an example. The following list table +;; +;; #+attr_odt :list-table t +;; - Row 1 +;; - 1.1 +;; - 1.2 +;; - 1.3 +;; - Row 2 +;; - 2.1 +;; - 2.2 +;; - 2.3 +;; +;; will be exported as though it were an Org table like the one show +;; below. +;; +;; | Row 1 | 1.1 | 1.2 | 1.3 | +;; | Row 2 | 2.1 | 2.2 | 2.3 | +;; +;; Note that org-tables are NOT multi-line and each line is mapped to +;; a unique row in the exported document. So if an exported table +;; needs to contain a single paragraph (with copious text) it needs to +;; be typed up in a single line. Editing such long lines using the +;; table editor will be a cumbersome task. Furthermore inclusion of +;; multi-paragraph text in a table cell is well-nigh impossible. +;; +;; A LIST-TABLE circumvents above problems. +;; +;; Note that in the example above the list items could be paragraphs +;; themselves and the list can be arbitrarily deep. +;; +;; Inspired by following thread: +;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html + +;; Translate lists to tables + +(defun org-odt--translate-list-tables (tree backend info) + (org-element-map tree 'plain-list + (lambda (l1-list) + (when (org-export-read-attribute :attr_odt l1-list :list-table) + ;; Replace list with table. + (org-element-set-element + l1-list + ;; Build replacement table. + (apply 'org-element-adopt-elements + (list 'table '(:type org :attr_odt (":style \"GriddedTable\""))) + (org-element-map l1-list 'item + (lambda (l1-item) + (let* ((l1-item-contents (org-element-contents l1-item)) + l1-item-leading-text l2-list) + ;; Remove Level-2 list from the Level-item. It + ;; will be subsequently attached as table-cells. + (let ((cur l1-item-contents) prev) + (while (and cur (not (eq (org-element-type (car cur)) + 'plain-list))) + (setq prev cur) + (setq cur (cdr cur))) + (when prev + (setcdr prev nil) + (setq l2-list (car cur))) + (setq l1-item-leading-text l1-item-contents)) + ;; Level-1 items start a table row. + (apply 'org-element-adopt-elements + (list 'table-row (list :type 'standard)) + ;; Leading text of level-1 item define + ;; the first table-cell. + (apply 'org-element-adopt-elements + (list 'table-cell nil) + l1-item-leading-text) + ;; Level-2 items define subsequent + ;; table-cells of the row. + (org-element-map l2-list 'item + (lambda (l2-item) + (apply 'org-element-adopt-elements + (list 'table-cell nil) + (org-element-contents l2-item))) + info nil 'item)))) + info nil 'item)))) + nil) + info) + tree) + + +;;; Interactive functions + +(defun org-odt-create-manifest-file-entry (&rest args) + (push args org-odt-manifest-file-entries)) + +(defun org-odt-write-manifest-file () + (make-directory (concat org-odt-zip-dir "META-INF")) + (let ((manifest-file (concat org-odt-zip-dir "META-INF/manifest.xml"))) + (with-current-buffer + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect manifest-file t)) + (insert + " + \n") + (mapc + (lambda (file-entry) + (let* ((version (nth 2 file-entry)) + (extra (if (not version) "" + (format " manifest:version=\"%s\"" version)))) + (insert + (format org-odt-manifest-file-entry-tag + (nth 0 file-entry) (nth 1 file-entry) extra)))) + org-odt-manifest-file-entries) + (insert "\n")))) + +(defmacro org-odt--export-wrap (out-file &rest body) + `(let* ((--out-file ,out-file) + (out-file-type (file-name-extension --out-file)) + (org-odt-xml-files '("META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml")) + ;; Initialize temporary workarea. All files that end up in + ;; the exported document get parked/created here. + (org-odt-zip-dir (file-name-as-directory + (make-temp-file (format "%s-" out-file-type) t))) + (org-odt-manifest-file-entries nil) + (--cleanup-xml-buffers + (function + (lambda nil + ;; Kill all XML buffers. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + org-odt-xml-files) + ;; Delete temporary directory and also other embedded + ;; files that get copied there. + (delete-directory org-odt-zip-dir t))))) + (condition-case err + (progn + (unless (executable-find "zip") + ;; Not at all OSes ship with zip by default + (error "Executable \"zip\" needed for creating OpenDocument files")) + ;; Do export. This creates a bunch of xml files ready to be + ;; saved and zipped. + (progn ,@body) + ;; Create a manifest entry for content.xml. + (org-odt-create-manifest-file-entry "text/xml" "content.xml") + ;; Write mimetype file + (let* ((mimetypes + '(("odt" . "application/vnd.oasis.opendocument.text") + ("odf" . "application/vnd.oasis.opendocument.formula"))) + (mimetype (cdr (assoc-string out-file-type mimetypes t)))) + (unless mimetype + (error "Unknown OpenDocument backend %S" out-file-type)) + (write-region mimetype nil (concat org-odt-zip-dir "mimetype")) + (org-odt-create-manifest-file-entry mimetype "/" "1.2")) + ;; Write out the manifest entries before zipping + (org-odt-write-manifest-file) + ;; Save all XML files. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + ;; Prettify output if needed. + (when org-odt-prettify-xml + (indent-region (point-min) (point-max))) + (save-buffer 0))))) + org-odt-xml-files) + ;; Run zip. + (let* ((target --out-file) + (target-name (file-name-nondirectory target)) + (cmds `(("zip" "-mX0" ,target-name "mimetype") + ("zip" "-rmTq" ,target-name ".")))) + ;; If a file with same name as the desired output file + ;; exists, remove it. + (when (file-exists-p target) + (delete-file target)) + ;; Zip up the xml files. + (let ((coding-system-for-write 'no-conversion) exitcode err-string) + (message "Creating ODT file...") + ;; Switch temporarily to content.xml. This way Zip + ;; process will inherit `org-odt-zip-dir' as the current + ;; directory. + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "content.xml") t) + (mapc + (lambda (cmd) + (message "Running %s" (mapconcat 'identity cmd " ")) + (setq err-string + (with-output-to-string + (setq exitcode + (apply 'call-process (car cmd) + nil standard-output nil (cdr cmd))))) + (or (zerop exitcode) + (error (concat "Unable to create OpenDocument file." + (format " Zip failed with error (%s)" + err-string))))) + cmds))) + ;; Move the zip file from temporary work directory to + ;; user-mandated location. + (rename-file (concat org-odt-zip-dir target-name) target) + (message "Created %s" (expand-file-name target)) + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + ;; Open the OpenDocument file in archive-mode for + ;; examination. + (find-file-noselect target t) + ;; Return exported file. + (cond + ;; Case 1: Conversion desired on exported file. Run the + ;; converter on the OpenDocument file. Return the + ;; converted file. + (org-odt-preferred-output-format + (or (org-odt-convert target org-odt-preferred-output-format) + target)) + ;; Case 2: No further conversion. Return exported + ;; OpenDocument file. + (t target)))) + (error + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) + + +;;;; Export to OpenDocument formula + +;;;###autoload +(defun org-odt-export-as-odf (latex-frag &optional odf-file) + "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. +Use `org-create-math-formula' to convert LATEX-FRAG first to +MathML. When invoked as an interactive command, use +`org-latex-regexps' to infer LATEX-FRAG from currently active +region. If no LaTeX fragments are found, prompt for it. Push +MathML source to kill ring depending on the value of +`org-export-copy-to-kill-ring'." + (interactive + `(,(let (frag) + (setq frag (and (setq frag (and (region-active-p) + (buffer-substring (region-beginning) + (region-end)))) + (loop for e in org-latex-regexps + thereis (when (string-match (nth 1 e) frag) + (match-string (nth 2 e) frag))))) + (read-string "LaTeX Fragment: " frag nil frag)) + ,(let ((odf-filename (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name)))) + (read-file-name "ODF filename: " nil odf-filename nil + (file-name-nondirectory odf-filename))))) + (let ((filename (or odf-file + (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name))))) + (org-odt--export-wrap + filename + (let* ((buffer (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect (concat org-odt-zip-dir + "content.xml") t)))) + (coding-system-for-write 'utf-8) + (save-buffer-coding-system 'utf-8)) + (set-buffer buffer) + (set-buffer-file-coding-system coding-system-for-write) + (let ((mathml (org-create-math-formula latex-frag))) + (unless mathml (error "No Math formula created")) + (insert mathml) + ;; Add MathML to kill ring, if needed. + (when (org-export--copy-to-kill-ring-p) + (org-kill-new (buffer-string)))))))) + +;;;###autoload +(defun org-odt-export-as-odf-and-open () + "Export LaTeX fragment as OpenDocument formula and immediately open it. +Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument +formula file." + (interactive) + (org-open-file (call-interactively 'org-odt-export-as-odf) 'system)) + + +;;;; Export to OpenDocument Text + +;;;###autoload +(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist) + "Export current buffer to a ODT file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".odt" subtreep))) + (if async + (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt)) + `(expand-file-name + (org-odt--export-wrap + ,outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in + ;; collecting styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export + ;; process. + (let ((out-buf + (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t)))) + (output (org-export-as + 'odt ,subtreep ,visible-only nil ,ext-plist))) + (with-current-buffer out-buf + (erase-buffer) + (insert output))))))) + (org-odt--export-wrap + outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in collecting + ;; styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export process. + (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist)) + (out-buf (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t))))) + (with-current-buffer out-buf (erase-buffer) (insert output)))))))) + + +;;;; Convert between OpenDocument and other formats + +(defun org-odt-reachable-p (in-fmt out-fmt) + "Return non-nil if IN-FMT can be converted to OUT-FMT." + (catch 'done + (let ((reachable-formats (org-odt-do-reachable-formats in-fmt))) + (dolist (e reachable-formats) + (let ((out-fmt-spec (assoc out-fmt (cdr e)))) + (when out-fmt-spec + (throw 'done (cons (car e) out-fmt-spec)))))))) + +(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg) + "Workhorse routine for `org-odt-convert'." + (require 'browse-url) + (let* ((in-file (expand-file-name (or in-file buffer-file-name))) + (dummy (or (file-readable-p in-file) + (error "Cannot read %s" in-file))) + (in-fmt (file-name-extension in-file)) + (out-fmt (or out-fmt (error "Output format unspecified"))) + (how (or (org-odt-reachable-p in-fmt out-fmt) + (error "Cannot convert from %s format to %s format?" + in-fmt out-fmt))) + (convert-process (car how)) + (out-file (concat (file-name-sans-extension in-file) "." + (nth 1 (or (cdr how) out-fmt)))) + (extra-options (or (nth 2 (cdr how)) "")) + (out-dir (file-name-directory in-file)) + (cmd (format-spec convert-process + `((?i . ,(shell-quote-argument in-file)) + (?I . ,(browse-url-file-url in-file)) + (?f . ,out-fmt) + (?o . ,out-file) + (?O . ,(browse-url-file-url out-file)) + (?d . , (shell-quote-argument out-dir)) + (?D . ,(browse-url-file-url out-dir)) + (?x . ,extra-options))))) + (when (file-exists-p out-file) + (delete-file out-file)) + + (message "Executing %s" cmd) + (let ((cmd-output (shell-command-to-string cmd))) + (message "%s" cmd-output)) + + (cond + ((file-exists-p out-file) + (message "Exported to %s" out-file) + (when prefix-arg + (message "Opening %s..." out-file) + (org-open-file out-file 'system)) + out-file) + (t + (message "Export to %s failed" out-file) + nil)))) + +(defun org-odt-do-reachable-formats (in-fmt) + "Return verbose info about formats to which IN-FMT can be converted. +Return a list where each element is of the +form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See +`org-odt-convert-processes' for CONVERTER-PROCESS and see +`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST." + (let* ((converter + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)))) + (capabilities + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)) + org-odt-convert-capabilities)) + reachable-formats) + (when converter + (dolist (c capabilities) + (when (member in-fmt (nth 1 c)) + (push (cons converter (nth 2 c)) reachable-formats)))) + reachable-formats)) + +(defun org-odt-reachable-formats (in-fmt) + "Return list of formats to which IN-FMT can be converted. +The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." + (let (l) + (mapc (lambda (e) (add-to-list 'l e)) + (apply 'append (mapcar + (lambda (e) (mapcar 'car (cdr e))) + (org-odt-do-reachable-formats in-fmt)))) + l)) + +(defun org-odt-convert-read-params () + "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'. +This is a helper routine for interactive use." + (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) + (in-file (read-file-name "File to be converted: " + nil buffer-file-name t)) + (in-fmt (file-name-extension in-file)) + (out-fmt-choices (org-odt-reachable-formats in-fmt)) + (out-fmt + (or (and out-fmt-choices + (funcall input "Output format: " + out-fmt-choices nil nil nil)) + (error + "No known converter or no known output formats for %s files" + in-fmt)))) + (list in-file out-fmt))) + +;;;###autoload +(defun org-odt-convert (&optional in-file out-fmt prefix-arg) + "Convert IN-FILE to format OUT-FMT using a command line converter. +IN-FILE is the file to be converted. If unspecified, it defaults +to variable `buffer-file-name'. OUT-FMT is the desired output +format. Use `org-odt-convert-process' as the converter. +If PREFIX-ARG is non-nil then the newly converted file is opened +using `org-open-file'." + (interactive + (append (org-odt-convert-read-params) current-prefix-arg)) + (org-odt-do-convert in-file out-fmt prefix-arg)) + +;;; Library Initializations + +(mapc + (lambda (desc) + ;; Let Emacs open all OpenDocument files in archive mode + (add-to-list 'auto-mode-alist + (cons (concat "\\." (car desc) "\\'") 'archive-mode))) + org-odt-file-extensions) + +(provide 'ox-odt) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-odt.el ends here diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el new file mode 100644 index 00000000000..3b2e55e2d45 --- /dev/null +++ b/lisp/org/ox-org.el @@ -0,0 +1,253 @@ +;;; ox-org.el --- Org Back-End for Org Export Engine + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: org, wp + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'ox) +(declare-function htmlize-buffer "htmlize" (&optional buffer)) + +(defgroup org-export-org nil + "Options for exporting Org mode files to Org." + :tag "Org Export Org" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(define-obsolete-variable-alias + 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4") +(defcustom org-org-htmlized-css-url nil + "URL pointing to the CSS defining colors for htmlized Emacs buffers. +Normally when creating an htmlized version of an Org buffer, +htmlize will create the CSS to define the font colors. However, +this does not work when converting in batch mode, and it also can +look bad if different people with different fontification setup +work on the same website. When this variable is non-nil, +creating an htmlized version of an Org buffer using +`org-org-export-as-org' will include a link to this URL if the +setting of `org-html-htmlize-output-type' is 'css." + :group 'org-export-org + :type '(choice + (const :tag "Don't include external stylesheet link" nil) + (string :tag "URL or local href"))) + +(org-export-define-backend 'org + '((babel-call . org-org-identity) + (bold . org-org-identity) + (center-block . org-org-identity) + (clock . org-org-identity) + (code . org-org-identity) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (diary-sexp . org-org-identity) + (drawer . org-org-identity) + (dynamic-block . org-org-identity) + (entity . org-org-identity) + (example-block . org-org-identity) + (fixed-width . org-org-identity) + (footnote-definition . org-org-identity) + (footnote-reference . org-org-identity) + (headline . org-org-headline) + (horizontal-rule . org-org-identity) + (inline-babel-call . org-org-identity) + (inline-src-block . org-org-identity) + (inlinetask . org-org-identity) + (italic . org-org-identity) + (item . org-org-identity) + (keyword . org-org-keyword) + (latex-environment . org-org-identity) + (latex-fragment . org-org-identity) + (line-break . org-org-identity) + (link . org-org-identity) + (node-property . org-org-identity) + (paragraph . org-org-identity) + (plain-list . org-org-identity) + (planning . org-org-identity) + (property-drawer . org-org-identity) + (quote-block . org-org-identity) + (quote-section . org-org-identity) + (radio-target . org-org-identity) + (section . org-org-identity) + (special-block . org-org-identity) + (src-block . org-org-identity) + (statistics-cookie . org-org-identity) + (strike-through . org-org-identity) + (subscript . org-org-identity) + (superscript . org-org-identity) + (table . org-org-identity) + (table-cell . org-org-identity) + (table-row . org-org-identity) + (target . org-org-identity) + (timestamp . org-org-identity) + (underline . org-org-identity) + (verbatim . org-org-identity) + (verse-block . org-org-identity)) + :menu-entry + '(?O "Export to Org" + ((?O "As Org buffer" org-org-export-as-org) + (?o "As Org file" org-org-export-to-org) + (?v "As Org file and open" + (lambda (a s v b) + (if a (org-org-export-to-org t s v b) + (org-open-file (org-org-export-to-org nil s v b)))))))) + +(defun org-org-identity (blob contents info) + "Transcode BLOB element or object back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (let ((case-fold-search t)) + (replace-regexp-in-string + "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" "" + (org-export-expand blob contents t)))) + +(defun org-org-headline (headline contents info) + "Transcode HEADLINE element back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (unless (plist-get info :with-todo-keywords) + (org-element-put-property headline :todo-keyword nil)) + (unless (plist-get info :with-tags) + (org-element-put-property headline :tags nil)) + (unless (plist-get info :with-priority) + (org-element-put-property headline :priority nil)) + (org-element-put-property headline :level + (org-export-get-relative-level headline info)) + (org-element-headline-interpreter headline contents)) + +(defun org-org-keyword (keyword contents info) + "Transcode KEYWORD element back into Org syntax. +CONTENTS is nil. INFO is ignored. This function ignores +keywords targeted at other export back-ends." + (unless (member (org-element-property :key keyword) + (mapcar + (lambda (block-cons) + (and (eq (cdr block-cons) 'org-element-export-block-parser) + (car block-cons))) + org-element-block-name-alist)) + (org-element-keyword-interpreter keyword nil))) + +;;;###autoload +(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an Org buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ORG Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (org-export-to-buffer 'org "*Org ORG Export*" + async subtreep visible-only nil ext-plist (lambda () (org-mode)))) + +;;;###autoload +(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an org file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file name." + (interactive) + (let ((outfile (org-export-output-file-name ".org" subtreep))) + (org-export-to-file 'org outfile + async subtreep visible-only nil ext-plist))) + +;;;###autoload +(defun org-org-publish-to-org (plist filename pub-dir) + "Publish an org file to org. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'org filename ".org" plist pub-dir) + (when (plist-get plist :htmlized-source) + (require 'htmlize) + (require 'ox-html) + (let* ((org-inhibit-startup t) + (htmlize-output-type 'css) + (html-ext (concat "." (or (plist-get plist :html-extension) + org-html-extension "html"))) + (visitingp (find-buffer-visiting filename)) + (work-buffer (or visitingp (find-file filename))) + newbuf) + (font-lock-fontify-buffer) + (show-all) + (org-show-block-all) + (setq newbuf (htmlize-buffer)) + (with-current-buffer newbuf + (when org-org-htmlized-css-url + (goto-char (point-min)) + (and (re-search-forward + ".*" nil t) + (replace-match + (format + "" + org-org-htmlized-css-url) t t))) + (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) + (kill-buffer newbuf) + (unless visitingp (kill-buffer work-buffer))) + (set-buffer-modified-p nil))) + + +(provide 'ox-org) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-org.el ends here diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el new file mode 100644 index 00000000000..55cb6466e9c --- /dev/null +++ b/lisp/org/ox-publish.el @@ -0,0 +1,1239 @@ +;;; ox-publish.el --- Publish Related Org Mode Files as a Website +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. + +;; Author: David O'Toole +;; Maintainer: Carsten Dominik +;; Keywords: hypermedia, outlines, wp + +;; 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 . + +;;; Commentary: + +;; This program allow configurable publishing of related sets of +;; Org mode files as a complete website. +;; +;; ox-publish.el can do the following: +;; +;; + Publish all one's Org files to a given export back-end +;; + Upload HTML, images, attachments and other files to a web server +;; + Exclude selected private pages from publishing +;; + Publish a clickable sitemap of pages +;; + Manage local timestamps for publishing only changed files +;; + Accept plugin functions to extend range of publishable content +;; +;; Documentation for publishing is in the manual. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'format-spec) +(require 'ox) + + + +;;; Variables + +(defvar org-publish-temp-files nil + "Temporary list of files to be published.") + +;; Here, so you find the variable right before it's used the first time: +(defvar org-publish-cache nil + "This will cache timestamps and titles for files in publishing projects. +Blocks could hash sha1 values here.") + +(defgroup org-publish nil + "Options for publishing a set of Org-mode and related files." + :tag "Org Publishing" + :group 'org) + +(defcustom org-publish-project-alist nil + "Association list to control publishing behavior. +Each element of the alist is a publishing 'project.' The CAR of +each element is a string, uniquely identifying the project. The +CDR of each element is in one of the following forms: + +1. A well-formed property list with an even number of elements, + alternating keys and values, specifying parameters for the + publishing process. + + \(:property value :property value ... ) + +2. A meta-project definition, specifying of a list of + sub-projects: + + \(:components (\"project-1\" \"project-2\" ...)) + +When the CDR of an element of org-publish-project-alist is in +this second form, the elements of the list after `:components' +are taken to be components of the project, which group together +files requiring different publishing options. When you publish +such a project with \\[org-publish], the components all publish. + +When a property is given a value in `org-publish-project-alist', +its setting overrides the value of the corresponding user +variable (if any) during publishing. However, options set within +a file override everything. + +Most properties are optional, but some should always be set: + + `:base-directory' + + Directory containing publishing source files. + + `:base-extension' + + Extension (without the dot!) of source files. This can be + a regular expression. If not given, \"org\" will be used as + default extension. + + `:publishing-directory' + + Directory (possibly remote) where output files will be + published. + +The `:exclude' property may be used to prevent certain files from +being published. Its value may be a string or regexp matching +file names you don't want to be published. + +The `:include' property may be used to include extra files. Its +value may be a list of filenames to include. The filenames are +considered relative to the base directory. + +When both `:include' and `:exclude' properties are given values, +the exclusion step happens first. + +One special property controls which back-end function to use for +publishing files in the project. This can be used to extend the +set of file types publishable by `org-publish', as well as the +set of output formats. + + `:publishing-function' + + Function to publish file. Each back-end may define its + own (i.e. `org-latex-publish-to-pdf', + `org-html-publish-to-html'). May be a list of functions, in + which case each function in the list is invoked in turn. + +Another property allows you to insert code that prepares +a project for publishing. For example, you could call GNU Make +on a certain makefile, to ensure published files are built up to +date. + + `:preparation-function' + + Function to be called before publishing this project. This + may also be a list of functions. + + `:completion-function' + + Function to be called after publishing this project. This + may also be a list of functions. + +Some properties control details of the Org publishing process, +and are equivalent to the corresponding user variables listed in +the right column. Back-end specific properties may also be +included. See the back-end documentation for more information. + + :author `user-full-name' + :creator `org-export-creator-string' + :email `user-mail-address' + :exclude-tags `org-export-exclude-tags' + :headline-levels `org-export-headline-levels' + :language `org-export-default-language' + :preserve-breaks `org-export-preserve-breaks' + :section-numbers `org-export-with-section-numbers' + :select-tags `org-export-select-tags' + :time-stamp-file `org-export-time-stamp-file' + :with-archived-trees `org-export-with-archived-trees' + :with-author `org-export-with-author' + :with-creator `org-export-with-creator' + :with-date `org-export-with-date' + :with-drawers `org-export-with-drawers' + :with-email `org-export-with-email' + :with-emphasize `org-export-with-emphasize' + :with-entities `org-export-with-entities' + :with-fixed-width `org-export-with-fixed-width' + :with-footnotes `org-export-with-footnotes' + :with-inlinetasks `org-export-with-inlinetasks' + :with-latex `org-export-with-latex' + :with-priority `org-export-with-priority' + :with-smart-quotes `org-export-with-smart-quotes' + :with-special-strings `org-export-with-special-strings' + :with-statistics-cookies' `org-export-with-statistics-cookies' + :with-sub-superscript `org-export-with-sub-superscripts' + :with-toc `org-export-with-toc' + :with-tables `org-export-with-tables' + :with-tags `org-export-with-tags' + :with-tasks `org-export-with-tasks' + :with-timestamps `org-export-with-timestamps' + :with-planning `org-export-with-planning' + :with-todo-keywords `org-export-with-todo-keywords' + +The following properties may be used to control publishing of +a site-map of files or summary page for a given project. + + `:auto-sitemap' + + Whether to publish a site-map during + `org-publish-current-project' or `org-publish-all'. + + `:sitemap-filename' + + Filename for output of sitemap. Defaults to \"sitemap.org\". + + `:sitemap-title' + + Title of site-map page. Defaults to name of file. + + `:sitemap-function' + + Plugin function to use for generation of site-map. Defaults + to `org-publish-org-sitemap', which generates a plain list of + links to all files in the project. + + `:sitemap-style' + + Can be `list' (site-map is just an itemized list of the + titles of the files involved) or `tree' (the directory + structure of the source files is reflected in the site-map). + Defaults to `tree'. + + `:sitemap-sans-extension' + + Remove extension from site-map's file-names. Useful to have + cool URIs (see http://www.w3.org/Provider/Style/URI). + Defaults to nil. + +If you create a site-map file, adjust the sorting like this: + + `:sitemap-sort-folders' + + Where folders should appear in the site-map. Set this to + `first' (default) or `last' to display folders first or last, + respectively. Any other value will mix files and folders. + + `:sitemap-sort-files' + + The site map is normally sorted alphabetically. You can + change this behaviour setting this to `anti-chronologically', + `chronologically', or nil. + + `:sitemap-ignore-case' + + Should sorting be case-sensitive? Default nil. + +The following property control the creation of a concept index. + + `:makeindex' + + Create a concept index. The file containing the index has to + be called \"theindex.org\". If it doesn't exist in the + project, it will be generated. Contents of the index are + stored in the file \"theindex.inc\", which can be included in + \"theindex.org\". + +Other properties affecting publication. + + `:body-only' + + Set this to t to publish only the body of the documents." + :group 'org-export-publish + :type 'alist) + +(defcustom org-publish-use-timestamps-flag t + "Non-nil means use timestamp checking to publish only changed files. +When nil, do no timestamp checking and always publish all files." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-timestamp-directory + (convert-standard-filename "~/.org-timestamps/") + "Name of directory in which to store publishing timestamps." + :group 'org-export-publish + :type 'directory) + +(defcustom org-publish-list-skipped-files t + "Non-nil means show message about files *not* published." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-sitemap-sort-files 'alphabetically + "Method to sort files in site-maps. +Possible values are `alphabetically', `chronologically', +`anti-chronologically' and nil. + +If `alphabetically', files will be sorted alphabetically. If +`chronologically', files will be sorted with older modification +time first. If `anti-chronologically', files will be sorted with +newer modification time first. nil won't sort files. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-files'." + :group 'org-export-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-folders 'first + "A symbol, denoting if folders are sorted first in sitemaps. +Possible values are `first', `last', and nil. +If `first', folders will be sorted before files. +If `last', folders are sorted to the end after the files. +Any other value will not mix files and folders. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-folders'." + :group 'org-export-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-ignore-case nil + "Non-nil when site-map sorting should ignore case. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-ignore-case'." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-sitemap-date-format "%Y-%m-%d" + "Format for printing a date in the sitemap. +See `format-time-string' for allowed formatters." + :group 'org-export-publish + :type 'string) + +(defcustom org-publish-sitemap-file-entry-format "%t" + "Format string for site-map file entry. +You could use brackets to delimit on what part the link will be. + +%t is the title. +%a is the author. +%d is the date formatted using `org-publish-sitemap-date-format'." + :group 'org-export-publish + :type 'string) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Timestamp-related functions + +(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) + "Return path to timestamp file for filename FILENAME." + (setq filename (concat filename "::" (or pub-dir "") "::" + (format "%s" (or pub-func "")))) + (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) + +(defun org-publish-needed-p + (filename &optional pub-dir pub-func true-pub-dir base-dir) + "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. +TRUE-PUB-DIR is where the file will truly end up. Currently we +are not using this - maybe it can eventually be used to check if +the file is present at the target location, and how old it is. +Right now we cannot do this, because we do not know under what +file name the file will be stored - the publishing function can +still decide about that independently." + (let ((rtn (if (not org-publish-use-timestamps-flag) t + (org-publish-cache-file-needs-publishing + filename pub-dir pub-func base-dir)))) + (if rtn (message "Publishing file %s using `%s'" filename pub-func) + (when org-publish-list-skipped-files + (message "Skipping unmodified file %s" filename))) + rtn)) + +(defun org-publish-update-timestamp + (filename &optional pub-dir pub-func base-dir) + "Update publishing timestamp for file FILENAME. +If there is no timestamp, create one." + (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (stamp (org-publish-cache-ctime-of-src filename))) + (org-publish-cache-set key stamp))) + +(defun org-publish-remove-all-timestamps () + "Remove all files in the timestamp directory." + (let ((dir org-publish-timestamp-directory) + files) + (when (and (file-exists-p dir) (file-directory-p dir)) + (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (org-publish-reset-cache)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Getting project information out of `org-publish-project-alist' + +(defun org-publish-expand-projects (projects-alist) + "Expand projects in PROJECTS-ALIST. +This splices all the components into the list." + (let ((rest projects-alist) rtn p components) + (while (setq p (pop rest)) + (if (setq components (plist-get (cdr p) :components)) + (setq rest (append + (mapcar (lambda (x) (assoc x org-publish-project-alist)) + components) + rest)) + (push p rtn))) + (nreverse (delete-dups (delq nil rtn))))) + +(defvar org-publish-sitemap-sort-files) +(defvar org-publish-sitemap-sort-folders) +(defvar org-publish-sitemap-ignore-case) +(defvar org-publish-sitemap-requested) +(defvar org-publish-sitemap-date-format) +(defvar org-publish-sitemap-file-entry-format) +(defun org-publish-compare-directory-files (a b) + "Predicate for `sort', that sorts folders and files for sitemap." + (let ((retval t)) + (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) + ;; First we sort files: + (when org-publish-sitemap-sort-files + (case org-publish-sitemap-sort-files + (alphabetically + (let* ((adir (file-directory-p a)) + (aorg (and (string-match "\\.org$" a) (not adir))) + (bdir (file-directory-p b)) + (borg (and (string-match "\\.org$" b) (not bdir))) + (A (if aorg (concat (file-name-directory a) + (org-publish-find-title a)) a)) + (B (if borg (concat (file-name-directory b) + (org-publish-find-title b)) b))) + (setq retval (if org-publish-sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((anti-chronologically chronologically) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval + (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) + (>= A B))))))) + ;; Directory-wise wins: + (when org-publish-sitemap-sort-folders + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (equal org-publish-sitemap-sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) + retval)) + +(defun org-publish-get-base-files-1 + (base-dir &optional recurse match skip-file skip-dir) + "Set `org-publish-temp-files' with files from BASE-DIR directory. +If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is +non-nil, restrict this list to the files matching the regexp +MATCH. If SKIP-FILE is non-nil, skip file matching the regexp +SKIP-FILE. If SKIP-DIR is non-nil, don't check directories +matching the regexp SKIP-DIR when recursing through BASE-DIR." + (mapc (lambda (f) + (let ((fd-p (file-directory-p f)) + (fnd (file-name-nondirectory f))) + (if (and fd-p recurse + (not (string-match "^\\.+$" fnd)) + (if skip-dir (not (string-match skip-dir fnd)) t)) + (org-publish-get-base-files-1 + f recurse match skip-file skip-dir) + (unless (or fd-p ;; this is a directory + (and skip-file (string-match skip-file fnd)) + (not (file-exists-p (file-truename f))) + (not (string-match match fnd))) + + (pushnew f org-publish-temp-files))))) + (let ((all-files (if (not recurse) (directory-files base-dir t match) + ;; If RECURSE is non-nil, we want all files + ;; matching MATCH and sub-directories. + (org-remove-if-not + (lambda (file) + (or (file-directory-p file) + (and match (string-match match file)))) + (directory-files base-dir t))))) + (if (not org-publish-sitemap-requested) all-files + (sort all-files 'org-publish-compare-directory-files))))) + +(defun org-publish-get-base-files (project &optional exclude-regexp) + "Return a list of all files in PROJECT. +If EXCLUDE-REGEXP is set, this will be used to filter out +matching filenames." + (let* ((project-plist (cdr project)) + (base-dir (file-name-as-directory + (plist-get project-plist :base-directory))) + (include-list (plist-get project-plist :include)) + (recurse (plist-get project-plist :recursive)) + (extension (or (plist-get project-plist :base-extension) "org")) + ;; sitemap-... variables are dynamically scoped for + ;; org-publish-compare-directory-files: + (org-publish-sitemap-requested + (plist-get project-plist :auto-sitemap)) + (sitemap-filename + (or (plist-get project-plist :sitemap-filename) "sitemap.org")) + (org-publish-sitemap-sort-folders + (if (plist-member project-plist :sitemap-sort-folders) + (plist-get project-plist :sitemap-sort-folders) + org-publish-sitemap-sort-folders)) + (org-publish-sitemap-sort-files + (cond ((plist-member project-plist :sitemap-sort-files) + (plist-get project-plist :sitemap-sort-files)) + ;; For backward compatibility: + ((plist-member project-plist :sitemap-alphabetically) + (if (plist-get project-plist :sitemap-alphabetically) + 'alphabetically nil)) + (t org-publish-sitemap-sort-files))) + (org-publish-sitemap-ignore-case + (if (plist-member project-plist :sitemap-ignore-case) + (plist-get project-plist :sitemap-ignore-case) + org-publish-sitemap-sort-ignore-case)) + (match (if (eq extension 'any) "^[^\\.]" + (concat "^[^\\.].*\\.\\(" extension "\\)$")))) + ;; Make sure `org-publish-sitemap-sort-folders' has an accepted + ;; value. + (unless (memq org-publish-sitemap-sort-folders '(first last)) + (setq org-publish-sitemap-sort-folders nil)) + + (setq org-publish-temp-files nil) + (if org-publish-sitemap-requested + (pushnew (expand-file-name (concat base-dir sitemap-filename)) + org-publish-temp-files)) + (org-publish-get-base-files-1 base-dir recurse match + ;; FIXME distinguish exclude regexp + ;; for skip-file and skip-dir? + exclude-regexp exclude-regexp) + (mapc (lambda (f) + (pushnew + (expand-file-name (concat base-dir f)) + org-publish-temp-files)) + include-list) + org-publish-temp-files)) + +(defun org-publish-get-project-from-filename (filename &optional up) + "Return the project that FILENAME belongs to." + (let* ((filename (expand-file-name filename)) + project-name) + + (catch 'p-found + (dolist (prj org-publish-project-alist) + (unless (plist-get (cdr prj) :components) + ;; [[info:org:Selecting%20files]] shows how this is supposed to work: + (let* ((r (plist-get (cdr prj) :recursive)) + (b (expand-file-name (file-name-as-directory + (plist-get (cdr prj) :base-directory)))) + (x (or (plist-get (cdr prj) :base-extension) "org")) + (e (plist-get (cdr prj) :exclude)) + (i (plist-get (cdr prj) :include)) + (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) + (when + (or (and i + (member filename + (mapcar (lambda (file) + (expand-file-name file b)) + i))) + (and (not (and e (string-match e filename))) + (string-match xm filename))) + (setq project-name (car prj)) + (throw 'p-found project-name)))))) + (when up + (dolist (prj org-publish-project-alist) + (if (member project-name (plist-get (cdr prj) :components)) + (setq project-name (car prj))))) + (assoc project-name org-publish-project-alist))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Tools for publishing functions in back-ends + +(defun org-publish-org-to (backend filename extension plist &optional pub-dir) + "Publish an Org file to a specified back-end. + +BACKEND is a symbol representing the back-end used for +transcoding. FILENAME is the filename of the Org file to be +published. EXTENSION is the extension used for the output +string, with the leading dot. PLIST is the property list for the +given project. + +Optional argument PUB-DIR, when non-nil is the publishing +directory. + +Return output file name." + (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) + ;; Check if a buffer visiting FILENAME is already open. + (let* ((org-inhibit-startup t) + (visitingp (find-buffer-visiting filename)) + (work-buffer (or visitingp (find-file-noselect filename)))) + (prog1 (with-current-buffer work-buffer + (let ((output-file + (org-export-output-file-name extension nil pub-dir)) + (body-p (plist-get plist :body-only))) + (org-export-to-file backend output-file + nil nil nil body-p + ;; Add `org-publish-collect-numbering' and + ;; `org-publish-collect-index' to final output + ;; filters. The latter isn't dependent on + ;; `:makeindex', since we want to keep it up-to-date + ;; in cache anyway. + (org-combine-plists + plist + `(:filter-final-output + ,(cons 'org-publish-collect-numbering + (cons 'org-publish-collect-index + (plist-get plist :filter-final-output)))))))) + ;; Remove opened buffer in the process. + (unless visitingp (kill-buffer work-buffer))))) + +(defun org-publish-attachment (plist filename pub-dir) + "Publish a file with no transformation of any kind. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (unless (file-directory-p pub-dir) + (make-directory pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) + (copy-file filename + (expand-file-name (file-name-nondirectory filename) pub-dir) + t))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Publishing files, sets of files, and indices + +(defun org-publish-file (filename &optional project no-cache) + "Publish file FILENAME from PROJECT. +If NO-CACHE is not nil, do not initialize org-publish-cache and +write it to disk. This is needed, since this function is used to +publish single files, when entire projects are published. +See `org-publish-projects'." + (let* ((project + (or project + (or (org-publish-get-project-from-filename filename) + (error "File %s not part of any known project" + (abbreviate-file-name filename))))) + (project-plist (cdr project)) + (ftname (expand-file-name filename)) + (publishing-function + (or (plist-get project-plist :publishing-function) + (error "No publishing function chosen"))) + (base-dir + (file-name-as-directory + (expand-file-name + (or (plist-get project-plist :base-directory) + (error "Project %s does not have :base-directory defined" + (car project)))))) + (pub-dir + (file-name-as-directory + (file-truename + (or (eval (plist-get project-plist :publishing-directory)) + (error "Project %s does not have :publishing-directory defined" + (car project)))))) + tmp-pub-dir) + + (unless no-cache (org-publish-initialize-cache (car project))) + + (setq tmp-pub-dir + (file-name-directory + (concat pub-dir + (and (string-match (regexp-quote base-dir) ftname) + (substring ftname (match-end 0)))))) + (if (listp publishing-function) + ;; allow chain of publishing functions + (mapc (lambda (f) + (when (org-publish-needed-p + filename pub-dir f tmp-pub-dir base-dir) + (funcall f project-plist filename tmp-pub-dir) + (org-publish-update-timestamp filename pub-dir f base-dir))) + publishing-function) + (when (org-publish-needed-p + filename pub-dir publishing-function tmp-pub-dir base-dir) + (funcall publishing-function project-plist filename tmp-pub-dir) + (org-publish-update-timestamp + filename pub-dir publishing-function base-dir))) + (unless no-cache (org-publish-write-cache-file)))) + +(defun org-publish-projects (projects) + "Publish all files belonging to the PROJECTS alist. +If `:auto-sitemap' is set, publish the sitemap too. If +`:makeindex' is set, also produce a file theindex.org." + (mapc + (lambda (project) + ;; Each project uses its own cache file: + (org-publish-initialize-cache (car project)) + (let* ((project-plist (cdr project)) + (exclude-regexp (plist-get project-plist :exclude)) + (sitemap-p (plist-get project-plist :auto-sitemap)) + (sitemap-filename (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (sitemap-function (or (plist-get project-plist :sitemap-function) + 'org-publish-org-sitemap)) + (org-publish-sitemap-date-format + (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (org-publish-sitemap-file-entry-format + (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format)) + (preparation-function + (plist-get project-plist :preparation-function)) + (completion-function (plist-get project-plist :completion-function)) + (files (org-publish-get-base-files project exclude-regexp)) + (theindex + (expand-file-name "theindex.org" + (plist-get project-plist :base-directory)))) + (when preparation-function (run-hooks 'preparation-function)) + (if sitemap-p (funcall sitemap-function project sitemap-filename)) + ;; Publish all files from PROJECT excepted "theindex.org". Its + ;; publishing will be deferred until "theindex.inc" is + ;; populated. + (dolist (file files) + (unless (equal file theindex) + (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". + (when (plist-get project-plist :makeindex) + (org-publish-index-generate-theindex + project (plist-get project-plist :base-directory)) + (org-publish-file theindex project t)) + (when completion-function (run-hooks 'completion-function)) + (org-publish-write-cache-file))) + (org-publish-expand-projects projects))) + +(defun org-publish-org-sitemap (project &optional sitemap-filename) + "Create a sitemap of pages in set defined by PROJECT. +Optionally set the filename of the sitemap with SITEMAP-FILENAME. +Default for SITEMAP-FILENAME is 'sitemap.org'." + (let* ((project-plist (cdr project)) + (dir (file-name-as-directory + (plist-get project-plist :base-directory))) + (localdir (file-name-directory dir)) + (indent-str (make-string 2 ?\ )) + (exclude-regexp (plist-get project-plist :exclude)) + (files (nreverse + (org-publish-get-base-files project exclude-regexp))) + (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) + (sitemap-title (or (plist-get project-plist :sitemap-title) + (concat "Sitemap for project " (car project)))) + (sitemap-style (or (plist-get project-plist :sitemap-style) + 'tree)) + (sitemap-sans-extension + (plist-get project-plist :sitemap-sans-extension)) + (visiting (find-buffer-visiting sitemap-filename)) + (ifn (file-name-nondirectory sitemap-filename)) + file sitemap-buffer) + (with-current-buffer + (let ((org-inhibit-startup t)) + (setq sitemap-buffer + (or visiting (find-file sitemap-filename)))) + (erase-buffer) + (insert (concat "#+TITLE: " sitemap-title "\n\n")) + (while (setq file (pop files)) + (let ((fn (file-name-nondirectory file)) + (link (file-relative-name file dir)) + (oldlocal localdir)) + (when sitemap-sans-extension + (setq link (file-name-sans-extension link))) + ;; sitemap shouldn't list itself + (unless (equal (file-truename sitemap-filename) + (file-truename file)) + (if (eq sitemap-style 'list) + (message "Generating list-style sitemap for %s" sitemap-title) + (message "Generating tree-style sitemap for %s" sitemap-title) + (setq localdir (concat (file-name-as-directory dir) + (file-name-directory link))) + (unless (string= localdir oldlocal) + (if (string= localdir dir) + (setq indent-str (make-string 2 ?\ )) + (let ((subdirs + (split-string + (directory-file-name + (file-name-directory + (file-relative-name localdir dir))) "/")) + (subdir "") + (old-subdirs (split-string + (file-relative-name oldlocal dir) "/"))) + (setq indent-str (make-string 2 ?\ )) + (while (string= (car old-subdirs) (car subdirs)) + (setq indent-str (concat indent-str (make-string 2 ?\ ))) + (pop old-subdirs) + (pop subdirs)) + (dolist (d subdirs) + (setq subdir (concat subdir d "/")) + (insert (concat indent-str " + " d "\n")) + (setq indent-str (make-string + (+ (length indent-str) 2) ?\ ))))))) + ;; This is common to 'flat and 'tree + (let ((entry + (org-publish-format-file-entry + org-publish-sitemap-file-entry-format file project-plist)) + (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) + (cond ((string-match-p regexp entry) + (string-match regexp entry) + (insert (concat indent-str " + " (match-string 1 entry) + "[[file:" link "][" + (match-string 2 entry) + "]]" (match-string 3 entry) "\n"))) + (t + (insert (concat indent-str " + [[file:" link "][" + entry + "]]\n")))))))) + (save-buffer)) + (or visiting (kill-buffer sitemap-buffer)))) + +(defun org-publish-format-file-entry (fmt file project-plist) + (format-spec + fmt + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-publish-sitemap-date-format + (org-publish-find-date file))) + (?a . ,(or (plist-get project-plist :author) user-full-name))))) + +(defun org-publish-find-title (file &optional reset) + "Find the title of FILE in project." + (or + (and (not reset) (org-publish-cache-get-file-property file :title nil t)) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file)))) + (with-current-buffer buffer + (org-mode) + (let ((title + (let ((property (plist-get (org-export-get-environment) :title))) + (if property (org-element-interpret-data property) + (file-name-nondirectory (file-name-sans-extension file)))))) + (unless visiting (kill-buffer buffer)) + (org-publish-cache-set-file-property file :title title) + title))))) + +(defun org-publish-find-date (file) + "Find the date of FILE in project. +This function assumes FILE is either a directory or an Org file. +If FILE is an Org file and provides a DATE keyword use it. In +any other case use the file system's modification time. Return +time in `current-time' format." + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let* ((visiting (find-buffer-visiting file)) + (file-buf (or visiting (find-file-noselect file nil))) + (date (plist-get + (with-current-buffer file-buf + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-get-environment)) + :date))) + (unless visiting (kill-buffer file-buf)) + ;; DATE is either a timestamp object or a secondary string. If it + ;; is a timestamp or if the secondary string contains a timestamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((eq (org-element-type date) 'timestamp) + (org-time-string-to-time (org-element-interpret-data date))) + ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file)))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Interactive publishing functions + +;;;###autoload +(defalias 'org-publish-project 'org-publish) + +;;;###autoload +(defun org-publish (project &optional force async) + "Publish PROJECT. + +PROJECT is either a project name, as a string, or a project +alist (see `org-publish-project-alist' variable). + +When optional argument FORCE is non-nil, force publishing all +files in PROJECT. With a non-nil optional argument ASYNC, +publishing will be done asynchronously, in another process." + (interactive + (list + (assoc (org-icompleting-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + current-prefix-arg)) + (let ((project-alist (if (not (stringp project)) (list project) + ;; If this function is called in batch mode, + ;; project is still a string here. + (list (assoc project org-publish-project-alist))))) + (if async + (org-export-async-start 'ignore + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-projects ',project-alist))) + (save-window-excursion + (let* ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-projects project-alist)))))) + +;;;###autoload +(defun org-publish-all (&optional force async) + "Publish all projects. +With prefix argument FORCE, remove all files in the timestamp +directory and force publishing all projects. With a non-nil +optional argument ASYNC, publishing will be done asynchronously, +in another process." + (interactive "P") + (if async + (org-export-async-start 'ignore + `(progn + (when ',force (org-publish-remove-all-timestamps)) + (let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-projects ',org-publish-project-alist)))) + (when force (org-publish-remove-all-timestamps)) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-projects org-publish-project-alist))))) + + +;;;###autoload +(defun org-publish-current-file (&optional force async) + "Publish the current file. +With prefix argument FORCE, force publish the file. When +optional argument ASYNC is non-nil, publishing will be done +asynchronously, in another process." + (interactive "P") + (let ((file (buffer-file-name (buffer-base-buffer)))) + (if async + (org-export-async-start 'ignore + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-file ,file))) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-file file)))))) + +;;;###autoload +(defun org-publish-current-project (&optional force async) + "Publish the project associated with the current file. +With a prefix argument, force publishing of all files in +the project." + (interactive "P") + (save-window-excursion + (let ((project (org-publish-get-project-from-filename + (buffer-file-name (buffer-base-buffer)) 'up))) + (if project (org-publish project force async) + (error "File %s is not part of any known project" + (buffer-file-name (buffer-base-buffer))))))) + + + +;;; Index generation + +(defun org-publish-collect-index (output backend info) + "Update index for a file in cache. + +OUTPUT is the output from transcoding current file. BACKEND is +the back-end that was used for transcoding. INFO is a plist +containing publishing and export options. + +The index relative to current file is stored as an alist. An +association has the following shape: (TERM FILE-NAME PARENT), +where TERM is the indexed term, as a string, FILE-NAME is the +original full path of the file where the term in encountered, and +PARENT is a reference to the headline, if any, containing the +original index keyword. When non-nil, this reference is a cons +cell. Its CAR is a symbol among `id', `custom-id' and `name' and +its CDR is a string." + (let ((file (plist-get info :input-file))) + (org-publish-cache-set-file-property + file :index + (delete-dups + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INDEX") + (let ((parent (org-export-get-parent-headline k))) + (list (org-element-property :value k) + file + (cond + ((not parent) nil) + ((let ((id (org-element-property :ID parent))) + (and id (cons 'id id)))) + ((let ((id (org-element-property :CUSTOM_ID parent))) + (and id (cons 'custom-id id)))) + (t (cons 'name + ;; Remove statistics cookie. + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value parent))))))))) + info)))) + ;; Return output unchanged. + output) + +(defun org-publish-index-generate-theindex (project directory) + "Retrieve full index from cache and build \"theindex.org\". +PROJECT is the project the index relates to. DIRECTORY is the +publishing directory." + (let ((all-files (org-publish-get-base-files + project (plist-get (cdr project) :exclude))) + full-index) + ;; Compile full index and sort it alphabetically. + (dolist (file all-files + (setq full-index + (sort (nreverse full-index) + (lambda (a b) (string< (downcase (car a)) + (downcase (car b))))))) + (let ((index (org-publish-cache-get-file-property file :index))) + (dolist (term index) + (unless (member term full-index) (push term full-index))))) + ;; Write "theindex.inc" in DIRECTORY. + (with-temp-file (expand-file-name "theindex.inc" directory) + (let ((current-letter nil) (last-entry nil)) + (dolist (idx full-index) + (let* ((entry (org-split-string (car idx) "!")) + (letter (upcase (substring (car entry) 0 1))) + ;; Transform file into a path relative to publishing + ;; directory. + (file (file-relative-name + (nth 1 idx) + (plist-get (cdr project) :base-directory)))) + ;; Check if another letter has to be inserted. + (unless (string= letter current-letter) + (insert (format "* %s\n" letter))) + ;; Compute the first difference between last entry and + ;; current one: it tells the level at which new items + ;; should be added. + (let* ((rank (if (equal entry last-entry) (1- (length entry)) + (loop for n from 0 to (length entry) + unless (equal (nth n entry) (nth n last-entry)) + return n))) + (len (length (nthcdr rank entry)))) + ;; For each term after the first difference, create + ;; a new sub-list with the term as body. Moreover, + ;; linkify the last term. + (dotimes (n len) + (insert + (concat + (make-string (* (+ rank n) 2) ? ) " - " + (if (not (= (1- len) n)) (nth (+ rank n) entry) + ;; Last term: Link it to TARGET, if possible. + (let ((target (nth 2 idx))) + (format + "[[%s][%s]]" + ;; Destination. + (case (car target) + ('nil (format "file:%s" file)) + (id (format "id:%s" (cdr target))) + (custom-id (format "file:%s::#%s" file (cdr target))) + (otherwise (format "file:%s::*%s" file (cdr target)))) + ;; Description. + (car (last entry))))) + "\n")))) + (setq current-letter letter last-entry entry)))) + ;; Create "theindex.org", if it doesn't exist yet, and provide + ;; a default index file. + (let ((index.org (expand-file-name "theindex.org" directory))) + (unless (file-exists-p index.org) + (with-temp-file index.org + (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n"))))))) + + + +;;; External Fuzzy Links Resolution +;; +;; This part implements tools to resolve [[file.org::*Some headline]] +;; links, where "file.org" belongs to the current project. + +(defun org-publish-collect-numbering (output backend info) + (org-publish-cache-set-file-property + (plist-get info :input-file) :numbering + (mapcar (lambda (entry) + (cons (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value (car entry)))) + (cdr entry))) + (plist-get info :headline-numbering))) + ;; Return output unchanged. + output) + +(defun org-publish-resolve-external-fuzzy-link (file fuzzy) + "Return numbering for headline matching FUZZY search in FILE. + +Return value is a list of numbers, or nil. This function allows +to resolve external fuzzy links like: + + [[file.org::*fuzzy][description]]" + (when org-publish-cache + (cdr (assoc (org-split-string + (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy)) + (org-publish-cache-get-file-property + (expand-file-name file) :numbering nil t))))) + + + +;;; Caching functions + +(defun org-publish-write-cache-file (&optional free-cache) + "Write `org-publish-cache' to file. +If FREE-CACHE, empty the cache." + (unless org-publish-cache + (error "`org-publish-write-cache-file' called, but no cache present")) + + (let ((cache-file (org-publish-cache-get ":cache-file:"))) + (unless cache-file + (error "Cannot find cache-file name in `org-publish-write-cache-file'")) + (with-temp-file cache-file + (let (print-level print-length) + (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (maphash (lambda (k v) + (insert + (format (concat "(puthash %S " + (if (or (listp v) (symbolp v)) + "'" "") + "%S org-publish-cache)\n") k v))) + org-publish-cache))) + (when free-cache (org-publish-reset-cache)))) + +(defun org-publish-initialize-cache (project-name) + "Initialize the projects cache if not initialized yet and return it." + + (unless project-name + (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) + + (unless (file-exists-p org-publish-timestamp-directory) + (make-directory org-publish-timestamp-directory t)) + (unless (file-directory-p org-publish-timestamp-directory) + (error "Org publish timestamp: %s is not a directory" + org-publish-timestamp-directory)) + + (unless (and org-publish-cache + (string= (org-publish-cache-get ":project:") project-name)) + (let* ((cache-file + (concat + (expand-file-name org-publish-timestamp-directory) + project-name ".cache")) + (cexists (file-exists-p cache-file))) + + (when org-publish-cache (org-publish-reset-cache)) + + (if cexists (load-file cache-file) + (setq org-publish-cache + (make-hash-table :test 'equal :weakness nil :size 100)) + (org-publish-cache-set ":project:" project-name) + (org-publish-cache-set ":cache-file:" cache-file)) + (unless cexists (org-publish-write-cache-file nil)))) + org-publish-cache) + +(defun org-publish-reset-cache () + "Empty org-publish-cache and reset it nil." + (message "%s" "Resetting org-publish-cache") + (when (hash-table-p org-publish-cache) + (clrhash org-publish-cache)) + (setq org-publish-cache nil)) + +(defun org-publish-cache-file-needs-publishing + (filename &optional pub-dir pub-func base-dir) + "Check the timestamp of the last publishing of FILENAME. +Return non-nil if the file needs publishing. Also check if +any included files have been more recently published, so that +the file including them will be republished as well." + (unless org-publish-cache + (error + "`org-publish-cache-file-needs-publishing' called, but no cache present")) + (let* ((case-fold-search t) + (key (org-publish-timestamp-filename filename pub-dir pub-func)) + (pstamp (org-publish-cache-get key)) + (org-inhibit-startup t) + (visiting (find-buffer-visiting filename)) + included-files-ctime buf) + + (when (equal (file-name-extension filename) "org") + (setq buf (find-file (expand-file-name filename))) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward + "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) + (let* ((included-file (expand-file-name (match-string 1)))) + (add-to-list 'included-files-ctime + (org-publish-cache-ctime-of-src included-file) t)))) + (unless visiting (kill-buffer buf))) + (if (null pstamp) t + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (or (< pstamp ctime) + (when included-files-ctime + (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) + included-files-ctime)))))))))) + +(defun org-publish-cache-set-file-property + (filename property value &optional project-name) + "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. +Use cache file of PROJECT-NAME. If the entry does not exist, it +will be created. Return VALUE." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename))) + (if pl (progn (plist-put pl property value) value) + (org-publish-cache-get-file-property + filename property value nil project-name)))) + +(defun org-publish-cache-get-file-property + (filename property &optional default no-create project-name) + "Return the value for a PROPERTY of file FILENAME in publishing cache. +Use cache file of PROJECT-NAME. Return the value of that PROPERTY +or DEFAULT, if the value does not yet exist. If the entry will +be created, unless NO-CREATE is not nil." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename)) retval) + (if pl + (if (plist-member pl property) + (setq retval (plist-get pl property)) + (setq retval default)) + ;; no pl yet: + (unless no-create + (org-publish-cache-set filename (list property default))) + (setq retval default)) + retval)) + +(defun org-publish-cache-get (key) + "Return the value stored in `org-publish-cache' for key KEY. +Returns nil, if no value or nil is found, or the cache does not +exist." + (unless org-publish-cache + (error "`org-publish-cache-get' called, but no cache present")) + (gethash key org-publish-cache)) + +(defun org-publish-cache-set (key value) + "Store KEY VALUE pair in `org-publish-cache'. +Returns value on success, else nil." + (unless org-publish-cache + (error "`org-publish-cache-set' called, but no cache present")) + (puthash key value org-publish-cache)) + +(defun org-publish-cache-ctime-of-src (file) + "Get the ctime of FILE as an integer." + (let ((attr (file-attributes + (expand-file-name (or (file-symlink-p file) file) + (file-name-directory file))))) + (if (not attr) (error "No such file: \"%s\"" file) + (+ (lsh (car (nth 5 attr)) 16) + (cadr (nth 5 attr)))))) + + +(provide 'ox-publish) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-publish.el ends here diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el new file mode 100644 index 00000000000..ef881afe2c0 --- /dev/null +++ b/lisp/org/ox-texinfo.el @@ -0,0 +1,1887 @@ +;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. +;; Author: Jonathan Leech-Pepin +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements a Texinfo back-end for Org generic +;; exporter. +;; +;; To test it, run +;; +;; M-: (org-export-to-buffer 'texinfo "*Test Texinfo*") RET +;; +;; in an Org mode buffer then switch to the buffer to see the Texinfo +;; export. See ox.el for more details on how this exporter works. +;; + +;; It introduces nine new buffer keywords: "TEXINFO_CLASS", +;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_POST_HEADER", +;; "TEXINFO_DIR_CATEGORY", "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC" +;; "SUBTITLE" and "SUBAUTHOR". + +;; +;; It introduces 1 new headline property keywords: +;; "TEXINFO_MENU_TITLE" for optional menu titles. +;; +;; To include inline code snippets (for example for generating @kbd{} +;; and @key{} commands), the following export-snippet keys are +;; accepted: +;; +;; texinfo +;; info +;; +;; You can add them for export snippets via any of the below: +;; +;; (add-to-list 'org-export-snippet-translation-alist +;; '("info" . "texinfo")) +;; + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) + +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'texinfo + '((bold . org-texinfo-bold) + (center-block . org-texinfo-center-block) + (clock . org-texinfo-clock) + (code . org-texinfo-code) + (comment . org-texinfo-comment) + (comment-block . org-texinfo-comment-block) + (drawer . org-texinfo-drawer) + (dynamic-block . org-texinfo-dynamic-block) + (entity . org-texinfo-entity) + (example-block . org-texinfo-example-block) + (export-block . org-texinfo-export-block) + (export-snippet . org-texinfo-export-snippet) + (fixed-width . org-texinfo-fixed-width) + (footnote-definition . org-texinfo-footnote-definition) + (footnote-reference . org-texinfo-footnote-reference) + (headline . org-texinfo-headline) + (inline-src-block . org-texinfo-inline-src-block) + (inlinetask . org-texinfo-inlinetask) + (italic . org-texinfo-italic) + (item . org-texinfo-item) + (keyword . org-texinfo-keyword) + (line-break . org-texinfo-line-break) + (link . org-texinfo-link) + (paragraph . org-texinfo-paragraph) + (plain-list . org-texinfo-plain-list) + (plain-text . org-texinfo-plain-text) + (planning . org-texinfo-planning) + (property-drawer . org-texinfo-property-drawer) + (quote-block . org-texinfo-quote-block) + (quote-section . org-texinfo-quote-section) + (radio-target . org-texinfo-radio-target) + (section . org-texinfo-section) + (special-block . org-texinfo-special-block) + (src-block . org-texinfo-src-block) + (statistics-cookie . org-texinfo-statistics-cookie) + (subscript . org-texinfo-subscript) + (superscript . org-texinfo-superscript) + (table . org-texinfo-table) + (table-cell . org-texinfo-table-cell) + (table-row . org-texinfo-table-row) + (target . org-texinfo-target) + (template . org-texinfo-template) + (timestamp . org-texinfo-timestamp) + (verbatim . org-texinfo-verbatim) + (verse-block . org-texinfo-verse-block)) + :export-block "TEXINFO" + :filters-alist + '((:filter-headline . org-texinfo-filter-section-blank-lines) + (:filter-section . org-texinfo-filter-section-blank-lines)) + :menu-entry + '(?i "Export to Texinfo" + ((?t "As TEXI file" org-texinfo-export-to-texinfo) + (?i "As INFO file" org-texinfo-export-to-info))) + :options-alist + '((:texinfo-filename "TEXINFO_FILENAME" nil org-texinfo-filename t) + (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t) + (:texinfo-header "TEXINFO_HEADER" nil nil newline) + (:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline) + (:subtitle "SUBTITLE" nil nil newline) + (:subauthor "SUBAUTHOR" nil nil newline) + (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) + (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) + (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t))) + + + +;;; User Configurable Variables + +(defgroup org-export-texinfo nil + "Options for exporting Org mode files to Texinfo." + :tag "Org Export Texinfo" + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-export) + +;;; Preamble + +(defcustom org-texinfo-filename "" + "Default filename for Texinfo output." + :group 'org-export-texinfo + :type '(string :tag "Export Filename")) + +(defcustom org-texinfo-coding-system nil + "Default document encoding for Texinfo output. + +If `nil' it will default to `buffer-file-coding-system'." + :group 'org-export-texinfo + :type 'coding-system) + +(defcustom org-texinfo-default-class "info" + "The default Texinfo class." + :group 'org-export-texinfo + :type '(string :tag "Texinfo class")) + +(defcustom org-texinfo-classes + '(("info" + "\\input texinfo @c -*- texinfo -*-" + ("@chapter %s" . "@unnumbered %s") + ("@section %s" . "@unnumberedsec %s") + ("@subsection %s" . "@unnumberedsubsec %s") + ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) + "Alist of Texinfo classes and associated header and structure. +If #+Texinfo_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + \(numbered-section . unnumbered-section\) + ...\) + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. + +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the \(reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-texinfo + :type '(repeat + (list (string :tag "Texinfo class") + (string :tag "Texinfo header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (function :tag "Hook computing sectioning")))))) + +;;; Headline + +(defcustom org-texinfo-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +As an example, one could set the variable to the following, in +order to reproduce the default set-up: + +\(defun org-texinfo-format-headline (todo todo-type priority text tags) + \"Default format function for a headline.\" + \(concat (when todo + \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) + \(when priority + \(format \"\\\\framebox{\\\\#%c} \" priority)) + text + \(when tags + \(format \"\\\\hfill{}\\\\textsc{%s}\" + \(mapconcat 'identity tags \":\"))))" + :group 'org-export-texinfo + :type 'function) + +;;; Node listing (menu) + +(defcustom org-texinfo-node-description-column 32 + "Column at which to start the description in the node + listings. + +If a node title is greater than this length, the description will +be placed after the end of the title." + :group 'org-export-texinfo + :type 'integer) + +;;; Footnotes +;; +;; Footnotes are inserted directly + +;;; Timestamps + +(defcustom org-texinfo-active-timestamp-format "@emph{%s}" + "A printf format string to be applied to active timestamps." + :group 'org-export-texinfo + :type 'string) + +(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-texinfo + :type 'string) + +(defcustom org-texinfo-diary-timestamp-format "@emph{%s}" + "A printf format string to be applied to diary timestamps." + :group 'org-export-texinfo + :type 'string) + +;;; Links + +(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" + "Format string for links with unknown path type." + :group 'org-export-texinfo + :type 'string) + +;;; Tables + +(defcustom org-texinfo-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-texinfo + :type 'boolean) + +(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e. \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-texinfo + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + +(defcustom org-texinfo-def-table-markup "@samp" + "Default setting for @table environments." + :group 'org-export-texinfo + :type 'string) + +;;; Text markup + +(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") + (code . code) + (italic . "@emph{%s}") + (verbatim . verb) + (comment . "@c %s")) + "Alist of Texinfo expressions to convert text markup. + +The key must be a symbol among `bold', `italic' and `comment'. +The value is a formatting string to wrap fontified text with. + +Value can also be set to the following symbols: `verb' and +`code'. For the former, Org will use \"@verb\" to +create a format string and select a delimiter character that +isn't in the string. For the latter, Org will use \"@code\" +to typeset and try to protect special characters. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-texinfo + :type 'alist + :options '(bold code italic verbatim comment)) + +;;; Drawers + +(defcustom org-texinfo-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in Texinfo code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default function simply returns the value of CONTENTS." + :group 'org-export-texinfo + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + +;;; Inlinetasks + +(defcustom org-texinfo-format-inlinetask-function 'ignore + "Function called to format an inlinetask in Texinfo code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behavior: + +\(defun org-texinfo-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for Texinfo export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"@strong{%s} \" todo)) + \(when priority (format \"#%c \" priority)) + title + \(when tags + \(format \":%s:\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \"@center %s\n\n\" + \"%s\" + \"\n\")) + full-title contents))" + :group 'org-export-texinfo + :type 'function) + +;;; Src blocks +;; +;; Src Blocks are example blocks, except for LISP + +;;; Compilation + +(defcustom org-texinfo-info-process + '("makeinfo %f") + "Commands to process a Texinfo file to an INFO file. +This is list of strings, each of them will be given to the shell +as a command. %f in the command will be replaced by the full +file name, %b by the file base name \(i.e without extension) and +%o by the base directory of the file." + :group 'org-export-texinfo + :type '(repeat :tag "Shell command sequence" + (string :tag "Shell command"))) + +(defcustom org-texinfo-logfiles-extensions + '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") + "The list of file extensions to consider as Texinfo logfiles. +The logfiles will be remove if `org-texinfo-remove-logfiles' is +non-nil." + :group 'org-export-texinfo + :type '(repeat (string :tag "Extension"))) + +(defcustom org-texinfo-remove-logfiles t + "Non-nil means remove the logfiles produced by compiling a Texinfo file. +By default, logfiles are files with these extensions: .aux, .toc, +.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove, +set `org-texinfo-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + + +;;; Constants +(defconst org-texinfo-max-toc-depth 4 + "Maximum depth for creation of detailed menu listings. Beyond + this depth Texinfo will not recognize the nodes and will cause + errors. Left as a constant in case this value ever changes.") + +(defconst org-texinfo-supported-coding-systems + '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u") + "List of coding systems supported by Texinfo, as strings. +Specified coding system will be matched against these strings. +If two strings share the same prefix (e.g. \"ISO-8859-1\" and +\"ISO-8859-15\"), the most specific one has to be listed first.") + + +;;; Internal Functions + +(defun org-texinfo-filter-section-blank-lines (headline back-end info) + "Filter controlling number of blank lines after a section." + (let ((blanks (make-string 2 ?\n))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))) + +(defun org-texinfo--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-texinfo--make-option-string (options) + "Return a comma separated string of keywords and values. +OPTIONS is an alist where the key is the options keyword as +a string, and the value a list containing the keyword value, or +nil." + (mapconcat (lambda (pair) + (concat (first pair) + (when (> (length (second pair)) 0) + (concat "=" (second pair))))) + options + ",")) + +(defun org-texinfo--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-texinfo-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ((eq 'verb fmt) + (let ((separator (org-texinfo--find-verb-separator text))) + (concat "@verb{" separator text separator "}"))) + ((eq 'code fmt) + (let ((start 0) + (rtn "") + char) + (while (string-match "[@{}]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (concat "@" char) + rtn (concat rtn char))) + (setq text (concat rtn text) + fmt "@code{%s}") + (format fmt text))) + ;; Else use format string. + (t (format fmt text))))) + +(defun org-texinfo--get-node (headline info) + "Return node entry associated to HEADLINE. +INFO is a plist used as a communication channel." + (let ((menu-title (org-export-get-alt-title headline info))) + (org-texinfo--sanitize-menu + (replace-regexp-in-string + "%" "%%" + (if menu-title (org-export-data menu-title info) + (org-texinfo--sanitize-headline + (org-element-property :title headline) info)))))) + +;;; Headline sanitizing + +(defun org-texinfo--sanitize-headline (headline info) + "Remove all formatting from the text of a headline for use in + node and menu listing." + (mapconcat 'identity + (org-texinfo--sanitize-headline-contents headline info) " ")) + +(defun org-texinfo--sanitize-headline-contents (headline info) + "Retrieve the content of the headline. + +Any content that can contain further formatting is checked +recursively, to ensure that nested content is also properly +retrieved." + (loop for contents in headline append + (cond + ;; already a string + ((stringp contents) + (list (replace-regexp-in-string " $" "" contents))) + ;; Is exported as-is (value) + ((org-element-map contents '(verbatim code) + (lambda (value) (org-element-property :value value)) info)) + ;; Has content and recurse into the content + ((org-element-contents contents) + (org-texinfo--sanitize-headline-contents + (org-element-contents contents) info))))) + +;;; Menu sanitizing + +(defun org-texinfo--sanitize-menu (title) + "Remove invalid characters from TITLE for use in menus and +nodes. + +Based on Texinfo specifications, the following must be removed: +@ { } ( ) : . ," + (replace-regexp-in-string "[@{}():,.]" "" title)) + +;;; Content sanitizing + +(defun org-texinfo--sanitize-content (text) + "Ensure characters are properly escaped when used in headlines or blocks. + +Escape characters are: @ { }" + (replace-regexp-in-string "\\\([@{}]\\\)" "@\\1" text)) + +;;; Menu creation + +(defun org-texinfo--build-menu (tree level info &optional detailed) + "Create the @menu/@end menu information from TREE at headline +level LEVEL. + +TREE contains the parse-tree to work with, either of the entire +document or of a specific parent headline. LEVEL indicates what +level of headlines to look at when generating the menu. INFO is +a plist containing contextual information. + +Detailed determines whether to build a single level of menu, or +recurse into all children as well." + (let ((menu (org-texinfo--generate-menu-list tree level info)) + output text-menu) + (cond + (detailed + ;; Looping is done within the menu generation. + (setq text-menu (org-texinfo--generate-detailed menu level info))) + (t + (setq text-menu (org-texinfo--generate-menu-items menu info)))) + (when text-menu + (setq output (org-texinfo--format-menu text-menu)) + (mapconcat 'identity output "\n")))) + +(defun org-texinfo--generate-detailed (menu level info) + "Generate a detailed listing of all subheadings within MENU starting at LEVEL. + +MENU is the parse-tree to work with. LEVEL is the starting level +for the menu headlines and from which recursion occurs. INFO is +a plist containing contextual information." + (when level + (let ((max-depth (min org-texinfo-max-toc-depth + (plist-get info :headline-levels)))) + (when (> max-depth level) + (loop for headline in menu append + (let* ((title (org-texinfo--menu-headlines headline info)) + ;; Create list of menu entries for the next level + (sublist (org-texinfo--generate-menu-list + headline (1+ level) info)) + ;; Generate the menu items for that level. If + ;; there are none omit that heading completely, + ;; otherwise join the title to it's related entries. + (submenu (if (org-texinfo--generate-menu-items sublist info) + (append (list title) + (org-texinfo--generate-menu-items sublist info)) + 'nil)) + ;; Start the process over the next level down. + (recursion (org-texinfo--generate-detailed sublist (1+ level) info))) + (setq recursion (append submenu recursion)) + recursion)))))) + +(defun org-texinfo--generate-menu-list (tree level info) + "Generate the list of headlines that are within a given level +of the tree for further formatting. + +TREE is the parse-tree containing the headlines. LEVEL is the +headline level to generate a list of. INFO is a plist holding +contextual information." + (org-element-map tree 'headline + (lambda (head) + (and (= (org-export-get-relative-level head info) level) + ;; Do not take note of footnotes or copying headlines. + (not (org-element-property :COPYING head)) + (not (org-element-property :footnote-section-p head)) + ;; Collect headline. + head)) + info)) + +(defun org-texinfo--generate-menu-items (items info) + "Generate a list of headline information from the listing ITEMS. + +ITEMS is a list of the headlines to be converted into entries. +INFO is a plist containing contextual information. + +Returns a list containing the following information from each +headline: length, title, description. This is used to format the +menu using `org-texinfo--format-menu'." + (loop for headline in items collect + (let* ((menu-title (org-texinfo--sanitize-menu + (org-export-data + (org-export-get-alt-title headline info) + info))) + (title (org-texinfo--sanitize-menu + (org-texinfo--sanitize-headline + (org-element-property :title headline) info))) + (descr (org-export-data + (org-element-property :DESCRIPTION headline) + info)) + (menu-entry (if (string= "" menu-title) title menu-title)) + (len (length menu-entry)) + (output (list len menu-entry descr))) + output))) + +(defun org-texinfo--menu-headlines (headline info) + "Retrieve the title from HEADLINE. + +INFO is a plist holding contextual information. + +Return the headline as a list of (length title description) with +length of -1 and nil description. This is used in +`org-texinfo--format-menu' to identify headlines as opposed to +entries." + (let ((title (org-export-data + (org-element-property :title headline) info))) + (list -1 title 'nil))) + +(defun org-texinfo--format-menu (text-menu) + "Format the TEXT-MENU items to be properly printed in the menu. + +Each entry in the menu should be provided as (length title +description). + +Headlines in the detailed menu are given length -1 to ensure they +are never confused with other entries. They also have no +description. + +Other menu items are output as: + Title:: description + +With the spacing between :: and description based on the length +of the longest menu entry." + + (let (output) + (setq output + (mapcar (lambda (name) + (let* ((title (nth 1 name)) + (desc (nth 2 name)) + (length (nth 0 name)) + (column (max + ;;6 is "* " ":: " for inserted text + length + (- + org-texinfo-node-description-column + 6))) + (spacing (- column length) + )) + (if (> length -1) + (concat "* " title ":: " + (make-string spacing ?\s) + (if desc + (concat desc))) + (concat "\n" title "\n")))) + text-menu)) + output)) + +;;; Template + +(defun org-texinfo-template (contents info) + "Return complete document string after Texinfo conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let* ((title (org-export-data (plist-get info :title) info)) + (info-filename (or (plist-get info :texinfo-filename) + (file-name-nondirectory + (org-export-output-file-name ".info")))) + (author (org-export-data (plist-get info :author) info)) + (lang (org-export-data (plist-get info :language) info)) + (texinfo-header (plist-get info :texinfo-header)) + (texinfo-post-header (plist-get info :texinfo-post-header)) + (subtitle (plist-get info :subtitle)) + (subauthor (plist-get info :subauthor)) + (class (plist-get info :texinfo-class)) + (header (nth 1 (assoc class org-texinfo-classes))) + (copying + (org-element-map (plist-get info :parse-tree) 'headline + (lambda (hl) (and (org-element-property :COPYING hl) hl)) info t)) + (dircat (plist-get info :texinfo-dircat)) + (dirtitle (plist-get info :texinfo-dirtitle)) + (dirdesc (plist-get info :texinfo-dirdesc)) + ;; Spacing to align description (column 32 - 3 for `* ' and + ;; `.' in text. + (dirspacing (- 29 (length dirtitle))) + (menu (org-texinfo-make-menu info 'main)) + (detail-menu (org-texinfo-make-menu info 'detailed))) + (concat + ;; Header + header "\n" + "@c %**start of header\n" + ;; Filename and Title + "@setfilename " info-filename "\n" + "@settitle " title "\n" + ;; Coding system. + (format + "@documentencoding %s\n" + (catch 'coding-system + (let ((case-fold-search t) + (name (symbol-name (or org-texinfo-coding-system + buffer-file-coding-system)))) + (dolist (system org-texinfo-supported-coding-systems "UTF-8") + (when (org-string-match-p (regexp-quote system) name) + (throw 'coding-system system)))))) + "\n" + (format "@documentlanguage %s\n" lang) + "\n\n" + "@c Version and Contact Info\n" + "@set AUTHOR " author "\n" + + ;; Additional Header Options set by `#+TEXINFO_HEADER + (if texinfo-header + (concat "\n" + texinfo-header + "\n")) + + "@c %**end of header\n" + "@finalout\n" + "\n\n" + + ;; Additional Header Options set by #+TEXINFO_POST_HEADER + (if texinfo-post-header + (concat "\n" + texinfo-post-header + "\n")) + + ;; Copying + "@copying\n" + ;; Only export the content of the headline, do not need the + ;; initial headline. + (org-export-data (nth 2 copying) info) + "@end copying\n" + "\n\n" + + ;; Info directory information + ;; Only supply if both title and category are provided + (if (and dircat dirtitle) + (concat "@dircategory " dircat "\n" + "@direntry\n" + "* " dirtitle "." + (make-string dirspacing ?\s) + dirdesc "\n" + "@end direntry\n")) + "\n\n" + + ;; Title + "@titlepage\n" + "@title " title "\n\n" + (if subtitle + (concat "@subtitle " subtitle "\n")) + "@author " author "\n" + (if subauthor + (concat subauthor "\n")) + "\n" + "@c The following two commands start the copyright page.\n" + "@page\n" + "@vskip 0pt plus 1filll\n" + "@insertcopying\n" + "@end titlepage\n\n" + "@c Output the table of contents at the beginning.\n" + "@contents\n\n" + + ;; Configure Top Node when not for Tex + "@ifnottex\n" + "@node Top\n" + "@top " title " Manual\n" + "@insertcopying\n" + "@end ifnottex\n\n" + + ;; Do not output menus if they are empty + (if menu + ;; Menu + (concat "@menu\n" + menu + "\n\n" + ;; Detailed Menu + (if detail-menu + (concat "@detailmenu\n" + " --- The Detailed Node Listing ---\n" + detail-menu + "\n\n" + "@end detailmenu\n")) + "@end menu\n")) + "\n\n" + + ;; Document's body. + contents + "\n" + ;; Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "@c %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; Document end. + "\n@bye"))) + + + +;;; Transcode Functions + +;;; Bold + +(defun org-texinfo-bold (bold contents info) + "Transcode BOLD from Org to Texinfo. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-texinfo--text-markup contents 'bold)) + +;;; Center Block + +(defun org-texinfo-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) + +;;; Clock + +(defun org-texinfo-clock (clock contents info) + "Transcode a CLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "@noindent" + (format "@strong{%s} " org-clock-string) + (format org-texinfo-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + "@*")) + +;;; Code + +(defun org-texinfo-code (code contents info) + "Transcode a CODE object from Org to Texinfo. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-texinfo--text-markup (org-element-property :value code) 'code)) + +;;; Comment + +(defun org-texinfo-comment (comment contents info) + "Transcode a COMMENT object from Org to Texinfo. +CONTENTS is the text in the comment. INFO is a plist holding +contextual information." + (org-texinfo--text-markup (org-element-property :value comment) 'comment)) + +;;; Comment Block + +(defun org-texinfo-comment-block (comment-block contents info) + "Transcode a COMMENT-BLOCK object from Org to Texinfo. +CONTENTS is the text within the block. INFO is a plist holding +contextual information." + (format "@ignore\n%s@end ignore" (org-element-property :value comment-block))) + +;;; Drawer + +(defun org-texinfo-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-texinfo-format-drawer-function + name contents))) + output)) + +;;; Dynamic Block + +(defun org-texinfo-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + +;;; Entity + +(defun org-texinfo-entity (entity contents info) + "Transcode an ENTITY object from Org to Texinfo. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent))) + +;;; Example Block + +(defun org-texinfo-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "@verbatim\n%s@end verbatim" + (org-export-format-code-default example-block info))) + +;;; Export Block + +(defun org-texinfo-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "TEXINFO") + (org-remove-indentation (org-element-property :value export-block)))) + +;;; Export Snippet + +(defun org-texinfo-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'texinfo) + (org-element-property :value export-snippet))) + +;;; Fixed Width + +(defun org-texinfo-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "@example\n%s\n@end example" + (org-remove-indentation + (org-texinfo--sanitize-content + (org-element-property :value fixed-width))))) + +;;; Footnote Reference +;; + +(defun org-texinfo-footnote-reference (footnote contents info) + "Create a footnote reference for FOOTNOTE. + +FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a +plist holding contextual information." + (let ((def (org-export-get-footnote-definition footnote info))) + (format "@footnote{%s}" + (org-trim (org-export-data def info))))) + +;;; Headline + +(defun org-texinfo-headline (headline contents info) + "Transcode a HEADLINE element from Org to Texinfo. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((class (plist-get info :texinfo-class)) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + (class-sectioning (assoc class org-texinfo-classes)) + ;; Find the index type, if any + (index (org-element-property :INDEX headline)) + ;; Check if it is an appendix + (appendix (org-element-property :APPENDIX headline)) + ;; Retrieve headline text + (text (org-texinfo--sanitize-headline + (org-element-property :title headline) info)) + ;; Create node info, to insert it before section formatting. + ;; Use custom menu title if present + (node (format "@node %s\n" (org-texinfo--get-node headline info))) + ;; Menus must be generated with first child, otherwise they + ;; will not nest properly + (menu (let* ((first (org-export-first-sibling-p headline info)) + (parent (org-export-get-parent-headline headline)) + (title (org-texinfo--sanitize-headline + (org-element-property :title parent) info)) + heading listing + (tree (plist-get info :parse-tree))) + (if first + (org-element-map (plist-get info :parse-tree) 'headline + (lambda (ref) + (if (member title (org-element-property :title ref)) + (push ref heading))) + info t)) + (setq listing (org-texinfo--build-menu + (car heading) level info)) + (if listing + (setq listing (replace-regexp-in-string + "%" "%%" listing) + listing (format + "\n@menu\n%s\n@end menu\n\n" listing)) + 'nil))) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (let ((sec (if (and (symbolp (nth 2 class-sectioning)) + (fboundp (nth 2 class-sectioning))) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. + ((stringp sec) sec) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (cond + ;;If an index, always unnumbered + (index + (concat menu node (cdr sec) "\n%s")) + (appendix + (concat menu node (replace-regexp-in-string + "unnumbered" + "appendix" + (cdr sec)) "\n%s")) + ;; Otherwise number as needed. + (t + (concat menu node + (funcall + (if numberedp #'car #'cdr) sec) "\n%s"))))))) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + ;; Create the headline text along with a no-tag version. The + ;; latter is required to remove tags from table of contents. + (full-text (org-texinfo--sanitize-content + (if (not (eq org-texinfo-format-headline-function 'ignore)) + ;; User-defined formatting function. + (funcall org-texinfo-format-headline-function + todo todo-type priority text tags) + ;; Default formatting. + (concat + (when todo + (format "@strong{%s} " todo)) + (when priority (format "@emph{#%s} " priority)) + text + (when tags + (format " :%s:" + (mapconcat 'identity tags ":"))))))) + (full-text-no-tag + (org-texinfo--sanitize-content + (if (not (eq org-texinfo-format-headline-function 'ignore)) + ;; User-defined formatting function. + (funcall org-texinfo-format-headline-function + todo todo-type priority text nil) + ;; Default formatting. + (concat + (when todo (format "@strong{%s} " todo)) + (when priority (format "@emph{#%c} " priority)) + text)))) + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + ;; Case 2: This is the `copying' section: ignore it + ;; This is used elsewhere. + ((org-element-property :COPYING headline) nil) + ;; Case 3: An index. If it matches one of the known indexes, + ;; print it as such following the contents, otherwise + ;; print the contents and leave the index up to the user. + (index + (format + section-fmt full-text + (concat pre-blanks contents "\n" + (if (member index '("cp" "fn" "ky" "pg" "tp" "vr")) + (concat "@printindex " index))))) + ;; Case 4: This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((or (not section-fmt) (org-export-low-level-p headline info)) + ;; Build the real contents of the sub-tree. + (let ((low-level-body + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "@%s\n" (if numberedp 'enumerate 'itemize))) + ;; Itemize headline + "@item\n" full-text "\n" pre-blanks contents))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n@end %s" (if numberedp 'enumerate 'itemize)) + low-level-body)))) + ;; Case 5: Standard headline. Export it as a section. + (t + (cond + ((not (and tags (eq (plist-get info :with-tags) 'not-in-toc))) + ;; Regular section. Use specified format string. + (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text + (concat pre-blanks contents))) + ((string-match "\\`@\\(.*?\\){" section-fmt) + ;; If tags should be removed from table of contents, insert + ;; title without tags as an alternative heading in sectioning + ;; command. + (format (replace-match (concat (match-string 1 section-fmt) "[%s]") + nil nil section-fmt 1) + ;; Replace square brackets with parenthesis since + ;; square brackets are not supported in optional + ;; arguments. + (replace-regexp-in-string + "\\[" "(" + (replace-regexp-in-string + "\\]" ")" + full-text-no-tag)) + full-text + (concat pre-blanks contents))) + (t + ;; Impossible to add an alternative heading. Fallback to + ;; regular sectioning format string. + (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text + (concat pre-blanks contents)))))))) + +;;; Inline Src Block + +(defun org-texinfo-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block)) + (separator (org-texinfo--find-verb-separator code))) + (concat "@verb{" separator code separator "}"))) + +;;; Inlinetask + +(defun org-texinfo-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-texinfo-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (not (eq org-texinfo-format-inlinetask-function 'ignore)) + (funcall org-texinfo-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (let ((full-title + (concat + (when todo (format "@strong{%s} " todo)) + (when priority (format "#%c " priority)) + title + (when tags (format ":%s:" + (mapconcat 'identity tags ":")))))) + (format (concat "@center %s\n\n" + "%s" + "\n") + full-title contents))))) + +;;; Italic + +(defun org-texinfo-italic (italic contents info) + "Transcode ITALIC from Org to Texinfo. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-texinfo--text-markup contents 'italic)) + +;;; Item + +(defun org-texinfo-item (item contents info) + "Transcode an ITEM element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((tag (org-element-property :tag item)) + (desc (org-export-data tag info))) + (concat "\n@item " (if tag desc) "\n" + (and contents (org-trim contents)) "\n"))) + +;;; Keyword + +(defun org-texinfo-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "TEXINFO") value) + ((string= key "CINDEX") (format "@cindex %s" value)) + ((string= key "FINDEX") (format "@findex %s" value)) + ((string= key "KINDEX") (format "@kindex %s" value)) + ((string= key "PINDEX") (format "@pindex %s" value)) + ((string= key "TINDEX") (format "@tindex %s" value)) + ((string= key "VINDEX") (format "@vindex %s" value))))) + +;;; Line Break + +(defun org-texinfo-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + "@*\n") + +;;; Link + +(defun org-texinfo-link (link desc info) + "Transcode a LINK object from Org to Texinfo. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (path (cond + ((member type '("http" "https" "ftp")) + (concat type ":" raw-path)) + ((string= type "file") + (if (file-name-absolute-p raw-path) + (concat "file://" (expand-file-name raw-path)) + (concat "file://" raw-path))) + (t raw-path))) + (email (if (string= type "mailto") + (let ((text (replace-regexp-in-string + "@" "@@" raw-path))) + (concat text (if desc (concat "," desc)))))) + protocol) + (cond + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "id")) + (let ((destination (org-export-resolve-id-link link info))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "@uref{file://%s,%s}" destination desc) + (format "@uref{file://%s}" destination))) + ;; LINK points to a headline. Use the headline as the NODE target + (headline + (format "@ref{%s,%s}" + (org-texinfo--get-node destination info) + (or desc ""))) + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "@ref{%s}" path) + (format "@ref{%s,,%s}" path desc))))))) + ((member type '("info")) + (let* ((info-path (split-string path "[:#]")) + (info-manual (car info-path)) + (info-node (or (cadr info-path) "top")) + (title (or desc ""))) + (format "@ref{%s,%s,,%s,}" info-node title info-manual))) + ((member type '("fuzzy")) + (let ((destination (org-export-resolve-fuzzy-link link info))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "@uref{file://%s,%s}" destination desc) + (format "@uref{file://%s}" destination))) + ;; LINK points to a headline. Use the headline as the NODE target + (headline + (format "@ref{%s,%s}" + (org-texinfo--get-node destination info) + (or desc ""))) + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "@ref{%s}" path) + (format "@ref{%s,,%s}" path desc))))))) + ;; Special case for email addresses + (email + (format "@email{%s}" email)) + ;; External link with a description part. + ((and path desc) (format "@uref{%s,%s}" path desc)) + ;; External link without a description part. + (path (format "@uref{%s}" path)) + ;; No path, only description. Try to do something useful. + (t (format org-texinfo-link-with-unknown-path-format desc))))) + + +;;; Menu + +(defun org-texinfo-make-menu (info level) + "Create the menu for inclusion in the texifo document. + +INFO is the parsed buffer that contains the headlines. LEVEL +determines whether to make the main menu, or the detailed menu. + +This is only used for generating the primary menu. In-Node menus +are generated directly." + (let ((parse (plist-get info :parse-tree))) + (cond + ;; Generate the main menu + ((eq level 'main) (org-texinfo--build-menu parse 1 info)) + ;; Generate the detailed (recursive) menu + ((eq level 'detailed) + ;; Requires recursion + ;;(org-texinfo--build-detailed-menu parse top info) + (org-texinfo--build-menu parse 1 info 'detailed))))) + +;;; Paragraph + +(defun org-texinfo-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Texinfo. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + contents) + +;;; Plain List + +(defun org-texinfo-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Texinfo. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) + (indic (or (plist-get attr :indic) + org-texinfo-def-table-markup)) + (type (org-element-property :type plain-list)) + (table-type (plist-get attr :table-type)) + ;; Ensure valid texinfo table type. + (table-type (if (member table-type '("ftable" "vtable")) table-type + "table")) + (list-type (cond + ((eq type 'ordered) "enumerate") + ((eq type 'unordered) "itemize") + ((eq type 'descriptive) table-type)))) + (format "@%s%s\n@end %s" + (if (eq type 'descriptive) + (concat list-type " " indic) + list-type) + contents + list-type))) + +;;; Plain Text + +(defun org-texinfo-plain-text (text info) + "Transcode a TEXT string from Org to Texinfo. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + ;; First protect @, { and }. + (let ((output (org-texinfo--sanitize-content text))) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output + (org-export-activate-smart-quotes output :texinfo info text))) + ;; LaTeX into @LaTeX{} and TeX into @TeX{} + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\(\\(?:La\\)?TeX\\)" output start) + (setq output (replace-match + (format "@%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (while (string-match (regexp-quote "...") output) + (setq output (replace-match "@dots{}" nil t output)))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output))) + ;; Return value. + output)) + +;;; Planning + +(defun org-texinfo-planning (planning contents info) + "Transcode a PLANNING element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "@noindent" + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "@strong{%s} " org-closed-string) + (format org-texinfo-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "@strong{%s} " org-deadline-string) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "@strong{%s} " org-scheduled-string) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) + " ") + "@*")) + +;;; Property Drawer + +(defun org-texinfo-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;; Quote Block + +(defun org-texinfo-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((title (org-element-property :name quote-block)) + (start-quote (concat "@quotation" + (if title + (format " %s" title))))) + (format "%s\n%s@end quotation" start-quote contents))) + +;;; Quote Section + +(defun org-texinfo-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "@verbatim\n%s@end verbatim" value)))) + +;;; Radio Target + +(defun org-texinfo-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Texinfo. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "@anchor{%s}%s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + +;;; Section + +(defun org-texinfo-section (section contents info) + "Transcode a SECTION element from Org to Texinfo. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + +;;; Special Block + +(defun org-texinfo-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) + +;;; Src Block + +(defun org-texinfo-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (lisp-p (string-match-p "lisp" lang)) + (src-contents (org-texinfo--sanitize-content + (org-export-format-code-default src-block info)))) + (cond + ;; Case 1. Lisp Block + (lisp-p + (format "@lisp\n%s@end lisp" + src-contents)) + ;; Case 2. Other blocks + (t + (format "@example\n%s@end example" + src-contents))))) + +;;; Statistics Cookie + +(defun org-texinfo-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + +;;; Subscript + +(defun org-texinfo-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Texinfo. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "@math{_%s}" contents)) + +;;; Superscript + +(defun org-texinfo-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Texinfo. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "@math{^%s}" contents)) + +;;; Table +;; +;; `org-texinfo-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" attribute. Otherwise, it +;; delegates the job to either `org-texinfo-table--table.el-table' or +;; `org-texinfo-table--org-table' functions, depending of the type of +;; the table. +;; +;; `org-texinfo-table--align-string' is a subroutine used to build +;; alignment string for Org tables. + +(defun org-texinfo-table (table contents info) + "Transcode a TABLE element from Org to Texinfo. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (cond + ;; Case 1: verbatim table. + ((or org-texinfo-tables-verbatim + (let ((attr (mapconcat 'identity + (org-element-property :attr_latex table) + " "))) + (and attr (string-match "\\" attr)))) + (format "@verbatim \n%s\n@end verbatim" + ;; Re-create table, without affiliated keywords. + (org-trim + (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: table.el table. Convert it using appropriate tools. + ((eq (org-element-property :type table) 'table.el) + (org-texinfo-table--table.el-table table contents info)) + ;; Case 3: Standard table. + (t (org-texinfo-table--org-table table contents info)))) + +(defun org-texinfo-table-column-widths (table info) + "Determine the largest table cell in each column to process alignment. + +TABLE is the table element to transcode. INFO is a plist used as +a communication channel." + (let* ((rows (org-element-map table 'table-row 'identity info)) + (collected (loop for row in rows collect + (org-element-map row 'table-cell 'identity info))) + (number-cells (length (car collected))) + cells counts) + (loop for row in collected do + (push (mapcar (lambda (ref) + (let* ((start (org-element-property :contents-begin ref)) + (end (org-element-property :contents-end ref)) + (length (- end start))) + length)) row) cells)) + (setq cells (org-remove-if 'null cells)) + (push (loop for count from 0 to (- number-cells 1) collect + (loop for item in cells collect + (nth count item))) counts) + (mapconcat (lambda (size) + (make-string size ?a)) (mapcar (lambda (ref) + (apply 'max `(,@ref))) (car counts)) + "} {"))) + +(defun org-texinfo-table--org-table (table contents info) + "Return appropriate Texinfo code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' attribute." + (let* ((attr (org-export-read-attribute :attr_texinfo table)) + (col-width (plist-get attr :columns)) + (columns (if col-width + (format "@columnfractions %s" + col-width) + (format "{%s}" + (org-texinfo-table-column-widths + table info))))) + ;; Prepare the final format string for the table. + (cond + ;; Longtable. + ;; Others. + (t (concat + (format "@multitable %s\n%s@end multitable" + columns + contents)))))) + +(defun org-texinfo-table--table.el-table (table contents info) + "Returns nothing. + +Rather than return an invalid table, nothing is returned." + 'nil) + +;;; Table Cell + +(defun org-texinfo-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Texinfo. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-texinfo-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-texinfo-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents) + (when (org-export-get-next-element table-cell info) "\n@tab "))) + +;;; Table Row + +(defun org-texinfo-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Texinfo. +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let ((rowgroup-tag + (cond + ;; Case 1: Belongs to second or subsequent rowgroup. + ((not (= 1 (org-export-table-row-group table-row info))) + "@item ") + ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ((org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + "@headitem ") + ;; Case 3: Row is from first and only row group. + (t "@item ")))) + (when (eq (org-element-property :type table-row) 'standard) + (concat rowgroup-tag contents "\n"))))) + +;;; Target + +(defun org-texinfo-target (target contents info) + "Transcode a TARGET object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "@anchor{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + +;;; Timestamp + +(defun org-texinfo-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-texinfo-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format org-texinfo-active-timestamp-format value)) + ((inactive inactive-range) + (format org-texinfo-inactive-timestamp-format value)) + (t (format org-texinfo-diary-timestamp-format value))))) + +;;; Verbatim + +(defun org-texinfo-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Texinfo. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim)) + +;;; Verse Block + +(defun org-texinfo-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Texinfo. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; In a verse environment, add a line break to each newline + ;; character and change each white space at beginning of a line + ;; into a space of 1 em. Also change each blank line with + ;; a vertical space of 1 em. + (progn + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" "\\\\vspace*{1em}" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) + (while (string-match "^[ \t]+" contents) + (let ((new-str (format "\\hspace*{%dem}" + (length (match-string 0 contents))))) + (setq contents (replace-match new-str nil t contents)))) + (format "\\begin{verse}\n%s\\end{verse}" contents))) + + +;;; Interactive functions + +(defun org-texinfo-export-to-texinfo + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a Texinfo file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist))) + +(defun org-texinfo-export-to-info + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to Texinfo then process through to INFO. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return INFO file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-texinfo-compile file))))) + +;;;###autoload +(defun org-texinfo-publish-to-texinfo (plist filename pub-dir) + "Publish an org file to Texinfo. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'texinfo filename ".texi" plist pub-dir)) + +;;;###autoload +(defun org-texinfo-convert-region-to-texinfo () + "Assume the current region has org-mode syntax, and convert it to Texinfo. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an Texinfo buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'texinfo)) + +(defun org-texinfo-compile (file) + "Compile a texinfo file. + +FILE is the name of the file being compiled. Processing is +done through the command specified in `org-texinfo-info-process'. + +Return INFO file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p file) + (file-name-directory full-name) + default-directory)) + errors) + (message (format "Processing Texinfo file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-texinfo-info-process) + (funcall org-texinfo-info-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org INFO Texinfo Output*" buffer. + ((consp org-texinfo-info-process) + (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-texinfo-info-process) + ;; Collect standard errors from output buffer. + (setq errors (org-texinfo-collect-errors outbuf)))) + (t (error "No valid command to process to Info"))) + (let ((infofile (concat out-dir base-name ".info"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p infofile)) + (error (concat (format "INFO file %s wasn't produced" infofile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-texinfo-remove-logfiles + (dolist (ext org-texinfo-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + infofile)))) + +(defun org-texinfo-collect-errors (buffer) + "Collect some kind of errors from \"makeinfo\" command output. + +BUFFER is the buffer containing output. + +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + ;; Find final "makeinfo" run. + (when t + (let ((case-fold-search t) + (errors "")) + (when (save-excursion + (re-search-forward "perhaps incorrect sectioning?" nil t)) + (setq errors (concat errors " [incorrect sectioning]"))) + (when (save-excursion + (re-search-forward "missing close brace" nil t)) + (setq errors (concat errors " [syntax error]"))) + (when (save-excursion + (re-search-forward "Unknown command" nil t)) + (setq errors (concat errors " [undefined @command]"))) + (when (save-excursion + (re-search-forward "No matching @end" nil t)) + (setq errors (concat errors " [block incomplete]"))) + (when (save-excursion + (re-search-forward "requires a sectioning" nil t)) + (setq errors (concat errors " [invalid section command]"))) + (when (save-excursion + (re-search-forward "\\[unexpected\]" nil t)) + (setq errors (concat errors " [unexpected error]"))) + (when (save-excursion + (re-search-forward "misplaced " nil t)) + (setq errors (concat errors " [syntax error]"))) + (and (org-string-nw-p errors) (org-trim errors))))))) + + +(provide 'ox-texinfo) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-texinfo.el ends here diff --git a/lisp/org/ox.el b/lisp/org/ox.el new file mode 100644 index 00000000000..0102523b5c7 --- /dev/null +++ b/lisp/org/ox.el @@ -0,0 +1,6218 @@ +;;; ox.el --- Generic Export Engine for Org Mode + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements a generic export engine for Org, built on +;; its syntactical parser: Org Elements. +;; +;; Besides that parser, the generic exporter is made of three distinct +;; parts: +;; +;; - The communication channel consists in a property list, which is +;; created and updated during the process. Its use is to offer +;; every piece of information, would it be about initial environment +;; or contextual data, all in a single place. The exhaustive list +;; of properties is given in "The Communication Channel" section of +;; this file. +;; +;; - The transcoder walks the parse tree, ignores or treat as plain +;; text elements and objects according to export options, and +;; eventually calls back-end specific functions to do the real +;; transcoding, concatenating their return value along the way. +;; +;; - The filter system is activated at the very beginning and the very +;; end of the export process, and each time an element or an object +;; has been converted. It is the entry point to fine-tune standard +;; output from back-end transcoders. See "The Filter System" +;; section for more information. +;; +;; The core function is `org-export-as'. It returns the transcoded +;; buffer as a string. +;; +;; An export back-end is defined with `org-export-define-backend'. +;; This function can also support specific buffer keywords, OPTION +;; keyword's items and filters. Refer to function's documentation for +;; more information. +;; +;; If the new back-end shares most properties with another one, +;; `org-export-define-derived-backend' can be used to simplify the +;; process. +;; +;; Any back-end can define its own variables. Among them, those +;; customizable should belong to the `org-export-BACKEND' group. +;; +;; Tools for common tasks across back-ends are implemented in the +;; following part of the file. +;; +;; Then, a wrapper macro for asynchronous export, +;; `org-export-async-start', along with tools to display results. are +;; given in the penultimate part. +;; +;; Eventually, a dispatcher (`org-export-dispatch') for standard +;; back-ends is provided in the last one. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org-element) +(require 'org-macro) +(require 'ob-exp) + +(declare-function org-publish "ox-publish" (project &optional force async)) +(declare-function org-publish-all "ox-publish" (&optional force async)) +(declare-function + org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" + (&optional force async)) + +(defvar org-publish-project-alist) +(defvar org-table-number-fraction) +(defvar org-table-number-regexp) + + + +;;; Internal Variables +;; +;; Among internal variables, the most important is +;; `org-export-options-alist'. This variable define the global export +;; options, shared between every exporter, and how they are acquired. + +(defconst org-export-max-depth 19 + "Maximum nesting depth for headlines, counting from 0.") + +(defconst org-export-options-alist + '((:author "AUTHOR" nil user-full-name t) + (:creator "CREATOR" nil org-export-creator-string) + (:date "DATE" nil nil t) + (:description "DESCRIPTION" nil nil newline) + (:email "EMAIL" nil user-mail-address t) + (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split) + (:headline-levels nil "H" org-export-headline-levels) + (:keywords "KEYWORDS" nil nil space) + (:language "LANGUAGE" nil org-export-default-language t) + (:preserve-breaks nil "\\n" org-export-preserve-breaks) + (:section-numbers nil "num" org-export-with-section-numbers) + (:select-tags "SELECT_TAGS" nil org-export-select-tags split) + (:time-stamp-file nil "timestamp" org-export-time-stamp-file) + (:title "TITLE" nil nil space) + (:with-archived-trees nil "arch" org-export-with-archived-trees) + (:with-author nil "author" org-export-with-author) + (:with-clocks nil "c" org-export-with-clocks) + (:with-creator nil "creator" org-export-with-creator) + (:with-date nil "date" org-export-with-date) + (:with-drawers nil "d" org-export-with-drawers) + (:with-email nil "email" org-export-with-email) + (:with-emphasize nil "*" org-export-with-emphasize) + (:with-entities nil "e" org-export-with-entities) + (:with-fixed-width nil ":" org-export-with-fixed-width) + (:with-footnotes nil "f" org-export-with-footnotes) + (:with-inlinetasks nil "inline" org-export-with-inlinetasks) + (:with-latex nil "tex" org-export-with-latex) + (:with-planning nil "p" org-export-with-planning) + (:with-priority nil "pri" org-export-with-priority) + (:with-smart-quotes nil "'" org-export-with-smart-quotes) + (:with-special-strings nil "-" org-export-with-special-strings) + (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies) + (:with-sub-superscript nil "^" org-export-with-sub-superscripts) + (:with-toc nil "toc" org-export-with-toc) + (:with-tables nil "|" org-export-with-tables) + (:with-tags nil "tags" org-export-with-tags) + (:with-tasks nil "tasks" org-export-with-tasks) + (:with-timestamps nil "<" org-export-with-timestamps) + (:with-todo-keywords nil "todo" org-export-with-todo-keywords)) + "Alist between export properties and ways to set them. + +The CAR of the alist is the property name, and the CDR is a list +like (KEYWORD OPTION DEFAULT BEHAVIOR) where: + +KEYWORD is a string representing a buffer keyword, or nil. Each + property defined this way can also be set, during subtree + export, through a headline property named after the keyword + with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE + property). +OPTION is a string that could be found in an #+OPTIONS: line. +DEFAULT is the default value for the property. +BEHAVIOR determines how Org should handle multiple keywords for + the same property. It is a symbol among: + nil Keep old value and discard the new one. + t Replace old value with the new one. + `space' Concatenate the values, separating them with a space. + `newline' Concatenate the values, separating them with + a newline. + `split' Split values at white spaces, and cons them to the + previous list. + +Values set through KEYWORD and OPTION have precedence over +DEFAULT. + +All these properties should be back-end agnostic. Back-end +specific properties are set through `org-export-define-backend'. +Properties redefined there have precedence over these.") + +(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS") + "List of in-buffer keywords that require special treatment. +These keywords are not directly associated to a property. The +way they are handled must be hard-coded into +`org-export--get-inbuffer-options' function.") + +(defconst org-export-filters-alist + '((:filter-bold . org-export-filter-bold-functions) + (:filter-babel-call . org-export-filter-babel-call-functions) + (:filter-center-block . org-export-filter-center-block-functions) + (:filter-clock . org-export-filter-clock-functions) + (:filter-code . org-export-filter-code-functions) + (:filter-comment . org-export-filter-comment-functions) + (:filter-comment-block . org-export-filter-comment-block-functions) + (:filter-diary-sexp . org-export-filter-diary-sexp-functions) + (:filter-drawer . org-export-filter-drawer-functions) + (:filter-dynamic-block . org-export-filter-dynamic-block-functions) + (:filter-entity . org-export-filter-entity-functions) + (:filter-example-block . org-export-filter-example-block-functions) + (:filter-export-block . org-export-filter-export-block-functions) + (:filter-export-snippet . org-export-filter-export-snippet-functions) + (:filter-final-output . org-export-filter-final-output-functions) + (:filter-fixed-width . org-export-filter-fixed-width-functions) + (:filter-footnote-definition . org-export-filter-footnote-definition-functions) + (:filter-footnote-reference . org-export-filter-footnote-reference-functions) + (:filter-headline . org-export-filter-headline-functions) + (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) + (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) + (:filter-inline-src-block . org-export-filter-inline-src-block-functions) + (:filter-inlinetask . org-export-filter-inlinetask-functions) + (:filter-italic . org-export-filter-italic-functions) + (:filter-item . org-export-filter-item-functions) + (:filter-keyword . org-export-filter-keyword-functions) + (:filter-latex-environment . org-export-filter-latex-environment-functions) + (:filter-latex-fragment . org-export-filter-latex-fragment-functions) + (:filter-line-break . org-export-filter-line-break-functions) + (:filter-link . org-export-filter-link-functions) + (:filter-node-property . org-export-filter-node-property-functions) + (:filter-options . org-export-filter-options-functions) + (:filter-paragraph . org-export-filter-paragraph-functions) + (:filter-parse-tree . org-export-filter-parse-tree-functions) + (:filter-plain-list . org-export-filter-plain-list-functions) + (:filter-plain-text . org-export-filter-plain-text-functions) + (:filter-planning . org-export-filter-planning-functions) + (:filter-property-drawer . org-export-filter-property-drawer-functions) + (:filter-quote-block . org-export-filter-quote-block-functions) + (:filter-quote-section . org-export-filter-quote-section-functions) + (:filter-radio-target . org-export-filter-radio-target-functions) + (:filter-section . org-export-filter-section-functions) + (:filter-special-block . org-export-filter-special-block-functions) + (:filter-src-block . org-export-filter-src-block-functions) + (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions) + (:filter-strike-through . org-export-filter-strike-through-functions) + (:filter-subscript . org-export-filter-subscript-functions) + (:filter-superscript . org-export-filter-superscript-functions) + (:filter-table . org-export-filter-table-functions) + (:filter-table-cell . org-export-filter-table-cell-functions) + (:filter-table-row . org-export-filter-table-row-functions) + (:filter-target . org-export-filter-target-functions) + (:filter-timestamp . org-export-filter-timestamp-functions) + (:filter-underline . org-export-filter-underline-functions) + (:filter-verbatim . org-export-filter-verbatim-functions) + (:filter-verse-block . org-export-filter-verse-block-functions)) + "Alist between filters properties and initial values. + +The key of each association is a property name accessible through +the communication channel. Its value is a configurable global +variable defining initial filters. + +This list is meant to install user specified filters. Back-end +developers may install their own filters using +`org-export-define-backend'. Filters defined there will always +be prepended to the current list, so they always get applied +first.") + +(defconst org-export-default-inline-image-rule + `(("file" . + ,(format "\\.%s\\'" + (regexp-opt + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" + "xpm" "pbm" "pgm" "ppm") t)))) + "Default rule for link matching an inline image. +This rule applies to links with no description. By default, it +will be considered as an inline image if it targets a local file +whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", +\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\". +See `org-export-inline-image-p' for more information about +rules.") + +(defvar org-export-async-debug nil + "Non-nil means asynchronous export process should leave data behind. + +This data is found in the appropriate \"*Org Export Process*\" +buffer, and in files prefixed with \"org-export-process\" and +located in `temporary-file-directory'. + +When non-nil, it will also set `debug-on-error' to a non-nil +value in the external process.") + +(defvar org-export-stack-contents nil + "Record asynchronously generated export results and processes. +This is an alist: its CAR is the source of the +result (destination file or buffer for a finished process, +original buffer for a running one) and its CDR is a list +containing the back-end used, as a symbol, and either a process +or the time at which it finished. It is used to build the menu +from `org-export-stack'.") + +(defvar org-export--registered-backends nil + "List of backends currently available in the exporter. +This variable is set with `org-export-define-backend' and +`org-export-define-derived-backend' functions.") + +(defvar org-export-dispatch-last-action nil + "Last command called from the dispatcher. +The value should be a list. Its CAR is the action, as a symbol, +and its CDR is a list of export options.") + +(defvar org-export-dispatch-last-position (make-marker) + "The position where the last export command was created using the dispatcher. +This marker will be used with `C-u C-c C-e' to make sure export repetition +uses the same subtree if the previous command was restricted to a subtree.") + +;; For compatibility with Org < 8 +(defvar org-export-current-backend nil + "Name, if any, of the back-end used during an export process. + +Its value is a symbol such as `html', `latex', `ascii', or nil if +the back-end is anonymous (see `org-export-create-backend') or if +there is no export process in progress. + +It can be used to teach Babel blocks how to act differently +according to the back-end used.") + + +;;; User-configurable Variables +;; +;; Configuration for the masses. +;; +;; They should never be accessed directly, as their value is to be +;; stored in a property list (cf. `org-export-options-alist'). +;; Back-ends will read their value from there instead. + +(defgroup org-export nil + "Options for exporting Org mode files." + :tag "Org Export" + :group 'org) + +(defgroup org-export-general nil + "General options for export engine." + :tag "Org Export General" + :group 'org-export) + +(defcustom org-export-with-archived-trees 'headline + "Whether sub-trees with the ARCHIVE tag should be exported. + +This can have three different values: +nil Do not export, pretend this tree is not present. +t Do export the entire tree. +`headline' Only export the headline, but skip the tree below it. + +This option can also be set with the OPTIONS keyword, +e.g. \"arch:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Not at all" nil) + (const :tag "Headline only" headline) + (const :tag "Entirely" t))) + +(defcustom org-export-with-author t + "Non-nil means insert author name into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"author:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-clocks nil + "Non-nil means export CLOCK keywords. +This option can also be set with the OPTIONS keyword, +e.g. \"c:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-creator 'comment + "Non-nil means the postamble should contain a creator sentence. + +The sentence can be set in `org-export-creator-string' and +defaults to \"Generated by Org mode XX in Emacs XXX.\". + +If the value is `comment' insert it as a comment." + :group 'org-export-general + :type '(choice + (const :tag "No creator sentence" nil) + (const :tag "Sentence as a comment" comment) + (const :tag "Insert the sentence" t))) + +(defcustom org-export-with-date t + "Non-nil means insert date in the exported document. +This option can also be set with the OPTIONS keyword, +e.g. \"date:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-date-timestamp-format nil + "Time-stamp format string to use for DATE keyword. + +The format string, when specified, only applies if date consists +in a single time-stamp. Otherwise its value will be ignored. + +See `format-time-string' for details on how to build this +string." + :group 'org-export-general + :type '(choice + (string :tag "Time-stamp format string") + (const :tag "No format string" nil))) + +(defcustom org-export-creator-string + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-general + :type '(string :tag "Creator string")) + +(defcustom org-export-with-drawers '(not "LOGBOOK") + "Non-nil means export contents of standard drawers. + +When t, all drawers are exported. This may also be a list of +drawer names to export. If that list starts with `not', only +drawers with such names will be ignored. + +This variable doesn't apply to properties drawers. + +This option can also be set with the OPTIONS keyword, +e.g. \"d:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "All drawers" t) + (const :tag "None" nil) + (repeat :tag "Selected drawers" + (string :tag "Drawer name")) + (list :tag "Ignored drawers" + (const :format "" not) + (repeat :tag "Specify names of drawers to ignore during export" + :inline t + (string :tag "Drawer name"))))) + +(defcustom org-export-with-email nil + "Non-nil means insert author email into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"email:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-emphasize t + "Non-nil means interpret *word*, /word/, _word_ and +word+. + +If the export target supports emphasizing text, the word will be +typeset in bold, italic, with an underline or strike-through, +respectively. + +This option can also be set with the OPTIONS keyword, +e.g. \"*:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-exclude-tags '("noexport") + "Tags that exclude a tree from export. + +All trees carrying any of these tags will be excluded from +export. This is without condition, so even subtrees inside that +carry one of the `org-export-select-tags' will be removed. + +This option can also be set with the EXCLUDE_TAGS keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-fixed-width t + "Non-nil means lines starting with \":\" will be in fixed width font. + +This can be used to have pre-formatted text, fragments of code +etc. For example: + : ;; Some Lisp examples + : (while (defc cnt) + : (ding)) +will be looking just like this in also HTML. See also the QUOTE +keyword. Not all export backends support this. + +This option can also be set with the OPTIONS keyword, +e.g. \"::nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-footnotes t + "Non-nil means Org footnotes should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"f:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-latex t + "Non-nil means process LaTeX environments and fragments. + +This option can also be set with the OPTIONS line, +e.g. \"tex:verbatim\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim. +t Allow export of math snippets." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Interpret math snippets" t) + (const :tag "Leave math verbatim" verbatim))) + +(defcustom org-export-headline-levels 3 + "The last level which is still exported as a headline. + +Inferior levels will usually produce itemize or enumerate lists +when exported, but back-end behaviour may differ. + +This option can also be set with the OPTIONS keyword, +e.g. \"H:2\"." + :group 'org-export-general + :type 'integer) + +(defcustom org-export-default-language "en" + "The default language for export and clocktable translations, as a string. +This may have an association in +`org-clock-clocktable-language-setup', +`org-export-smart-quotes-alist' and `org-export-dictionary'. +This option can also be set with the LANGUAGE keyword." + :group 'org-export-general + :type '(string :tag "Language")) + +(defcustom org-export-preserve-breaks nil + "Non-nil means preserve all line breaks when exporting. +This option can also be set with the OPTIONS keyword, +e.g. \"\\n:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-entities t + "Non-nil means interpret entities when exporting. + +For example, HTML export converts \\alpha to α and \\AA to +Å. + +For a list of supported names, see the constant `org-entities' +and the user option `org-entities-user'. + +This option can also be set with the OPTIONS keyword, +e.g. \"e:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-inlinetasks t + "Non-nil means inlinetasks should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"inline:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-planning nil + "Non-nil means include planning info in export. + +Planning info is the line containing either SCHEDULED:, +DEADLINE:, CLOSED: time-stamps, or a combination of them. + +This option can also be set with the OPTIONS keyword, +e.g. \"p:t\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-priority nil + "Non-nil means include priority cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"pri:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-section-numbers t + "Non-nil means add section numbers to headlines when exporting. + +When set to an integer n, numbering will only happen for +headlines whose relative level is higher or equal to n. + +This option can also be set with the OPTIONS keyword, +e.g. \"num:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-select-tags '("export") + "Tags that select a tree for export. + +If any such tag is found in a buffer, all trees that do not carry +one of these tags will be ignored during export. Inside trees +that are selected like this, you can still deselect a subtree by +tagging it with one of the `org-export-exclude-tags'. + +This option can also be set with the SELECT_TAGS keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-smart-quotes nil + "Non-nil means activate smart quotes during export. +This option can also be set with the OPTIONS keyword, +e.g., \"':t\". + +When setting this to non-nil, you need to take care of +using the correct Babel package when exporting to LaTeX. +E.g., you can load Babel for french like this: + +#+LATEX_HEADER: \\usepackage[french]{babel}" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-special-strings t + "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. + +When this option is turned on, these strings will be exported as: + + Org HTML LaTeX UTF-8 + -----+----------+--------+------- + \\- ­ \\- + -- – -- – + --- — --- — + ... … \\ldots … + +This option can also be set with the OPTIONS keyword, +e.g. \"-:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-statistics-cookies t + "Non-nil means include statistics cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"stat:nil\"" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. + +If you want to control how Org displays those characters, see +`org-use-sub-superscripts'. `org-export-with-sub-superscripts' +used to be an alias for `org-use-sub-superscripts' in Org <8.0, +it is not anymore. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts and see them exported correctly. + +You can also set the option with #+OPTIONS: ^:t + +Several characters after \"_\" or \"^\" will be considered as a +single item - so grouping with {} is normally not needed. For +example, the following things will be parsed as single sub- or +superscripts: + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Interpret them" t) + (const :tag "Curly brackets only" {}) + (const :tag "Do not interpret them" nil))) + +(defcustom org-export-with-toc t + "Non-nil means create a table of contents in exported files. + +The TOC contains headlines with levels up +to`org-export-headline-levels'. When an integer, include levels +up to N in the toc, this may then be different from +`org-export-headline-levels', but it will not be allowed to be +larger than the number of headline levels. When nil, no table of +contents is made. + +This option can also be set with the OPTIONS keyword, +e.g. \"toc:nil\" or \"toc:3\"." + :group 'org-export-general + :type '(choice + (const :tag "No Table of Contents" nil) + (const :tag "Full Table of Contents" t) + (integer :tag "TOC to level"))) + +(defcustom org-export-with-tables t + "If non-nil, lines starting with \"|\" define a table. +For example: + + | Name | Address | Birthday | + |-------------+----------+-----------| + | Arthur Dent | England | 29.2.2100 | + +This option can also be set with the OPTIONS keyword, +e.g. \"|:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-tags t + "If nil, do not export tags, just remove them from headlines. + +If this is the symbol `not-in-toc', tags will be removed from +table of contents entries, but still be shown in the headlines of +the document. + +This option can also be set with the OPTIONS keyword, +e.g. \"tags:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Off" nil) + (const :tag "Not in TOC" not-in-toc) + (const :tag "On" t))) + +(defcustom org-export-with-tasks t + "Non-nil means include TODO items for export. + +This may have the following values: +t include tasks independent of state. +`todo' include only tasks that are not yet done. +`done' include only tasks that are already done. +nil ignore all tasks. +list of keywords include tasks with these keywords. + +This option can also be set with the OPTIONS keyword, +e.g. \"tasks:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-export-time-stamp-file t + "Non-nil means insert a time stamp into the exported file. +The time stamp shows when the file was created. This option can +also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-timestamps t + "Non nil means allow timestamps in export. + +It can be set to any of the following values: + t export all timestamps. + `active' export active timestamps only. + `inactive' export inactive timestamps only. + nil do not export timestamps + +This only applies to timestamps isolated in a paragraph +containing only timestamps. Other timestamps are always +exported. + +This option can also be set with the OPTIONS keyword, e.g. +\"<:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-export-with-todo-keywords t + "Non-nil means include TODO keywords in export. +When nil, remove all these keywords from the export. This option +can also be set with the OPTIONS keyword, e.g. \"todo:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-allow-bind-keywords nil + "Non-nil means BIND keywords can define local variable values. +This is a potential security risk, which is why the default value +is nil. You can also allow them through local buffer variables." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-snippet-translation-alist nil + "Alist between export snippets back-ends and exporter back-ends. + +This variable allows to provide shortcuts for export snippets. + +For example, with a value of '\(\(\"h\" . \"html\"\)\), the +HTML back-end will recognize the contents of \"@@h:@@\" as +HTML code while every other back-end will ignore it." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons (string :tag "Shortcut") + (string :tag "Back-end")))) + +(defcustom org-export-coding-system nil + "Coding system for the exported file." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-export-copy-to-kill-ring 'if-interactive + "Should we push exported content to the kill ring?" + :group 'org-export-general + :version "24.3" + :type '(choice + (const :tag "Always" t) + (const :tag "When export is done interactively" if-interactive) + (const :tag "Never" nil))) + +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export-dispatch'. +This variable can be either set to `buffer' or `subtree'." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" buffer) + (const :tag "Export current subtree" subtree))) + +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is ever +shown, but remains buried. However, when exporting to +a temporary buffer, that buffer is popped up in a second window. +When this variable is nil, the buffer remains buried also in +these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-in-background nil + "Non-nil means export and publishing commands will run in background. +Results from an asynchronous export are never displayed +automatically. But you can retrieve them with \\[org-export-stack]." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-async-init-file user-init-file + "File used to initialize external export process. +Value must be an absolute file name. It defaults to user's +initialization file. Though, a specific configuration makes the +process faster and the export more portable." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(file :must-match t)) + +(defcustom org-export-dispatch-use-expert-ui nil + "Non-nil means using a non-intrusive `org-export-dispatch'. +In that case, no help buffer is displayed. Though, an indicator +for current export scope is added to the prompt (\"b\" when +output is restricted to body only, \"s\" when it is restricted to +the current subtree, \"v\" when only visible elements are +considered for export, \"f\" when publishing functions should be +passed the FORCE argument and \"a\" when the export should be +asynchronous). Also, \[?] allows to switch back to standard +mode." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Defining Back-ends +;; +;; An export back-end is a structure with `org-export-backend' type +;; and `name', `parent', `transcoders', `options', `filters', `blocks' +;; and `menu' slots. +;; +;; At the lowest level, a back-end is created with +;; `org-export-create-backend' function. +;; +;; A named back-end can be registered with +;; `org-export-register-backend' function. A registered back-end can +;; later be referred to by its name, with `org-export-get-backend' +;; function. Also, such a back-end can become the parent of a derived +;; back-end from which slot values will be inherited by default. +;; `org-export-derived-backend-p' can check if a given back-end is +;; derived from a list of back-end names. +;; +;; `org-export-get-all-transcoders', `org-export-get-all-options' and +;; `org-export-get-all-filters' return the full alist of transcoders, +;; options and filters, including those inherited from ancestors. +;; +;; At a higher level, `org-export-define-backend' is the standard way +;; to define an export back-end. If the new back-end is similar to +;; a registered back-end, `org-export-define-derived-backend' may be +;; used instead. +;; +;; Eventually `org-export-barf-if-invalid-backend' returns an error +;; when a given back-end hasn't been registered yet. + +(defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) + name parent transcoders options filters blocks menu) + +(defun org-export-get-backend (name) + "Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found." + (catch 'found + (dolist (b org-export--registered-backends) + (when (eq (org-export-backend-name b) name) + (throw 'found b))))) + +(defun org-export-register-backend (backend) + "Register BACKEND as a known export back-end. +BACKEND is a structure with `org-export-backend' type." + ;; Refuse to register an unnamed back-end. + (unless (org-export-backend-name backend) + (error "Cannot register a unnamed export back-end")) + ;; Refuse to register a back-end with an unknown parent. + (let ((parent (org-export-backend-parent backend))) + (when (and parent (not (org-export-get-backend parent))) + (error "Cannot use unknown \"%s\" back-end as a parent" parent))) + ;; Register dedicated export blocks in the parser. + (dolist (name (org-export-backend-blocks backend)) + (add-to-list 'org-element-block-name-alist + (cons name 'org-element-export-block-parser))) + ;; If a back-end with the same name as BACKEND is already + ;; registered, replace it with BACKEND. Otherwise, simply add + ;; BACKEND to the list of registered back-ends. + (let ((old (org-export-get-backend (org-export-backend-name backend)))) + (if old (setcar (memq old org-export--registered-backends) backend) + (push backend org-export--registered-backends)))) + +(defun org-export-barf-if-invalid-backend (backend) + "Signal an error if BACKEND isn't defined." + (unless (org-export-backend-p backend) + (error "Unknown \"%s\" back-end: Aborting export" backend))) + +(defun org-export-derived-backend-p (backend &rest backends) + "Non-nil if BACKEND is derived from one of BACKENDS. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BACKENDS is constituted of symbols." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (catch 'exit + (while (org-export-backend-parent backend) + (when (memq (org-export-backend-name backend) backends) + (throw 'exit t)) + (setq backend + (org-export-get-backend (org-export-backend-parent backend)))) + (memq (org-export-backend-name backend) backends)))) + +(defun org-export-get-all-transcoders (backend) + "Return full translation table for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are element or object types, as symbols, and values are +transcoders. + +Unlike to `org-export-backend-transcoders', this function +also returns transcoders inherited from parent back-ends, +if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((transcoders (org-export-backend-transcoders backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq transcoders + (append transcoders (org-export-backend-transcoders backend)))) + transcoders))) + +(defun org-export-get-all-options (backend) + "Return export options for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. See `org-export-options-alist' +for the shape of the return value. + +Unlike to `org-export-backend-options', this function also +returns options inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((options (org-export-backend-options backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq options (append options (org-export-backend-options backend)))) + options))) + +(defun org-export-get-all-filters (backend) + "Return complete list of filters for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are symbols and values lists of functions. + +Unlike to `org-export-backend-filters', this function also +returns filters inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((filters (org-export-backend-filters backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq filters (append filters (org-export-backend-filters backend)))) + filters))) + +(defun org-export-define-backend (backend transcoders &rest body) + "Define a new back-end BACKEND. + +TRANSCODERS is an alist between object or element types and +functions handling them. + +These functions should return a string without any trailing +space, or nil. They must accept three arguments: the object or +element itself, its contents or nil when it isn't recursive and +the property list used as a communication channel. + +Contents, when not nil, are stripped from any global indentation +\(although the relative one is preserved). They also always end +with a single newline character. + +If, for a given type, no function is found, that element or +object type will simply be ignored, along with any blank line or +white space at its end. The same will happen if the function +returns the nil value. If that function returns the empty +string, the type will be ignored, but the blank lines or white +spaces will be kept. + +In addition to element and object types, one function can be +associated to the `template' (or `inner-template') symbol and +another one to the `plain-text' symbol. + +The former returns the final transcoded string, and can be used +to add a preamble and a postamble to document's body. It must +accept two arguments: the transcoded string and the property list +containing export options. A function associated to `template' +will not be applied if export has option \"body-only\". +A function associated to `inner-template' is always applied. + +The latter, when defined, is to be called on every text not +recognized as an element or an object. It must accept two +arguments: the text string and the information channel. It is an +appropriate place to protect special chars relative to the +back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist between filters and function, or list of functions, + specific to the back-end. See `org-export-filters-alist' for + a list of all allowed filters. Filters defined here + shouldn't make a back-end test, as it may prevent back-ends + derived from this one to behave properly. + + :menu-entry + + Menu entry for the export dispatcher. It should be a list + like: + + '(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU) + + where : + + KEY is a free character selecting the back-end. + + DESCRIPTION-OR-ORDINAL is either a string or a number. + + If it is a string, is will be used to name the back-end in + its menu entry. If it is a number, the following menu will + be displayed as a sub-menu of the back-end with the same + KEY. Also, the number will be used to determine in which + order such sub-menus will appear (lowest first). + + ACTION-OR-MENU is either a function or an alist. + + If it is an action, it will be called with four + arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and + BODY-ONLY. See `org-export-as' for further explanations on + some of them. + + If it is an alist, associations should follow the + pattern: + + '(KEY DESCRIPTION ACTION) + + where KEY, DESCRIPTION and ACTION are described above. + + Valid values include: + + '(?m \"My Special Back-end\" my-special-export-function) + + or + + '(?l \"Export to LaTeX\" + \(?p \"As PDF file\" org-latex-export-to-pdf) + \(?o \"As PDF file and open\" + \(lambda (a s v b) + \(if a (org-latex-export-to-pdf t s v b) + \(org-open-file + \(org-latex-export-to-pdf nil s v b))))))) + + or the following, which will be added to the previous + sub-menu, + + '(?l 1 + \((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex) + \(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf))) + + :options-alist + + Alist between back-end specific properties introduced in + communication channel and how their value are acquired. See + `org-export-options-alist' for more information about + structure of the values." + (declare (indent 1)) + (let (blocks filters menu-entry options contents) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (t (pop body)))) + (org-export-register-backend + (org-export-create-backend :name backend + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) + +(defun org-export-define-derived-backend (child parent &rest body) + "Create a new back-end as a variant of an existing one. + +CHILD is the name of the derived back-end. PARENT is the name of +the parent back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist of filters that will overwrite or complete filters + defined in PARENT back-end. See `org-export-filters-alist' + for a list of allowed filters. + + :menu-entry + + Menu entry for the export dispatcher. See + `org-export-define-backend' for more information about the + expected value. + + :options-alist + + Alist of back-end specific properties that will overwrite or + complete those defined in PARENT back-end. Refer to + `org-export-options-alist' for more information about + structure of the values. + + :translate-alist + + Alist of element and object types and transcoders that will + overwrite or complete transcode table from PARENT back-end. + Refer to `org-export-define-backend' for detailed information + about transcoders. + +As an example, here is how one could define \"my-latex\" back-end +as a variant of `latex' back-end with a custom template function: + + \(org-export-define-derived-backend 'my-latex 'latex + :translate-alist '((template . my-latex-template-fun))) + +The back-end could then be called with, for example: + + \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" + (declare (indent 2)) + (let (blocks filters menu-entry options transcoders contents) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (:translate-alist (setq transcoders (pop body))) + (t (pop body)))) + (org-export-register-backend + (org-export-create-backend :name child + :parent parent + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) + + + +;;; The Communication Channel +;; +;; During export process, every function has access to a number of +;; properties. They are of two types: +;; +;; 1. Environment options are collected once at the very beginning of +;; the process, out of the original buffer and configuration. +;; Collecting them is handled by `org-export-get-environment' +;; function. +;; +;; Most environment options are defined through the +;; `org-export-options-alist' variable. +;; +;; 2. Tree properties are extracted directly from the parsed tree, +;; just before export, by `org-export-collect-tree-properties'. +;; +;; Here is the full list of properties available during transcode +;; process, with their category and their value type. +;; +;; + `:author' :: Author's name. +;; - category :: option +;; - type :: string +;; +;; + `:back-end' :: Current back-end used for transcoding. +;; - category :: tree +;; - type :: symbol +;; +;; + `:creator' :: String to write as creation information. +;; - category :: option +;; - type :: string +;; +;; + `:date' :: String to use as date. +;; - category :: option +;; - type :: string +;; +;; + `:description' :: Description text for the current data. +;; - category :: option +;; - type :: string +;; +;; + `:email' :: Author's email. +;; - category :: option +;; - type :: string +;; +;; + `:exclude-tags' :: Tags for exclusion of subtrees from export +;; process. +;; - category :: option +;; - type :: list of strings +;; +;; + `:export-options' :: List of export options available for current +;; process. +;; - category :: none +;; - type :: list of symbols, among `subtree', `body-only' and +;; `visible-only'. +;; +;; + `:exported-data' :: Hash table used for memoizing +;; `org-export-data'. +;; - category :: tree +;; - type :: hash table +;; +;; + `:filetags' :: List of global tags for buffer. Used by +;; `org-export-get-tags' to get tags with inheritance. +;; - category :: option +;; - type :: list of strings +;; +;; + `:footnote-definition-alist' :: Alist between footnote labels and +;; their definition, as parsed data. Only non-inlined footnotes +;; are represented in this alist. Also, every definition isn't +;; guaranteed to be referenced in the parse tree. The purpose of +;; this property is to preserve definitions from oblivion +;; (i.e. when the parse tree comes from a part of the original +;; buffer), it isn't meant for direct use in a back-end. To +;; retrieve a definition relative to a reference, use +;; `org-export-get-footnote-definition' instead. +;; - category :: option +;; - type :: alist (STRING . LIST) +;; +;; + `:headline-levels' :: Maximum level being exported as an +;; headline. Comparison is done with the relative level of +;; headlines in the parse tree, not necessarily with their +;; actual level. +;; - category :: option +;; - type :: integer +;; +;; + `:headline-offset' :: Difference between relative and real level +;; of headlines in the parse tree. For example, a value of -1 +;; means a level 2 headline should be considered as level +;; 1 (cf. `org-export-get-relative-level'). +;; - category :: tree +;; - type :: integer +;; +;; + `:headline-numbering' :: Alist between headlines and their +;; numbering, as a list of numbers +;; (cf. `org-export-get-headline-number'). +;; - category :: tree +;; - type :: alist (INTEGER . LIST) +;; +;; + `:id-alist' :: Alist between ID strings and destination file's +;; path, relative to current directory. It is used by +;; `org-export-resolve-id-link' to resolve ID links targeting an +;; external file. +;; - category :: option +;; - type :: alist (STRING . STRING) +;; +;; + `:ignore-list' :: List of elements and objects that should be +;; ignored during export. +;; - category :: tree +;; - type :: list of elements and objects +;; +;; + `:input-file' :: Full path to input file, if any. +;; - category :: option +;; - type :: string or nil +;; +;; + `:keywords' :: List of keywords attached to data. +;; - category :: option +;; - type :: string +;; +;; + `:language' :: Default language used for translations. +;; - category :: option +;; - type :: string +;; +;; + `:parse-tree' :: Whole parse tree, available at any time during +;; transcoding. +;; - category :: option +;; - type :: list (as returned by `org-element-parse-buffer') +;; +;; + `:preserve-breaks' :: Non-nil means transcoding should preserve +;; all line breaks. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:section-numbers' :: Non-nil means transcoding should add +;; section numbers to headlines. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees +;; in transcoding. When such a tag is present, subtrees without +;; it are de facto excluded from the process. See +;; `use-select-tags'. +;; - category :: option +;; - type :: list of strings +;; +;; + `:time-stamp-file' :: Non-nil means transcoding should insert +;; a time stamp in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:translate-alist' :: Alist between element and object types and +;; transcoding functions relative to the current back-end. +;; Special keys `inner-template', `template' and `plain-text' are +;; also possible. +;; - category :: option +;; - type :: alist (SYMBOL . FUNCTION) +;; +;; + `:with-archived-trees' :: Non-nil when archived subtrees should +;; also be transcoded. If it is set to the `headline' symbol, +;; only the archived headline's name is retained. +;; - category :: option +;; - type :: symbol (nil, t, `headline') +;; +;; + `:with-author' :: Non-nil means author's name should be included +;; in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-clocks' :: Non-nil means clock keywords should be exported. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-creator' :: Non-nil means a creation sentence should be +;; inserted at the end of the transcoded string. If the value +;; is `comment', it should be commented. +;; - category :: option +;; - type :: symbol (`comment', nil, t) +;; +;; + `:with-date' :: Non-nil means output should contain a date. +;; - category :: option +;; - type :. symbol (nil, t) +;; +;; + `:with-drawers' :: Non-nil means drawers should be exported. If +;; its value is a list of names, only drawers with such names +;; will be transcoded. If that list starts with `not', drawer +;; with these names will be skipped. +;; - category :: option +;; - type :: symbol (nil, t) or list of strings +;; +;; + `:with-email' :: Non-nil means output should contain author's +;; email. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-emphasize' :: Non-nil means emphasized text should be +;; interpreted. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-fixed-width' :: Non-nil if transcoder should interpret +;; strings starting with a colon as a fixed-with (verbatim) area. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-footnotes' :: Non-nil if transcoder should interpret +;; footnotes. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-latex' :: Non-nil means `latex-environment' elements and +;; `latex-fragment' objects should appear in export output. When +;; this property is set to `verbatim', they will be left as-is. +;; - category :: option +;; - type :: symbol (`verbatim', nil, t) +;; +;; + `:with-planning' :: Non-nil means transcoding should include +;; planning info. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-priority' :: Non-nil means transcoding should include +;; priority cookies. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in +;; plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-special-strings' :: Non-nil means transcoding should +;; interpret special strings in plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-sub-superscript' :: Non-nil means transcoding should +;; interpret subscript and superscript. With a value of "{}", +;; only interpret those using curly brackets. +;; - category :: option +;; - type :: symbol (nil, {}, t) +;; +;; + `:with-tables' :: Non-nil means transcoding should interpret +;; tables. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-tags' :: Non-nil means transcoding should keep tags in +;; headlines. A `not-in-toc' value will remove them from the +;; table of contents, if any, nonetheless. +;; - category :: option +;; - type :: symbol (nil, t, `not-in-toc') +;; +;; + `:with-tasks' :: Non-nil means transcoding should include +;; headlines with a TODO keyword. A `todo' value will only +;; include headlines with a todo type keyword while a `done' +;; value will do the contrary. If a list of strings is provided, +;; only tasks with keywords belonging to that list will be kept. +;; - category :: option +;; - type :: symbol (t, todo, done, nil) or list of strings +;; +;; + `:with-timestamps' :: Non-nil means transcoding should include +;; time stamps. Special value `active' (resp. `inactive') ask to +;; export only active (resp. inactive) timestamps. Otherwise, +;; completely remove them. +;; - category :: option +;; - type :: symbol: (`active', `inactive', t, nil) +;; +;; + `:with-toc' :: Non-nil means that a table of contents has to be +;; added to the output. An integer value limits its depth. +;; - category :: option +;; - type :: symbol (nil, t or integer) +;; +;; + `:with-todo-keywords' :: Non-nil means transcoding should +;; include TODO keywords. +;; - category :: option +;; - type :: symbol (nil, t) + + +;;;; Environment Options +;; +;; Environment options encompass all parameters defined outside the +;; scope of the parsed data. They come from five sources, in +;; increasing precedence order: +;; +;; - Global variables, +;; - Buffer's attributes, +;; - Options keyword symbols, +;; - Buffer keywords, +;; - Subtree properties. +;; +;; The central internal function with regards to environment options +;; is `org-export-get-environment'. It updates global variables with +;; "#+BIND:" keywords, then retrieve and prioritize properties from +;; the different sources. +;; +;; The internal functions doing the retrieval are: +;; `org-export--get-global-options', +;; `org-export--get-buffer-attributes', +;; `org-export--parse-option-keyword', +;; `org-export--get-subtree-options' and +;; `org-export--get-inbuffer-options' +;; +;; Also, `org-export--list-bound-variables' collects bound variables +;; along with their value in order to set them as buffer local +;; variables later in the process. + +(defun org-export-get-environment (&optional backend subtreep ext-plist) + "Collect export options from the current buffer. + +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. + +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. + +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings." + ;; First install #+BIND variables since these must be set before + ;; global options are read. + (dolist (pair (org-export--list-bound-variables)) + (org-set-local (car pair) (nth 1 pair))) + ;; Get and prioritize export options... + (org-combine-plists + ;; ... from global variables... + (org-export--get-global-options backend) + ;; ... from an external property list... + ext-plist + ;; ... from in-buffer settings... + (org-export--get-inbuffer-options backend) + ;; ... and from subtree, when appropriate. + (and subtreep (org-export--get-subtree-options backend)) + ;; Eventually add misc. properties. + (list + :back-end + backend + :translate-alist (org-export-get-all-transcoders backend) + :footnote-definition-alist + ;; Footnotes definitions must be collected in the original + ;; buffer, as there's no insurance that they will still be in + ;; the parse tree, due to possible narrowing. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-footnote-definition-re nil t) + (let ((def (save-match-data (org-element-at-point)))) + (when (eq (org-element-type def) 'footnote-definition) + (push + (cons (org-element-property :label def) + (let ((cbeg (org-element-property :contents-begin def))) + (when cbeg + (org-element--parse-elements + cbeg (org-element-property :contents-end def) + nil nil nil nil (list 'org-data nil))))) + alist)))) + alist)) + :id-alist + ;; Collect id references. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) + (let ((link (org-element-context))) + (when (eq (org-element-type link) 'link) + (let* ((id (org-element-property :path link)) + (file (org-id-find-id-file id))) + (when file + (push (cons id (file-relative-name file)) alist))))))) + alist)))) + +(defun org-export--parse-option-keyword (options &optional backend) + "Parse an OPTIONS line and return values as a plist. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies which back-end +specific items to read, if any." + (let* ((all + ;; Priority is given to back-end specific options. + (append (and backend (org-export-get-all-options backend)) + org-export-options-alist)) + plist) + (dolist (option all) + (let ((property (car option)) + (item (nth 2 option))) + (when (and item + (not (plist-member plist property)) + (string-match (concat "\\(\\`\\|[ \t]\\)" + (regexp-quote item) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") + options)) + (setq plist (plist-put plist + property + (car (read-from-string + (match-string 2 options)))))))) + plist)) + +(defun org-export--get-subtree-options (&optional backend) + "Get export options in subtree at point. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies back-end used +for export. Return options as a plist." + ;; For each buffer keyword, create a headline property setting the + ;; same property in communication channel. The name for the property + ;; is the keyword with "EXPORT_" appended to it. + (org-with-wide-buffer + (let (prop plist) + ;; Make sure point is at a heading. + (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t)) + ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's + ;; title as its fallback value. + (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE") + (progn (looking-at org-todo-line-regexp) + (org-match-string-no-properties 3)))) + (setq plist + (plist-put + plist :title + (org-element-parse-secondary-string + prop (org-element-restriction 'keyword))))) + ;; EXPORT_OPTIONS are parsed in a non-standard way. + (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) + (setq plist + (nconc plist (org-export--parse-option-keyword prop backend)))) + ;; Handle other keywords. TITLE keyword is excluded as it has + ;; been handled already. + (let ((seen '("TITLE"))) + (mapc + (lambda (option) + (let ((property (car option)) + (keyword (nth 1 option))) + (when (and keyword (not (member keyword seen))) + (let* ((subtree-prop (concat "EXPORT_" keyword)) + ;; Export properties are not case-sensitive. + (value (let ((case-fold-search t)) + (org-entry-get (point) subtree-prop)))) + (push keyword seen) + (when (and value (not (plist-member plist property))) + (setq plist + (plist-put + plist + property + (cond + ;; Parse VALUE if required. + ((member keyword org-element-document-properties) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))) + ;; If BEHAVIOR is `split' expected value is + ;; a list of strings, not a string. + ((eq (nth 4 option) 'split) (org-split-string value)) + (t value))))))))) + ;; Look for both general keywords and back-end specific + ;; options, with priority given to the latter. + (append (and backend (org-export-get-all-options backend)) + org-export-options-alist))) + ;; Return value. + plist))) + +(defun org-export--get-inbuffer-options (&optional backend) + "Return current buffer export options, as a plist. + +Optional argument BACKEND, when non-nil, is an export back-end, +as returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific options should also be read in the +process. + +Assume buffer is in Org mode. Narrowing, if any, is ignored." + (let* (plist + get-options ; For byte-compiler. + (case-fold-search t) + (options (append + ;; Priority is given to back-end specific options. + (and backend (org-export-get-all-options backend)) + org-export-options-alist)) + (regexp (format "^[ \t]*#\\+%s:" + (regexp-opt (nconc (delq nil (mapcar 'cadr options)) + org-export-special-keywords)))) + (find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (pushnew (car option) properties)))))) + (get-options + (lambda (&optional files plist) + ;; Recursively read keywords in buffer. FILES is a list + ;; of files read so far. PLIST is the current property + ;; list obtained. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (val (org-element-property :value element))) + (cond + ;; Options in `org-export-special-keywords'. + ((equal key "SETUPFILE") + (let ((file (expand-file-name + (org-remove-double-quotes (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (insert (org-file-contents file 'noerror)) + (let ((org-inhibit-startup t)) (org-mode)) + (setq plist (funcall get-options + (cons file files) plist)))))) + ((equal key "OPTIONS") + (setq plist + (org-combine-plists + plist + (org-export--parse-option-keyword val backend)))) + ((equal key "FILETAGS") + (setq plist + (org-combine-plists + plist + (list :filetags + (org-uniquify + (append (org-split-string val ":") + (plist-get plist :filetags))))))) + (t + ;; Options in `org-export-options-alist'. + (dolist (property (funcall find-properties key)) + (let ((behaviour (nth 4 (assq property options)))) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOR. + (case behaviour + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ('t val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property)))))))))))))) + ;; Return final value. + plist)))) + ;; Read options in the current buffer. + (setq plist (funcall get-options + (and buffer-file-name (list buffer-file-name)) nil)) + ;; Parse keywords specified in `org-element-document-properties' + ;; and return PLIST. + (dolist (keyword org-element-document-properties plist) + (dolist (property (funcall find-properties keyword)) + (let ((value (plist-get plist property))) + (when (stringp value) + (setq plist + (plist-put plist property + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)))))))))) + +(defun org-export--get-buffer-attributes () + "Return properties related to buffer attributes, as a plist." + ;; Store full path of input file name, or nil. For internal use. + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list :input-file visited-file + :title (if (not visited-file) (buffer-name (buffer-base-buffer)) + (file-name-sans-extension + (file-name-nondirectory visited-file)))))) + +(defun org-export--get-global-options (&optional backend) + "Return global export options as a plist. +Optional argument BACKEND, if non-nil, is an export back-end, as +returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific export options should also be read in the +process." + (let (plist + ;; Priority is given to back-end specific options. + (all (append (and backend (org-export-get-all-options backend)) + org-export-options-alist))) + (dolist (cell all plist) + (let ((prop (car cell)) + (default-value (nth 3 cell))) + (unless (or (not default-value) (plist-member plist prop)) + (setq plist + (plist-put + plist + prop + ;; Eval default value provided. If keyword is + ;; a member of `org-element-document-properties', + ;; parse it as a secondary string before storing it. + (let ((value (eval (nth 3 cell)))) + (if (not (stringp value)) value + (let ((keyword (nth 1 cell))) + (if (member keyword org-element-document-properties) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)) + value))))))))))) + +(defun org-export--list-bound-variables () + "Return variables bound from BIND keywords in current buffer. +Also look for BIND keywords in setup files. The return value is +an alist where associations are (VARIABLE-NAME VALUE)." + (when org-export-allow-bind-keywords + (let* (collect-bind ; For byte-compiler. + (collect-bind + (lambda (files alist) + ;; Return an alist between variable names and their + ;; value. FILES is a list of setup files names read so + ;; far, used to avoid circular dependencies. ALIST is + ;; the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "BIND") + (push (read (format "(%s)" val)) alist) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (insert (org-file-contents file 'noerror)) + (setq alist + (funcall collect-bind + (cons file files) + alist)))))))))) + alist))))) + ;; Return value in appropriate order of appearance. + (nreverse (funcall collect-bind nil nil))))) + + +;;;; Tree Properties +;; +;; Tree properties are information extracted from parse tree. They +;; are initialized at the beginning of the transcoding process by +;; `org-export-collect-tree-properties'. +;; +;; Dedicated functions focus on computing the value of specific tree +;; properties during initialization. Thus, +;; `org-export--populate-ignore-list' lists elements and objects that +;; should be skipped during export, `org-export--get-min-level' gets +;; the minimal exportable level, used as a basis to compute relative +;; level for headlines. Eventually +;; `org-export--collect-headline-numbering' builds an alist between +;; headlines and their numbering. + +(defun org-export-collect-tree-properties (data info) + "Extract tree properties from parse tree. + +DATA is the parse tree from which information is retrieved. INFO +is a list holding export options. + +Following tree properties are set or updated: + +`:exported-data' Hash table used to memoize results from + `org-export-data'. + +`:footnote-definition-alist' List of footnotes definitions in + original buffer and current parse tree. + +`:headline-offset' Offset between true level of headlines and + local level. An offset of -1 means a headline + of level 2 should be considered as a level + 1 headline in the context. + +`:headline-numbering' Alist of all headlines as key an the + associated numbering as value. + +`:ignore-list' List of elements that should be ignored during + export. + +Return updated plist." + ;; Install the parse tree in the communication channel, in order to + ;; use `org-export-get-genealogy' and al. + (setq info (plist-put info :parse-tree data)) + ;; Get the list of elements and objects to ignore, and put it into + ;; `:ignore-list'. Do not overwrite any user ignore that might have + ;; been done during parse tree filtering. + (setq info + (plist-put info + :ignore-list + (append (org-export--populate-ignore-list data info) + (plist-get info :ignore-list)))) + ;; Compute `:headline-offset' in order to be able to use + ;; `org-export-get-relative-level'. + (setq info + (plist-put info + :headline-offset + (- 1 (org-export--get-min-level data info)))) + ;; Update footnotes definitions list with definitions in parse tree. + ;; This is required since buffer expansion might have modified + ;; boundaries of footnote definitions contained in the parse tree. + ;; This way, definitions in `footnote-definition-alist' are bound to + ;; match those in the parse tree. + (let ((defs (plist-get info :footnote-definition-alist))) + (org-element-map data 'footnote-definition + (lambda (fn) + (push (cons (org-element-property :label fn) + `(org-data nil ,@(org-element-contents fn))) + defs))) + (setq info (plist-put info :footnote-definition-alist defs))) + ;; Properties order doesn't matter: get the rest of the tree + ;; properties. + (nconc + `(:headline-numbering ,(org-export--collect-headline-numbering data info) + :exported-data ,(make-hash-table :test 'eq :size 4001)) + info)) + +(defun org-export--get-min-level (data options) + "Return minimum exportable headline's level in DATA. +DATA is parsed tree as returned by `org-element-parse-buffer'. +OPTIONS is a plist holding export options." + (catch 'exit + (let ((min-level 10000)) + (mapc + (lambda (blob) + (when (and (eq (org-element-type blob) 'headline) + (not (org-element-property :footnote-section-p blob)) + (not (memq blob (plist-get options :ignore-list)))) + (setq min-level (min (org-element-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-contents data)) + ;; If no headline was found, for the sake of consistency, set + ;; minimum level to 1 nonetheless. + (if (= min-level 10000) 1 min-level)))) + +(defun org-export--collect-headline-numbering (data options) + "Return numbering of all exportable headlines in a parse tree. + +DATA is the parse tree. OPTIONS is the plist holding export +options. + +Return an alist whose key is a headline and value is its +associated numbering \(in the shape of a list of numbers\) or nil +for a footnotes section." + (let ((numbering (make-vector org-export-max-depth 0))) + (org-element-map data 'headline + (lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((relative-level + (1- (org-export-get-relative-level headline options)))) + (cons + headline + (loop for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0)))))) + options))) + +(defun org-export--populate-ignore-list (data options) + "Return list of elements and objects to ignore during export. +DATA is the parse tree to traverse. OPTIONS is the plist holding +export options." + (let* (ignore + walk-data + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data options)) + (walk-data + (lambda (data) + ;; Collect ignored elements or objects into IGNORE-LIST. + (let ((type (org-element-type data))) + (if (org-export--skip-p data options selected) (push data ignore) + (if (and (eq type 'headline) + (eq (plist-get options :with-archived-trees) 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, add it to ignore list. + (mapc (lambda (e) (push e ignore)) + (org-element-contents data)) + ;; Move into secondary string, if any. + (let ((sec-prop + (cdr (assq type org-element-secondary-value-alist)))) + (when sec-prop + (mapc walk-data (org-element-property sec-prop data)))) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data)))))))) + ;; Main call. + (funcall walk-data data) + ;; Return value. + ignore)) + +(defun org-export--selected-trees (data info) + "Return list of headlines and inlinetasks with a select tag in their tree. +DATA is parsed data as returned by `org-element-parse-buffer'. +INFO is a plist holding export options." + (let* (selected-trees + walk-data ; For byte-compiler. + (walk-data + (function + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (loop for tag in (plist-get info :select-tags) + thereis (member tag tags)) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the tree + ;; as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + 'identity) + selected-trees)) + ;; If at a headline, continue searching in tree, + ;; recursively. + (when (eq type 'headline) + (mapc (lambda (el) + (funcall walk-data el (cons data genealogy))) + (org-element-contents data)))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (mapc (lambda (el) (funcall walk-data el genealogy)) + (org-element-contents data))))))))) + (funcall walk-data data nil) + selected-trees)) + +(defun org-export--skip-p (blob options selected) + "Non-nil when element or object BLOB should be skipped during export. +OPTIONS is the plist holding export options. SELECTED, when +non-nil, is a list of headlines or inlinetasks belonging to +a tree with a select tag." + (case (org-element-type blob) + (clock (not (plist-get options :with-clocks))) + (drawer + (let ((with-drawers-p (plist-get options :with-drawers))) + (or (not with-drawers-p) + (and (consp with-drawers-p) + ;; If `:with-drawers' value starts with `not', ignore + ;; every drawer whose name belong to that list. + ;; Otherwise, ignore drawers whose name isn't in that + ;; list. + (let ((name (org-element-property :drawer-name blob))) + (if (eq (car with-drawers-p) 'not) + (member-ignore-case name (cdr with-drawers-p)) + (not (member-ignore-case name with-drawers-p)))))))) + ((footnote-definition footnote-reference) + (not (plist-get options :with-footnotes))) + ((headline inlinetask) + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword blob)) + (todo-type (org-element-property :todo-type blob)) + (archived (plist-get options :with-archived-trees)) + (tags (org-element-property :tags blob))) + (or + (and (eq (org-element-type blob) 'inlinetask) + (not (plist-get options :with-inlinetasks))) + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get options :exclude-tags) + thereis (member k tags)) + ;; When a select tag is present in the buffer, ignore any tree + ;; without it. + (and selected (not (memq blob selected))) + ;; Ignore commented sub-trees. + (org-element-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo + (or (not with-tasks) + (and (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and (consp with-tasks) (not (member todo with-tasks)))))))) + ((latex-environment latex-fragment) (not (plist-get options :with-latex))) + (planning (not (plist-get options :with-planning))) + (statistics-cookie (not (plist-get options :with-statistics-cookies))) + (table-cell + (and (org-export-table-has-special-column-p + (org-export-get-parent-table blob)) + (not (org-export-get-previous-element blob options)))) + (table-row (org-export-table-row-is-special-p blob options)) + (timestamp + ;; `:with-timestamps' only applies to isolated timestamps + ;; objects, i.e. timestamp objects in a paragraph containing only + ;; timestamps and whitespaces. + (when (let ((parent (org-export-get-parent-element blob))) + (and (memq (org-element-type parent) '(paragraph verse-block)) + (not (org-element-map parent + (cons 'plain-text + (remq 'timestamp org-element-all-objects)) + (lambda (obj) + (or (not (stringp obj)) (org-string-nw-p obj))) + options t)))) + (case (plist-get options :with-timestamps) + ('nil t) + (active + (not (memq (org-element-property :type blob) '(active active-range)))) + (inactive + (not (memq (org-element-property :type blob) + '(inactive inactive-range))))))))) + + +;;; The Transcoder +;; +;; `org-export-data' reads a parse tree (obtained with, i.e. +;; `org-element-parse-buffer') and transcodes it into a specified +;; back-end output. It takes care of filtering out elements or +;; objects according to export options and organizing the output blank +;; lines and white space are preserved. The function memoizes its +;; results, so it is cheap to call it within transcoders. +;; +;; It is possible to modify locally the back-end used by +;; `org-export-data' or even use a temporary back-end by using +;; `org-export-data-with-backend'. +;; +;; Internally, three functions handle the filtering of objects and +;; elements during the export. In particular, +;; `org-export-ignore-element' marks an element or object so future +;; parse tree traversals skip it, `org-export--interpret-p' tells which +;; elements or objects should be seen as real Org syntax and +;; `org-export-expand' transforms the others back into their original +;; shape +;; +;; `org-export-transcoder' is an accessor returning appropriate +;; translator function for a given element or object. + +(defun org-export-transcoder (blob info) + "Return appropriate transcoder for BLOB. +INFO is a plist containing export directives." + (let ((type (org-element-type blob))) + ;; Return contents only for complete parse trees. + (if (eq type 'org-data) (lambda (blob contents info) contents) + (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) + (and (functionp transcoder) transcoder))))) + +(defun org-export-data (data info) + "Convert DATA into current back-end format. + +DATA is a parse tree, an element or an object or a secondary +string. INFO is a plist holding export options. + +Return transcoded string." + (let ((memo (gethash data (plist-get info :exported-data) 'no-memo))) + (if (not (eq memo 'no-memo)) memo + (let* ((type (org-element-type data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Plain text. + ((eq type 'plain-text) + (org-export-filter-apply-functions + (plist-get info :filter-plain-text) + (let ((transcoder (org-export-transcoder data info))) + (if transcoder (funcall transcoder data info) data)) + info)) + ;; Uninterpreted element/object: change it back to Org + ;; syntax and export again resulting raw string. + ((not (org-export--interpret-p data info)) + (org-export-data + (org-export-expand + data + (mapconcat (lambda (blob) (org-export-data blob info)) + (org-element-contents data) + "")) + info)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special case, + ;; headline with archive tag and archived trees restricted + ;; to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (or (and (functionp transcoder) + (funcall transcoder data nil info)) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing objects + ;; must have their indentation normalized + ;; first. + (org-element-normalize-contents + data + ;; When normalizing contents of the first + ;; paragraph in an item or a footnote + ;; definition, ignore first line's + ;; indentation: there is none and it + ;; might be misleading. + (when (eq type 'paragraph) + (let ((parent (org-export-get-parent data))) + (and + (eq (car (org-element-contents parent)) + data) + (memq (org-element-type parent) + '(footnote-definition item)))))))) + ""))) + (funcall transcoder data + (if (not greaterp) contents + (org-element-normalize-string contents)) + info)))))))) + ;; Final result will be memoized before being returned. + (puthash + data + (cond + ((not results) nil) + ((memq type '(org-data plain-text nil)) results) + ;; Append the same white space between elements or objects as in + ;; the original buffer, and call appropriate filters. + (t + (let ((results + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((post-blank (or (org-element-property :post-blank data) + 0))) + (if (memq type org-element-all-elements) + (concat (org-element-normalize-string results) + (make-string post-blank ?\n)) + (concat results (make-string post-blank ? )))) + info))) + results))) + (plist-get info :exported-data)))))) + +(defun org-export-data-with-backend (data backend info) + "Convert DATA into BACKEND format. + +DATA is an element, an object, a secondary string or a string. +BACKEND is a symbol. INFO is a plist used as a communication +channel. + +Unlike to `org-export-with-backend', this function will +recursively convert DATA using BACKEND translation table." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-data + data + ;; Set-up a new communication channel with translations defined in + ;; BACKEND as the translate table and a new hash table for + ;; memoization. + (org-combine-plists + info + (list :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + ;; Size of the hash table is reduced since this function + ;; will probably be used on small trees. + :exported-data (make-hash-table :test 'eq :size 401))))) + +(defun org-export--interpret-p (blob info) + "Non-nil if element or object BLOB should be interpreted during export. +If nil, BLOB will appear as raw Org syntax. Check is done +according to export options INFO, stored as a plist." + (case (org-element-type blob) + ;; ... entities... + (entity (plist-get info :with-entities)) + ;; ... emphasis... + ((bold italic strike-through underline) + (plist-get info :with-emphasize)) + ;; ... fixed-width areas. + (fixed-width (plist-get info :with-fixed-width)) + ;; ... LaTeX environments and fragments... + ((latex-environment latex-fragment) + (let ((with-latex-p (plist-get info :with-latex))) + (and with-latex-p (not (eq with-latex-p 'verbatim))))) + ;; ... sub/superscripts... + ((subscript superscript) + (let ((sub/super-p (plist-get info :with-sub-superscript))) + (if (eq sub/super-p '{}) + (org-element-property :use-brackets-p blob) + sub/super-p))) + ;; ... tables... + (table (plist-get info :with-tables)) + (otherwise t))) + +(defun org-export-expand (blob contents &optional with-affiliated) + "Expand a parsed element or object to its original state. + +BLOB is either an element or an object. CONTENTS is its +contents, as a string or nil. + +When optional argument WITH-AFFILIATED is non-nil, add affiliated +keywords before output." + (let ((type (org-element-type blob))) + (concat (and with-affiliated (memq type org-element-all-elements) + (org-element--interpret-affiliated-keywords blob)) + (funcall (intern (format "org-element-%s-interpreter" type)) + blob contents)))) + +(defun org-export-ignore-element (element info) + "Add ELEMENT to `:ignore-list' in INFO. + +Any element in `:ignore-list' will be skipped when using +`org-element-map'. INFO is modified by side effects." + (plist-put info :ignore-list (cons element (plist-get info :ignore-list)))) + + + +;;; The Filter System +;; +;; Filters allow end-users to tweak easily the transcoded output. +;; They are the functional counterpart of hooks, as every filter in +;; a set is applied to the return value of the previous one. +;; +;; Every set is back-end agnostic. Although, a filter is always +;; called, in addition to the string it applies to, with the back-end +;; used as argument, so it's easy for the end-user to add back-end +;; specific filters in the set. The communication channel, as +;; a plist, is required as the third argument. +;; +;; From the developer side, filters sets can be installed in the +;; process with the help of `org-export-define-backend', which +;; internally stores filters as an alist. Each association has a key +;; among the following symbols and a function or a list of functions +;; as value. +;; +;; - `:filter-options' applies to the property list containing export +;; options. Unlike to other filters, functions in this list accept +;; two arguments instead of three: the property list containing +;; export options and the back-end. Users can set its value through +;; `org-export-filter-options-functions' variable. +;; +;; - `:filter-parse-tree' applies directly to the complete parsed +;; tree. Users can set it through +;; `org-export-filter-parse-tree-functions' variable. +;; +;; - `:filter-final-output' applies to the final transcoded string. +;; Users can set it with `org-export-filter-final-output-functions' +;; variable +;; +;; - `:filter-plain-text' applies to any string not recognized as Org +;; syntax. `org-export-filter-plain-text-functions' allows users to +;; configure it. +;; +;; - `:filter-TYPE' applies on the string returned after an element or +;; object of type TYPE has been transcoded. A user can modify +;; `org-export-filter-TYPE-functions' +;; +;; All filters sets are applied with +;; `org-export-filter-apply-functions' function. Filters in a set are +;; applied in a LIFO fashion. It allows developers to be sure that +;; their filters will be applied first. +;; +;; Filters properties are installed in communication channel with +;; `org-export-install-filters' function. +;; +;; Eventually, two hooks (`org-export-before-processing-hook' and +;; `org-export-before-parsing-hook') are run at the beginning of the +;; export process and just before parsing to allow for heavy structure +;; modifications. + + +;;;; Hooks + +(defvar org-export-before-processing-hook nil + "Hook run at the beginning of the export process. + +This is run before include keywords and macros are expanded and +Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + +(defvar org-export-before-parsing-hook nil + "Hook run before parsing an export buffer. + +This is run after include keywords and macros have been expanded +and Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + + +;;;; Special Filters + +(defvar org-export-filter-options-functions nil + "List of functions applied to the export options. +Each filter is called with two arguments: the export options, as +a plist, and the back-end, as a symbol. It must return +a property list containing export options.") + +(defvar org-export-filter-parse-tree-functions nil + "List of functions applied to the parsed tree. +Each filter is called with three arguments: the parse tree, as +returned by `org-element-parse-buffer', the back-end, as +a symbol, and the communication channel, as a plist. It must +return the modified parse tree to transcode.") + +(defvar org-export-filter-plain-text-functions nil + "List of functions applied to plain text. +Each filter is called with three arguments: a string which +contains no Org syntax, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-final-output-functions nil + "List of functions applied to the transcoded string. +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") + + +;;;; Elements Filters + +(defvar org-export-filter-babel-call-functions nil + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-center-block-functions nil + "List of functions applied to a transcoded center block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-clock-functions nil + "List of functions applied to a transcoded clock. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-functions nil + "List of functions applied to a transcoded comment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-block-functions nil + "List of functions applied to a transcoded comment-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-diary-sexp-functions nil + "List of functions applied to a transcoded diary-sexp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-drawer-functions nil + "List of functions applied to a transcoded drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-dynamic-block-functions nil + "List of functions applied to a transcoded dynamic-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-example-block-functions nil + "List of functions applied to a transcoded example-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-block-functions nil + "List of functions applied to a transcoded export-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-fixed-width-functions nil + "List of functions applied to a transcoded fixed-width. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-definition-functions nil + "List of functions applied to a transcoded footnote-definition. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-headline-functions nil + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-horizontal-rule-functions nil + "List of functions applied to a transcoded horizontal-rule. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inlinetask-functions nil + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-item-functions nil + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-keyword-functions nil + "List of functions applied to a transcoded keyword. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-environment-functions nil + "List of functions applied to a transcoded latex-environment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-node-property-functions nil + "List of functions applied to a transcoded node-property. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-paragraph-functions nil + "List of functions applied to a transcoded paragraph. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-plain-list-functions nil + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-planning-functions nil + "List of functions applied to a transcoded planning. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-property-drawer-functions nil + "List of functions applied to a transcoded property-drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-quote-block-functions nil + "List of functions applied to a transcoded quote block. +Each filter is called with three arguments: the transcoded quote +data, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-quote-section-functions nil + "List of functions applied to a transcoded quote-section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-section-functions nil + "List of functions applied to a transcoded section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-special-block-functions nil + "List of functions applied to a transcoded special block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-src-block-functions nil + "List of functions applied to a transcoded src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-functions nil + "List of functions applied to a transcoded table. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-cell-functions nil + "List of functions applied to a transcoded table-cell. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-row-functions nil + "List of functions applied to a transcoded table-row. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verse-block-functions nil + "List of functions applied to a transcoded verse block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Objects Filters + +(defvar org-export-filter-bold-functions nil + "List of functions applied to transcoded bold text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-code-functions nil + "List of functions applied to transcoded code text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-entity-functions nil + "List of functions applied to a transcoded entity. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-snippet-functions nil + "List of functions applied to a transcoded export-snippet. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-reference-functions nil + "List of functions applied to a transcoded footnote-reference. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-babel-call-functions nil + "List of functions applied to a transcoded inline-babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-src-block-functions nil + "List of functions applied to a transcoded inline-src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-italic-functions nil + "List of functions applied to transcoded italic text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-fragment-functions nil + "List of functions applied to a transcoded latex-fragment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-line-break-functions nil + "List of functions applied to a transcoded line-break. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-link-functions nil + "List of functions applied to a transcoded link. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-radio-target-functions nil + "List of functions applied to a transcoded radio-target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-statistics-cookie-functions nil + "List of functions applied to a transcoded statistics-cookie. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-strike-through-functions nil + "List of functions applied to transcoded strike-through text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-subscript-functions nil + "List of functions applied to a transcoded subscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-superscript-functions nil + "List of functions applied to a transcoded superscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-target-functions nil + "List of functions applied to a transcoded target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-timestamp-functions nil + "List of functions applied to a transcoded timestamp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-underline-functions nil + "List of functions applied to transcoded underline text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verbatim-functions nil + "List of functions applied to transcoded verbatim text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Filters Tools +;; +;; Internal function `org-export-install-filters' installs filters +;; hard-coded in back-ends (developer filters) and filters from global +;; variables (user filters) in the communication channel. +;; +;; Internal function `org-export-filter-apply-functions' takes care +;; about applying each filter in order to a given data. It ignores +;; filters returning a nil value but stops whenever a filter returns +;; an empty string. + +(defun org-export-filter-apply-functions (filters value info) + "Call every function in FILTERS. + +Functions are called with arguments VALUE, current export +back-end's name and INFO. A function returning a nil value will +be skipped. If it returns the empty string, the process ends and +VALUE is ignored. + +Call is done in a LIFO fashion, to be sure that developer +specified filters, if any, are called first." + (catch 'exit + (let* ((backend (plist-get info :back-end)) + (backend-name (and backend (org-export-backend-name backend)))) + (dolist (filter filters value) + (let ((result (funcall filter value backend-name info))) + (cond ((not result) value) + ((equal value "") (throw 'exit nil)) + (t (setq value result)))))))) + +(defun org-export-install-filters (info) + "Install filters properties in communication channel. +INFO is a plist containing the current communication channel. +Return the updated communication channel." + (let (plist) + ;; Install user-defined filters with `org-export-filters-alist' + ;; and filters already in INFO (through ext-plist mechanism). + (mapc (lambda (p) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) + org-export-filters-alist) + ;; Prepend back-end specific filters to that list. + (mapc (lambda (p) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + (org-export-get-all-filters (plist-get info :back-end))) + ;; Return new communication channel. + (org-combine-plists info plist))) + + + +;;; Core functions +;; +;; This is the room for the main function, `org-export-as', along with +;; its derivative, `org-export-string-as'. +;; `org-export--copy-to-kill-ring-p' determines if output of these +;; function should be added to kill ring. +;; +;; Note that `org-export-as' doesn't really parse the current buffer, +;; but a copy of it (with the same buffer-local variables and +;; visibility), where macros and include keywords are expanded and +;; Babel blocks are executed, if appropriate. +;; `org-export-with-buffer-copy' macro prepares that copy. +;; +;; File inclusion is taken care of by +;; `org-export-expand-include-keyword' and +;; `org-export--prepare-file-contents'. Structure wise, including +;; a whole Org file in a buffer often makes little sense. For +;; example, if the file contains a headline and the include keyword +;; was within an item, the item should contain the headline. That's +;; why file inclusion should be done before any structure can be +;; associated to the file, that is before parsing. +;; +;; `org-export-insert-default-template' is a command to insert +;; a default template (or a back-end specific template) at point or in +;; current subtree. + +(defun org-export-copy-buffer () + "Return a copy of the current buffer. +The copy preserves Org buffer-local variables, visibility and +narrowing." + (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer))) + (new-buf (generate-new-buffer (buffer-name)))) + (with-current-buffer new-buf + (funcall copy-buffer-fun) + (set-buffer-modified-p nil)) + new-buf)) + +(defmacro org-export-with-buffer-copy (&rest body) + "Apply BODY in a copy of the current buffer. +The copy preserves local variables, visibility and contents of +the original buffer. Point is at the beginning of the buffer +when BODY is applied." + (declare (debug t)) + (org-with-gensyms (buf-copy) + `(let ((,buf-copy (org-export-copy-buffer))) + (unwind-protect + (with-current-buffer ,buf-copy + (goto-char (point-min)) + (progn ,@body)) + (and (buffer-live-p ,buf-copy) + ;; Kill copy without confirmation. + (progn (with-current-buffer ,buf-copy + (restore-buffer-modified-p nil)) + (kill-buffer ,buf-copy))))))) + +(defun org-export--generate-copy-script (buffer) + "Generate a function duplicating BUFFER. + +The copy will preserve local variables, visibility, contents and +narrowing of the original buffer. If a region was active in +BUFFER, contents will be narrowed to that region instead. + +The resulting function can be evaluated at a later time, from +another buffer, effectively cloning the original buffer there. + +The function assumes BUFFER's major mode is `org-mode'." + (with-current-buffer buffer + `(lambda () + (let ((inhibit-modification-hooks t)) + ;; Set major mode. Ignore `org-mode-hook' as it has been run + ;; already in BUFFER. + (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode)) + ;; Copy specific buffer local variables and variables set + ;; through BIND keywords. + ,@(let ((bound-variables (org-export--list-bound-variables)) + vars) + (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars) + (when (consp entry) + (let ((var (car entry)) + (val (cdr entry))) + (and (not (eq var 'org-font-lock-keywords)) + (or (memq var + '(default-directory + buffer-file-name + buffer-file-coding-system)) + (assq var bound-variables) + (string-match "^\\(org-\\|orgtbl-\\)" + (symbol-name var))) + ;; Skip unreadable values, as they cannot be + ;; sent to external process. + (or (not val) (ignore-errors (read (format "%S" val)))) + (push `(set (make-local-variable (quote ,var)) + (quote ,val)) + vars)))))) + ;; Whole buffer contents. + (insert + ,(org-with-wide-buffer + (buffer-substring-no-properties + (point-min) (point-max)))) + ;; Narrowing. + ,(if (org-region-active-p) + `(narrow-to-region ,(region-beginning) ,(region-end)) + `(narrow-to-region ,(point-min) ,(point-max))) + ;; Current position of point. + (goto-char ,(point)) + ;; Overlays with invisible property. + ,@(let (ov-set) + (mapc + (lambda (ov) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push `(overlay-put + (make-overlay ,(overlay-start ov) + ,(overlay-end ov)) + 'invisible (quote ,invis-prop)) + ov-set)))) + (overlays-in (point-min) (point-max))) + ov-set))))) + +;;;###autoload +(defun org-export-as + (backend &optional subtreep visible-only body-only ext-plist) + "Transcode current Org buffer into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without surrounding template. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) + (save-excursion + (save-restriction + ;; Narrow buffer to an appropriate region or subtree for + ;; parsing. If parsing subtree, be sure to remove main headline + ;; too. + (cond ((org-region-active-p) + (narrow-to-region (region-beginning) (region-end))) + (subtreep + (org-narrow-to-subtree) + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point) (point-max)))) + ;; Initialize communication channel with original buffer + ;; attributes, unavailable in its copy. + (let* ((org-export-current-backend (org-export-backend-name backend)) + (info (org-combine-plists + (list :export-options + (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only)))) + (org-export--get-buffer-attributes))) + tree) + ;; Update communication channel and get parse tree. Buffer + ;; isn't parsed directly. Instead, a temporary copy is + ;; created, where include keywords, macros are expanded and + ;; code blocks are evaluated. + (org-export-with-buffer-copy + ;; Run first hook with current back-end's name as argument. + (run-hook-with-args 'org-export-before-processing-hook + (org-export-backend-name backend)) + (org-export-expand-include-keyword) + ;; Update macro templates since #+INCLUDE keywords might have + ;; added some new ones. + (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (org-export-execute-babel-code) + ;; Update radio targets since keyword inclusion might have + ;; added some more. + (org-update-radio-target-regexp) + ;; Run last hook with current back-end's name as argument. + (goto-char (point-min)) + (save-excursion + (run-hook-with-args 'org-export-before-parsing-hook + (org-export-backend-name backend))) + ;; Update communication channel with environment. Also + ;; install user's and developer's filters. + (setq info + (org-export-install-filters + (org-combine-plists + info (org-export-get-environment backend subtreep ext-plist)))) + ;; Expand export-specific set of macros: {{{author}}}, + ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done + ;; once regular macros have been expanded, since document + ;; keywords may contain one of them. + (org-macro-replace-all + (list (cons "author" + (org-element-interpret-data (plist-get info :author))) + (cons "date" + (org-element-interpret-data (plist-get info :date))) + ;; EMAIL is not a parsed keyword: store it as-is. + (cons "email" (or (plist-get info :email) "")) + (cons "title" + (org-element-interpret-data (plist-get info :title))))) + ;; Call options filters and update export options. We do not + ;; use `org-export-filter-apply-functions' here since the + ;; arity of such filters is different. + (let ((backend-name (org-export-backend-name backend))) + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend-name))) + (when result (setq info result))))) + ;; Parse buffer and call parse-tree filter on it. + (setq tree + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + (org-element-parse-buffer nil visible-only) info)) + ;; Now tree is complete, compute its properties and add them + ;; to communication channel. + (setq info + (org-combine-plists + info (org-export-collect-tree-properties tree info))) + ;; Eventually transcode TREE. Wrap the resulting string into + ;; a template. + (let* ((body (org-element-normalize-string + (or (org-export-data tree info) ""))) + (inner-template (cdr (assq 'inner-template + (plist-get info :translate-alist)))) + (full-body (if (not (functionp inner-template)) body + (funcall inner-template body info))) + (template (cdr (assq 'template + (plist-get info :translate-alist))))) + ;; Remove all text properties since they cannot be + ;; retrieved from an external process. Finally call + ;; final-output filter and return result. + (org-no-properties + (org-export-filter-apply-functions + (plist-get info :filter-final-output) + (if (or (not (functionp template)) body-only) full-body + (funcall template full-body info)) + info)))))))) + +;;;###autoload +(defun org-export-string-as (string backend &optional body-only ext-plist) + "Transcode STRING into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (with-temp-buffer + (insert string) + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-as backend nil nil body-only ext-plist))) + +;;;###autoload +(defun org-export-replace-region-by (backend) + "Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end." + (if (not (org-region-active-p)) + (user-error "No active region to replace") + (let* ((beg (region-beginning)) + (end (region-end)) + (str (buffer-substring beg end)) rpl) + (setq rpl (org-export-string-as str backend t)) + (delete-region beg end) + (insert rpl)))) + +;;;###autoload +(defun org-export-insert-default-template (&optional backend subtreep) + "Insert all export keywords with default values at beginning of line. + +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties." + (interactive) + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer")) + (when (and subtreep (org-before-first-heading-p)) + (user-error "No subtree to set export options for")) + (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) + (backend + (or backend + (intern + (org-completing-read + "Options category: " + (cons "default" + (mapcar (lambda (b) + (symbol-name (org-export-backend-name b))) + org-export--registered-backends)))))) + options keywords) + ;; Populate OPTIONS and KEYWORDS. + (dolist (entry (cond ((eq backend 'default) org-export-options-alist) + ((org-export-backend-p backend) + (org-export-get-all-options backend)) + (t (org-export-get-all-options + (org-export-get-backend backend))))) + (let ((keyword (nth 1 entry)) + (option (nth 2 entry))) + (cond + (keyword (unless (assoc keyword keywords) + (let ((value + (if (eq (nth 4 entry) 'split) + (mapconcat 'identity (eval (nth 3 entry)) " ") + (eval (nth 3 entry))))) + (push (cons keyword value) keywords)))) + (option (unless (assoc option options) + (push (cons option (eval (nth 3 entry))) options)))))) + ;; Move to an appropriate location in order to insert options. + (unless subtreep (beginning-of-line)) + ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the + ;; list of available keywords. + (when (assoc "TITLE" keywords) + (let ((title + (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file)))) + (buffer-name (buffer-base-buffer))))) + (if (not subtreep) (insert (format "#+TITLE: %s\n" title)) + (org-entry-put node "EXPORT_TITLE" title)))) + (when (assoc "DATE" keywords) + (let ((date (with-temp-buffer (org-insert-time-stamp (current-time))))) + (if (not subtreep) (insert "#+DATE: " date "\n") + (org-entry-put node "EXPORT_DATE" date)))) + (when (assoc "AUTHOR" keywords) + (let ((author (cdr (assoc "AUTHOR" keywords)))) + (if subtreep (org-entry-put node "EXPORT_AUTHOR" author) + (insert + (format "#+AUTHOR:%s\n" + (if (not (org-string-nw-p author)) "" + (concat " " author))))))) + (when (assoc "EMAIL" keywords) + (let ((email (cdr (assoc "EMAIL" keywords)))) + (if subtreep (org-entry-put node "EXPORT_EMAIL" email) + (insert + (format "#+EMAIL:%s\n" + (if (not (org-string-nw-p email)) "" + (concat " " email))))))) + ;; Then (multiple) OPTIONS lines. Never go past fill-column. + (when options + (let ((items + (mapcar + #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt))) + (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) + (if subtreep + (org-entry-put + node "EXPORT_OPTIONS" (mapconcat 'identity items " ")) + (while items + (insert "#+OPTIONS:") + (let ((width 10)) + (while (and items + (< (+ width (length (car items)) 1) fill-column)) + (let ((item (pop items))) + (insert " " item) + (incf width (1+ (length item)))))) + (insert "\n"))))) + ;; And the rest of keywords. + (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2))))) + (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL")) + (let ((val (cdr key))) + (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val) + (insert + (format "#+%s:%s\n" + (car key) + (if (org-string-nw-p val) (format " %s" val) ""))))))))) + +(defun org-export-expand-include-keyword (&optional included dir) + "Expand every include keyword in buffer. +Optional argument INCLUDED is a list of included file names along +with their line restriction, when appropriate. It is used to +avoid infinite recursion. Optional argument DIR is the current +working directory. It is used to properly resolve relative +paths." + (let ((case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (org-element-property :value element)) + (ind (org-get-indentation)) + (file (and (string-match + "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) + (prog1 (expand-file-name + (org-remove-double-quotes + (match-string 1 value)) + dir) + (setq value (replace-match "" nil nil value))))) + (lines + (and (string-match + ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" + value) + (prog1 (match-string 1 value) + (setq value (replace-match "" nil nil value))))) + (env (cond ((string-match "\\" value) 'example) + ((string-match "\\ level limit) (- level limit)))))) + +(defun org-export-get-headline-number (headline info) + "Return HEADLINE numbering as a list of numbers. +INFO is a plist holding contextual information." + (cdr (assoc headline (plist-get info :headline-numbering)))) + +(defun org-export-numbered-headline-p (headline info) + "Return a non-nil value if HEADLINE element should be numbered. +INFO is a plist used as a communication channel." + (let ((sec-num (plist-get info :section-numbers)) + (level (org-export-get-relative-level headline info))) + (if (wholenump sec-num) (<= level sec-num) sec-num))) + +(defun org-export-number-to-roman (n) + "Convert integer N into a roman numeral." + (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") + ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") + ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") + ( 1 . "I"))) + (res "")) + (if (<= n 0) + (number-to-string n) + (while roman + (if (>= n (caar roman)) + (setq n (- n (caar roman)) + res (concat res (cdar roman))) + (pop roman))) + res))) + +(defun org-export-get-tags (element info &optional tags inherited) + "Return list of tags associated to ELEMENT. + +ELEMENT has either an `headline' or an `inlinetask' type. INFO +is a plist used as a communication channel. + +Select tags (see `org-export-select-tags') and exclude tags (see +`org-export-exclude-tags') are removed from the list. + +When non-nil, optional argument TAGS should be a list of strings. +Any tag belonging to this list will also be removed. + +When optional argument INHERITED is non-nil, tags can also be +inherited from parent headlines and FILETAGS keywords." + (org-remove-if + (lambda (tag) (or (member tag (plist-get info :select-tags)) + (member tag (plist-get info :exclude-tags)) + (member tag tags))) + (if (not inherited) (org-element-property :tags element) + ;; Build complete list of inherited tags. + (let ((current-tag-list (org-element-property :tags element))) + (mapc + (lambda (parent) + (mapc + (lambda (tag) + (when (and (memq (org-element-type parent) '(headline inlinetask)) + (not (member tag current-tag-list))) + (push tag current-tag-list))) + (org-element-property :tags parent))) + (org-export-get-genealogy element)) + ;; Add FILETAGS keywords and return results. + (org-uniquify (append (plist-get info :filetags) current-tag-list)))))) + +(defun org-export-get-node-property (property blob &optional inherited) + "Return node PROPERTY value for BLOB. + +PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an +element or object. + +If optional argument INHERITED is non-nil, the value can be +inherited from a parent headline. + +Return value is a string or nil." + (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + (if (not inherited) (org-element-property property blob) + (let ((parent headline) value) + (catch 'found + (while parent + (when (plist-member (nth 1 parent) property) + (throw 'found (org-element-property property parent))) + (setq parent (org-element-property :parent parent)))))))) + +(defun org-export-get-category (blob info) + "Return category for element or object BLOB. + +INFO is a plist used as a communication channel. + +CATEGORY is automatically inherited from a parent headline, from +#+CATEGORY: keyword or created out of original file name. If all +fail, the fall-back value is \"???\"." + (or (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + ;; Almost like `org-export-node-property', but we cannot trust + ;; `plist-member' as every headline has a `:CATEGORY' + ;; property, would it be nil or equal to "???" (which has the + ;; same meaning). + (let ((parent headline) value) + (catch 'found + (while parent + (let ((category (org-element-property :CATEGORY parent))) + (and category (not (equal "???" category)) + (throw 'found category))) + (setq parent (org-element-property :parent parent)))))) + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (kwd) + (when (equal (org-element-property :key kwd) "CATEGORY") + (org-element-property :value kwd))) + info 'first-match) + (let ((file (plist-get info :input-file))) + (and file (file-name-sans-extension (file-name-nondirectory file)))) + "???")) + +(defun org-export-get-alt-title (headline info) + "Return alternative title for HEADLINE, as a secondary string. +INFO is a plist used as a communication channel. If no optional +title is defined, fall-back to the regular title." + (or (org-element-property :alt-title headline) + (org-element-property :title headline))) + +(defun org-export-first-sibling-p (headline info) + "Non-nil when HEADLINE is the first sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (eq (org-element-type (org-export-get-previous-element headline info)) + 'headline))) + +(defun org-export-last-sibling-p (headline info) + "Non-nil when HEADLINE is the last sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (org-export-get-next-element headline info))) + + +;;;; For Keywords +;; +;; `org-export-get-date' returns a date appropriate for the document +;; to about to be exported. In particular, it takes care of +;; `org-export-date-timestamp-format'. + +(defun org-export-get-date (info &optional fmt) + "Return date value for the current document. + +INFO is a plist used as a communication channel. FMT, when +non-nil, is a time format string that will be applied on the date +if it consists in a single timestamp object. It defaults to +`org-export-date-timestamp-format' when nil. + +A proper date can be a secondary string, a string or nil. It is +meant to be translated with `org-export-data' or alike." + (let ((date (plist-get info :date)) + (fmt (or fmt org-export-date-timestamp-format))) + (cond ((not date) nil) + ((and fmt + (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp)) + (org-timestamp-format (car date) fmt)) + (t date)))) + + +;;;; For Links +;; +;; `org-export-solidify-link-text' turns a string into a safer version +;; for links, replacing most non-standard characters with hyphens. +;; +;; `org-export-get-coderef-format' returns an appropriate format +;; string for coderefs. +;; +;; `org-export-inline-image-p' returns a non-nil value when the link +;; provided should be considered as an inline image. +;; +;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links +;; (i.e. links with "fuzzy" as type) within the parsed tree, and +;; returns an appropriate unique identifier when found, or nil. +;; +;; `org-export-resolve-id-link' returns the first headline with +;; specified id or custom-id in parse tree, the path to the external +;; file with the id or nil when neither was found. +;; +;; `org-export-resolve-coderef' associates a reference to a line +;; number in the element it belongs, or returns the reference itself +;; when the element isn't numbered. + +(defun org-export-solidify-link-text (s) + "Take link text S and make a safe target out of it." + (save-match-data + (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-"))) + +(defun org-export-get-coderef-format (path desc) + "Return format string for code reference link. +PATH is the link path. DESC is its description." + (save-match-data + (cond ((not desc) "%s") + ((string-match (regexp-quote (concat "(" path ")")) desc) + (replace-match "%s" t t desc)) + (t desc)))) + +(defun org-export-inline-image-p (link &optional rules) + "Non-nil if LINK object points to an inline image. + +Optional argument is a set of RULES defining inline images. It +is an alist where associations have the following shape: + + \(TYPE . REGEXP) + +Applying a rule means apply REGEXP against LINK's path when its +type is TYPE. The function will return a non-nil value if any of +the provided rules is non-nil. The default rule is +`org-export-default-inline-image-rule'. + +This only applies to links without a description." + (and (not (org-element-contents link)) + (let ((case-fold-search t) + (rules (or rules org-export-default-inline-image-rule))) + (catch 'exit + (mapc + (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match (cdr rule) + (org-element-property :path link)) + (throw 'exit t))) + rules) + ;; Return nil if no rule matched. + nil)))) + +(defun org-export-resolve-coderef (ref info) + "Resolve a code reference REF. + +INFO is a plist used as a communication channel. + +Return associated line number in source code, or REF itself, +depending on src-block or example element's switches." + (org-element-map (plist-get info :parse-tree) '(example-block src-block) + (lambda (el) + (with-temp-buffer + (insert (org-trim (org-element-property :value el))) + (let* ((label-fmt (regexp-quote + (or (org-element-property :label-fmt el) + org-coderef-label-format))) + (ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" + (replace-regexp-in-string "%s" ref label-fmt nil t)))) + ;; Element containing REF is found. Resolve it to either + ;; a label or a line number, as needed. + (when (re-search-backward ref-re nil t) + (cond + ((org-element-property :use-labels el) ref) + ((eq (org-element-property :number-lines el) 'continued) + (+ (org-export-get-loc el info) (line-number-at-pos))) + (t (line-number-at-pos))))))) + info 'first-match)) + +(defun org-export-resolve-fuzzy-link (link info) + "Return LINK destination. + +INFO is a plist holding contextual information. + +Return value can be an object, an element, or nil: + +- If LINK path matches a target object (i.e. <>) return it. + +- If LINK path exactly matches the name affiliated keyword + \(i.e. #+NAME: path) of an element, return that element. + +- If LINK path exactly matches any headline name, return that + element. If more than one headline share that name, priority + will be given to the one with the closest common ancestor, if + any, or the first one in the parse tree otherwise. + +- Otherwise, return nil. + +Assume LINK type is \"fuzzy\". White spaces are not +significant." + (let* ((raw-path (org-element-property :path link)) + (match-title-p (eq (aref raw-path 0) ?*)) + ;; Split PATH at white spaces so matches are space + ;; insensitive. + (path (org-split-string + (if match-title-p (substring raw-path 1) raw-path))) + ;; Cache for destinations that are not position dependent. + (link-cache + (or (plist-get info :resolve-fuzzy-link-cache) + (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache + (make-hash-table :test 'equal))) + :resolve-fuzzy-link-cache))) + (cached (gethash path link-cache 'not-found))) + (cond + ;; Destination is not position dependent: use cached value. + ((and (not match-title-p) (not (eq cached 'not-found))) cached) + ;; First try to find a matching "<>" unless user specified + ;; he was looking for a headline (path starts with a "*" + ;; character). + ((and (not match-title-p) + (let ((match (org-element-map (plist-get info :parse-tree) 'target + (lambda (blob) + (and (equal (org-split-string + (org-element-property :value blob)) + path) + blob)) + info 'first-match))) + (and match (puthash path match link-cache))))) + ;; Then try to find an element with a matching "#+NAME: path" + ;; affiliated keyword. + ((and (not match-title-p) + (let ((match (org-element-map (plist-get info :parse-tree) + org-element-all-elements + (lambda (el) + (let ((name (org-element-property :name el))) + (when (and name + (equal (org-split-string name) path)) + el))) + info 'first-match))) + (and match (puthash path match link-cache))))) + ;; Last case: link either points to a headline or to nothingness. + ;; Try to find the source, with priority given to headlines with + ;; the closest common ancestor. If such candidate is found, + ;; return it, otherwise return nil. + (t + (let ((find-headline + (function + ;; Return first headline whose `:raw-value' property is + ;; NAME in parse tree DATA, or nil. Statistics cookies + ;; are ignored. + (lambda (name data) + (org-element-map data 'headline + (lambda (headline) + (when (equal (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value headline))) + name) + headline)) + info 'first-match))))) + ;; Search among headlines sharing an ancestor with link, from + ;; closest to farthest. + (catch 'exit + (mapc + (lambda (parent) + (let ((foundp (funcall find-headline path parent))) + (when foundp (throw 'exit foundp)))) + (let ((parent-hl (org-export-get-parent-headline link))) + (if (not parent-hl) (list (plist-get info :parse-tree)) + (cons parent-hl (org-export-get-genealogy parent-hl))))) + ;; No destination found: return nil. + (and (not match-title-p) (puthash path nil link-cache)))))))) + +(defun org-export-resolve-id-link (link info) + "Return headline referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be the headline element matched in current parse +tree, a file name or nil. Assume LINK type is either \"id\" or +\"custom-id\"." + (let ((id (org-element-property :path link))) + ;; First check if id is within the current parse tree. + (or (org-element-map (plist-get info :parse-tree) 'headline + (lambda (headline) + (when (or (string= (org-element-property :ID headline) id) + (string= (org-element-property :CUSTOM_ID headline) id)) + headline)) + info 'first-match) + ;; Otherwise, look for external files. + (cdr (assoc id (plist-get info :id-alist)))))) + +(defun org-export-resolve-radio-link (link info) + "Return radio-target object referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be a radio-target object or nil. Assume LINK +has type \"radio\"." + (let ((path (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :path link)))) + (org-element-map (plist-get info :parse-tree) 'radio-target + (lambda (radio) + (and (eq (compare-strings + (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :value radio)) + nil nil path nil nil t) + t) + radio)) + info 'first-match))) + + +;;;; For References +;; +;; `org-export-get-ordinal' associates a sequence number to any object +;; or element. + +(defun org-export-get-ordinal (element info &optional types predicate) + "Return ordinal number of an element or object. + +ELEMENT is the element or object considered. INFO is the plist +used as a communication channel. + +Optional argument TYPES, when non-nil, is a list of element or +object types, as symbols, that should also be counted in. +Otherwise, only provided element's type is considered. + +Optional argument PREDICATE is a function returning a non-nil +value if the current element or object should be counted in. It +accepts two arguments: the element or object being considered and +the plist used as a communication channel. This allows to count +only a certain type of objects (i.e. inline images). + +Return value is a list of numbers if ELEMENT is a headline or an +item. It is nil for keywords. It represents the footnote number +for footnote definitions and footnote references. If ELEMENT is +a target, return the same value as if ELEMENT was the closest +table, item or headline containing the target. In any other +case, return the sequence number of ELEMENT among elements or +objects of the same type." + ;; Ordinal of a target object refer to the ordinal of the closest + ;; table, item, or headline containing the object. + (when (eq (org-element-type element) 'target) + (setq element + (loop for parent in (org-export-get-genealogy element) + when + (memq + (org-element-type parent) + '(footnote-definition footnote-reference headline item + table)) + return parent))) + (case (org-element-type element) + ;; Special case 1: A headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote-definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map (plist-get info :parse-tree) + (or types (org-element-type element)) + (lambda (el) + (cond + ((eq element el) (1+ counter)) + ((not predicate) (incf counter) nil) + ((funcall predicate el info) (incf counter) nil))) + info 'first-match))))) + + +;;;; For Src-Blocks +;; +;; `org-export-get-loc' counts number of code lines accumulated in +;; src-block or example-block elements with a "+n" switch until +;; a given element, excluded. Note: "-n" switches reset that count. +;; +;; `org-export-unravel-code' extracts source code (along with a code +;; references alist) from an `element-block' or `src-block' type +;; element. +;; +;; `org-export-format-code' applies a formatting function to each line +;; of code, providing relative line number and code reference when +;; appropriate. Since it doesn't access the original element from +;; which the source code is coming, it expects from the code calling +;; it to know if lines should be numbered and if code references +;; should appear. +;; +;; Eventually, `org-export-format-code-default' is a higher-level +;; function (it makes use of the two previous functions) which handles +;; line numbering and code references inclusion, and returns source +;; code in a format suitable for plain text or verbatim output. + +(defun org-export-get-loc (element info) + "Return accumulated lines of code up to ELEMENT. + +INFO is the plist used as a communication channel. + +ELEMENT is excluded from count." + (let ((loc 0)) + (org-element-map (plist-get info :parse-tree) + `(src-block example-block ,(org-element-type element)) + (lambda (el) + (cond + ;; ELEMENT is reached: Quit the loop. + ((eq el element)) + ;; Only count lines from src-block and example-block elements + ;; with a "+n" or "-n" switch. A "-n" switch resets counter. + ((not (memq (org-element-type el) '(src-block example-block))) nil) + ((let ((linums (org-element-property :number-lines el))) + (when linums + ;; Accumulate locs or reset them. + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + (setq loc (if (eq linums 'new) lines (+ loc lines)))))) + ;; Return nil to stay in the loop. + nil))) + info 'first-match) + ;; Return value. + loc)) + +(defun org-export-unravel-code (element) + "Clean source code and extract references out of it. + +ELEMENT has either a `src-block' an `example-block' type. + +Return a cons cell whose CAR is the source code, cleaned from any +reference and protective comma and CDR is an alist between +relative line number (integer) and name of code reference on that +line (string)." + (let* ((line 0) refs + ;; Get code and clean it. Remove blank lines at its + ;; beginning and end. + (code (replace-regexp-in-string + "\\`\\([ \t]*\n\\)+" "" + (replace-regexp-in-string + "\\([ \t]*\n\\)*[ \t]*\\'" "\n" + (org-element-property :value element)))) + ;; Get format used for references. + (label-fmt (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format))) + ;; Build a regexp matching a loc with a reference. + (with-ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + ;; Return value. + (cons + ;; Code with references removed. + (org-element-normalize-string + (mapconcat + (lambda (loc) + (incf line) + (if (not (string-match with-ref-re loc)) loc + ;; Ref line: remove ref, and signal its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (org-split-string code "\n") "\n")) + ;; Reference alist. + refs))) + +(defun org-export-format-code (code fun &optional num-lines ref-alist) + "Format CODE by applying FUN line-wise and return it. + +CODE is a string representing the code to format. FUN is +a function. It must accept three arguments: a line of +code (string), the current line number (integer) or nil and the +reference associated to the current line (string) or nil. + +Optional argument NUM-LINES can be an integer representing the +number of code lines accumulated until the current code. Line +numbers passed to FUN will take it into account. If it is nil, +FUN's second argument will always be nil. This number can be +obtained with `org-export-get-loc' function. + +Optional argument REF-ALIST can be an alist between relative line +number (i.e. ignoring NUM-LINES) and the name of the code +reference on it. If it is nil, FUN's third argument will always +be nil. It can be obtained through the use of +`org-export-unravel-code' function." + (let ((--locs (org-split-string code "\n")) + (--line 0)) + (org-element-normalize-string + (mapconcat + (lambda (--loc) + (incf --line) + (let ((--ref (cdr (assq --line ref-alist)))) + (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) + --locs "\n")))) + +(defun org-export-format-code-default (element info) + "Return source code from ELEMENT, formatted in a standard way. + +ELEMENT is either a `src-block' or `example-block' element. INFO +is a plist used as a communication channel. + +This function takes care of line numbering and code references +inclusion. Line numbers, when applicable, appear at the +beginning of the line, separated from the code by two white +spaces. Code references, on the other hand, appear flushed to +the right, separated by six white spaces from the widest line of +code." + ;; Extract code and references. + (let* ((code-info (org-export-unravel-code element)) + (code (car code-info)) + (code-lines (org-split-string code "\n"))) + (if (null code-lines) "" + (let* ((refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0))) + (num-fmt + (and num-start + (format "%%%ds " + (length (number-to-string + (+ (length code-lines) num-start)))))) + ;; Prepare references display, if required. Any reference + ;; should start six columns after the widest line of code, + ;; wrapped with parenthesis. + (max-width + (+ (apply 'max (mapcar 'length code-lines)) + (if (not num-start) 0 (length (format num-fmt num-start)))))) + (org-export-format-code + code + (lambda (loc line-num ref) + (let ((number-str (and num-fmt (format num-fmt line-num)))) + (concat + number-str + loc + (and ref + (concat (make-string + (- (+ 6 max-width) + (+ (length loc) (length number-str))) ? ) + (format "(%s)" ref)))))) + num-start refs))))) + + +;;;; For Tables +;; +;; `org-export-table-has-special-column-p' and and +;; `org-export-table-row-is-special-p' are predicates used to look for +;; meta-information about the table structure. +;; +;; `org-table-has-header-p' tells when the rows before the first rule +;; should be considered as table's header. +;; +;; `org-export-table-cell-width', `org-export-table-cell-alignment' +;; and `org-export-table-cell-borders' extract information from +;; a table-cell element. +;; +;; `org-export-table-dimensions' gives the number on rows and columns +;; in the table, ignoring horizontal rules and special columns. +;; `org-export-table-cell-address', given a table-cell object, returns +;; the absolute address of a cell. On the other hand, +;; `org-export-get-table-cell-at' does the contrary. +;; +;; `org-export-table-cell-starts-colgroup-p', +;; `org-export-table-cell-ends-colgroup-p', +;; `org-export-table-row-starts-rowgroup-p', +;; `org-export-table-row-ends-rowgroup-p', +;; `org-export-table-row-starts-header-p' and +;; `org-export-table-row-ends-header-p' indicate position of current +;; row or cell within the table. + +(defun org-export-table-has-special-column-p (table) + "Non-nil when TABLE has a special column. +All special columns will be ignored during export." + ;; The table has a special column when every first cell of every row + ;; has an empty value or contains a symbol among "/", "#", "!", "$", + ;; "*" "_" and "^". Though, do not consider a first row containing + ;; only empty cells as special. + (let ((special-column-p 'empty)) + (catch 'exit + (mapc + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column-p 'special)) + ((not value)) + (t (throw 'exit nil)))))) + (org-element-contents table)) + (eq special-column-p 'special)))) + +(defun org-export-table-has-header-p (table info) + "Non-nil when TABLE has a header. + +INFO is a plist used as a communication channel. + +A table has a header when it contains at least two row groups." + (let ((cache (or (plist-get info :table-header-cache) + (plist-get (setq info + (plist-put info :table-header-cache + (make-hash-table :test 'eq))) + :table-header-cache)))) + (or (gethash table cache) + (let ((rowgroup 1) row-flag) + (puthash + table + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag (eq (org-element-property :type row) 'rule)) + (incf rowgroup) (setq row-flag nil)) + ((and (not row-flag) (eq (org-element-property :type row) + 'standard)) + (setq row-flag t) nil))) + info 'first-match) + cache))))) + +(defun org-export-table-row-is-special-p (table-row info) + "Non-nil if TABLE-ROW is considered special. + +INFO is a plist used as the communication channel. + +All special rows will be ignored during export." + (when (eq (org-element-property :type table-row) 'standard) + (let ((first-cell (org-element-contents + (car (org-element-contents table-row))))) + ;; A row is special either when... + (or + ;; ... it starts with a field only containing "/", + (equal first-cell '("/")) + ;; ... the table contains a special column and the row start + ;; with a marking character among, "^", "_", "$" or "!", + (and (org-export-table-has-special-column-p + (org-export-get-parent table-row)) + (member first-cell '(("^") ("_") ("$") ("!")))) + ;; ... it contains only alignment cookies and empty cells. + (let ((special-row-p 'empty)) + (catch 'exit + (mapc + (lambda (cell) + (let ((value (org-element-contents cell))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid expanding it with `org-export-data'. + (cond ((not value)) + ((and (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" + (car value))) + (setq special-row-p 'cookie)) + (t (throw 'exit nil))))) + (org-element-contents table-row)) + (eq special-row-p 'cookie))))))) + +(defun org-export-table-row-group (table-row info) + "Return TABLE-ROW's group number, as an integer. + +INFO is a plist used as the communication channel. + +Return value is the group number, as an integer, or nil for +special rows and rows separators. First group is also table's +header." + (let ((cache (or (plist-get info :table-row-group-cache) + (plist-get (setq info + (plist-put info :table-row-group-cache + (make-hash-table :test 'eq))) + :table-row-group-cache)))) + (cond ((gethash table-row cache)) + ((eq (org-element-property :type table-row) 'rule) nil) + (t (let ((group 0) row-flag) + (org-element-map (org-export-get-parent table-row) 'table-row + (lambda (row) + (if (eq (org-element-property :type row) 'rule) + (setq row-flag nil) + (unless row-flag (incf group) (setq row-flag t))) + (when (eq table-row row) (puthash table-row group cache))) + info 'first-match)))))) + +(defun org-export-table-cell-width (table-cell info) + "Return TABLE-CELL contents width. + +INFO is a plist used as the communication channel. + +Return value is the width given by the last width cookie in the +same column as TABLE-CELL, or nil." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-width-cache) + (plist-get (setq info + (plist-put info :table-cell-width-cache + (make-hash-table :test 'eq))) + :table-cell-width-cache))) + (width-vector (or (gethash table cache) + (puthash table (make-vector columns 'empty) cache))) + (value (aref width-vector column))) + (if (not (eq value 'empty)) value + (let (cookie-width) + (dolist (row (org-element-contents table) + (aset width-vector column cookie-width)) + (when (org-export-table-row-is-special-p row info) + ;; In a special row, try to find a width cookie at COLUMN. + (let* ((value (org-element-contents + (elt (org-element-contents row) column))) + (cookie (car value))) + ;; The following checks avoid expanding unnecessarily + ;; the cell with `org-export-data'. + (when (and value + (not (cdr value)) + (stringp cookie) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie) + (match-string 1 cookie)) + (setq cookie-width + (string-to-number (match-string 1 cookie))))))))))) + +(defun org-export-table-cell-alignment (table-cell info) + "Return TABLE-CELL contents alignment. + +INFO is a plist used as the communication channel. + +Return alignment as specified by the last alignment cookie in the +same column as TABLE-CELL. If no such cookie is found, a default +alignment value will be deduced from fraction of numbers in the +column (see `org-table-number-fraction' for more information). +Possible values are `left', `right' and `center'." + ;; Load `org-table-number-fraction' and `org-table-number-regexp'. + (require 'org-table) + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-alignment-cache) + (plist-get (setq info + (plist-put info :table-cell-alignment-cache + (make-hash-table :test 'eq))) + :table-cell-alignment-cache))) + (align-vector (or (gethash table cache) + (puthash table (make-vector columns nil) cache)))) + (or (aref align-vector column) + (let ((number-cells 0) + (total-cells 0) + cookie-align + previous-cell-number-p) + (dolist (row (org-element-contents (org-export-get-parent row))) + (cond + ;; In a special row, try to find an alignment cookie at + ;; COLUMN. + ((org-export-table-row-is-special-p row info) + (let ((value (org-element-contents + (elt (org-element-contents row) column)))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid useless expansion through + ;; `org-export-data'. + (when (and value + (not (cdr value)) + (stringp (car value)) + (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" + (car value)) + (match-string 1 (car value))) + (setq cookie-align (match-string 1 (car value)))))) + ;; Ignore table rules. + ((eq (org-element-property :type row) 'rule)) + ;; In a standard row, check if cell's contents are + ;; expressing some kind of number. Increase NUMBER-CELLS + ;; accordingly. Though, don't bother if an alignment + ;; cookie has already defined cell's alignment. + ((not cookie-align) + (let ((value (org-export-data + (org-element-contents + (elt (org-element-contents row) column)) + info))) + (incf total-cells) + ;; Treat an empty cell as a number if it follows + ;; a number. + (if (not (or (string-match org-table-number-regexp value) + (and (string= value "") previous-cell-number-p))) + (setq previous-cell-number-p nil) + (setq previous-cell-number-p t) + (incf number-cells)))))) + ;; Return value. Alignment specified by cookies has + ;; precedence over alignment deduced from cell's contents. + (aset align-vector + column + (cond ((equal cookie-align "l") 'left) + ((equal cookie-align "r") 'right) + ((equal cookie-align "c") 'center) + ((>= (/ (float number-cells) total-cells) + org-table-number-fraction) + 'right) + (t 'left))))))) + +(defun org-export-table-cell-borders (table-cell info) + "Return TABLE-CELL borders. + +INFO is a plist used as a communication channel. + +Return value is a list of symbols, or nil. Possible values are: +`top', `bottom', `above', `below', `left' and `right'. Note: +`top' (resp. `bottom') only happen for a cell in the first +row (resp. last row) of the table, ignoring table rules, if any. + +Returned borders ignore special rows." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + borders) + ;; Top/above border? TABLE-CELL has a border above when a rule + ;; used to demarcate row groups can be found above. Hence, + ;; finding a rule isn't sufficient to push `above' in BORDERS: + ;; another regular row has to be found above that rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'above borders)) + (throw 'exit nil))))) + ;; Look at every row before the current one. + (cdr (memq row (reverse (org-element-contents table))))) + ;; No rule above, or rule found starts the table (ignoring any + ;; special row): TABLE-CELL is at the top of the table. + (when rule-flag (push 'above borders)) + (push 'top borders))) + ;; Bottom/below border? TABLE-CELL has a border below when next + ;; non-regular row below is a rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'below borders)) + (throw 'exit nil))))) + ;; Look at every row after the current one. + (cdr (memq row (org-element-contents table)))) + ;; No rule below, or rule found ends the table (modulo some + ;; special row): TABLE-CELL is at the bottom of the table. + (when rule-flag (push 'below borders)) + (push 'bottom borders))) + ;; Right/left borders? They can only be specified by column + ;; groups. Column groups are defined in a row starting with "/". + ;; Also a column groups row only contains "<", "<>", ">" or blank + ;; cells. + (catch 'exit + (let ((column (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells)))))) + (mapc + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) + (when (equal (org-element-contents + (car (org-element-contents row))) + '("/")) + (let ((column-groups + (mapcar + (lambda (cell) + (let ((value (org-element-contents cell))) + (when (member value '(("<") ("<>") (">") nil)) + (car value)))) + (org-element-contents row)))) + ;; There's a left border when previous cell, if + ;; any, ends a group, or current one starts one. + (when (or (and (not (zerop column)) + (member (elt column-groups (1- column)) + '(">" "<>"))) + (member (elt column-groups column) '("<" "<>"))) + (push 'left borders)) + ;; There's a right border when next cell, if any, + ;; starts a group, or current one ends one. + (when (or (and (/= (1+ column) (length column-groups)) + (member (elt column-groups (1+ column)) + '("<" "<>"))) + (member (elt column-groups column) '(">" "<>"))) + (push 'right borders)) + (throw 'exit nil))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (reverse (org-element-contents table))))) + ;; Return value. + borders)) + +(defun org-export-table-cell-starts-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the beginning of a row group. +INFO is a plist used as a communication channel." + ;; A cell starts a column group either when it is at the beginning + ;; of a row (or after the special column, if any) or when it has + ;; a left border. + (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell + 'identity info 'first-match) + table-cell) + (memq 'left (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-cell-ends-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the end of a row group. +INFO is a plist used as a communication channel." + ;; A cell ends a column group either when it is at the end of a row + ;; or when it has a right border. + (or (eq (car (last (org-element-contents + (org-export-get-parent table-cell)))) + table-cell) + (memq 'right (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-row-starts-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the beginning of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'top borders) (memq 'above borders))))) + +(defun org-export-table-row-ends-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the end of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'bottom borders) (memq 'below borders))))) + +(defun org-export-table-row-starts-header-p (table-row info) + "Non-nil when TABLE-ROW is the first table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-starts-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-row-ends-header-p (table-row info) + "Non-nil when TABLE-ROW is the last table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-ends-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-row-number (table-row info) + "Return TABLE-ROW number. +INFO is a plist used as a communication channel. Return value is +zero-based and ignores separators. The function returns nil for +special columns and separators." + (when (and (eq (org-element-property :type table-row) 'standard) + (not (org-export-table-row-is-special-p table-row info))) + (let ((number 0)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (cond ((eq row table-row) number) + ((eq (org-element-property :type row) 'standard) + (incf number) nil))) + info 'first-match)))) + +(defun org-export-table-dimensions (table info) + "Return TABLE dimensions. + +INFO is a plist used as a communication channel. + +Return value is a CONS like (ROWS . COLUMNS) where +ROWS (resp. COLUMNS) is the number of exportable +rows (resp. columns)." + (let (first-row (columns 0) (rows 0)) + ;; Set number of rows, and extract first one. + (org-element-map table 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (incf rows) + (unless first-row (setq first-row row)))) info) + ;; Set number of columns. + (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) + ;; Return value. + (cons rows columns))) + +(defun org-export-table-cell-address (table-cell info) + "Return address of a regular TABLE-CELL object. + +TABLE-CELL is the cell considered. INFO is a plist used as +a communication channel. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. Only exportable cells are considered. The +function returns nil for other cells." + (let* ((table-row (org-export-get-parent table-cell)) + (row-number (org-export-table-row-number table-row info))) + (when row-number + (cons row-number + (let ((col-count 0)) + (org-element-map table-row 'table-cell + (lambda (cell) + (if (eq cell table-cell) col-count (incf col-count) nil)) + info 'first-match)))))) + +(defun org-export-get-table-cell-at (address table info) + "Return regular table-cell object at ADDRESS in TABLE. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. TABLE is a table type element. INFO is +a plist used as a communication channel. + +If no table-cell, among exportable cells, is found at ADDRESS, +return nil." + (let ((column-pos (cdr address)) (column-count 0)) + (org-element-map + ;; Row at (car address) or nil. + (let ((row-pos (car address)) (row-count 0)) + (org-element-map table 'table-row + (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) nil) + ((= row-count row-pos) row) + (t (incf row-count) nil))) + info 'first-match)) + 'table-cell + (lambda (cell) + (if (= column-count column-pos) cell + (incf column-count) nil)) + info 'first-match))) + + +;;;; For Tables Of Contents +;; +;; `org-export-collect-headlines' builds a list of all exportable +;; headline elements, maybe limited to a certain depth. One can then +;; easily parse it and transcode it. +;; +;; Building lists of tables, figures or listings is quite similar. +;; Once the generic function `org-export-collect-elements' is defined, +;; `org-export-collect-tables', `org-export-collect-figures' and +;; `org-export-collect-listings' can be derived from it. + +(defun org-export-collect-headlines (info &optional n) + "Collect headlines in order to build a table of contents. + +INFO is a plist used as a communication channel. + +When optional argument N is an integer, it specifies the depth of +the table of contents. Otherwise, it is set to the value of the +last headline level. See `org-export-headline-levels' for more +information. + +Return a list of all exportable headlines as parsed elements. +Footnote sections, if any, will be ignored." + (let ((limit (plist-get info :headline-levels))) + (setq n (if (wholenump n) (min n limit) limit)) + (org-element-map (plist-get info :parse-tree) 'headline + #'(lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((level (org-export-get-relative-level headline info))) + (and (<= level n) headline)))) + info))) + +(defun org-export-collect-elements (type info &optional predicate) + "Collect referenceable elements of a determined type. + +TYPE can be a symbol or a list of symbols specifying element +types to search. Only elements with a caption are collected. + +INFO is a plist used as a communication channel. + +When non-nil, optional argument PREDICATE is a function accepting +one argument, an element of type TYPE. It returns a non-nil +value when that element should be collected. + +Return a list of all elements found, in order of appearance." + (org-element-map (plist-get info :parse-tree) type + (lambda (element) + (and (org-element-property :caption element) + (or (not predicate) (funcall predicate element)) + element)) + info)) + +(defun org-export-collect-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. + +Return a list of table elements with a caption." + (org-export-collect-elements 'table info)) + +(defun org-export-collect-figures (info predicate) + "Build a list of figures. + +INFO is a plist used as a communication channel. PREDICATE is +a function which accepts one argument: a paragraph element and +whose return value is non-nil when that element should be +collected. + +A figure is a paragraph type element, with a caption, verifying +PREDICATE. The latter has to be provided since a \"figure\" is +a vague concept that may depend on back-end. + +Return a list of elements recognized as figures." + (org-export-collect-elements 'paragraph info predicate)) + +(defun org-export-collect-listings (info) + "Build a list of src blocks. + +INFO is a plist used as a communication channel. + +Return a list of src-block elements with a caption." + (org-export-collect-elements 'src-block info)) + + +;;;; Smart Quotes +;; +;; The main function for the smart quotes sub-system is +;; `org-export-activate-smart-quotes', which replaces every quote in +;; a given string from the parse tree with its "smart" counterpart. +;; +;; Dictionary for smart quotes is stored in +;; `org-export-smart-quotes-alist'. +;; +;; Internally, regexps matching potential smart quotes (checks at +;; string boundaries are also necessary) are defined in +;; `org-export-smart-quotes-regexps'. + +(defconst org-export-smart-quotes-alist + '(("da" + ;; one may use: »...«, "...", ›...‹, or '...'. + ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; LaTeX quotes require Babel! + (opening-double-quote :utf-8 "»" :html "»" :latex ">>" + :texinfo "@guillemetright{}") + (closing-double-quote :utf-8 "«" :html "«" :latex "<<" + :texinfo "@guillemetleft{}") + (opening-single-quote :utf-8 "›" :html "›" :latex "\\frq{}" + :texinfo "@guilsinglright{}") + (closing-single-quote :utf-8 "‹" :html "‹" :latex "\\flq{}" + :texinfo "@guilsingleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("de" + (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" + :texinfo "@quotedblbase{}") + (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" + :texinfo "@quotedblleft{}") + (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}" + :texinfo "@quotesinglbase{}") + (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}" + :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("en" + (opening-double-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (closing-double-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("es" + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (closing-single-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (apostrophe :utf-8 "’" :html "’")) + ("fr" + (opening-double-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (opening-single-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (apostrophe :utf-8 "’" :html "’")) + ("no" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nb" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nn" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("sv" + ;; based on https://sv.wikipedia.org/wiki/Citattecken + (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (closing-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (opening-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ) + "Smart quotes translations. + +Alist whose CAR is a language string and CDR is an alist with +quote type as key and a plist associating various encodings to +their translation as value. + +A quote type can be any symbol among `opening-double-quote', +`closing-double-quote', `opening-single-quote', +`closing-single-quote' and `apostrophe'. + +Valid encodings include `:utf-8', `:html', `:latex' and +`:texinfo'. + +If no translation is found, the quote character is left as-is.") + +(defconst org-export-smart-quotes-regexps + (list + ;; Possible opening quote at beginning of string. + "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\|\\s(\\)" + ;; Possible closing quote at beginning of string. + "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)" + ;; Possible apostrophe at beginning of string. + "\\`\\('\\)\\S-" + ;; Opening single and double quotes. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)" + ;; Closing single and double quotes. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)" + ;; Apostrophe. + "\\S-\\('\\)\\S-" + ;; Possible opening quote at end of string. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'" + ;; Possible closing quote at end of string. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'" + ;; Possible apostrophe at end of string. + "\\S-\\('\\)\\'") + "List of regexps matching a quote or an apostrophe. +In every regexp, quote or apostrophe matched is put in group 1.") + +(defun org-export-activate-smart-quotes (s encoding info &optional original) + "Replace regular quotes with \"smart\" quotes in string S. + +ENCODING is a symbol among `:html', `:latex', `:texinfo' and +`:utf-8'. INFO is a plist used as a communication channel. + +The function has to retrieve information about string +surroundings in parse tree. It can only happen with an +unmodified string. Thus, if S has already been through another +process, a non-nil ORIGINAL optional argument will provide that +original string. + +Return the new string." + (if (equal s "") "" + (let* ((prev (org-export-get-previous-element (or original s) info)) + ;; Try to be flexible when computing number of blanks + ;; before object. The previous object may be a string + ;; introduced by the back-end and not completely parsed. + (pre-blank (and prev + (or (org-element-property :post-blank prev) + ;; A string with missing `:post-blank' + ;; property. + (and (stringp prev) + (string-match " *\\'" prev) + (length (match-string 0 prev))) + ;; Fallback value. + 0))) + (next (org-export-get-next-element (or original s) info)) + (get-smart-quote + (lambda (q type) + ;; Return smart quote associated to a give quote Q, as + ;; a string. TYPE is a symbol among `open', `close' and + ;; `apostrophe'. + (let ((key (case type + (apostrophe 'apostrophe) + (open (if (equal "'" q) 'opening-single-quote + 'opening-double-quote)) + (otherwise (if (equal "'" q) 'closing-single-quote + 'closing-double-quote))))) + (or (plist-get + (cdr (assq key + (cdr (assoc (plist-get info :language) + org-export-smart-quotes-alist)))) + encoding) + q))))) + (if (or (equal "\"" s) (equal "'" s)) + ;; Only a quote: no regexp can match. We have to check both + ;; sides and decide what to do. + (cond ((and (not prev) (not next)) s) + ((not prev) (funcall get-smart-quote s 'open)) + ((and (not next) (zerop pre-blank)) + (funcall get-smart-quote s 'close)) + ((not next) s) + ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe)) + (t (funcall get-smart-quote 'open))) + ;; 1. Replace quote character at the beginning of S. + (cond + ;; Apostrophe? + ((and prev (zerop pre-blank) + (string-match (nth 2 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and prev (zerop pre-blank) + (string-match (nth 1 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and (or (not prev) (> pre-blank 0)) + (string-match (nth 0 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; 2. Replace quotes in the middle of the string. + (setq s (replace-regexp-in-string + ;; Opening quotes. + (nth 3 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'open)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Closing quotes. + (nth 4 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'close)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Apostrophes. + (nth 5 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'apostrophe)) + s nil t 1)) + ;; 3. Replace quote character at the end of S. + (cond + ;; Apostrophe? + ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and (not next) + (string-match (nth 7 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; Return string with smart quotes. + s)))) + +;;;; Topology +;; +;; Here are various functions to retrieve information about the +;; neighborhood of a given element or object. Neighbors of interest +;; are direct parent (`org-export-get-parent'), parent headline +;; (`org-export-get-parent-headline'), first element containing an +;; object, (`org-export-get-parent-element'), parent table +;; (`org-export-get-parent-table'), previous element or object +;; (`org-export-get-previous-element') and next element or object +;; (`org-export-get-next-element'). +;; +;; `org-export-get-genealogy' returns the full genealogy of a given +;; element or object, from closest parent to full parse tree. + +(defsubst org-export-get-parent (blob) + "Return BLOB parent or nil. +BLOB is the element or object considered." + (org-element-property :parent blob)) + +(defun org-export-get-genealogy (blob) + "Return full genealogy relative to a given element or object. + +BLOB is the element or object being considered. + +Ancestors are returned from closest to farthest, the last one +being the full parse tree." + (let (genealogy (parent blob)) + (while (setq parent (org-element-property :parent parent)) + (push parent genealogy)) + (nreverse genealogy))) + +(defun org-export-get-parent-headline (blob) + "Return BLOB parent headline or nil. +BLOB is the element or object being considered." + (let ((parent blob)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'headline)))) + parent)) + +(defun org-export-get-parent-element (object) + "Return first element containing OBJECT or nil. +OBJECT is the object to consider." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (memq (org-element-type parent) org-element-all-objects))) + parent)) + +(defun org-export-get-parent-table (object) + "Return OBJECT parent table or nil. +OBJECT is either a `table-cell' or `table-element' type object." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'table)))) + parent)) + +(defun org-export-get-previous-element (blob info &optional n) + "Return previous element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return previous exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings before BLOB, from farthest to +closest. With any other non-nil value, return a list containing +all of them." + (let ((siblings + ;; An object can belong to the contents of its parent or + ;; to a secondary string. We check the latter option + ;; first. + (let ((parent (org-export-get-parent blob))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (and (memq blob sec-value) sec-value)) + (org-element-contents parent)))) + prev) + (catch 'exit + (mapc (lambda (obj) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj prev)) + ((zerop n) (throw 'exit prev)) + (t (decf n) (push obj prev)))) + (cdr (memq blob (reverse siblings)))) + prev))) + +(defun org-export-get-next-element (blob info &optional n) + "Return next element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return next exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings after BLOB, from closest to farthest. +With any other non-nil value, return a list containing all of +them." + (let ((siblings + ;; An object can belong to the contents of its parent or to + ;; a secondary string. We check the latter option first. + (let ((parent (org-export-get-parent blob))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (cdr (memq blob sec-value))) + (cdr (memq blob (org-element-contents parent)))))) + next) + (catch 'exit + (mapc (lambda (obj) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj next)) + ((zerop n) (throw 'exit (nreverse next))) + (t (decf n) (push obj next)))) + siblings) + (nreverse next)))) + + +;;;; Translation +;; +;; `org-export-translate' translates a string according to the language +;; specified by the LANGUAGE keyword. `org-export-dictionary' contains +;; the dictionary used for the translation. + +(defconst org-export-dictionary + '(("%e %n: %c" + ("fr" :default "%e %n : %c" :html "%e %n : %c")) + ("Author" + ("ca" :default "Autor") + ("cs" :default "Autor") + ("da" :default "Forfatter") + ("de" :default "Autor") + ("eo" :html "Aŭtoro") + ("es" :default "Autor") + ("fi" :html "Tekijä") + ("fr" :default "Auteur") + ("hu" :default "Szerzõ") + ("is" :html "Höfundur") + ("it" :default "Autore") + ("ja" :html "著者" :utf-8 "著者") + ("nl" :default "Auteur") + ("no" :default "Forfatter") + ("nb" :default "Forfatter") + ("nn" :default "Forfattar") + ("pl" :default "Autor") + ("ru" :html "Автор" :utf-8 "Автор") + ("sv" :html "Författare") + ("uk" :html "Автор" :utf-8 "Автор") + ("zh-CN" :html "作者" :utf-8 "作者") + ("zh-TW" :html "作者" :utf-8 "作者")) + ("Date" + ("ca" :default "Data") + ("cs" :default "Datum") + ("da" :default "Dato") + ("de" :default "Datum") + ("eo" :default "Dato") + ("es" :default "Fecha") + ("fi" :html "Päivämäärä") + ("hu" :html "Dátum") + ("is" :default "Dagsetning") + ("it" :default "Data") + ("ja" :html "日付" :utf-8 "日付") + ("nl" :default "Datum") + ("no" :default "Dato") + ("nb" :default "Dato") + ("nn" :default "Dato") + ("pl" :default "Data") + ("ru" :html "Дата" :utf-8 "Дата") + ("sv" :default "Datum") + ("uk" :html "Дата" :utf-8 "Дата") + ("zh-CN" :html "日期" :utf-8 "日期") + ("zh-TW" :html "日期" :utf-8 "日期")) + ("Equation" + ("da" :default "Ligning") + ("de" :default "Gleichung") + ("es" :html "Ecuación" :default "Ecuación") + ("fr" :ascii "Equation" :default "Équation") + ("no" :default "Ligning") + ("nb" :default "Ligning") + ("nn" :default "Likning") + ("sv" :default "Ekvation") + ("zh-CN" :html "方程" :utf-8 "方程")) + ("Figure" + ("da" :default "Figur") + ("de" :default "Abbildung") + ("es" :default "Figura") + ("ja" :html "図" :utf-8 "図") + ("no" :default "Illustrasjon") + ("nb" :default "Illustrasjon") + ("nn" :default "Illustrasjon") + ("sv" :default "Illustration") + ("zh-CN" :html "图" :utf-8 "图")) + ("Figure %d:" + ("da" :default "Figur %d") + ("de" :default "Abbildung %d:") + ("es" :default "Figura %d:") + ("fr" :default "Figure %d :" :html "Figure %d :") + ("ja" :html "図%d: " :utf-8 "図%d: ") + ("no" :default "Illustrasjon %d") + ("nb" :default "Illustrasjon %d") + ("nn" :default "Illustrasjon %d") + ("sv" :default "Illustration %d") + ("zh-CN" :html "图%d " :utf-8 "图%d ")) + ("Footnotes" + ("ca" :html "Peus de pàgina") + ("cs" :default "Pozn\xe1mky pod carou") + ("da" :default "Fodnoter") + ("de" :html "Fußnoten" :default "Fußnoten") + ("eo" :default "Piednotoj") + ("es" :html "Nota al pie de página" :default "Nota al pie de página") + ("fi" :default "Alaviitteet") + ("fr" :default "Notes de bas de page") + ("hu" :html "Lábjegyzet") + ("is" :html "Aftanmálsgreinar") + ("it" :html "Note a piè di pagina") + ("ja" :html "脚注" :utf-8 "脚注") + ("nl" :default "Voetnoten") + ("no" :default "Fotnoter") + ("nb" :default "Fotnoter") + ("nn" :default "Fotnotar") + ("pl" :default "Przypis") + ("ru" :html "Сноски" :utf-8 "Сноски") + ("sv" :default "Fotnoter") + ("uk" :html "Примітки" + :utf-8 "Примітки") + ("zh-CN" :html "脚注" :utf-8 "脚注") + ("zh-TW" :html "腳註" :utf-8 "腳註")) + ("List of Listings" + ("da" :default "Programmer") + ("de" :default "Programmauflistungsverzeichnis") + ("es" :default "Indice de Listados de programas") + ("fr" :default "Liste des programmes") + ("no" :default "Dataprogrammer") + ("nb" :default "Dataprogrammer") + ("zh-CN" :html "代码目录" :utf-8 "代码目录")) + ("List of Tables" + ("da" :default "Tabeller") + ("de" :default "Tabellenverzeichnis") + ("es" :default "Indice de tablas") + ("fr" :default "Liste des tableaux") + ("no" :default "Tabeller") + ("nb" :default "Tabeller") + ("nn" :default "Tabeller") + ("sv" :default "Tabeller") + ("zh-CN" :html "表格目录" :utf-8 "表格目录")) + ("Listing %d:" + ("da" :default "Program %d") + ("de" :default "Programmlisting %d") + ("es" :default "Listado de programa %d") + ("fr" :default "Programme %d :" :html "Programme %d :") + ("no" :default "Dataprogram") + ("nb" :default "Dataprogram") + ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) + ("See section %s" + ("da" :default "jævnfør afsnit %s") + ("de" :default "siehe Abschnitt %s") + ("es" :default "vea seccion %s") + ("fr" :default "cf. section %s") + ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) + ("Table" + ("de" :default "Tabelle") + ("es" :default "Tabla") + ("fr" :default "Tableau") + ("ja" :html "表" :utf-8 "表") + ("zh-CN" :html "表" :utf-8 "表")) + ("Table %d:" + ("da" :default "Tabel %d") + ("de" :default "Tabelle %d") + ("es" :default "Tabla %d") + ("fr" :default "Tableau %d :") + ("ja" :html "表%d:" :utf-8 "表%d:") + ("no" :default "Tabell %d") + ("nb" :default "Tabell %d") + ("nn" :default "Tabell %d") + ("sv" :default "Tabell %d") + ("zh-CN" :html "表%d " :utf-8 "表%d ")) + ("Table of Contents" + ("ca" :html "Índex") + ("cs" :default "Obsah") + ("da" :default "Indhold") + ("de" :default "Inhaltsverzeichnis") + ("eo" :default "Enhavo") + ("es" :html "Índice") + ("fi" :html "Sisällysluettelo") + ("fr" :ascii "Sommaire" :default "Table des matières") + ("hu" :html "Tartalomjegyzék") + ("is" :default "Efnisyfirlit") + ("it" :default "Indice") + ("ja" :html "目次" :utf-8 "目次") + ("nl" :default "Inhoudsopgave") + ("no" :default "Innhold") + ("nb" :default "Innhold") + ("nn" :default "Innhald") + ("pl" :html "Spis treści") + ("ru" :html "Содержание" + :utf-8 "Содержание") + ("sv" :html "Innehåll") + ("uk" :html "Зміст" :utf-8 "Зміст") + ("zh-CN" :html "目录" :utf-8 "目录") + ("zh-TW" :html "目錄" :utf-8 "目錄")) + ("Unknown reference" + ("da" :default "ukendt reference") + ("de" :default "Unbekannter Verweis") + ("es" :default "referencia desconocida") + ("fr" :ascii "Destination inconnue" :default "Référence inconnue") + ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) + "Dictionary for export engine. + +Alist whose CAR is the string to translate and CDR is an alist +whose CAR is the language string and CDR is a plist whose +properties are possible charsets and values translated terms. + +It is used as a database for `org-export-translate'. Since this +function returns the string as-is if no translation was found, +the variable only needs to record values different from the +entry.") + +(defun org-export-translate (s encoding info) + "Translate string S according to language specification. + +ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' +and `:utf-8'. INFO is a plist used as a communication channel. + +Translation depends on `:language' property. Return the +translated string. If no translation is found, try to fall back +to `:default' encoding. If it fails, return S." + (let* ((lang (plist-get info :language)) + (translations (cdr (assoc lang + (cdr (assoc s org-export-dictionary)))))) + (or (plist-get translations encoding) + (plist-get translations :default) + s))) + + + +;;; Asynchronous Export +;; +;; `org-export-async-start' is the entry point for asynchronous +;; export. It recreates current buffer (including visibility, +;; narrowing and visited file) in an external Emacs process, and +;; evaluates a command there. It then applies a function on the +;; returned results in the current process. +;; +;; At a higher level, `org-export-to-buffer' and `org-export-to-file' +;; allow to export to a buffer or a file, asynchronously or not. +;; +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. +;; +;; Asynchronously generated results are never displayed directly. +;; Instead, they are stored in `org-export-stack-contents'. They can +;; then be retrieved by calling `org-export-stack'. +;; +;; Export Stack is viewed through a dedicated major mode +;;`org-export-stack-mode' and tools: `org-export-stack-refresh', +;;`org-export-stack-delete', `org-export-stack-view' and +;;`org-export-stack-clear'. +;; +;; For back-ends, `org-export-add-to-stack' add a new source to stack. +;; It should be used whenever `org-export-async-start' is called. + +(defmacro org-export-async-start (fun &rest body) + "Call function FUN on the results returned by BODY evaluation. + +BODY evaluation happens in an asynchronous process, from a buffer +which is an exact copy of the current one. + +Use `org-export-add-to-stack' in FUN in order to register results +in the stack. + +This is a low level function. See also `org-export-to-buffer' +and `org-export-to-file' for more specialized functions." + (declare (indent 1) (debug t)) + (org-with-gensyms (process temp-file copy-fun proc-buffer coding) + ;; Write the full sexp evaluating BODY in a copy of the current + ;; buffer to a temporary file, as it may be too long for program + ;; args in `start-process'. + `(with-temp-message "Initializing asynchronous export process" + (let ((,copy-fun (org-export--generate-copy-script (current-buffer))) + (,temp-file (make-temp-file "org-export-process")) + (,coding buffer-file-coding-system)) + (with-temp-file ,temp-file + (insert + ;; Null characters (from variable values) are inserted + ;; within the file. As a consequence, coding system for + ;; buffer contents will not be recognized properly. So, + ;; we make sure it is the same as the one used to display + ;; the original buffer. + (format ";; -*- coding: %s; -*-\n%S" + ,coding + `(with-temp-buffer + (when org-export-async-debug '(setq debug-on-error t)) + ;; Ignore `kill-emacs-hook' and code evaluation + ;; queries from Babel as we need a truly + ;; non-interactive process. + (setq kill-emacs-hook nil + org-babel-confirm-evaluate-answer-no t) + ;; Initialize export framework. + (require 'ox) + ;; Re-create current buffer there. + (funcall ,,copy-fun) + (restore-buffer-modified-p nil) + ;; Sexp to evaluate in the buffer. + (print (progn ,,@body)))))) + ;; Start external process. + (let* ((process-connection-type nil) + (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) + (,process + (start-process + "org-export-process" ,proc-buffer + (expand-file-name invocation-name invocation-directory) + "-Q" "--batch" + "-l" org-export-async-init-file + "-l" ,temp-file))) + ;; Register running process in stack. + (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) + ;; Set-up sentinel in order to catch results. + (let ((handler ,fun)) + (set-process-sentinel + ,process + `(lambda (p status) + (let ((proc-buffer (process-buffer p))) + (when (eq (process-status p) 'exit) + (unwind-protect + (if (zerop (process-exit-status p)) + (unwind-protect + (let ((results + (with-current-buffer proc-buffer + (goto-char (point-max)) + (backward-sexp) + (read (current-buffer))))) + (funcall ,handler results)) + (unless org-export-async-debug + (and (get-buffer proc-buffer) + (kill-buffer proc-buffer)))) + (org-export-add-to-stack proc-buffer nil p) + (ding) + (message "Process '%s' exited abnormally" p)) + (unless org-export-async-debug + (delete-file ,,temp-file))))))))))))) + +;;;###autoload +(defun org-export-to-buffer + (backend buffer + &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + \(defun org-latex-export-as-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER." + (declare (indent 2)) + (if async + (org-export-async-start + `(lambda (output) + (with-current-buffer (get-buffer-create ,buffer) + (erase-buffer) + (setq buffer-file-coding-system ',buffer-file-coding-system) + (insert output) + (goto-char (point-min)) + (org-export-add-to-stack (current-buffer) ',backend) + (ignore-errors (funcall ,post-process)))) + `(org-export-as + ',backend ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((output + (org-export-as backend subtreep visible-only body-only ext-plist)) + (buffer (get-buffer-create buffer)) + (encoding buffer-file-coding-system)) + (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p)) + (org-kill-new output)) + (with-current-buffer buffer + (erase-buffer) + (setq buffer-file-coding-system encoding) + (insert output) + (goto-char (point-min)) + (and (functionp post-process) (funcall post-process))) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window buffer)) + buffer))) + +;;;###autoload +(defun org-export-to-file + (backend file &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer will then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + \(defun org-latex-export-to-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(let ((outfile (org-export-output-file-name \".tex\" subtreep))) + \(org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + \(lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE." + (declare (indent 2)) + (if (not (file-writable-p file)) (error "Output file not writable") + (let ((encoding (or org-export-coding-system buffer-file-coding-system))) + (if async + (org-export-async-start + `(lambda (file) + (org-export-add-to-stack (expand-file-name file) ',backend)) + `(let ((output + (org-export-as + ',backend ,subtreep ,visible-only ,body-only + ',ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write ',encoding)) + (write-file ,file))) + (or (ignore-errors (funcall ',post-process ,file)) ,file))) + (let ((output (org-export-as + backend subtreep visible-only body-only ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write encoding)) + (write-file file))) + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) + (org-kill-new output)) + ;; Get proper return value. + (or (and (functionp post-process) (funcall post-process file)) + file)))))) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return file name as a string." + (let* ((visited-file (buffer-file-name (buffer-base-buffer))) + (base-name + ;; File name may come from EXPORT_FILE_NAME subtree + ;; property, assuming point is at beginning of said + ;; sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors (org-back-to-heading) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension))))))) + (output-file + ;; Build file name. Enforce EXTENSION over whatever user + ;; may have come up with. PUB-DIR, if defined, always has + ;; precedence over any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((file-name-absolute-p base-name) (concat base-name extension)) + (t (concat (file-name-as-directory ".") base-name extension))))) + ;; If writing to OUTPUT-FILE would overwrite original file, append + ;; EXTENSION another time to final name. + (if (and visited-file (org-file-equal-p visited-file output-file)) + (concat output-file extension) + output-file))) + +(defun org-export-add-to-stack (source backend &optional process) + "Add a new result to export stack if not present already. + +SOURCE is a buffer or a file name containing export results. +BACKEND is a symbol representing export back-end used to generate +it. + +Entries already pointing to SOURCE and unavailable entries are +removed beforehand. Return the new stack." + (setq org-export-stack-contents + (cons (list source backend (or process (current-time))) + (org-export-stack-remove source)))) + +(defun org-export-stack () + "Menu for asynchronous export results and running processes." + (interactive) + (let ((buffer (get-buffer-create "*Org Export Stack*"))) + (set-buffer buffer) + (when (zerop (buffer-size)) (org-export-stack-mode)) + (org-export-stack-refresh) + (pop-to-buffer buffer)) + (message "Type \"q\" to quit, \"?\" for help")) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error "Source unavailable; type `g' to update buffer")))))) + +(defun org-export-stack-clear () + "Remove all entries from export stack." + (interactive) + (setq org-export-stack-contents nil)) + +(defun org-export-stack-refresh (&rest dummy) + "Refresh the asynchronous export stack. +DUMMY is ignored. Unavailable sources are removed from the list. +Return the new stack." + (let ((inhibit-read-only t)) + (org-preserve-lc + (erase-buffer) + (insert (concat + (let ((counter 0)) + (mapconcat + (lambda (entry) + (let ((proc-p (processp (nth 2 entry)))) + (concat + ;; Back-end. + (format " %-12s " (or (nth 1 entry) "")) + ;; Age. + (let ((data (nth 2 entry))) + (if proc-p (format " %6s " (process-status data)) + ;; Compute age of the results. + (org-format-seconds + "%4h:%.2m " + (float-time (time-since data))))) + ;; Source. + (format " %s" + (let ((source (car entry))) + (if (stringp source) source + (buffer-name source))))))) + ;; Clear stack from exited processes, dead buffers or + ;; non-existent files. + (setq org-export-stack-contents + (org-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) "\n"))))))) + +(defun org-export-stack-remove (&optional source) + "Remove export results at point from stack. +If optional argument SOURCE is non-nil, remove it instead." + (interactive) + (let ((source (or source (org-export--stack-source-at-point)))) + (setq org-export-stack-contents + (org-remove-if (lambda (el) (equal (car el) source)) + org-export-stack-contents)))) + +(defun org-export-stack-view (&optional in-emacs) + "View export results at point in stack. +With an optional prefix argument IN-EMACS, force viewing files +within Emacs." + (interactive "P") + (let ((source (org-export--stack-source-at-point))) + (cond ((processp source) + (org-switch-to-buffer-other-window (process-buffer source))) + ((bufferp source) (org-switch-to-buffer-other-window source)) + (t (org-open-file source in-emacs))))) + +(defvar org-export-stack-mode-map + (let ((km (make-sparse-keymap))) + (define-key km " " 'next-line) + (define-key km "n" 'next-line) + (define-key km "\C-n" 'next-line) + (define-key km [down] 'next-line) + (define-key km "p" 'previous-line) + (define-key km "\C-p" 'previous-line) + (define-key km "\C-?" 'previous-line) + (define-key km [up] 'previous-line) + (define-key km "C" 'org-export-stack-clear) + (define-key km "v" 'org-export-stack-view) + (define-key km (kbd "RET") 'org-export-stack-view) + (define-key km "d" 'org-export-stack-remove) + km) + "Keymap for Org Export Stack.") + +(define-derived-mode org-export-stack-mode special-mode "Org-Stack" + "Mode for displaying asynchronous export stack. + +Type \\[org-export-stack] to visualize the asynchronous export +stack. + +In an Org Export Stack buffer, use \\\\[org-export-stack-view] to view export output +on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear +stack completely. + +Removing entries in an Org Export Stack buffer doesn't affect +files or buffers, only the display. + +\\{org-export-stack-mode-map}" + (abbrev-mode 0) + (auto-fill-mode 0) + (setq buffer-read-only t + buffer-undo-list t + truncate-lines t + header-line-format + '(:eval + (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) + (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) + (set (make-local-variable 'revert-buffer-function) + 'org-export-stack-refresh)) + + + +;;; The Dispatcher +;; +;; `org-export-dispatch' is the standard interactive way to start an +;; export process. It uses `org-export--dispatch-ui' as a subroutine +;; for its interface, which, in turn, delegates response to key +;; pressed to `org-export--dispatch-action'. + +;;;###autoload +(defun org-export-dispatch (&optional arg) + "Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavors: standard and expert. + +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavor or the other. + +When ARG is \\[universal-argument], repeat the last export action, with the same set +of options used back then, on the current buffer. + +When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." + (interactive "P") + (let* ((input + (cond ((equal arg '(16)) '(stack)) + ((and arg org-export-dispatch-last-action)) + (t (save-window-excursion + (unwind-protect + (progn + ;; Remember where we are + (move-marker org-export-dispatch-last-position + (point) + (org-base-buffer (current-buffer))) + ;; Get and store an export command + (setq org-export-dispatch-last-action + (org-export--dispatch-ui + (list org-export-initial-scope + (and org-export-in-background 'async)) + nil + org-export-dispatch-use-expert-ui))) + (and (get-buffer "*Org Export Dispatcher*") + (kill-buffer "*Org Export Dispatcher*"))))))) + (action (car input)) + (optns (cdr input))) + (unless (memq 'subtree optns) + (move-marker org-export-dispatch-last-position nil)) + (case action + ;; First handle special hard-coded actions. + (template (org-export-insert-default-template nil optns)) + (stack (org-export-stack)) + (publish-current-file + (org-publish-current-file (memq 'force optns) (memq 'async optns))) + (publish-current-project + (org-publish-current-project (memq 'force optns) (memq 'async optns))) + (publish-choose-project + (org-publish (assoc (org-icompleting-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + (memq 'force optns) + (memq 'async optns))) + (publish-all (org-publish-all (memq 'force optns) (memq 'async optns))) + (otherwise + (save-excursion + (when arg + ;; Repeating command, maybe move cursor to restore subtree + ;; context. + (if (eq (marker-buffer org-export-dispatch-last-position) + (org-base-buffer (current-buffer))) + (goto-char org-export-dispatch-last-position) + ;; We are in a different buffer, forget position. + (move-marker org-export-dispatch-last-position nil))) + (funcall action + ;; Return a symbol instead of a list to ease + ;; asynchronous export macro use. + (and (memq 'async optns) t) + (and (memq 'subtree optns) t) + (and (memq 'visible optns) t) + (and (memq 'body optns) t))))))) + +(defun org-export--dispatch-ui (options first-key expertp) + "Handle interface for `org-export-dispatch'. + +OPTIONS is a list containing current interactive options set for +export. It can contain any of the following symbols: +`body' toggles a body-only export +`subtree' restricts export to current subtree +`visible' restricts export to visible part of buffer. +`force' force publishing files. +`async' use asynchronous export process + +FIRST-KEY is the key pressed to select the first level menu. It +is nil when this menu hasn't been selected yet. + +EXPERTP, when non-nil, triggers expert UI. In that case, no help +buffer is provided, but indications about currently active +options are given in the prompt. Moreover, \[?] allows to switch +back to standard interface." + (let* ((fontify-key + (lambda (key &optional access-key) + ;; Fontify KEY string. Optional argument ACCESS-KEY, when + ;; non-nil is the required first-level key to activate + ;; KEY. When its value is t, activate KEY independently + ;; on the first key, if any. A nil value means KEY will + ;; only be activated at first level. + (if (or (eq access-key t) (eq access-key first-key)) + (org-propertize key 'face 'org-warning) + key))) + (fontify-value + (lambda (value) + ;; Fontify VALUE string. + (org-propertize value 'face 'font-lock-variable-name-face))) + ;; Prepare menu entries by extracting them from registered + ;; back-ends and sorting them by access key and by ordinal, + ;; if any. + (entries + (sort (sort (delq nil + (mapcar 'org-export-backend-menu + org-export--registered-backends)) + (lambda (a b) + (let ((key-a (nth 1 a)) + (key-b (nth 1 b))) + (cond ((and (numberp key-a) (numberp key-b)) + (< key-a key-b)) + ((numberp key-b) t))))) + 'car-less-than-car)) + ;; Compute a list of allowed keys based on the first key + ;; pressed, if any. Some keys + ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always + ;; available. + (allowed-keys + (nconc (list 2 22 19 6 1) + (if (not first-key) (org-uniquify (mapcar 'car entries)) + (let (sub-menu) + (dolist (entry entries (sort (mapcar 'car sub-menu) '<)) + (when (eq (car entry) first-key) + (setq sub-menu (append (nth 2 entry) sub-menu)))))) + (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) + ((not first-key) (list ?P))) + (list ?& ?#) + (when expertp (list ??)) + (list ?q))) + ;; Build the help menu for standard UI. + (help + (unless expertp + (concat + ;; Options are hard-coded. + (format "[%s] Body only: %s [%s] Visible only: %s +\[%s] Export scope: %s [%s] Force publishing: %s +\[%s] Async export: %s\n\n" + (funcall fontify-key "C-b" t) + (funcall fontify-value + (if (memq 'body options) "On " "Off")) + (funcall fontify-key "C-v" t) + (funcall fontify-value + (if (memq 'visible options) "On " "Off")) + (funcall fontify-key "C-s" t) + (funcall fontify-value + (if (memq 'subtree options) "Subtree" "Buffer ")) + (funcall fontify-key "C-f" t) + (funcall fontify-value + (if (memq 'force options) "On " "Off")) + (funcall fontify-key "C-a" t) + (funcall fontify-value + (if (memq 'async options) "On " "Off"))) + ;; Display registered back-end entries. When a key + ;; appears for the second time, do not create another + ;; entry, but append its sub-menu to existing menu. + (let (last-key) + (mapconcat + (lambda (entry) + (let ((top-key (car entry))) + (concat + (unless (eq top-key last-key) + (setq last-key top-key) + (format "\n[%s] %s\n" + (funcall fontify-key (char-to-string top-key)) + (nth 1 entry))) + (let ((sub-menu (nth 2 entry))) + (unless (functionp sub-menu) + ;; Split sub-menu into two columns. + (let ((index -1)) + (concat + (mapconcat + (lambda (sub-entry) + (incf index) + (format + (if (zerop (mod index 2)) " [%s] %-26s" + "[%s] %s\n") + (funcall fontify-key + (char-to-string (car sub-entry)) + top-key) + (nth 1 sub-entry))) + sub-menu "") + (when (zerop (mod index 2)) "\n")))))))) + entries "")) + ;; Publishing menu is hard-coded. + (format "\n[%s] Publish + [%s] Current file [%s] Current project + [%s] Choose project [%s] All projects\n\n\n" + (funcall fontify-key "P") + (funcall fontify-key "f" ?P) + (funcall fontify-key "p" ?P) + (funcall fontify-key "x" ?P) + (funcall fontify-key "a" ?P)) + (format "[%s] Export stack [%s] Insert template\n" + (funcall fontify-key "&" t) + (funcall fontify-key "#" t)) + (format "[%s] %s" + (funcall fontify-key "q" t) + (if first-key "Main menu" "Exit"))))) + ;; Build prompts for both standard and expert UI. + (standard-prompt (unless expertp "Export command: ")) + (expert-prompt + (when expertp + (format + "Export command (C-%s%s%s%s%s) [%s]: " + (if (memq 'body options) (funcall fontify-key "b" t) "b") + (if (memq 'visible options) (funcall fontify-key "v" t) "v") + (if (memq 'subtree options) (funcall fontify-key "s" t) "s") + (if (memq 'force options) (funcall fontify-key "f" t) "f") + (if (memq 'async options) (funcall fontify-key "a" t) "a") + (mapconcat (lambda (k) + ;; Strip control characters. + (unless (< k 27) (char-to-string k))) + allowed-keys ""))))) + ;; With expert UI, just read key with a fancy prompt. In standard + ;; UI, display an intrusive help buffer. + (if expertp + (org-export--dispatch-action + expert-prompt allowed-keys entries options first-key expertp) + ;; At first call, create frame layout in order to display menu. + (unless (get-buffer "*Org Export Dispatcher*") + (delete-other-windows) + (org-switch-to-buffer-other-window + (get-buffer-create "*Org Export Dispatcher*")) + (setq cursor-type nil + header-line-format "Use SPC, DEL, C-n or C-p to navigate.") + ;; Make sure that invisible cursor will not highlight square + ;; brackets. + (set-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?\[ "w")) + ;; At this point, the buffer containing the menu exists and is + ;; visible in the current window. So, refresh it. + (with-current-buffer "*Org Export Dispatcher*" + ;; Refresh help. Maintain display continuity by re-visiting + ;; previous window position. + (let ((pos (window-start))) + (erase-buffer) + (insert help) + (set-window-start nil pos))) + (org-fit-window-to-buffer) + (org-export--dispatch-action + standard-prompt allowed-keys entries options first-key expertp)))) + +(defun org-export--dispatch-action + (prompt allowed-keys entries options first-key expertp) + "Read a character from command input and act accordingly. + +PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is +a list of characters available at a given step in the process. +ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and +EXPERTP are the same as defined in `org-export--dispatch-ui', +which see. + +Toggle export options when required. Otherwise, return value is +a list with action as CAR and a list of interactive export +options as CDR." + (let (key) + ;; Scrolling: when in non-expert mode, act on motion keys (C-n, + ;; C-p, SPC, DEL). + (while (and (setq key (read-char-exclusive prompt)) + (not expertp) + (memq key '(14 16 ?\s ?\d))) + (case key + (14 (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up 1)) + (message "End of buffer") + (sit-for 1))) + (16 (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down 1)) + (message "Beginning of buffer") + (sit-for 1))) + (?\s (if (not (pos-visible-in-window-p (point-max))) + (scroll-up nil) + (message "End of buffer") + (sit-for 1))) + (?\d (if (not (pos-visible-in-window-p (point-min))) + (scroll-down nil) + (message "Beginning of buffer") + (sit-for 1))))) + (cond + ;; Ignore undefined associations. + ((not (memq key allowed-keys)) + (ding) + (unless expertp (message "Invalid key") (sit-for 1)) + (org-export--dispatch-ui options first-key expertp)) + ;; q key at first level aborts export. At second level, cancel + ;; first key instead. + ((eq key ?q) (if (not first-key) (error "Export aborted") + (org-export--dispatch-ui options nil expertp))) + ;; Help key: Switch back to standard interface if expert UI was + ;; active. + ((eq key ??) (org-export--dispatch-ui options first-key nil)) + ;; Send request for template insertion along with export scope. + ((eq key ?#) (cons 'template (memq 'subtree options))) + ;; Switch to asynchronous export stack. + ((eq key ?&) '(stack)) + ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). + ((memq key '(2 22 19 6 1)) + (org-export--dispatch-ui + (let ((option (case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) + (if (memq option options) (remq option options) + (cons option options))) + first-key expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + ((or first-key (functionp (nth 2 (assq key entries)))) + (cons (cond + ((not first-key) (nth 2 (assq key entries))) + ;; Publishing actions are hard-coded. Send a special + ;; signal to `org-export-dispatch'. + ((eq first-key ?P) + (case key + (?f 'publish-current-file) + (?p 'publish-current-project) + (?x 'publish-choose-project) + (?a 'publish-all))) + ;; Return first action associated to FIRST-KEY + KEY + ;; path. Indeed, derived backends can share the same + ;; FIRST-KEY. + (t (catch 'found + (mapc (lambda (entry) + (let ((match (assq key (nth 2 entry)))) + (when match (throw 'found (nth 2 match))))) + (member (assq first-key entries) entries))))) + options)) + ;; Otherwise, enter sub-menu. + (t (org-export--dispatch-ui options key expertp))))) + + + +(provide 'ox) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox.el ends here diff --git a/lisp/outline.el b/lisp/outline.el index 0ec5227a286..c7cad31f572 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1,9 +1,9 @@ ;;; outline.el --- outline mode commands for Emacs -;; Copyright (C) 1986, 1993-1995, 1997, 2000-2013 Free Software +;; Copyright (C) 1986, 1993-1995, 1997, 2000-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: outlines ;; This file is part of GNU Emacs. diff --git a/lisp/paren.el b/lisp/paren.el index a9d3be60622..b6b08016ab7 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -1,9 +1,9 @@ ;;; paren.el --- highlight matching paren -;; Copyright (C) 1993, 1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1996, 2001-2014 Free Software Foundation, Inc. ;; Author: rms@gnu.org -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, faces ;; This file is part of GNU Emacs. @@ -37,11 +37,6 @@ :prefix "show-paren-" :group 'paren-matching) -;; This is the overlay used to highlight the matching paren. -(defvar show-paren-overlay nil) -;; This is the overlay used to highlight the closeparen right before point. -(defvar show-paren-overlay-1 nil) - (defcustom show-paren-style 'parenthesis "Style used when showing a matching paren. Valid styles are `parenthesis' (meaning show the matching paren), @@ -77,37 +72,22 @@ active, you must toggle the mode off and on again for this to take effect." :group 'paren-showing :version "20.3") -(defgroup paren-showing-faces nil - "Group for faces of Show Paren mode." - :group 'paren-showing - :group 'faces - :version "22.1") - -(defface show-paren-match - '((((class color) (background light)) - :background "turquoise") ; looks OK on tty (becomes cyan) - (((class color) (background dark)) - :background "steelblue3") ; looks OK on tty (becomes blue) - (((background dark)) - :background "grey50") - (t - :background "gray")) - "Show Paren mode face used for a matching paren." - :group 'paren-showing-faces) (define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") -(defface show-paren-mismatch - '((((class color)) (:foreground "white" :background "purple")) - (t (:inverse-video t))) - "Show Paren mode face used for a mismatching paren." - :group 'paren-showing-faces) (define-obsolete-face-alias 'show-paren-mismatch-face 'show-paren-mismatch "22.1") (defvar show-paren-highlight-openparen t "Non-nil turns on openparen highlighting when matching forward.") -(defvar show-paren-idle-timer nil) +(defvar show-paren--idle-timer nil) +(defvar show-paren--overlay + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the matching paren.") +(defvar show-paren--overlay-1 + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the paren at point.") + ;;;###autoload (define-minor-mode show-paren-mode @@ -120,154 +100,148 @@ Show Paren mode is a global minor mode. When enabled, any matching parenthesis is highlighted in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." :global t :group 'paren-showing - ;; Enable or disable the mechanism. - ;; First get rid of the old idle timer. - (if show-paren-idle-timer - (cancel-timer show-paren-idle-timer)) - (setq show-paren-idle-timer nil) - ;; If show-paren-mode is enabled in some buffer now, - ;; set up a new timer. - (when (memq t (mapcar (lambda (buffer) - (with-current-buffer buffer - show-paren-mode)) - (buffer-list))) - (setq show-paren-idle-timer (run-with-idle-timer - show-paren-delay t - 'show-paren-function))) - (unless show-paren-mode - (and show-paren-overlay - (eq (overlay-buffer show-paren-overlay) (current-buffer)) - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (eq (overlay-buffer show-paren-overlay-1) (current-buffer)) - (delete-overlay show-paren-overlay-1)))) + ;; Enable or disable the mechanism. + ;; First get rid of the old idle timer. + (when show-paren--idle-timer + (cancel-timer show-paren--idle-timer) + (setq show-paren--idle-timer nil)) + (setq show-paren--idle-timer (run-with-idle-timer + show-paren-delay t + #'show-paren-function)) + (unless show-paren-mode + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1))) + +(defvar show-paren-data-function #'show-paren--default + "Function to find the opener/closer at point and its match. +The function is called with no argument and should return either nil +if there's no opener/closer at point, or a list of the form +\(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) +Where HERE-BEG..HERE-END is expected to be around point.") + +(defun show-paren--default () + (let* ((oldpos (point)) + (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) + ((eq (syntax-class (syntax-after (point))) 4) 1))) + (unescaped + (when dir + ;; Verify an even number of quoting characters precede the paren. + ;; Follow the same logic as in `blink-matching-open'. + (= (if (= dir -1) 1 0) + (logand 1 (- (point) + (save-excursion + (if (= dir -1) (forward-char -1)) + (skip-syntax-backward "/\\") + (point))))))) + (here-beg (if (eq dir 1) (point) (1- (point)))) + (here-end (if (eq dir 1) (1+ (point)) (point))) + pos mismatch) + ;; + ;; Find the other end of the sexp. + (when unescaped + (save-excursion + (save-restriction + ;; Determine the range within which to look for a match. + (when blink-matching-paren-distance + (narrow-to-region + (max (point-min) (- (point) blink-matching-paren-distance)) + (min (point-max) (+ (point) blink-matching-paren-distance)))) + ;; Scan across one sexp within that range. + ;; Errors or nil mean there is a mismatch. + (condition-case () + (setq pos (scan-sexps (point) dir)) + (error (setq pos t mismatch t))) + ;; Move back the other way and verify we get back to the + ;; starting point. If not, these two parens don't really match. + ;; Maybe the one at point is escaped and doesn't really count, + ;; or one is inside a comment. + (when (integerp pos) + (unless (condition-case () + (eq (point) (scan-sexps pos (- dir))) + (error nil)) + (setq pos nil))) + ;; If found a "matching" paren, see if it is the right + ;; kind of paren to match the one we started at. + (if (not (integerp pos)) + (if mismatch (list here-beg here-end nil nil t)) + (let ((beg (min pos oldpos)) (end (max pos oldpos))) + (unless (eq (syntax-class (syntax-after beg)) 8) + (setq mismatch + (not (or (eq (char-before end) + ;; This can give nil. + (cdr (syntax-after beg))) + (eq (char-after beg) + ;; This can give nil. + (cdr (syntax-after (1- end)))) + ;; The cdr might hold a new paren-class + ;; info rather than a matching-char info, + ;; in which case the two CDRs should match. + (eq (cdr (syntax-after (1- end))) + (cdr (syntax-after beg))))))) + (list here-beg here-end + (if (= dir 1) (1- pos) pos) + (if (= dir 1) pos (1+ pos)) + mismatch)))))))) ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-function () - (if show-paren-mode - (let* ((oldpos (point)) - (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) - ((eq (syntax-class (syntax-after (point))) 4) 1))) - (unescaped - (when dir - ;; Verify an even number of quoting characters precede the paren. - ;; Follow the same logic as in `blink-matching-open'. - (= (if (= dir -1) 1 0) - (logand 1 (- (point) - (save-excursion - (if (= dir -1) (forward-char -1)) - (skip-syntax-backward "/\\") - (point))))))) - pos mismatch face) - ;; - ;; Find the other end of the sexp. - (when unescaped - (save-excursion - (save-restriction - ;; Determine the range within which to look for a match. - (when blink-matching-paren-distance - (narrow-to-region - (max (point-min) (- (point) blink-matching-paren-distance)) - (min (point-max) (+ (point) blink-matching-paren-distance)))) - ;; Scan across one sexp within that range. - ;; Errors or nil mean there is a mismatch. - (condition-case () - (setq pos (scan-sexps (point) dir)) - (error (setq pos t mismatch t))) - ;; Move back the other way and verify we get back to the - ;; starting point. If not, these two parens don't really match. - ;; Maybe the one at point is escaped and doesn't really count. - (when (integerp pos) - (unless (condition-case () - (eq (point) (scan-sexps pos (- dir))) - (error nil)) - (setq pos nil))) - ;; If found a "matching" paren, see if it is the right - ;; kind of paren to match the one we started at. - (when (integerp pos) - (let ((beg (min pos oldpos)) (end (max pos oldpos))) - (unless (eq (syntax-class (syntax-after beg)) 8) - (setq mismatch - (not (or (eq (char-before end) - ;; This can give nil. - (cdr (syntax-after beg))) - (eq (char-after beg) - ;; This can give nil. - (cdr (syntax-after (1- end)))) - ;; The cdr might hold a new paren-class - ;; info rather than a matching-char info, - ;; in which case the two CDRs should match. - (eq (cdr (syntax-after (1- end))) - (cdr (syntax-after beg)))))))))))) - ;; - ;; Highlight the other end of the sexp, or unhighlight if none. - (if (not pos) - (progn - ;; If not at a paren that has a match, - ;; turn off any previous paren highlighting. - (and show-paren-overlay (overlay-buffer show-paren-overlay) - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) - (delete-overlay show-paren-overlay-1))) - ;; - ;; Use the correct face. - (if mismatch - (progn - (if show-paren-ring-bell-on-mismatch - (beep)) - (setq face 'show-paren-mismatch)) - (setq face 'show-paren-match)) - ;; - ;; If matching backwards, highlight the closeparen - ;; before point as well as its matching open. - ;; If matching forward, and the openparen is unbalanced, - ;; highlight the paren at point to indicate misbalance. - ;; Otherwise, turn off any such highlighting. - (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos)) - (when (and show-paren-overlay-1 - (overlay-buffer show-paren-overlay-1)) - (delete-overlay show-paren-overlay-1)) - (let ((from (if (= dir 1) - (point) - (- (point) 1))) - (to (if (= dir 1) - (+ (point) 1) - (point)))) - (if show-paren-overlay-1 - (move-overlay show-paren-overlay-1 from to (current-buffer)) - (setq show-paren-overlay-1 (make-overlay from to nil t))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay-1 'priority show-paren-priority) - (overlay-put show-paren-overlay-1 'face face))) - ;; - ;; Turn on highlighting for the matching paren, if found. - ;; If it's an unmatched paren, turn off any such highlighting. - (if (not (integerp pos)) - (when show-paren-overlay (delete-overlay show-paren-overlay)) - (let ((to (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - (point) - pos)) - (from (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - pos - (save-excursion - (goto-char pos) - (- (point) dir))))) - (if show-paren-overlay - (move-overlay show-paren-overlay from to (current-buffer)) - (setq show-paren-overlay (make-overlay from to nil t)))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay 'priority show-paren-priority) - (overlay-put show-paren-overlay 'face face)))) - ;; show-paren-mode is nil in this buffer. - (and show-paren-overlay - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (delete-overlay show-paren-overlay-1)))) + (let ((data (and show-paren-mode (funcall show-paren-data-function)))) + (if (not data) + (progn + ;; If show-paren-mode is nil in this buffer or if not at a paren that + ;; has a match, turn off any previous paren highlighting. + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1)) + + ;; Found something to highlight. + (let* ((here-beg (nth 0 data)) + (here-end (nth 1 data)) + (there-beg (nth 2 data)) + (there-end (nth 3 data)) + (mismatch (nth 4 data)) + (face + (if mismatch + (progn + (if show-paren-ring-bell-on-mismatch + (beep)) + 'show-paren-mismatch) + 'show-paren-match))) + ;; + ;; If matching backwards, highlight the closeparen + ;; before point as well as its matching open. + ;; If matching forward, and the openparen is unbalanced, + ;; highlight the paren at point to indicate misbalance. + ;; Otherwise, turn off any such highlighting. + (if (or (not here-beg) + (and (not show-paren-highlight-openparen) + (> here-end (point)) + (integerp there-beg))) + (delete-overlay show-paren--overlay-1) + (move-overlay show-paren--overlay-1 + here-beg here-end (current-buffer)) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay-1 'priority show-paren-priority) + (overlay-put show-paren--overlay-1 'face face)) + ;; + ;; Turn on highlighting for the matching paren, if found. + ;; If it's an unmatched paren, turn off any such highlighting. + (if (not there-beg) + (delete-overlay show-paren--overlay) + (if (or (eq show-paren-style 'expression) + (and (eq show-paren-style 'mixed) + (let ((closest (if (< there-beg here-beg) + (1- there-end) (1+ there-beg)))) + (not (pos-visible-in-window-p closest))))) + (move-overlay show-paren--overlay + (point) + (if (< there-beg here-beg) there-beg there-end) + (current-buffer)) + (move-overlay show-paren--overlay + there-beg there-end (current-buffer))) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay 'priority show-paren-priority) + (overlay-put show-paren--overlay 'face face)))))) (provide 'paren) diff --git a/lisp/password-cache.el b/lisp/password-cache.el index cb7f3e863cd..523b6200b65 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -1,6 +1,6 @@ ;;; password-cache.el --- Read passwords, possibly using a password cache. -;; Copyright (C) 1999-2000, 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2000, 2003-2014 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Created: 2003-12-21 diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el index 9b6d2c7e073..ac1a6faeebc 100644 --- a/lisp/pcmpl-cvs.el +++ b/lisp/pcmpl-cvs.el @@ -1,6 +1,6 @@ ;;; pcmpl-cvs.el --- functions for dealing with cvs completions -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: John Wiegley ;; Package: pcomplete diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 91b146fdc78..bcab1f7cb5b 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -1,6 +1,6 @@ ;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Package: pcomplete @@ -158,7 +158,8 @@ "Completion for the GNU tar utility." ;; options that end in an equal sign will want further completion... (let (saw-option complete-within) - (let ((pcomplete-suffix-list (cons ?= pcomplete-suffix-list))) + (let ((pcomplete-suffix-list (if (boundp 'pcomplete-suffix-list) + (cons ?= pcomplete-suffix-list)))) (while (pcomplete-match "^-" 0) (setq saw-option t) (if (pcomplete-match "^--" 0) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 7e7bfe28713..9da931bbac4 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -1,6 +1,6 @@ ;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Package: pcomplete @@ -31,9 +31,10 @@ (require 'pcomplete) -(defgroup pcmpl-linux nil - "Functions for dealing with GNU/Linux completions." - :group 'pcomplete) +;; Unused. +;;; (defgroup pcmpl-linux nil +;;; "Functions for dealing with GNU/Linux completions." +;;; :group 'pcomplete) ;; Functions: diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index d2462b63be2..f7eac8c14d5 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -1,6 +1,6 @@ ;;; pcmpl-rpm.el --- functions for dealing with rpm completions -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Package: pcomplete diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 4fc2f84c1c9..6ac3e1579b6 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -1,6 +1,6 @@ ;;; pcmpl-unix.el --- standard UNIX completions -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Package: pcomplete diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el new file mode 100644 index 00000000000..9217316bfce --- /dev/null +++ b/lisp/pcmpl-x.el @@ -0,0 +1,290 @@ +;;; pcmpl-x.el --- completion for miscellaneous tools -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Author: Leo Liu +;; Keywords: processes, tools, convenience +;; Package: pcomplete + +;; 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 . + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'pcomplete) + + +;;;; tlmgr - http://www.tug.org/texlive/tlmgr.html + +(defcustom pcmpl-x-tlmgr-program "tlmgr" + "Name of the tlmgr program." + :version "24.4" + :type 'file + :group 'pcomplete) + +(defvar pcmpl-x-tlmgr-common-options + '("--repository" + "--gui" + "--gui-lang" + "--machine-readable" + "--package-logfile" + "--pause" + "--persistent-downloads" + "--no-persistent-downloads" + "--no-execute-actions" + "--debug-translation" + "--help" + "--version")) + +(defvar pcmpl-x-tlmgr-actions + '(("help") + ("version") + ("gui") + ("install") + ("update") + ("backup") + ("restore") + ("remove") + ("repository" ("list" "add" "remove" "set")) + ("candidates") + ("option" ("show" + "showall" + "repository" + "formats" + "postcode" + "docfiles" + "srcfiles" + "backupdir" + "autobackup" + "sys_bin" + "sys_man" + "sys_info" + "desktop_integration" + "fileassocs" + "multiuser")) + ("conf" ("texmf" "tlmgr")) + ("paper" + ("a4" "letter" "xdvi" "pdftex" "dvips" "dvipdfmx" "dvipdfm" "context") + (lambda () + (unless (member (pcomplete-arg 1) '("a4" "letter")) + (pcomplete-here* '("paper")) + (pcomplete-here* '("a4" "letter"))))) + ("platform" ("list" "add" "remove")) + ("print-platform" ("collections" "schemes")) + ("arch" ("list" "add" "remove")) + ("print-arch" ("collections" "schemes")) + ("info" ("collections" "schemes")) + ("search") + ("dump-tlpdb") + ("check" ("files" "depends" "executes" "runfiles" "all")) + ("path" ("add" "remove")) + ("postaction" ("install" "remove") ("shortcut" "fileassoc" "script")) + ("uninstall") + ("generate" ("language" + "language.dat" + "language.def" + "language.dat.lua" + "fmtutil")))) + +(defvar pcmpl-x-tlmgr-options-cache (make-hash-table :size 31 :test 'equal)) + +(defun pcmpl-x-tlmgr-action-options (action) + "Get the list of long options for ACTION." + (if (eq (gethash action pcmpl-x-tlmgr-options-cache 'missing) 'missing) + (with-temp-buffer + (when (zerop + (call-process pcmpl-x-tlmgr-program nil t nil action "-h")) + (goto-char (point-min)) + (puthash action + (cons "--help" + (cl-loop while (re-search-forward + "^[ \t]+\\(--[[:alnum:]-]+=?\\)" + nil t) + collect (match-string 1))) + pcmpl-x-tlmgr-options-cache) + (pcmpl-x-tlmgr-action-options action))) + (gethash action pcmpl-x-tlmgr-options-cache))) + +;;;###autoload +(defun pcomplete/tlmgr () + "Completion for the `tlmgr' command." + (while (pcomplete-match "^--" 0) + (pcomplete-here* pcmpl-x-tlmgr-common-options) + (unless (or (pcomplete-match "^--" 0) + (all-completions (pcomplete-arg 0) pcmpl-x-tlmgr-actions)) + (pcomplete-here* (pcomplete-dirs-or-entries)))) + (pcomplete-here* pcmpl-x-tlmgr-actions) + (let ((action (substring-no-properties (pcomplete-arg 1)))) + (while t + (if (pcomplete-match "^--" 0) + (pcomplete-here* (pcmpl-x-tlmgr-action-options action)) + (dolist (completions (cdr (assoc action pcmpl-x-tlmgr-actions))) + (cond ((functionp completions) + (funcall completions)) + ((all-completions (pcomplete-arg 0) completions) + (pcomplete-here* completions)) + (t (pcomplete-here* (pcomplete-dirs-or-entries))))) + (unless (pcomplete-match "^--" 0) + (pcomplete-here* (pcomplete-dirs-or-entries))))))) + + +;;;; ack - http://betterthangrep.com + +;; Usage: +;; - To complete short options type '-' first +;; - To complete long options type '--' first +;; - Color name completion is supported following +;; --color-filename=, --color-match= and --color-lineno= +;; - Type completion is supported following --type= + +(defcustom pcmpl-x-ack-program + (file-name-nondirectory (or (executable-find "ack-grep") + (executable-find "ack") + "ack")) + "Name of the ack program." + :version "24.4" + :type 'file + :group 'pcomplete) + +(defvar pcmpl-x-ack-color-options + '("clear" + "reset" + "dark" + "bold" + "underline" + "underscore" + "blink" + "reverse" + "concealed" + "black" + "red" + "green" + "yellow" + "blue" + "magenta" + "on_black" + "on_red" + "on_green" + "on_yellow" + "on_blue" + "on_magenta" + "on_cyan" + "on_white") + "Color names for the `ack' command.") + +(defun pcmpl-x-ack-run (buffer &rest args) + "Run ack with ARGS and send the output to BUFFER." + (condition-case nil + (apply 'call-process (or pcmpl-x-ack-program "ack") nil buffer nil args) + (file-error -1))) + +(defun pcmpl-x-ack-short-options () + "Short options for the `ack' command." + (with-temp-buffer + (let (options) + (when (zerop (pcmpl-x-ack-run t "--help")) + (goto-char (point-min)) + (while (re-search-forward "^ -\\([^-]\\)" nil t) + (push (match-string 1) options)) + (mapconcat 'identity (nreverse options) ""))))) + +(defun pcmpl-x-ack-long-options (&optional arg) + "Long options for the `ack' command." + (with-temp-buffer + (let (options) + (when (zerop (pcmpl-x-ack-run t (or arg "--help"))) + (goto-char (point-min)) + (while (re-search-forward + "\\(?: ?\\|, \\)\\(--\\(\\[no\\]\\)?\\([[:alnum:]-]+=?\\)\\)" + nil t) + (if (not (match-string 2)) + (push (match-string 1) options) + (push (concat "--" (match-string 3)) options) + (push (concat "--no" (match-string 3)) options))) + (nreverse options))))) + +(defun pcmpl-x-ack-type-options () + "A list of types for the `ack' command." + (pcmpl-x-ack-long-options "--help-types")) + +;;;###autoload +(defun pcomplete/ack () + "Completion for the `ack' command. +Start an argument with '-' to complete short options and '--' for +long options." + ;; No space after = + (while t + (if (pcomplete-match "^-" 0) + (cond + ((pcomplete-match "^--color-\\w+=\\(\\S-*\\)" 0) + (pcomplete-here* pcmpl-x-ack-color-options + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--\\(?:no\\)?ignore-dir=\\(\\S-*\\)" 0) + (pcomplete-here* (pcomplete-dirs) + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--type=\\(\\S-*\\)" 0) + (pcomplete-here* (mapcar (lambda (type-option) + (substring type-option 2)) + (pcmpl-x-ack-type-options)) + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--" 0) + (pcomplete-here* (append (pcmpl-x-ack-long-options) + (pcmpl-x-ack-type-options)))) + (t (pcomplete-opt (pcmpl-x-ack-short-options)))) + (pcomplete-here* (pcomplete-dirs-or-entries))))) + +;;;###autoload +(defalias 'pcomplete/ack-grep 'pcomplete/ack) + + +;;;; the_silver_search - https://github.com/ggreer/the_silver_searcher + +(defvar pcmpl-x-ag-options nil) + +(defun pcmpl-x-ag-options () + (or pcmpl-x-ag-options + (setq pcmpl-x-ag-options + (with-temp-buffer + (when (zerop (call-process "ag" nil t nil "--help")) + (let (short long) + (goto-char (point-min)) + (while (re-search-forward "^ +\\(-[a-zA-Z]\\) " nil t) + (push (match-string 1) short)) + (goto-char (point-min)) + (while (re-search-forward + "^ +\\(?:-[a-zA-Z] \\)?\\(--\\(\\[no\\]\\)?[^ \t\n]+\\) " + nil t) + (if (match-string 2) + (progn + (replace-match "" nil nil nil 2) + (push (match-string 1) long) + (replace-match "no" nil nil nil 2) + (push (match-string 1) long)) + (push (match-string 1) long))) + (list (cons 'short (nreverse short)) + (cons 'long (nreverse long))))))))) + +;;;###autoload +(defun pcomplete/ag () + "Completion for the `ag' command." + (while t + (if (pcomplete-match "^-" 0) + (pcomplete-here* (cdr (assq (if (pcomplete-match "^--" 0) 'long 'short) + (pcmpl-x-ag-options)))) + (pcomplete-here* (pcomplete-dirs-or-entries))))) + +(provide 'pcmpl-x) +;;; pcmpl-x.el ends here diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 957505f43b8..dbeefda7671 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1,6 +1,6 @@ ;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: John Wiegley ;; Keywords: processes abbrev diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 2e3f500766f..4359f3f9aa1 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -1,6 +1,6 @@ ;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Dave Pearson ;; Maintainer: Dave Pearson @@ -185,19 +185,8 @@ GRID is the grid of positions to click.") ;; Gameplay functions. -(put '5x5-mode 'mode-class 'special) - -(defun 5x5-mode () - "A mode for playing `5x5'. - -The key bindings for `5x5-mode' are: - -\\{5x5-mode-map}" - (kill-all-local-variables) - (use-local-map 5x5-mode-map) - (setq major-mode '5x5-mode - mode-name "5x5") - (run-mode-hooks '5x5-mode-hook) +(define-derived-mode 5x5-mode special-mode "5x5" + "A mode for playing `5x5'." (setq buffer-read-only t truncate-lines t) (buffer-disable-undo)) diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 83eddbf095f..8b286ab5d07 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -1,6 +1,6 @@ ;;; animate.el --- make text dance -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Maintainer: Richard Stallman ;; Keywords: games diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index d38f799756b..8e4106e03e3 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -1,6 +1,6 @@ ;;; blackbox.el --- blackbox game in Emacs Lisp -;; Copyright (C) 1985-1987, 1992, 2001-2013 Free Software Foundation, +;; Copyright (C) 1985-1987, 1992, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: F. Thomas May @@ -113,9 +113,8 @@ map)) ;; Blackbox mode is suitable only for specially formatted data. -(put 'blackbox-mode 'mode-class 'special) -(defun blackbox-mode () +(define-derived-mode blackbox-mode special-mode "Blackbox" "Major mode for playing blackbox. To learn how to play blackbox, see the documentation for function `blackbox'. @@ -124,13 +123,7 @@ The usual mnemonic keys move the cursor around the box. \\[bb-romp] -- send in a ray from point, or toggle a ball at point \\[bb-done] -- end game and get score" - (interactive) - (kill-all-local-variables) - (use-local-map blackbox-mode-map) - (setq truncate-lines t) - (setq major-mode 'blackbox-mode) - (setq mode-name "Blackbox") - (run-mode-hooks 'blackbox-mode-hook)) + (setq truncate-lines t)) ;;;###autoload (defun blackbox (num) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 10493093aad..e7f5725a0f0 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1,6 +1,6 @@ -;;; bubbles.el --- Puzzle game for Emacs +;;; bubbles.el --- Puzzle game for Emacs -*- coding: utf-8 -*- -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Ulf Jasper ;; URL: http://ulf.epplejasper.de/ @@ -198,7 +198,7 @@ types are present." :group 'bubbles) (defcustom bubbles-chars - '(?+ ?O ?# ?X ?. ?* ?& ?) + '(?+ ?O ?# ?X ?. ?* ?& ?§) "Characters used for bubbles. Note that the actual number of different bubbles is determined by the number of colors, see `bubbles-colors'." @@ -211,7 +211,7 @@ the number of colors, see `bubbles-colors'." Available modes are `shift-default' and `shift-always'." :type '(radio (const :tag "Default" default) (const :tag "Shifter" always) - ;;(const :tag "Mega Shifter" 'mega) + ;;(const :tag "Mega Shifter" mega) ) :group 'bubbles) @@ -231,7 +231,7 @@ Available modes are `shift-default' and `shift-always'." (defvar bubbles--score 0 "Current Bubbles score.") -(defvar bubbles--neighbourhood-score 0 +(defvar bubbles--neighborhood-score 0 "Score of active bubbles neighborhood.") (defvar bubbles--faces nil @@ -925,7 +925,7 @@ static char * dot3d_xpm[] = { (buffer-disable-undo) (force-mode-line-update) (redisplay) - (add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t)) + (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t)) ;;;###autoload (defun bubbles () @@ -1087,7 +1087,7 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (char-after (point)) nil))) -(defun bubbles--mark-direct-neighbours (row col char) +(defun bubbles--mark-direct-neighbors (row col char) "Mark direct neighbors of bubble at ROW COL with same CHAR." (save-excursion (let ((count 0)) @@ -1097,38 +1097,37 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (add-text-properties (point) (1+ (point)) '(active t face 'bubbles--highlight-face)) (setq count (+ 1 - (bubbles--mark-direct-neighbours row (1+ col) char) - (bubbles--mark-direct-neighbours row (1- col) char) - (bubbles--mark-direct-neighbours (1+ row) col char) - (bubbles--mark-direct-neighbours (1- row) col char)))) + (bubbles--mark-direct-neighbors row (1+ col) char) + (bubbles--mark-direct-neighbors row (1- col) char) + (bubbles--mark-direct-neighbors (1+ row) col char) + (bubbles--mark-direct-neighbors (1- row) col char)))) count))) -(defun bubbles--mark-neighbourhood (&optional pos) +(defun bubbles--mark-neighborhood (&optional pos) "Mark neighborhood of point. Use optional parameter POS instead of point if given." (when bubbles--playing (unless pos (setq pos (point))) - (condition-case err - (let ((char (char-after pos)) - (inhibit-read-only t) - (row (bubbles--row (point))) - (col (bubbles--col (point)))) - (add-text-properties (point-min) (point-max) - '(face default active nil)) - (let ((count 0)) - (when (and row col (not (eq char (bubbles--empty-char)))) - (setq count (bubbles--mark-direct-neighbours row col char)) - (unless (> count 1) - (add-text-properties (point-min) (point-max) - '(face default active nil)) - (setq count 0))) - (bubbles--update-neighbourhood-score count)) - (put-text-property (point-min) (point-max) 'pointer 'arrow) - (bubbles--update-faces-or-images) - (sit-for 0)) - (error (message "Bubbles: Internal error %s" err))))) + (with-demoted-errors "Bubbles: Internal error %s" + (let ((char (char-after pos)) + (inhibit-read-only t) + (row (bubbles--row (point))) + (col (bubbles--col (point)))) + (add-text-properties (point-min) (point-max) + '(face default active nil)) + (let ((count 0)) + (when (and row col (not (eq char (bubbles--empty-char)))) + (setq count (bubbles--mark-direct-neighbors row col char)) + (unless (> count 1) + (add-text-properties (point-min) (point-max) + '(face default active nil)) + (setq count 0))) + (bubbles--update-neighborhood-score count)) + (put-text-property (point-min) (point-max) 'pointer 'arrow) + (bubbles--update-faces-or-images) + (sit-for 0))))) -(defun bubbles--neighbourhood-available () +(defun bubbles--neighborhood-available () "Return t if another valid neighborhood is available." (catch 'found (save-excursion @@ -1154,20 +1153,20 @@ Use optional parameter POS instead of point if given." (defun bubbles--reset-score () "Reset bubbles score." - (setq bubbles--neighbourhood-score 0 + (setq bubbles--neighborhood-score 0 bubbles--score 0) (bubbles--update-score)) (defun bubbles--update-score () "Calculate and display new bubbles score." - (setq bubbles--score (+ bubbles--score bubbles--neighbourhood-score)) + (setq bubbles--score (+ bubbles--score bubbles--neighborhood-score)) (bubbles--show-scores)) -(defun bubbles--update-neighbourhood-score (size) +(defun bubbles--update-neighborhood-score (size) "Calculate and display score of active neighborhood from its SIZE." (if (> size 1) - (setq bubbles--neighbourhood-score (expt (- size 1) 2)) - (setq bubbles--neighbourhood-score 0)) + (setq bubbles--neighborhood-score (expt (- size 1) 2)) + (setq bubbles--neighborhood-score 0)) (bubbles--show-scores)) (defun bubbles--show-scores () @@ -1178,7 +1177,7 @@ Use optional parameter POS instead of point if given." (let ((inhibit-read-only t) (pos (point))) (delete-region (point) (point-max)) - (insert (format "Selected: %4d\n" bubbles--neighbourhood-score)) + (insert (format "Selected: %4d\n" bubbles--neighborhood-score)) (insert " ") (add-text-properties (1- (point)) (point) (list 'intangible t 'display @@ -1217,10 +1216,10 @@ Use optional parameter POS instead of point if given." "Remove active bubbles region." (interactive) (when (and bubbles--playing - (> bubbles--neighbourhood-score 0)) + (> bubbles--neighborhood-score 0)) (setq bubbles--save-data (list bubbles--score (buffer-string))) (let ((inhibit-read-only t)) - ;; blank out current neighbourhood + ;; blank out current neighborhood (let ((row (bubbles--row (point))) (col (bubbles--col (point)))) (goto-char (point-max)) @@ -1290,7 +1289,7 @@ Use optional parameter POS instead of point if given." (bubbles--update-faces-or-images) (sit-for 0))) (put-text-property (point-min) (point-max) 'removed nil) - (unless (bubbles--neighbourhood-available) + (unless (bubbles--neighborhood-available) (bubbles--game-over))) ;; undo (setq buffer-undo-list '((apply bubbles-undo . nil))) diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index d060c31aebc..4d49fca7568 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -1,9 +1,9 @@ ;;; cookie1.el --- retrieve random phrases from fortune cookie files -;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2014 Free Software Foundation, Inc. ;; Author: Eric S. Raymond -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games, extensions ;; Created: Mon Mar 22 17:06:26 1993 @@ -25,11 +25,10 @@ ;;; Commentary: ;; Support for random cookie fetches from phrase files, used for such -;; critical applications as emulating Zippy the Pinhead and confounding -;; the NSA Trunk Trawler. +;; critical applications as confounding the NSA Trunk Trawler. ;; ;; The two entry points are `cookie' and `cookie-insert'. The helper -;; function `shuffle-vector' may be of interest to programmers. +;; function `cookie-shuffle-vector' may be of interest to programmers. ;; ;; The code expects phrase files to be in one of two formats: ;; @@ -49,32 +48,62 @@ ;; This code derives from Steve Strassmann's 1987 spook.el package, but ;; has been generalized so that it supports multiple simultaneous ;; cookie databases and fortune files. It is intended to be called -;; from other packages such as yow.el and spook.el. +;; from other packages such as spook.el. ;;; Code: +(defgroup cookie nil + "Random cookies from phrase files." + :prefix "cookie-" + :group 'games) + +(defcustom cookie-file nil + "Default phrase file for cookie functions." + :type '(choice (const nil) file) + :group 'cookie + :version "24.4") + (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" "Delimiter used to separate cookie file entries.") (defvar cookie-cache (make-vector 511 0) "Cache of cookie files that have already been snarfed.") +(defun cookie-check-file (file) + "Return either FILE or `cookie-file'. +Signal an error if the result is nil or not readable." + (or (setq file (or file cookie-file)) (user-error "No phrase file specified")) + (or (file-readable-p file) (user-error "Cannot read file `%s'" file)) + file) + ;;;###autoload -(defun cookie (phrase-file startmsg endmsg) +(defun cookie (phrase-file &optional startmsg endmsg) "Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at the beginning -of load, ENDMSG at the end." - (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) - (shuffle-vector cookie-vector) - (aref cookie-vector 0))) +of load, ENDMSG at the end. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used." + (interactive (list (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file) nil nil)) + (setq phrase-file (cookie-check-file phrase-file)) + (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)) + res) + (cookie-shuffle-vector cookie-vector) + (setq res (aref cookie-vector 0)) + (if (called-interactively-p 'interactive) + (message "%s" res) + res))) ;;;###autoload (defun cookie-insert (phrase-file &optional count startmsg endmsg) "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at the beginning of load, ENDMSG at the end." + (setq phrase-file (cookie-check-file phrase-file)) (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) - (shuffle-vector cookie-vector) + (cookie-shuffle-vector cookie-vector) (let ((start (point))) (insert ?\n) (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) @@ -89,12 +118,11 @@ of load, ENDMSG at the end." (cookie1 (1- arg) cookie-vec)))) ;;;###autoload -(defun cookie-snarf (phrase-file startmsg endmsg) +(defun cookie-snarf (phrase-file &optional startmsg endmsg) "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." - (or (file-readable-p phrase-file) - (error "Cannot read file `%s'" phrase-file)) + (setq phrase-file (cookie-check-file phrase-file)) (let ((sym (intern-soft phrase-file cookie-cache))) (and sym (not (equal (symbol-function sym) (nth 5 (file-attributes phrase-file)))) @@ -104,27 +132,25 @@ and subsequent calls on the same file won't go to disk." (if sym (symbol-value sym) (setq sym (intern phrase-file cookie-cache)) - (message "%s" startmsg) - (save-excursion - (let ((buf (generate-new-buffer "*cookie*")) - (result nil)) - (set-buffer buf) - (fset sym (nth 5 (file-attributes phrase-file))) + (if startmsg (message "%s" startmsg)) + (fset sym (nth 5 (file-attributes phrase-file))) + (let (result) + (with-temp-buffer (insert-file-contents (expand-file-name phrase-file)) (re-search-forward cookie-delimiter) (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) (let ((beg (point))) (re-search-forward cookie-delimiter) (setq result (cons (buffer-substring beg (match-beginning 0)) - result)))) - (kill-buffer buf) - (message "%s" endmsg) - (set sym (apply 'vector result))))))) + result))))) + (if endmsg (message "%s" endmsg)) + (set sym (apply 'vector result)))))) -(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) +(defun cookie-read (prompt phrase-file &optional startmsg endmsg require-match) "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. STARTMSG and ENDMSG are passed along to `cookie-snarf'. -Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." +Argument REQUIRE-MATCH non-nil forces a matching cookie." + (setq phrase-file (cookie-check-file phrase-file)) ;; Make sure the cookies are in the cache. (or (intern-soft phrase-file cookie-cache) (cookie-snarf phrase-file startmsg endmsg)) @@ -141,24 +167,80 @@ Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." (put sym 'completion-alist alist)))) nil require-match nil nil)) -; Thanks to Ian G Batten -; [of the University of Birmingham Computer Science Department] -; for the iterative version of this shuffle. -; -;;;###autoload -(defun shuffle-vector (vector) +(define-obsolete-function-alias 'read-cookie 'cookie-read "24.4") + +;; Thanks to Ian G Batten +;; [of the University of Birmingham Computer Science Department] +;; for the iterative version of this shuffle. +(defun cookie-shuffle-vector (vector) "Randomly permute the elements of VECTOR (all permutations equally likely)." - (let ((i 0) - j - temp - (len (length vector))) - (while (< i len) - (setq j (+ i (random (- len i)))) - (setq temp (aref vector i)) + (let ((len (length vector)) + j temp) + (dotimes (i len vector) + (setq j (+ i (random (- len i))) + temp (aref vector i)) (aset vector i (aref vector j)) - (aset vector j temp) - (setq i (1+ i)))) - vector) + (aset vector j temp)))) + +(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") + + +(defun cookie-apropos (regexp phrase-file &optional display) + "Return a list of all entries matching REGEXP from PHRASE-FILE. +Interactively, uses `read-regexp' to read REGEXP. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used. +If called interactively, or if DISPLAY is non-nil, display a list of matches." + (interactive (list (read-regexp "Apropos phrase (regexp): ") + (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file) t)) + (setq phrase-file (cookie-check-file phrase-file)) + ;; Make sure phrases are loaded. + (cookie phrase-file) + (let* ((case-fold-search t) + (cookie-table-symbol (intern phrase-file cookie-cache)) + (string-table (symbol-value cookie-table-symbol)) + (matches nil)) + (and (dotimes (i (length string-table) matches) + (and (string-match-p regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches)))) + (setq matches (sort matches 'string-lessp))) + (and display + (if matches + (let ((l matches)) + (with-output-to-temp-buffer "*Cookie Apropos*" + (while l + (princ (car l)) + (setq l (cdr l)) + (and l (princ "\n\n"))) + (help-print-return-message))) + (message "No matches found."))) + matches)) + + +(declare-function doctor-ret-or-read "doctor" (arg)) + +(defun cookie-doctor (phrase-file) + "Feed cookie phrases from PHRASE-FILE to the doctor. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used." + (interactive (list (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file))) + (setq phrase-file (cookie-check-file phrase-file)) + (doctor) ; start the psychotherapy + (message "") + (switch-to-buffer "*doctor*") + (sit-for 0) + (while (not (input-pending-p)) + (insert (cookie phrase-file)) + (sit-for 0) + (doctor-ret-or-read 1) + (doctor-ret-or-read 1))) + (provide 'cookie1) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index c02e36fd307..247b15b4355 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -1,6 +1,6 @@ ;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers ;; -;; Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-1996, 2001-2014 Free Software Foundation, Inc. ;; ;; Author: Christopher J. Madsen ;; Keywords: games diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el index 376a8c357b2..0d980d6ba5e 100644 --- a/lisp/play/dissociate.el +++ b/lisp/play/dissociate.el @@ -1,8 +1,8 @@ ;;; dissociate.el --- scramble text amusingly for Emacs -;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ;; This file is part of GNU Emacs. diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 4c50461011c..13e6f8ee87a 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -1,9 +1,9 @@ ;;; doctor.el --- psychological help for frustrated users -;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2013 Free Software +;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ;; This file is part of GNU Emacs. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index db525fe531f..0028b7258ae 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1,6 +1,6 @@ -;;; dunnet.el --- text adventure for Emacs -*- byte-compile-warnings: nil -*- +;;; dunnet.el --- text adventure for Emacs -;; Copyright (C) 1992-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-1993, 2001-2014 Free Software Foundation, Inc. ;; Author: Ron Schnell ;; Created: 25 Jul 1992 @@ -1386,7 +1386,7 @@ for a moment, then straighten yourself up. (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) (rlogin . dun-rlogin) (uncompress . dun-uncompress) - (cat . dun-cat) (zippy . dun-zippy))) + (cat . dun-cat))) (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) @@ -2996,9 +2996,6 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-mprincl "Ascii files only.") (dun-mprincl "File not found.")))))))) -(defun dun-zippy (args) - (dun-mprincl (yow))) - (defun dun-rlogin-endgame () (if (not (= (dun-score nil) 90)) (dun-mprincl @@ -3356,3 +3353,7 @@ File not found"))) (provide 'dunnet) ;;; dunnet.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not free-vars lexical) +;; End: diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index cb58c0d0af0..9e56215023c 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -1,6 +1,6 @@ ;;; fortune.el --- use fortune to create signatures -;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001-2014 Free Software Foundation, Inc. ;; Author: Holger Schauer ;; Keywords: games utils mail diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index b6fd064ca84..4f2be487463 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -1,6 +1,6 @@ ;;; gamegrid.el --- library for implementing grid-based games on Emacs -;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2001-2014 Free Software Foundation, Inc. ;; Author: Glynn Clements ;; Version: 1.02 diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 3daf9d5f784..a2a93730cf0 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -1,6 +1,6 @@ ;;; gametree.el --- manage game analysis trees in Emacs -;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001-2014 Free Software Foundation, Inc. ;; Author: Ian T Zimmerman ;; Created: Wed Dec 10 07:41:46 PST 1997 @@ -399,23 +399,23 @@ depth AT-DEPTH or smaller is found." (error (goto-char (point-max)) (if (not (bolp)) (insert "\n")))) - (let ((starting-plys + (let ((starting-plies (if (> (gametree-current-branch-depth) parent-depth) (gametree-current-branch-ply) (save-excursion (forward-line -1) (gametree-current-branch-ply))))) (goto-char (1- (point))) (insert "\n") - (insert (format (if (= 0 (mod starting-plys 2)) + (insert (format (if (= 0 (mod starting-plies 2)) gametree-full-ply-format gametree-half-ply-format) - (/ starting-plys 2)))))) + (/ starting-plies 2)))))) (defun gametree-break-line-here (&optional at-move) "Split the variation node at the point position. This command works whether the current variation node is a leaf, or is already branching at its end. The new node is created at a level that -reflects the number of game plys between the beginning of the current +reflects the number of game plies between the beginning of the current variation and the breaking point. With a numerical argument AT-MOVE, split the variation before @@ -436,7 +436,7 @@ only work of Black's moves are explicitly numbered, for instance (goto-char (match-beginning 0)))) (gametree-transpose-following-leaves) (let* ((pt (point-marker)) - (plys (gametree-current-branch-ply)) + (plies (gametree-current-branch-ply)) (depth (gametree-current-branch-depth)) (old-depth depth)) (if (= depth 0) @@ -451,7 +451,7 @@ only work of Black's moves are explicitly numbered, for instance (if (zerop old-branch-ply) (1+ (gametree-current-branch-depth)) (+ (gametree-current-branch-depth) - (- plys old-branch-ply)))))) + (- plies old-branch-ply)))))) (save-excursion (beginning-of-line 1) (funcall gametree-make-heading-function depth) @@ -471,7 +471,7 @@ only work of Black's moves are explicitly numbered, for instance (insert "\n") (if (not (= 0 old-depth)) (funcall gametree-make-heading-function - (+ depth (- (gametree-current-branch-ply) plys)))) + (+ depth (- (gametree-current-branch-ply) plies)))) (gametree-prettify-heading)))) (defun gametree-merge-line () @@ -531,8 +531,10 @@ Subnodes which have been manually scored are honored." (defun gametree-layout-to-register (register) "Store current tree layout in register REGISTER. Use \\[gametree-apply-register-layout] to restore that configuration. -Argument is a character, naming the register." - (interactive "cLayout to register: ") +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Layout to register: "))) (save-excursion (goto-char (point-min)) (set-register register @@ -540,8 +542,13 @@ Argument is a character, naming the register." (defun gametree-apply-register-layout (char) "Return to a tree layout stored in a register. -Argument is a character, naming the register." - (interactive "*cApply layout from register: ") +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." + (interactive + (progn + (barf-if-buffer-read-only) + (list (register-read-with-preview "Apply layout from register: ")))) (save-excursion (goto-char (point-min)) (gametree-apply-layout (get-register char) 0 t))) diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index f2abc00e3f5..1cd1f81b6f8 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -1,10 +1,10 @@ -;;; gomoku.el --- Gomoku game between you and Emacs +;;; gomoku.el --- Gomoku game between you and Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1988, 1994, 1996, 2001-2013 Free Software Foundation, +;; Copyright (C) 1988, 1994, 1996, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Philippe Schnoebelen -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Adapted-By: ESR, Daniel Pfeiffer ;; Keywords: games @@ -176,14 +176,9 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X))) "Font lock rules for Gomoku.") -(put 'gomoku-mode 'front-sticky - (put 'gomoku-mode 'rear-nonsticky '(intangible))) -(put 'gomoku-mode 'intangible 1) ;; This one is for when they set view-read-only to t: Gomoku cannot ;; allow View Mode to be activated in its buffer. -(put 'gomoku-mode 'mode-class 'special) - -(define-derived-mode gomoku-mode nil "Gomoku" +(define-derived-mode gomoku-mode special-mode "Gomoku" "Major mode for playing Gomoku against Emacs. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous @@ -196,7 +191,8 @@ Other useful commands:\n (gomoku-display-statistics) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(gomoku-font-lock-keywords t) - buffer-read-only t)) + buffer-read-only t) + (add-hook 'post-command-hook #'gomoku--intangible nil t)) ;;; ;;; THE BOARD. @@ -836,8 +832,7 @@ Use \\[describe-mode] for more info." (min (max (/ (+ (- (cdr click) gomoku-y-offset 1) - (let ((inhibit-point-motion-hooks t)) - (count-lines 1 (window-start))) + (count-lines (point-min) (window-start)) gomoku-square-height (% gomoku-square-height 2) (/ gomoku-square-height 2)) @@ -948,29 +943,28 @@ If the game is finished, this command requests for another game." (defun gomoku-max-width () "Largest possible board width for the current window." - (1+ (/ (- (window-width (selected-window)) + (1+ (/ (- (window-width) gomoku-x-offset gomoku-x-offset 1) gomoku-square-width))) (defun gomoku-max-height () "Largest possible board height for the current window." - (1+ (/ (- (window-height (selected-window)) + (1+ (/ (- (window-height) gomoku-y-offset gomoku-y-offset 2) ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! gomoku-square-height))) (defun gomoku-point-y () "Return the board row where point is." - (let ((inhibit-point-motion-hooks t)) - (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1)) - gomoku-square-height)))) + (1+ (/ (- (count-lines (point-min) (point)) + gomoku-y-offset (if (bolp) 0 1)) + gomoku-square-height))) (defun gomoku-point-square () "Return the index of the square point is on." - (let ((inhibit-point-motion-hooks t)) - (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset) - gomoku-square-width)) - (gomoku-point-y)))) + (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset) + gomoku-square-width)) + (gomoku-point-y))) (defun gomoku-goto-square (index) "Move point to square number INDEX." @@ -978,20 +972,18 @@ If the game is finished, this command requests for another game." (defun gomoku-goto-xy (x y) "Move point to square at X, Y coords." - (let ((inhibit-point-motion-hooks t)) - (goto-char (point-min)) - (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y))))) + (goto-char (point-min)) + (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y)))) (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) (defun gomoku-plot-square (square value) "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." (or (= value 1) (gomoku-goto-square square)) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (insert-and-inherit (cond ((= value 1) ?X) - ((= value 6) ?O) - (?.))) + (let ((inhibit-read-only t)) + (insert (cond ((= value 1) ?X) + ((= value 6) ?O) + (?.))) (and (zerop value) (add-text-properties (1- (point)) (point) @@ -1004,8 +996,7 @@ If the game is finished, this command requests for another game." "Display an N by M Gomoku board." (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t) - (point 1) opoint - (intangible t) + (point (point-min)) opoint (i m) j x) ;; Try to minimize number of chars (because of text properties) (setq tab-width @@ -1014,17 +1005,15 @@ If the game is finished, this command requests for another game." (max (/ (+ (% gomoku-x-offset gomoku-square-width) gomoku-square-width 1) 2) 2))) (erase-buffer) - (newline gomoku-y-offset) + (insert-char ?\n gomoku-y-offset) (while (progn (setq j n x (- gomoku-x-offset gomoku-square-width)) (while (>= (setq j (1- j)) 0) - (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width)) - (current-column)) - tab-width)) - (insert-char ? (- x (current-column))) - (if (setq intangible (not intangible)) - (put-text-property point (point) 'intangible 2)) + (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width)) + (current-column)) + tab-width)) + (insert-char ?\s (- x (current-column))) (and (zerop j) (= i (- m 2)) (progn @@ -1042,16 +1031,9 @@ If the game is finished, this command requests for another game." (if (= i (1- m)) (setq opoint point)) (insert-char ?\n gomoku-square-height)) - (or (eq (char-after 1) ?.) - (put-text-property 1 2 'point-entered - (lambda (_x _y) (if (bobp) (forward-char))))) - (or intangible - (put-text-property point (point) 'intangible 2)) - (put-text-property point (point) 'point-entered - (lambda (_x _y) (if (eobp) (backward-char)))) - (put-text-property (point-min) (point) 'category 'gomoku-mode)) + (insert-char ?\n)) (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board - (sit-for 0)) ; Display NOW + (sit-for 0)) ; Display NOW (defun gomoku-display-statistics () "Obnoxiously display some statistics about previous games in mode line." @@ -1114,8 +1096,7 @@ If the game is finished, this command requests for another game." "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." (save-excursion ; Not moving point from last square (let ((depl (gomoku-xy-to-index dx dy)) - (inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (inhibit-read-only t)) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 (while (/= square1 square2) (gomoku-goto-square square1) @@ -1134,36 +1115,57 @@ If the game is finished, this command requests for another game." (setq n (1+ n)) (forward-line 1) (indent-to column) - (insert-and-inherit ?|)))) + (insert ?|)))) ((= dx -1) ; 1st Diagonal (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2)) (forward-line (/ gomoku-square-height 2)))) - (insert-and-inherit ?/)) + (insert ?/)) (t ; 2nd Diagonal (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2)) (forward-line (/ gomoku-square-height 2)))) - (insert-and-inherit ?\\)))))) + (insert ?\\)))))) (sit-for 0)) ; Display NOW ;;; ;;; CURSOR MOTION. ;;; + +(defvar-local gomoku--last-pos 0) + +(defconst gomoku--intangible-chars "- \t\n|/\\\\") + +(defun gomoku--intangible () + (when (or (eobp) + (save-excursion + (not (zerop (skip-chars-forward gomoku--intangible-chars))))) + (if (<= gomoku--last-pos (point)) ;Moving forward. + (progn + (skip-chars-forward gomoku--intangible-chars) + (when (eobp) + (skip-chars-backward gomoku--intangible-chars) + (forward-char -1))) + (skip-chars-backward gomoku--intangible-chars) + (if (bobp) + (skip-chars-forward gomoku--intangible-chars) + (forward-char -1)))) + (setq gomoku--last-pos (point))) + ;; previous-line and next-line don't work right with intangible newlines (defun gomoku-move-down () "Move point down one row on the Gomoku board." (interactive) - (if (< (gomoku-point-y) gomoku-board-height) - (let ((column (current-column))) - (forward-line gomoku-square-height) - (move-to-column column)))) + (when (< (gomoku-point-y) gomoku-board-height) + (let ((column (current-column))) + (forward-line gomoku-square-height) + (move-to-column column)))) (defun gomoku-move-up () "Move point up one row on the Gomoku board." (interactive) - (if (> (gomoku-point-y) 1) - (let ((column (current-column))) - (forward-line (- 1 gomoku-square-height)) - (move-to-column column)))) + (when (> (gomoku-point-y) 1) + (let ((column (current-column))) + (forward-line (- gomoku-square-height)) + (move-to-column column)))) (defun gomoku-move-ne () "Move point North East on the Gomoku board." diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index de6c198092e..51e0a0f4e4d 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -1,6 +1,6 @@ -;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: iso-latin-1; -*- +;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: utf-8; -*- -;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2014 Free Software Foundation, Inc. ;; Author: Danny Roozendaal (was: ) ;; Created: October 21 1996 @@ -170,15 +170,15 @@ Variables: `handwrite-linespace' (default 12) (textp) (ps-buf-name) ;name of the PostScript buffer (trans-table - '(("" . "264") ("" . "207") ("" . "210") ("" . "211") - ("" . "212") ("" . "213") ("" . "214") ("" . "216") - ("" . "217") ("" . "220") ("" . "221") ("" . "222") - ("" . "223") ("" . "224") ("" . "225") ("" . "227") - ("" . "230") ("" . "231") ("" . "232") ("" . "233") - ("" . "234") ("" . "235") ("" . "236") ("" . "237") - ("" . "247") ("" . "241") ("" . "250") ("" . "251") - ("ij" . "264") ("" . "215") ("" . "244") ("" . "226") - ("" . "243"))) + '(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211") + ("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216") + ("è" . "217") ("ê" . "220") ("ë" . "221") ("í" . "222") + ("ì" . "223") ("î" . "224") ("ï" . "225") ("ó" . "227") + ("ò" . "230") ("ô" . "231") ("ö" . "232") ("õ" . "233") + ("ú" . "234") ("ù" . "235") ("û" . "236") ("ü" . "237") + ("ß" . "247") ("°" . "241") ("®" . "250") ("©" . "251") + ("ij" . "264") ("ç" . "215") ("§" . "244") ("ñ" . "226") + ("£" . "243"))) (escape-table '("\\\\" "(" ")")) ; \\ comes first to not work ; on inserted backslashes line) @@ -244,7 +244,7 @@ Variables: `handwrite-linespace' (default 12) (insert "showpage exec Hwsave restore\n\n") (insert "%%Pages " (number-to-string ipage) " 0\n") (insert "%%EOF\n") - ;;To avoid cumbersome code we simply ignore pagefeeds + ;;To avoid cumbersome code we simply ignore formfeeds (goto-char textp) (while (search-forward "\f" nil t) (replace-match "" nil t) ) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 9e8b6ff97eb..b868db68f30 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -1,7 +1,7 @@ ;;; hanoi.el --- towers of hanoi in Emacs ;; Author: Damon Anton Permezel -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ; Author (a) 1985, Damon Anton Permezel diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 0845ea2c300..5c516e70f99 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -1,6 +1,6 @@ ;;; landmark.el --- neural-network robot that learns landmarks -;; Copyright (C) 1996-1997, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Terrence Brannon (was: ) ;; Created: December 16, 1996 - first release to usenet @@ -233,10 +233,8 @@ (put 'landmark-mode 'intangible 1) ;; This one is for when they set view-read-only to t: Landmark cannot ;; allow View Mode to be activated in its buffer. -(put 'landmark-mode 'mode-class 'special) - -(defun landmark-mode () - "Major mode for playing Landmark against Emacs. +(define-derived-mode landmark-mode special-mode "Lm" + "Major mode for playing Lm against Emacs. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. @@ -247,16 +245,9 @@ Other useful commands: \\{landmark-mode-map} Entry to this mode calls the value of `landmark-mode-hook' if that value is non-nil. One interesting value is `turn-on-font-lock'." - (interactive) - (kill-all-local-variables) - (setq major-mode 'landmark-mode - mode-name "Landmark") (landmark-display-statistics) - (use-local-map landmark-mode-map) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(landmark-font-lock-keywords t) - buffer-read-only t) - (run-mode-hooks 'landmark-mode-hook)) + (setq-local font-lock-defaults '(landmark-font-lock-keywords t)) + (setq buffer-read-only t)) ;;;_ + THE SCORE TABLE. @@ -843,13 +834,13 @@ If the game is finished, this command requests for another game." (defun landmark-max-width () "Largest possible board width for the current window." - (1+ (/ (- (window-width (selected-window)) + (1+ (/ (- (window-width) landmark-x-offset landmark-x-offset 1) landmark-square-width))) (defun landmark-max-height () "Largest possible board height for the current window." - (1+ (/ (- (window-height (selected-window)) + (1+ (/ (- (window-height) landmark-y-offset landmark-y-offset 2) ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! landmark-square-height))) diff --git a/lisp/play/life.el b/lisp/play/life.el index a52c5477bb7..a79fc9c0b7e 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -1,9 +1,9 @@ ;;; life.el --- John Horton Conway's `Life' game for GNU Emacs -;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 2001-2014 Free Software Foundation, Inc. ;; Author: Kyle Jones -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ;; This file is part of GNU Emacs. @@ -122,33 +122,32 @@ generations (this defaults to 1)." (life-setup) (catch 'life-exit (while t - (let ((inhibit-quit t)) + (let ((inhibit-quit t) + (inhibit-read-only t)) (life-display-generation sleeptime) (life-grim-reaper) (life-expand-plane-if-needed) (life-increment-generation))))) -(defalias 'life-mode 'life) -(put 'life-mode 'mode-class 'special) +(define-derived-mode life-mode special-mode "Life" + "Major mode for the buffer of `life'." + (setq-local case-fold-search nil) + (setq-local truncate-lines t) + (setq-local show-trailing-whitespace nil) + (setq-local life-current-generation 0) + (setq-local life-generation-string "0") + (setq-local mode-line-buffer-identification '("Life: generation " + life-generation-string)) + (setq-local fill-column (1- (window-width))) + (setq-local life-window-start 1) + (buffer-disable-undo)) (defun life-setup () - (let (n) - (switch-to-buffer (get-buffer-create "*Life*") t) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search nil - mode-name "Life" - major-mode 'life-mode - truncate-lines t - show-trailing-whitespace nil - life-current-generation 0 - life-generation-string "0" - mode-line-buffer-identification '("Life: generation " - life-generation-string) - fill-column (1- (window-width)) - life-window-start 1) - (buffer-disable-undo (current-buffer)) - ;; stuff in the random pattern + (switch-to-buffer (get-buffer-create "*Life*") t) + (erase-buffer) + (life-mode) + ;; stuff in the random pattern + (let ((inhibit-read-only t)) (life-insert-random-pattern) ;; make sure (life-life-char) is used throughout (goto-char (point-min)) @@ -156,18 +155,18 @@ generations (this defaults to 1)." (replace-match (life-life-string) t t)) ;; center the pattern horizontally (goto-char (point-min)) - (setq n (/ (- fill-column (line-end-position)) 2)) - (while (not (eobp)) - (indent-to n) - (forward-line)) + (let ((n (/ (- fill-column (line-end-position)) 2))) + (while (not (eobp)) + (indent-to n) + (forward-line))) ;; center the pattern vertically - (setq n (/ (- (1- (window-height)) - (count-lines (point-min) (point-max))) - 2)) - (goto-char (point-min)) - (newline n) - (goto-char (point-max)) - (newline n) + (let ((n (/ (- (1- (window-height)) + (count-lines (point-min) (point-max))) + 2))) + (goto-char (point-min)) + (newline n) + (goto-char (point-max)) + (newline n)) ;; pad lines out to fill-column (goto-char (point-min)) (while (not (eobp)) @@ -290,8 +289,7 @@ generations (this defaults to 1)." (life-display-generation 0) (signal 'life-extinct nil)) -(put 'life-extinct 'error-conditions '(life-extinct quit)) -(put 'life-extinct 'error-message "All life has perished") +(define-error 'life-extinct "All life has perished" 'quit) ;FIXME: quit really? (provide 'life) diff --git a/lisp/play/morse.el b/lisp/play/morse.el index 54dfd1c4ea3..5394d3f283e 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el @@ -1,6 +1,6 @@ ;;; morse.el --- convert text to morse code and back -*- coding: utf-8 -*- -;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc. ;; Author: Rick Farnbach ;; Keywords: games diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index e4e627a5293..d3d55b30520 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -1,6 +1,6 @@ ;;; mpuz.el --- multiplication puzzle for GNU Emacs -;; Copyright (C) 1990, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990, 2001-2014 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen ;; Overhauled: Daniel Pfeiffer @@ -94,7 +94,9 @@ The value t means never ding, and `error' means only ding on wrong input." map) "Local keymap to use in Mult Puzzle.") -(defun mpuz-mode () + + +(define-derived-mode mpuz-mode fundamental-mode "Mult Puzzle" "Multiplication puzzle mode. You have to guess which letters stand for which digits in the @@ -106,13 +108,7 @@ then the digit. Thus, to guess that A=3, type `A 3'. To leave the game to do other editing work, just switch buffers. Then you may resume the game with M-x mpuz. You may abort a game by typing \\\\[mpuz-offer-abort]." - (interactive) - (kill-all-local-variables) - (setq major-mode 'mpuz-mode - mode-name "Mult Puzzle" - tab-width 30) - (use-local-map mpuz-mode-map) - (run-mode-hooks 'mpuz-mode-hook)) + (setq tab-width 30)) ;; Some variables for statistics diff --git a/lisp/play/pong.el b/lisp/play/pong.el index 65293485982..463d412ec54 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -1,6 +1,6 @@ ;;; pong.el --- classical implementation of pong -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Benjamin Drieu ;; Keywords: games diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 85acfb116d2..d1874c66fe0 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -1,6 +1,6 @@ ;;; snake.el --- implementation of Snake for Emacs -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Glynn Clements ;; Created: 1997-09-10 @@ -353,21 +353,13 @@ Argument SNAKE-BUFFER is the name of the buffer." (put 'snake-mode 'mode-class 'special) -(defun snake-mode () - "A mode for playing Snake. - -Snake mode keybindings: - \\{snake-mode-map} -" - (kill-all-local-variables) +(define-derived-mode snake-mode special-mode "Snake" + "A mode for playing Snake." (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) (use-local-map snake-null-map) - (setq major-mode 'snake-mode) - (setq mode-name "Snake") - (unless (featurep 'emacs) (setq mode-popup-menu '("Snake Commands" @@ -382,9 +374,7 @@ Snake mode keybindings: (setq gamegrid-use-glyphs snake-use-glyphs-flag) (setq gamegrid-use-color snake-use-color-flag) - (gamegrid-init (snake-display-options)) - - (run-mode-hooks 'snake-mode-hook)) + (gamegrid-init (snake-display-options))) ;;;###autoload (defun snake () diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 86d9408118b..884b126f712 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -1,6 +1,6 @@ ;;; solitaire.el --- game of solitaire in Emacs Lisp -;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Jan Schormann ;; Created: Fri afternoon, Jun 3, 1994 diff --git a/lisp/play/spook.el b/lisp/play/spook.el index 08c31d3878b..fdc3c6915aa 100644 --- a/lisp/play/spook.el +++ b/lisp/play/spook.el @@ -1,8 +1,8 @@ ;;; spook.el --- spook phrase utility for overloading the NSA line eater -;; Copyright (C) 1988, 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1993, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ;; Created: May 1987 @@ -69,10 +69,6 @@ "Checking authorization..." "Checking authorization...Approved")) -;; Note: the implementation that used to take up most of this file has been -;; cleaned up, generalized, gratuitously broken by esr, and now resides in -;; cookie1.el. - (provide 'spook) ;;; spook.el ends here diff --git a/lisp/play/studly.el b/lisp/play/studly.el index d28304df1e5..f6aae4548b1 100644 --- a/lisp/play/studly.el +++ b/lisp/play/studly.el @@ -5,7 +5,7 @@ ;; This file is part of GNU Emacs. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: games ;;; Commentary: diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index dd33d067246..26fd73fdac0 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -1,6 +1,6 @@ ;;; tetris.el --- implementation of Tetris for Emacs -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Glynn Clements ;; Version: 2.01 @@ -77,20 +77,13 @@ If the return value is a number, it is used as the timer period." ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] "Vector of colors of the various shapes in text mode." :group 'tetris - :type (let ((names `("Shape 1" "Shape 2" "Shape 3" - "Shape 4" "Shape 5" "Shape 6" "Shape 7")) - (result nil)) - (while names - (add-to-list 'result - (cons 'choice - (cons :tag - (cons (car names) - (mapcar (lambda (color) - (list 'const color)) - (defined-colors))))) - t) - (setq names (cdr names))) - result)) + :type '(vector (color :tag "Shape 1") + (color :tag "Shape 2") + (color :tag "Shape 3") + (color :tag "Shape 4") + (color :tag "Shape 5") + (color :tag "Shape 6") + (color :tag "Shape 7"))) (defcustom tetris-x-colors [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 1724ebdf198..17b69937586 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -1,6 +1,6 @@ ;;; zone.el --- idle display hacks -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Victor Zandy ;; Maintainer: Thien-Thi Nguyen @@ -110,7 +110,7 @@ If the element is a function or a list of a function and a number, (let ((f (selected-frame)) (outbuf (get-buffer-create "*zone*")) (text (buffer-substring (window-start) (window-end))) - (wp (1+ (- (window-point (selected-window)) + (wp (1+ (- (window-point) (window-start))))) (put 'zone 'orig-buffer (current-buffer)) (switch-to-buffer outbuf) diff --git a/lisp/printing.el b/lisp/printing.el index bf50aa8f679..bb7e3843c32 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1,6 +1,6 @@ ;;; printing.el --- printing utilities -;; Copyright (C) 2000-2001, 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2001, 2003-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre @@ -1030,7 +1030,7 @@ Please send all bug fixes and enhancements to (defconst pr-cygwin-system - (and ps-windows-system (getenv "OSTYPE") + (and lpr-windows-system (getenv "OSTYPE") (string-match "cygwin" (getenv "OSTYPE")))) @@ -1342,6 +1342,10 @@ Used by `pr-menu-bind' and `pr-update-menus'.") ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GNU Emacs Definitions +(eval-and-compile + (unless (featurep 'xemacs) + (defvar pr-menu-bar nil + "Specify Printing menu-bar entry."))) (cond ((featurep 'xemacs) ; XEmacs @@ -1372,9 +1376,6 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (defun pr-menu-char-width () (frame-char-width)) - (defvar pr-menu-bar nil - "Specify Printing menu-bar entry.") - ;; GNU Emacs ;; Menu binding ;; Replace existing "print" item by "Printing" item. @@ -1413,7 +1414,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (eval-and-compile (cond - (ps-windows-system + (lpr-windows-system ;; GNU Emacs for Windows 9x/NT (defun pr-menu-position (entry index horizontal) (let ((pos (cdr (mouse-pixel-position)))) @@ -1613,7 +1614,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.") "Ensure the proper directory separator depending on the OS. That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory separator; otherwise, ensure unix-style directory separator." - (if (or pr-cygwin-system ps-windows-system) + (if (or pr-cygwin-system lpr-windows-system) (subst-char-in-string ?/ ?\\ path) (subst-char-in-string ?\\ ?/ path))) @@ -1666,7 +1667,7 @@ separator; otherwise, ensure unix-style directory separator." (defcustom pr-path-style (if (and (not pr-cygwin-system) - ps-windows-system) + lpr-windows-system) 'windows 'unix) "Specify which path style to use for external commands. @@ -1777,7 +1778,7 @@ function (see it for documentation) to update text printer menu." (defcustom pr-txt-printer-alist (list (list 'default lpr-command nil (cond ((boundp 'printer-name) printer-name) - (ps-windows-system "PRN") + (lpr-windows-system "PRN") (t nil) ))) ;; Examples: @@ -1922,8 +1923,8 @@ function (see it for documentation) to update PostScript printer menu." (defcustom pr-ps-printer-alist (list (list 'default lpr-command nil - (cond (ps-windows-system nil) - (ps-lp-system "-d") + (cond (lpr-windows-system nil) + (lpr-lp-system "-d") (t "-P")) (or (getenv "PRINTER") (getenv "LPDEST") ps-printer-name))) ;; Examples: @@ -2199,7 +2200,7 @@ Useful links: ;; hacked from `temporary-file-directory' variable in files.el (file-name-as-directory (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (cond (ps-windows-system "c:/temp") + (cond (lpr-windows-system "c:/temp") (t "/tmp") ))))) "Specify a directory for temporary files during printing. @@ -2231,7 +2232,7 @@ See also `pr-temp-dir' and `pr-ps-temp-file'." (defcustom pr-gv-command - (if ps-windows-system + (if lpr-windows-system "gsview32.exe" "gv") "Specify path and name of the gsview/gv utility. @@ -2272,7 +2273,7 @@ Useful links: (defcustom pr-gs-command - (if ps-windows-system + (if lpr-windows-system "gswin32.exe" "gs") "Specify path and name of the ghostscript utility. @@ -2298,7 +2299,7 @@ Useful links: (defcustom pr-gs-switches - (if ps-windows-system + (if lpr-windows-system '("-q -dNOPAUSE -Ic:/gs/gs5.50;c:/gs/gs5.50/fonts") '("-q -dNOPAUSE -I/usr/share/ghostscript/5.10")) "Specify ghostscript switches. See the documentation on GS for more info. @@ -2340,7 +2341,7 @@ Useful links: (defcustom pr-gs-device - (if ps-windows-system + (if lpr-windows-system "mswinpr2" "uniprint") "Specify the ghostscript device switch value (-sDEVICE=). @@ -4626,21 +4627,21 @@ bottom." ;;;###autoload -(defun pr-customize (&rest ignore) +(defun pr-customize (&rest _ignore) "Customization of the `printing' group." (interactive) (customize-group 'printing)) ;;;###autoload -(defun lpr-customize (&rest ignore) +(defun lpr-customize (&rest _ignore) "Customization of the `lpr' group." (interactive) (customize-group 'lpr)) ;;;###autoload -(defun pr-help (&rest ignore) +(defun pr-help (&rest _ignore) "Help for the printing package." (interactive) (pr-show-setup pr-help-message "*Printing Help*")) @@ -4674,21 +4675,21 @@ bottom." ;;;###autoload -(defun pr-show-ps-setup (&rest ignore) +(defun pr-show-ps-setup (&rest _ignore) "Show current ps-print settings." (interactive) (pr-show-setup (ps-setup) "*PS Setup*")) ;;;###autoload -(defun pr-show-pr-setup (&rest ignore) +(defun pr-show-pr-setup (&rest _ignore) "Show current printing settings." (interactive) (pr-show-setup (pr-setup) "*PR Setup*")) ;;;###autoload -(defun pr-show-lpr-setup (&rest ignore) +(defun pr-show-lpr-setup (&rest _ignore) "Show current lpr settings." (interactive) (pr-show-setup (lpr-setup) "*LPR Setup*")) @@ -4851,8 +4852,8 @@ Or choose the menu option Printing/Show Settings/printing." (ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch) (ps-comment-string "pr-ps-printer " pr-ps-printer) (ps-comment-string "pr-cygwin-system " pr-cygwin-system) - (ps-comment-string "ps-windows-system " ps-windows-system) - (ps-comment-string "ps-lp-system " ps-lp-system) + (ps-comment-string "lpr-windows-system " lpr-windows-system) + (ps-comment-string "lpr-lp-system " lpr-lp-system) nil '(14 . pr-path-style) '(14 . pr-path-alist) @@ -5234,14 +5235,14 @@ If menu binding was not done, calls `pr-menu-bind'." pr-ps-printer (nth 3 ps)) (or (stringp pr-ps-command) (setq pr-ps-command - (cond (ps-windows-system "print") - (ps-lp-system "lp") + (cond (lpr-windows-system "print") + (lpr-lp-system "lp") (t "lpr") ))) (or (stringp pr-ps-printer-switch) (setq pr-ps-printer-switch - (cond (ps-windows-system "/D:") - (ps-lp-system "-d") + (cond (lpr-windows-system "/D:") + (lpr-lp-system "-d") (t "-P") ))) (pr-eval-alist (nthcdr 4 ps))) @@ -5259,8 +5260,8 @@ If menu binding was not done, calls `pr-menu-bind'." pr-txt-printer (nth 2 txt))) (or (stringp pr-txt-command) (setq pr-txt-command - (cond (ps-windows-system "print") - (ps-lp-system "lp") + (cond (lpr-windows-system "print") + (lpr-lp-system "lp") (t "lpr") ))) (pr-update-mode-line)) @@ -5666,7 +5667,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-switches (switches mess) (or (listp switches) (error "%S should have a list of strings" mess)) - (ps-flatten-list ; dynamic evaluation + (lpr-flatten-list ; dynamic evaluation (mapcar 'ps-eval-switch switches))) @@ -5824,7 +5825,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-find-buffer-visiting (file) (if (not (file-directory-p file)) - (find-buffer-visiting (if ps-windows-system + (find-buffer-visiting (if lpr-windows-system (downcase file) file)) (let ((truename (file-truename file)) @@ -5938,7 +5939,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-dosify-file-name (or (pr-find-command command) (pr-path-command (cond (pr-cygwin-system 'cygwin) - (ps-windows-system 'windows) + (lpr-windows-system 'windows) (t 'unix)) (file-name-nondirectory command) nil) @@ -5975,7 +5976,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-find-command (cmd) - (if ps-windows-system + (if lpr-windows-system ;; windows system (let ((ext (cons (file-name-extension cmd t) (list ".exe" ".bat" ".com"))) @@ -6124,7 +6125,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-checkbox "\n " 'pr-i-region - #'(lambda (widget &rest ignore) + #'(lambda (widget &rest _ignore) (let ((region-p (pr-interface-save (ps-mark-active-p)))) (cond ((null (widget-value widget)) ; widget is nil @@ -6145,7 +6146,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-checkbox " " 'pr-i-mode - #'(lambda (widget &rest ignore) + #'(lambda (widget &rest _ignore) (let ((mode-p (pr-interface-save (pr-mode-alist-p)))) (cond @@ -6181,7 +6182,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (widget-create 'regexp :size 58 :format "\n File Regexp : %v\n" - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (setq pr-i-regexp (widget-value widget))) pr-i-regexp) ;; 1b. Directory: List Directory Entry @@ -6221,7 +6222,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-checkbox " " 'pr-i-despool - #'(lambda (widget &rest ignore) + #'(lambda (widget &rest _ignore) (if pr-spool-p (setq pr-i-despool (not pr-i-despool)) (ding) @@ -6258,7 +6259,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." 'integer :size 3 :format "\n N-Up : %v" - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (let ((value (if (string= (widget-apply widget :value-get) "") 0 (widget-value widget)))) @@ -6287,7 +6288,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; 4. Settings: ;; 4. Settings: Landscape Auto Region Verbose (pr-insert-checkbox "\n\n " 'ps-landscape-mode - #'(lambda (&rest ignore) + #'(lambda (&rest _ignore) (setq ps-landscape-mode (not ps-landscape-mode) pr-file-landscape ps-landscape-mode)) " Landscape ") @@ -6309,7 +6310,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-toggle 'ps-zebra-stripes " Zebra Stripes") (pr-insert-checkbox " " 'pr-spool-p - #'(lambda (&rest ignore) + #'(lambda (&rest _ignore) (setq pr-spool-p (not pr-spool-p)) (unless pr-spool-p (setq pr-i-despool nil) @@ -6319,7 +6320,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; 4. Settings: Duplex Print with faces (pr-insert-checkbox "\n " 'ps-spool-duplex - #'(lambda (&rest ignore) + #'(lambda (&rest _ignore) (setq ps-spool-duplex (not ps-spool-duplex) pr-file-duplex ps-spool-duplex)) " Duplex ") @@ -6328,7 +6329,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; 4. Settings: Tumble Print via Ghostscript (pr-insert-checkbox "\n " 'ps-spool-tumble - #'(lambda (&rest ignore) + #'(lambda (&rest _ignore) (setq ps-spool-tumble (not ps-spool-tumble) pr-file-tumble ps-spool-tumble)) " Tumble ") @@ -6351,7 +6352,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; 5. Customize: (pr-insert-italic "\n\nCustomize : " 2 11) (pr-insert-button 'pr-customize "printing" " ") - (pr-insert-button #'(lambda (&rest ignore) (ps-print-customize)) + (pr-insert-button #'(lambda (&rest _ignore) (ps-print-customize)) "ps-print" " ") (pr-insert-button 'lpr-customize "lpr")) @@ -6373,7 +6374,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-button 'pr-kill-help "Kill All Printing Help Buffer")) -(defun pr-kill-help (&rest ignore) +(defun pr-kill-help (&rest _ignore) "Kill all printing help buffer." (interactive) (let ((help '("*Printing Interface Help*" "*Printing Help*" @@ -6387,20 +6388,20 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (recenter (- (window-height) 2))) -(defun pr-interface-quit (&rest ignore) +(defun pr-interface-quit (&rest _ignore) "Kill the printing buffer interface and quit." (interactive) (kill-buffer pr-buffer-name) (set-window-configuration pr-i-window-configuration)) -(defun pr-interface-help (&rest ignore) +(defun pr-interface-help (&rest _ignore) "printing buffer interface help." (interactive) (pr-show-setup pr-interface-help-message "*Printing Interface Help*")) -(defun pr-interface-txt-print (&rest ignore) +(defun pr-interface-txt-print (&rest _ignore) "Print using lpr package." (interactive) (condition-case data @@ -6432,7 +6433,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (message "%s" (error-message-string data))))) -(defun pr-interface-printify (&rest ignore) +(defun pr-interface-printify (&rest _ignore) "Printify a buffer." (interactive) (condition-case data @@ -6457,7 +6458,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (message "%s" (error-message-string data))))) -(defun pr-interface-ps-print (&rest ignore) +(defun pr-interface-ps-print (&rest _ignore) "Print using ps-print package." (interactive) (pr-interface-ps 'pr-despool-ps-print 'pr-ps-directory-ps-print @@ -6466,7 +6467,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." 'pr-ps-buffer-ps-print)) -(defun pr-interface-preview (&rest ignore) +(defun pr-interface-preview (&rest _ignore) "Preview a PostScript file." (interactive) (pr-interface-ps 'pr-despool-preview 'pr-ps-directory-preview @@ -6547,7 +6548,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (error "Please specify be a readable directory"))) -(defun pr-interface-directory (widget &rest ignore) +(defun pr-interface-directory (widget &rest _ignore) (and pr-buffer-verbose (message "You can use M-TAB or ESC TAB for file completion")) (let ((dir (widget-value widget))) @@ -6556,7 +6557,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (setq pr-i-directory dir)))) -(defun pr-interface-infile (widget &rest ignore) +(defun pr-interface-infile (widget &rest _ignore) (and pr-buffer-verbose (message "You can use M-TAB or ESC TAB for file completion")) (let ((file (widget-value widget))) @@ -6565,7 +6566,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (setq pr-i-ps-file file)))) -(defun pr-interface-outfile (widget &rest ignore) +(defun pr-interface-outfile (widget &rest _ignore) (setq pr-i-answer-yes nil) (and pr-buffer-verbose (message "You can use M-TAB or ESC TAB for file completion")) @@ -6601,7 +6602,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-insert-toggle (var-sym label) (widget-create 'checkbox - :notify `(lambda (&rest ignore) + :notify `(lambda (&rest _ignore) (setq ,var-sym (not ,var-sym))) (symbol-value var-sym)) (widget-insert label)) @@ -6622,7 +6623,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." :format "%v" :inline t :value ,var-sym - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (setq ,var-sym (widget-value widget)) ,@body) :void '(choice-item :format "%[%t%]" @@ -6638,7 +6639,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." 'radio-button :format " %[%v%]" :value (eq ,var-sym (quote ,sym)) - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (setq ,var-sym (quote ,sym)) (pr-update-radio-button (quote ,var-sym))))))) (put var-sym 'pr-widget-list (cons (cons wid sym) wid-list)))) diff --git a/lisp/proced.el b/lisp/proced.el index e0a61e9f84b..592c0d066c7 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1,6 +1,6 @@ ;;; proced.el --- operate on system processes like dired -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: Roland Winkler ;; Keywords: Processes, Unix diff --git a/lisp/profiler.el b/lisp/profiler.el index 07192a39bef..6238e7dd36f 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -1,22 +1,24 @@ ;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*- -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. ;; Author: Tomohiro Matsuyama ;; Keywords: lisp -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -25,6 +27,7 @@ ;;; Code: (require 'cl-lib) +(require 'pcase) (defgroup profiler nil "Emacs profiler." @@ -58,7 +61,7 @@ (defun profiler-format-number (number) "Format NUMBER in human readable string." (if (and (integerp number) (> number 0)) - (cl-loop with i = (% (1+ (floor (log10 number))) 3) + (cl-loop with i = (% (1+ (floor (log number 10))) 3) for c in (append (number-to-string number) nil) if (= i 0) collect ?, into s @@ -84,10 +87,12 @@ (profiler-ensure-string arg))) for len = (length str) if (< width len) - collect (substring str 0 width) into frags + collect (progn (put-text-property (max 0 (- width 2)) len + 'invisible 'profiler str) + str) into frags else collect - (let ((padding (make-string (- width len) ?\s))) + (let ((padding (make-string (max 0 (- width len)) ?\s))) (cl-ecase align (left (concat str padding)) (right (concat padding str)))) @@ -246,18 +251,17 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (not (profiler-calltree-count< a b))) (defun profiler-calltree-depth (tree) - (let ((parent (profiler-calltree-parent tree))) - (if (null parent) - 0 - (1+ (profiler-calltree-depth parent))))) + (let ((d 0)) + (while (setq tree (profiler-calltree-parent tree)) + (cl-incf d)) + d)) (defun profiler-calltree-find (tree entry) "Return a child tree of ENTRY under TREE." (let (result (children (profiler-calltree-children tree))) - ;; FIXME: Use `assoc'. (while (and children (null result)) (let ((child (car children))) - (when (equal (profiler-calltree-entry child) entry) + (when (function-equal (profiler-calltree-entry child) entry) (setq result child)) (setq children (cdr children)))) result)) @@ -268,10 +272,9 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (profiler-calltree-walk child function))) (defun profiler-calltree-build-1 (tree log &optional reverse) - ;; FIXME: Do a better job of reconstructing a complete call-tree - ;; when the backtraces have been truncated. Ideally, we should be - ;; able to reduce profiler-max-stack-depth to 3 or 4 and still - ;; get a meaningful call-tree. + ;; This doesn't try to stitch up partial backtraces together. + ;; We still use it for reverse calltrees, but for forward calltrees, we use + ;; profiler-calltree-build-unified instead now. (maphash (lambda (backtrace count) (let ((node tree) @@ -288,6 +291,115 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (setq node child))))))) log)) + +(define-hash-table-test 'profiler-function-equal #'function-equal + (lambda (f) (cond + ((byte-code-function-p f) (aref f 1)) + ((eq (car-safe f) 'closure) (cddr f)) + (t f)))) + +(defun profiler-calltree-build-unified (tree log) + ;; Let's try to unify all those partial backtraces into a single + ;; call tree. First, we record in fun-map all the functions that appear + ;; in `log' and where they appear. + (let ((fun-map (make-hash-table :test 'profiler-function-equal)) + (parent-map (make-hash-table :test 'eq)) + (leftover-tree (profiler-make-calltree + :entry (intern "...") :parent tree))) + (push leftover-tree (profiler-calltree-children tree)) + (maphash + (lambda (backtrace _count) + (let ((max (length backtrace))) + ;; Don't record the head elements in there, since we want to use this + ;; fun-map to find parents of partial backtraces, but parents only + ;; make sense if they have something "above". + (dotimes (i (1- max)) + (let ((f (aref backtrace i))) + (when f + (push (cons i backtrace) (gethash f fun-map))))))) + log) + ;; Then, for each partial backtrace, try to find a parent backtrace + ;; (i.e. a backtrace that describes (part of) the truncated part of + ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3 + ;; is deeper), any backtrace that includes f1 could be a parent; and indeed + ;; the counts of this partial backtrace could each come from a different + ;; parent backtrace (some of which may not even be in `log'). So we should + ;; consider each backtrace that includes f1 and give it some percentage of + ;; `count'. But we can't know for sure what percentage to give to each + ;; possible parent. + ;; The "right" way might be to give a percentage proportional to the counts + ;; already registered for that parent, or some such statistical principle. + ;; But instead, we will give all our counts to a single "best + ;; matching" parent. So let's look for the best matching parent, and store + ;; the result in parent-map. + ;; Using the "best matching parent" is important also to try and avoid + ;; stitching together backtraces that can't possibly go together. + ;; For example, when the head is `apply' (or `mapcar', ...), we want to + ;; make sure we don't just use any parent that calls `apply', since most of + ;; them would never, in turn, cause apply to call the subsequent function. + (maphash + (lambda (backtrace _count) + (let* ((max (1- (length backtrace))) + (head (aref backtrace max)) + (best-parent nil) + (best-match (1+ max)) + (parents (gethash head fun-map))) + (pcase-dolist (`(,i . ,parent) parents) + (when t ;; (<= (- max i) best-match) ;Else, it can't be better. + (let ((match max) + (imatch i)) + (cl-assert (>= match imatch)) + (cl-assert (function-equal (aref backtrace max) + (aref parent i))) + (while (progn + (cl-decf imatch) (cl-decf match) + (when (> imatch 0) + (function-equal (aref backtrace match) + (aref parent imatch))))) + (when (< match best-match) + (cl-assert (<= (- max i) best-match)) + ;; Let's make sure this parent is not already our child: we + ;; don't want cycles here! + (let ((valid t) + (tmp-parent parent)) + (while (setq tmp-parent + (if (eq tmp-parent backtrace) + (setq valid nil) + (cdr (gethash tmp-parent parent-map))))) + (when valid + (setq best-match match) + (setq best-parent (cons i parent)))))))) + (puthash backtrace best-parent parent-map))) + log) + ;; Now we have a single parent per backtrace, so we have a unified tree. + ;; Let's build the actual call-tree from it. + (maphash + (lambda (backtrace count) + (let ((node tree) + (parents (list (cons -1 backtrace))) + (tmp backtrace) + (max (length backtrace))) + (while (setq tmp (gethash tmp parent-map)) + (push tmp parents) + (setq tmp (cdr tmp))) + (when (aref (cdar parents) (1- max)) + (cl-incf (profiler-calltree-count leftover-tree) count) + (setq node leftover-tree)) + (pcase-dolist (`(,i . ,parent) parents) + (let ((j (1- max))) + (while (> j i) + (let ((f (aref parent j))) + (cl-decf j) + (when f + (let ((child (profiler-calltree-find node f))) + (unless child + (setq child (profiler-make-calltree + :entry f :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child))))))))) + log))) + (defun profiler-calltree-compute-percentages (tree) (let ((total-count 0)) ;; FIXME: the memory profiler's total wraps around all too easily! @@ -302,7 +414,9 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (cl-defun profiler-calltree-build (log &key reverse) (let ((tree (profiler-make-calltree))) - (profiler-calltree-build-1 tree log reverse) + (if reverse + (profiler-calltree-build-1 tree log reverse) + (profiler-calltree-build-unified tree log)) (profiler-calltree-compute-percentages tree) tree)) @@ -370,7 +484,7 @@ RET: expand or collapse")) (defun profiler-report-make-name-part (tree) (let* ((entry (profiler-calltree-entry tree)) (depth (profiler-calltree-depth tree)) - (indent (make-string (* (1- depth) 2) ?\s)) + (indent (make-string (* (1- depth) 1) ?\s)) (mark (if (profiler-calltree-leaf-p tree) profiler-report-leaf-mark profiler-report-closed-mark)) @@ -378,7 +492,7 @@ RET: expand or collapse")) (format "%s%s %s" indent mark entry))) (defun profiler-report-header-line-format (fmt &rest args) - (let* ((header (apply 'profiler-format fmt args)) + (let* ((header (apply #'profiler-format fmt args)) (escaped (replace-regexp-in-string "%" "%%" header))) (concat " " escaped))) @@ -403,7 +517,7 @@ RET: expand or collapse")) (insert (propertize (concat line "\n") 'calltree tree)))) (defun profiler-report-insert-calltree-children (tree) - (mapc 'profiler-report-insert-calltree + (mapc #'profiler-report-insert-calltree (profiler-calltree-children tree))) @@ -501,6 +615,7 @@ return it." (define-derived-mode profiler-report-mode special-mode "Profiler-Report" "Profiler Report Mode." + (add-to-invisibility-spec '(profiler . t)) (setq buffer-read-only t buffer-undo-list t truncate-lines t)) @@ -530,9 +645,10 @@ return it." (forward-line -1) (profiler-report-move-to-entry)) -(defun profiler-report-expand-entry () - "Expand entry at point." - (interactive) +(defun profiler-report-expand-entry (&optional full) + "Expand entry at point. +With a prefix argument, expand the whole subtree." + (interactive "P") (save-excursion (beginning-of-line) (when (search-forward (concat profiler-report-closed-mark " ") @@ -542,7 +658,14 @@ return it." (let ((inhibit-read-only t)) (replace-match (concat profiler-report-open-mark " ")) (forward-line) - (profiler-report-insert-calltree-children tree) + (let ((first (point)) + (last (copy-marker (point) t))) + (profiler-report-insert-calltree-children tree) + (when full + (goto-char first) + (while (< (point) last) + (profiler-report-expand-entry) + (forward-line 1)))) t)))))) (defun profiler-report-collapse-entry () @@ -567,11 +690,11 @@ return it." (delete-region start (line-beginning-position))))) t))) -(defun profiler-report-toggle-entry () +(defun profiler-report-toggle-entry (&optional arg) "Expand entry at point if the tree is collapsed, otherwise collapse." - (interactive) - (or (profiler-report-expand-entry) + (interactive "P") + (or (profiler-report-expand-entry arg) (profiler-report-collapse-entry))) (defun profiler-report-find-entry (&optional event) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 3709aa26bbe..68b6c872d3f 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1,6 +1,6 @@ ;;; ada-mode.el --- major-mode for editing Ada sources -;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 1997-2014 Free Software Foundation, Inc. ;; Author: Rolf Ebert ;; Markus Heritsch @@ -130,6 +130,8 @@ (defvar ispell-check-comments) (defvar skeleton-further-elements) +(define-error 'ada-mode-errors nil) + (defun ada-mode-version () "Return Ada mode version." (interactive) @@ -147,6 +149,8 @@ This is a good place to add Ada environment specific bindings.") (defgroup ada nil "Major mode for editing and compiling Ada source in Emacs." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :link '(custom-manual "(ada-mode) Top") + :link '(emacs-commentary-link :tag "Commentary" "ada-mode.el") :group 'languages) (defcustom ada-auto-case t @@ -457,15 +461,8 @@ The extensions should include a `.' if needed.") (defvar ada-mode-extra-prefix "\C-c\C-q" "Prefix key to access `ada-mode-extra-map' functions.") -(defvar ada-mode-abbrev-table nil +(define-abbrev-table 'ada-mode-abbrev-table () "Local abbrev table for Ada mode.") -(define-abbrev-table 'ada-mode-abbrev-table ()) - -(defvar ada-mode-syntax-table nil - "Syntax table to be used for editing Ada source code.") - -(defvar ada-mode-symbol-syntax-table nil - "Syntax table for Ada, where `_' is a word constituent.") (eval-when-compile ;; These values are used in eval-when-compile expressions. @@ -845,61 +842,58 @@ the 4 file locations can be clicked on and jumped to." ;; better is available on XEmacs. ;;------------------------------------------------------------------------- -(defun ada-create-syntax-table () - "Create the two syntax tables use in the Ada mode. -The standard table declares `_' as a symbol constituent, the second one -declares it as a word constituent." - (interactive) - (setq ada-mode-syntax-table (make-syntax-table)) +(defvar ada-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Define string brackets (`%' is alternative string bracket, but + ;; almost never used as such and throws font-lock and indentation + ;; off the track.) + (modify-syntax-entry ?% "$" st) + (modify-syntax-entry ?\" "\"" st) - ;; define string brackets (`%' is alternative string bracket, but - ;; almost never used as such and throws font-lock and indentation - ;; off the track.) - (modify-syntax-entry ?% "$" ada-mode-syntax-table) - (modify-syntax-entry ?\" "\"" ada-mode-syntax-table) + (modify-syntax-entry ?: "." st) + (modify-syntax-entry ?\; "." st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?\| "." st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?/ "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?$ "." st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + (modify-syntax-entry ?\{ "." st) + (modify-syntax-entry ?\} "." st) + (modify-syntax-entry ?. "." st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?\' "." st) - (modify-syntax-entry ?: "." ada-mode-syntax-table) - (modify-syntax-entry ?\; "." ada-mode-syntax-table) - (modify-syntax-entry ?& "." ada-mode-syntax-table) - (modify-syntax-entry ?\| "." ada-mode-syntax-table) - (modify-syntax-entry ?+ "." ada-mode-syntax-table) - (modify-syntax-entry ?* "." ada-mode-syntax-table) - (modify-syntax-entry ?/ "." ada-mode-syntax-table) - (modify-syntax-entry ?= "." ada-mode-syntax-table) - (modify-syntax-entry ?< "." ada-mode-syntax-table) - (modify-syntax-entry ?> "." ada-mode-syntax-table) - (modify-syntax-entry ?$ "." ada-mode-syntax-table) - (modify-syntax-entry ?\[ "." ada-mode-syntax-table) - (modify-syntax-entry ?\] "." ada-mode-syntax-table) - (modify-syntax-entry ?\{ "." ada-mode-syntax-table) - (modify-syntax-entry ?\} "." ada-mode-syntax-table) - (modify-syntax-entry ?. "." ada-mode-syntax-table) - (modify-syntax-entry ?\\ "." ada-mode-syntax-table) - (modify-syntax-entry ?\' "." ada-mode-syntax-table) + ;; A single hyphen is punctuation, but a double hyphen starts a comment. + (modify-syntax-entry ?- ". 12" st) - ;; a single hyphen is punctuation, but a double hyphen starts a comment - (modify-syntax-entry ?- ". 12" ada-mode-syntax-table) + ;; See the comment above on grammar related function for the special + ;; setup for '#'. + (modify-syntax-entry ?# (if (featurep 'xemacs) "<" "$") st) - ;; See the comment above on grammar related function for the special - ;; setup for '#'. - (if (featurep 'xemacs) - (modify-syntax-entry ?# "<" ada-mode-syntax-table) - (modify-syntax-entry ?# "$" ada-mode-syntax-table)) + ;; And \f and \n end a comment. + (modify-syntax-entry ?\f "> " st) + (modify-syntax-entry ?\n "> " st) - ;; and \f and \n end a comment - (modify-syntax-entry ?\f "> " ada-mode-syntax-table) - (modify-syntax-entry ?\n "> " ada-mode-syntax-table) + ;; Define what belongs in Ada symbols. + (modify-syntax-entry ?_ "_" st) - ;; define what belongs in Ada symbols - (modify-syntax-entry ?_ "_" ada-mode-syntax-table) + ;; Define parentheses to match. + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + st) + "Syntax table to be used for editing Ada source code.") - ;; define parentheses to match - (modify-syntax-entry ?\( "()" ada-mode-syntax-table) - (modify-syntax-entry ?\) ")(" ada-mode-syntax-table) - - (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table)) - (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) - ) +(defvar ada-mode-symbol-syntax-table + (let ((st (make-syntax-table ada-mode-syntax-table))) + (modify-syntax-entry ?_ "w" st) + st) + "Syntax table for Ada, where `_' is a word constituent.") ;; Support of special characters in XEmacs (see the comments at the beginning ;; of the section on Grammar related functions). @@ -1293,7 +1287,7 @@ the file name." (if ada-popup-key (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) - ;; Support for Abbreviations (the user still need to "M-x abbrev-mode" + ;; Support for Abbreviations (the user still needs to "M-x abbrev-mode"). (setq local-abbrev-table ada-mode-abbrev-table) ;; Support for which-function mode @@ -1625,9 +1619,8 @@ ARG is the prefix the user entered with \\[universal-argument]." (let ((lastk last-command-event)) (with-syntax-table ada-mode-symbol-syntax-table - (cond ((or (eq lastk ?\n) - (eq lastk ?\r)) - ;; horrible kludge + (cond ((memq lastk '(?\n ?\r)) + ;; Horrible kludge. (insert " ") (ada-adjust-case) ;; horrible dekludge @@ -1706,9 +1699,7 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only." (interactive) (let ((end (save-excursion (skip-syntax-forward "w") (point))) (begin (save-excursion (skip-syntax-backward "w") (point)))) - (modify-syntax-entry ?_ "_") - (capitalize-region begin end) - (modify-syntax-entry ?_ "w"))) + (capitalize-region begin end))) (defun ada-adjust-case-region (from to) "Adjust the case of all words in the region between FROM and TO. @@ -2165,7 +2156,7 @@ and the offset." (unwind-protect (with-syntax-table ada-mode-symbol-syntax-table - ;; This need to be done here so that the advice is not always + ;; This needs to be done here so that the advice is not always ;; activated (this might interact badly with other modes) (if (featurep 'xemacs) (ad-activate 'parse-partial-sexp t)) @@ -3419,27 +3410,23 @@ Stop the search at LIMIT." If BACKWARD is non-nil, jump to the beginning of the previous word. Return the new position of point or nil if not found." (let ((match-cons nil) - (orgpoint (point)) - (old-syntax (char-to-string (char-syntax ?_)))) - (modify-syntax-entry ?_ "w") + (orgpoint (point))) (unless backward - (skip-syntax-forward "w")) + (skip-syntax-forward "w_")) (if (setq match-cons - (ada-search-ignore-string-comment "\\w" backward nil t)) + (ada-search-ignore-string-comment "\\sw\\|\\s_" backward nil t)) ;; ;; move to the beginning of the word found ;; (progn (goto-char (car match-cons)) - (skip-syntax-backward "w") + (skip-syntax-backward "w_") (point)) ;; ;; if not found, restore old position of point ;; (goto-char orgpoint) - 'nil) - (modify-syntax-entry ?_ old-syntax)) - ) + 'nil))) (defun ada-check-matching-start (keyword) @@ -5431,9 +5418,6 @@ This function typically is to be hooked into `ff-file-created-hook'." (ada-create-keymap) (ada-create-menu) -;; Create the syntax tables, but do not activate them -(ada-create-syntax-table) - ;; Add the default extensions (and set up speedbar) (ada-add-extensions ".ads" ".adb") ;; This two files are generated by GNAT when running with -gnatD diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index f6125545b96..585bfd08477 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -1,6 +1,6 @@ ;;; ada-prj.el --- GUI editing of project files for the ada-mode -;; Copyright (C) 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Emmanuel Briot ;; Maintainer: Stephen Leake diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 4d7530477c1..e35b5820c79 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -1,6 +1,6 @@ ;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates -;; Copyright (C) 1987, 1993-1994, 1996-2013 Free Software Foundation, +;; Copyright (C) 1987, 1993-1994, 1996-2014 Free Software Foundation, ;; Inc. ;; Authors: Daniel Pfeiffer diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index e44b7c191bf..7cad848fda8 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1,6 +1,6 @@ ;; ada-xref.el --- for lookup and completion in Ada mode -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Markus Heritsch ;; Rolf Ebert @@ -342,9 +342,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." ) (kill-buffer nil)))) - (set 'ada-xref-runtime-library-specs-path + (setq ada-xref-runtime-library-specs-path (reverse ada-xref-runtime-library-specs-path)) - (set 'ada-xref-runtime-library-ali-path + (setq ada-xref-runtime-library-ali-path (reverse ada-xref-runtime-library-ali-path)) )) @@ -582,8 +582,8 @@ as defined in the project file." (while dirs (if (file-directory-p (car dirs)) - (set 'list (append list (file-name-all-completions string (car dirs))))) - (set 'dirs (cdr dirs))) + (setq list (append list (file-name-all-completions string (car dirs))))) + (setq dirs (cdr dirs))) (cond ((equal flag 'lambda) (assoc string list)) (flag @@ -702,11 +702,11 @@ is non-nil, prompt the user to select one. If none are found, return ((file-exists-p first-choice) ;; filename.adp - (set 'selected first-choice)) + (setq selected first-choice)) ((= (length prj-files) 1) ;; Exactly one project file was found in the current directory - (set 'selected (car prj-files))) + (setq selected (car prj-files))) ((and (> (length prj-files) 1) (not no-user-question)) ;; multiple project files in current directory, ask the user @@ -732,7 +732,7 @@ is non-nil, prompt the user to select one. If none are found, return (> choice (length prj-files))) (setq choice (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) - (set 'selected (nth (1- choice) prj-files)))) + (setq selected (nth (1- choice) prj-files)))) ((= (length prj-files) 0) ;; No project file in the current directory; ask user @@ -742,7 +742,7 @@ is non-nil, prompt the user to select one. If none are found, return (concat "project file [" ada-last-prj-file "]:") nil ada-last-prj-file)) (unless (string= ada-last-prj-file "") - (set 'selected ada-last-prj-file)))) + (setq selected ada-last-prj-file)))) ))) (or selected "default.adp") @@ -792,9 +792,9 @@ is non-nil, prompt the user to select one. If none are found, return (setq prj-file (expand-file-name prj-file)) (if (string= (file-name-extension prj-file) "gpr") - (set 'project (ada-gnat-parse-gpr project prj-file)) + (setq project (ada-gnat-parse-gpr project prj-file)) - (set 'project (ada-parse-prj-file-1 prj-file project)) + (setq project (ada-parse-prj-file-1 prj-file project)) ) ;; Store the project properties @@ -842,7 +842,7 @@ Return new value of PROJECT." (substitute-in-file-name (match-string 2))))) ((string= (match-string 1) "build_dir") - (set 'project + (setq project (plist-put project 'build_dir (file-name-as-directory (match-string 2))))) @@ -884,7 +884,7 @@ Return new value of PROJECT." (t ;; any other field in the file is just copied - (set 'project (plist-put project + (setq project (plist-put project (intern (match-string 1)) (match-string 2)))))) @@ -900,21 +900,21 @@ Return new value of PROJECT." (let ((sep (plist-get project 'ada_project_path_sep))) (setq ada_project_path (reverse ada_project_path)) (setq ada_project_path (mapconcat 'identity ada_project_path sep)) - (set 'project (plist-put project 'ada_project_path ada_project_path)) + (setq project (plist-put project 'ada_project_path ada_project_path)) ;; env var needed now for ada-gnat-parse-gpr (setenv "ADA_PROJECT_PATH" ada_project_path))) - (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) - (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) - (if casing (set 'project (plist-put project 'casing (reverse casing)))) - (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd)))) - (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd)))) - (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd)))) - (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd)))) + (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) + (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) + (if casing (setq project (plist-put project 'casing (reverse casing)))) + (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd)))) + (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd)))) + (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd)))) + (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd)))) (if gpr_file (progn - (set 'project (ada-gnat-parse-gpr project gpr_file)) + (setq project (ada-gnat-parse-gpr project gpr_file)) ;; append Ada source and object directories to others from Emacs project file (setq src_dir (append (plist-get project 'src_dir) src_dir)) (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) @@ -930,8 +930,8 @@ Return new value of PROJECT." (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) ;;) - (if obj_dir (set 'project (plist-put project 'obj_dir (reverse obj_dir)))) - (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir)))) + (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir)))) + (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir)))) project )) @@ -1052,9 +1052,9 @@ existing buffer `*gnatfind*', if there is one." (if old-contents (progn (goto-char 1) - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (insert old-contents) - (set 'buffer-read-only t) + (setq buffer-read-only t) (goto-char (point-max))))) ) ) @@ -1142,7 +1142,7 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame." (condition-case err (ada-find-in-ali identlist other-frame) ;; File not found: print explicit error message - (error-file-not-found + (ada-error-file-not-found (message (concat (error-message-string err) (nthcdr 1 err)))) @@ -1194,9 +1194,9 @@ project file." (objects (getenv "ADA_OBJECTS_PATH")) (build-dir (ada-xref-get-project-field 'build_dir))) (if include - (set 'include (concat path-separator include))) + (setq include (concat path-separator include))) (if objects - (set 'objects (concat path-separator objects))) + (setq objects (concat path-separator objects))) (cons (concat "ADA_INCLUDE_PATH=" (mapconcat (lambda(x) (expand-file-name x build-dir)) @@ -1303,7 +1303,7 @@ If ARG is non-nil, ask for user confirmation." ;; Guess the command if it wasn't specified (if (not command) - (set 'command (list (file-name-sans-extension (buffer-name))))) + (setq command (list (file-name-sans-extension (buffer-name))))) ;; Modify the command to run remotely (setq command (ada-remote (mapconcat 'identity command @@ -1316,7 +1316,7 @@ If ARG is non-nil, ask for user confirmation." ;; Run the command (with-current-buffer (get-buffer-create "*run*") - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (erase-buffer) (start-process "run" (current-buffer) shell-file-name @@ -1352,7 +1352,7 @@ project file." ;; If the command was not given in the project file, start a bare gdb (if (not cmd) - (set 'cmd (concat ada-prj-default-debugger + (setq cmd (concat ada-prj-default-debugger " " (or executable-name (file-name-sans-extension (buffer-file-name)))))) @@ -1368,18 +1368,18 @@ project file." ;; chance to fully manage it. Then it works fine with Enlightenment ;; as well (let ((frame (make-frame '((visibility . nil))))) - (set 'cmd (concat + (setq cmd (concat cmd " --editor-window=" (cdr (assoc 'outer-window-id (frame-parameters frame))))) (select-frame frame))) ;; Add a -fullname switch ;; Use the remote machine - (set 'cmd (ada-remote (concat cmd " -fullname "))) + (setq cmd (ada-remote (concat cmd " -fullname "))) ;; Ask for confirmation if required (if (or arg ada-xref-confirm-compile) - (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) + (setq cmd (read-from-minibuffer "enter command to debug: " cmd))) (let ((old-comint-exec (symbol-function 'comint-exec))) @@ -1387,13 +1387,13 @@ project file." ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef (fset 'gud-gdb-massage-args (lambda (_file args) args)) - (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) + (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) (if (not (equal pre-cmd "")) (setq pre-cmd (concat pre-cmd ada-command-separator))) - (set 'post-cmd (mapconcat 'identity post-cmd "\n")) + (setq post-cmd (mapconcat 'identity post-cmd "\n")) (if post-cmd - (set 'post-cmd (concat post-cmd "\n"))) + (setq post-cmd (concat post-cmd "\n"))) ;; Temporarily replaces the definition of `comint-exec' so that we @@ -1403,7 +1403,7 @@ project file." `(lambda (buffer name command startfile switches) (let (compilation-buffer-name-function) (save-excursion - (set 'compilation-buffer-name-function + (setq compilation-buffer-name-function (lambda(x) (buffer-name buffer))) (compile (ada-quote-cmd (concat ,pre-cmd @@ -1498,12 +1498,12 @@ by replacing the file extension with `.ali'." "Search for FILE in DIR-LIST." (let (found) (while (and (not found) dir-list) - (set 'found (concat (file-name-as-directory (car dir-list)) + (setq found (concat (file-name-as-directory (car dir-list)) (file-name-nondirectory file))) (unless (file-exists-p found) - (set 'found nil)) - (set 'dir-list (cdr dir-list))) + (setq found nil)) + (setq dir-list (cdr dir-list))) found)) (defun ada-find-ali-file-in-dir (file) @@ -1558,11 +1558,11 @@ the project file." (while specs (if (string-match (concat (regexp-quote (car specs)) "$") file) - (set 'is-spec t)) - (set 'specs (cdr specs))))) + (setq is-spec t)) + (setq specs (cdr specs))))) (if is-spec - (set 'ali-file-name + (setq ali-file-name (ada-find-ali-file-in-dir (concat (file-name-base (ada-other-file-name)) ".ali")))) @@ -1589,8 +1589,8 @@ the project file." (while (and (not ali-file-name) (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) - (set 'parent-name (match-string 1 parent-name)) - (set 'ali-file-name (ada-find-ali-file-in-dir + (setq parent-name (match-string 1 parent-name)) + (setq ali-file-name (ada-find-ali-file-in-dir (concat parent-name ".ali"))) ) ali-file-name))) @@ -1637,7 +1637,7 @@ Search in project file for possible paths." (let ((filename (ada-find-src-file-in-dir file))) (if filename (expand-file-name filename) - (signal 'error-file-not-found (file-name-nondirectory file))) + (signal 'ada-error-file-not-found (file-name-nondirectory file))) ))) (defun ada-find-file-number-in-ali (file) @@ -1686,18 +1686,18 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." (if (and (= (char-before) ?\") (= (char-after (+ (length (match-string 0)) (point))) ?\")) (forward-char -1)) - (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + (setq identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) (if (ada-in-string-p) (error "Inside string or character constant")) (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) (error "No cross-reference available for reserved keyword")) (if (looking-at "[a-zA-Z0-9_]+") - (set 'identifier (match-string 0)) + (setq identifier (match-string 0)) (error "No identifier around"))) ;; Build the identlist - (set 'identlist (ada-make-identlist)) + (setq identlist (ada-make-identlist)) (ada-set-name identlist (downcase identifier)) (ada-set-line identlist (number-to-string (count-lines 1 (point)))) @@ -1725,7 +1725,7 @@ Information is extracted from the ali file." (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (set 'declaration-found + (setq declaration-found (re-search-forward (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) @@ -1743,7 +1743,7 @@ Information is extracted from the ali file." ;; Since we already know the number of the file, search for a direct ;; reference to it (goto-char (point-min)) - (set 'declaration-found t) + (setq declaration-found t) (ada-set-ali-index identlist (number-to-string (ada-find-file-number-in-ali @@ -1771,7 +1771,7 @@ Information is extracted from the ali file." ;; If still not found, then either the declaration is unknown ;; or the source file has been modified since the ali file was ;; created - (set 'declaration-found nil) + (setq declaration-found nil) ) ) @@ -1786,7 +1786,7 @@ Information is extracted from the ali file." (beginning-of-line)) (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" (ada-name-of identlist) "[ <{=\(\[]")) - (set 'declaration-found nil)))) + (setq declaration-found nil)))) ;; Still no success ! The ali file must be too old, and we need to ;; use a basic algorithm based on guesses. Note that this only happens @@ -1794,7 +1794,7 @@ Information is extracted from the ali file." ;; automatically (unless declaration-found (if (ada-xref-find-in-modified-ali identlist) - (set 'declaration-found t) + (setq declaration-found t) ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) @@ -1814,7 +1814,7 @@ Information is extracted from the ali file." (forward-line 1) (beginning-of-line) (while (looking-at "^\\.\\(.*\\)") - (set 'current-line (concat current-line (match-string 1))) + (setq current-line (concat current-line (match-string 1))) (forward-line 1)) ) @@ -1828,7 +1828,7 @@ Information is extracted from the ali file." (ada-file-of identlist))) ;; Else clean up the ali file - (error-file-not-found + (ada-error-file-not-found (signal (car err) (cdr err))) (error (kill-buffer ali-buffer) @@ -1860,7 +1860,7 @@ This function is disabled for operators, and only works for identifiers." (goto-char (point-max)) (while (re-search-backward my-regexp nil t) (save-excursion - (set 'line-ali (count-lines 1 (point))) + (setq line-ali (count-lines 1 (point))) (beginning-of-line) ;; have a look at the line and column numbers (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") @@ -1948,7 +1948,7 @@ opens a new window to show the declaration." ;; Get all the possible locations (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) - (set 'locations (list (list (match-string 1 ali-line) ;; line + (setq locations (list (list (match-string 1 ali-line) ;; line (match-string 2 ali-line) ;; column (ada-declare-file-of identlist)))) (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" @@ -1968,16 +1968,16 @@ opens a new window to show the declaration." (goto-char (point-min)) (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t (string-to-number file-number)) - (set 'file (match-string 1)) + (setq file (match-string 1)) ) ;; Else get the nearest file - (set 'file (ada-declare-file-of identlist))) + (setq file (ada-declare-file-of identlist))) - (set 'locations (append locations (list (list line col file))))) + (setq locations (append locations (list (list line col file))))) ;; Add the specs at the end again, so that from the last body we go to ;; the specs - (set 'locations (append locations (list (car locations)))) + (setq locations (append locations (list (car locations)))) ;; Find the new location we want to go to. ;; If we are on none of the locations listed, we simply go to the specs. @@ -1996,10 +1996,10 @@ opens a new window to show the declaration." col (nth 1 locations) file (nth 2 locations) locations nil) - (set 'locations (cdr locations)))) + (setq locations (cdr locations)))) ;; Find the file in the source path - (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) + (setq file (ada-get-ada-file-name file (ada-file-of identlist))) ;; Kill the .ali buffer (kill-buffer (current-buffer)) @@ -2044,10 +2044,10 @@ the declaration and documentation of the subprograms one is using." " " (shell-quote-argument (file-name-as-directory (car dirs))) "*.ali"))) - (set 'dirs (cdr dirs))) + (setq dirs (cdr dirs))) ;; Now parse the output - (set 'case-fold-search t) + (setq case-fold-search t) (goto-char (point-min)) (while (re-search-forward regexp nil t) (save-excursion @@ -2058,12 +2058,12 @@ the declaration and documentation of the subprograms one is using." (setq line (match-string 1) column (match-string 2)) (re-search-backward "^X [0-9]+ \\(.*\\)$") - (set 'file (list (match-string 1) line column)) + (setq file (list (match-string 1) line column)) ;; There could be duplicate choices, because of the structure ;; of the .ali files (unless (member file list) - (set 'list (append list (list file)))))))) + (setq list (append list (list file)))))))) ;; Current buffer is still "*grep*" (kill-buffer "*grep*") @@ -2078,7 +2078,7 @@ the declaration and documentation of the subprograms one is using." ;; Only one choice => Do the cross-reference ((= (length list) 1) - (set 'file (ada-find-src-file-in-dir (caar list))) + (setq file (ada-find-src-file-in-dir (caar list))) (if file (ada-xref-change-buffer file (string-to-number (nth 1 (car list))) @@ -2117,17 +2117,17 @@ the declaration and documentation of the subprograms one is using." (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) ) - (set 'choice (1- choice)) + (setq choice (1- choice)) (kill-buffer "*choice list*") - (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) + (setq file (ada-find-src-file-in-dir (car (nth choice list)))) (if file (ada-xref-change-buffer file (string-to-number (nth 1 (nth choice list))) (string-to-number (nth 2 (nth choice list))) identlist other-frame) - (signal 'error-file-not-found (car (nth choice list)))) + (signal 'ada-error-file-not-found (car (nth choice list)))) (message "This is only a (good) guess at the cross-reference.") )))) @@ -2144,7 +2144,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." (if ada-xref-other-buffer (if other-frame (find-file-other-frame file) - (set 'declaration-buffer (find-file-noselect file)) + (setq declaration-buffer (find-file-noselect file)) (set-buffer declaration-buffer) (switch-to-buffer-other-window declaration-buffer) ) @@ -2362,12 +2362,8 @@ For instance, it creates the gnat-specific menus, sets some hooks for (add-hook 'ada-mode-hook 'ada-xref-initialize) ;; Define a new error type -(put 'error-file-not-found - 'error-conditions - '(error ada-mode-errors error-file-not-found)) -(put 'error-file-not-found - 'error-message - "File not found in src-dir (check project file): ") +(define-error 'ada-error-file-not-found + "File not found in src-dir (check project file): " 'ada-mode-errors) (provide 'ada-xref) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 56680f23a8e..9557fc80eb2 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1,8 +1,8 @@ ;;; antlr-mode.el --- major mode for ANTLR grammar files -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. -;; Author: Christoph.Wedler@sap.com +;; Author: Christoph Wedler ;; Keywords: languages, ANTLR, code generator ;; Version: 2.2c ;; X-URL: http://antlr-mode.sourceforge.net/ @@ -178,10 +178,6 @@ (set-buffer-modified-p nil))))))) (put 'save-buffer-state-x 'lisp-indent-function 0) -;; get rid of byte-compile warnings -(eval-when-compile - (require 'cc-mode)) - (defvar outline-level) (defvar imenu-use-markers) (defvar imenu-create-index-function) diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 27114af0dc5..ab7612082d5 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -1,9 +1,9 @@ ;;; asm-mode.el --- mode for editing assembler code -;; Copyright (C) 1991, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991, 2001-2014 Free Software Foundation, Inc. ;; Author: Eric S. Raymond -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: tools, languages ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 8a99ad6e1b3..7baf906896a 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -1,6 +1,6 @@ ;;; autoconf.el --- mode for editing Autoconf configure.ac files -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: languages @@ -41,10 +41,10 @@ "Hook run by `autoconf-mode'.") (defconst autoconf-definition-regexp - "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\sw+\\)\\]*") + "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\(?:\\sw\\|\\s_\\)+\\)\\]*") (defvar autoconf-font-lock-keywords - `(("\\_" (0 "<")))) (setq-local font-lock-defaults - `(autoconf-font-lock-keywords nil nil (("_" . "w")))) + `(autoconf-font-lock-keywords nil nil)) (setq-local imenu-generic-expression autoconf-imenu-generic-expression) - (setq-local imenu-syntax-alist '(("_" . "w"))) (setq-local indent-line-function #'indent-relative) (setq-local add-log-current-defun-function #'autoconf-current-defun-function)) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el new file mode 100644 index 00000000000..e328cfa0d8b --- /dev/null +++ b/lisp/progmodes/bat-mode.el @@ -0,0 +1,186 @@ +;;; bat-mode.el --- Major mode for editing DOS/Windows scripts + +;; Copyright (C) 2003, 2008-2014 Free Software Foundation, Inc. + +;; Author: Arni Magnusson +;; Keywords: languages + +;; 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 . + +;;; Commentary: +;; +;; Major mode for editing DOS/Windows scripts (batch files). Provides syntax +;; highlighting, a basic template, access to DOS help pages, imenu/outline +;; navigation, and the ability to run scripts from within Emacs. The syntax +;; groups for highlighting are: +;; +;; Face Example +;; bat-label-face :LABEL +;; font-lock-comment-face rem +;; font-lock-builtin-face copy +;; font-lock-keyword-face goto +;; font-lock-warning-face cp +;; font-lock-constant-face [call] prog +;; font-lock-variable-name-face %var% +;; font-lock-type-face -option +;; +;; Usage: +;; +;; See documentation of function `bat-mode'. +;; +;; Separate package `dos-indent' (Matthew Fidler) provides rudimentary +;; indentation, see http://www.emacswiki.org/emacs/dos-indent.el. +;; +;; Acknowledgements: +;; +;; Inspired by `batch-mode' (Agnar Renolen) and `cmd-mode' (Tadamegu Furukawa). + +;;; Code: + +;; 1 Preamble + +(defgroup bat-mode nil + "Major mode for editing DOS/Windows batch files." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :group 'languages) + +;; 2 User variables + +(defface bat-label-face '((t :weight bold)) + "Font Lock mode face used to highlight labels in batch files.") + +;; 3 Internal variables + +(defvar bat-font-lock-keywords + (eval-when-compile + (let ((COMMANDS + '("assoc" "at" "attrib" "cd" "cls" "color" "copy" "date" "del" "dir" + "doskey" "echo" "endlocal" "erase" "fc" "find" "findstr" "format" + "ftype" "label" "md" "mkdir" "more" "move" "net" "path" "pause" + "popd" "prompt" "pushd" "rd" "ren" "rename" "replace" "rmdir" "set" + "setlocal" "shift" "sort" "subst" "time" "title" "tree" "type" + "ver" "vol" "xcopy")) + (CONTROLFLOW + '("call" "cmd" "defined" "do" "else" "equ" "exist" "exit" "for" "geq" + "goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start")) + (UNIX + '("bash" "cat" "cp" "fgrep" "grep" "ls" "sed" "sh" "mv" "rm"))) + `(("\\<_\\(call\\|goto\\)\\_>[ \t]+%?\\([A-Za-z0-9-_\\:.]+\\)%?" + (2 font-lock-constant-face t)) + ("^:[^:].*" + . 'bat-label-face) + ("\\<_\\(defined\\|set\\)\\_>[ \t]*\\(\\w+\\)" + (2 font-lock-variable-name-face)) + ("%\\(\\w+\\)%?" + (1 font-lock-variable-name-face)) + ("!\\(\\w+\\)!?" ; delayed-expansion !variable! + (1 font-lock-variable-name-face)) + ("[ =][-/]+\\(\\w+\\)" + (1 font-lock-type-face append)) + (,(concat "\\_<" (regexp-opt COMMANDS) "\\_>") . font-lock-builtin-face) + (,(concat "\\_<" (regexp-opt CONTROLFLOW) "\\_>") + . font-lock-keyword-face) + (,(concat "\\_<" (regexp-opt UNIX) "\\_>") + . font-lock-warning-face))))) + +(defvar bat-menu + '("Bat" + ["Run" bat-run :help "Run script"] + ["Run with Args" bat-run-args :help "Run script with args"] + "--" + ["Imenu" imenu :help "Navigate with imenu"] + "--" + ["Template" bat-template :help "Insert template"] + "--" + ["Help (Command)" bat-cmd-help :help "Show help page for DOS command"])) + +(defvar bat-mode-map + (let ((map (make-sparse-keymap))) + (easy-menu-define nil map nil bat-menu) + (define-key map [?\C-c ?\C-/] 'bat-cmd-help) ;FIXME: Why not C-c C-? ? + (define-key map [?\C-c ?\C-a] 'bat-run-args) + (define-key map [?\C-c ?\C-c] 'bat-run) + (define-key map [?\C-c ?\C-t] 'bat-template) + (define-key map [?\C-c ?\C-v] 'bat-run) + map)) + +(defvar bat-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + ;; Beware: `w' should not be used for non-alphabetic chars. + (modify-syntax-entry ?~ "_" table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?- "_" table) + (modify-syntax-entry ?_ "_" table) + ;; FIXME: { and } can appear in identifiers? Really? + (modify-syntax-entry ?{ "_" table) + (modify-syntax-entry ?} "_" table) + (modify-syntax-entry ?\\ "." table) + table)) + +(defconst bat--syntax-propertize + (syntax-propertize-rules + ("^[ \t]*\\(?:\\(@?r\\)em\\_>\\|\\(?1::\\):\\).*" (1 "<")))) + +;; 4 User functions + +(defun bat-cmd-help (cmd) + "Show help for batch file command CMD." + (interactive "sHelp: ") + (if (string-equal cmd "net") + ;; FIXME: liable to quoting nightmare. Use call-process? + (shell-command "net /?") (shell-command (concat "help " cmd)))) + +(defun bat-run () + "Run a batch file." + (interactive) + ;; FIXME: liable to quoting nightmare. Use call/start-process? + (save-buffer) (shell-command buffer-file-name)) + +(defun bat-run-args (args) + "Run a batch file with ARGS." + (interactive "sArgs: ") + ;; FIXME: Use `compile'? + (shell-command (concat buffer-file-name " " args))) + +(defun bat-template () + "Insert minimal batch file template." + (interactive) + (goto-char (point-min)) (insert "@echo off\nsetlocal\n\n")) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode)) + +;; 5 Main function + +;;;###autoload +(define-derived-mode bat-mode prog-mode "Bat" + "Major mode for editing DOS/Windows batch files.\n +Start a new script from `bat-template'. Read help pages for DOS commands +with `bat-cmd-help'. Navigate between sections using `imenu'. +Run script using `bat-run' and `bat-run-args'.\n +\\{bat-mode-map}" + (setq-local comment-start "rem ") + (setq-local syntax-propertize-function bat--syntax-propertize) + (setq-local font-lock-defaults + '(bat-font-lock-keywords nil t)) ; case-insensitive keywords + (setq-local imenu-generic-expression '((nil "^:[^:].*" 0))) + (setq-local outline-regexp ":[^:]")) + +(provide 'bat-mode) + +;;; bat-mode.el ends here diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 7ac549cc229..a4b374ef63a 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -1,6 +1,6 @@ ;; bug-reference.el --- buttonize bug references -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: Tom Tromey ;; Created: 21 Mar 2007 diff --git a/lisp/progmodes/cap-words.el b/lisp/progmodes/cap-words.el index 3411340ed6d..b03daf4cd5a 100644 --- a/lisp/progmodes/cap-words.el +++ b/lisp/progmodes/cap-words.el @@ -1,6 +1,6 @@ ;;; cap-words.el --- minor mode for motion in CapitalizedWordIdentifiers -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: languages diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index cb8d2d23c84..05d796c470e 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1,6 +1,6 @@ ;;; cc-align.el --- custom indentation functions for CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2004- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -737,7 +737,7 @@ arglist-cont-nonempty." (setq startpos (c-langelem-pos langelem))))) (setq startpos (c-langelem-pos langelem) - endpos (point)) + endpos (c-point 'bol)) ;; Find a syntactically relevant and unnested "=" token on the ;; current line. equalp is in that case set to the number of @@ -1039,6 +1039,7 @@ brace-list-close, brace-list-intro, statement-block-intro, arglist-intro, arglist-cont-nonempty, arglist-close, and all in* symbols, e.g. inclass and inextern-lang." (save-excursion + (beginning-of-line) (if (and (c-go-up-list-backward) (= (point) (c-point 'boi))) nil @@ -1191,6 +1192,7 @@ Works with: arglist-cont, arglist-cont-nonempty." (let ((orig-pos (point)) alignto) (save-excursion + (beginning-of-line) (and c-opt-asm-stmt-key @@ -1284,7 +1286,7 @@ newline is added. In either case, checking is stopped. This supports exactly the old newline insertion behavior." ;; newline only after semicolon, but only if that semicolon is not ;; inside a parenthesis list (e.g. a for loop statement) - (if (not (eq last-command-event ?\;)) + (if (not (eq (c-last-command-char) ?\;)) nil ; continue checking (if (condition-case nil (save-excursion @@ -1301,7 +1303,7 @@ If a comma was inserted, no determination is made. If a semicolon was inserted, and the following line is not blank, no newline is inserted. Otherwise, no determination is made." (save-excursion - (if (and (= last-command-event ?\;) + (if (and (= (c-last-command-char) ?\;) ;;(/= (point-max) ;; (save-excursion (skip-syntax-forward " ") (point)) (zerop (forward-line 1)) @@ -1318,13 +1320,13 @@ suppressed in one-liners, if the line is an in-class inline function. For other semicolon contexts, no determination is made." (let ((syntax (c-guess-basic-syntax)) (bol (save-excursion - (if (c-safe (up-list -1) t) - (c-point 'bol) - -1)))) - (if (and (eq last-command-event ?\;) - (eq (car (car syntax)) 'inclass) - (eq (car (car (cdr syntax))) 'topmost-intro) - (= (c-point 'bol) bol)) + (if (c-safe (up-list -1) t) + (c-point 'bol) + -1)))) + (if (and (eq (c-last-command-char) ?\;) + (eq (car (car syntax)) 'inclass) + (eq (car (car (cdr syntax))) 'topmost-intro) + (= (c-point 'bol) bol)) 'stop nil))) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 4b3fc91b0ff..44d69d7d0f1 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1,10 +1,10 @@ ;;; cc-awk.el --- AWK specific code within cc-mode. -;; Copyright (C) 1988, 1994, 1996, 2000-2013 Free Software Foundation, +;; Copyright (C) 1988, 1994, 1996, 2000-2014 Free Software Foundation, ;; Inc. ;; Author: Alan Mackenzie (originally based on awk-mode.el) -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: AWK, cc-mode, unix, languages ;; Package: cc-mode @@ -61,6 +61,7 @@ (cc-bytecomp-defun c-backward-token-1) (cc-bytecomp-defun c-beginning-of-statement-1) (cc-bytecomp-defun c-backward-sws) +(cc-bytecomp-defun c-forward-sws) (defvar awk-mode-syntax-table (let ((st (make-syntax-table))) @@ -169,9 +170,9 @@ (concat "\\=_?\"" c-awk-string-innards-re)) ;; Matches an AWK string at point up to, but not including, any terminator. ;; A gawk 3.1+ string may look like _"localizable string". -(defconst c-awk-one-line-possibly-open-string-re - (concat "\"\\(" c-awk-string-ch-re "\\|" c-awk-non-eol-esc-pair-re "\\)*" - "\\(\"\\|\\\\?$\\|\\'\\)")) +(defconst c-awk-possibly-open-string-re + (concat "\"\\(" c-awk-string-ch-re "\\|" c-awk-esc-pair-re "\\)*" + "\\(\"\\|$\\|\\'\\)")) ;; REGEXPS FOR AWK REGEXPS. (defconst c-awk-regexp-normal-re "[^[/\\\n\r]") @@ -192,25 +193,13 @@ "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)")) ;; Matches a regexp char list, up to (but not including) EOL if the ] is ;; missing. -(defconst c-awk-regexp-one-line-possibly-open-char-list-re - (concat "\\[\\]?\\(" c-awk-non-eol-esc-pair-re "\\|" "[^]\n\r]" "\\)*" - "\\(]\\|\\\\?$\\|\\'\\)")) -;; Matches the head (or all) of a regexp char class, up to (but not -;; including) the first EOL. (defconst c-awk-regexp-innards-re (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-list-re - "\\|" c-awk-regexp-normal-re "\\)*")) + "\\|" c-awk-regexp-normal-re "\\)*")) ;; Matches the inside of an AWK regexp (i.e. without the enclosing /s) (defconst c-awk-regexp-without-end-re (concat "/" c-awk-regexp-innards-re)) ;; Matches an AWK regexp up to, but not including, any terminating /. -(defconst c-awk-one-line-possibly-open-regexp-re - (concat "/\\(" c-awk-non-eol-esc-pair-re - "\\|" c-awk-regexp-one-line-possibly-open-char-list-re - "\\|" c-awk-regexp-normal-re "\\)*" - "\\(/\\|\\\\?$\\|\\'\\)")) -;; Matches as much of the head of an AWK regexp which fits on one line, -;; possibly all of it. ;; REGEXPS used for scanning an AWK buffer in order to decide IF A '/' IS A ;; REGEXP OPENER OR A DIVISION SIGN. By "state" in the following is meant @@ -262,15 +251,24 @@ ;; REGEXPS USED FOR FINDING THE POSITION OF A "virtual semicolon" (defconst c-awk-_-harmless-nonws-char-re "[^#/\"\\\\\n\r \t]") -;; NEW VERSION! (which will be restricted to the current line) -(defconst c-awk-one-line-non-syn-ws*-re - (concat "\\([ \t]*" - "\\(" c-awk-_-harmless-nonws-char-re "\\|" - c-awk-non-eol-esc-pair-re "\\|" - c-awk-one-line-possibly-open-string-re "\\|" - c-awk-one-line-possibly-open-regexp-re - "\\)" - "\\)*")) +(defconst c-awk-non-/-syn-ws*-re + (concat + "\\(" c-awk-escaped-nls*-with-space* + "\\(" c-awk-_-harmless-nonws-char-re "\\|" + c-awk-non-eol-esc-pair-re "\\|" + c-awk-possibly-open-string-re + "\\)" + "\\)*")) +(defconst c-awk-space*-/-re (concat c-awk-escaped-nls*-with-space* "/")) +;; Matches optional whitespace followed by "/". +(defconst c-awk-space*-regexp-/-re + (concat c-awk-escaped-nls*-with-space* "\\s\"")) +;; Matches optional whitespace followed by a "/" with string syntax (a matched +;; regexp delimiter). +(defconst c-awk-space*-unclosed-regexp-/-re + (concat c-awk-escaped-nls*-with-space* "\\s\|")) +;; Matches optional whitespace followed by a "/" with string fence syntax (an +;; unmatched regexp delimiter). ;; ACM, 2002/5/29: @@ -549,10 +547,36 @@ (defun c-awk-at-vsemi-p (&optional pos) ;; Is there a virtual semicolon at POS (or POINT)? (save-excursion - (let (nl-prop - (pos-or-point (progn (if pos (goto-char pos)) (point)))) - (forward-line 0) - (search-forward-regexp c-awk-one-line-non-syn-ws*-re) + (let* (nl-prop + (pos-or-point (progn (if pos (goto-char pos)) (point))) + (bol (c-point 'bol)) (eol (c-point 'eol))) + (c-awk-beginning-of-logical-line) + ;; Next `while' goes round one logical line (ending in, e.g. "\\") per + ;; iteration. Such a line is rare, and can only be an open string + ;; ending in an escaped \. + (while + (progn + ;; Next `while' goes over a division sign or /regexp/ per iteration. + (while + (and + (< (point) eol) + (progn + (search-forward-regexp c-awk-non-/-syn-ws*-re eol) + (looking-at c-awk-space*-/-re))) + (cond + ((looking-at c-awk-space*-regexp-/-re) ; /regexp/ + (forward-sexp)) + ((looking-at c-awk-space*-unclosed-regexp-/-re) ; Unclosed /regexp + (condition-case nil + (progn + (forward-sexp) + (backward-char)) ; Move to end of (logical) line. + (error (end-of-line)))) ; Happens at EOB. + (t ; division sign + (c-forward-syntactic-ws) + (forward-char)))) + (< (point) bol)) + (forward-line)) (and (eq (point) pos-or-point) (progn (while (and (eq (setq nl-prop (c-awk-get-NL-prop-cur-line)) ?\\) diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index e41455f7883..19366279b6c 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -1,6 +1,6 @@ ;;; cc-bytecomp.el --- compile time setup for proper compilation -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Martin Stjernholm ;; Maintainer: bug-cc-mode@gnu.org @@ -232,6 +232,9 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) (cc-bytecomp-setup-environment) t)))) +(defvar cc-bytecomp-noruntime-functions nil + "Saved value of `byte-compile-noruntime-functions'.") + (defmacro cc-require (cc-part) "Force loading of the corresponding .el file in the current directory during compilation, but compile in a `require'. Don't use within @@ -240,7 +243,18 @@ during compilation, but compile in a `require'. Don't use within Having cyclic cc-require's will result in infinite recursion. That's somewhat intentional." `(progn - (eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part))) + (eval-when-compile + (if (boundp 'byte-compile-noruntime-functions) ; in case load uncompiled + (setq cc-bytecomp-noruntime-functions + byte-compile-noruntime-functions)) + (cc-bytecomp-load (symbol-name ,cc-part))) + ;; Hack to suppress spurious "might not be defined at runtime" warnings. + ;; The basic issue is that + ;; (eval-when-compile (require 'foo)) + ;; (require 'foo) + ;; produces bogus noruntime warnings about functions from foo. + (eval-when-compile + (setq byte-compile-noruntime-functions cc-bytecomp-noruntime-functions)) (require ,cc-part))) (defmacro cc-provide (feature) @@ -266,7 +280,7 @@ somewhat intentional." during compilation, but do a compile time `require' otherwise. Don't use within `eval-when-compile'." `(eval-when-compile - (if (and (featurep 'cc-bytecomp) + (if (and (fboundp 'cc-bytecomp-is-compiling) (cc-bytecomp-is-compiling)) (if (or (not load-in-progress) (not (featurep ,cc-part))) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index e7b12ba04c8..4f205d62a4c 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1,6 +1,6 @@ ;;; cc-cmds.el --- user level commands for CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -45,7 +45,6 @@ (cc-require 'cc-engine) ;; Silence the compiler. -(cc-bytecomp-defun delete-forward-p) ; XEmacs (cc-bytecomp-defvar filladapt-mode) ; c-fill-paragraph contains a kludge ; which looks at this. @@ -357,6 +356,8 @@ left out." (interactive "P") (setq c-electric-flag (c-calculate-state arg c-electric-flag)) (c-update-modeline) + (when (fboundp 'electric-indent-local-mode) ; Emacs 24.4 or later. + (electric-indent-local-mode (if c-electric-flag 1 0))) (c-keep-region-active)) @@ -475,7 +476,7 @@ inside a literal or a macro, nothing special happens." (bolp (bolp))) (beginning-of-line) (delete-horizontal-space) - (insert last-command-event) + (insert (c-last-command-char)) (and (not bolp) (goto-char (- (point-max) pos))) ))) @@ -737,7 +738,7 @@ settings of `c-cleanup-list' are done." ;; `}': clean up empty defun braces (when (c-save-buffer-state () (and (memq 'empty-defun-braces c-cleanup-list) - (eq last-command-event ?\}) + (eq (c-last-command-char) ?\}) (c-intersect-lists '(defun-close class-close inline-close) syntax) (progn @@ -753,14 +754,14 @@ settings of `c-cleanup-list' are done." ;; `}': compact to a one-liner defun? (save-match-data (when - (and (eq last-command-event ?\}) + (and (eq (c-last-command-char) ?\}) (memq 'one-liner-defun c-cleanup-list) (c-intersect-lists '(defun-close) syntax) (c-try-one-liner)) (setq here (- (point-max) pos)))) ;; `{': clean up brace-else-brace and brace-elseif-brace - (when (eq last-command-event ?\{) + (when (eq (c-last-command-char) ?\{) (cond ((and (memq 'brace-else-brace c-cleanup-list) (re-search-backward @@ -814,7 +815,7 @@ settings of `c-cleanup-list' are done." )))) ;; blink the paren - (and (eq last-command-event ?\}) + (and (eq (c-last-command-char) ?\}) (not executing-kbd-macro) old-blink-paren (save-excursion @@ -851,7 +852,7 @@ is inhibited." (when (and (not arg) (eq literal 'c) (memq 'comment-close-slash c-cleanup-list) - (eq last-command-event ?/) + (eq (c-last-command-char) ?/) (looking-at (concat "[ \t]*\\(" (regexp-quote comment-end) "\\)?$")) ; (eq c-block-comment-ender "*/") ; C-style comments ALWAYS end in */ @@ -867,7 +868,7 @@ is inhibited." (setq indentp (and (not arg) c-syntactic-indentation c-electric-flag - (eq last-command-event ?/) + (eq (c-last-command-char) ?/) (eq (char-before) (if literal ?* ?/)))) (self-insert-command (prefix-numeric-value arg)) (if indentp @@ -941,10 +942,10 @@ settings of `c-cleanup-list'." (let ((pos (- (point-max) (point)))) (if (c-save-buffer-state () (and (or (and - (eq last-command-event ?,) + (eq (c-last-command-char) ?,) (memq 'list-close-comma c-cleanup-list)) (and - (eq last-command-event ?\;) + (eq (c-last-command-char) ?\;) (memq 'defun-close-semi c-cleanup-list))) (progn (forward-char -1) @@ -1101,7 +1102,7 @@ numeric argument is supplied, or the point is inside a literal." ;; Indent the line if appropriate. (when (and c-electric-flag c-syntactic-indentation c-recognize-<>-arglists) (setq found-delim - (if (eq last-command-event ?<) + (if (eq (c-last-command-char) ?<) ;; If a <, basically see if it's got "template" before it ..... (or (and (progn (backward-char) @@ -1195,7 +1196,7 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; clean up brace-elseif-brace (when (and (memq 'brace-elseif-brace c-cleanup-list) - (eq last-command-event ?\() + (eq (c-last-command-char) ?\() (re-search-backward (concat "}" "\\([ \t\n]\\|\\\\\n\\)*" @@ -1213,7 +1214,7 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; clean up brace-catch-brace (when (and (memq 'brace-catch-brace c-cleanup-list) - (eq last-command-event ?\() + (eq (c-last-command-char) ?\() (re-search-backward (concat "}" "\\([ \t\n]\\|\\\\\n\\)*" @@ -1234,7 +1235,7 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; space-before-funcall clean-up? ((and (memq 'space-before-funcall c-cleanup-list) - (eq last-command-event ?\() + (eq (c-last-command-char) ?\() (save-excursion (backward-char) (skip-chars-backward " \t") @@ -1252,7 +1253,7 @@ newline cleanups are done if appropriate; see the variable `c-cleanup-list'." ;; compact-empty-funcall clean-up? ((c-save-buffer-state () (and (memq 'compact-empty-funcall c-cleanup-list) - (eq last-command-event ?\)) + (eq (c-last-command-char) ?\)) (save-excursion (c-safe (backward-char 2)) (when (looking-at "()") @@ -1281,7 +1282,7 @@ keyword on the line, the keyword is not inserted inside a literal, and (when (c-save-buffer-state () (and c-electric-flag c-syntactic-indentation - (not (eq last-command-event ?_)) + (not (eq (c-last-command-char) ?_)) (= (save-excursion (skip-syntax-backward "w") (point)) diff --git a/lisp/progmodes/cc-compat.el b/lisp/progmodes/cc-compat.el index 1f8782cc920..8486742281e 100644 --- a/lisp/progmodes/cc-compat.el +++ b/lisp/progmodes/cc-compat.el @@ -1,6 +1,6 @@ ;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 1998- Martin Stjernholm ;; 1994-1999 Barry A. Warsaw diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 78c3f32b7a0..1606cfb3357 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,6 +1,6 @@ ;;; cc-defs.el --- compile time definitions for CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -48,16 +48,12 @@ ;; Silence the compiler. (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el -(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs (cc-bytecomp-defun region-active-p) ; XEmacs -(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs -(cc-bytecomp-defvar zmacs-regions) ; XEmacs (cc-bytecomp-defvar mark-active) ; Emacs (cc-bytecomp-defvar deactivate-mark) ; Emacs (cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs (cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21 -(cc-bytecomp-defvar lookup-syntax-properties) ; XEmacs (cc-bytecomp-defun string-to-syntax) ; Emacs 21 @@ -93,7 +89,7 @@ ;;; Variables also used at compile time. -(defconst c-version "5.32.4" +(defconst c-version "5.32.5" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -334,6 +330,8 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-region-is-active-p () ;; Return t when the region is active. The determination of region ;; activeness is different in both Emacs and XEmacs. + ;; FIXME? Emacs has region-active-p since 23.1, so maybe this test + ;; should be updated. (if (cc-bytecomp-boundp 'mark-active) ;; Emacs. 'mark-active @@ -343,7 +341,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it ;; otherwise. Covers the differences between Emacs and XEmacs. - (if (cc-bytecomp-fboundp 'zmacs-activate-region) + (if (fboundp 'zmacs-activate-region) ;; XEmacs. `(if ,activate (zmacs-activate-region) @@ -376,6 +374,13 @@ to it is returned. This function does not modify the point or the mark." `(int-to-char ,integer) integer)) +(defmacro c-last-command-char () + ;; The last character just typed. Note that `last-command-event' exists in + ;; both Emacs and XEmacs, but with confusingly different meanings. + (if (featurep 'xemacs) + 'last-command-char + 'last-command-event)) + (defmacro c-sentence-end () ;; Get the regular expression `sentence-end'. (if (cc-bytecomp-fboundp 'sentence-end) @@ -700,9 +705,9 @@ be after it." ;; `c-parse-state'. `(progn - (if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth) + (if (and ,(fboundp 'buffer-syntactic-context-depth) c-enable-xemacs-performance-kludge-p) - ,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth) + ,(when (fboundp 'buffer-syntactic-context-depth) ;; XEmacs only. This can improve the performance of ;; c-parse-state to between 3 and 60 times faster when ;; braces are hung. It can also degrade performance by @@ -1132,7 +1137,7 @@ been put there by c-put-char-property. POINT remains unchanged." ;; Make edebug understand the macros. ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn -(def-edebug-spec cc-eval-when-compile t) +(def-edebug-spec cc-eval-when-compile (&rest def-form)) (def-edebug-spec c-point t) (def-edebug-spec c-set-region-active t) (def-edebug-spec c-safe t) @@ -1288,10 +1293,14 @@ been put there by c-put-char-property. POINT remains unchanged." ;; suppressed. `(unwind-protect (c-save-buffer-state () - (c-clear-cpp-delimiters ,beg ,end) + (save-restriction + (widen) + (c-clear-cpp-delimiters ,beg ,end)) ,`(c-with-cpps-commented-out ,@forms)) (c-save-buffer-state () - (c-set-cpp-delimiters ,beg ,end)))) + (save-restriction + (widen) + (c-set-cpp-delimiters ,beg ,end))))) (defsubst c-intersect-lists (list alist) ;; return the element of ALIST that matches the first element found @@ -1599,7 +1608,7 @@ non-nil, a caret is prepended to invert the set." (let ((buf (generate-new-buffer " test")) parse-sexp-lookup-properties parse-sexp-ignore-comments - lookup-syntax-properties) + lookup-syntax-properties) ; XEmacs (with-current-buffer buf (set-syntax-table (make-syntax-table)) @@ -2210,7 +2219,7 @@ quoted." ;;(message (concat "Loading %s to get the source " ;; "value for language constant %s") ;; file name) - (load file)) + (load file nil t)) (unless (setq assignment-entry (cdar file-entry)) ;; The load didn't fill in the source for the diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 977bc755e32..f86e4b2c48a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,6 +1,6 @@ -;;; cc-engine.el --- core syntax guessing engine for CC mode +;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2001- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -147,9 +147,6 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) -;; Silence the compiler. -(cc-bytecomp-defun buffer-syntactic-context) ; XEmacs - ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -1138,9 +1135,13 @@ comment at the start of cc-engine.el for more info." (not (memq sym '(boundary ignore nil)))) ;; Need to investigate closer whether we've crossed ;; between a substatement and its containing statement. - (if (setq saved (if (looking-at c-block-stmt-1-key) - ptok - pptok)) + (if (setq saved + (cond ((and (looking-at c-block-stmt-1-2-key) + (eq (char-after ptok) ?\()) + pptok) + ((looking-at c-block-stmt-1-key) + ptok) + (t pptok))) (cond ((> start saved) (setq pos saved)) ((= start saved) (setq ret 'up))))) @@ -1260,16 +1261,22 @@ comment at the start of cc-engine.el for more info." ;; looking for more : and ?. (setq c-maybe-labelp nil skip-chars (substring c-stmt-delim-chars 0 -2))) - ;; At a CPP construct? - ((and c-opt-cpp-symbol (looking-at c-opt-cpp-symbol) - (save-excursion - (forward-line 0) - (looking-at c-opt-cpp-prefix))) - (c-end-of-macro)) + ;; At a CPP construct or a "#" or "##" operator? + ((and c-opt-cpp-symbol (looking-at c-opt-cpp-symbol)) + (if (save-excursion + (skip-chars-backward " \t") + (and (bolp) + (or (bobp) + (not (eq (char-before (1- (point))) ?\\))))) + (c-end-of-macro) + (skip-chars-forward c-opt-cpp-symbol))) ((memq (char-after) non-skip-list) (throw 'done (point))))) ;; In trailing space after an as yet undetected virtual semicolon? (c-backward-syntactic-ws from) + (when (and (bolp) (not (bobp))) ; Can happen in AWK Mode with an + ; unterminated string/regexp. + (backward-char)) (if (and (< (point) to) (c-at-vsemi-p)) (point) @@ -2180,32 +2187,46 @@ comment at the start of cc-engine.el for more info." ;; reduced by buffer changes, and increased by invocations of ;; `c-state-literal-at'. FIXME!!! -(defsubst c-state-pp-to-literal (from to) +(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either ;; (STATE TYPE (BEG . END)) if TO is in a literal; or ;; (STATE) otherwise, ;; where STATE is the parsing state at TO, TYPE is the type of the literal ;; (one of 'c, 'c++, 'string) and (BEG . END) is the boundaries of the literal. ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), ;; 7 (comment type) and 8 (start of comment/string) (and possibly 9) of ;; STATE are valid. (save-excursion (let ((s (parse-partial-sexp from to)) - ty) - (when (or (nth 3 s) (nth 4 s)) ; in a string or comment + ty co-st) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) - ((eq (nth 7 s) t) 'c++) + ((nth 7 s) 'c++) (t 'c))) (parse-partial-sexp (point) (point-max) - nil ; TARGETDEPTH - nil ; STOPBEFORE - s ; OLDSTATE - 'syntax-table)) ; stop at end of literal - (if ty - `(,s ,ty (,(nth 8 s) . ,(point))) - `(,s))))) + nil ; TARGETDEPTH + nil ; STOPBEFORE + s ; OLDSTATE + 'syntax-table) ; stop at end of literal + `(,s ,ty (,(nth 8 s) . ,(point)))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (looking-at "\\s!")) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) + co-st (point)) + (forward-comment 1) + `(,s ,ty (,co-st . ,(point)))) + + (t `(,s)))))) (defun c-state-safe-place (here) ;; Return a buffer position before HERE which is "safe", i.e. outside any @@ -2280,25 +2301,25 @@ comment at the start of cc-engine.el for more info." (while (and c (> (car c) c-state-semi-nonlit-pos-cache-limit)) (setq c (cdr c))) (setq c-state-semi-nonlit-pos-cache c) - + (while (and c (> (car c) here)) (setq high-pos (car c)) (setq c (cdr c))) (setq pos (or (car c) (point-min))) - + (unless high-pos (while ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. (and (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) - + ;; Test for being in a literal. If so, go to after it. (progn (setq lit (car (cddr (c-state-pp-to-literal pos npos)))) (or (null lit) (prog1 (<= (cdr lit) here) (setq npos (cdr lit)))))) - + (setq pos npos) (setq c-state-semi-nonlit-pos-cache (cons pos c-state-semi-nonlit-pos-cache)))) @@ -2532,8 +2553,11 @@ comment at the start of cc-engine.el for more info." ;; The return value is a list, one of the following: ;; ;; o - ('forward START-POINT) - scan forward from START-POINT, - ;; which is not less than the highest position in `c-state-cache' below here. + ;; which is not less than the highest position in `c-state-cache' below HERE, + ;; which is after GOOD-POS. ;; o - ('backward nil) - scan backwards (from HERE). + ;; o - ('back-and-forward START-POINT) - like 'forward, but when HERE is earlier + ;; than GOOD-POS. ;; o - ('IN-LIT nil) - point is inside the literal containing point-min. (let ((cache-pos (c-get-cache-scan-pos here)) ; highest position below HERE in cache (or 1) strategy ; 'forward, 'backward, or 'IN-LIT. @@ -2548,9 +2572,9 @@ comment at the start of cc-engine.el for more info." ((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting. (setq strategy 'backward)) (t - (setq strategy 'forward + (setq strategy 'back-and-forward start-point cache-pos))) - (list strategy (and (eq strategy 'forward) start-point)))) + (list strategy start-point))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2606,11 +2630,11 @@ comment at the start of cc-engine.el for more info." ;; OLD: { (.) {...........} ;; ^ ^ ;; FROM HERE - ;; + ;; ;; NEW: { {....} (.) {......... ;; ^ ^ ^ ;; LOWER BRACE PAIR HERE or HERE - ;; + ;; ;; This routine should be fast. Since it can get called a LOT, we maintain ;; `c-state-brace-pair-desert', a small cache of "failures", such that we ;; reduce the time wasted in repeated fruitless searches in brace deserts. @@ -2822,9 +2846,10 @@ comment at the start of cc-engine.el for more info." (defun c-remove-stale-state-cache (start-point here pps-point) ;; Remove stale entries from the `c-cache-state', i.e. those which will - ;; not be in it when it is amended for position HERE. Additionally, the - ;; "outermost" open-brace entry before HERE will be converted to a cons if - ;; the matching close-brace is scanned. + ;; not be in it when it is amended for position HERE. This may involve + ;; replacing a CONS element for a brace pair containing HERE with its car. + ;; Additionally, the "outermost" open-brace entry before HERE will be + ;; converted to a cons if the matching close-brace is below HERE. ;; ;; START-POINT is a "maximal" "safe position" - there must be no open ;; parens/braces/brackets between START-POINT and HERE. @@ -2835,7 +2860,7 @@ comment at the start of cc-engine.el for more info." ;; adjust it to get outside a string/comment. (Sorry about this! The code ;; needs to be FAST). ;; - ;; Return a list (GOOD-POS SCAN-BACK-POS PPS-STATE), where + ;; Return a list (GOOD-POS SCAN-BACK-POS CONS-SEPARATED PPS-STATE), where ;; o - GOOD-POS is a position where the new value `c-state-cache' is known ;; to be good (we aim for this to be as high as possible); ;; o - SCAN-BACK-POS, if not nil, indicates there may be a brace pair @@ -2843,6 +2868,9 @@ comment at the start of cc-engine.el for more info." ;; position to scan backwards from. It is the position of the "{" of the ;; last element to be removed from `c-state-cache', when that elt is a ;; cons, otherwise nil. + ;; o - CONS-SEPARATED is t when a cons element in `c-state-cache' has been + ;; replaced by its car because HERE lies inside the brace pair represented + ;; by the cons. ;; o - PPS-STATE is the parse-partial-sexp state at PPS-POINT. (save-excursion (save-restriction @@ -2870,6 +2898,7 @@ comment at the start of cc-engine.el for more info." pos upper-lim ; ,beyond which `c-state-cache' entries are removed scan-back-pos + cons-separated pair-beg pps-point-state target-depth) ;; Remove entries beyond HERE. Also remove any entries inside @@ -2891,7 +2920,8 @@ comment at the start of cc-engine.el for more info." (consp (car c-state-cache)) (> (cdar c-state-cache) upper-lim)) (setcar c-state-cache (caar c-state-cache)) - (setq scan-back-pos (car c-state-cache))) + (setq scan-back-pos (car c-state-cache) + cons-separated t)) ;; The next loop jumps forward out of a nested level of parens each ;; time round; the corresponding elements in `c-state-cache' are @@ -2907,7 +2937,7 @@ comment at the start of cc-engine.el for more info." start-point)) (goto-char pos) (while (and c-state-cache - (or (numberp (car c-state-cache)) ; Have we a { at all? + (or (numberp (car c-state-cache)) ; Have we a { at all? (cdr c-state-cache)) (< (point) here)) (cond @@ -2963,7 +2993,7 @@ comment at the start of cc-engine.el for more info." (setq c-state-cache (cons (cons pair-beg pos) c-state-cache))) - (list pos scan-back-pos pps-state))))) + (list pos scan-back-pos cons-separated pps-state))))) (defun c-remove-stale-state-cache-backwards (here) ;; Strip stale elements of `c-state-cache' by moving backwards through the @@ -3143,10 +3173,13 @@ comment at the start of cc-engine.el for more info." ;; This function is called from c-after-change. ;; The caches of non-literals: - (if (< here c-state-nonlit-pos-cache-limit) - (setq c-state-nonlit-pos-cache-limit here)) - (if (< here c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit here)) + ;; Note that we use "<=" for the possibility of the second char of a two-char + ;; comment opener being typed; this would invalidate any cache position at + ;; HERE. + (if (<= here c-state-nonlit-pos-cache-limit) + (setq c-state-nonlit-pos-cache-limit (1- here))) + (if (<= here c-state-semi-nonlit-pos-cache-limit) + (setq c-state-semi-nonlit-pos-cache-limit (1- here))) ;; `c-state-cache': ;; Case 1: if `here' is in a literal containing point-min, everything @@ -3160,7 +3193,8 @@ comment at the start of cc-engine.el for more info." ;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value ;; below `here'. To maintain its consistency, we may need to insert a new ;; brace pair. - (let ((here-bol (c-point 'bol here)) + (let (open-paren-in-column-0-is-defun-start + (here-bol (c-point 'bol here)) too-high-pa ; recorded {/(/[ next above here, or nil. dropped-cons ; was the last removed element a brace pair? pa) @@ -3231,6 +3265,7 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let* ((here (point)) (here-bopl (c-point 'bopl)) + open-paren-in-column-0-is-defun-start strategy ; 'forward, 'backward etc.. ;; Candidate positions to start scanning from: cache-pos ; highest position below HERE already existing in @@ -3240,6 +3275,7 @@ comment at the start of cc-engine.el for more info." ; are no open parens/braces between it and HERE. bopl-state res + cons-separated scan-backward-pos scan-forward-p) ; used for 'backward. ;; If POINT-MIN has changed, adjust the cache (unless (= (point-min) c-state-point-min) @@ -3252,13 +3288,15 @@ comment at the start of cc-engine.el for more info." ;; SCAN! (cond - ((eq strategy 'forward) + ((memq strategy '(forward back-and-forward)) (setq res (c-remove-stale-state-cache start-point here here-bopl)) (setq cache-pos (car res) scan-backward-pos (cadr res) - bopl-state (car (cddr res))) ; will be nil if (< here-bopl + cons-separated (car (cddr res)) + bopl-state (cadr (cddr res))) ; will be nil if (< here-bopl ; start-point) - (if scan-backward-pos + (if (and scan-backward-pos + (or cons-separated (eq strategy 'forward))) ;scan-backward-pos (c-append-lower-brace-pair-to-state-cache scan-backward-pos here)) (setq good-pos (c-append-to-state-cache cache-pos here)) @@ -3674,7 +3712,7 @@ comment at the start of cc-engine.el for more info." (while (let ((pos (or (and (looking-at c-nonsymbol-token-regexp) (match-end 0)) ;; `c-nonsymbol-token-regexp' should always match - ;; since we've skipped backward over punctuator + ;; since we've skipped backward over punctuation ;; or paren syntax, but consume one char in case ;; it doesn't so that we don't leave point before ;; some earlier incorrect token. @@ -3698,7 +3736,7 @@ comment at the start of cc-engine.el for more info." (if (looking-at c-nonsymbol-token-regexp) (goto-char (match-end 0)) ;; `c-nonsymbol-token-regexp' should always match since - ;; we've skipped backward over punctuator or paren + ;; we've skipped backward over punctuation or paren ;; syntax, but move forward in case it doesn't so that ;; we don't leave point earlier than we started with. (forward-char)) @@ -4444,19 +4482,12 @@ comment at the start of cc-engine.el for more info." (lim (or lim (c-state-semi-safe-place pos))) (pp-to-lit (save-restriction (widen) - (c-state-pp-to-literal lim pos))) + (c-state-pp-to-literal lim pos not-in-delimiter))) (state (car pp-to-lit)) (lit-limits (car (cddr pp-to-lit)))) (cond (lit-limits) - ((and (not not-in-delimiter) - (not (elt state 5)) - (eq (char-before) ?/) - (looking-at "[/*]")) ; FIXME!!! use c-line/block-comment-starter. 2008-09-28. - ;; We're standing in a comment starter. - (backward-char 1) - (cons (point) (progn (c-forward-single-comment) (point)))) (near (goto-char pos) @@ -4610,7 +4641,7 @@ comment at the start of cc-engine.el for more info." s ; state 'syntax-table))) ; stop-comment (setq pos (point))) - + ;; Now try and find enough non-literal characters recorded on the stack. ;; Go back one recorded literal each time round this loop. (while (and (< count how-far-back) @@ -4716,6 +4747,11 @@ comment at the start of cc-engine.el for more info." ;; inside `c-find-decl-spots'. The point is left at `cfd-match-pos' ;; if there is a match, otherwise at `cfd-limit'. ;; + ;; The macro moves point forward to the next putative start of a declaration + ;; or cfd-limit. This decl start is the next token after a "declaration + ;; prefix". The declaration prefix is the earlier of `cfd-prop-match' and + ;; `cfd-re-match'. `cfd-match-pos' is set to the decl prefix. + ;; ;; This macro might do hidden buffer changes. '(progn @@ -4737,34 +4773,47 @@ comment at the start of cc-engine.el for more info." (if (> cfd-re-match-end (point)) (goto-char cfd-re-match-end)) - (while (if (setq cfd-re-match-end - (re-search-forward c-decl-prefix-or-start-re - cfd-limit 'move)) + ;; Each time round, the next `while' moves forward over a pseudo match + ;; of `c-decl-prefix-or-start-re' which is either inside a literal, or + ;; is a ":" not preceded by "public", etc.. `cfd-re-match' and + ;; `cfd-re-match-end' get set. + (while + (progn + (setq cfd-re-match-end (re-search-forward c-decl-prefix-or-start-re + cfd-limit 'move)) + (cond + ((null cfd-re-match-end) + ;; No match. Finish up and exit the loop. + (setq cfd-re-match cfd-limit) + nil) + ((c-got-face-at + (if (setq cfd-re-match (match-end 1)) + ;; Matched the end of a token preceding a decl spot. + (progn + (goto-char cfd-re-match) + (1- cfd-re-match)) + ;; Matched a token that start a decl spot. + (goto-char (match-beginning 0)) + (point)) + c-literal-faces) + ;; Pseudo match inside a comment or string literal. Skip out + ;; of comments and string literals. + (while (progn + (goto-char (next-single-property-change + (point) 'face nil cfd-limit)) + (and (< (point) cfd-limit) + (c-got-face-at (point) c-literal-faces)))) + t) ; Continue the loop over pseudo matches. + ((and (match-string 1) + (string= (match-string 1) ":") + (save-excursion + (or (/= (c-backward-token-2 2) 0) ; no search limit. :-( + (not (looking-at c-decl-start-colon-kwd-re))))) + ;; Found a ":" which isn't part of "public:", etc. + t) + (t nil)))) ;; Found a real match. Exit the pseudo-match loop. - ;; Match. Check if it's inside a comment or string literal. - (c-got-face-at - (if (setq cfd-re-match (match-end 1)) - ;; Matched the end of a token preceding a decl spot. - (progn - (goto-char cfd-re-match) - (1- cfd-re-match)) - ;; Matched a token that start a decl spot. - (goto-char (match-beginning 0)) - (point)) - c-literal-faces) - - ;; No match. Finish up and exit the loop. - (setq cfd-re-match cfd-limit) - nil) - - ;; Skip out of comments and string literals. - (while (progn - (goto-char (next-single-property-change - (point) 'face nil cfd-limit)) - (and (< (point) cfd-limit) - (c-got-face-at (point) c-literal-faces))))) - - ;; If we matched at the decl start, we have to back up over the + ;; If our match was at the decl start, we have to back up over the ;; preceding syntactic ws to set `cfd-match-pos' and to catch ;; any decl spots in the syntactic ws. (unless cfd-re-match @@ -6466,6 +6515,61 @@ comment at the start of cc-engine.el for more info." (c-go-list-forward) t))) +(defmacro c-pull-open-brace (ps) + ;; Pull the next open brace from PS (which has the form of paren-state), + ;; skipping over any brace pairs. Returns NIL when PS is exhausted. + `(progn + (while (consp (car ,ps)) + (setq ,ps (cdr ,ps))) + (prog1 (car ,ps) + (setq ,ps (cdr ,ps))))) + +(defun c-back-over-member-initializers () + ;; Test whether we are in a C++ member initializer list, and if so, go back + ;; to the introducing ":", returning the position of the opening paren of + ;; the function's arglist. Otherwise return nil, leaving point unchanged. + (let ((here (point)) + (paren-state (c-parse-state)) + res) + + (setq res + (catch 'done + (if (not (c-at-toplevel-p)) + (progn + (while (not (c-at-toplevel-p)) + (goto-char (c-pull-open-brace paren-state))) + (c-backward-syntactic-ws) + (when (not (c-simple-skip-symbol-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + (c-backward-syntactic-ws) + (when (memq (char-before) '(?\) ?})) + (when (not (c-go-list-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + (when (c-simple-skip-symbol-backward) + (c-backward-syntactic-ws))) + + (while (eq (char-before) ?,) + (backward-char) + (c-backward-syntactic-ws) + + (when (not (memq (char-before) '(?\) ?}))) + (throw 'done nil)) + (when (not (c-go-list-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws) + (when (not (c-simple-skip-symbol-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + + (and + (eq (char-before) ?:) + (c-just-after-func-arglist-p)))) + + (or res (goto-char here)) + res)) + ;; Handling of large scale constructs like statements and declarations. @@ -6831,45 +6935,57 @@ comment at the start of cc-engine.el for more info." ;; can happen since we don't know if ;; `c-restricted-<>-arglists' will be correct inside the ;; arglist paren that gets entered. - c-parse-and-markup-<>-arglists) + c-parse-and-markup-<>-arglists + ;; Start of the identifier for which `got-identifier' was set. + name-start) (goto-char id-start) ;; Skip over type decl prefix operators. (Note similar code in ;; `c-font-lock-declarators'.) - (while (and (looking-at c-type-decl-prefix-key) - (if (and (c-major-mode-is 'c++-mode) - (match-beginning 3)) - ;; If the second submatch matches in C++ then - ;; we're looking at an identifier that's a - ;; prefix only if it specifies a member pointer. - (when (setq got-identifier (c-forward-name)) - (if (looking-at "\\(::\\)") - ;; We only check for a trailing "::" and - ;; let the "*" that should follow be - ;; matched in the next round. - (progn (setq got-identifier nil) t) - ;; It turned out to be the real identifier, - ;; so stop. - nil)) - t)) - - (if (eq (char-after) ?\() + (if (and c-recognize-typeless-decls + (equal c-type-decl-prefix-key "\\<\\>")) + (when (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) - (forward-char)) - (unless got-prefix-before-parens - (setq got-prefix-before-parens (= paren-depth 0))) - (setq got-prefix t) - (goto-char (match-end 1))) - (c-forward-syntactic-ws)) + (forward-char))) + (while (and (looking-at c-type-decl-prefix-key) + (if (and (c-major-mode-is 'c++-mode) + (match-beginning 3)) + ;; If the third submatch matches in C++ then + ;; we're looking at an identifier that's a + ;; prefix only if it specifies a member pointer. + (when (progn (setq pos (point)) + (setq got-identifier (c-forward-name))) + (setq name-start pos) + (if (looking-at "\\(::\\)") + ;; We only check for a trailing "::" and + ;; let the "*" that should follow be + ;; matched in the next round. + (progn (setq got-identifier nil) t) + ;; It turned out to be the real identifier, + ;; so stop. + nil)) + t)) + + (if (eq (char-after) ?\() + (progn + (setq paren-depth (1+ paren-depth)) + (forward-char)) + (unless got-prefix-before-parens + (setq got-prefix-before-parens (= paren-depth 0))) + (setq got-prefix t) + (goto-char (match-end 1))) + (c-forward-syntactic-ws))) (setq got-parens (> paren-depth 0)) ;; Skip over an identifier. (or got-identifier (and (looking-at c-identifier-start) - (setq got-identifier (c-forward-name)))) + (setq pos (point)) + (setq got-identifier (c-forward-name)) + (setq name-start pos))) ;; Skip over type decl suffix operators. (while (if (looking-at c-type-decl-suffix-key) @@ -6960,23 +7076,27 @@ comment at the start of cc-engine.el for more info." ;; declaration. (throw 'at-decl-or-cast t)) - (when (and got-parens - (not got-prefix) - (not got-suffix-after-parens) - (or backup-at-type - maybe-typeless - backup-maybe-typeless)) - ;; Got a declaration of the form "foo bar (gnu);" where we've - ;; recognized "bar" as the type and "gnu" as the declarator. - ;; In this case it's however more likely that "bar" is the - ;; declarator and "gnu" a function argument or initializer (if - ;; `c-recognize-paren-inits' is set), since the parens around - ;; "gnu" would be superfluous if it's a declarator. Shift the - ;; type one step backward. - (c-fdoc-shift-type-backward))) - ;; Found no identifier. + (when (and got-parens + (not got-prefix) + ;; (not got-suffix-after-parens) + (or backup-at-type + maybe-typeless + backup-maybe-typeless + (eq at-decl-or-cast t) + (save-excursion + (goto-char name-start) + (not (memq (c-forward-type) '(nil maybe)))))) + ;; Got a declaration of the form "foo bar (gnu);" or "bar + ;; (gnu);" where we've recognized "bar" as the type and "gnu" + ;; as the declarator. In this case it's however more likely + ;; that "bar" is the declarator and "gnu" a function argument + ;; or initializer (if `c-recognize-paren-inits' is set), + ;; since the parens around "gnu" would be superfluous if it's + ;; a declarator. Shift the type one step backward. + (c-fdoc-shift-type-backward))) + ;; Found no identifier. (if backup-at-type (progn @@ -7141,19 +7261,23 @@ comment at the start of cc-engine.el for more info." ;; uncommon (e.g. some placements of "const" in C++) it's not worth ;; the effort to look for them.) - (unless (or at-decl-end (looking-at "=[^=]")) - ;; If this is a declaration it should end here or its initializer(*) - ;; should start here, so check for allowed separation tokens. Note - ;; that this rule doesn't work e.g. with a K&R arglist after a - ;; function header. - ;; - ;; *) Don't check for C++ style initializers using parens - ;; since those already have been matched as suffixes. - ;; - ;; If `at-decl-or-cast' is then we've found some other sign that - ;; it's a declaration or cast, so then it's probably an - ;; invalid/unfinished one. - (throw 'at-decl-or-cast at-decl-or-cast)) +;;; 2008-04-16: commented out the next form, to allow the function to recognize +;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon) +;;; as a(n almost complete) declaration, enabling it to be fontified. + ;; CASE 13 + ;; (unless (or at-decl-end (looking-at "=[^=]")) + ;; If this is a declaration it should end here or its initializer(*) + ;; should start here, so check for allowed separation tokens. Note + ;; that this rule doesn't work e.g. with a K&R arglist after a + ;; function header. + ;; + ;; *) Don't check for C++ style initializers using parens + ;; since those already have been matched as suffixes. + ;; + ;; If `at-decl-or-cast' is then we've found some other sign that + ;; it's a declaration or cast, so then it's probably an + ;; invalid/unfinished one. + ;; (throw 'at-decl-or-cast at-decl-or-cast)) ;; Below are tests that only should be applied when we're certain to ;; not have parsed halfway through an expression. @@ -7330,7 +7454,11 @@ comment at the start of cc-engine.el for more info." ;; interactive refontification. (c-put-c-type-property (point) 'c-decl-arg-start)) - (when (and c-record-type-identifiers at-type (not (eq at-type t))) + (when (and c-record-type-identifiers at-type ;; (not (eq at-type t)) + ;; There seems no reason to exclude a token from + ;; fontification just because it's "a known type that can't + ;; be a name or other expression". 2013-09-18. + ) (let ((c-promote-possible-types t)) (save-excursion (goto-char type-start) @@ -7932,7 +8060,8 @@ comment at the start of cc-engine.el for more info." (or (looking-at c-block-stmt-1-key) (and (eq (char-after) ?\() (zerop (c-backward-token-2 1 t lim)) - (looking-at c-block-stmt-2-key))) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key)))) (point)))) (defun c-after-special-operator-id (&optional lim) @@ -8339,15 +8468,6 @@ comment at the start of cc-engine.el for more info." (back-to-indentation) (vector (point) open-paren-pos)))))) -(defmacro c-pull-open-brace (ps) - ;; Pull the next open brace from PS (which has the form of paren-state), - ;; skipping over any brace pairs. Returns NIL when PS is exhausted. - `(progn - (while (consp (car ,ps)) - (setq ,ps (cdr ,ps))) - (prog1 (car ,ps) - (setq ,ps (cdr ,ps))))) - (defun c-most-enclosing-decl-block (paren-state) ;; Return the buffer position of the most enclosing decl-block brace (in the ;; sense of c-looking-at-decl-block) in the PAREN-STATE structure, or nil if @@ -8379,6 +8499,34 @@ comment at the start of cc-engine.el for more info." (not (looking-at "="))))) b-pos))) +(defun c-backward-over-enum-header () + ;; We're at a "{". Move back to the enum-like keyword that starts this + ;; declaration and return t, otherwise don't move and return nil. + (let ((here (point)) + up-sexp-pos before-identifier) + (while + (and + (eq (c-backward-token-2) 0) + (or (not (looking-at "\\s)")) + (c-go-up-list-backward)) + (cond + ((and (looking-at c-symbol-key) (c-on-identifier) + (not before-identifier)) + (setq before-identifier t)) + ((and before-identifier + (or (eq (char-after) ?,) + (looking-at c-postfix-decl-spec-key))) + (setq before-identifier nil) + t) + ((looking-at c-brace-list-key) nil) + ((and c-recognize-<>-arglists + (eq (char-after) ?<) + (looking-at "\\s(")) + t) + (t nil)))) + (or (looking-at c-brace-list-key) + (progn (goto-char here) nil)))) + (defun c-inside-bracelist-p (containing-sexp paren-state) ;; return the buffer position of the beginning of the brace list ;; statement if we're inside a brace list, otherwise return nil. @@ -8393,18 +8541,9 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (or ;; This will pick up brace list declarations. - (c-safe - (save-excursion - (goto-char containing-sexp) - (c-forward-sexp -1) - (let (bracepos) - (if (and (or (looking-at c-brace-list-key) - (progn (c-forward-sexp -1) - (looking-at c-brace-list-key))) - (setq bracepos (c-down-list-forward (point))) - (not (c-crosses-statement-barrier-p (point) - (- bracepos 2)))) - (point))))) + (save-excursion + (goto-char containing-sexp) + (c-backward-over-enum-header)) ;; this will pick up array/aggregate init lists, even if they are nested. (save-excursion (let ((class-key @@ -8412,10 +8551,10 @@ comment at the start of cc-engine.el for more info." ;; check for the class key here. (and (c-major-mode-is 'pike-mode) c-decl-block-key)) - bufpos braceassignp lim next-containing) + bufpos braceassignp lim next-containing macro-start) (while (and (not bufpos) containing-sexp) - (when paren-state + (when paren-state (if (consp (car paren-state)) (setq lim (cdr (car paren-state)) paren-state (cdr paren-state)) @@ -8496,28 +8635,44 @@ comment at the start of cc-engine.el for more info." )))) nil) (t t)))))) - (if (and (eq braceassignp 'dontknow) - (/= (c-backward-token-2 1 t lim) 0)) - (setq braceassignp nil))) - (if (not braceassignp) - (if (eq (char-after) ?\;) - ;; Brace lists can't contain a semicolon, so we're done. - (setq containing-sexp nil) - ;; Go up one level. - (setq containing-sexp next-containing - lim nil - next-containing nil)) - ;; we've hit the beginning of the aggregate list - (c-beginning-of-statement-1 - (c-most-enclosing-brace paren-state)) - (setq bufpos (point)))) - ) + (if (and (eq braceassignp 'dontknow) + (/= (c-backward-token-2 1 t lim) 0)) + (setq braceassignp nil))) + (cond + (braceassignp + ;; We've hit the beginning of the aggregate list. + (c-beginning-of-statement-1 + (c-most-enclosing-brace paren-state)) + (setq bufpos (point))) + ((eq (char-after) ?\;) + ;; Brace lists can't contain a semicolon, so we're done. + (setq containing-sexp nil)) + ((and (setq macro-start (point)) + (c-forward-to-cpp-define-body) + (eq (point) containing-sexp)) + ;; We've a macro whose expansion starts with the '{'. + ;; Heuristically, if we have a ';' in it we've not got a + ;; brace list, otherwise we have. + (let ((macro-end (progn (c-end-of-macro) (point)))) + (goto-char containing-sexp) + (forward-char) + (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t) + (eq (char-before) ?\;)) + (setq bufpos nil + containing-sexp nil) + (setq bufpos macro-start)))) + (t + ;; Go up one level + (setq containing-sexp next-containing + lim nil + next-containing nil))))) + bufpos)) )) (defun c-looking-at-special-brace-list (&optional lim) - ;; If we're looking at the start of a pike-style list, ie `({})', - ;; `([])', `(<>)' etc, a cons of a cons of its starting and ending + ;; If we're looking at the start of a pike-style list, i.e., `({ })', + ;; `([ ])', `(< >)', etc., a cons of a cons of its starting and ending ;; positions and its entry in c-special-brace-lists is returned, nil ;; otherwise. The ending position is nil if the list is still open. ;; LIM is the limit for forward search. The point may either be at @@ -8762,7 +8917,7 @@ comment at the start of cc-engine.el for more info." (c-simple-skip-symbol-backward) (looking-at c-macro-with-semi-re) (goto-char pos) - (not (c-in-literal)))))) ; The most expensive check last. + (not (c-in-literal)))))) ; The most expensive check last. (defun c-macro-vsemi-status-unknown-p () t) ; See cc-defs.el. @@ -9230,7 +9385,8 @@ comment at the start of cc-engine.el for more info." (c-save-buffer-state ((indent-point (point)) (case-fold-search nil) - ;; A whole ugly bunch of various temporary variables. Have + open-paren-in-column-0-is-defun-start + ;; A whole ugly bunch of various temporary variables. Have ;; to declare them here since it's not possible to declare ;; a variable with only the scope of a cond test and the ;; following result clauses, and most of this function is a @@ -9303,10 +9459,6 @@ comment at the start of cc-engine.el for more info." containing-sexp nil))) (setq lim (1+ containing-sexp)))) (setq lim (point-min))) - (when (c-beginning-of-macro) - (goto-char indent-point) - (let ((lim1 (c-determine-limit 2000))) - (setq lim (max lim lim1)))) ;; If we're in a parenthesis list then ',' delimits the ;; "statements" rather than being an operator (with the @@ -9668,18 +9820,13 @@ comment at the start of cc-engine.el for more info." ;; 2007-11-09) )))) - ;; CASE 5B: After a function header but before the body (or - ;; the ending semicolon if there's no body). + ;; CASE 5R: Member init list. (Used to be part of CASE 5B.1) + ;; Note there is no limit on the backward search here, since member + ;; init lists can, in practice, be very large. ((save-excursion - (when (setq placeholder (c-just-after-func-arglist-p - (max lim (c-determine-limit 500)))) + (when (setq placeholder (c-back-over-member-initializers)) (setq tmp-pos (point)))) - (cond - - ;; CASE 5B.1: Member init list. - ((eq (char-after tmp-pos) ?:) - (if (or (>= tmp-pos indent-point) - (= (c-point 'bosws) (1+ tmp-pos))) + (if (= (c-point 'bosws) (1+ tmp-pos)) (progn ;; There is no preceding member init clause. ;; Indent relative to the beginning of indentation @@ -9692,6 +9839,23 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (c-add-syntax 'member-init-cont (point)))) + ;; CASE 5B: After a function header but before the body (or + ;; the ending semicolon if there's no body). + ((save-excursion + (when (setq placeholder (c-just-after-func-arglist-p + (max lim (c-determine-limit 500)))) + (setq tmp-pos (point)))) + (cond + + ;; CASE 5B.1: Member init list. + ((eq (char-after tmp-pos) ?:) + ;; There is no preceding member init clause. + ;; Indent relative to the beginning of indentation + ;; for the topmost-intro line that contains the + ;; prototype's open paren. + (goto-char placeholder) + (c-add-syntax 'member-init-intro (c-point 'boi))) + ;; CASE 5B.2: K&R arg decl intro ((and c-recognize-knr-p (c-in-knr-argdecl lim)) @@ -9727,12 +9891,12 @@ comment at the start of cc-engine.el for more info." (not (eq (char-after) ?:)) ))) (save-excursion - (c-backward-syntactic-ws lim) - (if (eq char-before-ip ?:) - (progn - (forward-char -1) - (c-backward-syntactic-ws lim))) - (back-to-indentation) + (c-beginning-of-statement-1 lim) + (when (looking-at c-opt-<>-sexp-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (c-forward-<>-arglist nil) + (c-forward-syntactic-ws)) (looking-at c-class-key))) ;; for Java (and (c-major-mode-is 'java-mode) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index f6c47f5bb4d..bf5630da045 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,6 +1,6 @@ ;;; cc-fonts.el --- font lock support for CC Mode -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 2002- Martin Stjernholm @@ -176,7 +176,6 @@ 'font-lock-negation-char-face)) (cc-bytecomp-defun face-inverse-video-p) ; Only in Emacs. -(cc-bytecomp-defun face-property-instance) ; Only in XEmacs. (defun c-make-inverse-face (oldface newface) ;; Emacs and XEmacs have completely different face manipulation @@ -1308,7 +1307,8 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char match-pos) (backward-char) (c-backward-token-2) - (looking-at c-block-stmt-2-key))) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key)))) (setq context nil c-restricted-<>-arglists t)) ;; Near BOB. @@ -1473,11 +1473,7 @@ casts and declarations are fontified. Used on level 2 and higher." (numberp (car paren-state)) (save-excursion (goto-char (car paren-state)) - (c-backward-token-2) - (or (looking-at c-brace-list-key) - (progn - (c-backward-token-2) - (looking-at c-brace-list-key))))))) + (c-backward-over-enum-header))))) (c-forward-token-2) nil) @@ -1567,12 +1563,7 @@ casts and declarations are fontified. Used on level 2 and higher." (eq (char-after encl-pos) ?\{) (save-excursion (goto-char encl-pos) - (c-backward-syntactic-ws) - (c-simple-skip-symbol-backward) - (or (looking-at c-brace-list-key) ; "enum" - (progn (c-backward-syntactic-ws) - (c-simple-skip-symbol-backward) - (looking-at c-brace-list-key))))) + (c-backward-over-enum-header))) (c-syntactic-skip-backward "^{," nil t) (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) @@ -1893,7 +1884,7 @@ higher." "\\)\\>" ;; Disallow various common punctuation chars that can't come ;; before the '{' of the enum list, to avoid searching too far. - "[^\]\[{}();,/#=]*" + "[^\]\[{}();/#=]*" "{") '((c-font-lock-declarators limit t nil) (save-match-data @@ -2486,7 +2477,7 @@ need for `pike-font-lock-extra-types'.") (setq comment-beg nil)) (setq region-beg comment-beg)) - (if (eq (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7) t) + (if (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7) ;; Collect a sequence of doc style line comments. (progn (goto-char comment-beg) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index b6f297bd9cc..8a379d429bd 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -1,6 +1,6 @@ ;;; cc-guess.el --- guess indentation values by scanning existing code -;; Copyright (C) 1985, 1987, 1992-2006, 2011-2013 Free Software +;; Copyright (C) 1985, 1987, 1992-2006, 2011-2014 Free Software ;; Foundation, Inc. ;; Author: 1994-1995 Barry A. Warsaw diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 0d5549e4441..29dff4a6394 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1,6 +1,6 @@ -;;; cc-langs.el --- language specific settings for CC Mode +;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2002- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -812,8 +812,8 @@ Assumed to not contain any submatches or \\| operators." (c-lang-defconst c-anchored-cpp-prefix "Regexp matching the prefix of a cpp directive anchored to BOL, in the languages that have a macro preprocessor." - t (if (c-lang-const c-opt-cpp-prefix) - (concat "^" (c-lang-const c-opt-cpp-prefix)))) + t "^\\s *\\(#\\)\\s *" + (java awk) nil) (c-lang-defvar c-anchored-cpp-prefix (c-lang-const c-anchored-cpp-prefix)) (c-lang-defconst c-opt-cpp-start @@ -2040,6 +2040,12 @@ declarations." ;; In CORBA PSDL: "as" "const" "implements" "of" "ref")) +(c-lang-defconst c-postfix-decl-spec-key + ;; Regexp matching the keywords in `c-postfix-decl-spec-kwds'. + t (c-make-keywords-re t (c-lang-const c-postfix-decl-spec-kwds))) +(c-lang-defvar c-postfix-decl-spec-key + (c-lang-const c-postfix-decl-spec-key)) + (c-lang-defconst c-nonsymbol-sexp-kwds "Keywords that may be followed by a nonsymbol sexp before whatever construct it's part of continues." @@ -2163,8 +2169,7 @@ assumed to be set if this isn't nil." (c-lang-defconst c-opt-<>-sexp-key ;; Adorned regexp matching keywords that can be followed by an angle ;; bracket sexp. Always set when `c-recognize-<>-arglists' is. - t (if (c-lang-const c-recognize-<>-arglists) - (c-make-keywords-re t (c-lang-const c-<>-sexp-kwds)))) + t (c-make-keywords-re t (c-lang-const c-<>-sexp-kwds))) (c-lang-defvar c-opt-<>-sexp-key (c-lang-const c-opt-<>-sexp-key)) (c-lang-defconst c-brace-id-list-kwds @@ -2187,6 +2192,18 @@ identifiers that follows the type in a normal declaration." t (c-make-keywords-re t (c-lang-const c-block-stmt-1-kwds))) (c-lang-defvar c-block-stmt-1-key (c-lang-const c-block-stmt-1-key)) +(c-lang-defconst c-block-stmt-1-2-kwds + "Statement keywords optionally followed by a paren sexp. +Keywords here should also be in `c-block-stmt-1-kwds'." + t nil + java '("try")) + +(c-lang-defconst c-block-stmt-1-2-key + ;; Regexp matching the start of a statement which may be followed by a + ;; paren sexp and will then be followed by a substatement. + t (c-make-keywords-re t (c-lang-const c-block-stmt-1-2-kwds))) +(c-lang-defvar c-block-stmt-1-2-key (c-lang-const c-block-stmt-1-2-key)) + (c-lang-defconst c-block-stmt-2-kwds "Statement keywords followed by a paren sexp and then by a substatement." t '("for" "if" "switch" "while") @@ -2576,6 +2593,15 @@ Note that Java specific rules are currently applied to tell this from ;;; Additional constants for parser-level constructs. +(c-lang-defconst c-decl-start-colon-kwd-re + "Regexp matching a keyword that is followed by a colon, where + the whole construct can precede a declaration. + E.g. \"public:\" in C++." + t "\\<\\>" + c++ (c-make-keywords-re t (c-lang-const c-protection-kwds))) +(c-lang-defvar c-decl-start-colon-kwd-re + (c-lang-const c-decl-start-colon-kwd-re)) + (c-lang-defconst c-decl-prefix-re "Regexp matching something that might precede a declaration, cast or label, such as the last token of a preceding statement or declaration. @@ -2615,8 +2641,11 @@ more info." java "\\([\{\}\(;,<]+\\)" ;; Match "<" in C++ to get the first argument in a template arglist. ;; In that case there's an additional check in `c-find-decl-spots' - ;; that it got open paren syntax. - c++ "\\([\{\}\(\);,<]+\\)" + ;; that it got open paren syntax. Match ":" to aid in picking up + ;; "public:", etc. This involves additional checks in + ;; `c-find-decl-prefix-search' to prevent a match of identifiers + ;; or labels. + c++ "\\([\{\}\(\);:,<]+\\)" ;; Additionally match the protection directives in Objective-C. ;; Note that this doesn't cope with the longer directives, which we ;; would have to match from start to end since they don't end with @@ -2805,7 +2834,8 @@ is in effect when this is matched (see `c-identifier-syntax-table')." "\\>") "") "\\)") - (java idl) "\\([\[\(]\\)") + java "\\([\[\(\)]\\)" + idl "\\([\[\(]\\)") (c-lang-defvar c-type-decl-suffix-key (c-lang-const c-type-decl-suffix-key) 'dont-doc) @@ -2907,7 +2937,7 @@ is in effect or not." (c-lang-defconst c-special-brace-lists "List of open- and close-chars that makes up a pike-style brace list, -i.e. for a ([]) list there should be a cons (?\\[ . ?\\]) in this +i.e. for a ([ ]) list there should be a cons (?\\[ . ?\\]) in this list." t nil pike '((?{ . ?}) (?\[ . ?\]) (?< . ?>))) @@ -2926,7 +2956,7 @@ calls before a brace block. This setting does not affect declarations that are preceded by a declaration starting keyword, so e.g. `c-typeless-decl-kwds' may still be used when it's set to nil." t nil - (c c++ objc) t) + (c c++ objc java) t) (c-lang-defvar c-recognize-typeless-decls (c-lang-const c-recognize-typeless-decls)) @@ -2938,7 +2968,8 @@ identifier or one of the keywords on `c-<>-type-kwds' or `c-<>-arglist-kwds'. If there's an identifier before then the whole expression is considered to be a type." t (or (consp (c-lang-const c-<>-type-kwds)) - (consp (c-lang-const c-<>-arglist-kwds)))) + (consp (c-lang-const c-<>-arglist-kwds))) + java t) (c-lang-defvar c-recognize-<>-arglists (c-lang-const c-recognize-<>-arglists)) (c-lang-defconst c-enums-contain-decls diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index a06eaf566d8..67425a0c82c 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -1,6 +1,6 @@ ;;; cc-menus.el --- imenu support for CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 1998- Martin Stjernholm ;; 1992-1999 Barry A. Warsaw @@ -161,49 +161,132 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") cc-imenu-c++-generic-expression "Imenu generic expression for C mode. See `imenu-generic-expression'.") -(defvar cc-imenu-java-generic-expression + +;; Auxiliary regexps for Java try to match their trailing whitespace where +;; appropriate, but _not_ starting whitespace. + +(defconst cc-imenu-java-ellipsis-regexp + (concat + "\\.\\{3\\}" + "[ \t\n\r]*")) + +(defun cc-imenu-java-build-type-args-regex (depth) + "Builds regexp for type arguments list with DEPTH allowed +nested angle brackets constructs." + (if (> depth 0) + (concat "<" + "[][.," c-alnum "_? \t\n\r]+" + (if (> depth 1) + "\\(") + (cc-imenu-java-build-type-args-regex (1- depth)) + (if (> depth 1) + (concat "[][.," c-alnum "_? \t\n\r]*" + "\\)*")) + ">"))) + +(defconst cc-imenu-java-type-spec-regexp + (concat + ;; zero or more identifiers followed by a dot + "\\(" + "[" c-alpha "_][" c-alnum "_]*\\." + "\\)*" + ;; a single mandatory identifier without a dot + "[" c-alpha "_][" c-alnum "_]*" + ;; then choice: + "\\(" + ;; (option 1) type arguments list which _may_ be followed with brackets + ;; and/or spaces, then optional variable arity + "[ \t\n\r]*" + (cc-imenu-java-build-type-args-regex 3) + "[][ \t\n\r]*" + "\\(" cc-imenu-java-ellipsis-regexp "\\)?" + "\\|" + ;; (option 2) just brackets and/or spaces (there should be at least one), + ;; then optional variable arity + "[][ \t\n\r]+" + "\\(" cc-imenu-java-ellipsis-regexp "\\)?" + "\\|" + ;; (option 3) just variable arity + cc-imenu-java-ellipsis-regexp + "\\)")) + +(defconst cc-imenu-java-comment-regexp + (concat + "/" + "\\(" + ;; a traditional comment + "\\*" + "\\(" + "[^*]" + "\\|" + "\\*+[^/*]" + "\\)*" + "\\*+/" + "\\|" + ;; an end-of-line comment + "/[^\n\r]*[\n\r]" + "\\)" + "[ \t\n\r]*" + )) + +;; Comments are allowed before the argument, after any of the +;; modifiers and after the identifier. +(defconst cc-imenu-java-method-arg-regexp + (concat + "\\(" cc-imenu-java-comment-regexp "\\)*" + ;; optional modifiers + "\\(" + ;; a modifier is either an annotation or "final" + "\\(" + "@[" c-alpha "_]" + "[" c-alnum "._]*" + ;; TODO support element-value pairs! + "\\|" + "final" + "\\)" + ;; a modifier ends with comments and/or ws + "\\(" + "\\(" cc-imenu-java-comment-regexp "\\)+" + "\\|" + "[ \t\n\r]+" + "\\(" cc-imenu-java-comment-regexp "\\)*" + "\\)" + "\\)*" + ;; type spec + cc-imenu-java-type-spec-regexp + ;; identifier + "[" c-alpha "_]" + "[" c-alnum "_]*" + ;; optional comments and/or ws + "[ \t\n\r]*" + "\\(" cc-imenu-java-comment-regexp "\\)*" + )) + +(defconst cc-imenu-java-generic-expression `((nil ,(concat - "[" c-alpha "_][\]\[." c-alnum "_<> ]+[ \t\n\r]+" ; type spec - "\\([" c-alpha "_][" c-alnum "_]*\\)" ; method name + cc-imenu-java-type-spec-regexp + "\\(" ; method name which gets captured + ; into index + "[" c-alpha "_]" + "[" c-alnum "_]*" + "\\)" "[ \t\n\r]*" - ;; An argument list htat is either empty or contains any number - ;; of arguments. An argument is any number of annotations - ;; followed by a type spec followed by a word. A word is an - ;; identifier. A type spec is an identifier, possibly followed - ;; by < typespec > possibly followed by []. - (concat "(" - "\\(" - "[ \t\n\r]*" - "\\(" - "@" - "[" c-alpha "_]" - "[" c-alnum "._]""*" - "[ \t\n\r]+" - "\\)*" - "\\(" - "[" c-alpha "_]" - "[\]\[" c-alnum "_.]*" - "\\(" - - "<" - "[ \t\n\r]*" - "[\]\[.," c-alnum "_<> \t\n\r]*" - ">" - "\\)?" - "\\(\\[\\]\\)?" - "[ \t\n\r]+" - "\\)" - "[" c-alpha "_]" - "[" c-alnum "_]*" - "[ \t\n\r,]*" - "\\)*" - ")" - "[.," c-alnum " \t\n\r]*" - "{" - )) 1)) + ;; An argument list that contains zero or more arguments. + (concat + "(" + "[ \t\n\r]*" + "\\(" + "\\(" cc-imenu-java-method-arg-regexp ",[ \t\n\r]*\\)*" + cc-imenu-java-method-arg-regexp + "\\)?" + ")" + "[.,_" c-alnum " \t\n\r]*" ; throws etc. + "{" + )) 7)) "Imenu generic expression for Java mode. See `imenu-generic-expression'.") + ;; Internal variables (defvar cc-imenu-objc-generic-expression-noreturn-index nil) (defvar cc-imenu-objc-generic-expression-general-func-index nil) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 3c3a5766582..9b18bbf82a9 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,6 +1,6 @@ ;;; cc-mode.el --- major mode for editing C and similar languages -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -86,8 +86,8 @@ (load "cc-bytecomp" nil t))) (cc-require 'cc-defs) -(cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) +(cc-require-when-compile 'cc-langs) (cc-require 'cc-engine) (cc-require 'cc-styles) (cc-require 'cc-cmds) @@ -97,7 +97,6 @@ ;; Silence the compiler. (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs -(cc-bytecomp-defun set-keymap-parents) ; XEmacs (cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1 ;; We set these variables during mode init, yet we don't require @@ -189,7 +188,13 @@ control). See \"cc-mode.el\" for more info." (setq c-block-comment-prefix (symbol-value 'c-comment-continuation-stars))) (add-hook 'change-major-mode-hook 'c-leave-cc-mode-mode) - (setq c-initialization-ok t)) + (setq c-initialization-ok t) + ;; Connect up with Emacs's electric-indent-mode, for >= Emacs 24.4 + (when (fboundp 'electric-indent-mode) + (add-hook 'electric-indent-mode-hook 'c-electric-indent-mode-hook) + (when (fboundp 'electric-indent-local-mode) + (add-hook 'electric-indent-local-mode-hook + 'c-electric-indent-local-mode-hook)))) ;; Will try initialization hooks again if they failed. (put 'c-initialize-cc-mode initprop c-initialization-ok)))) @@ -212,18 +217,22 @@ control). See \"cc-mode.el\" for more info." ((cc-bytecomp-fboundp 'set-keymap-parent) (set-keymap-parent map c-mode-base-map)) ;; XEmacs - ((cc-bytecomp-fboundp 'set-keymap-parents) + ((fboundp 'set-keymap-parents) (set-keymap-parents map c-mode-base-map)) ;; incompatible (t (error "CC Mode is incompatible with this version of Emacs"))) map)) -(defun c-define-abbrev-table (name defs) +(defun c-define-abbrev-table (name defs &optional doc) ;; Compatibility wrapper for `define-abbrev' which passes a non-nil ;; sixth argument for SYSTEM-FLAG in emacsen that support it ;; (currently only Emacs >= 21.2). - (let ((table (or (symbol-value name) - (progn (define-abbrev-table name nil) + (let ((table (or (and (boundp name) (symbol-value name)) + (progn (condition-case nil + (define-abbrev-table name nil doc) + (wrong-number-of-arguments ;E.g. Emacs<23. + (eval `(defvar ,name nil ,doc)) + (define-abbrev-table name nil))) (symbol-value name))))) (while defs (condition-case nil @@ -575,6 +584,14 @@ that requires a literal mode spec at compile time." ;; setup the comment indent variable in a Emacs version portable way (set (make-local-variable 'comment-indent-function) 'c-comment-indent) + ;; In Emacs 24.4 onwards, prevent Emacs's built in electric indentation from + ;; messing up CC Mode's, and set `c-electric-flag' if `electric-indent-mode' + ;; has been called by the user. + (when (boundp 'electric-indent-inhibit) (setq electric-indent-inhibit t)) + (when (and (boundp 'electric-indent-mode-has-been-called) + (> electric-indent-mode-has-been-called 1)) + (setq c-electric-flag electric-indent-mode)) + ;; ;; Put submode indicators onto minor-mode-alist, but only once. ;; (or (assq 'c-submode-indicators minor-mode-alist) ;; (setq minor-mode-alist @@ -804,7 +821,7 @@ Note that the style variables are always made local to the buffer." `(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks)))) -;;; Change hooks, linking with Font Lock. +;;; Change hooks, linking with Font Lock and electric-indent-mode. ;; Buffer local variables recording Beginning/End-of-Macro position before a ;; change, when a macro straddles, respectively, the BEG or END (or both) of @@ -936,7 +953,8 @@ Note that the style variables are always made local to the buffer." ;; Add needed properties to each CPP construct in the region. (goto-char c-new-BEG) - (let ((pps-position c-new-BEG) pps-state mbeg) + (skip-chars-backward " \t") + (let ((pps-position (point)) pps-state mbeg) (while (and (< (point) c-new-END) (search-forward-regexp c-anchored-cpp-prefix c-new-END t)) ;; If we've found a "#" inside a string/comment, ignore it. @@ -945,14 +963,12 @@ Note that the style variables are always made local to the buffer." pps-position (point)) (unless (or (nth 3 pps-state) ; in a string? (nth 4 pps-state)) ; in a comment? - (goto-char (match-beginning 0)) + (goto-char (match-beginning 1)) (setq mbeg (point)) (if (> (c-syntactic-end-of-macro) mbeg) (progn (c-neutralize-CPP-line mbeg (point)) - (c-set-cpp-delimiters mbeg (point)) - ;(setq pps-position (point)) - ) + (c-set-cpp-delimiters mbeg (point))) (forward-line)) ; no infinite loop with, e.g., "#//" ))))) @@ -1030,15 +1046,16 @@ Note that the style variables are always made local to the buffer." (list type marked-id type-pos term-pos (buffer-substring-no-properties type-pos term-pos) - (buffer-substring-no-properties beg end))))))) + (buffer-substring-no-properties beg end))))))) - (if c-get-state-before-change-functions - (mapc (lambda (fn) - (funcall fn beg end)) - c-get-state-before-change-functions)) - ))) - ;; The following must be done here rather than in `c-after-change' because - ;; newly inserted parens would foul up the invalidation algorithm. + (if c-get-state-before-change-functions + (let (open-paren-in-column-0-is-defun-start) + (mapc (lambda (fn) + (funcall fn beg end)) + c-get-state-before-change-functions))) + ))) + ;; The following must be done here rather than in `c-after-change' because + ;; newly inserted parens would foul up the invalidation algorithm. (c-invalidate-state-cache beg)) (defvar c-in-after-change-fontification nil) @@ -1060,7 +1077,7 @@ Note that the style variables are always made local to the buffer." ;; This calls the language variable c-before-font-lock-functions, if non nil. ;; This typically sets `syntax-table' properties. - (c-save-buffer-state () + (c-save-buffer-state (case-fold-search open-paren-in-column-0-is-defun-start) ;; When `combine-after-change-calls' is used we might get calls ;; with regions outside the current narrowing. This has been ;; observed in Emacs 20.7. @@ -1078,12 +1095,13 @@ Note that the style variables are always made local to the buffer." (setq beg end))) ;; C-y is capable of spuriously converting category properties - ;; c--as-paren-syntax into hard syntax-table properties. Remove - ;; these when it happens. + ;; c--as-paren-syntax and c-cpp-delimiter into hard syntax-table + ;; properties. Remove these when it happens. (c-clear-char-property-with-value beg end 'syntax-table c-<-as-paren-syntax) (c-clear-char-property-with-value beg end 'syntax-table c->-as-paren-syntax) + (c-clear-char-property-with-value beg end 'syntax-table nil) (c-trim-found-types beg end old-len) ; maybe we don't need all of these. (c-invalidate-sws-region-after beg end) @@ -1161,9 +1179,6 @@ Note that the style variables are always made local to the buffer." ;; `c-set-fl-decl-start' for the detailed functionality. (cons (c-set-fl-decl-start beg) end)) -(defvar c-standard-font-lock-fontify-region-function nil - "Standard value of `font-lock-fontify-region-function'") - (defun c-font-lock-fontify-region (beg end &optional verbose) ;; Effectively advice around `font-lock-fontify-region' which extends the ;; region (BEG END), for example, to avoid context fontification chopping @@ -1178,7 +1193,8 @@ Note that the style variables are always made local to the buffer." ;; ;; Type a space in the first blank line, and the fontification of the next ;; line was fouled up by context fontification. - (let ((new-beg beg) (new-end end) new-region case-fold-search) + (let ((new-beg beg) (new-end end) new-region case-fold-search + open-paren-in-column-0-is-defun-start) (if c-in-after-change-fontification (setq c-in-after-change-fontification nil) (save-restriction @@ -1188,17 +1204,14 @@ Note that the style variables are always made local to the buffer." (setq new-region (funcall fn new-beg new-end)) (setq new-beg (car new-region) new-end (cdr new-region))) c-before-context-fontification-functions)))) - (funcall c-standard-font-lock-fontify-region-function + (funcall (default-value 'font-lock-fontify-region-function) new-beg new-end verbose))) (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change - ;; function will get executed before the font-lock one. Amongst other - ;; things. + ;; function will get executed before the font-lock one. (remove-hook 'after-change-functions 'c-after-change t) - (add-hook 'after-change-functions 'c-after-change nil t) - (setq c-standard-font-lock-fontify-region-function - (default-value 'font-lock-fontify-region-function))) + (add-hook 'after-change-functions 'c-after-change nil t)) (defun c-font-lock-init () "Set up the font-lock variables for using the font-lock support in CC Mode. @@ -1239,30 +1252,46 @@ This function is called from `c-common-init', once per mode initialization." ;; function. (cons c-new-BEG c-new-END)) +;; Connect up to `electric-indent-mode' (Emacs 24.4 and later). +(defun c-electric-indent-mode-hook () + ;; Emacs has en/disabled `electric-indent-mode'. Propagate this through to + ;; each CC Mode buffer. + (when (and (boundp 'electric-indent-mode-has-been-called) + (> electric-indent-mode-has-been-called 1)) + (mapc (lambda (buf) + (with-current-buffer buf + (when c-buffer-is-cc-mode + ;; Don't use `c-toggle-electric-state' here due to recursion. + (setq c-electric-flag electric-indent-mode) + (c-update-modeline)))) + (buffer-list)))) + +(defun c-electric-indent-local-mode-hook () + ;; Emacs has en/disabled `electric-indent-local-mode' for this buffer. + ;; Propagate this through to this buffer's value of `c-electric-flag' + (when c-buffer-is-cc-mode + (setq c-electric-flag electric-indent-mode) + (c-update-modeline))) + ;; Support for C -;;;###autoload -(defvar c-mode-syntax-table nil +(defvar c-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table c)) "Syntax table used in c-mode buffers.") -(or c-mode-syntax-table - (setq c-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table c)))) -(defvar c-mode-abbrev-table nil - "Abbreviation table used in c-mode buffers.") (c-define-abbrev-table 'c-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0))) + ("while" "while" c-electric-continued-statement 0)) + "Abbreviation table used in c-mode buffers.") -(defvar c-mode-map () +(defvar c-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for C. + (define-key map "\C-c\C-e" 'c-macro-expand) + map) "Keymap used in c-mode buffers.") -(if c-mode-map - nil - (setq c-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for C - (define-key c-mode-map "\C-c\C-e" 'c-macro-expand) - ) + (easy-menu-define c-c-menu c-mode-map "C Mode Commands" (cons "C" (c-lang-const c-mode-menu c))) @@ -1327,30 +1356,25 @@ Key bindings: ;; Support for C++ -;;;###autoload -(defvar c++-mode-syntax-table nil +(defvar c++-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table c++)) "Syntax table used in c++-mode buffers.") -(or c++-mode-syntax-table - (setq c++-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table c++)))) -(defvar c++-mode-abbrev-table nil - "Abbreviation table used in c++-mode buffers.") (c-define-abbrev-table 'c++-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) ("while" "while" c-electric-continued-statement 0) - ("catch" "catch" c-electric-continued-statement 0))) + ("catch" "catch" c-electric-continued-statement 0)) + "Abbreviation table used in c++-mode buffers.") -(defvar c++-mode-map () +(defvar c++-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for C++. + (define-key map "\C-c\C-e" 'c-macro-expand) + (define-key map "\C-c:" 'c-scope-operator) + (define-key map "<" 'c-electric-lt-gt) + (define-key map ">" 'c-electric-lt-gt) + map) "Keymap used in c++-mode buffers.") -(if c++-mode-map - nil - (setq c++-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for C++ - (define-key c++-mode-map "\C-c\C-e" 'c-macro-expand) - (define-key c++-mode-map "\C-c:" 'c-scope-operator) - (define-key c++-mode-map "<" 'c-electric-lt-gt) - (define-key c++-mode-map ">" 'c-electric-lt-gt)) (easy-menu-define c-c++-menu c++-mode-map "C++ Mode Commands" (cons "C++" (c-lang-const c-mode-menu c++))) @@ -1387,26 +1411,21 @@ Key bindings: ;; Support for Objective-C -;;;###autoload -(defvar objc-mode-syntax-table nil +(defvar objc-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table objc)) "Syntax table used in objc-mode buffers.") -(or objc-mode-syntax-table - (setq objc-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table objc)))) -(defvar objc-mode-abbrev-table nil - "Abbreviation table used in objc-mode buffers.") (c-define-abbrev-table 'objc-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0))) + ("while" "while" c-electric-continued-statement 0)) + "Abbreviation table used in objc-mode buffers.") -(defvar objc-mode-map () +(defvar objc-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for Objective-C. + (define-key map "\C-c\C-e" 'c-macro-expand) + map) "Keymap used in objc-mode buffers.") -(if objc-mode-map - nil - (setq objc-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for Objective-C - (define-key objc-mode-map "\C-c\C-e" 'c-macro-expand)) (easy-menu-define c-objc-menu objc-mode-map "ObjC Mode Commands" (cons "ObjC" (c-lang-const c-mode-menu objc))) @@ -1445,28 +1464,22 @@ Key bindings: ;; Support for Java -;;;###autoload -(defvar java-mode-syntax-table nil +(defvar java-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table java)) "Syntax table used in java-mode buffers.") -(or java-mode-syntax-table - (setq java-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table java)))) -(defvar java-mode-abbrev-table nil - "Abbreviation table used in java-mode buffers.") (c-define-abbrev-table 'java-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) ("while" "while" c-electric-continued-statement 0) ("catch" "catch" c-electric-continued-statement 0) - ("finally" "finally" c-electric-continued-statement 0))) + ("finally" "finally" c-electric-continued-statement 0)) + "Abbreviation table used in java-mode buffers.") -(defvar java-mode-map () +(defvar java-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for Java. + map) "Keymap used in java-mode buffers.") -(if java-mode-map - nil - (setq java-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for Java - ) ;; Regexp trying to describe the beginning of a Java top-level ;; definition. This is not used by CC Mode, nor is it maintained @@ -1511,24 +1524,18 @@ Key bindings: ;; Support for CORBA's IDL language -;;;###autoload -(defvar idl-mode-syntax-table nil +(defvar idl-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table idl)) "Syntax table used in idl-mode buffers.") -(or idl-mode-syntax-table - (setq idl-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table idl)))) -(defvar idl-mode-abbrev-table nil +(c-define-abbrev-table 'idl-mode-abbrev-table nil "Abbreviation table used in idl-mode buffers.") -(c-define-abbrev-table 'idl-mode-abbrev-table nil) -(defvar idl-mode-map () +(defvar idl-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for IDL. + map) "Keymap used in idl-mode buffers.") -(if idl-mode-map - nil - (setq idl-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for IDL - ) (easy-menu-define c-idl-menu idl-mode-map "IDL Mode Commands" (cons "IDL" (c-lang-const c-mode-menu idl))) @@ -1565,26 +1572,21 @@ Key bindings: ;; Support for Pike -;;;###autoload -(defvar pike-mode-syntax-table nil +(defvar pike-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table pike)) "Syntax table used in pike-mode buffers.") -(or pike-mode-syntax-table - (setq pike-mode-syntax-table - (funcall (c-lang-const c-make-mode-syntax-table pike)))) -(defvar pike-mode-abbrev-table nil - "Abbreviation table used in pike-mode buffers.") (c-define-abbrev-table 'pike-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0))) + ("while" "while" c-electric-continued-statement 0)) + "Abbreviation table used in pike-mode buffers.") -(defvar pike-mode-map () +(defvar pike-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Additional bindings. + (define-key map "\C-c\C-e" 'c-macro-expand) + map) "Keymap used in pike-mode buffers.") -(if pike-mode-map - nil - (setq pike-mode-map (c-make-inherited-keymap)) - ;; additional bindings - (define-key pike-mode-map "\C-c\C-e" 'c-macro-expand)) (easy-menu-define c-pike-menu pike-mode-map "Pike Mode Commands" (cons "Pike" (c-lang-const c-mode-menu pike))) @@ -1629,32 +1631,26 @@ Key bindings: ;;;###autoload (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode)) -;;; Autoload directives must be on the top level, so we construct an -;;; autoload form instead. -;;;###autoload (autoload 'awk-mode "cc-mode" "Major mode for editing AWK code." t) - -(defvar awk-mode-abbrev-table nil - "Abbreviation table used in awk-mode buffers.") (c-define-abbrev-table 'awk-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) - ("while" "while" c-electric-continued-statement 0))) + ("while" "while" c-electric-continued-statement 0)) + "Abbreviation table used in awk-mode buffers.") -(defvar awk-mode-map () +(defvar awk-mode-map + (let ((map (c-make-inherited-keymap))) + ;; Add bindings which are only useful for awk. + (define-key map "#" 'self-insert-command) + (define-key map "/" 'self-insert-command) + (define-key map "*" 'self-insert-command) + (define-key map "\C-c\C-n" 'undefined) ; #if doesn't exist in awk. + (define-key map "\C-c\C-p" 'undefined) + (define-key map "\C-c\C-u" 'undefined) + (define-key map "\M-a" 'c-beginning-of-statement) ; 2003/10/7 + (define-key map "\M-e" 'c-end-of-statement) ; 2003/10/7 + (define-key map "\C-\M-a" 'c-awk-beginning-of-defun) + (define-key map "\C-\M-e" 'c-awk-end-of-defun) + map) "Keymap used in awk-mode buffers.") -(if awk-mode-map - nil - (setq awk-mode-map (c-make-inherited-keymap)) - ;; add bindings which are only useful for awk. - (define-key awk-mode-map "#" 'self-insert-command) - (define-key awk-mode-map "/" 'self-insert-command) - (define-key awk-mode-map "*" 'self-insert-command) - (define-key awk-mode-map "\C-c\C-n" 'undefined) ; #if doesn't exist in awk. - (define-key awk-mode-map "\C-c\C-p" 'undefined) - (define-key awk-mode-map "\C-c\C-u" 'undefined) - (define-key awk-mode-map "\M-a" 'c-beginning-of-statement) ; 2003/10/7 - (define-key awk-mode-map "\M-e" 'c-end-of-statement) ; 2003/10/7 - (define-key awk-mode-map "\C-\M-a" 'c-awk-beginning-of-defun) - (define-key awk-mode-map "\C-\M-e" 'c-awk-end-of-defun)) (easy-menu-define c-awk-menu awk-mode-map "AWK Mode Commands" (cons "AWK" (c-lang-const c-mode-menu awk))) @@ -1772,6 +1768,7 @@ Key bindings: filladapt-mode defun-prompt-regexp font-lock-mode + auto-fill-mode font-lock-maximum-decoration parse-sexp-lookup-properties lookup-syntax-properties)) diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index ff76e21a387..337ef9212d9 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -1,6 +1,6 @@ ;;; cc-styles.el --- support for styles in CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2004- Alan Mackenzie ;; 1998- Martin Stjernholm diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 66ff217c73e..a8d627f94d4 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1,6 +1,6 @@ ;;; cc-vars.el --- user customization variables for CC Mode -;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc. ;; Authors: 2002- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -42,23 +42,25 @@ (cc-require 'cc-defs) -;; Silence the compiler. -(cc-bytecomp-defun get-char-table) ; XEmacs - (cc-eval-when-compile (require 'custom) (require 'widget)) ;;; Helpers -;; This widget exists in newer versions of the Custom library -(or (get 'other 'widget-type) - (define-widget 'other 'sexp - "Matches everything, but doesn't let the user edit the value. + +;; Emacs has 'other since at least version 21.1. +;; FIXME this is probably broken, since the widget is defined +;; in wid-edit, which this file does not load. So we will always +;; define the widget, even when we don't need to. +(when (featurep 'xemacs) + (or (get 'other 'widget-type) + (define-widget 'other 'sexp + "Matches everything, but doesn't let the user edit the value. Useful as last item in a `choice' widget." - :tag "Other" - :format "%t%n" - :value 'other)) + :tag "Other" + :format "%t%n" + :value 'other))) ;; The next defun will supersede c-const-symbol. (eval-and-compile @@ -1622,27 +1624,6 @@ names).")) ) (make-variable-buffer-local 'c-macro-with-semi-re) -(defun c-make-macro-with-semi-re () - ;; Convert `c-macro-names-with-semicolon' into the regexp - ;; `c-macro-with-semi-re' (or just copy it if it's already a re). - (setq c-macro-with-semi-re - (and - c-opt-cpp-macro-define - (cond - ((stringp c-macro-names-with-semicolon) - (copy-sequence c-macro-names-with-semicolon)) - ((consp c-macro-names-with-semicolon) - (concat - "\\<" - (regexp-opt c-macro-names-with-semicolon) - "\\>")) ; N.B. the PAREN param of regexp-opt isn't supported by - ; all XEmacsen. - ((null c-macro-names-with-semicolon) - nil) - (t (error "c-make-macro-with-semi-re: invalid \ -c-macro-names-with-semicolon: %s" - c-macro-names-with-semicolon)))))) - (defvar c-macro-names-with-semicolon '("Q_OBJECT" "Q_PROPERTY" "Q_DECLARE" "Q_ENUMS") "List of #defined symbols whose expansion ends with a semicolon. @@ -1661,6 +1642,28 @@ Note that currently \(2008-11-04) this variable is a prototype, and is likely to disappear or change its form soon.") (make-variable-buffer-local 'c-macro-names-with-semicolon) +(defun c-make-macro-with-semi-re () + ;; Convert `c-macro-names-with-semicolon' into the regexp + ;; `c-macro-with-semi-re' (or just copy it if it's already a re). + (setq c-macro-with-semi-re + (and + (boundp 'c-opt-cpp-macro-define) + c-opt-cpp-macro-define + (cond + ((stringp c-macro-names-with-semicolon) + (copy-sequence c-macro-names-with-semicolon)) + ((consp c-macro-names-with-semicolon) + (concat + "\\<" + (regexp-opt c-macro-names-with-semicolon) + "\\>")) ; N.B. the PAREN param of regexp-opt isn't supported by + ; all XEmacsen. + ((null c-macro-names-with-semicolon) + nil) + (t (error "c-make-macro-with-semi-re: invalid \ +c-macro-names-with-semicolon: %s" + c-macro-names-with-semicolon)))))) + (defvar c-file-style nil "Variable interface for setting style via File Local Variables. In a file's Local Variable section, you can set this variable to a diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 6fb9caa1a42..7d4f6dc25b9 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1,11 +1,11 @@ ;;; cfengine.el --- mode for editing Cfengine files -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Maintainer: Ted Zlatanov ;; Keywords: languages -;; Version: 1.1 +;; Version: 1.3 ;; This file is part of GNU Emacs. @@ -30,11 +30,13 @@ ;; The CFEngine 3.x support doesn't have Imenu support but patches are ;; welcome. +;; By default, CFEngine 3.x syntax is used. + ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer ;; contents: -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-mode)) +;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode)) ;; OR you can choose to always use a specific version, if you prefer ;; it: @@ -43,12 +45,19 @@ ;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode)) ;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode)) +;; It's *highly* recommended that you enable the eldoc minor mode: + +;; (add-hook 'cfengine3-mode-hook 'eldoc-mode) + ;; This is not the same as the mode written by Rolf Ebert ;; , distributed with cfengine-2.0.5. It does ;; better fontification and indentation, inter alia. ;;; Code: +(autoload 'json-read "json") +(autoload 'regexp-opt "regexp-opt") + (defgroup cfengine () "Editing CFEngine files." :group 'languages) @@ -58,9 +67,731 @@ :group 'cfengine :type 'integer) +(defcustom cfengine-cf-promises + (or (executable-find "cf-promises") + (executable-find "/var/cfengine/bin/cf-promises") + (executable-find "/usr/bin/cf-promises") + (executable-find "/usr/sbin/cf-promises") + (executable-find "/usr/local/bin/cf-promises") + (executable-find "/usr/local/sbin/cf-promises") + (executable-find "~/bin/cf-promises") + (executable-find "~/sbin/cf-promises")) + "The location of the cf-promises executable. +Used for syntax discovery and checking. Set to nil to disable +the `compile-command' override. In that case, the ElDoc support +will use a fallback syntax definition." + :version "24.4" + :group 'cfengine + :type '(choice file (const nil))) + +(defcustom cfengine-parameters-indent '(promise pname 0) + "Indentation of CFEngine3 promise parameters (hanging indent). + +For example, say you have this code: + +bundle x y +{ + section: + class:: + promise ... + promiseparameter => ... +} + +You can choose to indent promiseparameter from the beginning of +the line (absolutely) or from the word \"promise\" (relatively). + +You can also choose to indent the start of the word +\"promiseparameter\" or the arrow that follows it. + +Finally, you can choose the amount of the indent. + +The default is to anchor at promise, indent parameter name, and offset 0: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} + +Here we anchor at beginning of line, indent arrow, and offset 10: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} + +Some, including cfengine_stdlib.cf, like to anchor at promise, indent +arrow, and offset 16 or so: + +bundle agent rcfiles +{ + files: + any:: + \"/tmp/netrc\" + comment => \"my netrc\", + perms => mog(\"600\", \"tzz\", \"tzz\"); +} +" + :version "24.4" + :group 'cfengine + :type '(list + (choice (const :tag "Anchor at beginning of promise" promise) + (const :tag "Anchor at beginning of line" bol)) + (choice (const :tag "Indent parameter name" pname) + (const :tag "Indent arrow" arrow)) + (integer :tag "Indentation amount from anchor"))) + (defvar cfengine-mode-debug nil "Whether `cfengine-mode' should print debugging info.") +(defvar cfengine-mode-syntax-cache nil + "Cache for `cfengine-mode' syntax trees obtained from 'cf-promises -s json'.") + +(defconst cfengine3-fallback-syntax + '((functions + (userexists + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (usemodule + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (unique + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (translatepath + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "string") (status . "normal")) + (sum + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "real") (status . "normal")) + (sublist + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "head,tail") (type . "option")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (strftime + (category . "data") (variadic . :json-false) + (parameters . [((range . "gmtime,localtime") (type . "option")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (strcmp + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (splitstring + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (splayclass + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "daily,hourly") (type . "option"))]) + (returnType . "context") (status . "normal")) + (sort + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "lex") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (some + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (shuffle + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (selectservers + (category . "communication") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "int") (status . "normal")) + (reverse + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (rrange + (category . "data") (variadic . :json-false) + (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real")) + ((range . "-9.99999E100,9.99999E100") (type . "real"))]) + (returnType . "rrange") (status . "normal")) + (returnszero + (category . "utils") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "useshell,noshell,powershell") (type . "option"))]) + (returnType . "context") (status . "normal")) + (remoteclassesmatching + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (remotescalar + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option"))]) + (returnType . "string") (status . "normal")) + (regldap + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . ".*") (type . "string")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "context") (status . "normal")) + (reglist + (category . "data") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regline + (category . "io") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (registryvalue + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (regextract + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regcmp + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (regarray + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (readtcp + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (readstringlist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (readstringarrayidx + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readstringarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readreallist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "rlist") (status . "normal")) + (readrealarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readintlist + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "ilist") (status . "normal")) + (readintarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (readfile + (category . "io") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (randomint + (category . "data") (variadic . :json-false) + (parameters . [((range . "-99999999999,9999999999") (type . "int")) + ((range . "-99999999999,9999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (product + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "real") (status . "normal")) + (peerleaders + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (peerleader + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (peers + (category . "communication") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (parsestringarrayidx + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parsestringarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parserealarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (parseintarray + (category . "io") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "0,99999999999") (type . "int")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "int") (status . "normal")) + (or + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (on + (category . "data") (variadic . :json-false) + (parameters . [((range . "1970,3000") (type . "int")) + ((range . "1,12") (type . "int")) + ((range . "1,31") (type . "int")) + ((range . "0,23") (type . "int")) + ((range . "0,59") (type . "int")) + ((range . "0,59") (type . "int"))]) + (returnType . "int") (status . "normal")) + (nth + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (now + (category . "system") (variadic . :json-false) + (parameters . []) + (returnType . "int") (status . "normal")) + (not + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (none + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (maplist + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (maparray + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (lsdir + (category . "files") (variadic . :json-false) + (parameters . [((range . ".+") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (length + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "int") (status . "normal")) + (ldapvalue + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "string") (status . "normal")) + (ldaplist + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (ldaparray + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string")) + ((range . "subtree,onelevel,base") (type . "option")) + ((range . "none,ssl,sasl") (type . "option"))]) + (returnType . "context") (status . "normal")) + (laterthan + (category . "files") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "context") (status . "normal")) + (lastnode + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (join + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "string") (status . "normal")) + (isvariable + (category . "utils") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isplain + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isnewerthan + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (islink + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (islessthan + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isgreaterthan + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isexecutable + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (isdir + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (irange + (category . "data") (variadic . :json-false) + (parameters . [((range . "-99999999999,9999999999") (type . "int")) + ((range . "-99999999999,9999999999") (type . "int"))]) + (returnType . "irange") (status . "normal")) + (iprange + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (intersection + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (ifelse + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (hubknowledge + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "string") (status . "normal")) + (hostswithclass + (category . "communication") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string")) + ((range . "name,address") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (hostsseen + (category . "communication") (variadic . :json-false) + (parameters . [((range . "0,99999999999") (type . "int")) + ((range . "lastseen,notseen") (type . "option")) + ((range . "name,address") (type . "option"))]) + (returnType . "slist") (status . "normal")) + (hostrange + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (hostinnetgroup + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (ip2host + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (host2ip + (category . "communication") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (hashmatch + (category . "data") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (hash + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))]) + (returnType . "string") (status . "normal")) + (groupexists + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (grep + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getvalues + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getusers + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getuid + (category . "system") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getindices + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (getgid + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getfields + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "\"?(/.*)") (type . "string")) + ((range . ".*") (type . "string")) + ((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (getenv + (category . "system") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "string") (status . "normal")) + (format + (category . "data") (variadic . t) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (filter + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "true,false,yes,no,on,off") (type . "option")) + ((range . "0,99999999999") (type . "int"))]) + (returnType . "slist") (status . "normal")) + (filestat + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))]) + (returnType . "string") (status . "normal")) + (filesize + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (filesexist + (category . "files") (variadic . :json-false) + (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))]) + (returnType . "context") (status . "normal")) + (fileexists + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (execresult + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".+") (type . "string")) + ((range . "useshell,noshell,powershell") (type . "option"))]) + (returnType . "string") (status . "normal")) + (every + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "context") (status . "normal")) + (escape + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (diskfree + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (dirname + (category . "files") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (difference + (category . "data") (variadic . :json-false) + (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) + ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (countlinesmatching + (category . "io") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "int") (status . "normal")) + (countclassesmatching + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "int") (status . "normal")) + (classesmatching + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "slist") (status . "normal")) + (classmatch + (category . "utils") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (classify + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "context") (status . "normal")) + (changedbefore + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")) + (concat + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (canonify + (category . "data") (variadic . :json-false) + (parameters . [((range . ".*") (type . "string"))]) + (returnType . "string") (status . "normal")) + (and + (category . "data") (variadic . t) + (parameters . []) + (returnType . "string") (status . "normal")) + (ago + (category . "data") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "int") (status . "normal")) + (accumulated + (category . "data") (variadic . :json-false) + (parameters . [((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,1000") (type . "int")) + ((range . "0,40000") (type . "int"))]) + (returnType . "int") (status . "normal")) + (accessedbefore + (category . "files") (variadic . :json-false) + (parameters . [((range . "\"?(/.*)") (type . "string")) + ((range . "\"?(/.*)") (type . "string"))]) + (returnType . "context") (status . "normal")))) + "Fallback CFEngine syntax, containing just function definitions.") + +(defvar cfengine-mode-syntax-functions-regex + (regexp-opt (mapcar (lambda (def) + (format "%s" (car def))) + (cdr (assq 'functions cfengine3-fallback-syntax))) + 'symbols)) + (defcustom cfengine-mode-abbrevs nil "Abbrevs for CFEngine2 mode." :group 'cfengine @@ -94,14 +825,14 @@ This includes those for cfservd as well as cfagent.") (regexp-opt cfengine3-defuns t) "Regex to match the CFEngine 3.x defuns.") - (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::") + (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::") (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):") (defconst cfengine3-vartypes (mapcar 'symbol-name - '(string int real slist ilist rlist irange rrange counter)) + '(string int real slist ilist rlist irange rrange counter data)) "List of the CFEngine 3.x variable types.")) (defvar cfengine2-font-lock-keywords @@ -117,7 +848,7 @@ This includes those for cfservd as well as cfagent.") ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face) ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) @@ -125,9 +856,9 @@ This includes those for cfservd as well as cfagent.") `( ;; Defuns. This happens early so they don't get caught by looser ;; patterns. - (,(concat "\\<" cfengine3-defuns-regex "\\>" - "[ \t]+\\<\\([[:alnum:]_]+\\)\\>" - "[ \t]+\\<\\([[:alnum:]_]+\\)" + (,(concat "\\_<" cfengine3-defuns-regex "\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)" ;; Optional parentheses with variable names inside. "\\(?:(\\([^)]*\\))\\)?") (1 font-lock-builtin-face) @@ -144,14 +875,14 @@ This includes those for cfservd as well as cfagent.") 1 font-lock-builtin-face) ;; Variables, including scope, e.g. module.var - ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face) - ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face) + ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face) + ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; Variable types. - (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>") + (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>") 1 font-lock-type-face))) (defvar cfengine2-imenu-expression @@ -159,9 +890,9 @@ This includes those for cfservd as well as cfagent.") (regexp-opt cfengine2-actions t)) ":[^:]") 1) - ("Variables/classes" "\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) - ("Variables/classes" "\\[ \t]+\\([[:alnum:]_]+\\)" 1)) + ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) + ("Variables/classes" "\\_[ \t]+\\([[:alnum:]_]+\\)" 1)) "`imenu-generic-expression' for CFEngine mode.") (defun cfengine2-outline-level () @@ -274,7 +1005,7 @@ Intended as the value of `indent-line-function'." Treats body/bundle blocks as defuns." (unless (<= (current-column) (current-indentation)) (end-of-line)) - (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-min))) t) @@ -283,7 +1014,7 @@ Treats body/bundle blocks as defuns." "`end-of-defun' function for Cfengine 3 mode. Treats body/bundle blocks as defuns." (end-of-line) - (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-max))) t) @@ -302,13 +1033,13 @@ Intended as the value of `indent-line-function'." (cond ;; Body/bundle blocks start at 0. - ((looking-at (concat cfengine3-defuns-regex "\\>")) + ((looking-at (concat cfengine3-defuns-regex "\\_>")) (indent-line-to 0)) ;; Categories are indented one step. - ((looking-at (concat cfengine3-category-regex "[ \t]*$")) + ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$")) (indent-line-to cfengine-indent)) ;; Class selectors are indented two steps. - ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$")) + ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$")) (indent-line-to (* 2 cfengine-indent))) ;; Outdent leading close brackets one step. ((or (eq ?\} (char-after)) @@ -317,12 +1048,14 @@ Intended as the value of `indent-line-function'." (indent-line-to (save-excursion (forward-char) (backward-sexp) + (move-beginning-of-line nil) + (skip-chars-forward " \t") (current-column))) (error nil))) - ;; Inside a string and it starts before this line. + ;; Inside a string and it starts before this line: do nothing. ((and (nth 3 parse) (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) - (indent-line-to 0)) + ) ;; Inside a defun, but not a nested list (depth is 1). This is ;; a promise, usually. @@ -331,7 +1064,23 @@ Intended as the value of `indent-line-function'." ;; plus 2. That way, promises indent deeper than class ;; selectors, which in turn are one deeper than categories. ((= 1 (nth 0 parse)) - (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent))) + (let ((p-anchor (nth 0 cfengine-parameters-indent)) + (p-what (nth 1 cfengine-parameters-indent)) + (p-indent (nth 2 cfengine-parameters-indent))) + ;; Do we have the parameter anchor and location and indent + ;; defined, and are we looking at a promise parameter? + (if (and p-anchor p-what p-indent + (looking-at "\\([[:alnum:]_]+[ \t]*\\)=>")) + (let* ((arrow-offset (* -1 (length (match-string 1)))) + (extra-offset (if (eq p-what 'arrow) arrow-offset 0)) + (base-offset (if (eq p-anchor 'promise) + (* (+ 2 (nth 0 parse)) cfengine-indent) + 0))) + (indent-line-to (max 0 (+ p-indent base-offset extra-offset)))) + ;; Else, indent to cfengine-indent times the nested depth + ;; plus 2. That way, promises indent deeper than class + ;; selectors, which in turn are one deeper than categories. + (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent))))) ;; Inside brackets/parens: indent to start column of non-comment ;; token on line following open bracket or by one step from open ;; bracket's column. @@ -417,6 +1166,115 @@ Intended as the value of `indent-line-function'." ;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+:: ;; CATEGORY: [a-zA-Z_]+: +(defun cfengine3--current-function () + "Look up current CFEngine 3 function" + (let* ((syntax (cfengine3-make-syntax-cache)) + (flist (assq 'functions syntax))) + (when flist + (let ((w (save-excursion + (skip-syntax-forward "w_") + (when (search-backward-regexp + cfengine-mode-syntax-functions-regex + (point-at-bol) + t) + (match-string 1))))) + (and w (assq (intern w) flist)))))) + +;; format from "cf-promises -s json", e.g. "sort" function: +;; ((category . "data") +;; (variadic . :json-false) +;; (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) +;; ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))]) +;; (returnType . "slist") +;; (status . "normal")) + +(defun cfengine3-format-function-docstring (fdef) + (let* ((f (format "%s" (car-safe fdef))) + (def (cdr fdef)) + (rtype (cdr (assq 'returnType def))) + (plist (cdr (assq 'parameters def))) + (has-some-parameters (> (length plist) 0)) + (variadic (eq t (cdr (assq 'variadic def))))) + + ;; (format "[%S]%s %s(%s%s)" def + (format "%s %s(%s%s)" + (if rtype + (propertize rtype 'face 'font-lock-variable-name-face) + "???") + (propertize f 'face 'font-lock-function-name-face) + (mapconcat (lambda (p) + (let ((type (cdr (assq 'type p))) + (range (cdr (assq 'range p)))) + (cond + ((not (stringp type)) "???type???") + ((not (stringp range)) "???range???") + ;; options are lists of possible keywords + ((equal type "option") + (propertize (concat "[" range "]") + 'face + 'font-lock-keyword-face)) + ;; anything else is a type name as a variable + (t (propertize type + 'face + 'font-lock-variable-name-face))))) + plist + ", ") + (if variadic + (if has-some-parameters ", ..." "...") + "")))) + +(defun cfengine3-clear-syntax-cache () + "Clear the internal syntax cache. +Should not be necessary unless you reinstall CFEngine." + (interactive) + (setq cfengine-mode-syntax-functions-regex nil) + (setq cfengine-mode-syntax-cache nil)) + +(defun cfengine3-make-syntax-cache () + "Build the CFEngine 3 syntax cache. +Calls `cfengine-cf-promises' with \"-s json\"" + (let ((syntax (cddr (assoc cfengine-cf-promises cfengine-mode-syntax-cache)))) + (if cfengine-cf-promises + (or syntax + (with-demoted-errors + (with-temp-buffer + (call-process-shell-command cfengine-cf-promises + nil ; no input + t ; current buffer + nil ; no redisplay + "-s" "json") + (goto-char (point-min)) + (setq syntax (json-read)) + (setq cfengine-mode-syntax-cache + (cons (cons cfengine-cf-promises syntax) + cfengine-mode-syntax-cache)) + (setq cfengine-mode-syntax-functions-regex + (regexp-opt (mapcar (lambda (def) + (format "%s" (car def))) + (cdr (assq 'functions syntax))) + 'symbols)))))) + cfengine3-fallback-syntax)) + +(defun cfengine3-documentation-function () + "Document CFengine 3 functions around point. +Intended as the value of `eldoc-documentation-function', which see. +Use it by enabling `eldoc-mode'." + (let ((fdef (cfengine3--current-function))) + (when fdef + (cfengine3-format-function-docstring fdef)))) + +(defun cfengine3-completion-function () + "Return completions for function name around or before point." + (cfengine3-make-syntax-cache) + (let* ((bounds (save-excursion + (let ((p (point))) + (skip-syntax-backward "w_" (point-at-bol)) + (list (point) p)))) + (syntax (cfengine3-make-syntax-cache)) + (flist (assq 'functions syntax))) + (when bounds + (append bounds (list (cdr flist)))))) + (defun cfengine-common-settings () (set (make-local-variable 'syntax-propertize-function) ;; In the main syntax-table, \ is marked as a punctuation, because @@ -436,12 +1294,18 @@ Intended as the value of `indent-line-function'." ;; The syntax defaults seem OK to give reasonable word movement. (modify-syntax-entry ?# "<" table) (modify-syntax-entry ?\n ">#" table) - (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\" "\"" table) ; "string" + (modify-syntax-entry ?\' "\"" table) ; 'string' ;; Variable substitution. (modify-syntax-entry ?$ "." table) ;; Doze path separators. (modify-syntax-entry ?\\ "." table)) +(defconst cfengine3--prettify-symbols-alist + '(("->" . ?→) + ("=>" . ?⇒) + ("::" . ?∷))) + ;;;###autoload (define-derived-mode cfengine3-mode prog-mode "CFE3" "Major mode for editing CFEngine3 input. @@ -453,8 +1317,26 @@ to the action header." (cfengine-common-syntax cfengine3-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) + (setq font-lock-defaults - '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun)) + '(cfengine3-font-lock-keywords + nil nil nil beginning-of-defun)) + (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist) + + ;; `compile-command' is almost never a `make' call with CFEngine so + ;; we override it + (when cfengine-cf-promises + (set (make-local-variable 'compile-command) + (concat cfengine-cf-promises + " -f " + (when buffer-file-name + (shell-quote-argument buffer-file-name))))) + + (set (make-local-variable 'eldoc-documentation-function) + #'cfengine3-documentation-function) + + (add-hook 'completion-at-point-functions + #'cfengine3-completion-function nil t) ;; Use defuns as the essential syntax block. (set (make-local-variable 'beginning-of-defun-function) @@ -475,7 +1357,6 @@ to the action header." ;; Shell commands can be quoted by single, double or back quotes. ;; It's debatable whether we should define string syntax, but it ;; should avoid potential confusion in some cases. - (modify-syntax-entry ?\' "\"" cfengine2-mode-syntax-table) (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line) @@ -501,11 +1382,11 @@ on the buffer contents" (save-restriction (goto-char (point-min)) (while (not (or (eobp) v3)) - (setq v3 (looking-at (concat cfengine3-defuns-regex "\\>"))) + (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>"))) (forward-line))) (if v3 (cfengine3-mode) (cfengine2-mode)))) -(defalias 'cfengine-mode 'cfengine-auto-mode) +(defalias 'cfengine-mode 'cfengine3-mode) (provide 'cfengine3) (provide 'cfengine) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 858d3298a65..ce5502a82dd 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -1,9 +1,9 @@ ;;; cmacexp.el --- expand C macros in a region -;; Copyright (C) 1992, 1994, 1996, 2000-2013 Free Software Foundation, +;; Copyright (C) 1992, 1994, 1996, 2000-2014 Free Software Foundation, ;; Inc. -;; Author: Francesco Potorti` +;; Author: Francesco Potortì ;; Adapted-By: ESR ;; Keywords: c @@ -70,7 +70,7 @@ ;; BUG REPORTS ======================================================= ;; Please report bugs, suggestions, complaints and so on to -;; pot@gnu.org (Francesco Potorti`). +;; bug-gnu-emacs@gnu.org and pot@gnu.org (Francesco Potortì). ;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ========================== @@ -404,3 +404,7 @@ Optional arg DISPLAY non-nil means show messages in the echo area." (kill-buffer outbuf)))) ;;; cmacexp.el ends here + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 9e9e2f0b090..f6a94e8bf8c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1,11 +1,11 @@ ;;; compile.el --- run compiler as inferior of Emacs, parse error messages -;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software +;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software ;; Foundation, Inc. ;; Authors: Roland McGrath , ;; Daniel Pfeiffer -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: tools, processes ;; This file is part of GNU Emacs. @@ -513,7 +513,7 @@ listed text properties PROP# are given values VAL# as well." "Directory to restore to when doing `recompile'.") (defvar compilation-directory-matcher - '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1)) + '("\\(?:Entering\\|Leavin\\(g\\)\\) directory [`']\\(.+\\)'$" (2 . 1)) "A list for tracking when directories are entered or left. If nil, do not track directories, e.g. if all file names are absolute. The first element is the REGEXP matching these messages. It can match any number @@ -526,7 +526,7 @@ directory we were in before the last entering message. If you change this, you may also want to change `compilation-page-delimiter'.") (defvar compilation-page-delimiter - "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+" + "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory [`'].+'\n\\)+" "Value of `page-delimiter' in Compilation mode.") (defvar compilation-mode-font-lock-keywords @@ -624,7 +624,9 @@ You might also use mode hooks to specify it in certain modes, like this: (file-exists-p \"Makefile\")) (set (make-local-variable 'compile-command) (concat \"make -k \" - (file-name-sans-extension buffer-file-name))))))" + (if buffer-file-name + (shell-quote-argument + (file-name-sans-extension buffer-file-name))))))))" :type 'string :group 'compilation) ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command)))) @@ -1352,9 +1354,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (eq (car face) 'face) (or (symbolp (cadr face)) (stringp (cadr face)))) - (put-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face (cadr face)) + (compilation--put-prop mn 'font-lock-face (cadr face)) (add-text-properties (match-beginning mn) (match-end mn) (nthcdr 2 face))) @@ -1392,6 +1392,9 @@ to `compilation-error-regexp-alist' if RULES is nil." (move-marker compilation--parsed limit) (goto-char start) (forward-line 0) ;Not line-beginning-position: ignore (comint) fields. + (while (and (not (bobp)) + (get-text-property (1- (point)) 'compilation-multiline)) + (forward-line -1)) (with-silent-modifications (compilation--parse-region (point) compilation--parsed))))) nil) @@ -1581,7 +1584,16 @@ Returns the compilation buffer created." "\\\\\\(.\\)" "\\1" (substring command (1+ (match-beginning 1)) (1- (match-end 1))))) - (t (substitute-env-vars (match-string 1 command))))) + ;; Try globbing as well (bug#15417). + (t (let* ((substituted-dir + (substitute-env-vars (match-string 1 command))) + ;; FIXME: This also tries to expand `*' that were + ;; introduced by the envvar expansion! + (expanded-dir + (file-expand-wildcards substituted-dir))) + (if (= (length expanded-dir) 1) + (car expanded-dir) + substituted-dir))))) (erase-buffer) ;; Select the desired mode. (if (not (eq mode t)) @@ -1611,16 +1623,12 @@ Returns the compilation buffer created." (format "%s started at %s\n\n" mode-name (substring (current-time-string) 0 19)) - ;; The command could be split into several lines, see - ;; `rgrep' for example. We want to display it as one - ;; line. - (apply 'concat (split-string command (regexp-quote "\\\n") t)) - "\n") + command "\n") (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html - (setq outwin (display-buffer outbuf)) + (setq outwin (display-buffer outbuf '(nil (allow-no-window . t)))) (with-current-buffer outbuf (let ((process-environment (append @@ -1642,7 +1650,7 @@ Returns the compilation buffer created." (list command mode name-function highlight-regexp)) (set (make-local-variable 'revert-buffer-function) 'compilation-revert-buffer) - (set-window-start outwin (point-min)) + (and outwin (set-window-start outwin (point-min))) ;; Position point as the user will see it. (let ((desired-visible-point @@ -1651,15 +1659,15 @@ Returns the compilation buffer created." (point-max) ;; Normally put it at the top. (point-min)))) - (if (eq outwin (selected-window)) - (goto-char desired-visible-point) + (goto-char desired-visible-point) + (when (and outwin (not (eq outwin (selected-window)))) (set-window-point outwin desired-visible-point))) ;; The setup function is called before compilation-set-window-height ;; so it can set the compilation-window-height buffer locally. (if compilation-process-setup-function (funcall compilation-process-setup-function)) - (compilation-set-window-height outwin) + (and outwin (compilation-set-window-height outwin)) ;; Start the compilation. (if (fboundp 'start-process) (let ((proc @@ -1814,6 +1822,7 @@ Returns the compilation buffer created." (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) + (define-key map "\C-o" 'compilation-display-error) (define-key map "\C-c\C-k" 'kill-compilation) (define-key map "\M-n" 'compilation-next-error) (define-key map "\M-p" 'compilation-previous-error) @@ -1858,6 +1867,7 @@ Returns the compilation buffer created." (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) + (define-key map "\C-o" 'compilation-display-error) (define-key map "\C-c\C-k" 'kill-compilation) (define-key map "\M-n" 'compilation-next-error) (define-key map "\M-p" 'compilation-previous-error) @@ -2299,6 +2309,12 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (interactive "p") (compilation-next-file (- n))) +(defun compilation-display-error () + "Display the source for current error in another window." + (interactive) + (setq compilation-current-error (point)) + (next-error-no-select 0)) + (defun kill-compilation () "Kill the process made by the \\[compile] or \\[grep] commands." (interactive) @@ -2311,7 +2327,7 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (defun compile-goto-error (&optional event) "Visit the source for the error message at point. -Use this command in a compilation log buffer. Sets the mark at point there." +Use this command in a compilation log buffer." (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) (or (compilation-buffer-p (current-buffer)) @@ -2320,7 +2336,6 @@ Use this command in a compilation log buffer. Sets the mark at point there." (if (get-text-property (point) 'compilation-directory) (dired-other-window (car (get-text-property (point) 'compilation-directory))) - (push-mark) (setq compilation-current-error (point)) (next-error-internal))) @@ -2374,10 +2389,12 @@ This is the value of `next-error-function' in Compilation buffers." ;; (setq timestamp compilation-buffer-modtime))) ) (with-current-buffer - (compilation-find-file - marker - (caar (compilation--loc->file-struct loc)) - (cadr (car (compilation--loc->file-struct loc)))) + (apply #'compilation-find-file + marker + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc))) (let ((screen-columns ;; Obey the compilation-error-screen-columns of the target ;; buffer if its major mode set it buffer-locally. @@ -2482,7 +2499,7 @@ displays at the top of the window; there is no arrow." All arguments are markers. If END-MK is non-nil, mark is set there and overlay is highlighted between MK and END-MK." ;; Show compilation buffer in other window, scrolled to this error. - (let* ((from-compilation-buffer (eq (window-buffer (selected-window)) + (let* ((from-compilation-buffer (eq (window-buffer) (marker-buffer msg))) ;; Use an existing window if it is in a visible frame. (pre-existing (get-buffer-window (marker-buffer msg) 0)) @@ -2491,14 +2508,16 @@ and overlay is highlighted between MK and END-MK." ;; the error location if the two buffers are in two ;; different frames. So don't do it if it's not necessary. pre-existing - (display-buffer (marker-buffer msg)))) + (display-buffer (marker-buffer msg) '(nil (allow-no-window . t))))) (highlight-regexp (with-current-buffer (marker-buffer msg) ;; also do this while we change buffer - (compilation-set-window w msg) + (goto-char (marker-position msg)) + (and w (compilation-set-window w msg)) compilation-highlight-regexp))) ;; Ideally, the window-size should be passed to `display-buffer' ;; so it's only used when creating a new window. - (unless pre-existing (compilation-set-window-height w)) + (when (and (not pre-existing) w) + (compilation-set-window-height w)) (if from-compilation-buffer ;; If the compilation buffer window was selected, @@ -2609,9 +2628,12 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (while (null buffer) ;Repeat until the user selects an existing file. ;; The file doesn't exist. Ask the user where to find it. (save-excursion ;This save-excursion is probably not right. - (let ((pop-up-windows t)) - (compilation-set-window (display-buffer (marker-buffer marker)) - marker) + (let ((w (let ((pop-up-windows t)) + (display-buffer (marker-buffer marker) + '(nil (allow-no-window . t)))))) + (with-current-buffer (marker-buffer marker) + (goto-char marker) + (and w (compilation-set-window w marker))) (let* ((name (read-file-name (format "Find this %s in (default %s): " compilation-error filename) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index e8678fe6281..c4f2b9ffe51 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1,6 +1,6 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs -;; Copyright (C) 1985-1987, 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1991-2014 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Bob Olson @@ -412,15 +412,15 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space', "use cperl-vc-rcs-header or cperl-vc-sccs-header instead." "22.1") -(defcustom cperl-clobber-mode-lists - (not - (and - (boundp 'interpreter-mode-alist) - (assoc "miniperl" interpreter-mode-alist) - (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) - "*Whether to install us into `interpreter-' and `extension' mode lists." - :type 'boolean - :group 'cperl) +;; (defcustom cperl-clobber-mode-lists +;; (not +;; (and +;; (boundp 'interpreter-mode-alist) +;; (assoc "miniperl" interpreter-mode-alist) +;; (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) +;; "*Whether to install us into `interpreter-' and `extension' mode lists." +;; :type 'boolean +;; :group 'cperl) (defcustom cperl-info-on-command-no-prompt nil "*Not-nil (and non-null) means not to prompt on C-h f. @@ -565,6 +565,7 @@ If nil, the value of `cperl-indent-level' will be used." "*Non-nil means that the _ (underline) should be treated as word char." :type 'boolean :group 'cperl) +(make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4") (defcustom cperl-extra-perl-args "" "*Extra arguments to use when starting Perl. @@ -1905,7 +1906,7 @@ or as help on variables `cperl-tips', `cperl-problems', (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) - (if (featurep 'easymenu) + (if (fboundp 'easy-menu-add) (easy-menu-add cperl-menu)) ; A NOP in Emacs. (run-mode-hooks 'cperl-mode-hook) (if cperl-hook-after-change @@ -3123,7 +3124,7 @@ and closing parentheses and brackets." (+ (if (or (memq (elt i 2) (append "}])" nil)) ; char-after (eq 'continuation ; do not stagger continuations (elt (cperl-sniff-for-indent parse-data) 0))) - 0 ; Closing parenth or continuation of a continuation + 0 ; Closing parenthesis or continuation of a continuation cperl-continued-statement-offset) (if (or (elt i 3) ; is-block (not (elt i 4)) ; is-brace @@ -5144,7 +5145,7 @@ Returns some position at the last line." (if (eq (following-char) ?\( ) (progn (forward-sexp 1) - (setq pp (point))) ; past parenth-group + (setq pp (point))) ; past parenthesis-group ;; after `else' or nothing (if ml ; after `else' (skip-chars-backward " \t\n") @@ -6216,6 +6217,10 @@ indentation and initial hashes. Behaves usually outside of comment." (error (message "cperl-init-faces (ignored): %s" errs)))) +(defvar ps-bold-faces) +(defvar ps-italic-faces) +(defvar ps-underlined-faces) + (defun cperl-ps-print-init () "Initialization of `ps-print' components for faces used in CPerl." (eval-after-load "ps-print" @@ -6529,6 +6534,9 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc"))) (eval '(mode-compile)))) ; Avoid a warning +(declare-function Info-find-node "info" + (filename nodename &optional no-going-back strict-case)) + (defun cperl-info-buffer (type) ;; Returns buffer with documentation. Creates if missing. ;; If TYPE, this vars buffer. @@ -6667,10 +6675,13 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (buffer-substring (match-beginning 1) (match-end 1))) +(declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist)) + (defun cperl-imenu-on-info () "Shows imenu for Perl Info Buffer. Opens Perl Info buffer if needed." (interactive) + (require 'imenu) (let* ((buffer (current-buffer)) imenu-create-index-function imenu-prev-index-position-function @@ -7130,6 +7141,10 @@ Use as (defvar cperl-hierarchy '(() ()) "Global hierarchy of classes.") +;; Follows call to (autoloaded) visit-tags-table. +(declare-function file-of-tag "etags" (&optional relative)) +(declare-function etags-snarf-tag "etags" (&optional use-explicit)) + (defun cperl-tags-hier-fill () ;; Suppose we are in a tag table cooked by cperl. (goto-char 1) @@ -7173,6 +7188,7 @@ Use as (end-of-line)))) (declare-function x-popup-menu "menu.c" (position menu)) +(declare-function etags-goto-tag-location "etags" (tag-info)) (defun cperl-tags-hier-init (&optional update) "Show hierarchical menu of classes and methods. @@ -8516,6 +8532,8 @@ the appropriate statement modifier." ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'") (cperl-invert-if-unless-modifiers))) +(declare-function Man-getpage-in-background "man" (topic)) + ;;; By Anthony Foiani ;;; Getting help on modules in C-h f ? ;;; This is a modified version of `man'. @@ -8882,8 +8900,9 @@ do extra unwind via `cperl-unwind-to-safe'." (beginning-of-line) (eq (get-text-property (setq beg (point)) 'syntax-type) 'multiline))) - (if (setq beg (cperl-beginning-of-property beg 'syntax-type)) - (goto-char beg))) + (let ((new-beg (cperl-beginning-of-property beg 'syntax-type))) + (setq beg (if (= new-beg beg) nil new-beg)) + (goto-char new-beg))) (setq beg (point)) (goto-char end) (while (and end diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 674d98b8dc3..c5fa5398dcc 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -1,6 +1,6 @@ ;;; cpp.el --- highlight or hide text according to cpp conditionals -;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 2001-2014 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: c, faces, tools @@ -136,13 +136,18 @@ Each entry is a list with the following elements: ("true" . t) ("both" . both))) +;; FIXME Gets clobbered by cpp-choose-face, so why is even it a defcustom? (defcustom cpp-face-default-list nil "Alist of faces you can choose from for cpp conditionals. Each element has the form (STRING . FACE), where STRING serves as a name (for `cpp-highlight-buffer' only) and FACE is either a face (a symbol) or a cons cell (background-color . COLOR)." - :type '(repeat (cons string (choice face (cons (const background-color) string)))) + :type '(alist :key-type (string :tag "Name") + :value-type (choice face + (const invisible) + (cons (const background-color) + (string :tag "Color")))) :group 'cpp) (defcustom cpp-face-light-name-list diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index b8cbb67ae0b..4e4fc138877 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -1,6 +1,6 @@ ;;; cwarn.el --- highlight suspicious C and C++ constructions -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Anders Lindgren ;; Keywords: c, languages, faces diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 8a868883a11..289ca3f8471 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -1,6 +1,6 @@ ;;; dcl-mode.el --- major mode for editing DCL command files -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Odd Gripenstam ;; Maintainer: Odd Gripenstam diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index 0c8dd61d44f..5363f61853d 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -1,11 +1,11 @@ ;;; ebnf-abn.el --- parser for ABNF (Augmented BNF) -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.2 +;; Old-Version: 1.2 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index bfdf0300f3f..848124b51ab 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -1,11 +1,11 @@ ;;; ebnf-bnf.el --- parser for EBNF -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.10 +;; Old-Version: 1.10 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index d856dbe7de4..5b41e146bb7 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -1,11 +1,11 @@ ;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML) -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.1 +;; Old-Version: 1.1 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 48e3a643de6..607abd6011f 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -1,11 +1,11 @@ ;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.2 +;; Old-Version: 1.2 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index 9c5246d81e4..e1bd1a1d54f 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -1,11 +1,11 @@ ;;; ebnf-iso.el --- parser for ISO EBNF -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.9 +;; Old-Version: 1.9 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index e116a4f2663..0e8909cbfa4 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -1,11 +1,11 @@ ;;; ebnf-otz.el --- syntactic chart OpTimiZer -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.0 +;; Old-Version: 1.0 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 15f0d5cac18..a72ca2c5f65 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -1,11 +1,11 @@ ;;; ebnf-yac.el --- parser for Yacc/Bison -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: wp, ebnf, PostScript -;; Version: 1.4 +;; Old-Version: 1.4 ;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index caa33d36440..eb4191683cc 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1,6 +1,6 @@ ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre @@ -3912,7 +3912,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and {/Effect EffectP def /fP F ForegroundP SetRGB BackgroundP aload pop true BG S /Effect 0 def - ( :) S false BG}if + ( :) S false BG}{pop}ifelse xw yw moveto hT EL RA xp yw moveto diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 4957b58d469..177c341f3e1 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1,9 +1,9 @@ ;;; ebrowse.el --- Emacs C++ class browser & tags facility -;; Copyright (C) 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-2014 Free Software Foundation, Inc. ;; Author: Gerd Moellmann -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: C++ tags tools ;; This file is part of GNU Emacs. @@ -33,12 +33,12 @@ ;;; Code: +(require 'cl-lib) (require 'easymenu) (require 'view) (require 'ebuff-menu) (eval-when-compile - (require 'cl-lib) (require 'helper)) @@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified." found)) -(defun ebrowse-delete-if-not (predicate list) - "Remove elements not satisfying PREDICATE from LIST and return the result. -This is a destructive operation." - (let (result) - (while list - (let ((next (cdr list))) - (when (funcall predicate (car list)) - (setq result (nconc result list)) - (setf (cdr list) nil)) - (setq list next))) - result)) - - (defmacro ebrowse-output (&rest body) "Eval BODY with a writable current buffer. Preserve buffer's modified state." @@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." - (ebrowse-delete-if-not + (cl-delete-if-not (lambda (buffer) (eq (buffer-local-value 'ebrowse--tree buffer) ebrowse--tree)) @@ -1618,7 +1605,7 @@ specifies where to find/view the result." ;; Get the source file to view or find. (setf file (ebrowse-find-source-file file tags-file)) ;; If current window is dedicated, use another frame. - (when (window-dedicated-p (selected-window)) + (when (window-dedicated-p) (setf where 'other-window)) (cond (view (setf ebrowse-temp-position-to-view struc diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index ff6321d74c3..b89b4cf0fe5 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1,10 +1,10 @@ ;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2013 Free +;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2014 Free ;; Software Foundation, Inc. ;; Author: Roland McGrath -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: tools ;; This file is part of GNU Emacs. @@ -982,7 +982,7 @@ See documentation of variable `tags-file-name'." ;; selected window's buffer; without the hair, point is moved in both ;; windows. To prevent this, we save the selected window's point before ;; doing find-tag-noselect, and restore it after. - (let* ((window-point (window-point (selected-window))) + (let* ((window-point (window-point)) (tagbuf (find-tag-noselect tagname next-p regexp-p)) (tagpoint (progn (set-buffer tagbuf) (point)))) (set-window-point (prog1 diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index a305393c7d8..98915985eec 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -1,6 +1,6 @@ ;;; executable.el --- base functionality for executable interpreter scripts -*- byte-compile-dynamic: t -*- -;; Copyright (C) 1994-1996, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1996, 2000-2014 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer ;; Keywords: languages, unix @@ -269,16 +269,15 @@ file modes." (save-restriction (widen) (string= "#!" (buffer-substring (point-min) (+ 2 (point-min))))) - (condition-case nil - (let* ((current-mode (file-modes (buffer-file-name))) - (add-mode (logand ?\111 (default-file-modes)))) - (or (/= (logand ?\111 current-mode) 0) - (zerop add-mode) - (set-file-modes (buffer-file-name) - (logior current-mode add-mode)))) - ;; Eg file-modes can return nil (bug#9879). It should not, - ;; in this context, but we should handle it all the same. - (error (message "Unable to make file executable"))))) + ;; Eg file-modes can return nil (bug#9879). It should not, + ;; in this context, but we should handle it all the same. + (with-demoted-errors "Unable to make file executable: %s" + (let* ((current-mode (file-modes (buffer-file-name))) + (add-mode (logand ?\111 (default-file-modes)))) + (or (/= (logand ?\111 current-mode) 0) + (zerop add-mode) + (set-file-modes (buffer-file-name) + (logior current-mode add-mode))))))) (provide 'executable) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index dba1d6a2f9b..6aee713dd86 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1,6 +1,6 @@ ;;; f90.el --- Fortran-90 mode (free format) -*- lexical-binding: t -*- -;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Torbjörn Einarsson ;; Maintainer: Glenn Morris @@ -247,15 +247,36 @@ (defcustom f90-smart-end 'blink "Qualification of END statements according to the matching block start. -For example, the END that closes an IF block is changed to END -IF. If the block has a label, this is added as well. Allowed -values are 'blink, 'no-blink, and nil. If nil, nothing is done. -The other two settings have the same effect, but 'blink +For example, change the END that closes an IF block to END IF. +If the block has a label, add it as well (unless `f90-smart-end-names' +says not to). Allowed values are `blink', `no-blink', and nil. If nil, +nothing is done. The other two settings have the same effect, but `blink' additionally blinks the cursor to the start of the block." :type '(choice (const blink) (const no-blink) (const nil)) :safe (lambda (value) (memq value '(blink no-blink nil))) :group 'f90) +;; Optional: program, module, type, function, subroutine +;; Not optional: block data?, forall, if, select case/type, associate, do, +;; where, interface, critical +;; No labels: enum +(defcustom f90-smart-end-names t + "Whether completion of END statements should insert optional block names. +For example, when closing a \"PROGRAM PROGNAME\" block, \"PROGNAME\" is +optional in the \"END PROGRAM\" statement. The same is true for modules, +functions, subroutines, and types. Some people prefer to omit the name +from the END statement, since it makes it easier to change the name. + +This does not apply to named DO, IF, etc. blocks. If such blocks +start with a label, they must end with one. + +If an end statement has a name that does not match the start, it is always +corrected, regardless of the value of this variable." + :type 'boolean + :safe 'booleanp + :group 'f90 + :version "24.4") + (defcustom f90-break-delimiters "[-+\\*/><=,% \t]" "Regexp matching delimiter characters at which lines may be broken. There are some common two-character tokens where one or more of @@ -298,55 +319,61 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." ;; User options end here. (defconst f90-keywords-re - (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" - "block" "call" "case" "character" "close" "common" "complex" - "contains" "continue" "cycle" "data" "deallocate" - "dimension" "do" "double" "else" "elseif" "elsewhere" "end" - "enddo" "endfile" "endif" "entry" "equivalence" "exit" - "external" "forall" "format" "function" "goto" "if" - "implicit" "include" "inquire" "integer" "intent" - "interface" "intrinsic" "logical" "module" "namelist" "none" - "nullify" "only" "open" "operator" "optional" "parameter" - "pause" "pointer" "precision" "print" "private" "procedure" - "program" "public" "read" "real" "recursive" "result" "return" - "rewind" "save" "select" "sequence" "stop" "subroutine" - "target" "then" "type" "use" "where" "while" "write" - ;; F95 keywords. - "elemental" "pure" - ;; F2003 - "abstract" "associate" "asynchronous" "bind" "class" - "deferred" "enum" "enumerator" "extends" "extends_type_of" - "final" "generic" "import" "non_intrinsic" "non_overridable" - "nopass" "pass" "protected" "same_type_as" "value" "volatile" - ;; F2008. - "contiguous" "submodule" "concurrent" "codimension" - "sync all" "sync memory" "critical" "image_index" - ) 'words) + (concat + "\\_<" + (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" + "block" "call" "case" "character" "close" "common" "complex" + "contains" "continue" "cycle" "data" "deallocate" + "dimension" "do" "double" "else" "elseif" "elsewhere" "end" + "enddo" "endfile" "endif" "entry" "equivalence" "exit" + "external" "forall" "format" "function" "goto" "if" + "implicit" "include" "inquire" "integer" "intent" + "interface" "intrinsic" "logical" "module" "namelist" "none" + "nullify" "only" "open" "operator" "optional" "parameter" + "pause" "pointer" "precision" "print" "private" "procedure" + "program" "public" "read" "real" "recursive" "result" "return" + "rewind" "save" "select" "sequence" "stop" "subroutine" + "target" "then" "type" "use" "where" "while" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003 + "abstract" "associate" "asynchronous" "bind" "class" + "deferred" "enum" "enumerator" "extends" "extends_type_of" + "final" "generic" "import" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "same_type_as" "value" "volatile" + ;; F2008. + "contiguous" "submodule" "concurrent" "codimension" + "sync all" "sync memory" "critical" "image_index" + )) + "\\_>") "Regexp used by the function `f90-change-keywords'.") (defconst f90-keywords-level-3-re - (regexp-opt - '("allocatable" "allocate" "assign" "assignment" "backspace" - "close" "deallocate" "dimension" "endfile" "entry" "equivalence" - "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" - ;; FIXME operator and assignment should be F2003 procedures? - "operator" "optional" "parameter" "pause" "pointer" "print" "private" - "public" "read" "recursive" "result" "rewind" "save" "select" - "sequence" "target" "write" - ;; F95 keywords. - "elemental" "pure" - ;; F2003. asynchronous separate. - "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" - "nopass" "pass" "protected" "value" "volatile" - ;; F2008. - ;; "concurrent" is only in the sense of "do [,] concurrent", but given - ;; the [,] it's simpler to just do every instance (cf "do while"). - "contiguous" "concurrent" "codimension" "sync all" "sync memory" - ) 'words) + (concat + "\\_<" + (regexp-opt + '("allocatable" "allocate" "assign" "assignment" "backspace" + "close" "deallocate" "dimension" "endfile" "entry" "equivalence" + "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" + ;; FIXME operator and assignment should be F2003 procedures? + "operator" "optional" "parameter" "pause" "pointer" "print" "private" + "public" "read" "recursive" "result" "rewind" "save" "select" + "sequence" "target" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003. asynchronous separate. + "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "value" "volatile" + ;; F2008. + ;; "concurrent" is only in the sense of "do [,] concurrent", but given + ;; the [,] it's simpler to just do every instance (cf "do while"). + "contiguous" "concurrent" "codimension" "sync all" "sync memory" + )) + "\\_>") "Keyword-regexp for font-lock level >= 3.") (defconst f90-procedures-re - (concat "\\<" + (concat "\\_<" (regexp-opt '("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "all" "allocated" "anint" "any" "asin" "associated" @@ -407,61 +434,67 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "Regexp matching intrinsic operators.") (defconst f90-hpf-keywords-re - (regexp-opt - ;; Intrinsic procedures. - '("all_prefix" "all_scatter" "all_suffix" "any_prefix" - "any_scatter" "any_suffix" "copy_prefix" "copy_scatter" - "copy_suffix" "count_prefix" "count_scatter" "count_suffix" - "grade_down" "grade_up" - "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix" - "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter" - "iany_suffix" "ilen" "iparity" "iparity_prefix" - "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix" - "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter" - "minval_suffix" "number_of_processors" "parity" - "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" - "processors_shape" "product_prefix" "product_scatter" - "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" - ;; Directives. - "align" "distribute" "dynamic" "independent" "inherit" "processors" - "realign" "redistribute" "template" - ;; Keywords. - "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) + (concat + "\\_<" + (regexp-opt + ;; Intrinsic procedures. + '("all_prefix" "all_scatter" "all_suffix" "any_prefix" + "any_scatter" "any_suffix" "copy_prefix" "copy_scatter" + "copy_suffix" "count_prefix" "count_scatter" "count_suffix" + "grade_down" "grade_up" + "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix" + "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter" + "iany_suffix" "ilen" "iparity" "iparity_prefix" + "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix" + "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter" + "minval_suffix" "number_of_processors" "parity" + "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" + "processors_shape" "product_prefix" "product_scatter" + "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" + ;; Directives. + "align" "distribute" "dynamic" "independent" "inherit" "processors" + "realign" "redistribute" "template" + ;; Keywords. + "block" "cyclic" "extrinsic" "new" "onto" "pure" "with")) + "\\_>") "Regexp for all HPF keywords, procedures and directives.") (defconst f90-constants-re - (regexp-opt '( ;; F2003 iso_fortran_env constants. - "iso_fortran_env" - "input_unit" "output_unit" "error_unit" - "iostat_end" "iostat_eor" - "numeric_storage_size" "character_storage_size" - "file_storage_size" - ;; F2003 iso_c_binding constants. - "iso_c_binding" - "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" - "c_size_t" - "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" - "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" - "c_int_least64_t" - "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" - "c_int_fast64_t" - "c_intmax_t" "c_intptr_t" - "c_float" "c_double" "c_long_double" - "c_float_complex" "c_double_complex" "c_long_double_complex" - "c_bool" "c_char" - "c_null_char" "c_alert" "c_backspace" "c_form_feed" - "c_new_line" "c_carriage_return" "c_horizontal_tab" - "c_vertical_tab" - "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" - "ieee_exceptions" - "ieee_arithmetic" - "ieee_features" - ;; F2008 iso_fortran_env constants. - "character_kinds" "int8" "int16" "int32" "int64" - "integer_kinds" "iostat_inquire_internal_unit" - "logical_kinds" "real_kinds" "real32" "real64" "real128" - "lock_type" "atomic_int_kind" "atomic_logical_kind" - ) 'words) + (concat + "\\_<" + (regexp-opt '( ;; F2003 iso_fortran_env constants. + "iso_fortran_env" + "input_unit" "output_unit" "error_unit" + "iostat_end" "iostat_eor" + "numeric_storage_size" "character_storage_size" + "file_storage_size" + ;; F2003 iso_c_binding constants. + "iso_c_binding" + "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" + "c_size_t" + "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" + "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" + "c_int_least64_t" + "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" + "c_int_fast64_t" + "c_intmax_t" "c_intptr_t" + "c_float" "c_double" "c_long_double" + "c_float_complex" "c_double_complex" "c_long_double_complex" + "c_bool" "c_char" + "c_null_char" "c_alert" "c_backspace" "c_form_feed" + "c_new_line" "c_carriage_return" "c_horizontal_tab" + "c_vertical_tab" + "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" + "ieee_exceptions" + "ieee_arithmetic" + "ieee_features" + ;; F2008 iso_fortran_env constants. + "character_kinds" "int8" "int16" "int32" "int64" + "integer_kinds" "iostat_inquire_internal_unit" + "logical_kinds" "real_kinds" "real32" "real64" "real128" + "lock_type" "atomic_int_kind" "atomic_logical_kind" + )) + "\\_>") "Regexp for Fortran intrinsic constants.") ;; cf f90-looking-at-type-like. @@ -470,16 +503,16 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." Set the match data so that subexpression 1,2 are the TYPE, and type-name parts, respectively." (let (found l) - (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)\\>[ \t]*" + (while (and (re-search-forward "\\_<\\(\\(?:end[ \t]*\\)?type\\)\\_>[ \t]*" limit t) (not (setq found (progn (setq l (match-data)) - (unless (looking-at "\\(is\\>\\|(\\)") - (when (if (looking-at "\\(\\sw+\\)") + (unless (looking-at "\\(is\\_>\\|(\\)") + (when (if (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") (goto-char (match-end 0)) (re-search-forward - "[ \t]*::[ \t]*\\(\\sw+\\)" + "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)) ;; 0 is wrong, but we don't use it. (set-match-data @@ -491,33 +524,33 @@ type-name parts, respectively." (defvar f90-font-lock-keywords-1 (list ;; Special highlighting of "module procedure". - '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" + '("\\_<\\(module[ \t]*procedure\\)\\_>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; Highlight definition of derived type. -;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" +;;; '("\\_<\\(\\(?:end[ \t]*\\)?type\\)\\_>\\([^()\n]*::\\)?[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" ;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) '(f90-typedef-matcher (1 font-lock-keyword-face) (2 font-lock-function-name-face)) ;; F2003. Prevent operators being highlighted as functions. - '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ + '("\\_<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t)) ;; Other functions and declarations. Named interfaces = F2003. ;; F2008: end submodule submodule_name. - '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\ + '("\\_<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\ function\\|associate\\|subroutine\\|interface\\)\\|use\\|call\\)\ -\\>[ \t]*\\(\\sw+\\)?" +\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; F2008: submodule (parent_name) submodule_name. - '("\\<\\(submodule\\)\\>[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)?" + '("\\_<\\(submodule\\)\\_>[ \t]*([^)\n]+)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; F2003. - '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ -\\(\\sw+\\)" + '("\\_<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ +\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-keyword-face) (3 font-lock-function-name-face)) - "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\>" + "\\_<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\_>" ;; "abstract interface" is F2003. - '("\\" (0 font-lock-keyword-face t))) + '("\\_" (0 font-lock-keyword-face t))) "This does fairly subdued highlighting of comments and function calls.") ;; NB not explicitly handling this, yet it seems to work. @@ -529,7 +562,7 @@ and variable-name parts, respectively." ;; Matcher functions must return nil only when there are no more ;; matches within the search range. (let (found l) - (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t) + (while (and (re-search-forward "\\_<\\(type\\|class\\)[ \t]*(" limit t) (not (setq found (condition-case nil @@ -544,7 +577,7 @@ and variable-name parts, respectively." (when (re-search-forward ;; type (foo) bar, qux - (if (looking-at "\\sw+") + (if (looking-at "\\(?:\\sw\\|\\s_\\)+") "\\([^&!\n]+\\)" ;; type (foo), stuff :: bar, qux "::[ \t]*\\([^&!\n]+\\)") @@ -587,53 +620,53 @@ enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ ;; integer( kind=1 ) function foo() ;; thanks to the happy accident described above. ;; Not anchored, so don't need to worry about "pure" etc. - '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ + '("\\_<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ logical\\|double[ \t]*precision\\|\ -\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\ -\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)" +\\(?:type\\|class\\)[ \t]*([ \t]*\\(?:\\sw\\|\\s_\\)+[ \t]*)\\)[ \t]*\\)\ +\\(function\\)\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(([^&!\n]*)\\)" (1 font-lock-type-face t) (4 font-lock-keyword-face t) (5 font-lock-function-name-face t) (6 'default t)) ;; enum (F2003; must be followed by ", bind(C)"). - '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) + '("\\_<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) ;; end do, enum (F2003), if, select, where, and forall constructs. ;; block, critical (F2008). ;; Note that "block data" may get somewhat mixed up with F2008 blocks, ;; but since the former is obsolete I'm not going to worry about it. - '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\ -block\\|critical\\)\\)\\>\ -\\([ \t]+\\(\\sw+\\)\\)?" + '("\\_<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\ +block\\|critical\\)\\)\\_>\ +\\([ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) - '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ + '("^[ \t0-9]*\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ -forall\\|block\\|critical\\)\\)\\>" +forall\\|block\\|critical\\)\\)\\_>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. - '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ + '("\\_<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ \\|enumerator\\|procedure\\|\ -logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" +logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t]*" (1 font-lock-keyword-face) (2 font-lock-type-face)) - '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" + '("\\_<\\(namelist\\|common\\)[ \t]*\/\\(\\(?:\\sw\\|\\s_\\)+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - "\\" + "\\_" '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) - "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" - '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" + "\\_<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\_>" + '("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) + '("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) ;; F2003 "class default". - '("\\<\\(class\\)[ \t]*default" . 1) + '("\\_<\\(class\\)[ \t]*default" . 1) ;; F2003 "type is" in a "select type" block. - '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) - '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)" + '("\\_<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) + '("\\_<\\(do\\|go[ \t]*to\\)\\_>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ;; Line numbers (lines whose first character after number is letter). '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)) ;; Override eg for "#include". - '("^#[ \t]*\\w+" (0 font-lock-preprocessor-face t) - ("\\" nil nil (0 font-lock-preprocessor-face))) + '("^#[ \t]*\\(?:\\sw\\|\\s_\\)+" (0 font-lock-preprocessor-face t) + ("\\_" nil nil (0 font-lock-preprocessor-face))) '("^#" ("\\(&&\\|||\\)" nil nil (0 font-lock-constant-face t))) - '("^#[ \t]*define[ \t]+\\(\\w+\\)(" (1 font-lock-function-name-face)) - '("^#[ \t]*define[ \t]+\\(\\w+\\)" (1 font-lock-variable-name-face)) + '("^#[ \t]*define[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)(" (1 font-lock-function-name-face)) + '("^#[ \t]*define[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face)) '("^#[ \t]*include[ \t]+\\(<.+>\\)" (1 font-lock-string-face)))) "Highlights declarations, do-loops and other constructs.") @@ -645,9 +678,9 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" ;; FIXME why isn't this font-lock-builtin-face, which ;; otherwise we hardly use, as in fortran.el? (list f90-procedures-re '(1 font-lock-keyword-face keep)) - "\\" ; avoid overwriting real defs + "\\_" ; avoid overwriting real defs ;; As an attribute, but not as an optional argument. - '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1))) + '("\\_<\\(asynchronous\\)[ \t]*[^=]" . 1))) "Highlights all F90 keywords and intrinsic procedures.") (defvar f90-font-lock-keywords-4 @@ -666,8 +699,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (let ((table (make-syntax-table))) (modify-syntax-entry ?\! "<" table) ; begin comment (modify-syntax-entry ?\n ">" table) ; end comment - ;; FIXME: This goes against the convention: it should be "_". - (modify-syntax-entry ?_ "w" table) ; underscore in names + (modify-syntax-entry ?_ "_" table) ; underscore in names (modify-syntax-entry ?\' "\"" table) ; string quote (modify-syntax-entry ?\" "\"" table) ; string quote ;; FIXME: We used to set ` to word syntax for the benefit of abbrevs, but @@ -822,14 +854,14 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ;; Regexps for finding program structures. (defconst f90-blocks-re - (concat "\\(block[ \t]*data\\|" + (concat "\\(\\(?:block[ \t]*data\\|" (regexp-opt '("do" "if" "interface" "function" "module" "program" "select" "subroutine" "type" "where" "forall" ;; F2003. "enum" "associate" ;; F2008. "submodule" "block" "critical")) - "\\)\\>") + "\\)\\_>\\)") "Regexp potentially indicating a \"block\" of F90 code.") (defconst f90-program-block-re @@ -845,15 +877,15 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (defconst f90-end-if-re (concat "end[ \t]*" (regexp-opt '("if" "select" "where" "forall") 'paren) - "\\>") + "\\_>") "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.") (defconst f90-end-type-re - "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>" + "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\_>" "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.") (defconst f90-end-associate-re - "end[ \t]*associate\\>" + "end[ \t]*associate\\_>" "Regexp matching the end of an ASSOCIATE block.") ;; This is for a TYPE block, not a variable of derived TYPE. @@ -864,12 +896,12 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ;; type, stuff :: word ;; type, bind(c) :: word ;; NOT "type (" - "\\<\\(type\\)\\>\\(?:\\(?:[^()\n]*\\|\ -.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\sw+\\)" + "\\_<\\(type\\)\\_>\\(?:\\(?:[^()\n]*\\|\ +.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" "Regexp matching the definition of a derived type.") (defconst f90-typeis-re - "\\<\\(class\\|type\\)[ \t]*is[ \t]*(" + "\\_<\\(class\\|type\\)[ \t]*is[ \t]*(" "Regexp matching a CLASS/TYPE IS statement.") (defconst f90-no-break-re @@ -888,12 +920,12 @@ allowed. This minor issue currently only affects \"(/\" and \"/)\".") ;; Hideshow support. (defconst f90-end-block-re - (concat "^[ \t0-9]*\\") + "\\_>") "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") @@ -903,11 +935,11 @@ Used in the F90 entry in `hs-special-modes-alist'.") (concat "^[ \t0-9]*" ; statement number "\\(\\(" - "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label + "\\(\\(?:\\sw\\|\\s_\\)+[ \t]*:[ \t]*\\)?" ; structure label "\\(do\\|select[ \t]*\\(case\\|type\\)\\|" ;; See comments in fortran-start-block-re for the problems of IF. "if[ \t]*(\\(.*\\|" - ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\\\)\\)\\)\\_\\|(\\)") - (or (looking-at "\\(\\sw+\\)") + (unless (looking-at "\\(is\\_>\\|(\\)") + (or (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") (re-search-forward - "[ \t]*::[ \t]*\\(\\sw+\\)" + "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)))))))) found)) @@ -957,36 +989,35 @@ Set subexpression 1 in the match-data to the name of the type." (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]") ;; (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]") ) - (list - '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1) - '("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\ -\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - (list "Types" 'f90-imenu-type-matcher 1) - ;; Does not handle: "type[, stuff] :: foo". -;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)" -;;; not-ib not-s) -;;; 1) - ;; Can't get the subexpression numbers to match in the two branches. -;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s) -;;; 3) - (list - "Procedures" - (concat - "^[ \t0-9]*" - "\\(" - ;; At least three non-space characters before function/subroutine. - ;; Check that the last three non-space characters do not spell E N D. - "[^!\"\&\n]*\\(" - not-e good-char good-char "\\|" - good-char not-n good-char "\\|" - good-char good-char not-d "\\)" - "\\|" - ;; Less than three non-space characters before function/subroutine. - good-char "?" good-char "?" - "\\)" - "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") - 4))) + `((nil "^[ \t0-9]*program[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)" 1) + ("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\ +\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(!\\|$\\)" 1) + ("Modules" "^[ \t0-9]*module[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(!\\|$\\)" 1) + ("Types" f90-imenu-type-matcher 1) + ;; Does not handle: "type[, stuff] :: foo". + ;;(format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\(?:\\sw\\|\\s_\\)\\)\\(?:\\sw\\|\\s_\\)*\\)" + ;; not-ib not-s) + ;;1) + ;; Can't get the subexpression numbers to match in the two branches. + ;; FIXME: Now with \(?N:..\) we can get the numbers to match! + ;;(format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\(?:\\sw\\|\\s_\\)\\)\\(?:\\sw\\|\\s_\\)*\\)\\)" not-ib not-s) + ;;3) + ("Procedures" + ,(concat + "^[ \t0-9]*" + "\\(" + ;; At least three non-space characters before function/subroutine. + ;; Check that the last three non-space characters do not spell E N D. + "[^!\"\&\n]*\\(" + not-e good-char good-char "\\|" + good-char not-n good-char "\\|" + good-char good-char not-d "\\)" + "\\|" + ;; Less than three non-space characters before function/subroutine. + good-char "?" good-char "?" + "\\)" + "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)") + 4))) "Value for `imenu-generic-expression' in F90 mode.") (defun f90-add-imenu-menu () @@ -995,7 +1026,7 @@ Set subexpression 1 in the match-data to the name of the type." (if (lookup-key (current-local-map) [menu-bar index]) (message "%s" "F90-imenu already exists.") (imenu-add-to-menubar "F90-imenu") - (redraw-frame (selected-frame)))) + (redraw-frame))) ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t. @@ -1119,11 +1150,11 @@ Variables controlling indentation style and extra features: Automatic insertion of \& at beginning of continuation lines (default t). `f90-smart-end' From an END statement, check and fill the end using matching block start. - Allowed values are 'blink, 'no-blink, and nil, which determine - whether to blink the matching beginning (default 'blink). + Allowed values are `blink', `no-blink', and nil, which determine + whether to blink the matching beginning (default `blink'). `f90-auto-keyword-case' Automatic change of case of keywords (default nil). - The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. + The possibilities are `downcase-word', `upcase-word', `capitalize-word'. `f90-leave-line-no' Do not left-justify line numbers (default nil). @@ -1235,13 +1266,13 @@ whitespace, if any." (defsubst f90-looking-at-do () "Return (\"do\" NAME) if a do statement starts after point. NAME is nil if the statement has no label." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\_>") (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-select-case () "Return (\"select\" NAME) if a select statement starts after point. NAME is nil if the statement has no label." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\ \\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(") (list (match-string 3) (match-string 2)))) @@ -1249,50 +1280,50 @@ NAME is nil if the statement has no label." "Return (\"if\" NAME) if an if () then statement starts after point. NAME is nil if the statement has no label." (save-excursion - (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") + (when (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2)) (pos (scan-lists (point) 1 0))) (and pos (goto-char pos)) (skip-chars-forward " \t") - (if (or (looking-at "then\\>") + (if (or (looking-at "then\\_>") (when (f90-line-continued) (f90-next-statement) (skip-chars-forward " \t0-9&") - (looking-at "then\\>"))) + (looking-at "then\\_>"))) (list struct label)))))) ;; FIXME label? (defsubst f90-looking-at-associate () "Return (\"associate\") if an associate block starts after point." - (if (looking-at "\\<\\(associate\\)[ \t]*(") + (if (looking-at "\\_<\\(associate\\)[ \t]*(") (list (match-string 1)))) (defsubst f90-looking-at-critical () "Return (KIND NAME) if a critical or block block starts after point." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\>") + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2))) (if (or (not (string-equal "block" struct)) (save-excursion (skip-chars-forward " \t") - (not (looking-at "data\\>")))) + (not (looking-at "data\\_>")))) (list struct label))))) (defsubst f90-looking-at-end-critical () "Return non-nil if a critical or block block ends after point." - (if (looking-at "end[ \t]*\\(critical\\|block\\)\\>") + (if (looking-at "end[ \t]*\\(critical\\|block\\)\\_>") (or (not (string-equal "block" (match-string 1))) (save-excursion (skip-chars-forward " \t") - (not (looking-at "data\\>")))))) + (not (looking-at "data\\_>")))))) (defsubst f90-looking-at-where-or-forall () "Return (KIND NAME) if a where or forall block starts after point. NAME is nil if the statement has no label." (save-excursion - (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ -\\(where\\|forall\\)\\>") + (when (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\ +\\(where\\|forall\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2)) (pos (scan-lists (point) 1 0))) @@ -1305,43 +1336,43 @@ NAME is nil if the statement has no label." NAME is non-nil only for type and certain interfaces." (cond ((save-excursion - (and (looking-at "\\[ \t]*") + (and (looking-at "\\_[ \t]*") (goto-char (match-end 0)) - (not (looking-at "\\(is\\>\\|(\\)")) - (or (looking-at "\\(\\sw+\\)") - (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)" + (not (looking-at "\\(is\\_>\\|(\\)")) + (or (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") + (re-search-forward "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)))) (list "type" (match-string 1))) ;;; ((and (not (looking-at f90-typeis-re)) ;;; (looking-at f90-type-def-re)) ;;; (list (match-string 1) (match-string 2))) - ((looking-at "\\<\\(interface\\)\\>[ \t]*") + ((looking-at "\\_<\\(interface\\)\\_>[ \t]*") (list (match-string 1) (save-excursion (goto-char (match-end 0)) (if (or (looking-at "\\(operator\\|assignment\\|read\\|\ write\\)[ \t]*([^)\n]*)") - (looking-at "\\sw+")) + (looking-at "\\(?:\\sw\\|\\s_\\)+")) (match-string 0))))) - ((looking-at "\\(enum\\|block[ \t]*data\\)\\>") + ((looking-at "\\(enum\\|block[ \t]*data\\)\\_>") (list (match-string 1) nil)) - ((looking-at "abstract[ \t]*\\(interface\\)\\>") + ((looking-at "abstract[ \t]*\\(interface\\)\\_>") (list (match-string 1) nil)))) (defsubst f90-looking-at-program-block-start () "Return (KIND NAME) if a program block with name NAME starts after point." ;;;NAME is nil for an un-named main PROGRAM block." (cond - ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") + ((looking-at "\\(program\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>") (list (match-string 1) (match-string 2))) - ((and (not (looking-at "module[ \t]*procedure\\>")) - (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) + ((and (not (looking-at "module[ \t]*procedure\\_>")) + (looking-at "\\(module\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>")) (list (match-string 1) (match-string 2))) - ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)\\>") + ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>") (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ -\\(\\sw+\\)")) +\\(\\(?:\\sw\\|\\s_\\)+\\)")) (list (match-string 1) (match-string 2))))) ;; Following will match an un-named main program block; however ;; one needs to check if there is an actual PROGRAM statement after @@ -1357,7 +1388,7 @@ write\\)[ \t]*([^)\n]*)") \\(?:assignment\\|operator\\|read\\|write\\)[ \t]*([^)\n]*)\\)") (list (match-string 1) (match-string 2))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) + "?\\([ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?\\_>")) (list (match-string 1) (match-string 3))))) (defsubst f90-comment-indent () @@ -1414,10 +1445,10 @@ if all else fails." (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ \\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\ -block\\|critical\\)\\>") +block\\|critical\\)\\_>") (looking-at "\\(program\\|\\(?:sub\\)?module\\|\ -\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>") - (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") +\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>") + (looking-at "\\(contains\\|\\(?:\\sw\\|\\s_\\)+[ \t]*:\\)") (looking-at f90-type-def-re) (re-search-forward "\\(function\\|subroutine\\)" (line-end-position) t))))) @@ -1483,7 +1514,7 @@ Does not check type and subprogram indentation." (setq icol (- icol f90-associate-indent))) ((f90-looking-at-end-critical) (setq icol (- icol f90-critical-indent))) - ((looking-at "end[ \t]*do\\>") + ((looking-at "end[ \t]*do\\_>") (setq icol (- icol f90-do-indent)))) (end-of-line)) icol))) @@ -1550,7 +1581,7 @@ Does not check type and subprogram indentation." (cond ((or (looking-at f90-else-like-re) (looking-at f90-end-if-re)) (setq icol (- icol f90-if-indent))) - ((looking-at "end[ \t]*do\\>") + ((looking-at "end[ \t]*do\\_>") (setq icol (- icol f90-do-indent))) ((looking-at f90-end-type-re) (setq icol (- icol f90-type-indent))) @@ -1671,7 +1702,7 @@ Interactively, pushes mark before moving point." (setq start-list (cons start-this start-list) ; not add-to-list! count (1+ count))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "[ \t]*\\(\\sw+\\)?")) + "[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")) (setq end-type (match-string 1) end-label (match-string 2) count (1- count)) @@ -1716,7 +1747,7 @@ Interactively, pushes mark before moving point." (skip-chars-forward " \t0-9") (cond ((or (f90-in-string) (f90-in-comment))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "[ \t]*\\(\\sw+\\)?")) + "[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")) (setq end-list (cons (list (match-string 1) (match-string 2)) end-list) count (1+ count))) @@ -1962,7 +1993,7 @@ If run in the middle of a line, the line is not broken." (car end-struct) (cadr end-struct)))) (setq ind-b (cond ((looking-at f90-end-if-re) f90-if-indent) - ((looking-at "end[ \t]*do\\>") f90-do-indent) + ((looking-at "end[ \t]*do\\_>") f90-do-indent) ((looking-at f90-end-type-re) f90-type-indent) ((looking-at f90-end-associate-re) f90-associate-indent) @@ -2108,12 +2139,19 @@ Like `join-line', but handles F90 syntax." (zmacs-deactivate-region) (deactivate-mark)))) +(defconst f90-end-block-optional-name + '("program" "module" "subroutine" "function" "type") + "Block types where including the name in the end statement is optional.") + (defun f90-block-match (beg-block beg-name end-block end-name) "Match end-struct with beg-struct and complete end-block if possible. BEG-BLOCK is the type of block as indicated at the start (e.g., do). BEG-NAME is the block start name (may be nil). END-BLOCK is the type of block as indicated at the end (may be nil). END-NAME is the block end name (may be nil). +If the block type matches `f90-end-block-optional-name', do not add +an end name if `f90-smart-end-names' is nil, but always update an +incorrect end name if there already was one. Leave point at the end of line." ;; Hack to deal with the case when this is called from ;; f90-indent-region on a program block without an explicit PROGRAM @@ -2133,8 +2171,11 @@ Leave point at the end of line." (if (f90-equal-symbols beg-name end-name) (and end-name (search-forward end-name)) (cond ((and beg-name (not end-name)) - (message "Inserting %s." beg-name) - (insert (concat " " beg-name))) + (unless (and (not f90-smart-end-names) + (member-ignore-case beg-block + f90-end-block-optional-name)) + (message "Inserting %s." beg-name) + (insert (concat " " beg-name)))) ((and beg-name end-name) (message "Replacing %s with %s." end-name beg-name) (search-forward end-name) @@ -2218,7 +2259,7 @@ Any other key combination is executed normally." (interactive "*") (self-insert-command 1) (when abbrev-mode - (set-temporary-overlay-map + (set-transient-map (let ((map (make-sparse-keymap))) (define-key map [??] 'f90-abbrev-help) (define-key map (vector help-char) 'f90-abbrev-help) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0f92df95a9d..10aed7db3c9 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1,9 +1,9 @@ -;;; flymake.el -- a universal on-the-fly syntax checker +;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*- -;; Copyright (C) 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2003-2014 Free Software Foundation, Inc. ;; Author: Pavel Kobyakov -;; Maintainer: Pavel Kobyakov +;; Maintainer: Leo Liu ;; Version: 0.3 ;; Keywords: c languages tools @@ -24,9 +24,9 @@ ;;; Commentary: ;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax -;; checks using the external syntax check tool (for C/C++ this -;; is usually the compiler) +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks +;; using the external syntax check tool (for C/C++ this is usually the +;; compiler). ;;; Bugs/todo: @@ -36,180 +36,77 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(if (featurep 'xemacs) (require 'overlay)) -(defvar flymake-is-running nil - "If t, flymake syntax check process is running for the current buffer.") -(make-variable-buffer-local 'flymake-is-running) +(defgroup flymake nil + "Universal on-the-fly syntax checker." + :version "23.1" + :link '(custom-manual "(flymake) Top") + :group 'tools) -(defvar flymake-timer nil - "Timer for starting syntax check.") -(make-variable-buffer-local 'flymake-timer) +(defcustom flymake-error-bitmap '(exclamation-mark error) + "Bitmap (a symbol) used in the fringe for indicating errors. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. -(defvar flymake-last-change-time nil - "Time of last buffer change.") -(make-variable-buffer-local 'flymake-last-change-time) +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) -(defvar flymake-check-start-time nil - "Time at which syntax check was started.") -(make-variable-buffer-local 'flymake-check-start-time) +(defcustom flymake-warning-bitmap 'question-mark + "Bitmap (a symbol) used in the fringe for indicating warnings. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. -(defvar flymake-check-was-interrupted nil - "Non-nil if syntax check was killed by `flymake-compile'.") -(make-variable-buffer-local 'flymake-check-was-interrupted) +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) -(defvar flymake-err-info nil - "Sorted list of line numbers and lists of err info in the form (file, err-text).") -(make-variable-buffer-local 'flymake-err-info) +(defcustom flymake-fringe-indicator-position 'left-fringe + "The position to put flymake fringe indicator. +The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. +See `flymake-error-bitmap' and `flymake-warning-bitmap'." + :group 'flymake + :version "24.3" + :type '(choice (const left-fringe) + (const right-fringe) + (const :tag "No fringe indicators" nil))) -(defvar flymake-new-err-info nil - "Same as `flymake-err-info', effective when a syntax check is in progress.") -(make-variable-buffer-local 'flymake-new-err-info) +(defcustom flymake-compilation-prevents-syntax-check t + "If non-nil, don't start syntax check if compilation is running." + :group 'flymake + :type 'boolean) -;;;; [[ cross-emacs compatibility routines -(defsubst flymake-makehash (&optional test) - (if (fboundp 'make-hash-table) - (if test (make-hash-table :test test) (make-hash-table)) - (with-no-warnings - (makehash test)))) +(defcustom flymake-start-syntax-check-on-newline t + "Start syntax check if newline char was added/removed from the buffer." + :group 'flymake + :type 'boolean) -(defalias 'flymake-float-time - (if (fboundp 'float-time) - 'float-time - (if (featurep 'xemacs) - (lambda () - (multiple-value-bind (s0 s1 s2) (values-list (current-time)) - (+ (* (float (ash 1 16)) s0) (float s1) (* 0.0000001 s2))))))) +(defcustom flymake-no-changes-timeout 0.5 + "Time to wait after last change before starting compilation." + :group 'flymake + :type 'number) -(defalias 'flymake-replace-regexp-in-string - (if (eval-when-compile (fboundp 'replace-regexp-in-string)) - 'replace-regexp-in-string - (lambda (regexp rep str) - (replace-in-string str regexp rep)))) +(defcustom flymake-gui-warnings-enabled t + "Enables/disables GUI warnings." + :group 'flymake + :type 'boolean) -(defalias 'flymake-split-string - (if (condition-case nil (equal (split-string " bc " " " t) '("bc")) - (error nil)) - (lambda (str pattern) (split-string str pattern t)) - (lambda (str pattern) - "Split STR into a list of substrings bounded by PATTERN. -Zero-length substrings at the beginning and end of the list are omitted." - (let ((split (split-string str pattern))) - (while (equal (car split) "") (setq split (cdr split))) - (setq split (nreverse split)) - (while (equal (car split) "") (setq split (cdr split))) - (nreverse split))))) - -(defalias 'flymake-get-temp-dir - (if (fboundp 'temp-directory) - 'temp-directory - (lambda () temporary-file-directory))) - -(defun flymake-posn-at-point-as-event (&optional position window dx dy) - "Return pixel position of top left corner of glyph at POSITION, -relative to top left corner of WINDOW, as a mouse-1 click -event (identical to the event that would be triggered by clicking -mouse button 1 at the top left corner of the glyph). - -POSITION and WINDOW default to the position of point in the -selected window. - -DX and DY specify optional offsets from the top left of the glyph." - (unless window (setq window (selected-window))) - (unless position (setq position (window-point window))) - (unless dx (setq dx 0)) - (unless dy (setq dy 0)) - - (let* ((pos (posn-at-point position window)) - (x-y (posn-x-y pos)) - (edges (window-inside-pixel-edges window)) - (win-x-y (window-pixel-edges window))) - ;; adjust for window edges - (setcar (nthcdr 2 pos) - (cons (+ (car x-y) (car edges) (- (car win-x-y)) dx) - (+ (cdr x-y) (cadr edges) (- (cadr win-x-y)) dy))) - (list 'mouse-1 pos))) - -(defun flymake-popup-menu (menu-data) - "Pop up the flymake menu at point, using the data MENU-DATA. -POS is a list of the form ((X Y) WINDOW), where X and Y are -pixels positions from the top left corner of WINDOW's frame. -MENU-DATA is a list of error and warning messages returned by -`flymake-make-err-menu-data'." - (if (featurep 'xemacs) - (let* ((pos (flymake-get-point-pixel-pos)) - (x-pos (nth 0 pos)) - (y-pos (nth 1 pos)) - (fake-event-props '(button 1 x 1 y 1))) - (setq fake-event-props (plist-put fake-event-props 'x x-pos)) - (setq fake-event-props (plist-put fake-event-props 'y y-pos)) - (popup-menu (flymake-make-xemacs-menu menu-data) - (make-event 'button-press fake-event-props))) - (x-popup-menu (if (eval-when-compile (fboundp 'posn-at-point)) - (flymake-posn-at-point-as-event) - (list (flymake-get-point-pixel-pos) (selected-window))) - (flymake-make-emacs-menu menu-data)))) - -(defun flymake-make-emacs-menu (menu-data) - "Return a menu specifier using MENU-DATA. -MENU-DATA is a list of error and warning messages returned by -`flymake-make-err-menu-data'. -See `x-popup-menu' for the menu specifier format." - (let* ((menu-title (nth 0 menu-data)) - (menu-items (nth 1 menu-data)) - (menu-commands (mapcar (lambda (foo) - (cons (nth 0 foo) (nth 1 foo))) - menu-items))) - (list menu-title (cons "" menu-commands)))) - -(if (featurep 'xemacs) (progn - -(defun flymake-nop ()) - -(defun flymake-make-xemacs-menu (menu-data) - "Return a menu specifier using MENU-DATA." - (let* ((menu-title (nth 0 menu-data)) - (menu-items (nth 1 menu-data)) - (menu-commands nil)) - (setq menu-commands (mapcar (lambda (foo) - (vector (nth 0 foo) (or (nth 1 foo) '(flymake-nop)) t)) - menu-items)) - (cons menu-title menu-commands))) - -)) ;; xemacs - -(unless (eval-when-compile (fboundp 'posn-at-point)) - -(defun flymake-current-row () - "Return current row number in current frame." - (if (fboundp 'window-edges) - (+ (car (cdr (window-edges))) (count-lines (window-start) (point))) - (count-lines (window-start) (point)))) - -(defun flymake-selected-frame () - (if (fboundp 'window-edges) - (selected-frame) - (selected-window))) - -(defun flymake-get-point-pixel-pos () - "Return point position in pixels: (x, y)." - (let ((mouse-pos (mouse-position)) - (pixel-pos nil) - (ret nil)) - (if (car (cdr mouse-pos)) - (progn - (set-mouse-position (flymake-selected-frame) (current-column) (flymake-current-row)) - (setq pixel-pos (mouse-pixel-position)) - (set-mouse-position (car mouse-pos) (car (cdr mouse-pos)) (cdr (cdr mouse-pos))) - (setq ret (list (car (cdr pixel-pos)) (cdr (cdr pixel-pos))))) - (progn - (setq ret '(0 0)))) - (flymake-log 3 "mouse pos is %s" ret) - ret)) - -) ;; End of (unless (fboundp 'posn-at-point) - -;;;; ]] +(defcustom flymake-start-syntax-check-on-find-file t + "Start syntax check on find file." + :group 'flymake + :type 'boolean) (defcustom flymake-log-level -1 "Logging level, only messages with level lower or equal will be logged. @@ -217,45 +114,22 @@ See `x-popup-menu' for the menu specifier format." :group 'flymake :type 'integer) -(defun flymake-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `flymake-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see `format')." - (if (<= level flymake-log-level) - (let* ((msg (apply 'format text args))) - (message "%s" msg) - ;;(with-temp-buffer - ;; (insert msg) - ;; (insert "\n") - ;; (flymake-save-buffer-in-file "d:/flymake.log" t) ; make log file name customizable - ;;) - ))) +(defcustom flymake-xml-program + (if (executable-find "xmlstarlet") "xmlstarlet" "xml") + "Program to use for XML validation." + :type 'file + :group 'flymake + :version "24.4") -(defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS." - (let ((tmp (copy-sequence list))) ; (???) - (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) - tmp)) +(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") + "Dirs where to look for master files." + :group 'flymake + :type '(repeat (string))) -(defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST." - (let ((tmp (copy-sequence list))) ; (???) - (setcar (nthcdr pos tmp) val) - tmp)) - -(defvar flymake-processes nil - "List of currently active flymake processes.") - -(defvar flymake-output-residual nil) - -(make-variable-buffer-local 'flymake-output-residual) - -(defgroup flymake nil - "Universal on-the-fly syntax checker." - :version "23.1" - :group 'tools) +(defcustom flymake-master-file-count-limit 32 + "Max number of master files to check." + :group 'flymake + :type 'integer) (defcustom flymake-allowed-file-name-masks '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) @@ -279,16 +153,81 @@ are the string substitutions (see `format')." ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) ;; ("\\.tex\\'" 1) ) - "Files syntax checking is allowed for." + "Files syntax checking is allowed for. +This is an alist with elements of the form: + REGEXP INIT [CLEANUP [NAME]] +REGEXP is a regular expression that matches a file name. +INIT is the init function to use. +CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. +NAME is the file name function to use, default `flymake-get-real-file-name'." :group 'flymake - :type '(repeat (string symbol symbol symbol))) + :type '(alist :key-type (regexp :tag "File regexp") + :value-type + (list :tag "Handler functions" + (function :tag "Init function") + (choice :tag "Cleanup function" + (const :tag "flymake-simple-cleanup" nil) + function) + (choice :tag "Name function" + (const :tag "flymake-get-real-file-name" nil) + function)))) + +(defvar-local flymake-is-running nil + "If t, flymake syntax check process is running for the current buffer.") + +(defvar-local flymake-timer nil + "Timer for starting syntax check.") + +(defvar-local flymake-last-change-time nil + "Time of last buffer change.") + +(defvar-local flymake-check-start-time nil + "Time at which syntax check was started.") + +(defvar-local flymake-check-was-interrupted nil + "Non-nil if syntax check was killed by `flymake-compile'.") + +(defvar-local flymake-err-info nil + "Sorted list of line numbers and lists of err info in the form (file, err-text).") + +(defvar-local flymake-new-err-info nil + "Same as `flymake-err-info', effective when a syntax check is in progress.") + +(defun flymake-log (level text &rest args) + "Log a message at level LEVEL. +If LEVEL is higher than `flymake-log-level', the message is +ignored. Otherwise, it is printed using `message'. +TEXT is a format control string, and the remaining arguments ARGS +are the string substitutions (see the function `format')." + (if (<= level flymake-log-level) + (let* ((msg (apply 'format text args))) + (message "%s" msg)))) + +(defun flymake-ins-after (list pos val) + "Insert VAL into LIST after position POS. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) + tmp)) + +(defun flymake-set-at (list pos val) + "Set VAL at position POS in LIST. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcar (nthcdr pos tmp) val) + tmp)) + +(defvar flymake-processes nil + "List of currently active flymake processes.") + +(defvar-local flymake-output-residual nil) (defun flymake-get-file-name-mode-and-masks (file-name) "Return the corresponding entry from `flymake-allowed-file-name-masks'." (unless (stringp file-name) (error "Invalid file-name")) (let ((fnm flymake-allowed-file-name-masks) - (mode-and-masks nil)) + (mode-and-masks nil)) (while (and (not mode-and-masks) fnm) (if (string-match (car (car fnm)) file-name) (setq mode-and-masks (cdr (car fnm)))) @@ -317,15 +256,19 @@ Return nil if we cannot, non-nil if we can." (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) 'flymake-get-real-file-name)) -(defvar flymake-find-buildfile-cache (flymake-makehash 'equal)) +(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) (defun flymake-get-buildfile-from-cache (dir-name) + "Look up DIR-NAME in cache and return its associated value. +If DIR-NAME is not found, return nil." (gethash dir-name flymake-find-buildfile-cache)) (defun flymake-add-buildfile-to-cache (dir-name buildfile) + "Associate DIR-NAME with BUILDFILE in the buildfile cache." (puthash dir-name buildfile flymake-find-buildfile-cache)) (defun flymake-clear-buildfile-cache () + "Clear the buildfile cache." (clrhash flymake-find-buildfile-cache)) (defun flymake-find-buildfile (buildfile-name source-dir-name) @@ -357,24 +300,16 @@ Return t if so, nil if not." (equal (flymake-fix-file-name file-name-one) (flymake-fix-file-name file-name-two))) -(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") - "Dirs where to look for master files." - :group 'flymake - :type '(repeat (string))) - -(defcustom flymake-master-file-count-limit 32 - "Max number of master files to check." - :group 'flymake - :type 'integer) - ;; This is bound dynamically to pass a parameter to a sort predicate below (defvar flymake-included-file-name) (defun flymake-find-possible-master-files (file-name master-file-dirs masks) "Find (by name and location) all possible master files. -Master files include .cpp and .c for .h. Files are searched for -starting from the .h directory and max max-level parent dirs. -File contents are not checked." + +Name is specified by FILE-NAME and location is specified by +MASTER-FILE-DIRS. Master files include .cpp and .c for .h. +Files are searched for starting from the .h directory and max +max-level parent dirs. File contents are not checked." (let* ((dirs master-file-dirs) (files nil) (done nil)) @@ -411,12 +346,9 @@ to the beginning of the list (File.h -> File.cpp moved to top)." (file-name-base file-one)) (not (equal file-one file-two)))) -(defcustom flymake-check-file-limit 8192 +(defvar flymake-check-file-limit 8192 "Maximum number of chars to look at when checking possible master file. -Nil means search the entire file." - :group 'flymake - :type '(choice (const :tag "No limit" nil) - (integer :tag "Characters"))) +Nil means search the entire file.") (defun flymake-check-patch-master-file-buffer (master-file-temp-buffer @@ -492,6 +424,7 @@ instead of reading master file from disk." (flymake-log 2 "found master file %s" master-file-name)) found)) +;;; XXX: remove (defun flymake-replace-region (beg end rep) "Replace text in BUFFER in region (BEG END) with REP." (save-excursion @@ -571,20 +504,12 @@ Find master file, patch and save it." nil)))) (defun flymake-save-buffer-in-file (file-name) + "Save the entire buffer contents into file FILE-NAME. +Create parent directories as needed." (make-directory (file-name-directory file-name) 1) (write-region nil nil file-name nil 566) (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) -(defun flymake-save-string-to-file (file-name data) - "Save string DATA to file FILE-NAME." - (write-region data nil file-name nil 566)) - -(defun flymake-read-file-to-string (file-name) - "Read contents of file FILE-NAME and return as a string." - (with-temp-buffer - (insert-file-contents file-name) - (buffer-substring (point-min) (point-max)))) - (defun flymake-process-filter (process output) "Parse OUTPUT and highlight error lines. It's flymake process filter." @@ -630,29 +555,31 @@ It's flymake process filter." (setq flymake-is-running nil)))))))) (defun flymake-post-syntax-check (exit-status command) - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (flymake-count-lines))) - (flymake-delete-own-overlays) - (flymake-highlight-err-lines flymake-err-info) - (let (err-count warn-count) - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name) err-count warn-count - (- (flymake-float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil) + (save-restriction + (widen) + (setq flymake-err-info flymake-new-err-info) + (setq flymake-new-err-info nil) + (setq flymake-err-info + (flymake-fix-line-numbers + flymake-err-info 1 (count-lines (point-min) (point-max)))) + (flymake-delete-own-overlays) + (flymake-highlight-err-lines flymake-err-info) + (let (err-count warn-count) + (setq err-count (flymake-get-err-count flymake-err-info "e")) + (setq warn-count (flymake-get-err-count flymake-err-info "w")) + (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" + (buffer-name) err-count warn-count + (- (float-time) flymake-check-start-time)) + (setq flymake-check-start-time nil) - (if (and (equal 0 err-count) (equal 0 warn-count)) - (if (equal 0 exit-status) - (flymake-report-status "" "") ; PASSED - (if (not flymake-check-was-interrupted) - (flymake-report-fatal-status "CFGERR" - (format "Configuration error has occurred while running %s" command)) - (flymake-report-status nil ""))) ; "STOPPED" - (flymake-report-status (format "%d/%d" err-count warn-count) "")))) + (if (and (equal 0 err-count) (equal 0 warn-count)) + (if (equal 0 exit-status) + (flymake-report-status "" "") ; PASSED + (if (not flymake-check-was-interrupted) + (flymake-report-fatal-status "CFGERR" + (format "Configuration error has occurred while running %s" command)) + (flymake-report-status nil ""))) ; "STOPPED" + (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) (defun flymake-parse-output-and-residual (output) "Split OUTPUT into lines, merge in residual if necessary." @@ -763,50 +690,10 @@ line number outside the file being compiled." "Determine whether overlay OV was created by flymake." (and (overlayp ov) (overlay-get ov 'flymake-overlay))) -(defcustom flymake-error-bitmap '(exclamation-mark error) - "Bitmap (a symbol) used in the fringe for indicating errors. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-warning-bitmap 'question-mark - "Bitmap (a symbol) used in the fringe for indicating warnings. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-fringe-indicator-position 'left-fringe - "The position to put flymake fringe indicator. -The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. -See `flymake-error-bitmap' and `flymake-warning-bitmap'." - :group 'flymake - :version "24.3" - :type '(choice (const left-fringe) - (const right-fringe) - (const :tag "No fringe indicators" nil))) - -(defun flymake-make-overlay (beg end tooltip-text face bitmap mouse-face) +(defun flymake-make-overlay (beg end tooltip-text face bitmap) "Allocate a flymake overlay in range BEG and END." (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t t)) + (let ((ov (make-overlay beg end nil t)) (fringe (and flymake-fringe-indicator-position (propertize "!" 'display (cons flymake-fringe-indicator-position @@ -814,7 +701,6 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'." bitmap (list bitmap))))))) (overlay-put ov 'face face) - (overlay-put ov 'mouse-face mouse-face) (overlay-put ov 'help-echo tooltip-text) (overlay-put ov 'flymake-overlay t) (overlay-put ov 'priority 100) @@ -866,42 +752,19 @@ Return t if it has at least one flymake overlay, nil if no overlay." Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (goto-char (point-min)) (forward-line (1- line-no)) - (let* ((line-beg (point-at-bol)) - (line-end (point-at-eol)) - (beg line-beg) - (end line-end) - (tooltip-text (flymake-ler-text (nth 0 line-err-info-list))) - (face nil) - (bitmap nil)) - - (goto-char line-beg) - (while (looking-at "[ \t]") - (forward-char)) - - (setq beg (point)) - - (goto-char line-end) - (while (and (looking-at "[ \t\r\n]") (> (point) 1)) - (backward-char)) - - (setq end (1+ (point))) - - (when (<= end beg) - (setq beg line-beg) - (setq end line-end)) - - (when (= end beg) - (goto-char end) - (forward-line) - (setq end (point))) - - (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (setq face 'flymake-errline - bitmap flymake-error-bitmap) - (setq face 'flymake-warnline - bitmap flymake-warning-bitmap)) - - (flymake-make-overlay beg end tooltip-text face bitmap nil))) + (pcase-let* ((beg (progn (back-to-indentation) (point))) + (end (progn + (end-of-line) + (skip-chars-backward " \t\f\t\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point)))) + (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) + (`(,face ,bitmap) + (if (> (flymake-get-line-err-count line-err-info-list "e") 0) + (list 'flymake-errline flymake-error-bitmap) + (list 'flymake-warnline flymake-warning-bitmap)))) + (flymake-make-overlay beg end tooltip-text face bitmap))) (defun flymake-parse-err-lines (err-info-list lines) "Parse err LINES, store info in ERR-INFO-LIST." @@ -931,7 +794,7 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." Return last one as residual if it does not end with newline char. Returns ((LINES) RESIDUAL)." (when (and output (> (length output) 0)) - (let* ((lines (flymake-split-string output "[\n\r]+")) + (let* ((lines (split-string output "[\n\r]+" t)) (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) (residual nil)) (when (not complete) @@ -989,21 +852,12 @@ Convert it to flymake internal format." Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns from compile.el") -;;(defcustom flymake-err-line-patterns -;; '( -;; ; MS Visual C++ 6.0 -;; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \: \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" -;; 1 3 4) -;; ; jikes -;; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[0-9]+\:[0-9]+\:[0-9]+\: \\(\\(Error\\|Warning\\|Caution\\):[ \t\n]*\\(.+\\)\\)" -;; 1 3 4)) -;; "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" -;; :group 'flymake -;; :type '(repeat (string number number number)) -;;) - -(defvar flymake-warning-re "^[wW]arning" - "Regexp matching against err-text to detect a warning.") +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") +(defvar flymake-warning-predicate "^[wW]arning" + "Predicate matching against error text to detect a warning. +Takes a single argument, the error's text and should return non-nil +if it's a warning. +Instead of a function, it can also be a regular expression.") (defun flymake-parse-line (line) "Parse LINE to see if it is an error or warning. @@ -1020,16 +874,22 @@ Return its components if so, nil otherwise." (line-idx (nth 2 (car patterns)))) (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number (match-string line-idx line)) 0)) + (setq line-no (if line-idx (string-to-number + (match-string line-idx line)) 0)) (setq err-text (if (> (length (car patterns)) 4) (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text (substring line (match-end 0))))) - (or err-text (setq err-text "")) - (if (and err-text (string-match flymake-warning-re err-text)) - (setq err-type "w") - ) - (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx - raw-file-name line-no err-text) + (flymake-patch-err-text + (substring line (match-end 0))))) + (if (null err-text) + (setq err-text "") + (when (cond ((stringp flymake-warning-predicate) + (string-match flymake-warning-predicate err-text)) + ((functionp flymake-warning-predicate) + (funcall flymake-warning-predicate err-text))) + (setq err-type "w"))) + (flymake-log + 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" + file-idx line-idx raw-file-name line-no err-text) (setq matched t))) (setq patterns (cdr patterns))) (if matched @@ -1106,26 +966,24 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (shell-quote-argument basedir) " DUMPVARS=INCLUDE_DIRS dumpvars")) (output (shell-command-to-string command-line)) - (lines (flymake-split-string output "\n")) + (lines (split-string output "\n" t)) (count (length lines)) (idx 0) (inc-dirs nil)) (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) (setq idx (1+ idx))) (when (< idx count) - (let* ((inc-lines (flymake-split-string (nth idx lines) " *-I")) + (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) (inc-count (length inc-lines))) (while (> inc-count 0) (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) - (push (flymake-replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) + (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) (setq inc-count (1- inc-count))))) (flymake-add-project-include-dirs-to-cache basedir inc-dirs) inc-dirs))) -(defcustom flymake-get-project-include-dirs-function 'flymake-get-project-include-dirs-imp - "Function used to get project include dirs, one parameter: basedir name." - :group 'flymake - :type 'function) +(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp + "Function used to get project include dirs, one parameter: basedir name.") (defun flymake-get-project-include-dirs (basedir) (funcall flymake-get-project-include-dirs-function basedir)) @@ -1133,9 +991,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-get-system-include-dirs () "System include dirs - from the 'INCLUDE' env setting." (let* ((includes (getenv "INCLUDE"))) - (if includes (flymake-split-string includes path-separator) nil))) + (if includes (split-string includes path-separator t) nil))) -(defvar flymake-project-include-dirs-cache (flymake-makehash 'equal)) +(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) (defun flymake-get-project-include-dirs-from-cache (base-dir) (gethash base-dir flymake-project-include-dirs-cache)) @@ -1175,11 +1033,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (error (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) -(defcustom flymake-compilation-prevents-syntax-check t - "If non-nil, don't start syntax check if compilation is running." - :group 'flymake - :type 'boolean) - (defun flymake-start-syntax-check () "Start syntax checking for current buffer." (interactive) @@ -1223,7 +1076,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-is-running t) (setq flymake-last-change-time nil) - (setq flymake-check-start-time (flymake-float-time)) + (setq flymake-check-start-time (float-time)) (flymake-report-status nil "*") (flymake-log 2 "started process %d, command=%s, dir=%s" @@ -1264,71 +1117,49 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-stop-all-syntax-checks) (call-interactively 'compile)) -(defcustom flymake-no-changes-timeout 0.5 - "Time to wait after last change before starting compilation." - :group 'flymake - :type 'number) - (defun flymake-on-timer-event (buffer) "Start a syntax check for buffer BUFFER if necessary." (when (buffer-live-p buffer) (with-current-buffer buffer (when (and (not flymake-is-running) flymake-last-change-time - (> (- (flymake-float-time) flymake-last-change-time) + (> (- (float-time) flymake-last-change-time) flymake-no-changes-timeout)) (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") (flymake-start-syntax-check))))) -(defun flymake-current-line-no () - "Return number of current line in current buffer." - (count-lines (point-min) (if (eobp) (point) (1+ (point))))) +(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line + 'flymake-popup-current-error-menu "24.4") -(defun flymake-count-lines () - "Return number of lines in buffer BUFFER." - (count-lines (point-min) (point-max))) - -(defun flymake-display-err-menu-for-current-line () - "Display a menu with errors/warnings for current line if it has errors and/or warnings." - (interactive) - (let* ((line-no (flymake-current-line-no)) - (line-err-info-list (nth 0 (flymake-find-err-info flymake-err-info line-no))) - (menu-data (flymake-make-err-menu-data line-no line-err-info-list)) - (choice nil)) - (if menu-data - (progn - (setq choice (flymake-popup-menu menu-data)) - (flymake-log 3 "choice=%s" choice) - (when choice - (eval choice))) - (flymake-log 1 "no errors for line %d" line-no)))) - -(defun flymake-make-err-menu-data (line-no line-err-info-list) - "Make a (menu-title (item-title item-action)*) list with errors/warnings from LINE-ERR-INFO-LIST." - (let* ((menu-items nil)) - (when line-err-info-list - (let* ((count (length line-err-info-list)) - (menu-item-text nil)) - (while (> count 0) - (setq menu-item-text (flymake-ler-text (nth (1- count) line-err-info-list))) - (let* ((file (flymake-ler-file (nth (1- count) line-err-info-list))) - (full-file (flymake-ler-full-file (nth (1- count) line-err-info-list))) - (line (flymake-ler-line (nth (1- count) line-err-info-list)))) - (if file - (setq menu-item-text (concat menu-item-text " - " file "(" (format "%d" line) ")"))) - (setq menu-items (cons (list menu-item-text - (if file (list 'flymake-goto-file-and-line full-file line) nil)) - menu-items))) - (setq count (1- count))) - (flymake-log 3 "created menu-items with %d item(s)" (length menu-items)))) - (if menu-items - (let* ((menu-title (format "Line %d: %d error(s), %d warning(s)" line-no - (flymake-get-line-err-count line-err-info-list "e") - (flymake-get-line-err-count line-err-info-list "w")))) - (list menu-title menu-items)) - nil))) +(defun flymake-popup-current-error-menu (&optional event) + "Pop up a menu with errors/warnings for current line." + (interactive (list last-nonmenu-event)) + (let* ((line-no (line-number-at-pos)) + (errors (or (car (flymake-find-err-info flymake-err-info line-no)) + (user-error "No errors for current line"))) + (menu (mapcar (lambda (x) + (if (flymake-ler-file x) + (cons (format "%s - %s(%d)" + (flymake-ler-text x) + (flymake-ler-file x) + (flymake-ler-line x)) + x) + (list (flymake-ler-text x)))) + errors)) + (event (if (mouse-event-p event) + event + (list 'mouse-1 (posn-at-point)))) + (title (format "Line %d: %d error(s), %d warning(s)" + line-no + (flymake-get-line-err-count errors "e") + (flymake-get-line-err-count errors "w"))) + (choice (x-popup-menu event (list title (cons "" menu))))) + (flymake-log 3 "choice=%s" choice) + (when choice + (flymake-goto-file-and-line (flymake-ler-full-file choice) + (flymake-ler-line choice))))) (defun flymake-goto-file-and-line (file line) "Try to get buffer for FILE and goto line LINE in it." @@ -1339,17 +1170,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (forward-line (1- line)))) ;; flymake minor mode declarations -(defvar flymake-mode-line nil) - -(make-variable-buffer-local 'flymake-mode-line) - -(defvar flymake-mode-line-e-w nil) - -(make-variable-buffer-local 'flymake-mode-line-e-w) - -(defvar flymake-mode-line-status nil) - -(make-variable-buffer-local 'flymake-mode-line-status) +(defvar-local flymake-mode-line nil) +(defvar-local flymake-mode-line-e-w nil) +(defvar-local flymake-mode-line-status nil) (defun flymake-report-status (e-w &optional status) "Show status in mode line." @@ -1368,11 +1191,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." "Display a warning to user." (message-box warning)) -(defcustom flymake-gui-warnings-enabled t - "Enables/disables GUI warnings." - :group 'flymake - :type 'boolean) - (defun flymake-report-fatal-status (status warning) "Display a warning and switch flymake mode off." (when flymake-gui-warnings-enabled @@ -1382,17 +1200,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" (buffer-name) status warning)) -(defcustom flymake-start-syntax-check-on-find-file t - "Start syntax check on find file." - :group 'flymake - :type 'boolean) - ;;;###autoload -(define-minor-mode flymake-mode - "Toggle on-the-fly syntax checking. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." +(define-minor-mode flymake-mode nil :group 'flymake :lighter flymake-mode-line (cond @@ -1448,19 +1257,14 @@ if ARG is omitted or nil." (flymake-mode 0) (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) -(defcustom flymake-start-syntax-check-on-newline t - "Start syntax check if newline char was added/removed from the buffer." - :group 'flymake - :type 'boolean) - (defun flymake-after-change-function (start stop _len) "Start syntax check for current buffer if it isn't already running." - ;;+(flymake-log 0 "setting change time to %s" (flymake-float-time)) + ;;+(flymake-log 0 "setting change time to %s" (float-time)) (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log 3 "starting syntax check as new-line has been seen") (flymake-start-syntax-check)) - (setq flymake-last-change-time (flymake-float-time)))) + (setq flymake-last-change-time (float-time)))) (defun flymake-after-save-hook () (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? @@ -1527,7 +1331,7 @@ if ARG is omitted or nil." (defun flymake-goto-next-error () "Go to next error in err ring." (interactive) - (let ((line-no (flymake-get-next-err-line-no flymake-err-info (flymake-current-line-no)))) + (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) (when (not line-no) (setq line-no (flymake-get-first-err-line-no flymake-err-info)) (flymake-log 1 "passed end of file")) @@ -1538,7 +1342,7 @@ if ARG is omitted or nil." (defun flymake-goto-prev-error () "Go to previous error in err ring." (interactive) - (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (flymake-current-line-no)))) + (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) (when (not line-no) (setq line-no (flymake-get-last-err-line-no flymake-err-info)) (flymake-log 1 "passed beginning of file")) @@ -1574,14 +1378,14 @@ if ARG is omitted or nil." ;; trying to remove the leading / of absolute file names. (slash-pos (string-match "/" dir)) (temp-dir (expand-file-name (substring dir (1+ slash-pos)) - (flymake-get-temp-dir)))) + temporary-file-directory))) (file-truename (expand-file-name (file-name-nondirectory file-name) temp-dir)))) (defun flymake-delete-temp-directory (dir-name) "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." - (let* ((temp-dir (flymake-get-temp-dir)) + (let* ((temp-dir temporary-file-directory) (suffix (substring dir-name (1+ (length temp-dir))))) (while (> (length suffix) 0) @@ -1591,17 +1395,10 @@ if ARG is omitted or nil." (file-truename (expand-file-name suffix temp-dir))) (setq suffix (file-name-directory suffix))))) -(defvar flymake-temp-source-file-name nil) -(make-variable-buffer-local 'flymake-temp-source-file-name) - -(defvar flymake-master-file-name nil) -(make-variable-buffer-local 'flymake-master-file-name) - -(defvar flymake-temp-master-file-name nil) -(make-variable-buffer-local 'flymake-temp-master-file-name) - -(defvar flymake-base-dir nil) -(make-variable-buffer-local 'flymake-base-dir) +(defvar-local flymake-temp-source-file-name nil) +(defvar-local flymake-master-file-name nil) +(defvar-local flymake-temp-master-file-name nil) +(defvar-local flymake-base-dir nil) (defun flymake-init-create-temp-buffer-copy (create-temp-f) "Make a temporary copy of the current buffer, save its name in buffer data and return the name." @@ -1837,8 +1634,9 @@ Use CREATE-TEMP-F for creating temp copy." ;;;; xml-specific init-cleanup routines (defun flymake-xml-init () - (list "xml" (list "val" (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))) + (list flymake-xml-program + (list "val" (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)))) (provide 'flymake) - ;;; flymake.el ends here diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index ff667f80f9d..cf324b40026 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,6 +1,6 @@ ;;; fortran.el --- Fortran mode for GNU Emacs -;; Copyright (C) 1986, 1993-1995, 1997-2013 Free Software Foundation, +;; Copyright (C) 1986, 1993-1995, 1997-2014 Free Software Foundation, ;; Inc. ;; Author: Michael D. Prange @@ -1080,8 +1080,7 @@ The next key typed is executed unless it is SPC." fortran-column-ruler-fixed) (save-excursion (beginning-of-line) - (if (eq (window-start (selected-window)) - (window-point (selected-window))) + (if (eq (window-start) (window-point)) (line-beginning-position 2) (point))) nil "Type SPC or any command to erase ruler.")) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 90c7cfc5008..7f8c483ee5c 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1,9 +1,9 @@ -;;; gdb-mi.el --- User Interface for running GDB +;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*- -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Nick Roberts -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: unix, tools ;; This file is part of GNU Emacs. @@ -91,7 +91,7 @@ (require 'gud) (require 'json) (require 'bindat) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -192,8 +192,8 @@ address for root variables.") (defvar gdb-disassembly-position nil) (defvar gdb-location-alist nil - "Alist of breakpoint numbers and full filenames. Only used for files that -Emacs can't find.") + "Alist of breakpoint numbers and full filenames. +Only used for files that Emacs can't find.") (defvar gdb-active-process nil "GUD tooltips display variable values when t, and macro definitions otherwise.") (defvar gdb-error "Non-nil when GDB is reporting an error.") @@ -206,8 +206,8 @@ Emacs can't find.") (defvar gdb-last-command nil) (defvar gdb-prompt-name nil) (defvar gdb-token-number 0) -(defvar gdb-handler-alist '()) -(defvar gdb-handler-number nil) +(defvar gdb-handler-list '() + "List of gdb-handler keeping track of all pending GDB commands.") (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) @@ -227,9 +227,8 @@ This variable is updated in `gdb-done-or-error' and returned by It is initialized to `gdb-non-stop-setting' at the beginning of every GDB session.") -(defvar gdb-buffer-type nil +(defvar-local gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") -(make-variable-buffer-local 'gdb-buffer-type) (defvar gdb-output-sink 'nil "The disposition of the output of the current gdb command. @@ -243,33 +242,113 @@ Possible values are these symbols: disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") -;; Pending triggers prevent congestion: Emacs won't send two similar -;; consecutive requests. +(defcustom gdb-discard-unordered-replies t + "Non-nil means discard any out-of-order GDB replies. +This protects against lost GDB replies, assuming that GDB always +replies in the same order as Emacs sends commands. When receiving a +reply with a given token-number, assume any pending messages with a +lower token-number are out-of-order." + :type 'boolean + :group 'gud + :version "24.4") -(defvar gdb-pending-triggers '() - "A list of trigger functions which have not yet been handled. +(cl-defstruct gdb-handler + "Data required to handle the reply of a command sent to GDB." + ;; Prefix of the command sent to GDB. The GDB reply for this command + ;; will be prefixed with this same TOKEN-NUMBER + (token-number nil :read-only t) + ;; Callback to invoke when the reply is received from GDB + (function nil :read-only t) + ;; PENDING-TRIGGER is used to prevent congestion: Emacs won't send + ;; two requests with the same PENDING-TRIGGER until a reply is received + ;; for the first one." + (pending-trigger nil)) -Elements are either function names or pairs (buffer . function)") +(defun gdb-add-handler (token-number handler-function &optional pending-trigger) + "Insert a new GDB command handler in `gdb-handler-list'. +Handlers are used to keep track of the commands sent to GDB +and to handle the replies received. +Upon reception of a reply prefixed with TOKEN-NUMBER, +invoke the callback HANDLER-FUNCTION. +If PENDING-TRIGGER is specified, no new GDB commands will be +sent with this same PENDING-TRIGGER until a reply is received +for this handler." -(defmacro gdb-add-pending (item) - `(push ,item gdb-pending-triggers)) -(defmacro gdb-pending-p (item) - `(member ,item gdb-pending-triggers)) -(defmacro gdb-delete-pending (item) - `(setq gdb-pending-triggers - (delete ,item gdb-pending-triggers))) + (push (make-gdb-handler :token-number token-number + :function handler-function + :pending-trigger pending-trigger) + gdb-handler-list)) + +(defun gdb-delete-handler (token-number) + "Remove the handler TOKEN-NUMBER from `gdb-handler-list'. +Additionally, if `gdb-discard-unordered-replies' is non-nil, +discard all handlers having a token number less than TOKEN-NUMBER." + (if gdb-discard-unordered-replies + + (setq gdb-handler-list + (cl-delete-if + (lambda (handler) + "Discard any HANDLER with a token number `<=' than TOKEN-NUMBER." + (when (< (gdb-handler-token-number handler) token-number) + (message "WARNING! Discarding GDB handler with token #%d\n" + (gdb-handler-token-number handler))) + (<= (gdb-handler-token-number handler) token-number)) + gdb-handler-list)) + + (setq gdb-handler-list + (cl-delete-if + (lambda (handler) + "Discard any HANDLER with a token number `eq' to TOKEN-NUMBER." + (eq (gdb-handler-token-number handler) token-number)) + gdb-handler-list)))) + +(defun gdb-get-handler-function (token-number) + "Return the function callback registered with the handler TOKEN-NUMBER." + (gdb-handler-function + (cl-find-if (lambda (handler) (eq (gdb-handler-token-number handler) + token-number)) + gdb-handler-list))) + + +(defun gdb-pending-handler-p (pending-trigger) + "Return non-nil if a command handler is pending with trigger PENDING-TRIGGER." + (cl-find-if (lambda (handler) (eq (gdb-handler-pending-trigger handler) + pending-trigger)) + gdb-handler-list)) + + +(defun gdb-handle-reply (token-number) + "Handle the GDB reply TOKEN-NUMBER. +This invokes the handler registered with this token number +in `gdb-handler-list' and clears all pending handlers invalidated +by the reception of this reply." + (let ((handler-function (gdb-get-handler-function token-number))) + (when handler-function + (funcall handler-function) + (gdb-delete-handler token-number)))) + +(defun gdb-remove-all-pending-triggers () + "Remove all pending triggers from gdb-handler-list. +The handlers are left in gdb-handler-list so that replies received +from GDB could still be handled. However, removing the pending triggers +allows Emacs to send new commands even if replies of previous commands +were not yet received." + (dolist (handler gdb-handler-list) + (setf (gdb-handler-pending-trigger handler) nil))) (defmacro gdb-wait-for-pending (&rest body) - "Wait until `gdb-pending-triggers' is empty and evaluate FORM. + "Wait for all pending GDB commands to finish and evaluate BODY. -This function checks `gdb-pending-triggers' value every -`gdb-wait-for-pending' seconds." - (run-with-timer - 0.5 nil - `(lambda () - (if (not gdb-pending-triggers) - (progn ,@body) - (gdb-wait-for-pending ,@body))))) +This function checks every 0.5 seconds if there are any pending +triggers in `gdb-handler-list'." + `(run-with-timer + 0.5 nil + '(lambda () + (if (not (cl-find-if (lambda (handler) + (gdb-handler-pending-trigger handler)) + gdb-handler-list)) + (progn ,@body) + (gdb-wait-for-pending ,@body))))) ;; Publish-subscribe @@ -294,9 +373,7 @@ argument (see `gdb-emit-signal')." (funcall (cdr subscriber) signal))) (defvar gdb-buf-publisher '() - "Used to invalidate GDB buffers by emitting a signal in -`gdb-update'. - + "Used to invalidate GDB buffers by emitting a signal in `gdb-update'. Must be a list of pairs with cars being buffers and cdr's being valid signal handlers.") @@ -327,8 +404,7 @@ valid signal handlers.") "When in non-stop mode, stopped threads can be examined while other threads continue to execute. -GDB session needs to be restarted for this setting to take -effect." +GDB session needs to be restarted for this setting to take effect." :type 'boolean :group 'gdb-non-stop :version "23.2") @@ -336,19 +412,18 @@ effect." ;; TODO Some commands can't be called with --all (give a notice about ;; it in setting doc) (defcustom gdb-gud-control-all-threads t - "When enabled, GUD execution commands affect all threads when -in non-stop mode. Otherwise, only current thread is affected." + "When non-nil, GUD execution commands affect all threads when +in non-stop mode. Otherwise, only current thread is affected." :type 'boolean :group 'gdb-non-stop :version "23.2") (defcustom gdb-switch-reasons t - "List of stop reasons which cause Emacs to switch to the thread -which caused the stop. When t, switch to stopped thread no matter -what the reason was. When nil, never switch to stopped thread -automatically. + "List of stop reasons for which Emacs should switch thread. +When t, switch to stopped thread no matter what the reason was. +When nil, never switch to stopped thread automatically. -This setting is used in non-stop mode only. In all-stop mode, +This setting is used in non-stop mode only. In all-stop mode, Emacs always switches to the thread which caused the stop." ;; exited, exited-normally and exited-signaled are not ;; thread-specific stop reasons and therefore are not included in @@ -404,7 +479,7 @@ and GDB buffers were updated in `gdb-stopped'." :link '(info-link "(gdb)GDB/MI Async Records")) (defcustom gdb-switch-when-another-stopped t - "When nil, Emacs won't switch to stopped thread if some other + "When nil, don't switch to stopped thread if some other stopped thread is already selected." :type 'boolean :group 'gdb-non-stop @@ -447,8 +522,7 @@ stopped thread is already selected." :version "23.2") (defcustom gdb-show-threads-by-default nil - "Show threads list buffer instead of breakpoints list by -default." + "Show threads list buffer instead of breakpoints list by default." :type 'boolean :group 'gdb-buffers :version "23.2") @@ -490,12 +564,12 @@ predefined macros." (defcustom gdb-create-source-file-list t "Non-nil means create a list of files from which the executable was built. - Set this to nil if the GUD buffer displays \"initializing...\" in the mode - line for a long time when starting, possibly because your executable was - built from a large number of files. This allows quicker initialization - but means that these files are not automatically enabled for debugging, - e.g., you won't be able to click in the fringe to set a breakpoint until - execution has already stopped there." +Set this to nil if the GUD buffer displays \"initializing...\" in the mode +line for a long time when starting, possibly because your executable was +built from a large number of files. This allows quicker initialization +but means that these files are not automatically enabled for debugging, +e.g., you won't be able to click in the fringe to set a breakpoint until +execution has already stopped there." :type 'boolean :group 'gdb :version "23.1") @@ -507,6 +581,9 @@ Also display the main routine in the disassembly buffer if present." :group 'gdb :version "22.1") +(defvar gdbmi-debug-mode nil + "When non-nil, print the messages sent/received from GDB/MI in *Messages*.") + (defun gdb-force-mode-line-update (status) (let ((buffer gud-comint-buffer)) (if (and buffer (buffer-name buffer)) @@ -570,28 +647,27 @@ When `gdb-non-stop' is nil, return COMMAND unchanged." (defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg) "`gud-call' wrapper which adds --thread/--all options between -CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'. +CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'. NOARG must be t when this macro is used outside `gud-def'" `(gud-call (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2) ,(when (not noarg) 'arg))) -(defun gdb--check-interpreter (proc string) +(defun gdb--check-interpreter (filter proc string) (unless (zerop (length string)) - (let ((filter (process-get proc 'gud-normal-filter))) - (set-process-filter proc filter) - (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) - ;; Apparently we're not running with -i=mi. - (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) - (message msg) - (setq string (concat (propertize msg 'font-lock-face 'error) - "\n" string))) - ;; Use the old gud-gbd filter, not because it works, but because it - ;; will properly display GDB's answers rather than hanging waiting for - ;; answers that aren't coming. - (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter)) - (funcall filter proc string)))) + (remove-function (process-filter proc) #'gdb--check-interpreter) + (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) + ;; Apparently we're not running with -i=mi. + (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) + (message msg) + (setq string (concat (propertize msg 'font-lock-face 'error) + "\n" string))) + ;; Use the old gud-gbd filter, not because it works, but because it + ;; will properly display GDB's answers rather than hanging waiting for + ;; answers that aren't coming. + (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter)) + (funcall filter proc string))) (defvar gdb-control-level 0) @@ -603,7 +679,7 @@ and source-file directory for your debugger. COMMAND-LINE is the shell command for starting the gdb session. It should be a string consisting of the name of the gdb -executable followed by command-line options. The command-line +executable followed by command line options. The command line options should include \"-i=mi\" to use gdb's MI text interface. Note that the old \"--annotate\" option is no longer supported. @@ -665,8 +741,7 @@ detailed description of this mode. ;; Setup a temporary process filter to warn when GDB was not started ;; with -i=mi. (let ((proc (get-buffer-process gud-comint-buffer))) - (process-put proc 'gud-normal-filter (process-filter proc)) - (set-process-filter proc #'gdb--check-interpreter)) + (add-function :around (process-filter proc) #'gdb--check-interpreter)) (set (make-local-variable 'gud-minor-mode) 'gdbmi) (set (make-local-variable 'gdb-control-level) 0) @@ -825,14 +900,12 @@ detailed description of this mode. gdb-frame-number nil gdb-thread-number nil gdb-var-list nil - gdb-pending-triggers nil gdb-output-sink 'user gdb-location-alist nil gdb-source-file-list nil gdb-last-command nil gdb-token-number 0 - gdb-handler-alist '() - gdb-handler-number nil + gdb-handler-list '() gdb-prompt-name nil gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) @@ -846,6 +919,8 @@ detailed description of this mode. gdb-register-names '() gdb-non-stop gdb-non-stop-setting) ;; + (gdbmi-bnf-init) + ;; (setq gdb-buffer-type 'gdbmi) ;; (gdb-force-mode-line-update @@ -906,7 +981,8 @@ no input, and GDB is waiting for input." (eq gud-minor-mode 'gdbmi)) (error "Not in a GDB-MI buffer")) (let ((proc (get-buffer-process gud-comint-buffer))) - (if (and (eobp) proc (process-live-p proc) + (if (and (eobp) + (process-live-p proc) (not gud-running) (= (point) (marker-position (process-mark proc)))) ;; Sending an EOF does not work with GDB-MI; submit an @@ -941,11 +1017,15 @@ no input, and GDB is waiting for input." (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) +(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"") + (defun gdb-tooltip-print (expr) (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) (cond - ((re-search-forward ".*value=\\(\".*\"\\)" nil t) + ((re-search-forward (concat ".*value=\\(" gdb--string-regexp + "\\)") + nil t) (tooltip-show (concat expr " = " (read (match-string 1))) (or gud-tooltip-echo-area @@ -1110,22 +1190,21 @@ With arg, enter name of variable to be watched in the minibuffer." (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) - (not (gdb-pending-p 'gdb-speedbar-timer))) + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) ;; Dummy command to update speedbar even when idle. - (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn) - ;; Keep gdb-pending-triggers non-nil till end. - (gdb-add-pending 'gdb-speedbar-timer))) + (gdb-input "-environment-pwd" + 'gdb-speedbar-timer-fn + 'gdb-speedbar-update))) (defun gdb-speedbar-timer-fn () (if gdb-speedbar-auto-raise (raise-frame speedbar-frame)) - (gdb-delete-pending 'gdb-speedbar-timer) (speedbar-timer-fn)) (defun gdb-var-evaluate-expression-handler (varnum changed) (goto-char (point-min)) - (re-search-forward ".*value=\\(\".*\"\\)" nil t) + (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)") + nil t) (let ((var (assoc varnum gdb-var-list))) (when var (if changed (setcar (nthcdr 5 var) 'changed)) @@ -1210,9 +1289,9 @@ With arg, enter name of variable to be watched in the minibuffer." ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update () - (if (not (gdb-pending-p 'gdb-var-update)) - (gdb-input "-var-update --all-values *" 'gdb-var-update-handler)) - (gdb-add-pending 'gdb-var-update)) + (gdb-input "-var-update --all-values *" + 'gdb-var-update-handler + 'gdb-var-update)) (defun gdb-var-update-handler () (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) @@ -1254,7 +1333,7 @@ With arg, enter name of variable to be watched in the minibuffer." (cond ((> new previous) ;; Add new children to list. - (dotimes (dummy previous) + (dotimes (_ previous) (push (pop temp-var-list) var-list)) (dolist (child children) (let ((varchild @@ -1268,15 +1347,13 @@ With arg, enter name of variable to be watched in the minibuffer." (push varchild var-list)))) ;; Remove deleted children from list. ((< new previous) - (dotimes (dummy new) + (dotimes (_ new) (push (pop temp-var-list) var-list)) - (dotimes (dummy (- previous new)) + (dotimes (_ (- previous new)) (pop temp-var-list))))) (push var1 var-list)) (setq var1 (pop temp-var-list))) (setq gdb-var-list (nreverse var-list)))))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) (gdb-speedbar-update)) (defun gdb-speedbar-expand-node (text token indent) @@ -1418,7 +1495,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with split-horizontal) `(defun ,name (&optional thread) ,(when doc doc) - (message thread) + (message "%s" thread) (gdb-preempt-existing-or-display-buffer (gdb-get-buffer-create ,buffer thread) ,split-horizontal))) @@ -1502,15 +1579,14 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (gdb-input (concat "-inferior-tty-set " tty) 'ignore)))) -(defun gdb-inferior-io-sentinel (proc str) +(defun gdb-inferior-io-sentinel (proc _str) (when (eq (process-status proc) 'failed) ;; When the debugged process exits, Emacs gets an EIO error on ;; read from the pty, and stops listening to it. If the gdb ;; process is still running, remove the pty, make a new one, and ;; pass it to gdb. - (let ((gdb-proc (get-buffer-process gud-comint-buffer)) - (io-buffer (process-buffer proc))) - (when (and gdb-proc (process-live-p gdb-proc) + (let ((io-buffer (process-buffer proc))) + (when (and (process-live-p (get-buffer-process gud-comint-buffer)) (buffer-live-p io-buffer)) ;; `comint-exec' deletes the original process as a side effect. (comint-exec io-buffer "gdb-inferior" nil nil nil) @@ -1687,6 +1763,9 @@ static char *magick[] = { As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") +(defun gdb-strip-string-backslash (string) + (replace-regexp-in-string "\\\\$" "" string)) + (defun gdb-send (proc string) "A comint send filter for gdb." (with-current-buffer gud-comint-buffer @@ -1694,10 +1773,15 @@ commands to be prefixed by \"-interpreter-exec console\".") (remove-text-properties (point-min) (point-max) '(face)))) ;; mimic key to repeat previous command in GDB (if (not (string= "" string)) - (setq gdb-last-command string) - (if gdb-last-command (setq string gdb-last-command))) - (if (or (string-match "^-" string) - (> gdb-control-level 0)) + (if gdb-continuation + (setq gdb-last-command (concat gdb-continuation + (gdb-strip-string-backslash string) + " ")) + (setq gdb-last-command (gdb-strip-string-backslash string))) + (if gdb-last-command (setq string gdb-last-command)) + (setq gdb-continuation nil)) + (if (and (not gdb-continuation) (or (string-match "^-" string) + (> gdb-control-level 0))) ;; Either MI command or we are feeding GDB's recursive reading loop. (progn (setq gdb-first-done-or-error t) @@ -1707,10 +1791,13 @@ commands to be prefixed by \"-interpreter-exec console\".") (setq gdb-control-level (1- gdb-control-level)))) ;; CLI command (if (string-match "\\\\$" string) - (setq gdb-continuation (concat gdb-continuation string "\n")) + (setq gdb-continuation + (concat gdb-continuation (gdb-strip-string-backslash + string) + " ")) (setq gdb-first-done-or-error t) (let ((to-send (concat "-interpreter-exec console " - (gdb-mi-quote string) + (gdb-mi-quote (concat gdb-continuation string " ")) "\n"))) (if gdb-enable-debug (push (cons 'mi-send to-send) gdb-debug-log)) @@ -1730,17 +1817,25 @@ All embedded quotes, newlines, and backslashes are preceded with a backslash." (setq string (replace-regexp-in-string "\n" "\\n" string t t)) (concat "\"" string "\"")) -(defun gdb-input (command handler-function) +(defun gdb-input (command handler-function &optional trigger-name) "Send COMMAND to GDB via the MI interface. Run the function HANDLER-FUNCTION, with no arguments, once the command is -complete." - (if gdb-enable-debug (push (list 'send-item command handler-function) - gdb-debug-log)) - (setq gdb-token-number (1+ gdb-token-number)) - (setq command (concat (number-to-string gdb-token-number) command)) - (push (cons gdb-token-number handler-function) gdb-handler-alist) - (process-send-string (get-buffer-process gud-comint-buffer) - (concat command "\n"))) +complete. Do not send COMMAND to GDB if TRIGGER-NAME is non-nil and +Emacs is still waiting for a reply from another command previously +sent with the same TRIGGER-NAME." + (when (or (not trigger-name) + (not (gdb-pending-handler-p trigger-name))) + (setq gdb-token-number (1+ gdb-token-number)) + (setq command (concat (number-to-string gdb-token-number) command)) + + (if gdb-enable-debug (push (list 'send-item command handler-function) + gdb-debug-log)) + + (gdb-add-handler gdb-token-number handler-function trigger-name) + + (if gdbmi-debug-mode (message "gdb-input: %s" command)) + (process-send-string (get-buffer-process gud-comint-buffer) + (concat command "\n")))) ;; NOFRAME is used for gud execution control commands (defun gdb-current-context-command (command) @@ -1761,8 +1856,7 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." "*")) (defun gdb-current-context-mode-name (mode) - "Add thread information to MODE which is to be used as -`mode-name'." + "Add thread information to MODE which is to be used as `mode-name'." (concat mode (if gdb-thread-number (format " [thread %s]" gdb-thread-number) @@ -1777,7 +1871,7 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." (defun gdb-resync() (setq gud-running nil) (setq gdb-output-sink 'user) - (setq gdb-pending-triggers nil)) + (gdb-remove-all-pending-triggers)) (defun gdb-update (&optional no-proc) "Update buffers showing status of debug session. @@ -1809,7 +1903,8 @@ If NO-PROC is non-nil, do not try to contact the GDB process." ;; because we may need to update current gud-running value without ;; changing current thread (see gdb-running) (defun gdb-setq-thread-number (number) - "Only this function must be used to change `gdb-thread-number' + "Set `gdb-thread-number' to NUMBER. +Only this function must be used to change `gdb-thread-number' value to NUMBER, because `gud-running' and `gdb-frame-number' need to be updated appropriately when current thread changes." ;; GDB 6.8 and earlier always output thread-id="0" when stopping. @@ -1824,7 +1919,7 @@ need to be updated appropriately when current thread changes." Note that when `gdb-gud-control-all-threads' is t, `gud-running' cannot be reliably used to determine whether or not execution -control buttons should be shown in menu or toolbar. Use +control buttons should be shown in menu or toolbar. Use `gdb-running-threads-count' and `gdb-stopped-threads-count' instead. @@ -1874,23 +1969,342 @@ is running." (set-window-buffer source-window buffer)) source-window)) -(defun gdb-car< (a b) - (< (car a) (car b))) -(defvar gdbmi-record-list - '((gdb-gdb . "(gdb) \n") - (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n") - (gdb-starting . "\\([0-9]*\\)\\^running\n") - (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n") - (gdb-console . "~\\(\".*?\"\\)\n") - (gdb-internals . "&\\(\".*?\"\\)\n") - (gdb-stopped . "\\*stopped,?\\(.*?\\)\n") - (gdb-running . "\\*running,\\(.*?\n\\)") - (gdb-thread-created . "=thread-created,\\(.*?\n\\)") - (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n") - (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)") - (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n") - (gdb-shell . "\\(\\(?:^.+\n\\)+\\)"))) +(defun gdbmi-start-with (str offset match) + "Return non-nil if string STR starts with MATCH, else returns nil. +OFFSET is the position in STR at which the comparison takes place." + (let ((match-length (length match)) + (str-length (- (length str) offset))) + (when (>= str-length match-length) + (string-equal match (substring str offset (+ offset match-length)))))) + +(defun gdbmi-same-start (str offset match) + "Return non-nil iff STR and MATCH are equal up to the end of either strings. +OFFSET is the position in STR at which the comparison takes place." + (let* ((str-length (- (length str) offset)) + (match-length (length match)) + (compare-length (min str-length match-length))) + (when (> compare-length 0) + (string-equal (substring str offset (+ offset compare-length)) + (substring match 0 compare-length))))) + +(defun gdbmi-is-number (character) + "Return non-nil iff CHARACTER is a numerical character between 0 and 9." + (and (>= character ?0) + (<= character ?9))) + + +(defvar-local gdbmi-bnf-state 'gdbmi-bnf-output + "Current GDB/MI output parser state. +The parser is placed in a different state when an incomplete data steam is +received from GDB. +This variable will preserve the state required to resume the parsing +when more data arrives.") + +(defvar-local gdbmi-bnf-offset 0 + "Offset in `gud-marker-acc' at which the parser is reading. +This offset is used to be able to parse the GDB/MI message +in-place, without the need of copying the string in a temporary buffer +or discarding parsed tokens by substringing the message.") + +(defun gdbmi-bnf-init () + "Initialize the GDB/MI message parser." + (setq gdbmi-bnf-state 'gdbmi-bnf-output) + (setq gdbmi-bnf-offset 0) + (setq gud-marker-acc "")) + + +(defun gdbmi-bnf-output () + "Implementation of the following GDB/MI output grammar rule: + + output ==> + ( out-of-band-record )* [ result-record ] gdb-prompt" + + (gdbmi-bnf-skip-unrecognized) + (while (gdbmi-bnf-out-of-band-record)) + (gdbmi-bnf-result-record) + (gdbmi-bnf-gdb-prompt)) + + +(defun gdbmi-bnf-skip-unrecognized () + "Skip characters until is encounters the beginning of a valid record. +Used as a protection mechanism in case something goes wrong when parsing +a GDB/MI reply message." + (let ((acc-length (length gud-marker-acc)) + (prefix-offset gdbmi-bnf-offset) + (prompt "(gdb) \n")) + + (while (and (< prefix-offset acc-length) + (gdbmi-is-number (aref gud-marker-acc prefix-offset))) + (setq prefix-offset (1+ prefix-offset))) + + (if (and (< prefix-offset acc-length) + (not (memq (aref gud-marker-acc prefix-offset) + '(?^ ?* ?+ ?= ?~ ?@ ?&))) + (not (gdbmi-same-start gud-marker-acc gdbmi-bnf-offset prompt)) + (string-match "\\([^^*+=~@&]+\\)" gud-marker-acc + gdbmi-bnf-offset)) + (let ((unrecognized-str (match-string 0 gud-marker-acc))) + (setq gdbmi-bnf-offset (match-end 0)) + (if gdbmi-debug-mode + (message "gdbmi-bnf-skip-unrecognized: %s" unrecognized-str)) + (gdb-shell unrecognized-str) + t)))) + + +(defun gdbmi-bnf-gdb-prompt () + "Implementation of the following GDB/MI output grammar rule: + gdb-prompt ==> + '(gdb)' nl + + nl ==> + CR | CR-LF" + + (let ((prompt "(gdb) \n")) + (when (gdbmi-start-with gud-marker-acc gdbmi-bnf-offset prompt) + (if gdbmi-debug-mode (message "gdbmi-bnf-gdb-prompt: %s" prompt)) + (gdb-gdb prompt) + (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length prompt))) + + ;; Returns non-nil to tell gud-gdbmi-marker-filter we've reached + ;; the end of a GDB reply message. + t))) + + +(defun gdbmi-bnf-result-record () + "Implementation of the following GDB/MI output grammar rule: + + result-record ==> + [ token ] '^' result-class ( ',' result )* nl + + token ==> + any sequence of digits." + + (gdbmi-bnf-result-and-async-record-impl)) + + +(defun gdbmi-bnf-out-of-band-record () + "Implementation of the following GDB/MI output grammar rule: + + out-of-band-record ==> + async-record | stream-record" + + (or (gdbmi-bnf-async-record) + (gdbmi-bnf-stream-record))) + + +(defun gdbmi-bnf-async-record () + "Implementation of the following GDB/MI output grammar rules: + + async-record ==> + exec-async-output | status-async-output | notify-async-output + + exec-async-output ==> + [ token ] '*' async-output + + status-async-output ==> + [ token ] '+' async-output + + notify-async-output ==> + [ token ] '=' async-output + + async-output ==> + async-class ( ',' result )* nl" + + (gdbmi-bnf-result-and-async-record-impl)) + + +(defun gdbmi-bnf-stream-record () + "Implement the following GDB/MI output grammar rule: + stream-record ==> + console-stream-output | target-stream-output | log-stream-output + + console-stream-output ==> + '~' c-string + + target-stream-output ==> + '@' c-string + + log-stream-output ==> + '&' c-string" + (when (< gdbmi-bnf-offset (length gud-marker-acc)) + (if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&)) + (string-match (concat "\\([~@&]\\)\\(" gdb--string-regexp "\\)\n") + gud-marker-acc + gdbmi-bnf-offset)) + (let ((prefix (match-string 1 gud-marker-acc)) + (c-string (match-string 2 gud-marker-acc))) + + (setq gdbmi-bnf-offset (match-end 0)) + (if gdbmi-debug-mode (message "gdbmi-bnf-stream-record: %s" + (match-string 0 gud-marker-acc))) + + (cond ((string-equal prefix "~") + (gdbmi-bnf-console-stream-output c-string)) + ((string-equal prefix "@") + (gdbmi-bnf-target-stream-output c-string)) + ((string-equal prefix "&") + (gdbmi-bnf-log-stream-output c-string))) + t)))) + +(defun gdbmi-bnf-console-stream-output (c-string) + "Handler for the console-stream-output GDB/MI output grammar rule." + (gdb-console c-string)) + +(defun gdbmi-bnf-target-stream-output (_c-string) + "Handler for the target-stream-output GDB/MI output grammar rule." + ;; Not currently used. + ) + +(defun gdbmi-bnf-log-stream-output (c-string) + "Handler for the log-stream-output GDB/MI output grammar rule." + ;; Suppress "No registers." GDB 6.8 and earlier + ;; duplicates MI error message on internal stream. + ;; Don't print to GUD buffer. + (if (not (string-equal (read c-string) "No registers.\n")) + (gdb-internals c-string))) + + +(defconst gdbmi-bnf-result-state-configs + '(("^" . (("done" . (gdb-done . progressive)) + ("error" . (gdb-error . progressive)) + ("running" . (gdb-starting . atomic)))) + ("*" . (("stopped" . (gdb-stopped . atomic)) + ("running" . (gdb-running . atomic)))) + ("+" . ()) + ("=" . (("thread-created" . (gdb-thread-created . atomic)) + ("thread-selected" . (gdb-thread-selected . atomic)) + ("thread-existed" . (gdb-ignored-notification . atomic)) + ('default . (gdb-ignored-notification . atomic))))) + "Alist of alists, mapping the type and class of message to a handler function. +Handler functions are all flagged as either `progressive' or `atomic'. +`progressive' handlers are capable of parsing incomplete messages. +They can be called several time with new data chunk as they arrive from GDB. +`progressive' handlers must have an extra argument that is set to a non-nil +value when the message is complete. + +Implement the following GDB/MI output grammar rule: + result-class ==> + 'done' | 'running' | 'connected' | 'error' | 'exit' + + async-class ==> + 'stopped' | others (where others will be added depending on the needs + --this is still in development).") + +(defun gdbmi-bnf-result-and-async-record-impl () + "Common implementation of the result-record and async-record rule. +Both rules share the same syntax. Those records may be very large in size. +For that reason, the \"result\" part of the record is parsed by +`gdbmi-bnf-incomplete-record-result', which will keep +receiving characters as they arrive from GDB until the record is complete." + (let ((acc-length (length gud-marker-acc)) + (prefix-offset gdbmi-bnf-offset)) + + (while (and (< prefix-offset acc-length) + (gdbmi-is-number (aref gud-marker-acc prefix-offset))) + (setq prefix-offset (1+ prefix-offset))) + + (if (and (< prefix-offset acc-length) + (member (aref gud-marker-acc prefix-offset) '(?* ?+ ?= ?^)) + (string-match "\\([0-9]*\\)\\([*+=^]\\)\\(.+?\\)\\([,\n]\\)" + gud-marker-acc gdbmi-bnf-offset)) + + (let ((token (match-string 1 gud-marker-acc)) + (prefix (match-string 2 gud-marker-acc)) + (class (match-string 3 gud-marker-acc)) + (complete (string-equal (match-string 4 gud-marker-acc) "\n")) + class-alist + class-command) + + (setq gdbmi-bnf-offset (match-end 0)) + (if gdbmi-debug-mode (message "gdbmi-bnf-result-record: %s" + (match-string 0 gud-marker-acc))) + + (setq class-alist + (cdr (assoc prefix gdbmi-bnf-result-state-configs))) + (setq class-command (cdr (assoc class class-alist))) + (if (null class-command) + (setq class-command (cdr (assoc 'default class-alist)))) + + (if complete + (if class-command + (if (equal (cdr class-command) 'progressive) + (funcall (car class-command) token "" complete) + (funcall (car class-command) token ""))) + (setq gdbmi-bnf-state + (lambda () + (gdbmi-bnf-incomplete-record-result token class-command))) + (funcall gdbmi-bnf-state)) + t)))) + +(defun gdbmi-bnf-incomplete-record-result (token class-command) + "State of the parser used to progressively parse a result-record or async-record +rule from an incomplete data stream. The parser will stay in this state until +the end of the current result or async record is reached." + (when (< gdbmi-bnf-offset (length gud-marker-acc)) + ;; Search the data stream for the end of the current record: + (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset)) + (is-progressive (equal (cdr class-command) 'progressive)) + (is-complete (not (null newline-pos))) + result-str) + + (when gdbmi-debug-mode + (message "gdbmi-bnf-incomplete-record-result: %s" + (substring gud-marker-acc gdbmi-bnf-offset newline-pos))) + + ;; Update the gdbmi-bnf-offset only if the current chunk of data can + ;; be processed by the class-command handler: + (when (or is-complete is-progressive) + (setq result-str + (substring gud-marker-acc gdbmi-bnf-offset newline-pos)) + + ;; Move gdbmi-bnf-offset past the end of the chunk. + (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str))) + (when newline-pos + (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset)))) + + ;; Update the parsing state before invoking the handler in class-command + ;; to make sure it's not left in an invalid state if the handler was + ;; to generate an error. + (if is-complete + (setq gdbmi-bnf-state 'gdbmi-bnf-output)) + + (if class-command + (if is-progressive + (funcall (car class-command) token result-str is-complete) + (if is-complete + (funcall (car class-command) token result-str)))) + + (unless is-complete + ;; Incomplete gdb response: abort parsing until we receive more data. + (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result, aborting: incomplete stream")) + (throw 'gdbmi-incomplete-stream nil)) + + is-complete))) + + +; The following grammar rules are not yet implemented by this GDBMI-BNF parser. +; The handling of those rules is currently done by the handlers registered +; in gdbmi-bnf-result-state-configs +; +; result ==> +; variable "=" value +; +; variable ==> +; string +; +; value ==> +; const | tuple | list +; +; const ==> +; c-string +; +; tuple ==> +; "{}" | "{" result ( "," result )* "}" +; +; list ==> +; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]" + (defun gud-gdbmi-marker-filter (string) "Filter GDB/MI output." @@ -1907,46 +2321,20 @@ is running." ;; Start accumulating output for the GUD buffer. (setq gdb-filter-output "") - (let (output-record-list) - ;; Process all the complete markers in this chunk. - (dolist (gdbmi-record gdbmi-record-list) - (while (string-match (cdr gdbmi-record) gud-marker-acc) - (push (list (match-beginning 0) - (car gdbmi-record) - (match-string 1 gud-marker-acc) - (match-string 2 gud-marker-acc) - (match-end 0)) - output-record-list) - (setq gud-marker-acc - (concat (substring gud-marker-acc 0 (match-beginning 0)) - ;; Pad with spaces to preserve position. - (make-string (length (match-string 0 gud-marker-acc)) 32) - (substring gud-marker-acc (match-end 0)))))) + (let ((acc-length (length gud-marker-acc))) + (catch 'gdbmi-incomplete-stream + (while (and (< gdbmi-bnf-offset acc-length) + (funcall gdbmi-bnf-state))))) - (setq output-record-list (sort output-record-list 'gdb-car<)) + (when (/= gdbmi-bnf-offset 0) + (setq gud-marker-acc (substring gud-marker-acc gdbmi-bnf-offset)) + (setq gdbmi-bnf-offset 0)) - (dolist (output-record output-record-list) - (let ((record-type (cadr output-record)) - (arg1 (nth 2 output-record)) - (arg2 (nth 3 output-record))) - (cond ((eq record-type 'gdb-error) - (gdb-done-or-error arg2 arg1 'error)) - ((eq record-type 'gdb-done) - (gdb-done-or-error arg2 arg1 'done)) - ;; Suppress "No registers." GDB 6.8 and earlier - ;; duplicates MI error message on internal stream. - ;; Don't print to GUD buffer. - ((not (and (eq record-type 'gdb-internals) - (string-equal (read arg1) "No registers.\n"))) - (funcall record-type arg1))))) + (when (and gdbmi-debug-mode (> (length gud-marker-acc) 0)) + (message "gud-gdbmi-marker-filter, unparsed string: %s" gud-marker-acc)) - (setq gdb-output-sink 'user) - ;; Remove padding. - (string-match "^ *" gud-marker-acc) - (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) - - gdb-filter-output)) + gdb-filter-output) (defun gdb-gdb (_output-field)) @@ -1954,24 +2342,24 @@ is running." (setq gdb-filter-output (concat output-field gdb-filter-output))) -(defun gdb-ignored-notification (_output-field)) +(defun gdb-ignored-notification (_token _output-field)) ;; gdb-invalidate-threads is defined to accept 'update-threads signal -(defun gdb-thread-created (_output-field)) -(defun gdb-thread-exited (output-field) - "Handle =thread-exited async record: unset `gdb-thread-number' - if current thread exited and update threads list." +(defun gdb-thread-created (_token _output-field)) +(defun gdb-thread-exited (_token output-field) + "Handle =thread-exited async record. +Unset `gdb-thread-number' if current thread exited and update threads list." (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, - ;; gdb-pending-triggers left after gdb-running disallow us to - ;; properly call -thread-info without --thread option. Thus we - ;; need to use gdb-wait-for-pending. + ;; the pending triggers in gdb-handler-list left after gdb-running + ;; disallow us to properly call -thread-info without --thread option. + ;; Thus we need to use gdb-wait-for-pending. (gdb-wait-for-pending (gdb-emit-signal gdb-buf-publisher 'update-threads)))) -(defun gdb-thread-selected (output-field) +(defun gdb-thread-selected (_token output-field) "Handler for =thread-selected MI output record. Sets `gdb-thread-number' to new id." @@ -1982,13 +2370,14 @@ Sets `gdb-thread-number' to new id." ;; by `=thread-selected` notification. `^done` causes `gdb-update` ;; as usually. Things happen to fast and second call (from ;; gdb-thread-selected handler) gets cut off by our beloved - ;; gdb-pending-triggers. - ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its - ;; body will get executed when `gdb-pending-triggers` is empty. + ;; pending triggers. + ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its + ;; body will get executed when `gdb-handler-list' if free of + ;; pending triggers. (gdb-wait-for-pending (gdb-update)))) -(defun gdb-running (output-field) +(defun gdb-running (_token output-field) (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone @@ -2003,24 +2392,19 @@ Sets `gdb-thread-number' to new id." (propertize gdb-inferior-status 'face font-lock-type-face)) (when (not gdb-non-stop) (setq gud-running t)) - (setq gdb-active-process t) - (gdb-emit-signal gdb-buf-publisher 'update-threads)) + (setq gdb-active-process t)) -(defun gdb-starting (_output-field) +(defun gdb-starting (_output-field _result) ;; CLI commands don't emit ^running at the moment so use gdb-running too. (setq gdb-inferior-status "running") (gdb-force-mode-line-update (propertize gdb-inferior-status 'face font-lock-type-face)) (setq gdb-active-process t) - (setq gud-running t) - ;; GDB doesn't seem to respond to -thread-info before first stop or - ;; thread exit (even in non-stop mode), so this is useless. - ;; Behavior may change in the future. - (gdb-emit-signal gdb-buf-publisher 'update-threads)) + (setq gud-running t)) ;; -break-insert -t didn't give a reason before gdb 6.9 -(defun gdb-stopped (output-field) +(defun gdb-stopped (_token output-field) "Given the contents of *stopped MI async record, select new current thread and update GDB buffers." ;; Reason is available with target-async only @@ -2066,9 +2450,9 @@ current thread and update GDB buffers." (if (or (eq gdb-switch-reasons t) (member reason gdb-switch-reasons)) (when (not (string-equal gdb-thread-number thread-id)) - (message (concat "Switched to thread " thread-id)) + (message "Switched to thread %s" thread-id) (gdb-setq-thread-number thread-id)) - (message (format "Thread %s stopped" thread-id))))) + (message "Thread %s stopped" thread-id)))) ;; Print "(gdb)" to GUD console (when gdb-first-done-or-error @@ -2106,7 +2490,13 @@ current thread and update GDB buffers." (setq gdb-filter-output (gdb-concat-output gdb-filter-output (read output-field)))) -(defun gdb-done-or-error (output-field token-number type) +(defun gdb-done (token-number output-field is-complete) + (gdb-done-or-error token-number 'done output-field is-complete)) + +(defun gdb-error (token-number output-field is-complete) + (gdb-done-or-error token-number 'error output-field is-complete)) + +(defun gdb-done-or-error (token-number type output-field is-complete) (if (string-equal token-number "") ;; Output from command entered by user (progn @@ -2115,21 +2505,19 @@ current thread and update GDB buffers." ;; MI error - send to minibuffer (when (eq type 'error) ;; Skip "msg=" from `output-field' - (message (read (substring output-field 4))) + (message "%s" (read (substring output-field 4))) ;; Don't send to the console twice. (If it is a console error ;; it is also in the console stream.) (setq output-field nil))) ;; Output from command from frontend. (setq gdb-output-sink 'emacs)) - (gdb-clear-partial-output) - ;; The process may already be dead (e.g. C-d at the gdb prompt). (let* ((proc (get-buffer-process gud-comint-buffer)) (no-proc (or (null proc) (memq (process-status proc) '(exit signal))))) - (when gdb-first-done-or-error + (when (and is-complete gdb-first-done-or-error) (unless (or token-number gud-running no-proc) (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) (gdb-update no-proc) @@ -2138,13 +2526,16 @@ current thread and update GDB buffers." (setq gdb-filter-output (gdb-concat-output gdb-filter-output output-field)) - (when token-number + ;; We are done concatenating to the output sink. Restore it to user sink: + (setq gdb-output-sink 'user) + + (when (and token-number is-complete) (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (funcall - (cdr (assoc (string-to-number token-number) gdb-handler-alist)))) - (setq gdb-handler-alist - (assq-delete-all token-number gdb-handler-alist))))) + (gdb-handle-reply (string-to-number token-number)))) + + (when is-complete + (gdb-clear-partial-output)))) (defun gdb-concat-output (so-far new) (cond @@ -2169,8 +2560,8 @@ Field names are wrapped in double quotes and equal signs are replaced with semicolons. If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from -partial output. This is used to get rid of useless keys in lists -in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and +partial output. This is used to get rid of useless keys in lists +in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and -break-info are examples of MI commands which issue such responses. @@ -2201,9 +2592,10 @@ incompatible with GDB/MI output syntax." (insert "]")))))) (goto-char (point-min)) (insert "{") - (while (re-search-forward - "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t) - (replace-match "\"\\1\":\\2" nil nil)) + (let ((re (concat "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|" + gdb--string-regexp "\\)"))) + (while (re-search-forward re nil t) + (replace-match "\"\\1\":\\2" nil nil))) (goto-char (point-max)) (insert "}"))) @@ -2267,20 +2659,6 @@ Return position where LINE begins." (row-properties nil) (right-align nil)) -(defun gdb-mapcar* (function &rest seqs) - "Apply FUNCTION to each element of SEQS, and make a list of the results. -If there are several SEQS, FUNCTION is called with that many -arguments, and mapping stops as soon as the shortest list runs -out." - (let ((shortest (apply #'min (mapcar #'length seqs)))) - (mapcar (lambda (i) - (apply function - (mapcar - (lambda (seq) - (nth i seq)) - seqs))) - (number-sequence 0 (1- shortest))))) - (defun gdb-table-add-row (table row &optional properties) "Add ROW of string to TABLE and recalculate column sizes. @@ -2298,7 +2676,7 @@ calling `gdb-table-string'." (setf (gdb-table-row-properties table) (append row-properties (list properties))) (setf (gdb-table-column-sizes table) - (gdb-mapcar* (lambda (x s) + (cl-mapcar (lambda (x s) (let ((new-x (max (abs x) (string-width (or s ""))))) (if right-align new-x (- new-x)))) @@ -2313,11 +2691,11 @@ calling `gdb-table-string'." (let ((column-sizes (gdb-table-column-sizes table))) (mapconcat 'identity - (gdb-mapcar* + (cl-mapcar (lambda (row properties) (apply 'propertize (mapconcat 'identity - (gdb-mapcar* (lambda (s x) (gdb-pad-string s x)) + (cl-mapcar (lambda (s x) (gdb-pad-string s x)) row column-sizes) sep) properties)) @@ -2337,16 +2715,16 @@ calling `gdb-table-string'." handler-name &optional signal-list) "Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets -HANDLER-NAME as its handler. HANDLER-NAME is bound to current +HANDLER-NAME as its handler. HANDLER-NAME is bound to current buffer with `gdb-bind-function-to-buffer'. If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the -defined trigger is called with an argument from SIGNAL-LIST. It's +defined trigger is called with an argument from SIGNAL-LIST. It's not recommended to define triggers with empty SIGNAL-LIST. Normally triggers should respond at least to 'update signal. Normally the trigger defined by this command must be called from -the buffer where HANDLER-NAME must work. This should be done so +the buffer where HANDLER-NAME must work. This should be done so that buffer-local thread number may be used in GDB-COMMAND (by calling `gdb-current-context-command'). `gdb-bind-function-to-buffer' is used to achieve this, see @@ -2359,54 +2737,51 @@ trigger argument when describing buffer types with (when (or (not ,signal-list) (memq signal ,signal-list)) - (when (not (gdb-pending-p - (cons (current-buffer) ',trigger-name))) - (gdb-input ,gdb-command - (gdb-bind-function-to-buffer ',handler-name (current-buffer))) - (gdb-add-pending (cons (current-buffer) ',trigger-name)))))) + (gdb-input ,gdb-command + (gdb-bind-function-to-buffer ',handler-name (current-buffer)) + (cons (current-buffer) ',trigger-name))))) ;; Used by disassembly buffer only, the rest use ;; def-gdb-trigger-and-handler -(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun +(defmacro def-gdb-auto-update-handler (handler-name custom-defun &optional nopreserve) - "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. + "Define a handler HANDLER-NAME calling CUSTOM-DEFUN. Handlers are normally called from the buffers they put output in. -Delete ((current-buffer) . TRIGGER-NAME) from -`gdb-pending-triggers', erase current buffer and evaluate -CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. +Erase current buffer and evaluate CUSTOM-DEFUN. +Then call `gdb-update-buffer-name'. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." `(defun ,handler-name () - (gdb-delete-pending (cons (current-buffer) ',trigger-name)) - (let* ((buffer-read-only nil) - (window (get-buffer-window (current-buffer) 0)) - (start (window-start window)) - (p (window-point window))) + (let* ((inhibit-read-only t) + ,@(unless nopreserve + '((window (get-buffer-window (current-buffer) 0)) + (start (window-start window)) + (p (window-point window))))) (erase-buffer) (,custom-defun) (gdb-update-buffer-name) - ,(when (not nopreserve) - '(set-window-start window start) - '(set-window-point window p))))) + ,@(when (not nopreserve) + '((set-window-start window start) + (set-window-point window p)))))) (defmacro def-gdb-trigger-and-handler (trigger-name gdb-command handler-name custom-defun &optional signal-list) "Define trigger and handler. -TRIGGER-NAME trigger is defined to send GDB-COMMAND. See -`def-gdb-auto-update-trigger'. +TRIGGER-NAME trigger is defined to send GDB-COMMAND. +See `def-gdb-auto-update-trigger'. -HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See -`def-gdb-auto-update-handler'." +HANDLER-NAME handler uses customization of CUSTOM-DEFUN. +See `def-gdb-auto-update-handler'." `(progn (def-gdb-auto-update-trigger ,trigger-name ,gdb-command ,handler-name ,signal-list) (def-gdb-auto-update-handler ,handler-name - ,trigger-name ,custom-defun))) + ,custom-defun))) @@ -2444,8 +2819,12 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (or (bindat-get-field breakpoint 'disp) "") (let ((flag (bindat-get-field breakpoint 'enabled))) (if (string-equal flag "y") - (propertize "y" 'font-lock-face font-lock-warning-face) - (propertize "n" 'font-lock-face font-lock-comment-face))) + (eval-when-compile + (propertize "y" 'font-lock-face + font-lock-warning-face)) + (eval-when-compile + (propertize "n" 'font-lock-face + font-lock-comment-face)))) (bindat-get-field breakpoint 'addr) (or (bindat-get-field breakpoint 'times) "") (if (and type (string-match ".*watchpoint" type)) @@ -2497,7 +2876,8 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (gdb-put-breakpoint-icon (string-equal flag "y") bptno (string-to-number line))))))))) -(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") +(defconst gdb-source-file-regexp + (concat "fullname=\\(" gdb--string-regexp "\\)")) (defun gdb-get-location (bptno line flag) "Find the directory containing the relevant source file. @@ -2506,6 +2886,7 @@ Put in buffer and place breakpoint icon." (catch 'file-not-found (if (re-search-forward gdb-source-file-regexp nil t) (delete (cons bptno "File not found") gdb-location-alist) + ;; FIXME: Why/how do we use (match-string 1) when the search failed? (push (cons bptno (match-string 1)) gdb-location-alist) (gdb-resync) (unless (assoc bptno gdb-location-alist) @@ -2583,7 +2964,7 @@ If not in a source or disassembly buffer just set point." obj) (when (numberp pos) (with-selected-window (posn-window posn) - (with-current-buffer (window-buffer (selected-window)) + (with-current-buffer (window-buffer) (goto-char pos) (dolist (overlay (overlays-in pos pos)) (when (overlay-get overlay 'put-break) @@ -2757,37 +3138,38 @@ corresponding to the mode line clicked." gdb-running-threads-count gdb-stopped-threads-count)) - (gdb-table-add-row table - (list - (bindat-get-field thread 'id) - (concat - (if gdb-thread-buffer-verbose-names - (concat (bindat-get-field thread 'target-id) " ") "") - (bindat-get-field thread 'state) - ;; Include frame information for stopped threads - (if (not running) - (concat - " in " (bindat-get-field thread 'frame 'func) - (if gdb-thread-buffer-arguments - (concat - " (" - (let ((args (bindat-get-field thread 'frame 'args))) - (mapconcat - (lambda (arg) - (apply #'format "%s=%s" - (gdb-get-many-fields arg 'name 'value))) - args ",")) - ")") - "") - (if gdb-thread-buffer-locations - (gdb-frame-location (bindat-get-field thread 'frame)) "") - (if gdb-thread-buffer-addresses - (concat " at " (bindat-get-field thread 'frame 'addr)) "")) - ""))) - (list - 'gdb-thread thread - 'mouse-face 'highlight - 'help-echo "mouse-2, RET: select thread"))) + (gdb-table-add-row + table + (list + (bindat-get-field thread 'id) + (concat + (if gdb-thread-buffer-verbose-names + (concat (bindat-get-field thread 'target-id) " ") "") + (bindat-get-field thread 'state) + ;; Include frame information for stopped threads + (if (not running) + (concat + " in " (bindat-get-field thread 'frame 'func) + (if gdb-thread-buffer-arguments + (concat + " (" + (let ((args (bindat-get-field thread 'frame 'args))) + (mapconcat + (lambda (arg) + (apply #'format "%s=%s" + (gdb-get-many-fields arg 'name 'value))) + args ",")) + ")") + "") + (if gdb-thread-buffer-locations + (gdb-frame-location (bindat-get-field thread 'frame)) "") + (if gdb-thread-buffer-addresses + (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + ""))) + (list + 'gdb-thread thread + 'mouse-face 'highlight + 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number (bindat-get-field thread 'id)) (setq marked-line (length gdb-threads-list)))) @@ -2803,8 +3185,8 @@ corresponding to the mode line clicked." "Define a NAME command which will act upon thread on the current line. CUSTOM-DEFUN may use locally bound `thread' variable, which will -be the value of 'gdb-thread property of the current line. If -'gdb-thread is nil, error is signaled." +be the value of 'gdb-thread property of the current line. +If `gdb-thread' is nil, error is signaled." `(defun ,name (&optional event) ,(when doc doc) (interactive (list last-input-event)) @@ -2888,11 +3270,16 @@ line." gud-stop-subjob "Interrupt thread at current line.") +;; Defined opaquely in M-x gdb via gud-def. +(declare-function gud-cont "gdb-mi" (arg) t) + (def-gdb-thread-buffer-gud-command gdb-continue-thread gud-cont "Continue thread at current line.") +(declare-function gud-step "gdb-mi" (arg) t) + (def-gdb-thread-buffer-gud-command gdb-step-thread gud-step @@ -2953,7 +3340,7 @@ line." (defun gdb-memory-column-width (size format) "Return length of string with memory unit of SIZE in FORMAT. -SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as +SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as in `gdb-memory-format'." (let ((format-base (cdr (assoc format '(("x" . 16) @@ -3322,7 +3709,6 @@ DOC is an optional documentation string." (def-gdb-auto-update-handler gdb-disassembly-handler - gdb-invalidate-disassembly gdb-disassembly-handler-custom t) @@ -3455,8 +3841,7 @@ DOC is an optional documentation string." (error "Not recognized as break/watchpoint line"))))) (defun gdb-goto-breakpoint (&optional event) - "Go to the location of breakpoint at current line of -breakpoints buffer." + "Go to the location of breakpoint at current line of breakpoints buffer." (interactive (list last-input-event)) (if event (posn-set-point (event-end event))) ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer. @@ -3815,21 +4200,19 @@ member." ;; Needs GDB 6.4 onwards (used to fail with no stack). (defun gdb-get-changed-registers () - (when (and (gdb-get-buffer 'gdb-registers-buffer) - (not (gdb-pending-p 'gdb-get-changed-registers))) + (when (gdb-get-buffer 'gdb-registers-buffer) (gdb-input "-data-list-changed-registers" - 'gdb-changed-registers-handler) - (gdb-add-pending 'gdb-get-changed-registers))) + 'gdb-changed-registers-handler + 'gdb-get-changed-registers))) (defun gdb-changed-registers-handler () - (gdb-delete-pending 'gdb-get-changed-registers) (setq gdb-changed-registers nil) (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () - ;; Don't use gdb-pending-triggers because this handler is called + ;; Don't use pending triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name @@ -3840,29 +4223,26 @@ member." (defun gdb-get-source-file-list () "Create list of source files for current GDB session. -If buffers already exist for any of these files, gud-minor-mode +If buffers already exist for any of these files, `gud-minor-mode' is set in them." (goto-char (point-min)) (while (re-search-forward gdb-source-file-regexp nil t) - (push (match-string 1) gdb-source-file-list)) + (push (read (match-string 1)) gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (member buffer-file-name gdb-source-file-list) (gdb-init-buffer))))) (defun gdb-get-main-selected-frame () - "Trigger for `gdb-frame-handler' which uses main current -thread. Called from `gdb-update'." - (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) - (progn - (gdb-input (gdb-current-context-command "-stack-info-frame") - 'gdb-frame-handler) - (gdb-add-pending 'gdb-get-main-selected-frame)))) + "Trigger for `gdb-frame-handler' which uses main current thread. +Called from `gdb-update'." + (gdb-input (gdb-current-context-command "-stack-info-frame") + 'gdb-frame-handler + 'gdb-get-main-selected-frame)) (defun gdb-frame-handler () - "Sets `gdb-selected-frame' and `gdb-selected-file' to show + "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (gdb-delete-pending 'gdb-get-main-selected-frame) (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) (when frame (setq gdb-selected-frame (bindat-get-field frame 'func)) @@ -3886,14 +4266,15 @@ overlay arrow in source buffer." (setq gud-overlay-arrow-position (make-marker)) (set-marker gud-overlay-arrow-position position)))))))) -(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") +(defconst gdb-prompt-name-regexp + (concat "value=\\(" gdb--string-regexp "\\)")) (defun gdb-get-prompt () "Find prompt for GDB session." (goto-char (point-min)) (setq gdb-prompt-name nil) (re-search-forward gdb-prompt-name-regexp nil t) - (setq gdb-prompt-name (match-string 1)) + (setq gdb-prompt-name (read (match-string 1))) ;; Insert first prompt. (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) @@ -3921,8 +4302,8 @@ overlay arrow in source buffer." (defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal) "Find window displaying a buffer with the same -`gdb-buffer-type' as BUF and show BUF there. If no such window -exists, just call `gdb-display-buffer' for BUF. If the window +`gdb-buffer-type' as BUF and show BUF there. If no such window +exists, just call `gdb-display-buffer' for BUF. If the window found is already dedicated, split window according to SPLIT-HORIZONTAL and show BUF in the new window." (if buf @@ -4174,7 +4555,7 @@ Kills the gdb buffers, and resets variables and the source buffers." buffers, if required." (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) - (setq gdb-main-file (match-string 1))) + (setq gdb-main-file (read (match-string 1)))) (if gdb-many-windows (gdb-setup-windows) (gdb-get-buffer-create 'gdb-breakpoints-buffer) @@ -4310,8 +4691,7 @@ CONTEXT is the text before COMMAND on the line." (gud-gdb-fetch-lines-break (length context)) (gud-gdb-fetched-lines nil) ;; This filter dumps output lines to `gud-gdb-fetched-lines'. - (gud-marker-filter #'gud-gdbmi-fetch-lines-filter) - complete-list) + (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)) (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) (gdb-input (concat "complete " context command) (lambda () (setq gud-gdb-fetch-lines-in-progress nil))) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index c3f950b5da8..23fced7ef8e 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -1,6 +1,6 @@ ;;; glasses.el --- make cantReadThis readable -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Milan Zamazal ;; Maintainer: Milan Zamazal diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 1e152c6d751..99629450c1b 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1,10 +1,10 @@ ;;; grep.el --- run `grep' and display the results -;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software +;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Roland McGrath -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: tools, processes ;; This file is part of GNU Emacs. @@ -410,7 +410,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 grep-error-face) (2 grep-error-face nil t)) - ("^.+?-[0-9]+-.*\n" (0 grep-context-face))) + ;; "filename-linenumber-" format is used for context lines in GNU grep, + ;; "filename=linenumber=" for lines with function names in "git grep -p". + ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") @@ -421,8 +423,9 @@ This variable's value takes effect when `grep-compute-defaults' is called.") ;;;###autoload (defvar find-program (purecopy "find") - "The default find program for `grep-find-command'. -This variable's value takes effect when `grep-compute-defaults' is called.") + "The default find program. +This is used by commands like `grep-find-command', `find-dired' +and others.") ;;;###autoload (defvar xargs-program (purecopy "xargs") @@ -816,13 +819,8 @@ substitution string. Note dynamic scoping of variables.") t t command)))))) (defun grep-read-regexp () - "Read regexp arg for interactive grep." - (let ((default (grep-tag-default))) - (read-regexp - (concat "Search for" - (if (and default (> (length default) 0)) - (format " (default \"%s\"): " default) ": ")) - default 'grep-regexp-history))) + "Read regexp arg for interactive grep using `read-regexp'." + (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history)) (defun grep-read-files (regexp) "Read files arg for interactive grep." @@ -993,8 +991,6 @@ to specify a command to run." (compilation-start regexp 'grep-mode)) (setq dir (file-name-as-directory (expand-file-name dir))) (require 'find-dired) ; for `find-name-arg' - ;; In Tramp, there could be problems if the command line is too - ;; long. We escape it, therefore. (let ((command (grep-expand-template grep-find-template regexp @@ -1003,7 +999,7 @@ to specify a command to run." (mapconcat #'shell-quote-argument (split-string files) - (concat "\\\n" " -o " find-name-arg " ")) + (concat " -o " find-name-arg " ")) " " (shell-quote-argument ")")) dir @@ -1024,7 +1020,7 @@ to specify a command to run." (concat "*/" (cdr ignore))))))) grep-find-ignored-directories - "\\\n -o -path ") + " -o -path ") " " (shell-quote-argument ")") " -prune -o ")) @@ -1042,7 +1038,7 @@ to specify a command to run." (shell-quote-argument (cdr ignore)))))) grep-find-ignored-files - "\\\n -o -name ") + " -o -name ") " " (shell-quote-argument ")") " -prune -o ")))))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d339495d76a..c6fc944bc13 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1,10 +1,10 @@ ;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -;; Copyright (C) 1992-1996, 1998, 2000-2013 Free Software Foundation, +;; Copyright (C) 1992-1996, 1998, 2000-2014 Free Software Foundation, ;; Inc. ;; Author: Eric S. Raymond -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: unix, tools ;; This file is part of GNU Emacs. @@ -46,11 +46,8 @@ (defvar gdb-show-changed-values) (defvar gdb-source-window) (defvar gdb-var-list) -(defvar gdb-speedbar-auto-raise) -(defvar gud-tooltip-mode) (defvar hl-line-mode) (defvar hl-line-sticky-flag) -(defvar tool-bar-map) ;; ====================================================================== @@ -70,7 +67,7 @@ pdb (Python), and jdb." :group 'gud) (global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh) -(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack +;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack (defvar gud-marker-filter nil) (put 'gud-marker-filter 'permanent-local t) @@ -324,8 +321,9 @@ Uses `gud--directories' to find the source files." (when buf ;; Copy `gud-minor-mode' to the found buffer to turn on the menu. (with-current-buffer buf - (set (make-local-variable 'gud-minor-mode) minor-mode) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (setq-local gud-minor-mode minor-mode) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map gud-tool-bar-map)) (when (and gud-tooltip-mode (eq gud-minor-mode 'gdbmi)) (make-local-variable 'gdb-define-alist) @@ -416,7 +414,7 @@ we're in the GUD buffer)." ;; ====================================================================== ;; speedbar support functions and variables. -(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer. +(eval-when-compile (require 'dframe)) ; for dframe-with-attached-buffer (defvar gud-last-speedbar-stackframe nil "Description of the currently displayed GUD stack. @@ -425,19 +423,24 @@ The value t means that there is no stack, and we are in display-file mode.") (defvar gud-speedbar-key-map nil "Keymap used when in the buffers display mode.") +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-message "dframe" (fmt &rest args)) + (defun gud-speedbar-item-info () "Display the data type of the watch expression element." (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) (if (nth 7 var) - (speedbar-message "%s: %s" (nth 7 var) (nth 3 var)) - (speedbar-message "%s" (nth 3 var))))) + (dframe-message "%s: %s" (nth 7 var) (nth 3 var)) + (dframe-message "%s" (nth 3 var))))) + +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(defvar speedbar-mode-functions-list) (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb." - (if gud-speedbar-key-map - nil + (unless gud-speedbar-key-map (setq gud-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key gud-speedbar-key-map "j" 'speedbar-edit-line) (define-key gud-speedbar-key-map "e" 'speedbar-edit-line) (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line) @@ -486,6 +489,13 @@ The value t means that there is no stack, and we are in display-file mode.") DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) +(declare-function speedbar-remove-localized-speedbar-support "speedbar" + (buffer)) +(declare-function speedbar-insert-button "speedbar" + (text face mouse function &optional token prevline)) + (defun gud-speedbar-buttons (buffer) "Create a speedbar display based on the current state of GUD. If the GUD BUFFER is not running a supported debugger, then turn @@ -707,6 +717,16 @@ The option \"--fullname\" must be included in this value." (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") +;; One of the nice features of GDB is its impressive support for +;; context-sensitive command completion. We preserve that feature +;; in the GUD buffer by using a GDB command designed just for Emacs. + +(defvar gud-gdb-completion-function nil + "Completion function for GDB commands. +It receives two arguments: COMMAND, the prefix for which we seek +completion; and CONTEXT, the text before COMMAND on the line. +It should return a list of completion strings.") + ;; If in gdb mode, gdb-mi is loaded. (declare-function gdb-restore-windows "gdb-mi" ()) @@ -767,16 +787,6 @@ directory and source-file directory for your debugger." (setq gud-filter-pending-text nil) (run-hooks 'gud-gdb-mode-hook)) -;; One of the nice features of GDB is its impressive support for -;; context-sensitive command completion. We preserve that feature -;; in the GUD buffer by using a GDB command designed just for Emacs. - -(defvar gud-gdb-completion-function nil - "Completion function for GDB commands. -It receives two arguments: COMMAND, the prefix for which we seek -completion; and CONTEXT, the text before COMMAND on the line. -It should return a list of completion strings.") - ;; The completion process filter indicates when it is finished. (defvar gud-gdb-fetch-lines-in-progress) @@ -884,9 +894,14 @@ It is passed through `gud-gdb-marker-filter' before we look at it." ;; gdb speedbar functions +;; Part of the macro expansion of dframe-with-attached-buffer. +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-select-attached-frame "dframe" (&optional frame)) +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) (sit-for 1))) @@ -1353,7 +1368,7 @@ and source-file directory for your debugger." ) ;; ====================================================================== -;; xdb (HP PARISC debugger) functions +;; xdb (HP PA-RISC debugger) functions ;; History of argument lists passed to xdb. (defvar gud-xdb-history nil) @@ -1487,14 +1502,38 @@ into one that invokes an Emacs-enabled debugging session. (let ((output "")) ;; Process all the complete markers in this chunk. - (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc) + ;; + ;; Here I match the string coming out of perldb. + ;; The strings can look like any of + ;; + ;; "\032\032/tmp/tst.pl:6:0\n" + ;; "\032\032(eval 5)[/tmp/tst.pl:6]:3:0\n" + ;; "\032\032(eval 17)[Basic/Core/Core.pm.PL (i.e. PDL::Core.pm):2931]:1:0\n" + ;; + ;; From those I want the filename and the line number. First I look for + ;; the eval case. If that doesn't match, I look for the "normal" case. + (while + (string-match + (eval-when-compile + (let ((file-re "\\(?:[a-zA-Z]:\\)?[^:\n]*")) + (concat "\032\032\\(?:" + (concat + "(eval [0-9]+)\\[" + "\\(" file-re "\\)" ; Filename. + "\\(?: (i\\.e\\. [^)]*)\\)?" + ":\\([0-9]*\\)\\]") ; Line number. + "\\|" + (concat + "\\(?1:" file-re "\\)" ; Filename. + ":\\(?2:[0-9]*\\)") ; Line number. + "\\):.*\n"))) + gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (match-string 1 gud-marker-acc) - (string-to-number (match-string 3 gud-marker-acc))) + (string-to-number (match-string 2 gud-marker-acc))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. @@ -2121,10 +2160,8 @@ relative to a classpath directory." (split-string ;; Eliminate any subclass references in the class ;; name string. These start with a "$" - ((lambda (x) - (if (string-match "$.*" x) - (replace-match "" t t x) p)) - p) + (if (string-match "$.*" p) + (replace-match "" t t p) p) "\\.") "/") ".java")) (cplist (append gud-jdb-sourcepath gud-jdb-classpath)) @@ -2444,7 +2481,8 @@ comint mode, which see." (setq mode-line-process '(":%s")) (define-key (current-local-map) "\C-c\C-l" 'gud-refresh) (set (make-local-variable 'gud-last-frame) nil) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map gud-tool-bar-map)) (make-local-variable 'comint-prompt-regexp) ;; Don't put repeated commands in command history many times. (set (make-local-variable 'comint-input-ignoredups) t) @@ -2612,6 +2650,8 @@ It is saved for when this flag is not set.") (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) (declare-function gdb-reset "gdb-mi" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new)) +(defvar speedbar-previously-used-expansion-list-name) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) @@ -2619,7 +2659,7 @@ It is saved for when this flag is not set.") ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) (set-process-buffer proc nil) - (if (and (boundp 'speedbar-frame) + (if (and (boundp 'speedbar-initial-expansion-list-name) (string-equal speedbar-initial-expansion-list-name "GUD")) (speedbar-change-initial-expansion-list speedbar-previously-used-expansion-list-name)) @@ -3242,6 +3282,8 @@ Treats actions as defuns." ;;; Customizable settings +(defvar tooltip-mode) + ;;;###autoload (define-minor-mode gud-tooltip-mode "Toggle the display of GUD tooltips. @@ -3312,6 +3354,9 @@ only tooltips in the buffer containing the overlay arrow." :group 'gud :group 'tooltip) +(make-obsolete-variable 'gud-tooltip-echo-area + "disable Tooltip mode instead" "24.4" 'set) + ;;; Reacting on mouse movements (defun gud-tooltip-change-major-mode () @@ -3363,9 +3408,6 @@ ACTIVATEP non-nil means activate mouse motion events." ;;; Tips for `gud' -(defvar gud-tooltip-original-filter nil - "Process filter to restore after GUD output has been received.") - (defvar gud-tooltip-dereference nil "Non-nil means print expressions with a `*' in front of them. For C this would dereference a pointer expression.") @@ -3396,12 +3438,13 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ; the tooltip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and ; it may be difficult to do better. Using GDB/MI as in -; gdb-mi.el gets round this problem. +; gdb-mi.el gets around this problem. (defun gud-tooltip-process-output (process output) "Process debugger output and show it in a tooltip window." - (set-process-filter process gud-tooltip-original-filter) + (remove-function (process-filter process) #'gud-tooltip-process-output) (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area tooltip-use-echo-area))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode)))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." @@ -3411,7 +3454,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ((or `xdb `pdb) (concat "p " expr)) (`sdb (concat expr "/")))) -(declare-function gdb-input "gdb-mi" (command handler)) +(declare-function gdb-input "gdb-mi" (command handler &optional trigger)) (declare-function tooltip-expr-to-print "tooltip" (event)) (declare-function tooltip-event-buffer "tooltip" (event)) @@ -3444,7 +3487,8 @@ This function must return nil if it doesn't handle EVENT." (unless (null define-elt) (tooltip-show (cdr define-elt) - (or gud-tooltip-echo-area tooltip-use-echo-area)) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode))) expr)))) (when gud-tooltip-dereference (setq expr (concat "*" expr))) @@ -3466,8 +3510,8 @@ so they have been disabled.")) (gdb-input (concat cmd "\n") `(lambda () (gdb-tooltip-print ,expr)))) - (setq gud-tooltip-original-filter (process-filter process)) - (set-process-filter process 'gud-tooltip-process-output) + (add-function :override (process-filter process) + #'gud-tooltip-process-output) (gud-basic-call cmd)) expr)))))))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index e264682edb3..9a811481f49 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1,10 +1,10 @@ ;;; hideif.el --- hides selected code within ifdef -;; Copyright (C) 1988, 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Brian Marick ;; Daniel LaLiberte -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: c, outlines ;; This file is part of GNU Emacs. @@ -35,9 +35,7 @@ ;; M-x hide-ifdefs or C-c @ h ;; ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't -;; pass through. The support of constant expressions in #if lines is -;; limited to identifiers, parens, and the operators: &&, ||, !, and -;; "defined". Please extend this. +;; pass through. Support complete C/C++ expression and precedence. ;; ;; The hidden code is marked by ellipses (...). Be ;; cautious when editing near ellipses, since the hidden text is @@ -97,6 +95,9 @@ ;; ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. ;; Extensively modified by Daniel LaLiberte (while at Gould). +;; +;; Extensively modified by Luke Lee in 2013 to support complete C expression +;; evaluation. ;;; Code: @@ -368,26 +369,44 @@ that form should be displayed.") (defvar hif-token-list) (defconst hif-token-alist - '(("||" . or) - ("&&" . and) + '(("||" . hif-or) + ("&&" . hif-and) ("|" . hif-logior) + ("^" . hif-logxor) ("&" . hif-logand) - ("==" . equal) + ("<<" . hif-shiftleft) + (">>" . hif-shiftright) + ("==" . hif-equal) + ;; Note: we include tokens like `=' which aren't supported by CPP's + ;; expression syntax, because they are still relevant for the tokenizer, + ;; especially in conjunction with ##. + ("=" . hif-assign) ("!=" . hif-notequal) - ("!" . not) - ("(" . lparen) - (")" . rparen) + ("##" . hif-token-concat) + ("!" . hif-not) + ("~" . hif-lognot) + ("(" . hif-lparen) + (")" . hif-rparen) (">" . hif-greater) ("<" . hif-less) (">=" . hif-greater-equal) ("<=" . hif-less-equal) ("+" . hif-plus) ("-" . hif-minus) + ("*" . hif-multiply) + ("/" . hif-divide) + ("%" . hif-modulo) ("?" . hif-conditional) (":" . hif-colon))) (defconst hif-token-regexp - (concat (regexp-opt (mapcar 'car hif-token-alist)) "\\|\\w+")) + (concat (regexp-opt (mapcar 'car hif-token-alist)) + "\\|0x[0-9a-fA-F]+\\.?[0-9a-fA-F]*" + "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal + "\\|\\w+")) + +(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)") + (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." @@ -401,23 +420,63 @@ that form should be displayed.") ((looking-at "\\\\\n") (forward-char 2)) + ((looking-at hif-string-literal-regexp) + (push (substring-no-properties (match-string 1)) token-list) + (goto-char (match-end 0))) ((looking-at hif-token-regexp) (let ((token (buffer-substring (point) (match-end 0)))) (goto-char (match-end 0)) ;; (message "token: %s" token) (sit-for 1) - (push (or (cdr (assoc token hif-token-alist)) - (if (string-equal token "defined") 'hif-defined) - (if (string-match "\\`[0-9]*\\'" token) - (string-to-number token)) - (intern token)) - token-list))) + (push + (or (cdr (assoc token hif-token-alist)) + (if (string-equal token "defined") 'hif-defined) + ;; TODO: + ;; 1. postfix 'l', 'll', 'ul' and 'ull' + ;; 2. floating number formats + ;; 3. hexadecimal/octal floats + ;; 4. 098 is interpreted as octal conversion error + ;; FIXME: string-to-number does not convert hex floats + (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" + token) + (string-to-number (match-string 1 token) 16)) ;; hex + ;; FIXME: string-to-number does not convert octal floats + (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token) + (string-to-number token 8)) ;; octal + (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" + token) + (string-to-number token)) ;; decimal + (intern token)) + token-list))) (t (error "Bad #if expression: %s" (buffer-string))))))) (nreverse token-list))) -;;;----------------------------------------------------------------- -;;; Translate C preprocessor #if expressions using recursive descent. -;;; This parser is limited to the operators &&, ||, !, and "defined". -;;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94 +;;------------------------------------------------------------------------ +;; Translate C preprocessor #if expressions using recursive descent. +;; This parser was limited to the operators &&, ||, !, and "defined". +;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94 +;; +;; Implement the C language operator precedence table. Add all those +;; missing operators that could be used in macros. Luke Lee 2013-09-04 + +;; | Operator Type | Operator | Associativity | +;; +----------------------+-----------------------------+---------------+ +;; | Primary Expression | () [] . -> expr++ expr-- | left-to-right | +;; | Unary Operators | * & + - ! ~ ++expr --expr | right-to-left | +;; | | (typecast) sizeof | | +;; | Binary Operators | * / % | left-to-right | +;; | | + - | | +;; | | >> << | | +;; | | < > <= >= | | +;; | | == != | | +;; | | & | | +;; | | ^ | | +;; | | | | | +;; | | && | | +;; | | || | | +;; | Ternary Operator | ?: | right-to-left | +;; x| Assignment Operators | = += -= *= /= %= >>= <<= &= | right-to-left | +;; | | ^= = | | +;; | Comma | , | left-to-right | (defsubst hif-nexttoken () "Pop the next token from token-list into the let variable \"hif-token\"." @@ -428,10 +487,24 @@ that form should be displayed.") (let ((hif-token-list token-list)) (hif-nexttoken) (prog1 - (hif-expr) + (and hif-token + (hif-exprlist)) (if hif-token ; is there still a token? (error "Error: unexpected token: %s" hif-token))))) +(defun hif-exprlist () + "Parse an exprlist: expr { ',' expr}" + (let ((result (hif-expr))) + (if (eq hif-token 'hif-comma) + (let ((temp (list result))) + (while + (progn + (hif-nexttoken) + (push (hif-expr) temp) + (eq hif-token 'hif-comma))) + (cons 'hif-comma (nreverse temp))) + result))) + (defun hif-expr () "Parse an expression as found in #if. expr : or-expr | or-expr '?' expr ':' expr." @@ -448,67 +521,125 @@ that form should be displayed.") result)) (defun hif-or-expr () - "Parse n or-expr : and-expr | or-expr '||' and-expr." + "Parse an or-expr : and-expr | or-expr '||' and-expr." (let ((result (hif-and-expr))) - (while (eq hif-token 'or) + (while (eq hif-token 'hif-or) (hif-nexttoken) (setq result (list 'hif-or result (hif-and-expr)))) result)) (defun hif-and-expr () - "Parse an and-expr : eq-expr | and-expr '&&' eq-expr." - (let ((result (hif-eq-expr))) - (while (eq hif-token 'and) + "Parse an and-expr : logior-expr | and-expr '&&' logior-expr." + (let ((result (hif-logior-expr))) + (while (eq hif-token 'hif-and) (hif-nexttoken) - (setq result (list 'hif-and result (hif-eq-expr)))) + (setq result (list 'hif-and result (hif-logior-expr)))) + result)) + +(defun hif-logior-expr () + "Parse a logor-expr : logxor-expr | logor-expr '|' logxor-expr." + (let ((result (hif-logxor-expr))) + (while (eq hif-token 'hif-logior) + (hif-nexttoken) + (setq result (list 'hif-logior result (hif-logxor-expr)))) + result)) + +(defun hif-logxor-expr () + "Parse a logxor-expr : logand-expr | logxor-expr '^' logand-expr." + (let ((result (hif-logand-expr))) + (while (eq hif-token 'hif-logxor) + (hif-nexttoken) + (setq result (list 'hif-logxor result (hif-logand-expr)))) + result)) + +(defun hif-logand-expr () + "Parse a logand-expr : eq-expr | logand-expr '&' eq-expr." + (let ((result (hif-eq-expr))) + (while (eq hif-token 'hif-logand) + (hif-nexttoken) + (setq result (list 'hif-logand result (hif-eq-expr)))) result)) (defun hif-eq-expr () - "Parse an eq-expr : math | eq-expr `=='|`!='|`<'|`>'|`>='|`<=' math." - (let ((result (hif-math)) + "Parse an eq-expr : comp | eq-expr `=='|`!=' comp." + (let ((result (hif-comp-expr)) (eq-token nil)) - (while (memq hif-token '(equal hif-notequal hif-greater hif-less - hif-greater-equal hif-less-equal)) + (while (memq hif-token '(hif-equal hif-notequal)) (setq eq-token hif-token) (hif-nexttoken) - (setq result (list eq-token result (hif-math)))) + (setq result (list eq-token result (hif-comp-expr)))) + result)) + +(defun hif-comp-expr () + "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift." + (let ((result (hif-logshift-expr)) + (comp-token nil)) + (while (memq hif-token '(hif-greater hif-less hif-greater-equal hif-less-equal)) + (setq comp-token hif-token) + (hif-nexttoken) + (setq result (list comp-token result (hif-logshift-expr)))) + result)) + +(defun hif-logshift-expr () + "Parse a logshift : math | logshift `<<'|`>>' math." + (let ((result (hif-math)) + (shift-token nil)) + (while (memq hif-token '(hif-shiftleft hif-shiftright)) + (setq shift-token hif-token) + (hif-nexttoken) + (setq result (list shift-token result (hif-math)))) result)) (defun hif-math () - "Parse an expression with + or - and simpler things. - math : factor | math '+|-' factor." + "Parse an expression with + or -. + math : muldiv | math '+|-' muldiv." + (let ((result (hif-muldiv-expr)) + (math-op nil)) + (while (memq hif-token '(hif-plus hif-minus)) + (setq math-op hif-token) + (hif-nexttoken) + (setq result (list math-op result (hif-muldiv-expr)))) + result)) + +(defun hif-muldiv-expr () + "Parse an expression with *,/,%. + muldiv : factor | muldiv '*|/|%' factor." (let ((result (hif-factor)) (math-op nil)) - (while (memq hif-token '(hif-plus hif-minus hif-logior hif-logand)) + (while (memq hif-token '(hif-multiply hif-divide hif-modulo)) (setq math-op hif-token) (hif-nexttoken) (setq result (list math-op result (hif-factor)))) result)) (defun hif-factor () - "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id." + "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | 'id(parmlist)' | strings | id." (cond - ((eq hif-token 'not) + ((eq hif-token 'hif-not) (hif-nexttoken) (list 'hif-not (hif-factor))) - ((eq hif-token 'lparen) + ((eq hif-token 'hif-lognot) (hif-nexttoken) - (let ((result (hif-expr))) - (if (not (eq hif-token 'rparen)) + (list 'hif-lognot (hif-factor))) + + ((eq hif-token 'hif-lparen) + (hif-nexttoken) + (let ((result (hif-exprlist))) + (if (not (eq hif-token 'hif-rparen)) (error "Bad token in parenthesized expression: %s" hif-token) (hif-nexttoken) result))) ((eq hif-token 'hif-defined) (hif-nexttoken) - (let ((paren (when (eq hif-token 'lparen) (hif-nexttoken) t)) + (let ((paren (when (eq hif-token 'hif-lparen) (hif-nexttoken) t)) (ident hif-token)) - (if (memq hif-token '(or and not hif-defined lparen rparen)) + (if (memq hif-token '(or and not hif-defined hif-lparen hif-rparen)) (error "Error: unexpected token: %s" hif-token)) (when paren (hif-nexttoken) - (unless (eq hif-token 'rparen) + (unless (eq hif-token 'hif-rparen) (error "Error: expected \")\" after identifier"))) (hif-nexttoken) `(hif-defined (quote ,ident)))) @@ -541,22 +672,54 @@ that form should be displayed.") (or (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b))))) (defun hif-not (a) (zerop (hif-mathify a))) +(defun hif-lognot (a) + (lognot (hif-mathify a))) (defmacro hif-mathify-binop (fun) `(lambda (a b) ,(format "Like `%s' but treat t and nil as 1 and 0." fun) (,fun (hif-mathify a) (hif-mathify b)))) +(defun hif-shiftleft (a b) + (setq a (hif-mathify a)) + (setq b (hif-mathify b)) + (if (< a 0) + (ash a b) + (lsh a b))) + +(defun hif-shiftright (a b) + (setq a (hif-mathify a)) + (setq b (hif-mathify b)) + (if (< a 0) + (ash a (- b)) + (lsh a (- b)))) + + +(defalias 'hif-multiply (hif-mathify-binop *)) +(defalias 'hif-divide (hif-mathify-binop /)) +(defalias 'hif-modulo (hif-mathify-binop %)) (defalias 'hif-plus (hif-mathify-binop +)) (defalias 'hif-minus (hif-mathify-binop -)) +(defalias 'hif-equal (hif-mathify-binop =)) (defalias 'hif-notequal (hif-mathify-binop /=)) (defalias 'hif-greater (hif-mathify-binop >)) (defalias 'hif-less (hif-mathify-binop <)) (defalias 'hif-greater-equal (hif-mathify-binop >=)) (defalias 'hif-less-equal (hif-mathify-binop <=)) (defalias 'hif-logior (hif-mathify-binop logior)) +(defalias 'hif-logxor (hif-mathify-binop logxor)) (defalias 'hif-logand (hif-mathify-binop logand)) + +(defun hif-comma (&rest expr) + "Evaluate a list of expr, return the result of the last item" + (let ((result nil)) + (dolist (e expr) + (ignore-errors + (setq result (funcall hide-ifdef-evaluator e)))) + result)) + + ;;;----------- end of parser ----------------------- diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index fbd1ded35a0..e9349b655b0 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -1,6 +1,6 @@ -;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks +;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -*- coding: utf-8 -*- -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen ;; Dan Nicolaescu @@ -207,7 +207,7 @@ ;; Dean Andrews, Alf-Ivar Holm, Holger Bauer, Christoph Conrad, Dave Love, ;; Dirk Herrmann, Gael Marziou, Jan Djarv, Guillaume Leray, Moody Ahmad, ;; Preston F. Crow, Lars Lindberg, Reto Zimmermann, Keith Sheffield, -;; Chew Meng Kuan, Tony Lam, Pete Ware, Franois Pinard, Stefan Monnier, +;; Chew Meng Kuan, Tony Lam, Pete Ware, François Pinard, Stefan Monnier, ;; Joseph Eydelnant, Michael Ernst, Peter Heslin ;; ;; Special thanks go to Dan Nicolaescu, who reimplemented hideshow using diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 894a42811c7..88c0a011e98 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -1,6 +1,6 @@ ;;; icon.el --- mode for editing Icon code -;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989, 2001-2014 Free Software Foundation, Inc. ;; Author: Chris Smith ;; Created: 15 Feb 89 diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index fd3253880ea..39951730ab3 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -1,10 +1,10 @@ ;;; idlw-complete-structtag.el --- Completion of structure tags. -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: J.D. Smith -;; Version: 1.2 +;; Old-Version: 1.2 ;; Keywords: languages ;; Package: idlwave diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 749b0b65576..e8a950c1fae 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -1,11 +1,10 @@ ;;; idlw-help.el --- HTML Help code for IDLWAVE -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; ;; Authors: J.D. Smith ;; Carsten Dominik ;; Maintainer: J.D. Smith -;; Version: 6.1.22 ;; Package: idlwave ;; This file is part of GNU Emacs. @@ -90,16 +89,15 @@ Defaults to `browse-url-browser-function', which see." (defcustom idlwave-help-browser-generic-program browse-url-generic-program "Program to run if using `browse-url-generic-program'." :group 'idlwave-online-help - :type 'string) - -(defvar browse-url-generic-args) + :type '(choice (const nil) string)) +;; AFAICS, never used since it was introduced in 2004. (defcustom idlwave-help-browser-generic-args (if (boundp 'browse-url-generic-args) browse-url-generic-args "") "Program args to use if using `browse-url-generic-program'." :group 'idlwave-online-help - :type 'string) + :type '(repeat string)) (defcustom idlwave-help-browser-is-local nil "Whether the browser will display locally in an Emacs window. @@ -1179,7 +1177,7 @@ Useful when source code is displayed as help. See the option (if (featurep 'font-lock) (let ((major-mode 'idlwave-mode) (font-lock-verbose - (if (interactive-p) font-lock-verbose nil)) + (if (called-interactively-p 'interactive) font-lock-verbose nil)) (syntax-table (syntax-table))) (unwind-protect (progn diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index cfb20c6e238..e7bf3792e5f 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1,12 +1,11 @@ ;; idlw-shell.el --- run IDL as an inferior process of Emacs. -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Authors: J.D. Smith ;; Carsten Dominik ;; Chris Chase ;; Maintainer: J.D. Smith -;; Version: 6.1.22 ;; Keywords: processes ;; Package: idlwave @@ -1447,10 +1446,10 @@ Otherwise just move the line. Move down unless UP is non-nil." ;; Newer versions of comint.el changed the name of comint-filter to ;; comint-output-filter. -(defun idlwave-shell-comint-filter (process string) nil) -(if (fboundp 'comint-output-filter) - (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter)) - (fset 'idlwave-shell-comint-filter (symbol-function 'comint-filter))) +(defalias 'idlwave-shell-comint-filter + (if (fboundp 'comint-output-filter) + #'comint-output-filter + #'comint-filter)) (defun idlwave-shell-is-running () "Return t if the shell process is running." diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index d83291d1511..7844890c22a 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -1,10 +1,9 @@ ;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: J.D. Smith -;; Version: 6.1.22 ;; Keywords: processes ;; Package: idlwave @@ -963,7 +962,7 @@ static char * file[] = { (if (featurep 'xemacs) nil ; no action necessary, toolbar gets updated automatically ;; On Emacs, redraw the frame to make sure the Toolbar is updated. - (redraw-frame (selected-frame)))) + (redraw-frame))) (provide 'idlw-toolbar) (provide 'idlwave-toolbar) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index ab65933416b..8d4320669a1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1,6 +1,6 @@ ;; idlwave.el --- IDL editing mode for GNU Emacs -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Authors: J.D. Smith ;; Carsten Dominik @@ -27,7 +27,7 @@ ;;; Commentary: ;; IDLWAVE enables feature-rich development and interaction with IDL, -;; the Interactive Data Language. It provides a compelling, +;; the Interactive Data Language. It provides a compelling, ;; full-featured alternative to the IDLDE development environment ;; bundled with IDL. @@ -381,7 +381,7 @@ current Scan only the current buffer, but no other buffers." :type '(choice (const :tag "No buffer" nil) (const :tag "All buffers" t) - (const :tag "Current buffer only" 'current))) + (const :tag "Current buffer only" current))) (defcustom idlwave-query-shell-for-routine-info t "Non-nil means query the shell for info about compiled routines. @@ -447,8 +447,9 @@ value of `!DIR'. See also `idlwave-library-path'." ;; Configuration files (defcustom idlwave-config-directory - (convert-standard-filename "~/.idlwave") + (locate-user-emacs-file "idlwave" ".idlwave") "Directory for configuration files and user-library catalog." + :version "24.4" ; added locate-user-emacs-file :group 'idlwave-routine-info :type 'file) @@ -776,7 +777,7 @@ spaces are left unchanged." :type '(choice (const :tag "Pad like assignments" t) (const :tag "Remove space near `='" nil) - (const :tag "Keep space near `='" 'keep))) + (other :tag "Keep space near `='" keep))) (defcustom idlwave-show-block t "Non-nil means point blinks to block beginning for `idlwave-show-begin'." @@ -5078,11 +5079,14 @@ Cache to disk for quick recovery." ;; The sequence here is important because earlier definitions shadow ;; later ones. We assume that if things in the buffers are newer ;; then in the shell of the system, they are meant to be different. - (setcdr idlwave-last-system-routine-info-cons-cell - (append idlwave-buffer-routines - idlwave-compiled-routines - idlwave-library-catalog-routines - idlwave-user-catalog-routines)) + (let ((temp (append idlwave-buffer-routines + idlwave-compiled-routines + idlwave-library-catalog-routines + idlwave-user-catalog-routines))) + ;; Not actually used for anything? + (if idlwave-last-system-routine-info-cons-cell + (setcdr idlwave-last-system-routine-info-cons-cell temp) + (setq idlwave-last-system-routine-info-cons-cell (cons temp nil)))) (setq idlwave-class-alist nil) ;; Give a message with information about the number of routines we have. @@ -5481,30 +5485,21 @@ directories and save the routine info. (message "Creating user catalog file...") (kill-buffer "*idlwave-scan.pro*") (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) - (let ((font-lock-maximum-size 0) - (auto-mode-alist nil)) - (find-file idlwave-user-catalog-file)) - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-mode 0)) - (erase-buffer) - (insert ";; IDLWAVE user catalog file\n") - (insert (format ";; Created %s\n\n" (current-time-string))) + (with-temp-buffer + (insert ";; IDLWAVE user catalog file\n") + (insert (format ";; Created %s\n\n" (current-time-string))) - ;; Define the routine info list - (insert "\n(setq idlwave-user-catalog-routines\n '(") - (let ((standard-output (current-buffer))) - (mapc (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-user-catalog-routines)) - (insert (format "))\n\n;;; %s ends here\n" - (file-name-nondirectory idlwave-user-catalog-file))) - (goto-char (point-min)) - ;; Save the buffer - (save-buffer 0) - (kill-buffer (current-buffer))) + ;; Define the routine info list + (insert "\n(setq idlwave-user-catalog-routines\n '(") + (let ((standard-output (current-buffer))) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-user-catalog-routines)) + (insert (format "))\n\n;;; %s ends here\n" + (file-name-nondirectory idlwave-user-catalog-file))) + (write-region nil nil idlwave-user-catalog-file))) (message "Creating user catalog file...done") (message "Info for %d routines saved in %s" (length idlwave-user-catalog-routines) @@ -5522,31 +5517,23 @@ directories and save the routine info. (defun idlwave-write-paths () (interactive) (when (and idlwave-path-alist idlwave-system-directory) - (let ((font-lock-maximum-size 0) - (auto-mode-alist nil)) - (find-file idlwave-path-file)) - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-mode 0)) - (erase-buffer) - (insert ";; IDLWAVE paths\n") - (insert (format ";; Created %s\n\n" (current-time-string))) + (with-temp-buffer + (insert ";; IDLWAVE paths\n") + (insert (format ";; Created %s\n\n" (current-time-string))) ;; Define the variable which knows the value of "!DIR" - (insert (format "\n(setq idlwave-system-directory \"%s\")\n" - idlwave-system-directory)) - - ;; Define the variable which contains a list of all scanned directories - (insert "\n(setq idlwave-path-alist\n '(") - (let ((standard-output (current-buffer))) - (mapc (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-path-alist)) - (insert "))\n") - (save-buffer 0) - (kill-buffer (current-buffer)))) + (insert (format "\n(setq idlwave-system-directory \"%s\")\n" + idlwave-system-directory)) + ;; Define the variable which contains a list of all scanned directories + (insert "\n(setq idlwave-path-alist\n '(") + (let ((standard-output (current-buffer))) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-path-alist)) + (insert "))\n") + (write-region nil nil idlwave-path-file)))) (defun idlwave-expand-path (path &optional default-dir) ;; Expand parts of path starting with '+' recursively into directory list. @@ -9055,7 +9042,7 @@ Assumes that point is at the beginning of the unit as found by ;; Here we hack func-menu.el in order to support this new mode. ;; The latest versions of func-menu.el already have this stuff in, so ;; we hack only if it is not already there. -(when (fboundp 'eval-after-load) +(when (featurep 'xemacs) (eval-after-load "func-menu" '(progn (or (assq 'idlwave-mode fume-function-name-regexp-alist) @@ -9309,6 +9296,8 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." (with-current-buffer "*Help*" (setq truncate-lines t))) +(declare-function speedbar-add-supported-extension "speedbar" (extension)) + ;; Add .pro files to speedbar for support, if it's loaded (eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro")) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index d73e9489d7c..5419a6dbdb8 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -1,6 +1,6 @@ ;;; inf-lisp.el --- an inferior-lisp mode -;; Copyright (C) 1988, 1993-1994, 2001-2013 Free Software Foundation, +;; Copyright (C) 1988, 1993-1994, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Olin Shivers @@ -91,6 +91,21 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (define-key map "\C-c\C-v" 'lisp-show-variable-documentation) map)) +(easy-menu-define + inferior-lisp-menu + inferior-lisp-mode-map + "Inferior Lisp Menu" + '("Inf-Lisp" + ["Eval Last Sexp" lisp-eval-last-sexp t] + "--" + ["Load File..." lisp-load-file t] + ["Compile File..." lisp-compile-file t] + "--" + ["Show Arglist..." lisp-show-arglist t] + ["Describe Symbol..." lisp-describe-sym t] + ["Show Documentation for Function..." lisp-show-function-documentation t] + ["Show Documentation for Variable..." lisp-show-variable-documentation t])) + ;;; These commands augment Lisp mode, so you can process Lisp code in ;;; the source files. (define-key lisp-mode-map "\M-\C-x" 'lisp-eval-defun) ; Gnu convention diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4aa1ac270d5..cc9ee8fe67b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1,6 +1,6 @@ ;;; js.el --- Major mode for editing JavaScript -*- lexical-binding: t -*- -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: Karl Landstrom ;; Daniel Colascione @@ -55,7 +55,6 @@ (eval-when-compile (require 'cl-lib) - (require 'comint) (require 'ido)) (defvar inferior-moz-buffer) @@ -460,12 +459,13 @@ The value must be no less than minus `js-indent-level'." :group 'js :version "24.1") -(defcustom js-auto-indent-flag t - "Whether to automatically indent when typing punctuation characters. -If non-nil, the characters {}();,: also indent the current line -in Javascript mode." - :type 'boolean - :group 'js) +(defcustom js-switch-indent-offset 0 + "Number of additional spaces for indenting the contents of a switch block. +The value must not be negative." + :type 'integer + :safe 'integerp + :group 'js + :version "24.4") (defcustom js-flat-functions nil "Treat nested functions as top-level functions in `js-mode'. @@ -1750,8 +1750,8 @@ nil." (when (save-excursion (and (not (eq (point-at-bol) (point-min))) (not (looking-at "[{]")) + (js--re-search-backward "[[:graph:]]" nil t) (progn - (js--re-search-backward "[[:graph:]]" nil t) (or (eobp) (forward-char)) (when (= (char-before) ?\)) (backward-list)) (skip-syntax-backward " ") @@ -1767,6 +1767,10 @@ nil." (list (cons 'c js-comment-lineup-func)))) (c-get-syntactic-indentation (list (cons symbol anchor))))) +(defun js--same-line (pos) + (and (>= pos (point-at-bol)) + (<= pos (point-at-eol)))) + (defun js--multi-line-declaration-indentation () "Helper function for `js--proper-indentation'. Return the proper indentation of the current line if it belongs to a declaration @@ -1785,12 +1789,11 @@ statement spanning multiple lines; otherwise, return nil." (or (eq (char-before) ?,) (and (not (eq (char-before) ?\;)) (prog2 - (skip-chars-backward "[[:punct:]]") + (skip-syntax-backward ".") (looking-at js--indent-operator-re) (js--backward-syntactic-ws)) (not (eq (char-before) ?\;))) - (and (>= pos (point-at-bol)) - (<= pos (point-at-eol))))))) + (js--same-line pos))))) (condition-case nil (backward-sexp) (scan-error (setq at-opening-bracket t)))) @@ -1798,23 +1801,68 @@ statement spanning multiple lines; otherwise, return nil." (goto-char (match-end 0)) (1+ (current-column))))))) +(defun js--indent-in-array-comp (bracket) + "Return non-nil if we think we're in an array comprehension. +In particular, return the buffer position of the first `for' kwd." + (let ((end (point))) + (save-excursion + (goto-char bracket) + (when (looking-at "\\[") + (forward-char 1) + (js--forward-syntactic-ws) + (if (looking-at "[[{]") + (let (forward-sexp-function) ; Use Lisp version. + (forward-sexp) ; Skip destructuring form. + (js--forward-syntactic-ws) + (if (and (/= (char-after) ?,) ; Regular array. + (looking-at "for")) + (match-beginning 0))) + ;; To skip arbitrary expressions we need the parser, + ;; so we'll just guess at it. + (if (and (> end (point)) ; Not empty literal. + (re-search-forward "[^,]]* \\(for\\) " end t) + ;; Not inside comment or string literal. + (not (nth 8 (parse-partial-sexp bracket (point))))) + (match-beginning 1))))))) + +(defun js--array-comp-indentation (bracket for-kwd) + (if (js--same-line for-kwd) + ;; First continuation line. + (save-excursion + (goto-char bracket) + (forward-char 1) + (skip-chars-forward " \t") + (current-column)) + (save-excursion + (goto-char for-kwd) + (current-column)))) + (defun js--proper-indentation (parse-status) "Return the proper indentation for the current line." (save-excursion (back-to-indentation) - (cond ((nth 4 parse-status) + (cond ((nth 4 parse-status) ; inside comment (js--get-c-offset 'c (nth 8 parse-status))) - ((nth 8 parse-status) 0) ; inside string - ((js--ctrl-statement-indentation)) - ((js--multi-line-declaration-indentation)) + ((nth 3 parse-status) 0) ; inside string ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) + ;; Indent array comprehension continuation lines specially. + ((let ((bracket (nth 1 parse-status)) + beg) + (and bracket + (not (js--same-line bracket)) + (setq beg (js--indent-in-array-comp bracket)) + ;; At or after the first loop? + (>= (point) beg) + (js--array-comp-indentation bracket beg)))) + ((js--ctrl-statement-indentation)) + ((js--multi-line-declaration-indentation)) ((nth 1 parse-status) ;; A single closing paren/bracket should be indented at the ;; same level as the opening statement. Same goes for ;; "case" and "default". - (let ((same-indent-p (looking-at - "[]})]\\|\\_\\|\\_")) + (let ((same-indent-p (looking-at "[]})]")) + (switch-keyword-p (looking-at "default\\_>\\|case\\_>[^:]")) (continued-expr-p (js--continued-expression-p))) (goto-char (nth 1 parse-status)) ; go to the opening char (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") @@ -1822,17 +1870,26 @@ statement spanning multiple lines; otherwise, return nil." (skip-syntax-backward " ") (when (eq (char-before) ?\)) (backward-list)) (back-to-indentation) - (cond (same-indent-p - (current-column)) - (continued-expr-p - (+ (current-column) (* 2 js-indent-level) - js-expr-indent-offset)) - (t - (+ (current-column) js-indent-level - (pcase (char-after (nth 1 parse-status)) - (?\( js-paren-indent-offset) - (?\[ js-square-indent-offset) - (?\{ js-curly-indent-offset)))))) + (let* ((in-switch-p (unless same-indent-p + (looking-at "\\_"))) + (same-indent-p (or same-indent-p + (and switch-keyword-p + in-switch-p))) + (indent + (cond (same-indent-p + (current-column)) + (continued-expr-p + (+ (current-column) (* 2 js-indent-level) + js-expr-indent-offset)) + (t + (+ (current-column) js-indent-level + (pcase (char-after (nth 1 parse-status)) + (?\( js-paren-indent-offset) + (?\[ js-square-indent-offset) + (?\{ js-curly-indent-offset))))))) + (if in-switch-p + (+ indent js-switch-indent-offset) + indent))) ;; If there is something following the opening ;; paren/bracket, everything else should be indented at ;; the same level. @@ -1848,13 +1905,11 @@ statement spanning multiple lines; otherwise, return nil." (defun js-indent-line () "Indent the current line as JavaScript." (interactive) - (save-restriction - (widen) - (let* ((parse-status - (save-excursion (syntax-ppss (point-at-bol)))) - (offset (- (current-column) (current-indentation)))) - (indent-line-to (js--proper-indentation parse-status)) - (when (> offset 0) (forward-char offset))))) + (let* ((parse-status + (save-excursion (syntax-ppss (point-at-bol)))) + (offset (- (current-column) (current-indentation)))) + (indent-line-to (js--proper-indentation parse-status)) + (when (> offset 0) (forward-char offset)))) ;;; Filling @@ -2217,6 +2272,9 @@ marker." (defvar find-tag-marker-ring) ; etags +;; etags loads ring. +(declare-function ring-insert "ring" (ring item)) + (defun js-find-symbol (&optional arg) "Read a JavaScript symbol and jump to it. With a prefix argument, restrict symbols to those from the @@ -2242,11 +2300,8 @@ current buffer. Pushes a mark onto the tag ring just like ;;; MozRepl integration -(put 'js-moz-bad-rpc 'error-conditions '(error timeout)) -(put 'js-moz-bad-rpc 'error-message "Mozilla RPC Error") - -(put 'js-js-error 'error-conditions '(error js-error)) -(put 'js-js-error 'error-message "Javascript Error") +(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) +(define-error 'js-js-error "Javascript Error") ;; '(js-error error)) (defun js--wait-for-matching-output (process regexp timeout &optional start) @@ -2639,6 +2694,11 @@ with `js--js-encode-value'." ;; order to catch a prompt that's only partially arrived (save-excursion (forward-line 0) (point)))) +;; Presumably "inferior-moz-process" loads comint. +(declare-function comint-send-string "comint" (process string)) +(declare-function comint-send-input "comint" + (&optional no-newline artificial)) + (defun js--js-enter-repl () (inferior-moz-process) ; called for side-effect (with-current-buffer inferior-moz-buffer @@ -2697,6 +2757,10 @@ with `js--js-encode-value'." (defsubst js--js-true (value) (not (js--js-not value))) +;; The somewhat complex code layout confuses the byte-compiler into +;; thinking this function "might not be defined at runtime". +(declare-function js--optimize-arglist "js" (arglist)) + (eval-and-compile (defun js--optimize-arglist (arglist) "Convert immediate js< and js! references to deferred ones." @@ -2824,6 +2888,8 @@ If nil, the whole Array is treated as a JS symbol.") (`error (signal 'js-js-error (list (cl-second result)))) (x (error "Unmatched case in js--js-decode-retval: %S" x)))) +(defvar comint-last-input-end) + (defun js--js-funcall (function &rest arguments) "Call the Mozilla function FUNCTION with arguments ARGUMENTS. If function is a string, look it up as a property on the global @@ -2996,6 +3062,8 @@ left-to-right." (defvar js-read-tab-history nil) +(declare-function ido-chop "ido" (items elem)) + (defun js--read-tab (prompt) "Read a Mozilla tab with prompt PROMPT. Return a cons of (TYPE . OBJECT). TYPE is either 'window or diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 34d1525bbab..430dd5facf7 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -1,6 +1,6 @@ ;;; ld-script.el --- GNU linker script editing mode for Emacs -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: Masatake YAMATO ;; Keywords: languages, faces @@ -48,7 +48,7 @@ (modify-syntax-entry ?\) ")(" st) (modify-syntax-entry ?\[ "(]" st) (modify-syntax-entry ?\] ")[" st) - (modify-syntax-entry ?_ "w" st) + (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?. "_" st) (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?: "." st) @@ -154,10 +154,10 @@ (defvar ld-script-font-lock-keywords (append - `((,(regexp-opt ld-script-keywords 'words) - 1 font-lock-keyword-face) - (,(regexp-opt ld-script-builtins 'words) - 1 font-lock-builtin-face) + `((,(concat "\\_<" (regexp-opt ld-script-keywords) "\\_>") + 0 font-lock-keyword-face) + (,(concat "\\_<" (regexp-opt ld-script-builtins) "\\_>") + 0 font-lock-builtin-face) ;; 3.6.7 Output Section Discarding ;; 3.6.4.1 Input Section Basics ;; 3.6.8.7 Output Section Phdr diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 0641fc776de..b795b35a8ea 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -1,6 +1,6 @@ ;;; m4-mode.el --- m4 code editing commands for Emacs -;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Andrew Csillag ;; Maintainer: Andrew Csillag @@ -45,15 +45,10 @@ :prefix "m4-" :group 'languages) -(defcustom m4-program - (cond - ((file-exists-p "/usr/local/bin/m4") "/usr/local/bin/m4") - ((file-exists-p "/usr/bin/m4") "/usr/bin/m4") - ((file-exists-p "/bin/m4") "/bin/m4") - ((file-exists-p "/usr/ccs/bin/m4") "/usr/ccs/bin/m4") - ( t "m4") - ) - "File name of the m4 executable." +(defcustom m4-program "m4" + "File name of the m4 executable. +If m4 is not in your PATH, set this to an absolute file name." + :version "24.4" :type 'file :group 'm4) @@ -85,19 +80,24 @@ :group 'm4) ;;this may still need some work -(defvar m4-mode-syntax-table nil +(defvar m4-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?` "('" table) + (modify-syntax-entry ?' ")`" table) + (modify-syntax-entry ?# "<\n" table) + (modify-syntax-entry ?\n ">#" table) + (modify-syntax-entry ?{ "_" table) + (modify-syntax-entry ?} "_" table) + ;; FIXME: This symbol syntax for underscore looks OK on its own, but it's + ;; odd that it should have the same syntax as { and } are these really + ;; valid in m4 symbols? + (modify-syntax-entry ?_ "_" table) + ;; FIXME: These three chars with word syntax look wrong. + (modify-syntax-entry ?* "w" table) + (modify-syntax-entry ?\" "w" table) + (modify-syntax-entry ?\" "w" table) + table) "Syntax table used while in `m4-mode'.") -(setq m4-mode-syntax-table (make-syntax-table)) -(modify-syntax-entry ?` "('" m4-mode-syntax-table) -(modify-syntax-entry ?' ")`" m4-mode-syntax-table) -(modify-syntax-entry ?# "<\n" m4-mode-syntax-table) -(modify-syntax-entry ?\n ">#" m4-mode-syntax-table) -(modify-syntax-entry ?{ "_" m4-mode-syntax-table) -(modify-syntax-entry ?} "_" m4-mode-syntax-table) -(modify-syntax-entry ?* "w" m4-mode-syntax-table) -(modify-syntax-entry ?_ "w" m4-mode-syntax-table) -(modify-syntax-entry ?\" "w" m4-mode-syntax-table) -(modify-syntax-entry ?\" "w" m4-mode-syntax-table) (defvar m4-mode-map (let ((map (make-sparse-keymap)) @@ -117,12 +117,6 @@ :help "Send contents of the current region to m4")) map)) -(defvar m4-mode-abbrev-table nil - "Abbrev table used while in `m4-mode'.") - -(unless m4-mode-abbrev-table - (define-abbrev-table 'm4-mode-abbrev-table ())) - (defun m4-m4-buffer () "Send contents of the current buffer to m4." (interactive) @@ -151,7 +145,6 @@ ;;;###autoload (define-derived-mode m4-mode prog-mode "m4" "A major mode to edit m4 macro files." - :abbrev-table m4-mode-abbrev-table (setq-local comment-start "#") (setq-local parse-sexp-ignore-comments t) (setq-local add-log-current-defun-function #'m4-current-defun-name) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 20673866bc4..30d9f459bde 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1,10 +1,10 @@ ;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1992, 1994, 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1994, 1999-2014 Free Software Foundation, Inc. ;; Author: Thomas Neumann ;; Eric S. Raymond -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Adapted-By: ESR ;; Keywords: unix, tools @@ -241,7 +241,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"." "List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a \".\" at the beginning of a line in `makefile-mode'." - :type '(repeat (list string)) + :type '(repeat string) :group 'makefile) (put 'makefile-special-targets-list 'risky-local-variable t) @@ -712,7 +712,9 @@ The function must satisfy this calling convention: (modify-syntax-entry ?\` "\" " st) (modify-syntax-entry ?# "< " st) (modify-syntax-entry ?\n "> " st) - st)) + (modify-syntax-entry ?= "." st) + st) + "Syntax table used in `makefile-mode'.") (defvar makefile-imake-mode-syntax-table (let ((st (make-syntax-table makefile-mode-syntax-table))) @@ -1298,7 +1300,8 @@ Fill comments, backslashed lines, and variable definitions specially." (point)))) (end (save-excursion - (while (= (preceding-char) ?\\) + (while (and (= (preceding-char) ?\\) + (not (eobp))) (end-of-line 2)) (point)))) (save-restriction diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el index e472b0cc530..01396c36e60 100644 --- a/lisp/progmodes/mantemp.el +++ b/lisp/progmodes/mantemp.el @@ -1,6 +1,6 @@ ;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output -;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2014 Free Software Foundation, Inc. ;; Author: Tom Houlder ;; Created: 10 Dec 1996 diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index b090435ac9b..3171867e3aa 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -1,6 +1,6 @@ ;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*- -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Ulrik Vieth ;; Version: 1.0 @@ -794,6 +794,7 @@ The environment marked is the one that contains point or follows point." (defvar meta-common-mode-syntax-table (let ((st (make-syntax-table))) + ;; FIXME: This goes against the convention! ;; underscores are word constituents (modify-syntax-entry ?_ "w" st) ;; miscellaneous non-word symbols diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 8814cdbba35..f8b497ef8f9 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1,6 +1,6 @@ ;;; mixal-mode.el --- Major mode for the mix asm language. -;; Copyright (C) 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2003-2014 Free Software Foundation, Inc. ;; Author: Pieter E.J. Pareit ;; Maintainer: Pieter E.J. Pareit @@ -1113,8 +1113,10 @@ Assumes that file has been compiled with debugging support." mixal-syntax-propertize-function) ;; might add an indent function in the future ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) - (set (make-local-variable 'compile-command) (concat "mixasm " - buffer-file-name))) + (set (make-local-variable 'compile-command) + (concat "mixasm " + (if buffer-file-name + (shell-quote-argument buffer-file-name))))) (provide 'mixal-mode) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index d634efebe5b..d7d0da84ed9 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -2,7 +2,7 @@ ;; Author: Michael Schmidt ;; Tom Perrine -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el deleted file mode 100644 index de7ca32befe..00000000000 --- a/lisp/progmodes/octave-inf.el +++ /dev/null @@ -1,386 +0,0 @@ -;;; octave-inf.el --- running Octave as an inferior Emacs process - -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. - -;; Author: Kurt Hornik -;; John Eaton -;; Maintainer: FSF -;; Keywords: languages -;; Package: octave-mod - -;; 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 . - -;;; Commentary: - -;;; Code: - -(require 'octave-mod) -(require 'comint) - -(defgroup octave-inferior nil - "Running Octave as an inferior Emacs process." - :group 'octave) - -(defcustom inferior-octave-program "octave" - "Program invoked by `inferior-octave'." - :type 'string - :group 'octave-inferior) - -(defcustom inferior-octave-prompt - "\\(^octave\\(\\|.bin\\|.exe\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ " - "Regexp to match prompts for the inferior Octave process." - :type 'regexp - :group 'octave-inferior) - -(defcustom inferior-octave-startup-file nil - "Name of the inferior Octave startup file. -The contents of this file are sent to the inferior Octave process on -startup." - :type '(choice (const :tag "None" nil) - file) - :group 'octave-inferior) - -(defcustom inferior-octave-startup-args nil - "List of command line arguments for the inferior Octave process. -For example, for suppressing the startup message and using `traditional' -mode, set this to (\"-q\" \"--traditional\")." - :type '(repeat string) - :group 'octave-inferior) - -(defvar inferior-octave-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map comint-mode-map) - (define-key map "\t" 'comint-dynamic-complete) - (define-key map "\M-?" 'comint-dynamic-list-filename-completions) - (define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring) - (define-key map [menu-bar inout list-history] - '("List Input History" . inferior-octave-dynamic-list-input-ring)) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-h" 'info-lookup-symbol) - map) - "Keymap used in Inferior Octave mode.") - -(defvar inferior-octave-mode-syntax-table - (let ((table (make-syntax-table octave-mode-syntax-table))) - table) - "Syntax table in use in inferior-octave-mode buffers.") - -(defcustom inferior-octave-mode-hook nil - "Hook to be run when Inferior Octave mode is started." - :type 'hook - :group 'octave-inferior) - -(defvar inferior-octave-font-lock-keywords - (list - (cons inferior-octave-prompt 'font-lock-type-face)) - ;; Could certainly do more font locking in inferior Octave ... - "Additional expressions to highlight in Inferior Octave mode.") - - -;;; Compatibility functions -(if (not (fboundp 'comint-line-beginning-position)) - ;; comint-line-beginning-position is defined in Emacs 21 - (defun comint-line-beginning-position () - "Returns the buffer position of the beginning of the line, after any prompt. -The prompt is assumed to be any text at the beginning of the line matching -the regular expression `comint-prompt-regexp', a buffer local variable." - (save-excursion (comint-bol nil) (point)))) - - -(defvar inferior-octave-output-list nil) -(defvar inferior-octave-output-string nil) -(defvar inferior-octave-receive-in-progress nil) - -(defvar inferior-octave-startup-hook nil) - -(defvar inferior-octave-complete-impossible nil - "Non-nil means that `inferior-octave-complete' is impossible.") - -(defvar inferior-octave-has-built-in-variables nil - "Non-nil means that Octave has built-in variables.") - -(defvar inferior-octave-dynamic-complete-functions - '(inferior-octave-completion-at-point comint-filename-completion) - "List of functions called to perform completion for inferior Octave. -This variable is used to initialize `comint-dynamic-complete-functions' -in the Inferior Octave buffer.") - -(defvar info-lookup-mode) - -(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" - "Major mode for interacting with an inferior Octave process. -Runs Octave as a subprocess of Emacs, with Octave I/O through an Emacs -buffer. - -Entry to this mode successively runs the hooks `comint-mode-hook' and -`inferior-octave-mode-hook'." - (setq comint-prompt-regexp inferior-octave-prompt - mode-line-process '(":%s") - local-abbrev-table octave-abbrev-table) - - (set (make-local-variable 'comment-start) octave-comment-start) - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-column) 32) - (set (make-local-variable 'comment-start-skip) octave-comment-start-skip) - - (set (make-local-variable 'font-lock-defaults) - '(inferior-octave-font-lock-keywords nil nil)) - - (set (make-local-variable 'info-lookup-mode) 'octave-mode) - - (setq comint-input-ring-file-name - (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") - comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) - (set (make-local-variable 'comint-dynamic-complete-functions) - inferior-octave-dynamic-complete-functions) - (add-hook 'comint-input-filter-functions - 'inferior-octave-directory-tracker nil t) - (comint-read-input-ring t)) - -;;;###autoload -(defun inferior-octave (&optional arg) - "Run an inferior Octave process, I/O via `inferior-octave-buffer'. -This buffer is put in Inferior Octave mode. See `inferior-octave-mode'. - -Unless ARG is non-nil, switches to this buffer. - -The elements of the list `inferior-octave-startup-args' are sent as -command line arguments to the inferior Octave process on startup. - -Additional commands to be executed on startup can be provided either in -the file specified by `inferior-octave-startup-file' or by the default -startup file, `~/.emacs-octave'." - (interactive "P") - (let ((buffer inferior-octave-buffer)) - (get-buffer-create buffer) - (if (comint-check-proc buffer) - () - (with-current-buffer buffer - (comint-mode) - (inferior-octave-startup) - (inferior-octave-mode))) - (if (not arg) - (pop-to-buffer buffer)))) - -;;;###autoload -(defalias 'run-octave 'inferior-octave) - -(defun inferior-octave-startup () - "Start an inferior Octave process." - (let ((proc (comint-exec-1 - (substring inferior-octave-buffer 1 -1) - inferior-octave-buffer - inferior-octave-program - (append (list "-i" "--no-line-editing") - inferior-octave-startup-args)))) - (set-process-filter proc 'inferior-octave-output-digest) - (setq comint-ptyp process-connection-type - inferior-octave-process proc - inferior-octave-output-list nil - inferior-octave-output-string nil - inferior-octave-receive-in-progress t) - - ;; This may look complicated ... However, we need to make sure that - ;; we additional startup code only AFTER Octave is ready (otherwise, - ;; output may be mixed up). Hence, we need to digest the Octave - ;; output to see when it issues a prompt. - (while inferior-octave-receive-in-progress - (accept-process-output inferior-octave-process)) - (goto-char (point-max)) - (set-marker (process-mark proc) (point)) - (insert-before-markers - (concat - (if (not (bobp)) " \n") - (if inferior-octave-output-list - (concat (mapconcat - 'identity inferior-octave-output-list "\n") - "\n")))) - - ;; Find out whether Octave has built-in variables. - (inferior-octave-send-list-and-digest - (list "exist \"LOADPATH\"\n")) - (setq inferior-octave-has-built-in-variables - (string-match "101$" (car inferior-octave-output-list))) - - ;; An empty secondary prompt, as e.g. obtained by '--braindead', - ;; means trouble. - (inferior-octave-send-list-and-digest (list "PS2\n")) - (if (string-match "\\(PS2\\|ans\\) = *$" (car inferior-octave-output-list)) - (inferior-octave-send-list-and-digest - (list (if inferior-octave-has-built-in-variables - "PS2 = \"> \"\n" - "PS2 (\"> \");\n")))) - - ;; O.k., now we are ready for the Inferior Octave startup commands. - (let* (commands - (program (file-name-nondirectory inferior-octave-program)) - (file (or inferior-octave-startup-file - (concat "~/.emacs-" program)))) - (setq commands - (list "more off;\n" - (if (not (string-equal - inferior-octave-output-string ">> ")) - (if inferior-octave-has-built-in-variables - "PS1=\"\\\\s> \";\n" - "PS1 (\"\\\\s> \");\n")) - (if (file-exists-p file) - (format "source (\"%s\");\n" file)))) - (inferior-octave-send-list-and-digest commands)) - (insert-before-markers - (concat - (if inferior-octave-output-list - (concat (mapconcat - 'identity inferior-octave-output-list "\n") - "\n")) - inferior-octave-output-string)) - ;; Next, we check whether Octave supports `completion_matches' ... - (inferior-octave-send-list-and-digest - (list "exist \"completion_matches\"\n")) - (setq inferior-octave-complete-impossible - (not (string-match "5$" (car inferior-octave-output-list)))) - - ;; And finally, everything is back to normal. - (set-process-filter proc 'inferior-octave-output-filter) - (run-hooks 'inferior-octave-startup-hook) - (run-hooks 'inferior-octave-startup-hook) - ;; Just in case, to be sure a cd in the startup file - ;; won't have detrimental effects. - (inferior-octave-resync-dirs))) - - -(defun inferior-octave-completion-at-point () - "Return the data to complete the Octave symbol at point." - (let* ((end (point)) - (start - (save-excursion - (skip-syntax-backward "w_" (comint-line-beginning-position)) - (point)))) - (cond ((eq start end) nil) - (inferior-octave-complete-impossible - (message (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X.")) - nil) - (t - (list - start end - (completion-table-dynamic - (lambda (command) - (inferior-octave-send-list-and-digest - (list (concat "completion_matches (\"" command "\");\n"))) - (sort (delete-dups inferior-octave-output-list) - 'string-lessp)))))))) - -(define-obsolete-function-alias 'inferior-octave-complete - 'completion-at-point "24.1") - -(defun inferior-octave-dynamic-list-input-ring () - "List the buffer's input history in a help buffer." - ;; We cannot use `comint-dynamic-list-input-ring', because it replaces - ;; "completion" by "history reference" ... - (interactive) - (if (or (not (ring-p comint-input-ring)) - (ring-empty-p comint-input-ring)) - (message "No history") - (let ((history nil) - (history-buffer " *Input History*") - (index (1- (ring-length comint-input-ring))) - (conf (current-window-configuration))) - ;; We have to build up a list ourselves from the ring vector. - (while (>= index 0) - (setq history (cons (ring-ref comint-input-ring index) history) - index (1- index))) - ;; Change "completion" to "history reference" - ;; to make the display accurate. - (with-output-to-temp-buffer history-buffer - (display-completion-list history) - (set-buffer history-buffer)) - (message "Hit space to flush") - (let ((ch (read-event))) - (if (eq ch ?\ ) - (set-window-configuration conf) - (setq unread-command-events (list ch))))))) - -(defun inferior-octave-strip-ctrl-g (string) - "Strip leading `^G' character. -If STRING starts with a `^G', ring the bell and strip it." - (if (string-match "^\a" string) - (progn - (ding) - (setq string (substring string 1)))) - string) - -(defun inferior-octave-output-filter (proc string) - "Standard output filter for the inferior Octave process. -Ring Emacs bell if process output starts with an ASCII bell, and pass -the rest to `comint-output-filter'." - (comint-output-filter proc (inferior-octave-strip-ctrl-g string))) - -(defun inferior-octave-output-digest (_proc string) - "Special output filter for the inferior Octave process. -Save all output between newlines into `inferior-octave-output-list', and -the rest to `inferior-octave-output-string'." - (setq string (concat inferior-octave-output-string string)) - (while (string-match "\n" string) - (setq inferior-octave-output-list - (append inferior-octave-output-list - (list (substring string 0 (match-beginning 0)))) - string (substring string (match-end 0)))) - (if (string-match inferior-octave-prompt string) - (setq inferior-octave-receive-in-progress nil)) - (setq inferior-octave-output-string string)) - -(defun inferior-octave-send-list-and-digest (list) - "Send LIST to the inferior Octave process and digest the output. -The elements of LIST have to be strings and are sent one by one. All -output is passed to the filter `inferior-octave-output-digest'." - (let* ((proc inferior-octave-process) - (filter (process-filter proc)) - string) - (set-process-filter proc 'inferior-octave-output-digest) - (setq inferior-octave-output-list nil) - (unwind-protect - (while (setq string (car list)) - (setq inferior-octave-output-string nil - inferior-octave-receive-in-progress t) - (comint-send-string proc string) - (while inferior-octave-receive-in-progress - (accept-process-output proc)) - (setq list (cdr list))) - (set-process-filter proc filter)))) - -(defun inferior-octave-directory-tracker (string) - "Tracks `cd' commands issued to the inferior Octave process. -Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." - (cond - ((string-match "^[ \t]*cd[ \t;]*$" string) - (cd "~")) - ((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string) - (cd (substring string (match-beginning 1) (match-end 1)))))) - -(defun inferior-octave-resync-dirs () - "Resync the buffer's idea of the current directory. -This command queries the inferior Octave process about its current -directory and makes this the current buffer's default directory." - (interactive) - (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) - (cd (car inferior-octave-output-list))) - -;;; provide ourself - -(provide 'octave-inf) - -;;; octave-inf.el ends here diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el deleted file mode 100644 index 806afe5a537..00000000000 --- a/lisp/progmodes/octave-mod.el +++ /dev/null @@ -1,1152 +0,0 @@ -;;; octave-mod.el --- editing Octave source files under Emacs - -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. - -;; Author: Kurt Hornik -;; John Eaton -;; Maintainer: FSF -;; Keywords: languages - -;; 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 . - -;;; Commentary: - -;; This package provides Emacs support for Octave. -;; It defines Octave mode, a major mode for editing -;; Octave code. - -;; The file octave-inf.el contains code for interacting with an inferior -;; Octave process using comint. - -;; See the documentation of `octave-mode' and -;; `run-octave' for further information on usage and customization. - -;;; Code: -(require 'custom) - -(defgroup octave nil - "Major mode for editing Octave source files." - :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :group 'languages) - -(defvar inferior-octave-output-list nil) -(defvar inferior-octave-output-string nil) -(defvar inferior-octave-receive-in-progress nil) - -(declare-function inferior-octave-send-list-and-digest "octave-inf" (list)) - -(defconst octave-maintainer-address - "Kurt Hornik , bug-gnu-emacs@gnu.org" - "Current maintainer of the Emacs Octave package.") - -(define-abbrev-table 'octave-abbrev-table - (mapcar (lambda (e) (append e '(nil 0 t))) - '(("`a" "all_va_args") - ("`b" "break") - ("`cs" "case") - ("`ca" "catch") - ("`c" "continue") - ("`el" "else") - ("`eli" "elseif") - ("`et" "end_try_catch") - ("`eu" "end_unwind_protect") - ("`ef" "endfor") - ("`efu" "endfunction") - ("`ei" "endif") - ("`es" "endswitch") - ("`ew" "endwhile") - ("`f" "for") - ("`fu" "function") - ("`gl" "global") - ("`gp" "gplot") - ("`gs" "gsplot") - ("`if" "if ()") - ("`o" "otherwise") - ("`rp" "replot") - ("`r" "return") - ("`s" "switch") - ("`t" "try") - ("`u" "until ()") - ("`up" "unwind_protect") - ("`upc" "unwind_protect_cleanup") - ("`w" "while ()"))) - "Abbrev table for Octave's reserved words. -Used in `octave-mode' and inferior-octave-mode buffers. -All Octave abbrevs start with a grave accent (`)." - :regexp "\\(?:[^`]\\|^\\)\\(\\(?:\\<\\|`\\)\\w+\\)\\W*") - -(defvar octave-comment-char ?# - "Character to start an Octave comment.") -(defvar octave-comment-start - (string octave-comment-char ?\s) - "String to insert to start a new Octave in-line comment.") -(defvar octave-comment-start-skip "\\s<+\\s-*" - "Regexp to match the start of an Octave comment up to its body.") - -(defvar octave-begin-keywords - '("do" "for" "function" "if" "switch" "try" "unwind_protect" "while")) -(defvar octave-else-keywords - '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup")) -(defvar octave-end-keywords - '("endfor" "endfunction" "endif" "endswitch" "end_try_catch" - "end_unwind_protect" "endwhile" "until" "end")) - -(defvar octave-reserved-words - (append octave-begin-keywords - octave-else-keywords - octave-end-keywords - '("break" "continue" "end" "global" "persistent" "return")) - "Reserved words in Octave.") - -(defvar octave-text-functions - '("casesen" "cd" "chdir" "clear" "diary" "dir" "document" "echo" - "edit_history" "format" "help" "history" "hold" - "load" "ls" "more" "run_history" "save" "type" - "which" "who" "whos") - "Text functions in Octave.") - -(defvar octave-variables - '("DEFAULT_EXEC_PATH" "DEFAULT_LOADPATH" - "EDITOR" "EXEC_PATH" "F_DUPFD" "F_GETFD" "F_GETFL" "F_SETFD" - "F_SETFL" "I" "IMAGE_PATH" "Inf" "J" - "NaN" "OCTAVE_VERSION" "O_APPEND" "O_CREAT" "O_EXCL" - "O_NONBLOCK" "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PAGER" "PS1" - "PS2" "PS4" "PWD" "SEEK_CUR" "SEEK_END" "SEEK_SET" "__F_DUPFD__" - "__F_GETFD__" "__F_GETFL__" "__F_SETFD__" "__F_SETFL__" "__I__" - "__Inf__" "__J__" "__NaN__" "__OCTAVE_VERSION__" "__O_APPEND__" - "__O_CREAT__" "__O_EXCL__" "__O_NONBLOCK__" "__O_RDONLY__" - "__O_RDWR__" "__O_TRUNC__" "__O_WRONLY__" "__PWD__" "__SEEK_CUR__" - "__SEEK_END__" "__SEEK_SET__" "__argv__" "__e__" "__eps__" - "__i__" "__inf__" "__j__" "__nan__" "__pi__" - "__program_invocation_name__" "__program_name__" "__realmax__" - "__realmin__" "__stderr__" "__stdin__" "__stdout__" "ans" "argv" - "beep_on_error" "completion_append_char" - "crash_dumps_octave_core" "default_save_format" - "e" "echo_executing_commands" "eps" - "error_text" "gnuplot_binary" "history_file" - "history_size" "ignore_function_time_stamp" - "inf" "nan" "nargin" "output_max_field_width" "output_precision" - "page_output_immediately" "page_screen_output" "pi" - "print_answer_id_name" "print_empty_dimensions" - "program_invocation_name" "program_name" - "realmax" "realmin" "return_last_computed_value" "save_precision" - "saving_history" "sighup_dumps_octave_core" "sigterm_dumps_octave_core" - "silent_functions" "split_long_rows" "stderr" "stdin" "stdout" - "string_fill_char" "struct_levels_to_print" - "suppress_verbose_help_message") - "Builtin variables in Octave.") - -(defvar octave-function-header-regexp - (concat "^\\s-*\\_<\\(function\\)\\_>" - "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") - "Regexp to match an Octave function header. -The string `function' and its name are given by the first and third -parenthetical grouping.") - -(defvar octave-font-lock-keywords - (list - ;; Fontify all builtin keywords. - (cons (concat "\\_<\\(" - (regexp-opt (append octave-reserved-words - octave-text-functions)) - "\\)\\_>") - 'font-lock-keyword-face) - ;; Fontify all builtin operators. - (cons "\\(&\\||\\|<=\\|>=\\|==\\|<\\|>\\|!=\\|!\\)" - (if (boundp 'font-lock-builtin-face) - 'font-lock-builtin-face - 'font-lock-preprocessor-face)) - ;; Fontify all builtin variables. - (cons (concat "\\_<" (regexp-opt octave-variables) "\\_>") - 'font-lock-variable-name-face) - ;; Fontify all function declarations. - (list octave-function-header-regexp - '(1 font-lock-keyword-face) - '(3 font-lock-function-name-face nil t))) - "Additional Octave expressions to highlight.") - -(defun octave-syntax-propertize-function (start end) - (goto-char start) - (octave-syntax-propertize-sqs end) - (funcall (syntax-propertize-rules - ;; Try to distinguish the string-quotes from the transpose-quotes. - ("[[({,; ]\\('\\)" - (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) - (point) end)) - -(defun octave-syntax-propertize-sqs (end) - "Propertize the content/end of single-quote strings." - (when (eq (nth 3 (syntax-ppss)) ?\') - ;; A '..' string. - (when (re-search-forward - "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) - (goto-char (match-beginning 2)) - (when (eq (char-before (match-beginning 1)) ?\\) - ;; Backslash cannot escape a single quote. - (put-text-property (1- (match-beginning 1)) (match-beginning 1) - 'syntax-table (string-to-syntax "."))) - (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "\"'"))))) - -(defcustom inferior-octave-buffer "*Inferior Octave*" - "Name of buffer for running an inferior Octave process." - :type 'string - :group 'octave-inferior) - -(defvar inferior-octave-process nil) - -(defvar octave-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "`" 'octave-abbrev-start) - (define-key map "\e\n" 'octave-indent-new-comment-line) - (define-key map "\M-\C-q" 'octave-indent-defun) - (define-key map "\C-c\C-b" 'octave-submit-bug-report) - (define-key map "\C-c\C-p" 'octave-previous-code-line) - (define-key map "\C-c\C-n" 'octave-next-code-line) - (define-key map "\C-c\C-a" 'octave-beginning-of-line) - (define-key map "\C-c\C-e" 'octave-end-of-line) - (define-key map [remap down-list] 'smie-down-list) - (define-key map "\C-c\M-\C-h" 'octave-mark-block) - (define-key map "\C-c]" 'smie-close-block) - (define-key map "\C-c/" 'smie-close-block) - (define-key map "\C-c\C-f" 'octave-insert-defun) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-h" 'info-lookup-symbol) - (define-key map "\C-c\C-il" 'octave-send-line) - (define-key map "\C-c\C-ib" 'octave-send-block) - (define-key map "\C-c\C-if" 'octave-send-defun) - (define-key map "\C-c\C-ir" 'octave-send-region) - (define-key map "\C-c\C-is" 'octave-show-process-buffer) - (define-key map "\C-c\C-ih" 'octave-hide-process-buffer) - (define-key map "\C-c\C-ik" 'octave-kill-process) - (define-key map "\C-c\C-i\C-l" 'octave-send-line) - (define-key map "\C-c\C-i\C-b" 'octave-send-block) - (define-key map "\C-c\C-i\C-f" 'octave-send-defun) - (define-key map "\C-c\C-i\C-r" 'octave-send-region) - (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-i\C-h" 'octave-hide-process-buffer) - (define-key map "\C-c\C-i\C-k" 'octave-kill-process) - map) - "Keymap used in Octave mode.") - - - -(easy-menu-define octave-mode-menu octave-mode-map - "Menu for Octave mode." - '("Octave" - ("Lines" - ["Previous Code Line" octave-previous-code-line t] - ["Next Code Line" octave-next-code-line t] - ["Begin of Continuation" octave-beginning-of-line t] - ["End of Continuation" octave-end-of-line t] - ["Split Line at Point" octave-indent-new-comment-line t]) - ("Blocks" - ["Mark Block" octave-mark-block t] - ["Close Block" smie-close-block t]) - ("Functions" - ["Indent Function" octave-indent-defun t] - ["Insert Function" octave-insert-defun t]) - "-" - ("Debug" - ["Send Current Line" octave-send-line t] - ["Send Current Block" octave-send-block t] - ["Send Current Function" octave-send-defun t] - ["Send Region" octave-send-region t] - ["Show Process Buffer" octave-show-process-buffer t] - ["Hide Process Buffer" octave-hide-process-buffer t] - ["Kill Process" octave-kill-process t]) - "-" - ["Indent Line" indent-according-to-mode t] - ["Complete Symbol" completion-at-point t] - "-" - ["Toggle Abbrev Mode" abbrev-mode - :style toggle :selected abbrev-mode] - ["Toggle Auto-Fill Mode" auto-fill-mode - :style toggle :selected auto-fill-function] - "-" - ["Submit Bug Report" octave-submit-bug-report t] - "-" - ["Describe Octave Mode" describe-mode t] - ["Lookup Octave Index" info-lookup-symbol t])) - -(defvar octave-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\r " " table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?* "." table) - (modify-syntax-entry ?/ "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?! "." table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?\' "." table) - ;; Was "w" for abbrevs, but now that it's not necessary any more, - (modify-syntax-entry ?\` "." table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?. "_" table) - (modify-syntax-entry ?_ "_" table) - ;; The "b" flag only applies to the second letter of the comstart - ;; and the first letter of the comend, i.e. the "4b" below is ineffective. - ;; If we try to put `b' on the single-line comments, we get a similar - ;; problem where the % and # chars appear as first chars of the 2-char - ;; comend, so the multi-line ender is also turned into style-b. - ;; So we need the new "c" comment style. - (modify-syntax-entry ?\% "< 13" table) - (modify-syntax-entry ?\# "< 13" table) - (modify-syntax-entry ?\{ "(} 2c" table) - (modify-syntax-entry ?\} "){ 4c" table) - (modify-syntax-entry ?\n ">" table) - table) - "Syntax table in use in `octave-mode' buffers.") - -(defcustom octave-blink-matching-block t - "Control the blinking of matching Octave block keywords. -Non-nil means show matching begin of block when inserting a space, -newline or semicolon after an else or end keyword." - :type 'boolean - :group 'octave) - -(defcustom octave-block-offset 2 - "Extra indentation applied to statements in Octave block structures." - :type 'integer - :group 'octave) - -(defvar octave-block-comment-start - (concat (make-string 2 octave-comment-char) " ") - "String to insert to start a new Octave comment on an empty line.") - -(defcustom octave-continuation-offset 4 - "Extra indentation applied to Octave continuation lines." - :type 'integer - :group 'octave) -(eval-and-compile - (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) -(defvar octave-continuation-regexp - (concat "[^#%\n]*\\(" octave-continuation-marker-regexp - "\\)\\s-*\\(\\s<.*\\)?$")) -(defcustom octave-continuation-string "\\" - "Character string used for Octave continuation lines. Normally \\." - :type 'string - :group 'octave) - -(defvar octave-completion-alist nil - "Alist of Octave symbols for completion in Octave mode. -Each element looks like (VAR . VAR), where the car and cdr are the same -symbol (an Octave command or variable name). -Currently, only builtin variables can be completed.") - -(defvar octave-mode-imenu-generic-expression - (list - ;; Functions - (list nil octave-function-header-regexp 3)) - "Imenu expression for Octave mode. See `imenu-generic-expression'.") - -(defcustom octave-mode-hook nil - "Hook to be run when Octave mode is started." - :type 'hook - :group 'octave) - -(defcustom octave-send-show-buffer t - "Non-nil means display `inferior-octave-buffer' after sending to it." - :type 'boolean - :group 'octave) -(defcustom octave-send-line-auto-forward t - "Control auto-forward after sending to the inferior Octave process. -Non-nil means always go to the next Octave code line after sending." - :type 'boolean - :group 'octave) -(defcustom octave-send-echo-input t - "Non-nil means echo input sent to the inferior Octave process." - :type 'boolean - :group 'octave) - - -;;; SMIE indentation - -(require 'smie) - -(defconst octave-operator-table - '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? - (right "=" "+=" "-=" "*=" "/=") - (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? - (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? - (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") - (nonassoc ":") ;No idea what this is. - (assoc "+" "-") - (assoc "*" "/" "\\" ".\\" ".*" "./") - (nonassoc "'" ".'") - (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". - (right "^" "**" ".^" ".**") - ;; It's not really an operator, but for indentation purposes it - ;; could be convenient to treat it as one. - (assoc "..."))) - -(defconst octave-smie-bnf-table - '((atom) - ;; We can't distinguish the first element in a sequence with - ;; precedence grammars, so we can't distinguish the condition - ;; if the `if' from the subsequent body, for example. - ;; This has to be done later in the indentation rules. - (exp (exp "\n" exp) - ;; We need to mention at least one of the operators in this part - ;; of the grammar: if the BNF and the operator table have - ;; no overlap, SMIE can't know how they relate. - (exp ";" exp) - ("try" exp "catch" exp "end_try_catch") - ("try" exp "catch" exp "end") - ("unwind_protect" exp - "unwind_protect_cleanup" exp "end_unwind_protect") - ("unwind_protect" exp "unwind_protect_cleanup" exp "end") - ("for" exp "endfor") - ("for" exp "end") - ("do" exp "until" atom) - ("while" exp "endwhile") - ("while" exp "end") - ("if" exp "endif") - ("if" exp "else" exp "endif") - ("if" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "end") - ("switch" exp "case" exp "endswitch") - ("switch" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "end") - ("function" exp "endfunction") - ("function" exp "end")) - ;; (fundesc (atom "=" atom)) - )) - -(defconst octave-smie-grammar - (smie-prec2->grammar - (smie-merge-prec2s - (smie-bnf->prec2 octave-smie-bnf-table - '((assoc "\n" ";"))) - - (smie-precs->prec2 octave-operator-table)))) - -;; Tokenizing needs to be refined so that ";;" is treated as two -;; tokens and also so as to recognize the \n separator (and -;; corresponding continuation lines). - -(defconst octave-operator-regexp - (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table)))) - -(defun octave-smie-backward-token () - (let ((pos (point))) - (forward-comment (- (point))) - (cond - ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". - (> pos (line-end-position)) - (if (looking-back octave-continuation-marker-regexp (- (point) 3)) - (progn - (goto-char (match-beginning 0)) - (forward-comment (- (point))) - nil) - t) - ;; Ignore it if it's within parentheses. - (let ((ppss (syntax-ppss))) - (not (and (nth 1 ppss) - (eq ?\( (char-after (nth 1 ppss))))))) - (skip-chars-forward " \t") - ;; Why bother distinguishing \n and ;? - ";") ;;"\n" - ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) - ;; Don't mistake a string quote for a transpose. - (not (looking-back "\\s\"" (1- (point))))) - (goto-char (match-beginning 0)) - (match-string-no-properties 0)) - (t - (smie-default-backward-token))))) - -(defun octave-smie-forward-token () - (skip-chars-forward " \t") - (when (looking-at (eval-when-compile - (concat "\\(" octave-continuation-marker-regexp - "\\)[ \t]*\\($\\|[%#]\\)"))) - (goto-char (match-end 1)) - (forward-comment 1)) - (cond - ((and (looking-at "$\\|[%#]") - ;; Ignore it if it's within parentheses. - (prog1 (let ((ppss (syntax-ppss))) - (not (and (nth 1 ppss) - (eq ?\( (char-after (nth 1 ppss)))))) - (forward-comment (point-max)))) - ;; Why bother distinguishing \n and ;? - ";") ;;"\n" - ((looking-at ";[ \t]*\\($\\|[%#]\\)") - ;; Combine the ; with the subsequent \n. - (goto-char (match-beginning 1)) - (forward-comment 1) - ";") - ((and (looking-at octave-operator-regexp) - ;; Don't mistake a string quote for a transpose. - (not (looking-at "\\s\""))) - (goto-char (match-end 0)) - (match-string-no-properties 0)) - (t - (smie-default-forward-token)))) - -(defun octave-smie-rules (kind token) - (pcase (cons kind token) - ;; We could set smie-indent-basic instead, but that would have two - ;; disadvantages: - ;; - changes to octave-block-offset wouldn't take effect immediately. - ;; - edebug wouldn't show the use of this variable. - (`(:elem . basic) octave-block-offset) - ;; Since "case" is in the same BNF rules as switch..end, SMIE by default - ;; aligns it with "switch". - (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) - (`(:after . ";") - (if (smie-rule-parent-p "function" "if" "while" "else" "elseif" "for" - "otherwise" "case" "try" "catch" "unwind_protect" - "unwind_protect_cleanup") - (smie-rule-parent octave-block-offset) - ;; For (invalid) code between switch and case. - ;; (if (smie-parent-p "switch") 4) - 0)))) - -(defvar electric-layout-rules) - -;;;###autoload -(define-derived-mode octave-mode prog-mode "Octave" - "Major mode for editing Octave code. - -This mode makes it easier to write Octave code by helping with -indentation, doing some of the typing for you (with Abbrev mode) and by -showing keywords, comments, strings, etc. in different faces (with -Font Lock mode on terminals that support it). - -Octave itself is a high-level language, primarily intended for numerical -computations. It provides a convenient command line interface for -solving linear and nonlinear problems numerically. Function definitions -can also be stored in files, and it can be used in a batch mode (which -is why you need this mode!). - -The latest released version of Octave is always available via anonymous -ftp from ftp.octave.org in the directory `/pub/octave'. Complete -source and binaries for several popular systems are available. - -Type \\[list-abbrevs] to display the built-in abbrevs for Octave keywords. - -Keybindings -=========== - -\\{octave-mode-map} - -Variables you can use to customize Octave mode -============================================== - -`octave-blink-matching-block' - Non-nil means show matching begin of block when inserting a space, - newline or semicolon after an else or end keyword. Default is t. - -`octave-block-offset' - Extra indentation applied to statements in block structures. - Default is 2. - -`octave-continuation-offset' - Extra indentation applied to Octave continuation lines. - Default is 4. - -`octave-continuation-string' - String used for Octave continuation lines. - Default is a backslash. - -`octave-send-echo-input' - Non-nil means always display `inferior-octave-buffer' after sending a - command to the inferior Octave process. - -`octave-send-line-auto-forward' - Non-nil means always go to the next unsent line of Octave code after - sending a line to the inferior Octave process. - -`octave-send-echo-input' - Non-nil means echo input sent to the inferior Octave process. - -Turning on Octave mode runs the hook `octave-mode-hook'. - -To begin using this mode for all `.m' files that you edit, add the -following lines to your init file: - - (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) - -To automatically turn on the abbrev and auto-fill features, -add the following lines to your init file as well: - - (add-hook 'octave-mode-hook - (lambda () - (abbrev-mode 1) - (auto-fill-mode 1))) - -To submit a problem report, enter \\[octave-submit-bug-report] from \ -an Octave mode buffer. -This automatically sets up a mail buffer with version information -already added. You just need to add a description of the problem, -including a reproducible test case and send the message." - (setq local-abbrev-table octave-abbrev-table) - - (smie-setup octave-smie-grammar #'octave-smie-rules - :forward-token #'octave-smie-forward-token - :backward-token #'octave-smie-backward-token) - (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) - - (set (make-local-variable 'smie-blink-matching-triggers) - (cons ?\; smie-blink-matching-triggers)) - (unless octave-blink-matching-block - (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) - - (set (make-local-variable 'electric-indent-chars) - (cons ?\; electric-indent-chars)) - ;; IIUC matlab-mode takes the opposite approach: it makes RET insert - ;; a ";" at those places where it's correct (i.e. outside of parens). - (set (make-local-variable 'electric-layout-rules) '((?\; . after))) - - (set (make-local-variable 'comment-start) octave-comment-start) - (set (make-local-variable 'comment-end) "") - ;; Don't set it here: it's not really a property of the language, - ;; just a personal preference of the author. - ;; (set (make-local-variable 'comment-column) 32) - (set (make-local-variable 'comment-start-skip) "\\s<+\\s-*") - (set (make-local-variable 'comment-add) 1) - - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'paragraph-start) - (concat "\\s-*$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'fill-paragraph-function) 'octave-fill-paragraph) - ;; FIXME: Why disable it? - ;; (set (make-local-variable 'adaptive-fill-regexp) nil) - ;; Again, this is not a property of the language, don't set it here. - ;; (set (make-local-variable 'fill-column) 72) - (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) - - (set (make-local-variable 'font-lock-defaults) - '(octave-font-lock-keywords)) - - (set (make-local-variable 'syntax-propertize-function) - #'octave-syntax-propertize-function) - - (set (make-local-variable 'imenu-generic-expression) - octave-mode-imenu-generic-expression) - (set (make-local-variable 'imenu-case-fold-search) nil) - - (add-hook 'completion-at-point-functions - 'octave-completion-at-point-function nil t) - (set (make-local-variable 'beginning-of-defun-function) - 'octave-beginning-of-defun) - - (easy-menu-add octave-mode-menu) - (octave-initialize-completions)) - -;;; Miscellaneous useful functions - -(defsubst octave-in-comment-p () - "Return t if point is inside an Octave comment." - (nth 4 (syntax-ppss))) - -(defsubst octave-in-string-p () - "Return t if point is inside an Octave string." - (nth 3 (syntax-ppss))) - -(defsubst octave-not-in-string-or-comment-p () - "Return t if point is not inside an Octave string or comment." - (let ((pps (syntax-ppss))) - (not (or (nth 3 pps) (nth 4 pps))))) - - -(defun octave-looking-at-kw (regexp) - "Like `looking-at', but sets `case-fold-search' nil." - (let ((case-fold-search nil)) - (looking-at regexp))) - -(defun octave-maybe-insert-continuation-string () - (if (or (octave-in-comment-p) - (save-excursion - (beginning-of-line) - (looking-at octave-continuation-regexp))) - nil - (delete-horizontal-space) - (insert (concat " " octave-continuation-string)))) - -;;; Indentation - -(defun octave-indent-new-comment-line () - "Break Octave line at point, continuing comment if within one. -If within code, insert `octave-continuation-string' before breaking the -line. If within a string, signal an error. -The new line is properly indented." - (interactive) - (delete-horizontal-space) - (cond - ((octave-in-comment-p) - (indent-new-comment-line)) - ((octave-in-string-p) - (error "Cannot split a code line inside a string")) - (t - (insert (concat " " octave-continuation-string)) - (reindent-then-newline-and-indent)))) - -(defun octave-indent-defun () - "Properly indent the Octave function which contains point." - (interactive) - (save-excursion - (mark-defun) - (message "Indenting function...") - (indent-region (point) (mark) nil)) - (message "Indenting function...done.")) - - -;;; Motion -(defun octave-next-code-line (&optional arg) - "Move ARG lines of Octave code forward (backward if ARG is negative). -Skips past all empty and comment lines. Default for ARG is 1. - -On success, return 0. Otherwise, go as far as possible and return -1." - (interactive "p") - (or arg (setq arg 1)) - (beginning-of-line) - (let ((n 0) - (inc (if (> arg 0) 1 -1))) - (while (and (/= arg 0) (= n 0)) - (setq n (forward-line inc)) - (while (and (= n 0) - (looking-at "\\s-*\\($\\|\\s<\\)")) - (setq n (forward-line inc))) - (setq arg (- arg inc))) - n)) - -(defun octave-previous-code-line (&optional arg) - "Move ARG lines of Octave code backward (forward if ARG is negative). -Skips past all empty and comment lines. Default for ARG is 1. - -On success, return 0. Otherwise, go as far as possible and return -1." - (interactive "p") - (or arg (setq arg 1)) - (octave-next-code-line (- arg))) - -(defun octave-beginning-of-line () - "Move point to beginning of current Octave line. -If on an empty or comment line, go to the beginning of that line. -Otherwise, move backward to the beginning of the first Octave code line -which is not inside a continuation statement, i.e., which does not -follow a code line ending in `...' or `\\', or is inside an open -parenthesis list." - (interactive) - (beginning-of-line) - (if (not (looking-at "\\s-*\\($\\|\\s<\\)")) - (while (or (condition-case nil - (progn - (up-list -1) - (beginning-of-line) - t) - (error nil)) - (and (or (looking-at "\\s-*\\($\\|\\s<\\)") - (save-excursion - (if (zerop (octave-previous-code-line)) - (looking-at octave-continuation-regexp)))) - (zerop (forward-line -1))))))) - -(defun octave-end-of-line () - "Move point to end of current Octave line. -If on an empty or comment line, go to the end of that line. -Otherwise, move forward to the end of the first Octave code line which -does not end in `...' or `\\' or is inside an open parenthesis list." - (interactive) - (end-of-line) - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*\\($\\|\\s<\\)")) - () - (while (or (condition-case nil - (progn - (up-list 1) - (end-of-line) - t) - (error nil)) - (and (save-excursion - (beginning-of-line) - (or (looking-at "\\s-*\\($\\|\\s<\\)") - (looking-at octave-continuation-regexp))) - (zerop (forward-line 1))))) - (end-of-line))) - -(defun octave-mark-block () - "Put point at the beginning of this Octave block, mark at the end. -The block marked is the one that contains point or follows point." - (interactive) - (if (and (looking-at "\\sw\\|\\s_") - (looking-back "\\sw\\|\\s_" (1- (point)))) - (skip-syntax-forward "w_")) - (unless (or (looking-at "\\s(") - (save-excursion - (let* ((token (funcall smie-forward-token-function)) - (level (assoc token smie-grammar))) - (and level (not (numberp (cadr level))))))) - (backward-up-list 1)) - (mark-sexp)) - -(defun octave-beginning-of-defun (&optional arg) - "Move backward to the beginning of an Octave function. -With positive ARG, do it that many times. Negative argument -N means -move forward to Nth following beginning of a function. -Returns t unless search stops at the beginning or end of the buffer." - (let* ((arg (or arg 1)) - (inc (if (> arg 0) 1 -1)) - (found nil) - (case-fold-search nil)) - (and (not (eobp)) - (not (and (> arg 0) (looking-at "\\_"))) - (skip-syntax-forward "w")) - (while (and (/= arg 0) - (setq found - (re-search-backward "\\_" inc))) - (if (octave-not-in-string-or-comment-p) - (setq arg (- arg inc)))) - (if found - (progn - (and (< inc 0) (goto-char (match-beginning 0))) - t)))) - - -;;; Filling -(defun octave-auto-fill () - "Perform auto-fill in Octave mode. -Returns nil if no feasible place to break the line could be found, and t -otherwise." - (let (fc give-up) - (if (or (null (setq fc (current-fill-column))) - (save-excursion - (beginning-of-line) - (and auto-fill-inhibit-regexp - (octave-looking-at-kw auto-fill-inhibit-regexp)))) - nil ; Can't do anything - (if (and (not (octave-in-comment-p)) - (> (current-column) fc)) - (setq fc (- fc (+ (length octave-continuation-string) 1)))) - (while (and (not give-up) (> (current-column) fc)) - (let* ((opoint (point)) - (fpoint - (save-excursion - (move-to-column (+ fc 1)) - (skip-chars-backward "^ \t\n") - ;; If we're at the beginning of the line, break after - ;; the first word - (if (bolp) - (re-search-forward "[ \t]" opoint t)) - ;; If we're in a comment line, don't break after the - ;; comment chars - (if (save-excursion - (skip-syntax-backward " <") - (bolp)) - (re-search-forward "[ \t]" (line-end-position) - 'move)) - ;; If we're not in a comment line and just ahead the - ;; continuation string, don't break here. - (if (and (not (octave-in-comment-p)) - (looking-at - (concat "\\s-*" - (regexp-quote - octave-continuation-string) - "\\s-*$"))) - (end-of-line)) - (skip-chars-backward " \t") - (point)))) - (if (save-excursion - (goto-char fpoint) - (not (or (bolp) (eolp)))) - (let ((prev-column (current-column))) - (if (save-excursion - (skip-chars-backward " \t") - (= (point) fpoint)) - (progn - (octave-maybe-insert-continuation-string) - (indent-new-comment-line t)) - (save-excursion - (goto-char fpoint) - (octave-maybe-insert-continuation-string) - (indent-new-comment-line t))) - (if (>= (current-column) prev-column) - (setq give-up t))) - (setq give-up t)))) - (not give-up)))) - -(defun octave-fill-paragraph (&optional _arg) - "Fill paragraph of Octave code, handling Octave comments." - ;; FIXME: difference with generic fill-paragraph: - ;; - code lines are only split, never joined. - ;; - \n that end comments are never removed. - ;; - insert continuation marker when splitting code lines. - (interactive "P") - (save-excursion - (let ((end (progn (forward-paragraph) (copy-marker (point) t))) - (beg (progn - (forward-paragraph -1) - (skip-chars-forward " \t\n") - (beginning-of-line) - (point))) - (cfc (current-fill-column)) - comment-prefix) - (goto-char beg) - (while (< (point) end) - (condition-case nil - (indent-according-to-mode) - (error nil)) - (move-to-column cfc) - ;; First check whether we need to combine non-empty comment lines - (if (and (< (current-column) cfc) - (octave-in-comment-p) - (not (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\s<+\\s-*$")))) - ;; This is a nonempty comment line which does not extend - ;; past the fill column. If it is followed by a nonempty - ;; comment line with the same comment prefix, try to - ;; combine them, and repeat this until either we reach the - ;; fill-column or there is nothing more to combine. - (progn - ;; Get the comment prefix - (save-excursion - (beginning-of-line) - (while (and (re-search-forward "\\s<+") - (not (octave-in-comment-p)))) - (setq comment-prefix (match-string 0))) - ;; And keep combining ... - (while (and (< (current-column) cfc) - (save-excursion - (forward-line 1) - (and (looking-at - (concat "^\\s-*" - comment-prefix - "\\S<")) - (not (looking-at - (concat "^\\s-*" - comment-prefix - "\\s-*$")))))) - (delete-char 1) - (re-search-forward comment-prefix) - (delete-region (match-beginning 0) (match-end 0)) - (fixup-whitespace) - (move-to-column cfc)))) - ;; We might also try to combine continued code lines> Perhaps - ;; some other time ... - (skip-chars-forward "^ \t\n") - (delete-horizontal-space) - (if (or (< (current-column) cfc) - (and (= (current-column) cfc) (eolp))) - (forward-line 1) - (if (not (eolp)) (insert " ")) - (or (octave-auto-fill) - (forward-line 1)))) - t))) - - -;;; Completions -(defun octave-initialize-completions () - "Create an alist for Octave completions." - (if octave-completion-alist - () - (setq octave-completion-alist - (append octave-reserved-words - octave-text-functions - octave-variables)))) - -(defun octave-completion-at-point-function () - "Find the text to complete and the corresponding table." - (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) - (end (point))) - (if (< beg (point)) - ;; Extend region past point, if applicable. - (save-excursion (skip-syntax-forward "w_") - (setq end (point)))) - (list beg end octave-completion-alist))) - -(define-obsolete-function-alias 'octave-complete-symbol - 'completion-at-point "24.1") - -;;; Electric characters && friends - -(defun octave-abbrev-start () - "Start entering an Octave abbreviation. -If Abbrev mode is turned on, typing ` (grave accent) followed by ? or -\\[help-command] lists all Octave abbrevs. Any other key combination is -executed normally. -Note that all Octave mode abbrevs start with a grave accent." - (interactive) - (self-insert-command 1) - (when abbrev-mode - (set-temporary-overlay-map - (let ((map (make-sparse-keymap))) - (define-key map [??] 'list-abbrevs) - (define-key map (vector help-char) 'list-abbrevs) - map)))) - -(define-skeleton octave-insert-defun - "Insert an Octave function skeleton. -Prompt for the function's name, arguments and return values (to be -entered without parens)." - (let* ((defname (substring (buffer-name) 0 -2)) - (name (read-string (format "Function name (default %s): " defname) - nil nil defname)) - (args (read-string "Arguments: ")) - (vals (read-string "Return values: "))) - (format "%s%s (%s)" - (cond - ((string-equal vals "") vals) - ((string-match "[ ,]" vals) (concat "[" vals "] = ")) - (t (concat vals " = "))) - name - args)) - \n "function " > str \n \n - octave-block-comment-start "usage: " str \n - octave-block-comment-start \n octave-block-comment-start - \n _ \n - "endfunction" > \n) - -;;; Communication with the inferior Octave process -(defun octave-kill-process () - "Kill inferior Octave process and its buffer." - (interactive) - (if inferior-octave-process - (progn - (process-send-string inferior-octave-process "quit;\n") - (accept-process-output inferior-octave-process))) - (if inferior-octave-buffer - (kill-buffer inferior-octave-buffer))) - -(defun octave-show-process-buffer () - "Make sure that `inferior-octave-buffer' is displayed." - (interactive) - (if (get-buffer inferior-octave-buffer) - (display-buffer inferior-octave-buffer) - (message "No buffer named %s" inferior-octave-buffer))) - -(defun octave-hide-process-buffer () - "Delete all windows that display `inferior-octave-buffer'." - (interactive) - (if (get-buffer inferior-octave-buffer) - (delete-windows-on inferior-octave-buffer) - (message "No buffer named %s" inferior-octave-buffer))) - -(defun octave-send-region (beg end) - "Send current region to the inferior Octave process." - (interactive "r") - (inferior-octave t) - (let ((proc inferior-octave-process) - (string (buffer-substring-no-properties beg end)) - line) - (with-current-buffer inferior-octave-buffer - (setq inferior-octave-output-list nil) - (while (not (string-equal string "")) - (if (string-match "\n" string) - (setq line (substring string 0 (match-beginning 0)) - string (substring string (match-end 0))) - (setq line string string "")) - (setq inferior-octave-receive-in-progress t) - (inferior-octave-send-list-and-digest (list (concat line "\n"))) - (while inferior-octave-receive-in-progress - (accept-process-output proc)) - (insert-before-markers - (mapconcat 'identity - (append - (if octave-send-echo-input (list line) (list "")) - (mapcar 'inferior-octave-strip-ctrl-g - inferior-octave-output-list) - (list inferior-octave-output-string)) - "\n"))))) - (if octave-send-show-buffer - (display-buffer inferior-octave-buffer))) - -(defun octave-send-block () - "Send current Octave block to the inferior Octave process." - (interactive) - (save-excursion - (octave-mark-block) - (octave-send-region (point) (mark)))) - -(defun octave-send-defun () - "Send current Octave function to the inferior Octave process." - (interactive) - (save-excursion - (mark-defun) - (octave-send-region (point) (mark)))) - -(defun octave-send-line (&optional arg) - "Send current Octave code line to the inferior Octave process. -With positive prefix ARG, send that many lines. -If `octave-send-line-auto-forward' is non-nil, go to the next unsent -code line." - (interactive "P") - (or arg (setq arg 1)) - (if (> arg 0) - (let (beg end) - (beginning-of-line) - (setq beg (point)) - (octave-next-code-line (- arg 1)) - (end-of-line) - (setq end (point)) - (if octave-send-line-auto-forward - (octave-next-code-line 1)) - (octave-send-region beg end)))) - -(defun octave-eval-print-last-sexp () - "Evaluate Octave sexp before point and print value into current buffer." - (interactive) - (inferior-octave t) - (let ((standard-output (current-buffer)) - (print-escape-newlines nil) - (opoint (point))) - (terpri) - (prin1 - (save-excursion - (forward-sexp -1) - (inferior-octave-send-list-and-digest - (list (concat (buffer-substring-no-properties (point) opoint) - "\n"))) - (mapconcat 'identity inferior-octave-output-list "\n"))) - (terpri))) - -;;; Bug reporting -(defun octave-submit-bug-report () - "Submit a bug report on the Emacs Octave package via mail." - (interactive) - (require 'reporter) - (and - (y-or-n-p "Do you want to submit a bug report? ") - (reporter-submit-bug-report - octave-maintainer-address - (concat "Emacs version " emacs-version) - (list - 'octave-blink-matching-block - 'octave-block-offset - 'octave-comment-char - 'octave-continuation-offset - 'octave-continuation-string - 'octave-send-echo-input - 'octave-send-line-auto-forward - 'octave-send-show-buffer)))) - -;; provide ourself - -(provide 'octave-mod) - -;;; octave-mod.el ends here diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el new file mode 100644 index 00000000000..123aac03eae --- /dev/null +++ b/lisp/progmodes/octave.el @@ -0,0 +1,1844 @@ +;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*- + +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. + +;; Author: Kurt Hornik +;; John Eaton +;; Maintainer: emacs-devel@gnu.org +;; Keywords: languages + +;; 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 . + +;;; Commentary: + +;; This package provides Emacs support for Octave. It defines a major +;; mode for editing Octave code and contains code for interacting with +;; an inferior Octave process using comint. + +;; See the documentation of `octave-mode' and `run-octave' for further +;; information on usage and customization. + +;;; Code: +(require 'comint) + +;;; For emacs < 24.3. +(require 'newcomment) +(eval-and-compile + (unless (fboundp 'user-error) + (defalias 'user-error 'error)) + (unless (fboundp 'delete-consecutive-dups) + (defalias 'delete-consecutive-dups 'delete-dups))) +(eval-when-compile + (unless (fboundp 'setq-local) + (defmacro setq-local (var val) + "Set variable VAR to value VAL in current buffer." + (list 'set (list 'make-local-variable (list 'quote var)) val)))) + +(defgroup octave nil + "Editing Octave code." + :link '(custom-manual "(octave-mode)Top") + :link '(url-link "http://www.gnu.org/s/octave") + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :group 'languages) + +(define-obsolete-function-alias 'octave-submit-bug-report + 'report-emacs-bug "24.4") + +(define-abbrev-table 'octave-abbrev-table nil + "Abbrev table for Octave's reserved words. +Used in `octave-mode' and `inferior-octave-mode' buffers.") + +(defvar octave-comment-char ?# + "Character to start an Octave comment.") + +(defvar octave-comment-start (char-to-string octave-comment-char) + "Octave-specific `comment-start' (which see).") + +(defvar octave-comment-start-skip "\\(^\\|\\S<\\)\\(?:%!\\|\\s<+\\)\\s-*" + "Octave-specific `comment-start-skip' (which see).") + +(defvar octave-begin-keywords + '("classdef" "do" "enumeration" "events" "for" "function" "if" "methods" + "parfor" "properties" "switch" "try" "unwind_protect" "while")) + +(defvar octave-else-keywords + '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup")) + +(defvar octave-end-keywords + '("endclassdef" "endenumeration" "endevents" "endfor" "endfunction" "endif" + "endmethods" "endparfor" "endproperties" "endswitch" "end_try_catch" + "end_unwind_protect" "endwhile" "until" "end")) + +(defvar octave-reserved-words + (append octave-begin-keywords + octave-else-keywords + octave-end-keywords + '("break" "continue" "global" "persistent" "return")) + "Reserved words in Octave.") + +(defvar octave-function-header-regexp + (concat "^\\s-*\\_<\\(function\\)\\_>" + "\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") + "Regexp to match an Octave function header. +The string `function' and its name are given by the first and third +parenthetical grouping.") + + +(defvar octave-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\M-\C-j" 'octave-indent-new-comment-line) + (define-key map "\C-c\C-p" 'octave-previous-code-line) + (define-key map "\C-c\C-n" 'octave-next-code-line) + (define-key map "\C-c\C-a" 'octave-beginning-of-line) + (define-key map "\C-c\C-e" 'octave-end-of-line) + (define-key map [remap down-list] 'smie-down-list) + (define-key map "\C-c\M-\C-h" 'octave-mark-block) + (define-key map "\C-c]" 'smie-close-block) + (define-key map "\C-c/" 'smie-close-block) + (define-key map "\C-c;" 'octave-update-function-file-comment) + (define-key map "\C-hd" 'octave-help) + (define-key map "\C-ha" 'octave-lookfor) + (define-key map "\C-c\C-l" 'octave-source-file) + (define-key map "\C-c\C-f" 'octave-insert-defun) + (define-key map "\C-c\C-il" 'octave-send-line) + (define-key map "\C-c\C-ib" 'octave-send-block) + (define-key map "\C-c\C-if" 'octave-send-defun) + (define-key map "\C-c\C-ir" 'octave-send-region) + (define-key map "\C-c\C-ia" 'octave-send-buffer) + (define-key map "\C-c\C-is" 'octave-show-process-buffer) + (define-key map "\C-c\C-iq" 'octave-hide-process-buffer) + (define-key map "\C-c\C-ik" 'octave-kill-process) + (define-key map "\C-c\C-i\C-l" 'octave-send-line) + (define-key map "\C-c\C-i\C-b" 'octave-send-block) + (define-key map "\C-c\C-i\C-f" 'octave-send-defun) + (define-key map "\C-c\C-i\C-r" 'octave-send-region) + (define-key map "\C-c\C-i\C-a" 'octave-send-buffer) + (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) + (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer) + (define-key map "\C-c\C-i\C-k" 'octave-kill-process) + map) + "Keymap used in Octave mode.") + + + +(easy-menu-define octave-mode-menu octave-mode-map + "Menu for Octave mode." + '("Octave" + ["Split Line at Point" octave-indent-new-comment-line t] + ["Previous Code Line" octave-previous-code-line t] + ["Next Code Line" octave-next-code-line t] + ["Begin of Line" octave-beginning-of-line t] + ["End of Line" octave-end-of-line t] + ["Mark Block" octave-mark-block t] + ["Close Block" smie-close-block t] + "---" + ["Start Octave Process" run-octave t] + ["Documentation Lookup" info-lookup-symbol t] + ["Help on Function" octave-help t] + ["Search help" octave-lookfor t] + ["Find Function Definition" octave-find-definition t] + ["Insert Function" octave-insert-defun t] + ["Update Function File Comment" octave-update-function-file-comment t] + "---" + ["Function Syntax Hints" (eldoc-mode 'toggle) + :style toggle :selected (bound-and-true-p eldoc-mode) + :help "Display function signatures after typing `SPC' or `('"] + ["Delimiter Matching" show-paren-mode + :style toggle :selected show-paren-mode + :help "Highlight matched pairs such as `if ... end'" + :visible (fboundp 'smie--matching-block-data)] + ["Auto Fill" auto-fill-mode + :style toggle :selected auto-fill-function + :help "Automatic line breaking"] + ["Electric Layout" electric-layout-mode + :style toggle :selected electric-layout-mode + :help "Automatically insert newlines around some chars"] + "---" + ("Debug" + ["Send Current Line" octave-send-line t] + ["Send Current Block" octave-send-block t] + ["Send Current Function" octave-send-defun t] + ["Send Region" octave-send-region t] + ["Send Buffer" octave-send-buffer t] + ["Source Current File" octave-source-file t] + ["Show Process Buffer" octave-show-process-buffer t] + ["Hide Process Buffer" octave-hide-process-buffer t] + ["Kill Process" octave-kill-process t]) + "---" + ["Octave Mode Manual" (info "(octave-mode)Top") t] + ["Customize Octave" (customize-group 'octave) t] + ["Submit Bug Report" report-emacs-bug t])) + +(defvar octave-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\r " " table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?! "." table) + (modify-syntax-entry ?\\ "." table) + (modify-syntax-entry ?\' "." table) + (modify-syntax-entry ?\` "." table) + (modify-syntax-entry ?. "." table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?_ "_" table) + ;; The "b" flag only applies to the second letter of the comstart + ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; If we try to put `b' on the single-line comments, we get a similar + ;; problem where the % and # chars appear as first chars of the 2-char + ;; comend, so the multi-line ender is also turned into style-b. + ;; So we need the new "c" comment style. + (modify-syntax-entry ?\% "< 13" table) + (modify-syntax-entry ?\# "< 13" table) + (modify-syntax-entry ?\{ "(} 2c" table) + (modify-syntax-entry ?\} "){ 4c" table) + (modify-syntax-entry ?\n ">" table) + table) + "Syntax table in use in `octave-mode' buffers.") + +(defcustom octave-font-lock-texinfo-comment t + "Control whether to highlight the texinfo comment block." + :type 'boolean + :group 'octave + :version "24.4") + +(defcustom octave-blink-matching-block t + "Control the blinking of matching Octave block keywords. +Non-nil means show matching begin of block when inserting a space, +newline or semicolon after an else or end keyword." + :type 'boolean + :group 'octave) + +(defcustom octave-block-offset 2 + "Extra indentation applied to statements in Octave block structures." + :type 'integer + :group 'octave) + +(defvar octave-block-comment-start + (concat (make-string 2 octave-comment-char) " ") + "String to insert to start a new Octave comment on an empty line.") + +(defcustom octave-continuation-offset 4 + "Extra indentation applied to Octave continuation lines." + :type 'integer + :group 'octave) + +(eval-and-compile + (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) + +(defvar octave-continuation-regexp + (concat "[^#%\n]*\\(" octave-continuation-marker-regexp + "\\)\\s-*\\(\\s<.*\\)?$")) + +;; Char \ is considered a bad decision for continuing a line. +(defconst octave-continuation-string "..." + "Character string used for Octave continuation lines.") + +(defvar octave-mode-imenu-generic-expression + (list + ;; Functions + (list nil octave-function-header-regexp 3)) + "Imenu expression for Octave mode. See `imenu-generic-expression'.") + +(defcustom octave-mode-hook nil + "Hook to be run when Octave mode is started." + :type 'hook + :group 'octave) + +(defcustom octave-send-show-buffer t + "Non-nil means display `inferior-octave-buffer' after sending to it." + :type 'boolean + :group 'octave) + +(defcustom octave-send-line-auto-forward t + "Control auto-forward after sending to the inferior Octave process. +Non-nil means always go to the next Octave code line after sending." + :type 'boolean + :group 'octave) + +(defcustom octave-send-echo-input t + "Non-nil means echo input sent to the inferior Octave process." + :type 'boolean + :group 'octave) + + +;;; SMIE indentation + +(require 'smie) + +;; Use '__operators__' in Octave REPL to get a full list. +(defconst octave-operator-table + '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? + (right "=" "+=" "-=" "*=" "/=") + (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? + (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? + (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") + (nonassoc ":") ;No idea what this is. + (assoc "+" "-") + (assoc "*" "/" "\\" ".\\" ".*" "./") + (nonassoc "'" ".'") + (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". + (right "^" "**" ".^" ".**") + ;; It's not really an operator, but for indentation purposes it + ;; could be convenient to treat it as one. + (assoc "..."))) + +(defconst octave-smie-bnf-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("parfor" exp "endparfor") + ("parfor" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end") + ("enumeration" exp "endenumeration") + ("enumeration" exp "end") + ("events" exp "endevents") + ("events" exp "end") + ("methods" exp "endmethods") + ("methods" exp "end") + ("properties" exp "endproperties") + ("properties" exp "end") + ("classdef" exp "endclassdef") + ("classdef" exp "end")) + ;; (fundesc (atom "=" atom)) + )) + +(defconst octave-smie-grammar + (smie-prec2->grammar + (smie-merge-prec2s + (smie-bnf->prec2 octave-smie-bnf-table + '((assoc "\n" ";"))) + + (smie-precs->prec2 octave-operator-table)))) + +;; Tokenizing needs to be refined so that ";;" is treated as two +;; tokens and also so as to recognize the \n separator (and +;; corresponding continuation lines). + +(defconst octave-operator-regexp + (regexp-opt (remove "\n" (apply 'append + (mapcar 'cdr octave-operator-table))))) + +(defun octave-smie-backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". + (> pos (line-end-position)) + (if (looking-back octave-continuation-marker-regexp (- (point) 3)) + (progn + (goto-char (match-beginning 0)) + (forward-comment (- (point))) + nil) + t) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss))))))) + (skip-chars-forward " \t") + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) + ;; Don't mistake a string quote for a transpose. + (not (looking-back "\\s\"" (1- (point))))) + (goto-char (match-beginning 0)) + (match-string-no-properties 0)) + (t + (smie-default-backward-token))))) + +(defun octave-smie-forward-token () + (skip-chars-forward " \t") + (when (looking-at (eval-when-compile + (concat "\\(" octave-continuation-marker-regexp + "\\)[ \t]*\\($\\|[%#]\\)"))) + (goto-char (match-end 1)) + (forward-comment 1)) + (cond + ((and (looking-at "[%#\n]") + (not (or (save-excursion (skip-chars-backward " \t") + ;; Only add implicit ; when needed. + (or (bolp) (eq (char-before) ?\;))) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss)))))))) + (if (eolp) (forward-char 1) (forward-comment 1)) + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((progn (forward-comment (point-max)) nil)) + ((looking-at ";[ \t]*\\($\\|[%#]\\)") + ;; Combine the ; with the subsequent \n. + (goto-char (match-beginning 1)) + (forward-comment 1) + ";") + ((and (looking-at octave-operator-regexp) + ;; Don't mistake a string quote for a transpose. + (not (looking-at "\\s\""))) + (goto-char (match-end 0)) + (match-string-no-properties 0)) + (t + (smie-default-forward-token)))) + +(defun octave-smie-rules (kind token) + (pcase (cons kind token) + ;; We could set smie-indent-basic instead, but that would have two + ;; disadvantages: + ;; - changes to octave-block-offset wouldn't take effect immediately. + ;; - edebug wouldn't show the use of this variable. + (`(:elem . basic) octave-block-offset) + ;; Since "case" is in the same BNF rules as switch..end, SMIE by default + ;; aligns it with "switch". + (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) + (`(:after . ";") + (if (smie-rule-parent-p "classdef" "events" "enumeration" "function" "if" + "while" "else" "elseif" "for" "parfor" + "properties" "methods" "otherwise" "case" + "try" "catch" "unwind_protect" + "unwind_protect_cleanup") + (smie-rule-parent octave-block-offset) + ;; For (invalid) code between switch and case. + ;; (if (smie-rule-parent-p "switch") 4) + nil)))) + +(defun octave-indent-comment () + "A function for `smie-indent-functions' (which see)." + (save-excursion + (back-to-indentation) + (cond + ((octave-in-string-or-comment-p) nil) + ((looking-at-p "\\(\\s<\\)\\1\\{2,\\}") + 0) + ;; Exclude %{, %} and %!. + ((and (looking-at-p "\\s<\\(?:[^{}!]\\|$\\)") + (not (looking-at-p "\\(\\s<\\)\\1"))) + (comment-choose-indent))))) + + +(defvar octave-font-lock-keywords + (list + ;; Fontify all builtin keywords. + (cons (concat "\\_<\\(" + (regexp-opt octave-reserved-words) + "\\)\\_>") + 'font-lock-keyword-face) + ;; Note: 'end' also serves as the last index in an indexing expression. + ;; Ref: http://www.mathworks.com/help/matlab/ref/end.html + (list (lambda (limit) + (while (re-search-forward "\\_" limit 'move) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (unless (octave-in-string-or-comment-p) + (condition-case nil + (progn + (goto-char beg) + (backward-up-list) + (when (memq (char-after) '(?\( ?\[ ?\{)) + (put-text-property beg end 'face nil)) + (goto-char end)) + (error (goto-char end)))))) + nil)) + ;; Fontify all operators. + (cons octave-operator-regexp 'font-lock-builtin-face) + ;; Fontify all function declarations. + (list octave-function-header-regexp + '(1 font-lock-keyword-face) + '(3 font-lock-function-name-face nil t))) + "Additional Octave expressions to highlight.") + +(defun octave-syntax-propertize-function (start end) + (goto-char start) + (octave-syntax-propertize-sqs end) + (funcall (syntax-propertize-rules + ("\\\\" (0 (when (eq (nth 3 (save-excursion + (syntax-ppss (match-beginning 0)))) + ?\") + (string-to-syntax "\\")))) + ;; Try to distinguish the string-quotes from the transpose-quotes. + ("\\(?:^\\|[[({,; ]\\)\\('\\)" + (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) + (point) end)) + +(defun octave-syntax-propertize-sqs (end) + "Propertize the content/end of single-quote strings." + (when (eq (nth 3 (syntax-ppss)) ?\') + ;; A '..' string. + (when (re-search-forward + "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) + (goto-char (match-beginning 2)) + (when (eq (char-before (match-beginning 1)) ?\\) + ;; Backslash cannot escape a single quote. + (put-text-property (1- (match-beginning 1)) (match-beginning 1) + 'syntax-table (string-to-syntax "."))) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "\"'"))))) + +(defvar electric-layout-rules) + +;;;###autoload +(define-derived-mode octave-mode prog-mode "Octave" + "Major mode for editing Octave code. + +Octave is a high-level language, primarily intended for numerical +computations. It provides a convenient command line interface +for solving linear and nonlinear problems numerically. Function +definitions can also be stored in files and used in batch mode. + +See Info node `(octave-mode) Using Octave Mode' for more details. + +Key bindings: +\\{octave-mode-map}" + :abbrev-table octave-abbrev-table + :group 'octave + + (smie-setup octave-smie-grammar #'octave-smie-rules + :forward-token #'octave-smie-forward-token + :backward-token #'octave-smie-backward-token) + (setq-local smie-indent-basic 'octave-block-offset) + (add-hook 'smie-indent-functions #'octave-indent-comment nil t) + + (setq-local smie-blink-matching-triggers + (cons ?\; smie-blink-matching-triggers)) + (unless octave-blink-matching-block + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) + + (setq-local electric-indent-chars + (cons ?\; electric-indent-chars)) + ;; IIUC matlab-mode takes the opposite approach: it makes RET insert + ;; a ";" at those places where it's correct (i.e. outside of parens). + (setq-local electric-layout-rules '((?\; . after))) + + (setq-local comment-use-syntax t) + (setq-local comment-start octave-comment-start) + (setq-local comment-end "") + (setq-local comment-start-skip octave-comment-start-skip) + (setq-local comment-add 1) + + (setq-local parse-sexp-ignore-comments t) + (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local fill-paragraph-function 'octave-fill-paragraph) + + (setq-local fill-nobreak-predicate + (lambda () (eq (octave-in-string-p) ?'))) + (with-no-warnings + (if (fboundp 'add-function) ; new in 24.4 + (add-function :around (local 'comment-line-break-function) + #'octave--indent-new-comment-line) + (setq-local comment-line-break-function + (apply-partially #'octave--indent-new-comment-line + #'comment-indent-new-line)))) + + (setq font-lock-defaults '(octave-font-lock-keywords)) + + (setq-local syntax-propertize-function #'octave-syntax-propertize-function) + + (setq-local imenu-generic-expression octave-mode-imenu-generic-expression) + (setq-local imenu-case-fold-search nil) + + (setq-local add-log-current-defun-function #'octave-add-log-current-defun) + + (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t) + (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) + (setq-local beginning-of-defun-function 'octave-beginning-of-defun) + (and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment)) + (setq-local eldoc-documentation-function 'octave-eldoc-function) + + (easy-menu-add octave-mode-menu)) + + +(defcustom inferior-octave-program "octave" + "Program invoked by `inferior-octave'." + :type 'string + :group 'octave) + +(defcustom inferior-octave-buffer "*Inferior Octave*" + "Name of buffer for running an inferior Octave process." + :type 'string + :group 'octave) + +(defcustom inferior-octave-prompt + ;; For Octave >= 3.8, default is always 'octave', see + ;; http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + "\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ " + "Regexp to match prompts for the inferior Octave process." + :type 'regexp + :group 'octave) + +(defcustom inferior-octave-prompt-read-only comint-prompt-read-only + "If non-nil, the Octave prompt is read only. +See `comint-prompt-read-only' for details." + :type 'boolean + :group 'octave + :version "24.4") + +(defcustom inferior-octave-startup-file + (let ((n (file-name-nondirectory inferior-octave-program))) + (locate-user-emacs-file (format "init_%s.m" n) (format ".emacs-%s" n))) + "Name of the inferior Octave startup file. +The contents of this file are sent to the inferior Octave process on +startup." + :type '(choice (const :tag "None" nil) file) + :group 'octave + :version "24.4") + +(defcustom inferior-octave-startup-args '("-i" "--no-line-editing") + "List of command line arguments for the inferior Octave process. +For example, for suppressing the startup message and using `traditional' +mode, include \"-q\" and \"--traditional\"." + :type '(repeat string) + :group 'octave + :version "24.4") + +(defcustom inferior-octave-mode-hook nil + "Hook to be run when Inferior Octave mode is started." + :type 'hook + :group 'octave) + +(defcustom inferior-octave-error-regexp-alist + '(("error:\\s-*\\(.*?\\) at line \\([0-9]+\\), column \\([0-9]+\\)" + 1 2 3 2 1) + ("warning:\\s-*\\([^:\n]+\\):.*at line \\([0-9]+\\), column \\([0-9]+\\)" + 1 2 3 1 1)) + "Value for `compilation-error-regexp-alist' in inferior octave." + :version "24.4" + :type '(repeat (choice (symbol :tag "Predefined symbol") + (sexp :tag "Error specification"))) + :group 'octave) + +(defvar inferior-octave-compilation-font-lock-keywords + '(("\\_" . compilation-info-face) + ("\\_" . compilation-error-face) + ("\\_<\\(warning\\):" 1 compilation-warning-face) + ("\\_<\\(error\\):" 1 compilation-error-face) + ("^\\s-*!!!!!.*\\|^.*failed$" . compilation-error-face)) + "Value for `compilation-mode-font-lock-keywords' in inferior octave.") + +(defvar inferior-octave-process nil) + +(defvar inferior-octave-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\t" 'completion-at-point) + (define-key map "\C-hd" 'octave-help) + (define-key map "\C-ha" 'octave-lookfor) + ;; Same as in `shell-mode'. + (define-key map "\M-?" 'comint-dynamic-list-filename-completions) + (define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring) + (define-key map [menu-bar inout list-history] + '("List Input History" . inferior-octave-dynamic-list-input-ring)) + map) + "Keymap used in Inferior Octave mode.") + +(defvar inferior-octave-mode-syntax-table + (let ((table (make-syntax-table octave-mode-syntax-table))) + table) + "Syntax table in use in `inferior-octave-mode' buffers.") + +(defvar inferior-octave-font-lock-keywords + (list + (cons inferior-octave-prompt 'font-lock-type-face)) + ;; Could certainly do more font locking in inferior Octave ... + "Additional expressions to highlight in Inferior Octave mode.") + +(defvar inferior-octave-output-list nil) +(defvar inferior-octave-output-string nil) +(defvar inferior-octave-receive-in-progress nil) + +(define-obsolete-variable-alias 'inferior-octave-startup-hook + 'inferior-octave-mode-hook "24.4") + +(defvar inferior-octave-dynamic-complete-functions + '(inferior-octave-completion-at-point comint-filename-completion) + "List of functions called to perform completion for inferior Octave. +This variable is used to initialize `comint-dynamic-complete-functions' +in the Inferior Octave buffer.") + +(defvar info-lookup-mode) +(defvar compilation-error-regexp-alist) +(defvar compilation-mode-font-lock-keywords) + +(declare-function compilation-forget-errors "compile" ()) + +(defun inferior-octave-process-live-p () + (process-live-p inferior-octave-process)) + +(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" + "Major mode for interacting with an inferior Octave process. + +See Info node `(octave-mode) Running Octave from Within Emacs' for more +details. + +Key bindings: +\\{inferior-octave-mode-map}" + :abbrev-table octave-abbrev-table + :group 'octave + + (setq comint-prompt-regexp inferior-octave-prompt) + + (setq-local comment-use-syntax t) + (setq-local comment-start octave-comment-start) + (setq-local comment-end "") + (setq comment-column 32) + (setq-local comment-start-skip octave-comment-start-skip) + + (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil)) + + (setq-local info-lookup-mode 'octave-mode) + (setq-local eldoc-documentation-function 'octave-eldoc-function) + + (setq comint-input-ring-file-name + (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") + comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) + (comint-read-input-ring t) + (setq-local comint-dynamic-complete-functions + inferior-octave-dynamic-complete-functions) + (setq-local comint-prompt-read-only inferior-octave-prompt-read-only) + (add-hook 'comint-input-filter-functions + 'inferior-octave-directory-tracker nil t) + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + (add-hook 'window-configuration-change-hook + 'inferior-octave-track-window-width-change nil t) + (setq-local compilation-error-regexp-alist inferior-octave-error-regexp-alist) + (setq-local compilation-mode-font-lock-keywords + inferior-octave-compilation-font-lock-keywords) + (compilation-shell-minor-mode 1) + (compilation-forget-errors)) + +;;;###autoload +(defun inferior-octave (&optional arg) + "Run an inferior Octave process, I/O via `inferior-octave-buffer'. +This buffer is put in Inferior Octave mode. See `inferior-octave-mode'. + +Unless ARG is non-nil, switches to this buffer. + +The elements of the list `inferior-octave-startup-args' are sent as +command line arguments to the inferior Octave process on startup. + +Additional commands to be executed on startup can be provided either in +the file specified by `inferior-octave-startup-file' or by the default +startup file, `~/.emacs-octave'." + (interactive "P") + (let ((buffer (get-buffer-create inferior-octave-buffer))) + (unless arg + (pop-to-buffer buffer)) + (unless (comint-check-proc buffer) + (with-current-buffer buffer + (inferior-octave-startup) + (inferior-octave-mode))) + buffer)) + +;;;###autoload +(defalias 'run-octave 'inferior-octave) + +(defun inferior-octave-startup () + "Start an inferior Octave process." + (let ((proc (comint-exec-1 + (substring inferior-octave-buffer 1 -1) + inferior-octave-buffer + inferior-octave-program + (append + inferior-octave-startup-args + ;; --no-gui is introduced in Octave > 3.7 + (and (not (member "--no-gui" inferior-octave-startup-args)) + (zerop (process-file inferior-octave-program + nil nil nil "--no-gui" "--help")) + '("--no-gui")))))) + (set-process-filter proc 'inferior-octave-output-digest) + (setq inferior-octave-process proc + inferior-octave-output-list nil + inferior-octave-output-string nil + inferior-octave-receive-in-progress t) + + ;; This may look complicated ... However, we need to make sure that + ;; we additional startup code only AFTER Octave is ready (otherwise, + ;; output may be mixed up). Hence, we need to digest the Octave + ;; output to see when it issues a prompt. + (while inferior-octave-receive-in-progress + (unless (inferior-octave-process-live-p) + ;; Spit out the error messages. + (when inferior-octave-output-list + (princ (concat (mapconcat 'identity inferior-octave-output-list "\n") + "\n") + (process-mark inferior-octave-process))) + (error "Process `%s' died" inferior-octave-process)) + (accept-process-output inferior-octave-process)) + (goto-char (point-max)) + (set-marker (process-mark proc) (point)) + (insert-before-markers + (concat + (if (not (bobp)) " \n") + (if inferior-octave-output-list + (concat (mapconcat + 'identity inferior-octave-output-list "\n") + "\n")))) + + ;; An empty secondary prompt, as e.g. obtained by '--braindead', + ;; means trouble. + (inferior-octave-send-list-and-digest (list "PS2\n")) + (when (string-match "\\(PS2\\|ans\\) = *$" + (car inferior-octave-output-list)) + (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n"))) + + (inferior-octave-send-list-and-digest + (list "disp (getenv ('OCTAVE_SRCDIR'))\n")) + (process-put proc 'octave-srcdir + (unless (equal (car inferior-octave-output-list) "") + (car inferior-octave-output-list))) + + ;; O.K., now we are ready for the Inferior Octave startup commands. + (inferior-octave-send-list-and-digest + (list "more off;\n" + (unless (equal inferior-octave-output-string ">> ") + ;; See http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + "PS1 ('octave> ');\n") + (when (and inferior-octave-startup-file + (file-exists-p inferior-octave-startup-file)) + (format "source ('%s');\n" inferior-octave-startup-file)))) + (when inferior-octave-output-list + (insert-before-markers + (mapconcat 'identity inferior-octave-output-list "\n"))) + + ;; And finally, everything is back to normal. + (set-process-filter proc 'comint-output-filter) + ;; Just in case, to be sure a cd in the startup file won't have + ;; detrimental effects. + (with-demoted-errors (inferior-octave-resync-dirs)) + ;; Generate a proper prompt, which is critical to + ;; `comint-history-isearch-backward-regexp'. Bug#14433. + (comint-send-string proc "\n"))) + +(defun inferior-octave-completion-table () + (completion-table-with-cache + (lambda (command) + (inferior-octave-send-list-and-digest + (list (format "completion_matches ('%s');\n" command))) + (delete-consecutive-dups + (sort inferior-octave-output-list 'string-lessp))))) + +(defun inferior-octave-completion-at-point () + "Return the data to complete the Octave symbol at point." + ;; http://debbugs.gnu.org/14300 + (unless (string-match-p "/" (or (comint--match-partial-filename) "")) + (let ((beg (save-excursion + (skip-syntax-backward "w_" (comint-line-beginning-position)) + (point))) + (end (point))) + (when (and beg (> end beg)) + (list beg end (completion-table-in-turn + (inferior-octave-completion-table) + 'comint-completion-file-name-table)))))) + +(define-obsolete-function-alias 'inferior-octave-complete + 'completion-at-point "24.1") + +(defun inferior-octave-dynamic-list-input-ring () + "List the buffer's input history in a help buffer." + ;; We cannot use `comint-dynamic-list-input-ring', because it replaces + ;; "completion" by "history reference" ... + (interactive) + (if (or (not (ring-p comint-input-ring)) + (ring-empty-p comint-input-ring)) + (message "No history") + (let ((history nil) + (history-buffer " *Input History*") + (index (1- (ring-length comint-input-ring))) + (conf (current-window-configuration))) + ;; We have to build up a list ourselves from the ring vector. + (while (>= index 0) + (setq history (cons (ring-ref comint-input-ring index) history) + index (1- index))) + ;; Change "completion" to "history reference" + ;; to make the display accurate. + (with-output-to-temp-buffer history-buffer + (display-completion-list history) + (set-buffer history-buffer)) + (message "Hit space to flush") + (let ((ch (read-event))) + (if (eq ch ?\ ) + (set-window-configuration conf) + (setq unread-command-events (list ch))))))) + +(defun inferior-octave-output-digest (_proc string) + "Special output filter for the inferior Octave process. +Save all output between newlines into `inferior-octave-output-list', and +the rest to `inferior-octave-output-string'." + (setq string (concat inferior-octave-output-string string)) + (while (string-match "\n" string) + (setq inferior-octave-output-list + (append inferior-octave-output-list + (list (substring string 0 (match-beginning 0)))) + string (substring string (match-end 0)))) + (if (string-match inferior-octave-prompt string) + (setq inferior-octave-receive-in-progress nil)) + (setq inferior-octave-output-string string)) + +(defun inferior-octave-check-process () + (or (inferior-octave-process-live-p) + (error (substitute-command-keys + "No inferior octave process running. Type \\[run-octave]")))) + +(defun inferior-octave-send-list-and-digest (list) + "Send LIST to the inferior Octave process and digest the output. +The elements of LIST have to be strings and are sent one by one. All +output is passed to the filter `inferior-octave-output-digest'." + (inferior-octave-check-process) + (let* ((proc inferior-octave-process) + (filter (process-filter proc)) + string) + (set-process-filter proc 'inferior-octave-output-digest) + (setq inferior-octave-output-list nil) + (unwind-protect + (while (setq string (car list)) + (setq inferior-octave-output-string nil + inferior-octave-receive-in-progress t) + (comint-send-string proc string) + (while inferior-octave-receive-in-progress + (accept-process-output proc)) + (setq list (cdr list))) + (set-process-filter proc filter)))) + +(defvar inferior-octave-directory-tracker-resync nil) +(make-variable-buffer-local 'inferior-octave-directory-tracker-resync) + +(defun inferior-octave-directory-tracker (string) + "Tracks `cd' commands issued to the inferior Octave process. +Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." + (when inferior-octave-directory-tracker-resync + (or (inferior-octave-resync-dirs 'noerror) + (setq inferior-octave-directory-tracker-resync nil))) + (cond + ((string-match "^[ \t]*cd[ \t;]*$" string) + (cd "~")) + ((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string) + (condition-case err + (cd (match-string 1 string)) + (error (setq inferior-octave-directory-tracker-resync t) + (message "%s: `%s'" + (error-message-string err) + (match-string 1 string))))))) + +(defun inferior-octave-resync-dirs (&optional noerror) + "Resync the buffer's idea of the current directory. +This command queries the inferior Octave process about its current +directory and makes this the current buffer's default directory." + (interactive) + (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) + (condition-case err + (progn + (cd (car inferior-octave-output-list)) + t) + (error (unless noerror (signal (car err) (cdr err)))))) + +(defcustom inferior-octave-minimal-columns 80 + "The minimal column width for the inferior Octave process." + :type 'integer + :group 'octave + :version "24.4") + +(defvar inferior-octave-last-column-width nil) + +(defun inferior-octave-track-window-width-change () + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + (let ((width (max inferior-octave-minimal-columns (window-width)))) + (unless (eq inferior-octave-last-column-width width) + (setq-local inferior-octave-last-column-width width) + (when (inferior-octave-process-live-p) + (inferior-octave-send-list-and-digest + (list (format "putenv ('COLUMNS', '%s');\n" width))))))) + + +;;; Miscellaneous useful functions + +(defun octave-in-comment-p () + "Return non-nil if point is inside an Octave comment." + (nth 4 (syntax-ppss))) + +(defun octave-in-string-p () + "Return non-nil if point is inside an Octave string." + (nth 3 (syntax-ppss))) + +(defun octave-in-string-or-comment-p () + "Return non-nil if point is inside an Octave string or comment." + (nth 8 (syntax-ppss))) + +(defun octave-looking-at-kw (regexp) + "Like `looking-at', but sets `case-fold-search' nil." + (let ((case-fold-search nil)) + (looking-at regexp))) + +(defun octave-maybe-insert-continuation-string () + (if (or (octave-in-comment-p) + (save-excursion + (beginning-of-line) + (looking-at octave-continuation-regexp))) + nil + (delete-horizontal-space) + (insert (concat " " octave-continuation-string)))) + +(defun octave-completing-read () + (let ((def (or (thing-at-point 'symbol) + (save-excursion + (skip-syntax-backward "-(") + (thing-at-point 'symbol))))) + (completing-read + (format (if def "Function (default %s): " + "Function: ") def) + (inferior-octave-completion-table) + nil nil nil nil def))) + +(defun octave-goto-function-definition (fn) + "Go to the function definition of FN in current buffer." + (let ((search + (lambda (re sub) + (let ((orig (point)) found) + (goto-char (point-min)) + (while (and (not found) (re-search-forward re nil t)) + (when (and (equal (match-string sub) fn) + (not (nth 8 (syntax-ppss)))) + (setq found t))) + (unless found (goto-char orig)) + found)))) + (pcase (and buffer-file-name (file-name-extension buffer-file-name)) + ("cc" (funcall search + "\\_")))) + (octave-skip-comment-forward (point-max))) + (let ((beg (comment-search-forward (point-max) t))) + (when beg + (goto-char beg) + (octave-skip-comment-forward (point-max)) + (list beg (point)))))) + +(defun octave-sync-function-file-names () + "Ensure function name agree with function file name. +See Info node `(octave)Function Files'." + (interactive) + (when buffer-file-name + (pcase-let ((`(,start ,_end ,name-start ,name-end) + (octave-function-file-p))) + (when (and start name-start) + (let* ((func (buffer-substring name-start name-end)) + (file (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + (help-form (format "\ +a: Use function name `%s' +b: Use file name `%s' +q: Don't fix\n" func file)) + (c (unless (equal file func) + (save-window-excursion + (help-form-show) + (read-char-choice + "Which name to use? (a/b/q) " '(?a ?b ?q)))))) + (pcase c + (?a (let ((newname (expand-file-name + (concat func (file-name-extension + buffer-file-name t))))) + (when (or (not (file-exists-p newname)) + (yes-or-no-p + (format "Target file %s exists; proceed? " newname))) + (when (file-exists-p buffer-file-name) + (rename-file buffer-file-name newname t)) + (set-visited-file-name newname)))) + (?b (save-excursion + (goto-char name-start) + (delete-region name-start name-end) + (insert file))))))))) + +(defun octave-update-function-file-comment (beg end) + "Query replace function names in function file comment." + (interactive + (progn + (barf-if-buffer-read-only) + (if (use-region-p) + (list (region-beginning) (region-end)) + (or (octave-function-file-comment) + (error "No function file comment found"))))) + (save-excursion + (let* ((bounds (or (octave-function-file-p) + (error "Not in a function file buffer"))) + (func (if (cddr bounds) + (apply #'buffer-substring (cddr bounds)) + (error "Function name not found"))) + (old-func (progn + (goto-char beg) + (when (re-search-forward + "[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>" + (min (line-end-position 4) end) + t) + (match-string 1)))) + (old-func (read-string (format (if old-func + "Name to replace (default %s): " + "Name to replace: ") + old-func) + nil nil old-func))) + (if (and func old-func (not (equal func old-func))) + (perform-replace old-func func 'query + nil 'delimited nil nil beg end) + (message "Function names match"))))) + +(defface octave-function-comment-block + '((t (:inherit font-lock-doc-face))) + "Face used to highlight function comment block." + :group 'octave) + +(eval-when-compile (require 'texinfo)) + +(defun octave-font-lock-texinfo-comment () + (let ((kws + (eval-when-compile + (delq nil (mapcar + (lambda (kw) + (if (numberp (nth 1 kw)) + `(,(nth 0 kw) ,(nth 1 kw) ,(nth 2 kw) prepend) + (message "Ignoring Texinfo highlight: %S" kw))) + texinfo-font-lock-keywords))))) + (font-lock-add-keywords + nil + `((,(lambda (limit) + (while (and (< (point) limit) + (search-forward "-*- texinfo -*-" limit t) + (octave-in-comment-p)) + (let ((beg (nth 8 (syntax-ppss))) + (end (progn + (octave-skip-comment-forward (point-max)) + (point)))) + (put-text-property beg end 'font-lock-multiline t) + (font-lock-prepend-text-property + beg end 'face 'octave-function-comment-block) + (dolist (kw kws) + (goto-char beg) + (while (re-search-forward (car kw) end 'move) + (font-lock-apply-highlight (cdr kw)))))) + nil))) + 'append))) + + +;;; Indentation + +(defun octave-indent-new-comment-line (&optional soft) + "Break Octave line at point, continuing comment if within one. +Insert `octave-continuation-string' before breaking the line +unless inside a list. Signal an error if within a single-quoted +string." + (interactive) + (funcall comment-line-break-function soft)) + +(defun octave--indent-new-comment-line (orig &rest args) + (cond + ((octave-in-comment-p) nil) + ((eq (octave-in-string-p) ?') + (error "Cannot split a single-quoted string")) + ((eq (octave-in-string-p) ?\") + (insert octave-continuation-string)) + (t + (delete-horizontal-space) + (unless (and (cadr (syntax-ppss)) + (eq (char-after (cadr (syntax-ppss))) ?\()) + (insert " " octave-continuation-string)))) + (apply orig args) + (indent-according-to-mode)) + +(define-obsolete-function-alias + 'octave-indent-defun 'prog-indent-sexp "24.4") + + +;;; Motion +(defun octave-next-code-line (&optional arg) + "Move ARG lines of Octave code forward (backward if ARG is negative). +Skips past all empty and comment lines. Default for ARG is 1. + +On success, return 0. Otherwise, go as far as possible and return -1." + (interactive "p") + (or arg (setq arg 1)) + (beginning-of-line) + (let ((n 0) + (inc (if (> arg 0) 1 -1))) + (while (and (/= arg 0) (= n 0)) + (setq n (forward-line inc)) + (while (and (= n 0) + (looking-at "\\s-*\\($\\|\\s<\\)")) + (setq n (forward-line inc))) + (setq arg (- arg inc))) + n)) + +(defun octave-previous-code-line (&optional arg) + "Move ARG lines of Octave code backward (forward if ARG is negative). +Skips past all empty and comment lines. Default for ARG is 1. + +On success, return 0. Otherwise, go as far as possible and return -1." + (interactive "p") + (or arg (setq arg 1)) + (octave-next-code-line (- arg))) + +(defun octave-beginning-of-line () + "Move point to beginning of current Octave line. +If on an empty or comment line, go to the beginning of that line. +Otherwise, move backward to the beginning of the first Octave code line +which is not inside a continuation statement, i.e., which does not +follow a code line ending with `...' or is inside an open +parenthesis list." + (interactive) + (beginning-of-line) + (unless (looking-at "\\s-*\\($\\|\\s<\\)") + (while (or (when (cadr (syntax-ppss)) + (goto-char (cadr (syntax-ppss))) + (beginning-of-line) + t) + (and (or (looking-at "\\s-*\\($\\|\\s<\\)") + (save-excursion + (if (zerop (octave-previous-code-line)) + (looking-at octave-continuation-regexp)))) + (zerop (forward-line -1))))))) + +(defun octave-end-of-line () + "Move point to end of current Octave line. +If on an empty or comment line, go to the end of that line. +Otherwise, move forward to the end of the first Octave code line which +does not end with `...' or is inside an open parenthesis list." + (interactive) + (end-of-line) + (unless (save-excursion + (beginning-of-line) + (looking-at "\\s-*\\($\\|\\s<\\)")) + (while (or (when (cadr (syntax-ppss)) + (condition-case nil + (progn + (up-list 1) + (end-of-line) + t) + (error nil))) + (and (save-excursion + (beginning-of-line) + (or (looking-at "\\s-*\\($\\|\\s<\\)") + (looking-at octave-continuation-regexp))) + (zerop (forward-line 1))))) + (end-of-line))) + +(defun octave-mark-block () + "Put point at the beginning of this Octave block, mark at the end. +The block marked is the one that contains point or follows point." + (interactive) + (if (and (looking-at "\\sw\\|\\s_") + (looking-back "\\sw\\|\\s_" (1- (point)))) + (skip-syntax-forward "w_")) + (unless (or (looking-at "\\s(") + (save-excursion + (let* ((token (funcall smie-forward-token-function)) + (level (assoc token smie-grammar))) + (and level (not (numberp (cadr level))))))) + (backward-up-list 1)) + (mark-sexp)) + +(defun octave-beginning-of-defun (&optional arg) + "Octave-specific `beginning-of-defun-function' (which see)." + (or arg (setq arg 1)) + ;; Move out of strings or comments. + (when (octave-in-string-or-comment-p) + (goto-char (octave-in-string-or-comment-p))) + (letrec ((orig (point)) + (toplevel (lambda (pos) + (condition-case nil + (progn + (backward-up-list 1) + (funcall toplevel (point))) + (scan-error pos))))) + (goto-char (funcall toplevel (point))) + (when (and (> arg 0) (/= orig (point))) + (setq arg (1- arg))) + (forward-sexp (- arg)) + (and (< arg 0) (forward-sexp -1)) + (/= orig (point)))) + +(defun octave-fill-paragraph (&optional _arg) + "Fill paragraph of Octave code, handling Octave comments." + ;; FIXME: difference with generic fill-paragraph: + ;; - code lines are only split, never joined. + ;; - \n that end comments are never removed. + ;; - insert continuation marker when splitting code lines. + (interactive "P") + (save-excursion + (let ((end (progn (forward-paragraph) (copy-marker (point) t))) + (beg (progn + (forward-paragraph -1) + (skip-chars-forward " \t\n") + (beginning-of-line) + (point))) + (cfc (current-fill-column)) + comment-prefix) + (goto-char beg) + (while (< (point) end) + (condition-case nil + (indent-according-to-mode) + (error nil)) + (move-to-column cfc) + ;; First check whether we need to combine non-empty comment lines + (if (and (< (current-column) cfc) + (octave-in-comment-p) + (not (save-excursion + (beginning-of-line) + (looking-at "^\\s-*\\s<+\\s-*$")))) + ;; This is a nonempty comment line which does not extend + ;; past the fill column. If it is followed by a nonempty + ;; comment line with the same comment prefix, try to + ;; combine them, and repeat this until either we reach the + ;; fill-column or there is nothing more to combine. + (progn + ;; Get the comment prefix + (save-excursion + (beginning-of-line) + (while (and (re-search-forward "\\s<+") + (not (octave-in-comment-p)))) + (setq comment-prefix (match-string 0))) + ;; And keep combining ... + (while (and (< (current-column) cfc) + (save-excursion + (forward-line 1) + (and (looking-at + (concat "^\\s-*" + comment-prefix + "\\S<")) + (not (looking-at + (concat "^\\s-*" + comment-prefix + "\\s-*$")))))) + (delete-char 1) + (re-search-forward comment-prefix) + (delete-region (match-beginning 0) (match-end 0)) + (fixup-whitespace) + (move-to-column cfc)))) + ;; We might also try to combine continued code lines> Perhaps + ;; some other time ... + (skip-chars-forward "^ \t\n") + (delete-horizontal-space) + (if (or (< (current-column) cfc) + (and (= (current-column) cfc) (eolp))) + (forward-line 1) + (if (not (eolp)) (insert " ")) + (or (funcall normal-auto-fill-function) + (forward-line 1)))) + t))) + +(defun octave-completion-at-point () + "Find the text to complete and the corresponding table." + (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) + (end (point))) + (if (< beg (point)) + ;; Extend region past point, if applicable. + (save-excursion (skip-syntax-forward "w_") + (setq end (point)))) + (when (> end beg) + (list beg end (or (and (inferior-octave-process-live-p) + (inferior-octave-completion-table)) + octave-reserved-words))))) + +(define-obsolete-function-alias 'octave-complete-symbol + 'completion-at-point "24.1") + +(defun octave-add-log-current-defun () + "A function for `add-log-current-defun-function' (which see)." + (save-excursion + (end-of-line) + (and (beginning-of-defun) + (re-search-forward octave-function-header-regexp + (line-end-position) t) + (match-string 3)))) + + +;;; Electric characters && friends +(define-skeleton octave-insert-defun + "Insert an Octave function skeleton. +Prompt for the function's name, arguments and return values (to be +entered without parens)." + (let* ((defname (file-name-sans-extension (buffer-name))) + (name (read-string (format "Function name (default %s): " defname) + nil nil defname)) + (args (read-string "Arguments: ")) + (vals (read-string "Return values: "))) + (format "%s%s (%s)" + (cond + ((string-equal vals "") vals) + ((string-match "[ ,]" vals) (concat "[" vals "] = ")) + (t (concat vals " = "))) + name + args)) + \n octave-block-comment-start "usage: " str \n + octave-block-comment-start '(delete-horizontal-space) \n + octave-block-comment-start '(delete-horizontal-space) \n + "function " > str \n + _ \n + "endfunction" > \n) + +;;; Communication with the inferior Octave process +(defun octave-kill-process () + "Kill inferior Octave process and its buffer." + (interactive) + (when (and (buffer-live-p (get-buffer inferior-octave-buffer)) + (or (yes-or-no-p (format "Kill %S and its buffer? " + inferior-octave-process)) + (user-error "Aborted"))) + (when (inferior-octave-process-live-p) + (set-process-query-on-exit-flag inferior-octave-process nil) + (process-send-string inferior-octave-process "quit;\n") + (accept-process-output inferior-octave-process)) + (kill-buffer inferior-octave-buffer))) + +(defun octave-show-process-buffer () + "Make sure that `inferior-octave-buffer' is displayed." + (interactive) + (if (get-buffer inferior-octave-buffer) + (display-buffer inferior-octave-buffer) + (message "No buffer named %s" inferior-octave-buffer))) + +(defun octave-hide-process-buffer () + "Delete all windows that display `inferior-octave-buffer'." + (interactive) + (if (get-buffer inferior-octave-buffer) + (delete-windows-on inferior-octave-buffer) + (message "No buffer named %s" inferior-octave-buffer))) + +(defun octave-source-file (file) + "Execute FILE in the inferior Octave process. +This is done using Octave's source function. FILE defaults to +current buffer file unless called with a prefix arg \\[universal-argument]." + (interactive (list (or (and (not current-prefix-arg) buffer-file-name) + (read-file-name "File: " nil nil t)))) + (or (stringp file) + (signal 'wrong-type-argument (list 'stringp file))) + (inferior-octave t) + (with-current-buffer inferior-octave-buffer + (comint-send-string inferior-octave-process + (format "source '%s'\n" file)))) + +(defun octave-send-region (beg end) + "Send current region to the inferior Octave process." + (interactive "r") + (inferior-octave t) + (let ((proc inferior-octave-process) + (string (buffer-substring-no-properties beg end)) + line) + (with-current-buffer inferior-octave-buffer + ;; http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00095.html + (compilation-forget-errors) + (setq inferior-octave-output-list nil) + (while (not (string-equal string "")) + (if (string-match "\n" string) + (setq line (substring string 0 (match-beginning 0)) + string (substring string (match-end 0))) + (setq line string string "")) + (setq inferior-octave-receive-in-progress t) + (inferior-octave-send-list-and-digest (list (concat line "\n"))) + (while inferior-octave-receive-in-progress + (accept-process-output proc)) + (insert-before-markers + (mapconcat 'identity + (append + (if octave-send-echo-input (list line) (list "")) + inferior-octave-output-list + (list inferior-octave-output-string)) + "\n"))))) + (if octave-send-show-buffer + (display-buffer inferior-octave-buffer))) + +(defun octave-send-buffer () + "Send current buffer to the inferior Octave process." + (interactive) + (octave-send-region (point-min) (point-max))) + +(defun octave-send-block () + "Send current Octave block to the inferior Octave process." + (interactive) + (save-excursion + (octave-mark-block) + (octave-send-region (point) (mark)))) + +(defun octave-send-defun () + "Send current Octave function to the inferior Octave process." + (interactive) + (save-excursion + (mark-defun) + (octave-send-region (point) (mark)))) + +(defun octave-send-line (&optional arg) + "Send current Octave code line to the inferior Octave process. +With positive prefix ARG, send that many lines. +If `octave-send-line-auto-forward' is non-nil, go to the next unsent +code line." + (interactive "P") + (or arg (setq arg 1)) + (if (> arg 0) + (let (beg end) + (beginning-of-line) + (setq beg (point)) + (octave-next-code-line (- arg 1)) + (end-of-line) + (setq end (point)) + (if octave-send-line-auto-forward + (octave-next-code-line 1)) + (octave-send-region beg end)))) + +(defun octave-eval-print-last-sexp () + "Evaluate Octave sexp before point and print value into current buffer." + (interactive) + (inferior-octave t) + (let ((standard-output (current-buffer)) + (print-escape-newlines nil) + (opoint (point))) + (terpri) + (prin1 + (save-excursion + (forward-sexp -1) + (inferior-octave-send-list-and-digest + (list (concat (buffer-substring-no-properties (point) opoint) + "\n"))) + (mapconcat 'identity inferior-octave-output-list "\n"))) + (terpri))) + + + +(defcustom octave-eldoc-message-style 'auto + "Octave eldoc message style: auto, oneline, multiline." + :type '(choice (const :tag "Automatic" auto) + (const :tag "One Line" oneline) + (const :tag "Multi Line" multiline)) + :group 'octave + :version "24.4") + +;; (FN SIGNATURE1 SIGNATURE2 ...) +(defvar octave-eldoc-cache nil) + +(defun octave-eldoc-function-signatures (fn) + (unless (equal fn (car octave-eldoc-cache)) + (inferior-octave-send-list-and-digest + (list (format "print_usage ('%s');\n" fn))) + (let (result) + (dolist (line inferior-octave-output-list) + (when (string-match + "\\s-*\\(?:--[^:]+\\|usage\\):\\s-*\\(.*\\)$" + line) + (push (match-string 1 line) result))) + (setq octave-eldoc-cache + (cons (substring-no-properties fn) + (nreverse result))))) + (cdr octave-eldoc-cache)) + +(defun octave-eldoc-function () + "A function for `eldoc-documentation-function' (which see)." + (when (inferior-octave-process-live-p) + (let* ((ppss (syntax-ppss)) + (paren-pos (cadr ppss)) + (fn (save-excursion + (if (and paren-pos + ;; PAREN-POS must be after the prompt + (>= paren-pos + (if (eq (get-buffer-process (current-buffer)) + inferior-octave-process) + (process-mark inferior-octave-process) + (point-min))) + (or (not (eq (get-buffer-process (current-buffer)) + inferior-octave-process)) + (< (process-mark inferior-octave-process) + paren-pos)) + (eq (char-after paren-pos) ?\()) + (goto-char paren-pos) + (setq paren-pos nil)) + (when (or (< (skip-syntax-backward "-") 0) paren-pos) + (thing-at-point 'symbol)))) + (sigs (and fn (octave-eldoc-function-signatures fn))) + (oneline (mapconcat 'identity sigs + (propertize " | " 'face 'warning))) + (multiline (mapconcat (lambda (s) (concat "-- " s)) sigs "\n"))) + ;; + ;; Return the value according to style. + (pcase octave-eldoc-message-style + (`auto (if (< (length oneline) (window-width (minibuffer-window))) + oneline + multiline)) + (`oneline oneline) + (`multiline multiline))))) + +(defcustom octave-help-buffer "*Octave Help*" + "Buffer name for `octave-help'." + :type 'string + :group 'octave + :version "24.4") + +;; Used in a mode derived from help-mode. +(declare-function help-button-action "help-mode" (button)) + +(define-button-type 'octave-help-file + 'follow-link t + 'action #'help-button-action + 'help-function 'octave-find-definition) + +(define-button-type 'octave-help-function + 'follow-link t + 'action (lambda (b) + (octave-help + (buffer-substring (button-start b) (button-end b))))) + +(defvar octave-help-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\C-hd" 'octave-help) + (define-key map "\C-ha" 'octave-lookfor) + map)) + +(define-derived-mode octave-help-mode help-mode "OctHelp" + "Major mode for displaying Octave documentation." + :abbrev-table nil + :syntax-table octave-mode-syntax-table + (eval-and-compile (require 'help-mode)) + ;; Don't highlight `EXAMPLE' as elisp symbols by using a regexp that + ;; can never match. + (setq-local help-xref-symbol-regexp "x\\`")) + +(defun octave-help (fn) + "Display the documentation of FN." + (interactive (list (octave-completing-read))) + (inferior-octave-send-list-and-digest + (list (format "help ('%s');\n" fn))) + (let ((lines inferior-octave-output-list) + (inhibit-read-only t)) + (when (string-match "error: \\(.*\\)$" (car lines)) + (error "%s" (match-string 1 (car lines)))) + (with-help-window octave-help-buffer + (princ (mapconcat 'identity lines "\n")) + (with-current-buffer octave-help-buffer + ;; Bound to t so that `help-buffer' returns current buffer for + ;; `help-setup-xref'. + (let ((help-xref-following t)) + (help-setup-xref (list 'octave-help fn) + (called-interactively-p 'interactive))) + ;; Note: can be turned off by suppress_verbose_help_message. + ;; + ;; Remove boring trailing text: Additional help for built-in functions + ;; and operators ... + (goto-char (point-max)) + (when (search-backward "\n\n\n" nil t) + (goto-char (match-beginning 0)) + (delete-region (point) (point-max))) + ;; File name highlight + (goto-char (point-min)) + (when (re-search-forward "from the file \\(.*\\)$" + (line-end-position) + t) + (let* ((file (match-string 1)) + (dir (file-name-directory + (directory-file-name (file-name-directory file))))) + (replace-match "" nil nil nil 1) + (insert "`") + ;; Include the parent directory which may be regarded as + ;; the category for the FN. + (help-insert-xref-button (file-relative-name file dir) + 'octave-help-file fn) + (insert "'"))) + ;; Make 'See also' clickable. + (with-syntax-table octave-mode-syntax-table + (when (re-search-forward "^\\s-*See also:" nil t) + (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) + (while (re-search-forward + "\\s-*\\([^,\n]+?\\)\\s-*\\(?:[,]\\|[.]?$\\)" end t) + (make-text-button (match-beginning 1) (match-end 1) + :type 'octave-help-function))))) + (octave-help-mode))))) + +(defun octave-lookfor (str &optional all) + "Search for the string STR in all function help strings. +If ALL is non-nil search the entire help string else only search the first +sentence." + (interactive "sSearch for: \nP") + (inferior-octave-send-list-and-digest + (list (format "lookfor (%s'%s');\n" + (if all "'-all', " "") + str))) + (let ((lines inferior-octave-output-list)) + (when (and (stringp (car lines)) + (string-match "error: \\(.*\\)$" (car lines))) + (error "%s" (match-string 1 (car lines)))) + (with-help-window octave-help-buffer + (with-current-buffer octave-help-buffer + (if lines + (insert (mapconcat 'identity lines "\n")) + (insert (format "Nothing found for \"%s\".\n" str))) + ;; Bound to t so that `help-buffer' returns current buffer for + ;; `help-setup-xref'. + (let ((help-xref-following t)) + (help-setup-xref (list 'octave-lookfor str all) + (called-interactively-p 'interactive))) + (goto-char (point-min)) + (when lines + (while (re-search-forward "^\\([^[:blank:]]+\\) " nil 'noerror) + (make-text-button (match-beginning 1) (match-end 1) + :type 'octave-help-function))) + (unless all + (goto-char (point-max)) + (insert "\nRetry with ") + (insert-text-button "'-all'" + 'follow-link t + 'action #'(lambda (_b) + (octave-lookfor str '-all))) + (insert ".\n")) + (octave-help-mode))))) + +(defcustom octave-source-directories nil + "A list of directories for Octave sources. +If the environment variable OCTAVE_SRCDIR is set, it is searched first." + :type '(repeat directory) + :group 'octave + :version "24.4") + +(defun octave-source-directories () + (let ((srcdir (or (and inferior-octave-process + (process-get inferior-octave-process 'octave-srcdir)) + (getenv "OCTAVE_SRCDIR")))) + (if srcdir + (cons srcdir octave-source-directories) + octave-source-directories))) + +(defvar octave-find-definition-filename-function + #'octave-find-definition-default-filename) + +(defun octave-find-definition-default-filename (name) + "Default value for `octave-find-definition-filename-function'." + (pcase (file-name-extension name) + ("oct" + (octave-find-definition-default-filename + (concat "libinterp/dldfcn/" + (file-name-sans-extension (file-name-nondirectory name)) + ".cc"))) + ("cc" + (let ((file (or (locate-file name (octave-source-directories)) + (locate-file (file-name-nondirectory name) + (octave-source-directories))))) + (or (and file (file-exists-p file)) + (error "File `%s' not found" name)) + file)) + ("mex" + (if (yes-or-no-p (format "File `%s' may be binary; open? " + (file-name-nondirectory name))) + name + (user-error "Aborted"))) + (t name))) + +(defvar find-tag-marker-ring) + +(defun octave-find-definition (fn) + "Find the definition of FN. +Functions implemented in C++ can be found if +variable `octave-source-directories' is set correctly." + (interactive (list (octave-completing-read))) + (require 'etags) + (let ((orig (point))) + (if (and (derived-mode-p 'octave-mode) + (octave-goto-function-definition fn)) + (ring-insert find-tag-marker-ring (copy-marker orig)) + (inferior-octave-send-list-and-digest + ;; help NAME is more verbose + (list (format "\ +if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" + fn fn fn))) + (let (line file) + ;; Skip garbage lines such as + ;; warning: fmincg.m: possible Matlab-style .... + (while (and (not file) (consp inferior-octave-output-list)) + (setq line (pop inferior-octave-output-list)) + (when (string-match "from the file \\(.*\\)$" line) + (setq file (match-string 1 line)))) + (if (not file) + (user-error "%s" (or line (format "`%s' not found" fn))) + (ring-insert find-tag-marker-ring (point-marker)) + (setq file (funcall octave-find-definition-filename-function file)) + (when file + (find-file file) + (octave-goto-function-definition fn))))))) + +(provide 'octave) +;;; octave.el ends here diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5f78b770936..dfb2b72a9d6 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1,6 +1,6 @@ ;;; opascal.el --- major mode for editing Object Pascal source in Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999, 2001-2014 Free Software Foundation, Inc. ;; Authors: Ray Blaak , ;; Simon South @@ -106,32 +106,13 @@ end; end;" (define-obsolete-variable-alias 'delphi-tab-always-indents 'opascal-tab-always-indents "24.4") (defcustom opascal-tab-always-indents tab-always-indent - "Non-nil means TAB in OPascal mode should always reindent the current line, -regardless of where in the line point is when the TAB command is used." + "Non-nil means `opascal-tab' should always reindent the current line. +That is, regardless of where in the line point is at the time." :type 'boolean) -(define-obsolete-variable-alias - 'delphi-comment-face 'opascal-comment-face "24.4") -(defcustom opascal-comment-face 'font-lock-comment-face - "Face used to color OPascal comments." - :type 'face) - -(define-obsolete-variable-alias - 'delphi-string-face 'opascal-string-face "24.4") -(defcustom opascal-string-face 'font-lock-string-face - "Face used to color OPascal strings." - :type 'face) - -(define-obsolete-variable-alias - 'delphi-keyword-face 'opascal-keyword-face "24.4") -(defcustom opascal-keyword-face 'font-lock-keyword-face - "Face used to color OPascal keywords." - :type 'face) - -(define-obsolete-variable-alias 'delphi-other-face 'opascal-other-face "24.4") -(defcustom opascal-other-face nil - "Face used to color everything else." - :type '(choice (const :tag "None" nil) face)) +(make-obsolete-variable 'opascal-tab-always-indents + "use `indent-for-tab-command' and `tab-always-indent'." + "24.4") (defconst opascal-directives '(absolute abstract assembler automated cdecl default dispid dynamic @@ -274,6 +255,21 @@ routine.") (defconst opascal-leading-spaces-re (concat "^" opascal-spaces-re)) (defconst opascal-word-chars "a-zA-Z0-9_") +(defvar opascal-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Strings. + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?\' "\"" st) + ;; Comments. + (modify-syntax-entry ?\{ "<" st) + (modify-syntax-entry ?\} ">" st) + (modify-syntax-entry ?\( "()1" st) + (modify-syntax-entry ?\) ")(4" st) + (modify-syntax-entry ?* ". 23b" st) + (modify-syntax-entry ?/ ". 12c" st) + (modify-syntax-entry ?\n "> c" st) + st)) + (defmacro opascal-save-excursion (&rest forms) ;; Executes the forms such that any movements have no effect, including ;; searches. @@ -283,13 +279,6 @@ routine.") (deactivate-mark nil)) (progn ,@forms))))) -(defmacro opascal-save-state (&rest forms) - ;; Executes the forms such that any buffer modifications do not have any side - ;; effects beyond the buffer's actual content changes. - `(let ((opascal--ignore-changes t)) - (with-silent-modifications - ,@forms))) - (defsubst opascal-is (element in-set) ;; If the element is in the set, the element cdr is returned, otherwise nil. (memq element in-set)) @@ -347,13 +336,6 @@ routine.") ;; Returns the column of the point p. (save-excursion (goto-char p) (current-column))) -(defun opascal-face-of (token-kind) - ;; Returns the face property appropriate for the token kind. - (cond ((opascal-is token-kind opascal-comments) opascal-comment-face) - ((opascal-is token-kind opascal-strings) opascal-string-face) - ((opascal-is token-kind opascal-keywords) opascal-keyword-face) - (opascal-other-face))) - (defvar opascal-progress-last-reported-point nil "The last point at which progress was reported.") @@ -361,8 +343,6 @@ routine.") "Number of chars to process before the next parsing progress report.") (defconst opascal-scanning-progress-step 2048 "Number of chars to process before the next scanning progress report.") -(defconst opascal-fontifying-progress-step opascal-scanning-progress-step - "Number of chars to process before the next fontification progress report.") (defun opascal-progress-start () ;; Initializes progress reporting. @@ -400,22 +380,30 @@ routine.") (goto-char curr-point) next)) -(defvar opascal--ignore-changes t - "Internal flag to control if the OPascal mode responds to buffer changes. -Defaults to t in case the `opascal-after-change' function is called on a -non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: - (let ((opascal--ignore-changes t)) ...)") - -(defun opascal-set-text-properties (from to properties) - ;; Like `set-text-properties', except we do not consider this to be a buffer - ;; modification. - (opascal-save-state - (set-text-properties from to properties))) +(defconst opascal--literal-start-re (regexp-opt '("//" "{" "(*" "'" "\""))) (defun opascal-literal-kind (p) ;; Returns the literal kind the point p is in (or nil if not in a literal). - (if (and (<= (point-min) p) (<= p (point-max))) - (get-text-property p 'token))) + (when (and (<= (point-min) p) (<= p (point-max))) + (save-excursion + (let ((ppss (syntax-ppss p))) + ;; We want to return non-nil when right in front + ;; of a comment/string. + (if (null (nth 8 ppss)) + (when (looking-at opascal--literal-start-re) + (pcase (char-after) + (`?/ 'comment-single-line) + (`?\{ 'comment-multi-line-1) + (`?\( 'comment-multi-line-2) + (`?\' 'string) + (`?\" 'double-quoted-string))) + (if (nth 3 ppss) ;String. + (if (eq (nth 3 ppss) ?\") + 'double-quoted-string 'string) + (pcase (nth 7 ppss) + (`2 'comment-single-line) + (`1 'comment-multi-line-2) + (_ 'comment-multi-line-1)))))))) (defun opascal-literal-start-pattern (literal-kind) ;; Returns the start pattern of the literal kind. @@ -446,96 +434,27 @@ non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: (string . "['\n]") (double-quoted-string . "[\"\n]"))))) -(defun opascal-is-literal-start (p) - ;; True if the point p is at the start point of a (completed) literal. - (let* ((kind (opascal-literal-kind p)) - (pattern (opascal-literal-start-pattern kind))) - (or (null kind) ; Non-literals are considered as start points. - (opascal-looking-at-string p pattern)))) - (defun opascal-is-literal-end (p) ;; True if the point p is at the end point of a (completed) literal. - (let* ((kind (opascal-literal-kind (1- p))) - (pattern (opascal-literal-end-pattern kind))) - (or (null kind) ; Non-literals are considered as end points. - - (and (opascal-looking-at-string (- p (length pattern)) pattern) - (or (not (opascal-is kind opascal-strings)) - ;; Special case: string delimiters are start/end ambiguous. - ;; We have an end only if there is some string content (at - ;; least a starting delimiter). - (not (opascal-is-literal-end (1- p))))) - - ;; Special case: strings cannot span lines. - (and (opascal-is kind opascal-strings) (eq ?\n (char-after (1- p))))))) - -(defun opascal-is-stable-literal (p) - ;; True if the point p marks a stable point. That is, a point outside of a - ;; literal region, inside of a literal region, or adjacent to completed - ;; literal regions. - (let ((at-start (opascal-is-literal-start p)) - (at-end (opascal-is-literal-end p))) - (or (>= p (point-max)) - (and at-start at-end) - (and (not at-start) (not at-end) - (eq (opascal-literal-kind (1- p)) (opascal-literal-kind p)))))) - -(defun opascal-complete-literal (literal-kind limit) - ;; Continues the search for a literal's true end point and returns the - ;; point past the end pattern (if found) or the limit (if not found). - (let ((pattern (opascal-literal-stop-pattern literal-kind))) - (if (not (stringp pattern)) - (error "Invalid literal kind %S" literal-kind) - ;; Search up to the limit. - (re-search-forward pattern limit 'goto-limit-on-fail) - (point)))) - -(defun opascal-literal-text-properties (kind) - ;; Creates a list of text properties for the literal kind. - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (list 'token kind 'face (opascal-face-of kind) 'lazy-lock t) - (list 'token kind))) - -(defun opascal-parse-next-literal (limit) - ;; Searches for the next literal region (i.e. comment or string) and sets the - ;; the point to its end (or the limit, if not found). The literal region is - ;; marked as such with a text property, to speed up tokenizing during face - ;; coloring and indentation scanning. - (let ((search-start (point))) - (cond ((not (opascal-is-literal-end search-start)) - ;; We are completing an incomplete literal. - (let ((kind (opascal-literal-kind (1- search-start)))) - (opascal-complete-literal kind limit) - (opascal-set-text-properties - search-start (point) (opascal-literal-text-properties kind)))) - - ((re-search-forward - "\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)" - limit 'goto-limit-on-fail) - ;; We found the start of a new literal. Find its end and mark it. - (let ((kind (cond ((match-beginning 1) 'comment-single-line) - ((match-beginning 2) 'comment-multi-line-1) - ((match-beginning 3) 'comment-multi-line-2) - ((match-beginning 4) 'string) - ((match-beginning 5) 'double-quoted-string))) - (start (match-beginning 0))) - (opascal-set-text-properties search-start start nil) - (opascal-complete-literal kind limit) - (opascal-set-text-properties - start (point) (opascal-literal-text-properties kind)))) - - ;; Nothing found. Mark it as a non-literal. - ((opascal-set-text-properties search-start limit nil))) - (opascal-step-progress (point) "Parsing" opascal-parsing-progress-step))) + (save-excursion + (and (null (nth 8 (syntax-ppss p))) + (nth 8 (syntax-ppss (1- p)))))) (defun opascal-literal-token-at (p) - ;; Returns the literal token surrounding the point p, or nil if none. - (let ((kind (opascal-literal-kind p))) - (when kind - (let ((start (previous-single-property-change (1+ p) 'token)) - (end (next-single-property-change p 'token))) - (opascal-token-of kind (or start (point-min)) (or end (point-max))))))) + "Return the literal token surrounding the point P, or nil if none." + (save-excursion + (let ((ppss (syntax-ppss p))) + (when (or (nth 8 ppss) (looking-at opascal--literal-start-re)) + (let* ((new-start (or (nth 8 ppss) p)) + (new-end (progn + (goto-char new-start) + (condition-case nil + (if (memq (char-after) '(?\' ?\")) + (forward-sexp 1) + (forward-comment 1)) + (scan-error (goto-char (point-max)))) + (point)))) + (opascal-token-of (opascal-literal-kind p) new-start new-end)))))) (defun opascal-point-token-at (p kind) ;; Returns the single character token at the point p. @@ -645,55 +564,6 @@ non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: (opascal-is (opascal-token-kind next-token) '(space newline)))) next-token)) -(defun opascal-parse-region (from to) - ;; Parses the literal tokens in the region. The point is set to "to". - (save-restriction - (widen) - (goto-char from) - (while (< (point) to) - (opascal-parse-next-literal to)))) - -(defun opascal-parse-region-until-stable (from to) - ;; Parses at least the literal tokens in the region. After that, parsing - ;; continues as long as obsolete literal regions are encountered. The point - ;; is set to the encountered stable point. - (save-restriction - (widen) - (opascal-parse-region from to) - (while (not (opascal-is-stable-literal (point))) - (opascal-parse-next-literal (point-max))))) - -(defun opascal-fontify-region (from to &optional verbose) - ;; Colors the text in the region according to OPascal rules. - (opascal-save-excursion - (opascal-save-state - (let ((p from) - (opascal-verbose verbose) - (token nil)) - (opascal-progress-start) - (while (< p to) - ;; Color the token and move past it. - (setq token (opascal-token-at p)) - (add-text-properties - (opascal-token-start token) (opascal-token-end token) - (list 'face (opascal-face-of (opascal-token-kind token)) 'lazy-lock t)) - (setq p (opascal-token-end token)) - (opascal-step-progress p "Fontifying" opascal-fontifying-progress-step)) - (opascal-progress-done))))) - -(defun opascal-after-change (change-start change-end _old-length) - ;; Called when the buffer has changed. Reparses the changed region. - (unless opascal--ignore-changes - (let ((opascal--ignore-changes t)) ; Prevent recursive calls. - (opascal-save-excursion - (opascal-progress-start) - ;; Reparse at least from the token previous to the change to the end of - ;; line after the change. - (opascal-parse-region-until-stable - (opascal-token-start (opascal-token-at (1- change-start))) - (progn (goto-char change-end) (end-of-line) (point))) - (opascal-progress-done))))) - (defun opascal-group-start (from-token) ;; Returns the token that denotes the start of the ()/[] group. (let ((token (opascal-previous-token from-token)) @@ -1561,41 +1431,6 @@ If before the indent, the point is moved to the indent." (interactive "r") (opascal-debug-log "String: %S" (buffer-substring from to))) -(defun opascal-debug-show-is-stable () - (interactive) - (opascal-debug-log "stable: %S prev: %S next: %S" - (opascal-is-stable-literal (point)) - (opascal-literal-kind (1- (point))) - (opascal-literal-kind (point)))) - -(defun opascal-debug-unparse-buffer () - (interactive) - (opascal-set-text-properties (point-min) (point-max) nil)) - -(defun opascal-debug-parse-region (from to) - (interactive "r") - (let ((opascal-verbose t)) - (opascal-save-excursion - (opascal-progress-start) - (opascal-parse-region from to) - (opascal-progress-done "Parsing done")))) - -(defun opascal-debug-parse-window () - (interactive) - (opascal-debug-parse-region (window-start) (window-end))) - -(defun opascal-debug-parse-buffer () - (interactive) - (opascal-debug-parse-region (point-min) (point-max))) - -(defun opascal-debug-fontify-window () - (interactive) - (opascal-fontify-region (window-start) (window-end) t)) - -(defun opascal-debug-fontify-buffer () - (interactive) - (opascal-fontify-region (point-min) (point-max) t)) - (defun opascal-debug-tokenize-region (from to) (interactive) (opascal-save-excursion @@ -1616,8 +1451,8 @@ If before the indent, the point is moved to the indent." (defun opascal-tab () - "Indent the region, when Transient Mark mode is enabled and the region is -active. Otherwise, indent the current line or insert a TAB, depending on the + "Indent the region, if Transient Mark mode is on and the region is active. +Otherwise, indent the current line or insert a TAB, depending on the value of `opascal-tab-always-indents' and the current line position." (interactive) (cond ((use-region-p) @@ -1634,6 +1469,7 @@ value of `opascal-tab-always-indents' and the current line position." ;; Otherwise, insert a tab character. (insert "\t")))) +(make-obsolete 'opascal-tab 'indent-for-tab-command "24.4") (defun opascal-is-directory (path) ;; True if the specified path is an existing directory. @@ -1747,6 +1583,7 @@ An error is raised if not in a comment." (error "Not in a comment") (let* ((start-comment (opascal-comment-block-start comment)) (end-comment (opascal-comment-block-end comment)) + ;; FIXME: Don't abuse global variables like `comment-end/start'. (comment-start (opascal-token-start start-comment)) (comment-end (opascal-token-end end-comment)) (content-start (opascal-comment-content-start start-comment)) @@ -1814,12 +1651,7 @@ An error is raised if not in a comment." ;; Restore our position (goto-char marked-point) - (set-marker marked-point nil) - - ;; React to the entire fill change as a whole. - (opascal-progress-start) - (opascal-parse-region comment-start comment-end) - (opascal-progress-done))))))) + (set-marker marked-point nil))))))) (defun opascal-new-comment-line () "If in a // comment, do a newline, indented such that one is still in the @@ -1848,16 +1680,37 @@ comment block. If not in a // comment, just does a normal newline." (goto-char end) token))) +(defconst opascal-font-lock-keywords + `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)" + (1 font-lock-keyword-face) (3 font-lock-function-name-face)) + ,(concat "\\_<" (regexp-opt (mapcar #'symbol-name opascal-keywords)) + "\\_>"))) + (defconst opascal-font-lock-defaults - '(nil ; We have our own fontify routine, so keywords don't apply. - t ; Syntactic fontification doesn't apply. + '(opascal-font-lock-keywords + nil ; Syntactic fontification does apply. nil ; Don't care about case since we don't use regexps to find tokens. nil ; Syntax alists don't apply. - nil ; Syntax begin movement doesn't apply - (font-lock-fontify-region-function . opascal-fontify-region) - (font-lock-verbose . opascal-fontifying-progress-step)) + nil ; Syntax begin movement doesn't apply. + ) "OPascal mode font-lock defaults. Syntactic fontification is ignored.") +(defconst opascal--syntax-propertize + (syntax-propertize-rules + ;; The syntax-table settings are too coarse and end up treating /* and (/ + ;; as comment starters. Fix it here by removing the "2" from the syntax + ;; of the second char of such sequences. + ("/\\(\\*\\)" (1 ". 3b")) + ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ;; Pascal uses '' and "" rather than \' and \" to escape quotes. + ("''\\|\"\"" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + ;; In case of 3 or more quotes in a row, only advance + ;; one quote at a time. + (forward-char -1) + nil))))) + (defvar opascal-debug-mode-map (let ((kmap (make-sparse-keymap))) (dolist (binding '(("n" opascal-debug-goto-next-token) @@ -1866,14 +1719,7 @@ comment block. If not in a // comment, just does a normal newline." ("T" opascal-debug-tokenize-buffer) ("W" opascal-debug-tokenize-window) ("g" opascal-debug-goto-point) - ("s" opascal-debug-show-current-string) - ("a" opascal-debug-parse-buffer) - ("w" opascal-debug-parse-window) - ("f" opascal-debug-fontify-window) - ("F" opascal-debug-fontify-buffer) - ("r" opascal-debug-parse-region) - ("c" opascal-debug-unparse-buffer) - ("x" opascal-debug-show-is-stable))) + ("s" opascal-debug-show-current-string))) (define-key kmap (car binding) (cadr binding))) kmap) "Keystrokes for OPascal mode debug commands.") @@ -1913,9 +1759,6 @@ Customization: Extra indentation for blocks in compound statements. `opascal-case-label-indent' (default 0) Extra indentation for case statement labels. - `opascal-tab-always-indents' (default `tab-always-indents') - Non-nil means TAB in OPascal mode should always reindent the current line, - regardless of where in the line point is when the TAB command is used. `opascal-search-path' (default .) Directories to search when finding external units. `opascal-verbose' (default nil) @@ -1923,14 +1766,8 @@ Customization: Coloring: - `opascal-comment-face' (default font-lock-comment-face) - Face used to color OPascal comments. - `opascal-string-face' (default font-lock-string-face) - Face used to color OPascal strings. `opascal-keyword-face' (default font-lock-keyword-face) Face used to color OPascal keywords. - `opascal-other-face' (default nil) - Face used to color everything else. Turning on OPascal mode calls the value of the variable `opascal-mode-hook' with no args, if that value is non-nil." @@ -1940,21 +1777,13 @@ with no args, if that value is non-nil." (setq-local comment-indent-function #'opascal-indent-line) (setq-local case-fold-search t) (setq-local opascal-progress-last-reported-point nil) - (setq-local opascal--ignore-changes nil) (setq-local font-lock-defaults opascal-font-lock-defaults) (setq-local tab-always-indent opascal-tab-always-indents) + (setq-local syntax-propertize-function opascal--syntax-propertize) - ;; FIXME: Use syntax-propertize-function to tokenize, maybe? - - ;; We need to keep track of changes to the buffer to determine if we need - ;; to retokenize changed text. - (add-hook 'after-change-functions #'opascal-after-change nil t) - - (opascal-save-excursion - (let ((opascal-verbose t)) - (opascal-progress-start) - (opascal-parse-region (point-min) (point-max)) - (opascal-progress-done)))) + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://\\|(\\*\\|{\\)[ \t]*") + (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*)\\|}\\)")) (provide 'opascal) ;;; opascal.el ends here diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 829ecda5150..ed79eacecc4 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1,6 +1,6 @@ ;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1993-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-2014 Free Software Foundation, Inc. ;; Author: Espen Skoglund ;; Keywords: languages @@ -158,31 +158,44 @@ -(defconst pascal-font-lock-keywords (purecopy - (list - '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)" +(defconst pascal-font-lock-keywords + `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)" + (1 font-lock-keyword-face) + (3 font-lock-function-name-face)) + ;; ("type" "const" "real" "integer" "char" "boolean" "var" + ;; "record" "array" "file") + (,(concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" + "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") + font-lock-type-face) + ("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face) + ("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) + ;; ("of" "to" "for" "if" "then" "else" "case" "while" + ;; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") + ,(concat "\\<\\(" + "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" + "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" + "\\)\\>") + ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" 1 font-lock-keyword-face) - '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)" - 3 font-lock-function-name-face t) -; ("type" "const" "real" "integer" "char" "boolean" "var" -; "record" "array" "file") - (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" - "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") - 'font-lock-type-face) - '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face) - '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) -; ("of" "to" "for" "if" "then" "else" "case" "while" -; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") - (concat "\\<\\(" - "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" - "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" - "\\)\\>") - '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 1 font-lock-keyword-face) - '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 2 font-lock-keyword-face t))) + ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" + 2 font-lock-keyword-face t)) "Additional expressions to highlight in Pascal mode.") -(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t)) + +(defconst pascal--syntax-propertize + (syntax-propertize-rules + ;; The syntax-table settings are too coarse and end up treating /* and (/ + ;; as comment starters. Fix it here by removing the "2" from the syntax + ;; of the second char of such sequences. + ("/\\(\\*\\)" (1 ". 3b")) + ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ;; Pascal uses '' and "" rather than \' and \" to escape quotes. + ("''\\|\"\"" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + ;; In case of 3 or more quotes in a row, only advance + ;; one quote at a time. + (forward-char -1) + nil))))) (defcustom pascal-indent-level 3 "Indentation of Pascal statements with respect to containing block." @@ -346,23 +359,22 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." - (set (make-local-variable 'local-abbrev-table) pascal-mode-abbrev-table) - (set (make-local-variable 'indent-line-function) 'pascal-indent-line) - (set (make-local-variable 'comment-indent-function) 'pascal-indent-comment) - (set (make-local-variable 'parse-sexp-ignore-comments) nil) - (set (make-local-variable 'blink-matching-paren-dont-ignore-comments) t) - (set (make-local-variable 'case-fold-search) t) - (set (make-local-variable 'comment-start) "{") - (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *") - (set (make-local-variable 'comment-end) "}") + (setq-local local-abbrev-table pascal-mode-abbrev-table) + (setq-local indent-line-function 'pascal-indent-line) + (setq-local comment-indent-function 'pascal-indent-comment) + (setq-local parse-sexp-ignore-comments nil) + (setq-local blink-matching-paren-dont-ignore-comments t) + (setq-local case-fold-search t) + (setq-local comment-start "{") + (setq-local comment-start-skip "(\\*+ *\\|{ *") + (setq-local comment-end "}") (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t) ;; Font lock support - (set (make-local-variable 'font-lock-defaults) - '(pascal-font-lock-keywords nil t)) + (setq-local font-lock-defaults '(pascal-font-lock-keywords nil t)) + (setq-local syntax-propertize-function pascal--syntax-propertize) ;; Imenu support - (set (make-local-variable 'imenu-generic-expression) - pascal-imenu-generic-expression) - (set (make-local-variable 'imenu-case-fold-search) t) + (setq-local imenu-generic-expression pascal-imenu-generic-expression) + (setq-local imenu-case-fold-search t) ;; Pascal-mode's own hide/show support. (add-to-invisibility-spec '(pascal . t))) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index bd58a7300ec..d09fb59371a 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -1,9 +1,9 @@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: William F. Mann -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Adapted-By: ESR ;; Keywords: languages @@ -127,7 +127,7 @@ (modify-syntax-entry ?\n ">" st) (modify-syntax-entry ?# "<" st) ;; `$' is also a prefix char so I was tempted to say "/ p", - ;; but the `p' thingy basically overrides the `/' :-( --stef + ;; but the `p' thingy basically overrides the `/' :-( -- Stef (modify-syntax-entry ?$ "/" st) (modify-syntax-entry ?% ". p" st) (modify-syntax-entry ?@ ". p" st) @@ -148,53 +148,20 @@ (defvar perl-imenu-generic-expression '(;; Functions - (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) ;;Variables - ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) - ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) + ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") ;; Regexps updated with help from Tom Tromey and ;; Jim Campbell . -(defcustom perl-prettify-symbols t - "If non-nil, some symbols will be displayed using Unicode chars." - :type 'boolean) - (defconst perl--prettify-symbols-alist - '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) - ;;("div" . ?÷) ("*" . ?×) ("o" . ?○) - ("->" . ?→) + '(("->" . ?→) ("=>" . ?⇒) - ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) - ("::" . ?∷) - )) - -(defun perl--font-lock-compose-symbol () - "Compose a sequence of ascii chars into a symbol. -Regexp match data 0 points to the chars." - ;; Check that the chars should really be composed into a symbol. - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (syntaxes (if (eq (char-syntax (char-after start)) ?w) - '(?w) '(?. ?\\)))) - (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) - (memq (char-syntax (or (char-after end) ?\ )) syntaxes) - (nth 8 (syntax-ppss))) - ;; No composition for you. Let's actually remove any composition - ;; we may have added earlier and which is now incorrect. - (remove-text-properties start end '(composition)) - ;; That's a symbol alright, so add the composition. - (compose-region start end (cdr (assoc (match-string 0) - perl--prettify-symbols-alist))))) - ;; Return nil because we're not adding any face property. - nil) - -(defun perl--font-lock-symbols-keywords () - (when perl-prettify-symbols - `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t) - (0 (perl--font-lock-compose-symbol)))))) + ("::" . ?∷))) (defconst perl-font-lock-keywords-1 '(;; What is this for? @@ -242,8 +209,7 @@ Regexp match data 0 points to the chars." ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) - ,@(perl--font-lock-symbols-keywords))) + ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) "Gaudy level highlighting for Perl mode.") (defvar perl-font-lock-keywords perl-font-lock-keywords-1 @@ -275,7 +241,6 @@ Regexp match data 0 points to the chars." (let ((case-fold-search nil)) (goto-char start) (perl-syntax-propertize-special-constructs end) - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") (funcall (syntax-propertize-rules ;; Turn POD into b-style comments. Place the cut rule first since it's @@ -287,7 +252,7 @@ Regexp match data 0 points to the chars." ;; check that it occurs inside a '..' string. ("\\(\\$\\)[{']" (1 ". p")) ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) @@ -345,7 +310,29 @@ Regexp match data 0 points to the chars." perl-quote-like-pairs) (string-to-syntax "|") (string-to-syntax "\""))) - (perl-syntax-propertize-special-constructs end)))))) + (perl-syntax-propertize-special-constructs end))))) + ;; Here documents. + ;; TODO: Handle < c")))))) ((or (null (setq char (nth 3 state))) (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) ;; Normal text, or comment, or docstring, or normal string. @@ -491,8 +494,7 @@ Regexp match data 0 points to the chars." (defcustom perl-indent-level 4 "Indentation of Perl statements with respect to containing block." - :type 'integer - :group 'perl) + :type 'integer) ;; Is is not unusual to put both things like perl-indent-level and ;; cperl-indent-level in the local variable section of a file. If only @@ -508,45 +510,37 @@ Regexp match data 0 points to the chars." (defcustom perl-continued-statement-offset 4 "Extra indent for lines not starting new statements." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-continued-brace-offset -4 "Extra indent for substatements that start with open-braces. This is in addition to `perl-continued-statement-offset'." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-offset 0 "Extra indentation for braces, compared with other text in same context." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-imaginary-offset 0 "Imagined indentation of an open brace that actually follows a statement." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-label-offset -2 "Offset of Perl label lines relative to usual indentation." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-indent-continued-arguments nil "If non-nil offset of argument lines relative to usual indentation. If nil, continued arguments are aligned with the first argument." - :type '(choice integer (const nil)) - :group 'perl) + :type '(choice integer (const nil))) (defcustom perl-indent-parens-as-block nil "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks. The closing bracket is aligned with the line of the opening bracket, not the contents of the brackets." :version "24.3" - :type 'boolean - :group 'perl) + :type 'boolean) (defcustom perl-tab-always-indent tab-always-indent "Non-nil means TAB in Perl mode always indents the current line. Otherwise it inserts a tab character if you type it past the first nonwhite character on the line." - :type 'boolean - :group 'perl) + :type 'boolean) ;; I changed the default to nil for consistency with general Emacs ;; conventions -- rms. @@ -555,13 +549,12 @@ nonwhite character on the line." For lines which don't need indenting, TAB either indents an existing comment, moves to end-of-line, or if at end-of-line already, create a new comment." - :type 'boolean - :group 'perl) + :type 'boolean) -(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]" +(defcustom perl-nochange "\f" "Lines starting with this regular expression are not auto-indented." :type 'regexp - :group 'perl) + :options '(";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]")) ;; Outline support @@ -647,13 +640,15 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") (setq-local comment-indent-function #'perl-comment-indent) (setq-local parse-sexp-ignore-comments t) + ;; Tell font-lock.el how to handle Perl. (setq font-lock-defaults '((perl-font-lock-keywords - perl-font-lock-keywords-1 - perl-font-lock-keywords-2) - nil nil ((?\_ . "w")) nil + perl-font-lock-keywords-1 + perl-font-lock-keywords-2) + nil nil ((?\_ . "w")) nil (font-lock-syntactic-face-function . perl-font-lock-syntactic-face-function))) + (setq-local prettify-symbols-alist perl--prettify-symbols-alist) (setq-local syntax-propertize-function #'perl-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) @@ -680,7 +675,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (define-obsolete-function-alias 'electric-perl-terminator 'perl-electric-terminator "22.1") -(defun perl-electric-noindent-p (char) +(defun perl-electric-noindent-p (_char) (unless (eolp) 'no-indent)) (defun perl-electric-terminator (arg) @@ -798,7 +793,11 @@ Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string." (let ((case-fold-search nil) (pos (- (point-max) (point))) - (bof (or parse-start (save-excursion (perl-beginning-of-function)))) + (bof (or parse-start (save-excursion + ;; Don't consider text on this line as a + ;; valid BOF from which to indent. + (goto-char (line-end-position 0)) + (perl-beginning-of-function)))) beg indent shift-amt) (beginning-of-line) (setq beg (point)) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el new file mode 100644 index 00000000000..3b850f3305b --- /dev/null +++ b/lisp/progmodes/prog-mode.el @@ -0,0 +1,149 @@ +;;; prog-mode.el --- Generic major mode for programming -*- lexical-binding: t -*- + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: internal +;; Package: emacs + +;; 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 . + +;;; Commentary: + +;; This major mode is mostly intended as a parent of other programming +;; modes. All major modes for programming languages should derive from this +;; mode so that users can put generic customization on prog-mode-hook. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(defgroup prog-mode nil + "Generic programming mode, from which others derive." + :group 'languages) + +(defvar prog-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-\M-q] 'prog-indent-sexp) + map) + "Keymap used for programming modes.") + +(defun prog-indent-sexp (&optional defun) + "Indent the expression after point. +When interactively called with prefix, indent the enclosing defun +instead." + (interactive "P") + (save-excursion + (when defun + (end-of-line) + (beginning-of-defun)) + (let ((start (point)) + (end (progn (forward-sexp 1) (point)))) + (indent-region start end nil)))) + +(defvar-local prettify-symbols-alist nil + "Alist of symbol prettifications. +Each element looks like (SYMBOL . CHARACTER), where the symbol +matching SYMBOL (a string, not a regexp) will be shown as +CHARACTER instead.") + +(defun prettify-symbols--compose-symbol (alist) + "Compose a sequence of characters into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (if (eq (char-syntax (char-after start)) ?w) + '(?w) '(?. ?\\))) + match) + (if (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes) + (memq (char-syntax (or (char-after end) ?\s)) syntaxes) + ;; syntax-ppss could modify the match data (bug#14595) + (progn (setq match (match-string 0)) (nth 8 (syntax-ppss)))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc match alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun prettify-symbols--make-keywords () + (if prettify-symbols-alist + `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t) + (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist)))) + nil)) + +(defvar-local prettify-symbols--keywords nil) + +;;;###autoload +(define-minor-mode prettify-symbols-mode + "Toggle Prettify Symbols mode. +With a prefix argument ARG, enable Prettify Symbols mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +When Prettify Symbols mode and font-locking are enabled, symbols are +prettified (displayed as composed characters) according to the rules +in `prettify-symbols-alist' (which see), which are locally defined +by major modes supporting prettifying. To add further customizations +for a given major mode, you can modify `prettify-symbols-alist' thus: + + (add-hook 'emacs-lisp-mode-hook + (lambda () + (push '(\"<=\" . ?≤) prettify-symbols-alist))) + +You can enable this mode locally in desired buffers, or use +`global-prettify-symbols-mode' to enable it for all modes that +support it." + :init-value nil + (if prettify-symbols-mode + ;; Turn on + (when (setq prettify-symbols--keywords (prettify-symbols--make-keywords)) + (font-lock-add-keywords nil prettify-symbols--keywords) + (setq-local font-lock-extra-managed-props + (cons 'composition font-lock-extra-managed-props)) + (font-lock-fontify-buffer)) + ;; Turn off + (when prettify-symbols--keywords + (font-lock-remove-keywords nil prettify-symbols--keywords) + (setq prettify-symbols--keywords nil)) + (when (memq 'composition font-lock-extra-managed-props) + (setq font-lock-extra-managed-props (delq 'composition + font-lock-extra-managed-props)) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) '(composition nil)))))) + +(defun turn-on-prettify-symbols-mode () + (when (and (not prettify-symbols-mode) + (local-variable-p 'prettify-symbols-alist)) + (prettify-symbols-mode 1))) + +;;;###autoload +(define-globalized-minor-mode global-prettify-symbols-mode + prettify-symbols-mode turn-on-prettify-symbols-mode) + +;;;###autoload +(define-derived-mode prog-mode fundamental-mode "Prog" + "Major mode for editing programming language source code." + (setq-local require-final-newline mode-require-final-newline) + (setq-local parse-sexp-ignore-comments t) + ;; Any programming language is always written left to right. + (setq bidi-paragraph-direction 'left-to-right)) + +(provide 'prog-mode) + +;;; prog-mode.el ends here diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 460dcd69447..d82eea05e1c 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1,9 +1,9 @@ -;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code +;;; prolog.el --- major mode for Prolog (and Mercury) -*- lexical-binding:t -*- -;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2013 Free +;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2014 Free ;; Software Foundation, Inc. -;; Authors: Emil strm +;; Authors: Emil Åström ;; Milan Zamazal ;; Stefan Bruda ;; * See below for more details @@ -31,7 +31,7 @@ ;; Original author: Masanobu UMEDA ;; Parts of this file was taken from a modified version of the original ;; by Johan Andersson, Peter Olin, Mats Carlsson, Johan Bevemyr, Stefan -;; Andersson, and Per Danielsson (all SICS people), and Henrik Bkman +;; Andersson, and Per Danielsson (all SICS people), and Henrik Båkman ;; at Uppsala University, Sweden. ;; ;; Some ideas and also a few lines of code have been borrowed (not stolen ;-) @@ -278,16 +278,16 @@ ;;; Code: +(require 'comint) + (eval-when-compile (require 'font-lock) ;; We need imenu everywhere because of the predicate index! (require 'imenu) ;) - (require 'info) (require 'shell) ) -(require 'comint) (require 'easymenu) (require 'align) @@ -376,29 +376,8 @@ The version numbers are of the format (Major . Minor)." :group 'prolog-indentation :type 'integer) -(defcustom prolog-align-comments-flag t - "Non-nil means automatically align comments when indenting." - :version "24.1" - :group 'prolog-indentation - :type 'boolean) - -(defcustom prolog-indent-mline-comments-flag t - "Non-nil means indent contents of /* */ comments. -Otherwise leave such lines as they are." - :version "24.1" - :group 'prolog-indentation - :type 'boolean) - -(defcustom prolog-object-end-to-0-flag t - "Non-nil means indent closing '}' in SICStus object definitions to level 0. -Otherwise indent to `prolog-indent-width'." - :version "24.1" - :group 'prolog-indentation - :type 'boolean) - (defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)" - "Regexp for character sequences after which next line is indented. -Next line after such a regexp is indented to the opening parenthesis level." + "Regexp for `prolog-electric-if-then-else-flag'." :version "24.1" :group 'prolog-indentation :type 'regexp) @@ -503,12 +482,6 @@ Legal values: ;; Keyboard -(defcustom prolog-electric-newline-flag (not (fboundp 'electric-indent-mode)) - "Non-nil means automatically indent the next line when the user types RET." - :version "24.1" - :group 'prolog-keyboard - :type 'boolean) - (defcustom prolog-hungry-delete-key-flag nil "Non-nil means delete key consumes all preceding spaces." :version "24.1" @@ -545,14 +518,6 @@ If underscore is pressed not on a variable then it behaves as usual." :group 'prolog-keyboard :type 'boolean) -(defcustom prolog-electric-tab-flag nil - "Non-nil means make TAB key electric. -Electric TAB inserts spaces after parentheses, ->, and ; -in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions." - :version "24.1" - :group 'prolog-keyboard - :type 'boolean) - (defcustom prolog-electric-if-then-else-flag nil "Non-nil makes `(', `>' and `;' electric to automatically indent if-then-else constructs." @@ -739,14 +704,6 @@ is non-nil for this variable." ;; Miscellaneous -(defcustom prolog-use-prolog-tokenizer-flag - (not (fboundp 'syntax-propertize-rules)) - "Non-nil means use the internal prolog tokenizer for indentation etc. -Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect." - :version "24.1" - :group 'prolog-other - :type 'boolean) - (defcustom prolog-imenu-flag t "Non-nil means add a clause index menu for all prolog files." :version "24.1" @@ -772,6 +729,8 @@ Relevant only when `prolog-imenu-flag' is non-nil." :version "24.1" :group 'prolog-other :type 'boolean) +(make-obsolete-variable 'prolog-underscore-wordchar-flag + 'superword-mode "24.4") (defcustom prolog-use-sicstus-sd nil "If non-nil, use the source level debugger of SICStus 3#7 and later." @@ -785,6 +744,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." :version "24.1" :group 'prolog-other :type 'boolean) +(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") ;;------------------------------------------------------------------- @@ -802,10 +762,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." ;; - In atoms \x sometimes needs a terminating \ (ISO-style) ;; and sometimes not. (let ((table (make-syntax-table))) - (if prolog-underscore-wordchar-flag - (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?_ "_" table)) - + (modify-syntax-entry ?_ (if prolog-underscore-wordchar-flag "w" "_") table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) @@ -815,7 +772,8 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (modify-syntax-entry ?\' "\"" table) ;; Any better way to handle the 0' construct?!? - (when prolog-char-quote-workaround + (when (and prolog-char-quote-workaround + (not (fboundp 'syntax-propertize-rules))) (modify-syntax-entry ?0 "\\" table)) (modify-syntax-entry ?% "<" table) @@ -830,117 +788,12 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (modify-syntax-entry ?/ ". 14" table) ) table)) -(defvar prolog-mode-abbrev-table nil) - -(if (eval-when-compile - (and (string-match "[[:upper:]]" "A") - (with-temp-buffer - (insert "A") (skip-chars-backward "[:upper:]") (bolp)))) - (progn - (defconst prolog-upper-case-string "[:upper:]" - "A string containing a char-range matching all upper case characters.") - (defconst prolog-lower-case-string "[:lower:]" - "A string containing a char-range matching all lower case characters.")) - - ;; GNU Emacs compatibility: GNU Emacs does not differentiate between - ;; ints and chars, or at least these two are interchangeable. - (defalias 'prolog-int-to-char - (if (fboundp 'int-to-char) #'int-to-char #'identity)) - - (defalias 'prolog-char-to-int - (if (fboundp 'char-to-int) #'char-to-int #'identity)) - - (defun prolog-ints-intervals (ints) - "Return a list of intervals (from . to) covering INTS." - (when ints - (setq ints (sort ints '<)) - (let ((prev (car ints)) - (interval-start (car ints)) - intervals) - (while ints - (let ((next (car ints))) - (when (> next (1+ prev)) ; start of new interval - (setq intervals (cons (cons interval-start prev) intervals)) - (setq interval-start next)) - (setq prev next) - (setq ints (cdr ints)))) - (setq intervals (cons (cons interval-start prev) intervals)) - (reverse intervals)))) - - (defun prolog-dash-letters (string) - "Return a condensed regexp covering all letters in STRING." - (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int - (string-to-list string)))) - codes) - (while intervals - (let* ((i (car intervals)) - (from (car i)) - (to (cdr i)) - (c (cond ((= from to) `(,from)) - ((= (1+ from) to) `(,from ,to)) - (t `(,from ?- ,to))))) - (setq codes (cons c codes))) - (setq intervals (cdr intervals))) - (apply 'concat (reverse codes)))) - - (let ((up_string "") - (low_string "")) - ;; Use `map-char-table' if it is defined. Otherwise enumerate all - ;; numbers between 0 and 255. `map-char-table' is probably safer. - ;; - ;; `map-char-table' causes problems under Emacs 23.0.0.1, the - ;; while loop seems to do its job well (Ryszard Szopa) - ;; - ;;(if (and (not (featurep 'xemacs)) - ;; (fboundp 'map-char-table)) - ;; (map-char-table - ;; (lambda (key value) - ;; (cond - ;; ((and - ;; (eq (prolog-int-to-char key) (downcase key)) - ;; (eq (prolog-int-to-char key) (upcase key))) - ;; ;; Do nothing if upper and lower case are the same - ;; ) - ;; ((eq (prolog-int-to-char key) (downcase key)) - ;; ;; The char is lower case - ;; (setq low_string (format "%s%c" low_string key))) - ;; ((eq (prolog-int-to-char key) (upcase key)) - ;; ;; The char is upper case - ;; (setq up_string (format "%s%c" up_string key))) - ;; )) - ;; (current-case-table)) - ;; `map-char-table' was undefined. - (let ((key 0)) - (while (< key 256) - (cond - ((and - (eq (prolog-int-to-char key) (downcase key)) - (eq (prolog-int-to-char key) (upcase key))) - ;; Do nothing if upper and lower case are the same - ) - ((eq (prolog-int-to-char key) (downcase key)) - ;; The char is lower case - (setq low_string (format "%s%c" low_string key))) - ((eq (prolog-int-to-char key) (upcase key)) - ;; The char is upper case - (setq up_string (format "%s%c" up_string key))) - ) - (setq key (1+ key)))) - ;; ) - ;; The strings are single-byte strings. - (defconst prolog-upper-case-string (prolog-dash-letters up_string) - "A string containing a char-range matching all upper case characters.") - (defconst prolog-lower-case-string (prolog-dash-letters low_string) - "A string containing a char-range matching all lower case characters.") - )) (defconst prolog-atom-char-regexp - (if (string-match "[[:alnum:]]" "0") - "[[:alnum:]_$]" - (format "[%s%s0-9_$]" prolog-lower-case-string prolog-upper-case-string)) + "[[:alnum:]_$]" "Regexp specifying characters which constitute atoms without quoting.") (defconst prolog-atom-regexp - (format "[%s$]%s*" prolog-lower-case-string prolog-atom-char-regexp)) + (format "[[:lower:]$]%s*" prolog-atom-char-regexp)) (defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(? "The characters used as left parentheses for the indentation code.") @@ -987,8 +840,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (require 'smie) -(defvar prolog-use-smie t) - (defun prolog-smie-forward-token () ;; FIXME: Add support for 0', if needed after adding it to ;; syntax-propertize-functions. @@ -1072,6 +923,13 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (pcase (cons kind token) (`(:elem . basic) prolog-indent-width) (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist. + ;; Allow indentation of if-then-else as: + ;; ( test + ;; -> thenrule + ;; ; elserule + ;; ) + (`(:before . ,(or `"->" `";")) + (and (smie-rule-bolp) (smie-rule-parent-p "(") (smie-rule-parent 1))) (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width))) @@ -1139,21 +997,16 @@ VERSION is of the format (Major . Minor)" (defun prolog-mode-variables () "Set some common variables to Prolog code specific values." - (setq local-abbrev-table prolog-mode-abbrev-table) - (set (make-local-variable 'paragraph-start) - (concat "[ \t]*$\\|" page-delimiter)) ;'%%..' - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill) - (set (make-local-variable 'comment-start) "%") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-add) 1) - (set (make-local-variable 'comment-start-skip) - ;; This complex regexp makes sure that comments cannot start - ;; inside quoted atoms or strings - (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" - prolog-quoted-atom-regexp prolog-string-regexp)) - (set (make-local-variable 'parens-require-spaces) nil) + (setq-local local-abbrev-table prolog-mode-abbrev-table) + (setq-local paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..' + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local normal-auto-fill-function 'prolog-do-auto-fill) + (setq-local comment-start "%") + (setq-local comment-end "") + (setq-local comment-add 1) + (setq-local comment-start-skip "\\(?:/\\*+ *\\|%%+ *\\)") + (setq-local parens-require-spaces nil) ;; Initialize Prolog system specific variables (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators prolog-determinism-specificators prolog-directives @@ -1163,19 +1016,14 @@ VERSION is of the format (Major . Minor)" (set (intern (concat (symbol-name var) "-i")) (prolog-find-value-by-system (symbol-value var)))) (when (null (prolog-program-name)) - (set (make-local-variable 'compile-command) (prolog-compile-string))) - (set (make-local-variable 'font-lock-defaults) - '(prolog-font-lock-keywords nil nil ((?_ . "w")))) - (set (make-local-variable 'syntax-propertize-function) - prolog-syntax-propertize-function) + (setq-local compile-command (prolog-compile-string))) + (setq-local font-lock-defaults + '(prolog-font-lock-keywords nil nil ((?_ . "w")))) + (setq-local syntax-propertize-function prolog-syntax-propertize-function) - (if prolog-use-smie - ;; Setup SMIE. - (smie-setup prolog-smie-grammar #'prolog-smie-rules - :forward-token #'prolog-smie-forward-token - :backward-token #'prolog-smie-backward-token) - (set (make-local-variable 'indent-line-function) 'prolog-indent-line)) - ) + (smie-setup prolog-smie-grammar #'prolog-smie-rules + :forward-token #'prolog-smie-forward-token + :backward-token #'prolog-smie-backward-token)) (defun prolog-mode-keybindings-common (map) "Define keybindings common to both Prolog modes in MAP." @@ -1196,25 +1044,12 @@ VERSION is of the format (Major . Minor)" (define-key map "\C-\M-e" 'prolog-end-of-predicate) (define-key map "\M-\C-c" 'prolog-mark-clause) (define-key map "\M-\C-h" 'prolog-mark-predicate) - (define-key map "\M-\C-n" 'prolog-forward-list) - (define-key map "\M-\C-p" 'prolog-backward-list) (define-key map "\C-c\C-n" 'prolog-insert-predicate-template) (define-key map "\C-c\C-s" 'prolog-insert-predspec) (define-key map "\M-\r" 'prolog-insert-next-clause) (define-key map "\C-c\C-va" 'prolog-variables-to-anonymous) (define-key map "\C-c\C-v\C-s" 'prolog-view-predspec) - (define-key map [Backspace] 'prolog-electric-delete) - (define-key map "." 'prolog-electric-dot) - (define-key map "_" 'prolog-electric-underscore) - (define-key map "(" 'prolog-electric-if-then-else) - (define-key map ";" 'prolog-electric-if-then-else) - (define-key map ">" 'prolog-electric-if-then-else) - (define-key map ":" 'prolog-electric-colon) - (define-key map "-" 'prolog-electric-dash) - (if prolog-electric-newline-flag - (define-key map "\r" 'newline-and-indent)) - ;; If we're running SICStus, then map C-c C-c e/d to enabling ;; and disabling of the source-level debugging facilities. ;(if (and (eq prolog-system 'sicstus) @@ -1261,8 +1096,6 @@ VERSION is of the format (Major . Minor)" (defvar prolog-mode-hook nil "List of functions to call after the prolog mode has initialized.") -(unless (fboundp 'prog-mode) - (defalias 'prog-mode 'fundamental-mode)) ;;;###autoload (define-derived-mode prolog-mode prog-mode "Prolog" "Major mode for editing Prolog code. @@ -1276,9 +1109,7 @@ To find out what version of Prolog mode you are running, enter `\\[prolog-mode-version]'. Commands: -\\{prolog-mode-map} -Entry to this mode calls the value of `prolog-mode-hook' -if that value is non-nil." +\\{prolog-mode-map}" (setq mode-name (concat "Prolog" (cond ((eq prolog-system 'eclipse) "[ECLiPSe]") @@ -1288,7 +1119,7 @@ if that value is non-nil." (t "")))) (prolog-mode-variables) (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar)) - + (add-hook 'post-self-insert-hook #'prolog-post-self-insert nil t) ;; `imenu' entry moved to the appropriate hook for consistency. ;; Load SICStus debugger if suitable @@ -1308,7 +1139,7 @@ if that value is non-nil." (define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" "Major mode for editing Mercury programs. Actually this is just customized `prolog-mode'." - (set (make-local-variable 'prolog-system) 'mercury)) + (setq-local prolog-system 'mercury)) ;;------------------------------------------------------------------- @@ -1396,9 +1227,9 @@ To find out what version of Prolog mode you are running, enter (setq mode-line-process '(": %s")) (prolog-mode-variables) (setq comint-prompt-regexp (prolog-prompt-regexp)) - (set (make-local-variable 'shell-dirstack-query) "pwd.") - (set (make-local-variable 'compilation-error-regexp-alist) - prolog-inferior-error-regexp-alist) + (setq-local shell-dirstack-query "pwd.") + (setq-local compilation-error-regexp-alist + prolog-inferior-error-regexp-alist) (compilation-shell-minor-mode) (prolog-inferior-menu)) @@ -1433,22 +1264,22 @@ With prefix argument ARG, restart the Prolog process if running before." )) (defun prolog-inferior-guess-flavor (&optional ignored) - (setq prolog-system - (when (or (numberp prolog-system) (markerp prolog-system)) - (save-excursion - (goto-char (1+ prolog-system)) - (cond - ((looking-at "GNU Prolog") 'gnu) - ((looking-at "Welcome to SWI-Prolog\\|%.*\\ pmark (point-min)) (copy-marker (1- pmark))) - (t (1- pmark))))) + (setq-local + prolog-system + ;; Force re-detection. + (let* ((proc (get-buffer-process (current-buffer))) + (pmark (and proc (marker-position (process-mark proc))))) + (cond + ((null pmark) (1- (point-min))) + ;; The use of insert-before-markers in comint.el together with + ;; the potential use of comint-truncate-buffer in the output + ;; filter, means that it's difficult to reliably keep track of + ;; the buffer position where the process's output started. + ;; If possible we use a marker at "start - 1", so that + ;; insert-before-marker at `start' won't shift it. And if not, + ;; we fall back on using a plain integer. + ((> pmark (point-min)) (copy-marker (1- pmark))) + (t (1- pmark))))) (add-hook 'comint-output-filter-functions 'prolog-inferior-guess-flavor nil t)) (if wait @@ -1738,28 +1570,26 @@ This function must be called from the source code buffer." (real-file buffer-file-name) (command-string (prolog-build-prolog-command compilep file real-file first-line)) - (process (get-process "prolog")) - (old-filter (process-filter process))) + (process (get-process "prolog"))) (with-current-buffer buffer (delete-region (point-min) (point-max)) ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? (compilation-mode) ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el. ;; Setting up font-locking for this buffer - (set (make-local-variable 'font-lock-defaults) - '(prolog-font-lock-keywords nil nil ((?_ . "w")))) + (setq-local font-lock-defaults + '(prolog-font-lock-keywords nil nil ((?_ . "w")))) (if (eq prolog-system 'sicstus) ;; FIXME: This looks really problematic: not only is this using ;; the old compilation-parse-errors-function, but ;; prolog-parse-sicstus-compilation-errors only accepts one argument ;; whereas compile.el calls it with 2 (and did so at least since ;; Emacs-20). - (set (make-local-variable 'compilation-parse-errors-function) - 'prolog-parse-sicstus-compilation-errors)) + (setq-local compilation-parse-errors-function + 'prolog-parse-sicstus-compilation-errors)) (setq buffer-read-only nil) (insert command-string "\n")) - (save-selected-window - (pop-to-buffer buffer)) + (display-buffer buffer) (setq prolog-process-flag t prolog-consult-compile-output "" prolog-consult-compile-first-line (if first-line (1- first-line) 0) @@ -1770,7 +1600,8 @@ This function must be called from the source code buffer." real-file)) (with-current-buffer buffer (goto-char (point-max)) - (set-process-filter process 'prolog-consult-compile-filter) + (add-function :override (process-filter process) + #'prolog-consult-compile-filter) (process-send-string "prolog" command-string) ;; (prolog-build-prolog-command compilep file real-file first-line)) (while (and prolog-process-flag @@ -1781,7 +1612,8 @@ This function must be called from the source code buffer." (insert (if compilep "\nCompilation finished.\n" "\nConsulted.\n")) - (set-process-filter process old-filter)))) + (remove-function (process-filter process) + #'prolog-consult-compile-filter)))) (defvar compilation-error-list) @@ -1951,20 +1783,6 @@ If COMPILEP is non-nil, compile, otherwise consult." ;;------------------------------------------------------------------- ;; Auxiliary functions -(defun prolog-make-keywords-regexp (keywords &optional protect) - "Create regexp from the list of strings KEYWORDS. -If PROTECT is non-nil, surround the result regexp by word breaks." - (let ((regexp - (if (fboundp 'regexp-opt) - ;; Emacs 20 - ;; Avoid compile warnings under earlier versions by using eval - (eval '(regexp-opt keywords)) - ;; Older Emacsen - (concat (mapconcat 'regexp-quote keywords "\\|"))) - )) - (if protect - (concat "\\<\\(" regexp "\\)\\>") - regexp))) (defun prolog-font-lock-object-matcher (bound) "Find SICStus objects method name for font lock. @@ -1995,669 +1813,272 @@ Argument BOUND is a buffer position limiting searching." ;; Set everything up (defun prolog-font-lock-keywords () "Set up font lock keywords for the current Prolog system." - ;(when window-system - (require 'font-lock) + ;;(when window-system + (require 'font-lock) - ;; Define Prolog faces - (defface prolog-redo-face - '((((class grayscale)) (:italic t)) - (((class color)) (:foreground "darkorchid")) - (t (:italic t))) - "Prolog mode face for highlighting redo trace lines." - :group 'prolog-faces) - (defface prolog-exit-face - '((((class grayscale)) (:underline t)) - (((class color) (background dark)) (:foreground "green")) - (((class color) (background light)) (:foreground "ForestGreen")) - (t (:underline t))) - "Prolog mode face for highlighting exit trace lines." - :group 'prolog-faces) - (defface prolog-exception-face - '((((class grayscale)) (:bold t :italic t :underline t)) - (((class color)) (:bold t :foreground "black" :background "Khaki")) - (t (:bold t :italic t :underline t))) - "Prolog mode face for highlighting exception trace lines." - :group 'prolog-faces) - (defface prolog-warning-face - '((((class grayscale)) (:underline t)) - (((class color) (background dark)) (:foreground "blue")) - (((class color) (background light)) (:foreground "MidnightBlue")) - (t (:underline t))) - "Face name to use for compiler warnings." - :group 'prolog-faces) - (defface prolog-builtin-face - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (((class grayscale) (background light)) - :foreground "LightGray" :bold t) - (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) - (t (:bold t))) - "Face name to use for compiler warnings." - :group 'prolog-faces) - (defvar prolog-warning-face - (if (prolog-face-name-p 'font-lock-warning-face) - 'font-lock-warning-face - 'prolog-warning-face) - "Face name to use for built in predicates.") - (defvar prolog-builtin-face - (if (prolog-face-name-p 'font-lock-builtin-face) - 'font-lock-builtin-face - 'prolog-builtin-face) - "Face name to use for built in predicates.") - (defvar prolog-redo-face 'prolog-redo-face - "Face name to use for redo trace lines.") - (defvar prolog-exit-face 'prolog-exit-face - "Face name to use for exit trace lines.") - (defvar prolog-exception-face 'prolog-exception-face - "Face name to use for exception trace lines.") + ;; Define Prolog faces + (defface prolog-redo-face + '((((class grayscale)) (:italic t)) + (((class color)) (:foreground "darkorchid")) + (t (:italic t))) + "Prolog mode face for highlighting redo trace lines." + :group 'prolog-faces) + (defface prolog-exit-face + '((((class grayscale)) (:underline t)) + (((class color) (background dark)) (:foreground "green")) + (((class color) (background light)) (:foreground "ForestGreen")) + (t (:underline t))) + "Prolog mode face for highlighting exit trace lines." + :group 'prolog-faces) + (defface prolog-exception-face + '((((class grayscale)) (:bold t :italic t :underline t)) + (((class color)) (:bold t :foreground "black" :background "Khaki")) + (t (:bold t :italic t :underline t))) + "Prolog mode face for highlighting exception trace lines." + :group 'prolog-faces) + (defface prolog-warning-face + '((((class grayscale)) (:underline t)) + (((class color) (background dark)) (:foreground "blue")) + (((class color) (background light)) (:foreground "MidnightBlue")) + (t (:underline t))) + "Face name to use for compiler warnings." + :group 'prolog-faces) + (defface prolog-builtin-face + '((((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan")) + (((class grayscale) (background light)) + :foreground "LightGray" :bold t) + (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) + (t (:bold t))) + "Face name to use for compiler warnings." + :group 'prolog-faces) + (defvar prolog-warning-face + (if (prolog-face-name-p 'font-lock-warning-face) + 'font-lock-warning-face + 'prolog-warning-face) + "Face name to use for built in predicates.") + (defvar prolog-builtin-face + (if (prolog-face-name-p 'font-lock-builtin-face) + 'font-lock-builtin-face + 'prolog-builtin-face) + "Face name to use for built in predicates.") + (defvar prolog-redo-face 'prolog-redo-face + "Face name to use for redo trace lines.") + (defvar prolog-exit-face 'prolog-exit-face + "Face name to use for exit trace lines.") + (defvar prolog-exception-face 'prolog-exception-face + "Face name to use for exception trace lines.") - ;; Font Lock Patterns - (let ( - ;; "Native" Prolog patterns - (head-predicates - (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp) - 1 font-lock-function-name-face)) - ;(list (format "^%s" prolog-atom-regexp) - ; 0 font-lock-function-name-face)) - (head-predicates-1 - (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp) - 1 font-lock-function-name-face) ) - (variables - '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)" - 1 font-lock-variable-name-face)) - (important-elements - (list (if (eq prolog-system 'mercury) - "[][}{;|]\\|\\\\[+=]\\|?" - "[][}{!;|]\\|\\*->") - 0 'font-lock-keyword-face)) - (important-elements-1 - '("[^-*]\\(->\\)" 1 font-lock-keyword-face)) - (predspecs ; module:predicate/cardinality - (list (format "\\<\\(%s:\\|\\)%s/[0-9]+" - prolog-atom-regexp prolog-atom-regexp) - 0 font-lock-function-name-face 'prepend)) - (keywords ; directives (queries) - (list - (if (eq prolog-system 'mercury) - (concat - "\\<\\(" - (prolog-make-keywords-regexp prolog-keywords-i) - "\\|" - (prolog-make-keywords-regexp - prolog-determinism-specificators-i) - "\\)\\>") + ;; Font Lock Patterns + (let ( + ;; "Native" Prolog patterns + (head-predicates + (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp) + 1 font-lock-function-name-face)) + ;(list (format "^%s" prolog-atom-regexp) + ; 0 font-lock-function-name-face)) + (head-predicates-1 + (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp) + 1 font-lock-function-name-face) ) + (variables + '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)" + 1 font-lock-variable-name-face)) + (important-elements + (list (if (eq prolog-system 'mercury) + "[][}{;|]\\|\\\\[+=]\\|?" + "[][}{!;|]\\|\\*->") + 0 'font-lock-keyword-face)) + (important-elements-1 + '("[^-*]\\(->\\)" 1 font-lock-keyword-face)) + (predspecs ; module:predicate/cardinality + (list (format "\\<\\(%s:\\|\\)%s/[0-9]+" + prolog-atom-regexp prolog-atom-regexp) + 0 font-lock-function-name-face 'prepend)) + (keywords ; directives (queries) + (list + (if (eq prolog-system 'mercury) (concat - "^[?:]- *\\(" - (prolog-make-keywords-regexp prolog-keywords-i) - "\\)\\>")) - 1 prolog-builtin-face)) - (quoted_atom (list prolog-quoted-atom-regexp - 2 'font-lock-string-face 'append)) - (string (list prolog-string-regexp - 1 'font-lock-string-face 'append)) - ;; SICStus specific patterns - (sicstus-object-methods - (if (eq prolog-system 'sicstus) - '(prolog-font-lock-object-matcher - 1 font-lock-function-name-face))) - ;; Mercury specific patterns - (types - (if (eq prolog-system 'mercury) - (list - (prolog-make-keywords-regexp prolog-types-i t) - 0 'font-lock-type-face))) - (modes - (if (eq prolog-system 'mercury) - (list - (prolog-make-keywords-regexp prolog-mode-specificators-i t) - 0 'font-lock-constant-face))) - (directives - (if (eq prolog-system 'mercury) - (list - (prolog-make-keywords-regexp prolog-directives-i t) - 0 'prolog-warning-face))) - ;; Inferior mode specific patterns - (prompt - ;; FIXME: Should be handled by comint already. - (list (prolog-prompt-regexp) 0 'font-lock-keyword-face)) - (trace-exit - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):" - 1 prolog-exit-face)) - ((eq prolog-system 'swi) - '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face)) - (t nil))) - (trace-fail - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):" - 1 prolog-warning-face)) - ((eq prolog-system 'swi) - '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face)) - (t nil))) - (trace-redo - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):" - 1 prolog-redo-face)) - ((eq prolog-system 'swi) - '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face)) - (t nil))) - (trace-call - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):" - 1 font-lock-function-name-face)) - ((eq prolog-system 'swi) - '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)" - 1 font-lock-function-name-face)) - (t nil))) - (trace-exception - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):" - 1 prolog-exception-face)) - ((eq prolog-system 'swi) - '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)" - 1 prolog-exception-face)) - (t nil))) - (error-message-identifier - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend)) - ((eq prolog-system 'swi) - '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend)) - (t nil))) - (error-whole-messages - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$" - 1 font-lock-comment-face append)) - ((eq prolog-system 'swi) - '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append)) - (t nil))) - (error-warning-messages - ;; FIXME: Add to compilation-error-regexp-alist instead. - ;; Mostly errors that SICStus asks the user about how to solve, - ;; such as "NAME CLASH:" for example. - (cond - ((eq prolog-system 'sicstus) - '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face)) - (t nil))) - (warning-messages - ;; FIXME: Add to compilation-error-regexp-alist instead. - (cond - ((eq prolog-system 'sicstus) - '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" - 2 prolog-warning-face prepend)) - (t nil)))) + "\\<\\(" + (regexp-opt prolog-keywords-i) + "\\|" + (regexp-opt + prolog-determinism-specificators-i) + "\\)\\>") + (concat + "^[?:]- *\\(" + (regexp-opt prolog-keywords-i) + "\\)\\>")) + 1 prolog-builtin-face)) + ;; SICStus specific patterns + (sicstus-object-methods + (if (eq prolog-system 'sicstus) + '(prolog-font-lock-object-matcher + 1 font-lock-function-name-face))) + ;; Mercury specific patterns + (types + (if (eq prolog-system 'mercury) + (list + (regexp-opt prolog-types-i 'words) + 0 'font-lock-type-face))) + (modes + (if (eq prolog-system 'mercury) + (list + (regexp-opt prolog-mode-specificators-i 'words) + 0 'font-lock-constant-face))) + (directives + (if (eq prolog-system 'mercury) + (list + (regexp-opt prolog-directives-i 'words) + 0 'prolog-warning-face))) + ;; Inferior mode specific patterns + (prompt + ;; FIXME: Should be handled by comint already. + (list (prolog-prompt-regexp) 0 'font-lock-keyword-face)) + (trace-exit + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):" + 1 prolog-exit-face)) + ((eq prolog-system 'swi) + '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face)) + (t nil))) + (trace-fail + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):" + 1 prolog-warning-face)) + ((eq prolog-system 'swi) + '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face)) + (t nil))) + (trace-redo + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):" + 1 prolog-redo-face)) + ((eq prolog-system 'swi) + '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face)) + (t nil))) + (trace-call + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):" + 1 font-lock-function-name-face)) + ((eq prolog-system 'swi) + '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)" + 1 font-lock-function-name-face)) + (t nil))) + (trace-exception + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):" + 1 prolog-exception-face)) + ((eq prolog-system 'swi) + '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)" + 1 prolog-exception-face)) + (t nil))) + (error-message-identifier + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend)) + ((eq prolog-system 'swi) + '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend)) + (t nil))) + (error-whole-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$" + 1 font-lock-comment-face append)) + ((eq prolog-system 'swi) + '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append)) + (t nil))) + (error-warning-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. + ;; Mostly errors that SICStus asks the user about how to solve, + ;; such as "NAME CLASH:" for example. + (cond + ((eq prolog-system 'sicstus) + '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face)) + (t nil))) + (warning-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. + (cond + ((eq prolog-system 'sicstus) + '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" + 2 prolog-warning-face prepend)) + (t nil)))) - ;; Make font lock list - (delq - nil - (cond - ((eq major-mode 'prolog-mode) - (list - head-predicates - head-predicates-1 - quoted_atom - string - variables - important-elements - important-elements-1 - predspecs - keywords - sicstus-object-methods - types - modes - directives)) - ((eq major-mode 'prolog-inferior-mode) - (list - prompt - error-message-identifier - error-whole-messages - error-warning-messages - warning-messages - predspecs - trace-exit - trace-fail - trace-redo - trace-call - trace-exception)) - ((eq major-mode 'compilation-mode) - (list - error-message-identifier - error-whole-messages - error-warning-messages - warning-messages - predspecs)))) - )) + ;; Make font lock list + (delq + nil + (cond + ((eq major-mode 'prolog-mode) + (list + head-predicates + head-predicates-1 + variables + important-elements + important-elements-1 + predspecs + keywords + sicstus-object-methods + types + modes + directives)) + ((eq major-mode 'prolog-inferior-mode) + (list + prompt + error-message-identifier + error-whole-messages + error-warning-messages + warning-messages + predspecs + trace-exit + trace-fail + trace-redo + trace-call + trace-exception)) + ((eq major-mode 'compilation-mode) + (list + error-message-identifier + error-whole-messages + error-warning-messages + warning-messages + predspecs)))) + )) -;;------------------------------------------------------------------- -;; Indentation stuff -;;------------------------------------------------------------------- -;; NB: This function *MUST* have this optional argument since XEmacs -;; assumes it. This does not mean we have to use it... -(defun prolog-indent-line (&optional _whole-exp) - "Indent current line as Prolog code. -With argument, indent any additional lines of the same clause -rigidly along with this one (not yet)." - (interactive "p") - (let ((indent (prolog-indent-level)) - (pos (- (point-max) (point)))) - (beginning-of-line) - (skip-chars-forward " \t") - (indent-line-to indent) - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) - - ;; Align comments - (if (and prolog-align-comments-flag - (save-excursion - (line-beginning-position) - ;; (let ((start (comment-search-forward (line-end-position) t))) - ;; (and start ;There's a comment to indent. - ;; ;; If it's first on the line, we've indented it already - ;; ;; and prolog-goto-comment-column would inf-loop. - ;; (progn (goto-char start) (skip-chars-backward " \t") - ;; (not (bolp))))))) - (and (looking-at comment-start-skip) - ;; The definition of comment-start-skip used in this - ;; mode is unusual in that it only matches at BOL. - (progn (skip-chars-forward " \t") - (not (eq (point) (match-end 1))))))) - (save-excursion - (prolog-goto-comment-column t))) - - ;; Insert spaces if needed - (if (or prolog-electric-tab-flag prolog-electric-if-then-else-flag) - (prolog-insert-spaces-after-paren)) - )) - -(defun prolog-indent-level () - "Compute prolog indentation level." +(defun prolog-find-unmatched-paren () + "Return the column of the last unmatched left parenthesis." (save-excursion - (beginning-of-line) - (let ((totbal (prolog-region-paren-balance - (prolog-clause-start t) (point))) - (oldpoint (point))) - (skip-chars-forward " \t") - (cond - ((looking-at "%%%") (prolog-indentation-level-of-line)) - ;Large comment starts - ((looking-at "%[^%]") comment-column) ;Small comment starts - ((bobp) 0) ;Beginning of buffer - - ;; If we found '}' then we must check if it's the - ;; end of an object declaration or something else. - ((and (looking-at "}") - (save-excursion - (forward-char 1) - ;; Goto to matching { - (if prolog-use-prolog-tokenizer-flag - (prolog-backward-list) - (backward-list)) - (skip-chars-backward " \t") - (backward-char 2) - (looking-at "::"))) - ;; It was an object - (if prolog-object-end-to-0-flag - 0 - prolog-indent-width)) - - ;;End of /* */ comment - ((looking-at "\\*/") - (save-excursion - (prolog-find-start-of-mline-comment) - (skip-chars-backward " \t") - (- (current-column) 2))) - - ;; Here we check if the current line is within a /* */ pair - ((and (looking-at "[^%/]") - (eq (prolog-in-string-or-comment) 'cmt)) - (if prolog-indent-mline-comments-flag - (prolog-find-start-of-mline-comment) - ;; Same as before - (prolog-indentation-level-of-line))) - - (t - (let ((empty t) ind linebal) - ;; See previous indentation - (while empty - (forward-line -1) - (beginning-of-line) - (if (bobp) - (setq empty nil) - (skip-chars-forward " \t") - (if (not (or (not (member (prolog-in-string-or-comment) - '(nil txt))) - (looking-at "%") - (looking-at "\n"))) - (setq empty nil)))) - - ;; Store this line's indentation - (setq ind (if (bobp) - 0 ;Beginning of buffer. - (current-column))) ;Beginning of clause. - - ;; Compute the balance of the line - (setq linebal (prolog-paren-balance)) - ;;(message "bal of previous line %d totbal %d" linebal totbal) - (if (< linebal 0) - (progn - ;; Add 'indent-level' mode to find-unmatched-paren instead? - (end-of-line) - (setq ind (prolog-find-indent-of-matching-paren)))) - - ;;(message "ind %d" ind) - (beginning-of-line) - - ;; Check if the line ends with ":-", ".", ":: {", "}" (might be - ;; unnecessary), "&" or ")" (The last four concerns SICStus objects) - (cond - ;; If the last char of the line is a '&' then set the indent level - ;; to prolog-indent-width (used in SICStus objects) - ((and (eq prolog-system 'sicstus) - (looking-at ".+&[ \t]*\\(%.*\\|\\)$")) - (setq ind prolog-indent-width)) - - ;; Increase indentation if the previous line was the head of a rule - ;; and does not contain a '.' - ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$" - prolog-head-delimiter)) - ;; We must check that the match is at a paren balance of 0. - (save-excursion - (let ((p (point))) - (re-search-forward prolog-head-delimiter) - (>= 0 (prolog-region-paren-balance p (point)))))) - (let ((headindent - (if (< (prolog-paren-balance) 0) - (save-excursion - (end-of-line) - (prolog-find-indent-of-matching-paren)) - (prolog-indentation-level-of-line)))) - (setq ind (+ headindent prolog-indent-width)))) - - ;; The previous line was the head of an object - ((looking-at ".+ *::.*{[ \t]*$") - (setq ind prolog-indent-width)) - - ;; If a '.' is found at the end of the previous line, then - ;; decrease the indentation. (The \\(%.*\\|\\) part of the - ;; regexp is for comments at the end of the line) - ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$") - ;; Make sure that the '.' found is not in a comment or string - (save-excursion - (end-of-line) - (re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min)) - ;; Guard against the real '.' being followed by a - ;; commented '.'. - (if (eq (prolog-in-string-or-comment) 'cmt) - ;; commented out '.' - (let ((here (line-beginning-position))) - (end-of-line) - (re-search-backward "\\.[ \t]*%.*$" here t)) - (not (prolog-in-string-or-comment)) - ) - )) - (setq ind 0)) - - ;; If a '.' is found at the end of the previous line, then - ;; decrease the indentation. (The /\\*.*\\*/ part of the - ;; regexp is for C-like comments at the end of the - ;; line--can we merge with the case above?). - ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$") - ;; Make sure that the '.' found is not in a comment or string - (save-excursion - (end-of-line) - (re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min)) - ;; Guard against the real '.' being followed by a - ;; commented '.'. - (if (eq (prolog-in-string-or-comment) 'cmt) - ;; commented out '.' - (let ((here (line-beginning-position))) - (end-of-line) - (re-search-backward "\\.[ \t]*/\\*.*$" here t)) - (not (prolog-in-string-or-comment)) - ) - )) - (setq ind 0)) - - ) - - ;; If the last non comment char is a ',' or left paren or a left- - ;; indent-regexp then indent to open parenthesis level - (if (and - (> totbal 0) - ;; SICStus objects have special syntax rules if point is - ;; not inside additional parens (objects are defined - ;; within {...}) - (not (and (eq prolog-system 'sicstus) - (= totbal 1) - (prolog-in-object)))) - (if (looking-at - (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$" - prolog-quoted-atom-regexp prolog-string-regexp - prolog-left-paren prolog-left-indent-regexp)) - (progn - (goto-char oldpoint) - (setq ind (prolog-find-unmatched-paren - (if prolog-paren-indent-p - 'termdependent - 'skipwhite))) - ;;(setq ind (prolog-find-unmatched-paren 'termdependent)) - ) - (goto-char oldpoint) - (setq ind (prolog-find-unmatched-paren nil)) - )) - - - ;; Return the indentation level - ind - )))))) - -(defun prolog-find-indent-of-matching-paren () - "Find the indentation level based on the matching parenthesis. -Indentation level is set to the one the point is after when the function is -called." - (save-excursion - ;; Go to the matching paren - (if prolog-use-prolog-tokenizer-flag - (prolog-backward-list) - (backward-list)) - - ;; If this was the first paren on the line then return this line's - ;; indentation level - (if (prolog-paren-is-the-first-on-line-p) - (prolog-indentation-level-of-line) - ;; It was not the first one - (progn - ;; Find the next paren - (prolog-goto-next-paren 0) - - ;; If this paren is a left one then use its column as indent level, - ;; if not then recurse this function - (if (looking-at prolog-left-paren) - (+ (current-column) 1) - (progn - (forward-char 1) - (prolog-find-indent-of-matching-paren))) - )) - )) - -(defun prolog-indentation-level-of-line () - "Return the indentation level of the current line." - (save-excursion - (beginning-of-line) - (skip-chars-forward " \t") + (goto-char (or (car (nth 9 (syntax-ppss))) (point-min))) (current-column))) -(defun prolog-paren-is-the-first-on-line-p () - "Return t if the parenthesis under the point is the first one on the line. -Return nil otherwise. -Note: does not check if the point is actually at a parenthesis!" - (save-excursion - (let ((begofline (line-beginning-position))) - (if (= begofline (point)) - t - (if (prolog-goto-next-paren begofline) - nil - t))))) - -(defun prolog-find-unmatched-paren (&optional mode) - "Return the column of the last unmatched left parenthesis. -If MODE is `skipwhite' then any white space after the parenthesis is added to -the answer. -If MODE is `plusone' then the parenthesis' column +1 is returned. -If MODE is `termdependent' then if the unmatched parenthesis is part of -a compound term the function will work as `skipwhite', otherwise -it will return the column paren plus the value of `prolog-paren-indent'. -If MODE is nil or not set then the parenthesis' exact column is returned." - (save-excursion - ;; If the next paren we find is a left one we're finished, if it's - ;; a right one then we go back one step and recurse - (prolog-goto-next-paren 0) - - (let ((roundparen (looking-at "("))) - (if (looking-at prolog-left-paren) - (let ((not-part-of-term - (save-excursion - (backward-char 1) - (looking-at "[ \t]")))) - (if (eq mode nil) - (current-column) - (if (and roundparen - (eq mode 'termdependent) - not-part-of-term) - (+ (current-column) - (if prolog-electric-tab-flag - ;; Electric TAB - prolog-paren-indent - ;; Not electric TAB - (if (looking-at ".[ \t]*$") - 2 - prolog-paren-indent)) - ) - - (forward-char 1) - (if (or (eq mode 'skipwhite) (eq mode 'termdependent) ) - (skip-chars-forward " \t")) - (current-column)))) - ;; Not looking at left paren - (progn - (forward-char 1) - ;; Go to the matching paren. When we get there we have a total - ;; balance of 0. - (if prolog-use-prolog-tokenizer-flag - (prolog-backward-list) - (backward-list)) - (prolog-find-unmatched-paren mode))) - ))) - (defun prolog-paren-balance () "Return the parenthesis balance of the current line. -A return value of n means n more left parentheses than right ones." +A return value of N means N more left parentheses than right ones." (save-excursion - (end-of-line) - (prolog-region-paren-balance (line-beginning-position) (point)))) + (car (parse-partial-sexp (line-beginning-position) + (line-end-position))))) -(defun prolog-region-paren-balance (beg end) - "Return the summed parenthesis balance in the region. -The region is limited by BEG and END positions." - (save-excursion - (let ((state (if prolog-use-prolog-tokenizer-flag - (prolog-tokenize beg end) - (parse-partial-sexp beg end)))) - (nth 0 state)))) - -(defun prolog-goto-next-paren (limit-pos) - "Move the point to the next parenthesis earlier in the buffer. -Return t if a match was found before LIMIT-POS. Return nil otherwise." - (let ((retval (re-search-backward - (concat prolog-left-paren "\\|" prolog-right-paren) - limit-pos t))) - - ;; If a match was found but it was in a string or comment, then recurse - (if (and retval (prolog-in-string-or-comment)) - (prolog-goto-next-paren limit-pos) - retval) - )) - -(defun prolog-in-string-or-comment () - "Check whether string, atom, or comment is under current point. -Return: - `txt' if the point is in a string, atom, or character code expression - `cmt' if the point is in a comment - nil otherwise." - (save-excursion - (let* ((start - (if (eq prolog-parse-mode 'beg-of-line) - ;; 'beg-of-line - (save-excursion - (let (safepoint) - (beginning-of-line) - (setq safepoint (point)) - (while (and (> (point) (point-min)) - (progn - (forward-line -1) - (end-of-line) - (if (not (bobp)) - (backward-char 1)) - (looking-at "\\\\")) - ) - (beginning-of-line) - (setq safepoint (point))) - safepoint)) - ;; 'beg-of-clause - (prolog-clause-start))) - (end (point)) - (state (if prolog-use-prolog-tokenizer-flag - (prolog-tokenize start end) - (if (fboundp 'syntax-ppss) - (syntax-ppss) - (parse-partial-sexp start end))))) - (cond - ((nth 3 state) 'txt) ; String - ((nth 4 state) 'cmt) ; Comment - (t - (cond - ((looking-at "%") 'cmt) ; Start of a comment - ((looking-at "/\\*") 'cmt) ; Start of a comment - ((looking-at "\'") 'txt) ; Start of an atom - ((looking-at "\"") 'txt) ; Start of a string - (t nil) - )))) - )) - -(defun prolog-find-start-of-mline-comment () - "Return the start column of a /* */ comment. -This assumes that the point is inside a comment." - (re-search-backward "/\\*" (point-min) t) - (forward-char 2) - (skip-chars-forward " \t") - (current-column)) - -(defun prolog-insert-spaces-after-paren () +(defun prolog-electric--if-then-else () "Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches. Spaces are inserted if all preceding objects on the line are whitespace characters, parentheses, or then/else branches." - (save-excursion - (let ((regexp (concat "(\\|" prolog-left-indent-regexp)) - level) - (beginning-of-line) - (skip-chars-forward " \t") - (when (looking-at regexp) + (when prolog-electric-if-then-else-flag + (save-excursion + (let ((regexp (concat "(\\|" prolog-left-indent-regexp)) + level) + (beginning-of-line) + (skip-chars-forward " \t") ;; Treat "( If -> " lines specially. ;;(setq incr (if (looking-at "(.*->") ;; 2 @@ -2674,12 +2095,12 @@ whitespace characters, parentheses, or then/else branches." (delete-region start (point))) (indent-to level) (skip-chars-forward " \t")) - ))) - (when (save-excursion - (backward-char 2) - (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)")) - (skip-chars-forward " \t")) - ) + )) + (when (save-excursion + (backward-char 2) + (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)")) + (skip-chars-forward " \t")) + )) ;;;; Comment filling @@ -2764,7 +2185,7 @@ between them)." ;; fill 'txt entities? (when (save-excursion (end-of-line) - (equal (prolog-in-string-or-comment) 'cmt)) + (nth 4 (syntax-ppss))) (let* ((bounds (prolog-comment-limits)) (cbeg (car bounds)) (type (nth 2 bounds)) @@ -2833,162 +2254,6 @@ In effect it sets the `fill-prefix' when inside comments and then calls (replace-regexp-in-string regexp newtext str nil literal)))) ;;------------------------------------------------------------------- -;; The tokenizer -;;------------------------------------------------------------------- - -(defconst prolog-tokenize-searchkey - (concat "[0-9]+'" - "\\|" - "['\"]" - "\\|" - prolog-left-paren - "\\|" - prolog-right-paren - "\\|" - "%" - "\\|" - "/\\*" - )) - -(defun prolog-tokenize (beg end &optional stopcond) - "Tokenize a region of prolog code between BEG and END. -STOPCOND decides the stop condition of the parsing. Valid values -are 'zerodepth which stops the parsing at the first right parenthesis -where the parenthesis depth is zero, 'skipover which skips over -the current entity (e.g. a list, a string, etc.) and nil. - -The function returns a list with the following information: - 0. parenthesis depth - 3. 'atm if END is inside an atom - 'str if END is inside a string - 'chr if END is in a character code expression (0'x) - nil otherwise - 4. non-nil if END is inside a comment - 5. end position (always equal to END if STOPCOND is nil) -The rest of the elements are undefined." - (save-excursion - (let* ((end2 (1+ end)) - oldp - (depth 0) - (quoted nil) - inside_cmt - (endpos end2) - skiptype ; The type of entity we'll skip over - ) - (goto-char beg) - - (if (and (eq stopcond 'skipover) - (looking-at "[^[({'\"]")) - (setq endpos (point)) ; Stay where we are - (while (and - (re-search-forward prolog-tokenize-searchkey end2 t) - (< (point) end2)) - (progn - (setq oldp (point)) - (goto-char (match-beginning 0)) - (cond - ;; Atoms and strings - ((looking-at "'") - ;; Find end of atom - (if (re-search-forward "[^\\]'" end2 'limit) - ;; Found end of atom - (progn - (setq oldp end2) - (if (and (eq stopcond 'skipover) - (not skiptype)) - (setq endpos (point)) - (setq oldp (point)))) ; Continue tokenizing - (setq quoted 'atm))) - - ((looking-at "\"") - ;; Find end of string - (if (re-search-forward "[^\\]\"" end2 'limit) - ;; Found end of string - (progn - (setq oldp end2) - (if (and (eq stopcond 'skipover) - (not skiptype)) - (setq endpos (point)) - (setq oldp (point)))) ; Continue tokenizing - (setq quoted 'str))) - - ;; Paren stuff - ((looking-at prolog-left-paren) - (setq depth (1+ depth)) - (setq skiptype 'paren)) - - ((looking-at prolog-right-paren) - (setq depth (1- depth)) - (if (and - (or (eq stopcond 'zerodepth) - (and (eq stopcond 'skipover) - (eq skiptype 'paren))) - (= depth 0)) - (progn - (setq endpos (1+ (point))) - (setq oldp end2)))) - - ;; Comment stuff - ((looking-at comment-start) - (end-of-line) - ;; (if (>= (point) end2) - (if (>= (point) end) - (progn - (setq inside_cmt t) - (setq oldp end2)) - (setq oldp (point)))) - - ((looking-at "/\\*") - (if (re-search-forward "\\*/" end2 'limit) - (setq oldp (point)) - (setq inside_cmt t) - (setq oldp end2))) - - ;; 0'char - ((looking-at "0'") - (setq oldp (1+ (match-end 0))) - (if (> oldp end) - (setq quoted 'chr))) - - ;; base'number - ((looking-at "[0-9]+'") - (goto-char (match-end 0)) - (skip-chars-forward "0-9a-zA-Z") - (setq oldp (point))) - - - ) - (goto-char oldp) - )) ; End of while - ) - - ;; Deal with multi-line comments - (and (prolog-inside-mline-comment end) - (setq inside_cmt t)) - - ;; Create return list - (list depth nil nil quoted inside_cmt endpos) - ))) - -(defun prolog-inside-mline-comment (here) - (save-excursion - (goto-char here) - (let* ((next-close (save-excursion (search-forward "*/" nil t))) - (next-open (save-excursion (search-forward "/*" nil t))) - (prev-open (save-excursion (search-backward "/*" nil t))) - (prev-close (save-excursion (search-backward "*/" nil t))) - (unmatched-next-close (and next-close - (or (not next-open) - (> next-open next-close)))) - (unmatched-prev-open (and prev-open - (or (not prev-close) - (> prev-open prev-close)))) - ) - (or unmatched-next-close unmatched-prev-open) - ))) - - -;;------------------------------------------------------------------- ;; Online help ;;------------------------------------------------------------------- @@ -3027,11 +2292,14 @@ The rest of the elements are undefined." (error "Sorry, no help method defined for this Prolog system.")))) )) + +(autoload 'Info-goto-node "info" nil t) +(declare-function Info-follow-nearest-node "info" (&optional FORK)) + (defun prolog-help-info (predicate) (let ((buffer (current-buffer)) oldp (str (concat "^\\* " (regexp-quote predicate) " */"))) - (require 'info) (pop-to-buffer nil) (Info-goto-node prolog-info-predicate-index) (if (not (re-search-forward str nil t)) @@ -3120,7 +2388,6 @@ Only for internal use by `prolog-find-documentation'") (defun prolog-goto-predicate-info (predicate) "Go to the info page for PREDICATE, which is a PredSpec." (interactive) - (require 'info) (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate) (let ((buffer (current-buffer)) (name (match-string 1 predicate)) @@ -3378,7 +2645,7 @@ When called with prefix argument ARG, disable zipping instead." (let ((state (prolog-clause-info)) (object (prolog-in-object))) (if (or (equal (nth 0 state) "") - (equal (prolog-in-string-or-comment) 'cmt)) + (nth 4 (syntax-ppss))) nil (if (and (eq prolog-system 'sicstus) object) @@ -3486,7 +2753,7 @@ STRING should be given if the last search was by `string-match' on STRING." (defun prolog-clause-start (&optional not-allow-methods) "Return the position at the start of the head of the current clause. If NOTALLOWMETHODS is non-nil then do not match on methods in -objects (relevant only if 'prolog-system' is set to 'sicstus)." +objects (relevant only if `prolog-system' is set to `sicstus')." (save-excursion (let ((notdone t) (retval (point-min))) @@ -3522,11 +2789,8 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." ;; ###### ;; (re-search-backward "^[a-z$']" nil t)) (let ((case-fold-search nil)) - (re-search-backward - ;; (format "^[%s$']" prolog-lower-case-string) - ;; FIXME: Use [:lower:] - (format "^\\([%s$']\\|[:?]-\\)" prolog-lower-case-string) - nil t))) + (re-search-backward "^\\([[:lower:]$']\\|[:?]-\\)" + nil t))) (let ((bal (prolog-paren-balance))) (cond ((> bal 0) @@ -3552,7 +2816,7 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." (defun prolog-clause-end (&optional not-allow-methods) "Return the position at the end of the current clause. If NOTALLOWMETHODS is non-nil then do not match on methods in -objects (relevant only if 'prolog-system' is set to 'sicstus)." +objects (relevant only if `prolog-system' is set to `sicstus')." (save-excursion (beginning-of-line) ; Necessary since we use "^...." for the search. (if (re-search-forward @@ -3566,7 +2830,7 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$" prolog-quoted-atom-regexp prolog-string-regexp)) nil t) - (if (and (prolog-in-string-or-comment) + (if (and (nth 8 (syntax-ppss)) (not (eobp))) (progn (forward-char) @@ -3589,7 +2853,7 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." ;; Retrieve the arity. (if (looking-at prolog-left-paren) (let ((endp (save-excursion - (prolog-forward-list) (point)))) + (forward-list) (point)))) (setq arity 1) (forward-char 1) ; Skip the opening paren. (while (progn @@ -3601,9 +2865,8 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." (forward-char 1) ; Skip the comma. ) ;; We found a string, list or something else we want - ;; to skip over. Always use prolog-tokenize, - ;; parse-partial-sexp does not have a 'skipover mode. - (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover)))) + ;; to skip over. + (forward-sexp 1)) ))) (list predname arity)))) @@ -3623,36 +2886,6 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)." (match-string 1) nil)))) -(defun prolog-forward-list () - "Move the point to the matching right parenthesis." - (interactive) - (if prolog-use-prolog-tokenizer-flag - (let ((state (prolog-tokenize (point) (point-max) 'zerodepth))) - (goto-char (nth 5 state))) - (forward-list))) - -;; NB: This could be done more efficiently! -(defun prolog-backward-list () - "Move the point to the matching left parenthesis." - (interactive) - (if prolog-use-prolog-tokenizer-flag - (let ((bal 0) - (paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren)) - (notdone t)) - ;; FIXME: Doesn't this incorrectly count 0'( and 0') ? - (while (and notdone (re-search-backward paren-regexp nil t)) - (cond - ((looking-at prolog-left-paren) - (if (not (prolog-in-string-or-comment)) - (setq bal (1+ bal))) - (if (= bal 0) - (setq notdone nil))) - ((looking-at prolog-right-paren) - (if (not (prolog-in-string-or-comment)) - (setq bal (1- bal)))) - ))) - (backward-list))) - (defun prolog-beginning-of-clause () "Move to the beginning of current clause. If already at the beginning of clause, move to previous clause." @@ -3785,23 +3018,6 @@ The module name should be written manually just before the semi-colon." (interactive "r") (comment-region beg end -1)))) -(defun prolog-goto-comment-column (&optional nocreate) - "Move comments on the current line to the correct position. -If NOCREATE is nil (or omitted) and there is no comment on the line, then -a new comment is created." - (interactive) - (beginning-of-line) - (if (or (not nocreate) - (and - (re-search-forward - (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *" - prolog-quoted-atom-regexp prolog-string-regexp) - (line-end-position) 'limit) - (progn - (goto-char (match-beginning 0)) - (not (eq (prolog-in-string-or-comment) 'txt))))) - (indent-for-comment))) - (defun prolog-indent-predicate () "Indent the current predicate." (interactive) @@ -3834,130 +3050,72 @@ a new comment is created." (goto-char pos) (goto-char (prolog-pred-start)))) -;; Stolen from `cc-mode.el': -(defun prolog-electric-delete (arg) - "Delete preceding character or whitespace. -If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is -consumed. If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is -nil, or point is inside a literal then the function -`backward-delete-char' is called." - (interactive "P") - (if (or (not prolog-hungry-delete-key-flag) - arg - (prolog-in-string-or-comment)) - (funcall 'backward-delete-char (prefix-numeric-value arg)) - (let ((here (point))) - (skip-chars-backward " \t\n") - (if (/= (point) here) - (delete-region (point) here) - (funcall 'backward-delete-char 1) - )))) - -;; For XEmacs compatibility (suggested by Per Mildner) -(put 'prolog-electric-delete 'pending-delete 'supersede) - -(defun prolog-electric-if-then-else (arg) - "If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs. -Bound to the >, ; and ( keys." - ;; FIXME: Use post-self-insert-hook or electric-indent-mode. - (interactive "P") - (self-insert-command (prefix-numeric-value arg)) - (if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren))) - -(defun prolog-electric-colon (arg) +(defun prolog-electric--colon () "If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct. That is, insert space (if appropriate), `:-' and newline if colon is pressed -at the end of a line that starts in the first column (i.e., clause -heads)." - ;; FIXME: Use post-self-insert-hook. - (interactive "P") - (if (and prolog-electric-colon-flag - (null arg) - (eolp) - ;(not (string-match "^\\s " (thing-at-point 'line)))) - (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line)))) - (progn - (unless (save-excursion (backward-char 1) (looking-at "\\s ")) - (insert " ")) - (insert ":-\n") - (indent-according-to-mode)) - (self-insert-command (prefix-numeric-value arg)))) +at the end of a line that starts in the first column (i.e., clause heads)." + (when (and prolog-electric-colon-flag + (eq (char-before) ?:) + (not current-prefix-arg) + (eolp) + (not (memq (char-after (line-beginning-position)) + '(?\s ?\t ?\%)))) + (unless (memq (char-before (1- (point))) '(?\s ?\t)) + (save-excursion (forward-char -1) (insert " "))) + (insert "-\n") + (indent-according-to-mode))) -(defun prolog-electric-dash (arg) +(defun prolog-electric--dash () "If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct. that is, insert space (if appropriate), `-->' and newline if dash is pressed -at the end of a line that starts in the first column (i.e., DCG -heads)." - ;; FIXME: Use post-self-insert-hook. - (interactive "P") - (if (and prolog-electric-dash-flag - (null arg) - (eolp) - ;(not (string-match "^\\s " (thing-at-point 'line)))) - (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line)))) - (progn - (unless (save-excursion (backward-char 1) (looking-at "\\s ")) - (insert " ")) - (insert "-->\n") - (indent-according-to-mode)) - (self-insert-command (prefix-numeric-value arg)))) +at the end of a line that starts in the first column (i.e., DCG heads)." + (when (and prolog-electric-dash-flag + (eq (char-before) ?-) + (not current-prefix-arg) + (eolp) + (not (memq (char-after (line-beginning-position)) + '(?\s ?\t ?\%)))) + (unless (memq (char-before (1- (point))) '(?\s ?\t)) + (save-excursion (forward-char -1) (insert " "))) + (insert "->\n") + (indent-according-to-mode))) -(defun prolog-electric-dot (arg) - "Insert dot and newline or a head of a new clause. - -If `prolog-electric-dot-flag' is nil, then simply insert dot. -Otherwise:: +(defun prolog-electric--dot () + "Make dot electric, if `prolog-electric-dot-flag' is non-nil. When invoked at the end of nonempty line, insert dot and newline. When invoked at the end of an empty line, insert a recursive call to the current predicate. When invoked at the beginning of line, insert a head of a new clause -of the current predicate. - -When called with prefix argument ARG, insert just dot." - ;; FIXME: Use post-self-insert-hook. - (interactive "P") +of the current predicate." ;; Check for situations when the electricity should not be active (if (or (not prolog-electric-dot-flag) - arg - (prolog-in-string-or-comment) + (not (eq (char-before) ?\.)) + current-prefix-arg + (nth 8 (syntax-ppss)) ;; Do not be electric in a floating point number or an operator (not - (or - ;; (re-search-backward - ;; ###### - ;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t))) - (save-excursion - (re-search-backward - ;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t))) - "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" - nil t)) - (save-excursion - (re-search-backward - ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t))) - (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" - prolog-lower-case-string) ;FIXME: [:lower:] - nil t)) - (save-excursion - (re-search-backward - ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t))) - (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" - prolog-upper-case-string) ;FIXME: [:upper:] - nil t)) - ) - ) + (save-excursion + (forward-char -1) + (skip-chars-backward " \t") + (let ((num (> (skip-chars-backward "0-9") 0))) + (or (bolp) + (memq (char-syntax (char-before)) + (if num '(?w ?_) '(?\) ?w ?_))))))) ;; Do not be electric if inside a parenthesis pair. - (not (= (prolog-region-paren-balance (prolog-clause-start) (point)) + (not (= (car (syntax-ppss)) 0)) ) - (funcall 'self-insert-command (prefix-numeric-value arg)) + nil ;;Not electric. (cond ;; Beginning of line - ((bolp) + ((save-excursion (forward-char -1) (bolp)) + (delete-region (1- (point)) (point)) ;Delete the dot that called us. (prolog-insert-predicate-template)) ;; At an empty line with at least one whitespace ((save-excursion (beginning-of-line) - (looking-at "[ \t]+$")) + (looking-at "[ \t]+\\.$")) + (delete-region (1- (point)) (point)) ;Delete the dot that called us. (prolog-insert-predicate-template) (when prolog-electric-dot-full-predicate-template (save-excursion @@ -3965,47 +3123,31 @@ When called with prefix argument ARG, insert just dot." (insert ".\n")))) ;; Default (t - (insert ".\n")) + (insert "\n")) ))) -(defun prolog-electric-underscore () +(defun prolog-electric--underscore () "Replace variable with an underscore. If `prolog-electric-underscore-flag' is non-nil and the point is on a variable then replace the variable with underscore and skip -the following comma and whitespace, if any. -If the point is not on a variable then insert underscore." - ;; FIXME: Use post-self-insert-hook. - (interactive) - (if prolog-electric-underscore-flag - (let (;start - (case-fold-search nil) - (oldp (point))) - ;; ###### - ;;(skip-chars-backward "a-zA-Z_") - (skip-chars-backward - (format "%s%s_" - ;; FIXME: Why not "a-zA-Z"? - prolog-lower-case-string - prolog-upper-case-string)) - - ;(setq start (point)) - (if (and (not (prolog-in-string-or-comment)) - ;; ###### - ;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>")) - (looking-at (format "\\<[_%s][%s%s_0-9]*\\>" - ;; FIXME: Use [:upper:] and friends. - prolog-upper-case-string - prolog-lower-case-string - prolog-upper-case-string))) - (progn - (replace-match "_") - (skip-chars-forward ", \t\n")) - (goto-char oldp) - (self-insert-command 1)) - ) - (self-insert-command 1)) - ) +the following comma and whitespace, if any." + (when prolog-electric-underscore-flag + (let ((case-fold-search nil)) + (when (and (not (nth 8 (syntax-ppss))) + (eq (char-before) ?_) + (save-excursion + (skip-chars-backward "[:alpha:]_") + (looking-at "\\<_[_[:upper:]][[:alnum:]_]*\\_>"))) + (replace-match "_") + (skip-chars-forward ", \t\n"))))) +(defun prolog-post-self-insert () + (pcase last-command-event + (`?_ (prolog-electric--underscore)) + (`?- (prolog-electric--dash)) + (`?: (prolog-electric--colon)) + ((or `?\( `?\; `?>) (prolog-electric--if-then-else)) + (`?. (prolog-electric--dot)))) (defun prolog-find-term (functor arity &optional prefix) "Go to the position at the start of the next occurrence of a term. @@ -4209,11 +3351,12 @@ PREFIX is the prefix of the search regexp." (easy-menu-add prolog-edit-menu-runtime) ;; Add predicate index menu - (set (make-local-variable 'imenu-create-index-function) - 'imenu-default-create-index-function) + (setq-local imenu-create-index-function + 'imenu-default-create-index-function) ;;Milan (this has problems with object methods...) ###### Does it? (Stefan) - (setq imenu-prev-index-position-function 'prolog-beginning-of-predicate) - (setq imenu-extract-index-name-function 'prolog-get-predspec) + (setq-local imenu-prev-index-position-function + #'prolog-beginning-of-predicate) + (setq-local imenu-extract-index-name-function #'prolog-get-predspec) (if (and prolog-imenu-flag (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines)) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 0f994a8422b..f7de331f73b 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -1,6 +1,6 @@ ;;; ps-mode.el --- PostScript mode for GNU Emacs -;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001-2014 Free Software Foundation, Inc. ;; Author: Peter Kleiweg ;; Maintainer: Peter Kleiweg @@ -427,7 +427,6 @@ If nil, use `temporary-file-directory'." (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char) (define-key ps-mode-map "\t" 'ps-mode-tabkey) (define-key ps-mode-map "\r" 'ps-mode-newline) - (define-key ps-mode-map [return] 'ps-mode-newline) (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)) (unless ps-run-mode-map diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f0f67d01845..670451e58ae 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1,11 +1,11 @@ -;;; python.el --- Python's flying circus support for Emacs +;;; python.el --- Python's flying circus support for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2003-2014 Free Software Foundation, Inc. ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.24.2 -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -40,9 +40,9 @@ ;; Indentation: Automatic indentation with indentation cycling is ;; provided, it allows you to navigate different available levels of -;; indentation by hitting several times. Also when inserting a -;; colon the `python-indent-electric-colon' command is invoked and -;; causes the current line to be dedented automatically if needed. +;; indentation by hitting several times. Also electric-indent-mode +;; is supported such that when inserting a colon the current line is +;; dedented automatically if needed. ;; Movement: `beginning-of-defun' and `end-of-defun' functions are ;; properly implemented. There are also specialized @@ -52,12 +52,12 @@ ;; Extra functions `python-nav-forward-statement', ;; `python-nav-backward-statement', ;; `python-nav-beginning-of-statement', `python-nav-end-of-statement', -;; `python-nav-beginning-of-block' and `python-nav-end-of-block' are -;; included but no bound to any key. At last but not least the -;; specialized `python-nav-forward-sexp' allows easy navigation -;; between code blocks. If you prefer `cc-mode'-like `forward-sexp' -;; movement, setting `forward-sexp-function' to nil is enough, You can -;; do that using the `python-mode-hook': +;; `python-nav-beginning-of-block', `python-nav-end-of-block' and +;; `python-nav-if-name-main' are included but no bound to any key. At +;; last but not least the specialized `python-nav-forward-sexp' allows +;; easy navigation between code blocks. If you prefer `cc-mode'-like +;; `forward-sexp' movement, setting `forward-sexp-function' to nil is +;; enough, You can do that using the `python-mode-hook': ;; (add-hook 'python-mode-hook ;; (lambda () (setq forward-sexp-function nil))) @@ -157,7 +157,7 @@ ;; Skeletons: 6 skeletons are provided for simple inserting of class, ;; def, for, if, try and while. These skeletons are integrated with -;; dabbrev. If you have `dabbrev-mode' activated and +;; abbrev. If you have `abbrev-mode' activated and ;; `python-skeleton-autoinsert' is set to t, then whenever you type ;; the name of any of those defined and hit SPC, they will be ;; automatically expanded. As an alternative you can use the defined @@ -177,12 +177,14 @@ ;; might guessed you should run `python-shell-send-buffer' from time ;; to time to get better results too. -;; Imenu: This mode supports Imenu in its most basic form, letting it -;; build the necessary alist via `imenu-default-create-index-function' -;; by having set `imenu-extract-index-name-function' to -;; `python-info-current-defun' and -;; `imenu-prev-index-position-function' to -;; `python-imenu-prev-index-position'. +;; Imenu: There are two index building functions to be used as +;; `imenu-create-index-function': `python-imenu-create-index' (the +;; default one, builds the alist in form of a tree) and +;; `python-imenu-create-flat-index'. See also +;; `python-imenu-format-item-label-function', +;; `python-imenu-format-parent-item-label-function', +;; `python-imenu-format-parent-item-jump-label-function' variables for +;; changing the way labels are formatted in the tree version. ;; If you used python-mode.el you probably will miss auto-indentation ;; when inserting newlines. To achieve the same behavior you have @@ -223,7 +225,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) ;;;###autoload -(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode)) +(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode)) (defgroup python nil "Python Language's flying circus support for Emacs." @@ -246,7 +248,6 @@ (define-key map (kbd "") 'python-indent-dedent-line) (define-key map "\C-c<" 'python-indent-shift-left) (define-key map "\C-c>" 'python-indent-shift-right) - (define-key map ":" 'python-indent-electric-colon) ;; Skeletons (define-key map "\C-c\C-tc" 'python-skeleton-class) (define-key map "\C-c\C-td" 'python-skeleton-def) @@ -368,22 +369,24 @@ This variant of `rx' supports common python named REGEXPS." ;;; Font-lock and syntax +(eval-when-compile + (defun python-syntax--context-compiler-macro (form type &optional syntax-ppss) + (pcase type + (`'comment + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 4 ppss) (nth 8 ppss)))) + (`'string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 3 ppss) (nth 8 ppss)))) + (`'paren + `(nth 1 (or ,syntax-ppss (syntax-ppss)))) + (_ form)))) + (defun python-syntax-context (type &optional syntax-ppss) "Return non-nil if point is on TYPE using SYNTAX-PPSS. TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." - (declare (compiler-macro - (lambda (form) - (pcase type - (`'comment - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 4 ppss) (nth 8 ppss)))) - (`'string - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 3 ppss) (nth 8 ppss)))) - (`'paren - `(nth 1 (or ,syntax-ppss (syntax-ppss)))) - (_ form))))) + (declare (compiler-macro python-syntax--context-compiler-macro)) (let ((ppss (or syntax-ppss (syntax-ppss)))) (pcase type (`comment (and (nth 4 ppss) (nth 8 ppss))) @@ -497,29 +500,24 @@ The type returned can be `comment', `string' or `paren'." (,(lambda (limit) (let ((re (python-rx (group (+ (any word ?. ?_))) (? ?\[ (+ (not (any ?\]))) ?\]) (* space) - assignment-operator))) - (when (re-search-forward re limit t) - (while (and (python-syntax-context 'paren) - (re-search-forward re limit t))) - (if (not (or (python-syntax-context 'paren) - (equal (char-after (point-marker)) ?=))) - t - (set-match-data nil))))) + assignment-operator)) + (res nil)) + (while (and (setq res (re-search-forward re limit t)) + (or (python-syntax-context 'paren) + (equal (char-after (point-marker)) ?=)))) + res)) (1 font-lock-variable-name-face nil nil)) ;; support for a, b, c = (1, 2, 3) (,(lambda (limit) (let ((re (python-rx (group (+ (any word ?. ?_))) (* space) (* ?, (* space) (+ (any word ?. ?_)) (* space)) ?, (* space) (+ (any word ?. ?_)) (* space) - assignment-operator))) - (when (and (re-search-forward re limit t) - (goto-char (nth 3 (match-data)))) - (while (and (python-syntax-context 'paren) - (re-search-forward re limit t)) - (goto-char (nth 3 (match-data)))) - (if (not (python-syntax-context 'paren)) - t - (set-match-data nil))))) + assignment-operator)) + (res nil)) + (while (and (setq res (re-search-forward re limit t)) + (goto-char (match-end 1)) + (python-syntax-context 'paren))) + res)) (1 font-lock-variable-name-face nil nil)))) (defconst python-syntax-propertize-function @@ -638,6 +636,13 @@ It makes underscores and dots word constituent chars.") These make `python-indent-calculate-indentation' subtract the value of `python-indent-offset'.") +(defvar python-indent-block-enders + '("break" "continue" "pass" "raise" "return") + "List of words that mark the end of a block. +These make `python-indent-calculate-indentation' subtract the +value of `python-indent-offset' when `python-indent-context' is +AFTER-LINE.") + (defun python-indent-guess-indent-offset () "Guess and set `python-indent-offset' for the current buffer." (interactive) @@ -670,7 +675,7 @@ These make `python-indent-calculate-indentation' subtract the value of (goto-char block-end) (python-util-forward-comment) (current-indentation)))) - (if indentation + (if (and indentation (not (zerop indentation))) (set (make-local-variable 'python-indent-offset) indentation) (message "Can't guess python-indent-offset, using defaults: %s" python-indent-offset))))))) @@ -681,6 +686,8 @@ Context information is returned with a cons with the form: \(STATUS . START) Where status can be any of the following symbols: + + * after-comment: When current line might continue a comment block * inside-paren: If point in between (), {} or [] * inside-string: If point is inside a string * after-backslash: Previous line ends in a backslash @@ -699,6 +706,17 @@ START is the buffer position where the sexp starts." (goto-char (line-beginning-position)) (bobp)) 'no-indent) + ;; Comment continuation + ((save-excursion + (when (and + (or + (python-info-current-line-comment-p) + (python-info-current-line-empty-p)) + (progn + (forward-comment -1) + (python-info-current-line-comment-p))) + (setq start (point)) + 'after-comment))) ;; Inside string ((setq start (python-syntax-context 'string ppss)) 'inside-string) @@ -750,6 +768,9 @@ START is the buffer position where the sexp starts." (save-excursion (pcase context-status (`no-indent 0) + (`after-comment + (goto-char context-start) + (current-indentation)) ;; When point is after beginning of block just add one level ;; of indentation relative to the context-start (`after-beginning-of-block @@ -759,15 +780,31 @@ START is the buffer position where the sexp starts." ;; indentation, in the case current line starts with a ;; `python-indent-dedenters' de-indent one level. (`after-line - (- - (save-excursion - (goto-char context-start) - (current-indentation)) - (if (progn - (back-to-indentation) - (looking-at (regexp-opt python-indent-dedenters))) - python-indent-offset - 0))) + (let* ((pair (save-excursion + (goto-char context-start) + (cons + (current-indentation) + (python-info-beginning-of-block-p)))) + (context-indentation (car pair)) + (after-block-start-p (cdr pair)) + (adjustment + (if (or (save-excursion + (back-to-indentation) + (and + ;; De-indent only when dedenters are not + ;; next to a block start. This allows + ;; one-liner constructs such as: + ;; if condition: print "yay" + ;; else: print "wry" + (not after-block-start-p) + (looking-at (regexp-opt python-indent-dedenters)))) + (save-excursion + (python-util-forward-comment -1) + (python-nav-beginning-of-statement) + (looking-at (regexp-opt python-indent-block-enders)))) + python-indent-offset + 0))) + (- context-indentation adjustment))) ;; When inside of a string, do nothing. just use the current ;; indentation. XXX: perhaps it would be a good idea to ;; invoke standard text indentation here @@ -1048,48 +1085,43 @@ the lines in which START and END lie." (list (region-beginning) (region-end) current-prefix-arg) (list (line-beginning-position) (line-end-position) current-prefix-arg))) (let ((deactivate-mark nil)) - (if count - (setq count (prefix-numeric-value count)) - (setq count python-indent-offset)) + (setq count (if count (prefix-numeric-value count) + python-indent-offset)) (indent-rigidly start end count))) -(defun python-indent-electric-colon (arg) - "Insert a colon and maybe de-indent the current line. -With numeric ARG, just insert that many colons. With -\\[universal-argument], just insert a single colon." - (interactive "*P") - (self-insert-command (if (not (integerp arg)) 1 arg)) - (when (and (not arg) - (eolp) - (not (equal ?: (char-after (- (point-marker) 2)))) - (not (python-syntax-comment-or-string-p))) - (let ((indentation (current-indentation)) - (calculated-indentation (python-indent-calculate-indentation))) - (python-info-closing-block-message) - (when (> indentation calculated-indentation) - (save-excursion - (indent-line-to calculated-indentation) - (when (not (python-info-closing-block-message)) - (indent-line-to indentation))))))) -(put 'python-indent-electric-colon 'delete-selection t) - (defun python-indent-post-self-insert-function () - "Adjust closing paren line indentation after a char is added. + "Adjust indentation after insertion of some characters. This function is intended to be added to the `post-self-insert-hook.' If a line renders a paren alone, after adding a char before it, the line will be re-indented automatically if needed." - (when (and (eq (char-before) last-command-event) - (not (bolp)) - (memq (char-after) '(?\) ?\] ?\}))) - (save-excursion - (goto-char (line-beginning-position)) - ;; If after going to the beginning of line the point - ;; is still inside a paren it's ok to do the trick - (when (python-syntax-context 'paren) - (let ((indentation (python-indent-calculate-indentation))) - (when (< (current-indentation) indentation) - (indent-line-to indentation))))))) + (when (and electric-indent-mode + (eq (char-before) last-command-event)) + (cond + ((and (not (bolp)) + (memq (char-after) '(?\) ?\] ?\}))) + (save-excursion + (goto-char (line-beginning-position)) + ;; If after going to the beginning of line the point + ;; is still inside a paren it's ok to do the trick + (when (python-syntax-context 'paren) + (let ((indentation (python-indent-calculate-indentation))) + (when (< (current-indentation) indentation) + (indent-line-to indentation)))))) + ((and (eq ?: last-command-event) + (memq ?: electric-indent-chars) + (not current-prefix-arg) + (eolp) + (not (equal ?: (char-before (1- (point))))) + (not (python-syntax-comment-or-string-p))) + (let ((indentation (current-indentation)) + (calculated-indentation (python-indent-calculate-indentation))) + (python-info-closing-block-message) + (when (> indentation calculated-indentation) + (save-excursion + (indent-line-to calculated-indentation) + (when (not (python-info-closing-block-message)) + (indent-line-to indentation))))))))) ;;; Navigation @@ -1151,13 +1183,13 @@ position. Return non-nil if point is moved to `beginning-of-defun'." (when (or (null arg) (= arg 0)) (setq arg 1)) (let ((found)) - (cond ((and (eq this-command 'mark-defun) - (python-info-looking-at-beginning-of-defun))) - (t - (dotimes (i (if (> arg 0) arg (- arg))) - (when (and (python-nav--beginning-of-defun arg) - (not found)) - (setq found t))))) + (while (and (not (= arg 0)) + (let ((keep-searching-p + (python-nav--beginning-of-defun arg))) + (when (and keep-searching-p (null found)) + (setq found t)) + keep-searching-p)) + (setq arg (if (> arg 0) (1- arg) (1+ arg)))) found)) (defun python-nav-end-of-defun () @@ -1180,18 +1212,88 @@ Returns nil if point is not in a def or class." ;; Ensure point moves forward. (and (> beg-pos (point)) (goto-char beg-pos))))) +(defun python-nav--syntactically (fn poscompfn &optional contextfn) + "Move point using FN avoiding places with specific context. +FN must take no arguments. POSCOMPFN is a two arguments function +used to compare current and previous point after it is moved +using FN, this is normally a less-than or greater-than +comparison. Optional argument CONTEXTFN defaults to +`python-syntax-context-type' and is used for checking current +point context, it must return a non-nil value if this point must +be skipped." + (let ((contextfn (or contextfn 'python-syntax-context-type)) + (start-pos (point-marker)) + (prev-pos)) + (catch 'found + (while t + (let* ((newpos + (and (funcall fn) (point-marker))) + (context (funcall contextfn))) + (cond ((and (not context) newpos + (or (and (not prev-pos) newpos) + (and prev-pos newpos + (funcall poscompfn newpos prev-pos)))) + (throw 'found (point-marker))) + ((and newpos context) + (setq prev-pos (point))) + (t (when (not newpos) (goto-char start-pos)) + (throw 'found nil)))))))) + +(defun python-nav--forward-defun (arg) + "Internal implementation of python-nav-{backward,forward}-defun. +Uses ARG to define which function to call, and how many times +repeat it." + (let ((found)) + (while (and (> arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-forward + python-nav-beginning-of-defun-regexp nil t)) + '>))) + (setq arg (1- arg))) + (while (and (< arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-backward + python-nav-beginning-of-defun-regexp nil t)) + '<))) + (setq arg (1+ arg))) + found)) + +(defun python-nav-backward-defun (&optional arg) + "Navigate to closer defun backward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (- (or arg 1)))) + +(defun python-nav-forward-defun (&optional arg) + "Navigate to closer defun forward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (or arg 1))) + (defun python-nav-beginning-of-statement () "Move to start of current statement." (interactive "^") - (while (and (or (back-to-indentation) t) - (not (bobp)) - (when (or - (save-excursion - (forward-line -1) - (python-info-line-ends-backslash-p)) - (python-syntax-context 'string) - (python-syntax-context 'paren)) - (forward-line -1)))) + (back-to-indentation) + (let* ((ppss (syntax-ppss)) + (context-point + (or + (python-syntax-context 'paren ppss) + (python-syntax-context 'string ppss)))) + (cond ((bobp)) + (context-point + (goto-char context-point) + (python-nav-beginning-of-statement)) + ((save-excursion + (forward-line -1) + (python-info-line-ends-backslash-p)) + (forward-line -1) + (python-nav-beginning-of-statement)))) (point-marker)) (defun python-nav-end-of-statement (&optional noend) @@ -1253,9 +1355,7 @@ backward to previous statement." (defun python-nav-beginning-of-block () "Move to start of current block." (interactive "^") - (let ((starting-pos (point)) - (block-regexp (python-rx - line-start (* whitespace) block-start))) + (let ((starting-pos (point))) (if (progn (python-nav-beginning-of-statement) (looking-at (python-rx block-start))) @@ -1324,33 +1424,41 @@ backward to previous block." (and (goto-char starting-pos) nil) (and (not (= (point) starting-pos)) (point-marker))))) -(defun python-nav-lisp-forward-sexp-safe (&optional arg) - "Safe version of standard `forward-sexp'. -When ARG > 0 move forward, else if ARG is < 0." - (or arg (setq arg 1)) +(defun python-nav--lisp-forward-sexp (&optional arg) + "Standard version `forward-sexp'. +It ignores completely the value of `forward-sexp-function' by +setting it to nil before calling `forward-sexp'. With positive +ARG move forward only one sexp, else move backwards." (let ((forward-sexp-function) - (paren-regexp - (if (> arg 0) (python-rx close-paren) (python-rx open-paren))) - (search-fn - (if (> arg 0) #'re-search-forward #'re-search-backward))) + (arg (if (or (not arg) (> arg 0)) 1 -1))) + (forward-sexp arg))) + +(defun python-nav--lisp-forward-sexp-safe (&optional arg) + "Safe version of standard `forward-sexp'. +When at end of sexp (i.e. looking at a opening/closing paren) +skips it instead of throwing an error. With positive ARG move +forward only one sexp, else move backwards." + (let* ((arg (if (or (not arg) (> arg 0)) 1 -1)) + (paren-regexp + (if (> arg 0) (python-rx close-paren) (python-rx open-paren))) + (search-fn + (if (> arg 0) #'re-search-forward #'re-search-backward))) (condition-case nil - (forward-sexp arg) + (python-nav--lisp-forward-sexp arg) (error (while (and (funcall search-fn paren-regexp nil t) (python-syntax-context 'paren))))))) -(defun python-nav--forward-sexp (&optional dir) +(defun python-nav--forward-sexp (&optional dir safe) "Move to forward sexp. -With positive Optional argument DIR direction move forward, else -backwards." +With positive optional argument DIR direction move forward, else +backwards. When optional argument SAFE is non-nil do not throw +errors when at end of sexp, skip it instead." (setq dir (or dir 1)) (unless (= dir 0) (let* ((forward-p (if (> dir 0) (and (setq dir 1) t) (and (setq dir -1) nil))) - (re-search-fn (if forward-p - 're-search-forward - 're-search-backward)) (context-type (python-syntax-context-type))) (cond ((memq context-type '(string comment)) @@ -1363,7 +1471,9 @@ backwards." (eq (syntax-class (syntax-after (1- (point)))) (car (string-to-syntax ")"))))) ;; Inside a paren or looking at it, lisp knows what to do. - (python-nav-lisp-forward-sexp-safe dir)) + (if safe + (python-nav--lisp-forward-sexp-safe dir) + (python-nav--lisp-forward-sexp dir))) (t ;; This part handles the lispy feel of ;; `python-nav-forward-sexp'. Knowing everything about the @@ -1377,7 +1487,9 @@ backwards." ((python-info-end-of-statement-p) 'statement-end))) (next-sexp-pos (save-excursion - (python-nav-lisp-forward-sexp-safe dir) + (if safe + (python-nav--lisp-forward-sexp-safe dir) + (python-nav--lisp-forward-sexp dir)) (point))) (next-sexp-context (save-excursion @@ -1431,23 +1543,48 @@ backwards." (python-nav-beginning-of-statement)) (t (goto-char next-sexp-pos)))))))))) -(defun python-nav--backward-sexp () - "Move to backward sexp." - (python-nav--forward-sexp -1)) - (defun python-nav-forward-sexp (&optional arg) - "Move forward across one block of code. -With ARG, do it that many times. Negative arg -N means -move backward N times." + "Move forward across expressions. +With ARG, do it that many times. Negative arg -N means move +backward N times." (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) - (python-nav--forward-sexp) + (python-nav--forward-sexp 1) (setq arg (1- arg))) (while (< arg 0) - (python-nav--backward-sexp) + (python-nav--forward-sexp -1) (setq arg (1+ arg)))) +(defun python-nav-backward-sexp (&optional arg) + "Move backward across expressions. +With ARG, do it that many times. Negative arg -N means move +backward N times." + (interactive "^p") + (or arg (setq arg 1)) + (python-nav-forward-sexp (- arg))) + +(defun python-nav-forward-sexp-safe (&optional arg) + "Move forward safely across expressions. +With ARG, do it that many times. Negative arg -N means move +backward N times." + (interactive "^p") + (or arg (setq arg 1)) + (while (> arg 0) + (python-nav--forward-sexp 1 t) + (setq arg (1- arg))) + (while (< arg 0) + (python-nav--forward-sexp -1 t) + (setq arg (1+ arg)))) + +(defun python-nav-backward-sexp-safe (&optional arg) + "Move backward safely across expressions. +With ARG, do it that many times. Negative arg -N means move +backward N times." + (interactive "^p") + (or arg (setq arg 1)) + (python-nav-forward-sexp-safe (- arg))) + (defun python-nav--up-list (&optional dir) "Internal implementation of `python-nav-up-list'. DIR is always 1 or -1 and comes sanitized from @@ -1509,6 +1646,29 @@ This command assumes point is not in a string or comment." (or arg (setq arg 1)) (python-nav-up-list (- arg))) +(defun python-nav-if-name-main () + "Move point at the beginning the __main__ block. +When \"if __name__ == '__main__':\" is found returns its +position, else returns nil." + (interactive) + (let ((point (point)) + (found (catch 'found + (goto-char (point-min)) + (while (re-search-forward + (python-rx line-start + "if" (+ space) + "__name__" (+ space) + "==" (+ space) + (group-n 1 (or ?\" ?\')) + "__main__" (backref 1) (* space) ":") + nil t) + (when (not (python-syntax-context-type)) + (beginning-of-line) + (throw 'found t)))))) + (if found + (point) + (ignore (goto-char point))))) + ;;; Shell integration @@ -1603,7 +1763,7 @@ This variable, when set to a string, makes the values stored in `python-shell-process-environment' and `python-shell-exec-path' to be modified properly so shells are started with the specified virtualenv." - :type 'string + :type '(choice (const nil) string) :group 'python :safe 'stringp) @@ -1876,8 +2036,8 @@ startup." (python-shell-parse-command) (python-shell-internal-get-process-name) nil t)))) -(defun python-shell-get-process () - "Get inferior Python process for current buffer and return it." +(defun python-shell-get-buffer () + "Get inferior Python buffer for current buffer and return it." (let* ((dedicated-proc-name (python-shell-get-process-name t)) (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name)) (global-proc-name (python-shell-get-process-name nil)) @@ -1885,8 +2045,12 @@ startup." (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) (global-running (comint-check-proc global-proc-buffer-name))) ;; Always prefer dedicated - (get-buffer-process (or (and dedicated-running dedicated-proc-buffer-name) - (and global-running global-proc-buffer-name))))) + (or (and dedicated-running dedicated-proc-buffer-name) + (and global-running global-proc-buffer-name)))) + +(defun python-shell-get-process () + "Get inferior Python process for current buffer and return it." + (get-buffer-process (python-shell-get-buffer))) (defun python-shell-get-or-create-process () "Get or create an inferior Python process for current buffer and return it." @@ -1940,27 +2104,29 @@ there for compatibility with CEDET.") (define-obsolete-variable-alias 'python-preoutput-result 'python-shell-internal-last-output "24.3") -(defun python-shell-send-string (string &optional process msg) - "Send STRING to inferior Python PROCESS. -When MSG is non-nil messages the first line of STRING." +(defun python-shell--save-temp-file (string) + (let* ((temporary-file-directory + (if (file-remote-p default-directory) + (concat (file-remote-p default-directory) "/tmp") + temporary-file-directory)) + (temp-file-name (make-temp-file "py")) + (coding-system-for-write 'utf-8)) + (with-temp-file temp-file-name + (insert "# -*- coding: utf-8 -*-\n") ;Not needed for Python-3. + (insert string) + (delete-trailing-whitespace)) + temp-file-name)) + +(defun python-shell-send-string (string &optional process) + "Send STRING to inferior Python PROCESS." (interactive "sPython command: ") - (let ((process (or process (python-shell-get-or-create-process))) - (lines (split-string string "\n" t))) - (and msg (message "Sent: %s..." (nth 0 lines))) - (if (> (length lines) 1) - (let* ((temporary-file-directory - (if (file-remote-p default-directory) - (concat (file-remote-p default-directory) "/tmp") - temporary-file-directory)) - (temp-file-name (make-temp-file "py")) - (file-name (or (buffer-file-name) temp-file-name))) - (with-temp-file temp-file-name - (insert string) - (delete-trailing-whitespace)) - (python-shell-send-file file-name process temp-file-name)) + (let ((process (or process (python-shell-get-or-create-process)))) + (if (string-match ".\n+." string) ;Multiline. + (let* ((temp-file-name (python-shell--save-temp-file string))) + (python-shell-send-file temp-file-name process temp-file-name t)) (comint-send-string process string) - (when (or (not (string-match "\n$" string)) - (string-match "\n[ \t].*\n?$" string)) + (when (or (not (string-match "\n\\'" string)) + (string-match "\n[ \t].*\n?\\'" string)) (comint-send-string process "\n"))))) (defvar python-shell-output-filter-in-progress nil) @@ -1999,10 +2165,9 @@ detecting a prompt at the end of the buffer." (substring python-shell-output-filter-buffer (match-end 0))))) "") -(defun python-shell-send-string-no-output (string &optional process msg) +(defun python-shell-send-string-no-output (string &optional process) "Send STRING to PROCESS and inhibit output. -When MSG is non-nil messages the first line of STRING. Return -the output." +Return the output." (let ((process (or process (python-shell-get-or-create-process))) (comint-preoutput-filter-functions '(python-shell-output-filter)) @@ -2010,7 +2175,7 @@ the output." (inhibit-quit t)) (or (with-local-quit - (python-shell-send-string string process msg) + (python-shell-send-string string process) (while python-shell-output-filter-in-progress ;; `python-shell-output-filter' takes care of setting ;; `python-shell-output-filter-in-progress' to NIL after it @@ -2032,7 +2197,7 @@ Returns the output. See `python-shell-send-string-no-output'." ;; Makes this function compatible with the old ;; python-send-receive. (At least for CEDET). (replace-regexp-in-string "_emacs_out +" "" string) - (python-shell-internal-get-or-create-process) nil))) + (python-shell-internal-get-or-create-process)))) (define-obsolete-function-alias 'python-send-receive 'python-shell-internal-send-string "24.3") @@ -2040,17 +2205,85 @@ Returns the output. See `python-shell-send-string-no-output'." (define-obsolete-function-alias 'python-send-string 'python-shell-internal-send-string "24.3") -(defun python-shell-send-region (start end) +(defvar python--use-fake-loc nil + "If non-nil, use `compilation-fake-loc' to trace errors back to the buffer. +If nil, regions of text are prepended by the corresponding number of empty +lines and Python is told to output error messages referring to the whole +source file.") + +(defun python-shell-buffer-substring (start end &optional nomain) + "Send buffer substring from START to END formatted for shell. +This is a wrapper over `buffer-substring' that takes care of +different transformations for the code sent to be evaluated in +the python shell: + 1. When Optional Argument NOMAIN is non-nil everything under an + \"if __name__ == '__main__'\" block will be removed. + 2. When a subregion of the buffer is sent, it takes care of + appending extra empty lines so tracebacks are correct. + 3. Wraps indented regions under an \"if True:\" block so the + interpreter evaluates them correctly." + (let ((substring (buffer-substring-no-properties start end)) + (fillstr (unless python--use-fake-loc + (make-string (1- (line-number-at-pos start)) ?\n))) + (toplevel-block-p (save-excursion + (goto-char start) + (or (zerop (line-number-at-pos start)) + (progn + (python-util-forward-comment 1) + (zerop (current-indentation))))))) + (with-temp-buffer + (python-mode) + (if fillstr (insert fillstr)) + (insert substring) + (goto-char (point-min)) + (unless python--use-fake-loc + ;; python-shell--save-temp-file adds an extra coding line, which would + ;; throw off the line-counts, so let's try to compensate here. + (if (looking-at "[ \t]*[#\n]") + (delete-region (point) (line-beginning-position 2)))) + (when (not toplevel-block-p) + (insert "if True:") + (delete-region (point) (line-end-position))) + (when nomain + (let* ((if-name-main-start-end + (and nomain + (save-excursion + (when (python-nav-if-name-main) + (cons (point) + (progn (python-nav-forward-sexp-safe) + (point))))))) + ;; Oh destructuring bind, how I miss you. + (if-name-main-start (car if-name-main-start-end)) + (if-name-main-end (cdr if-name-main-start-end))) + (when if-name-main-start-end + (goto-char if-name-main-start) + (delete-region if-name-main-start if-name-main-end) + (insert + (make-string + (- (line-number-at-pos if-name-main-end) + (line-number-at-pos if-name-main-start)) ?\n))))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(declare-function compilation-fake-loc "compile" + (marker file &optional line col)) + +(defun python-shell-send-region (start end &optional nomain) "Send the region delimited by START and END to inferior Python process." (interactive "r") - (python-shell-send-string - (concat - (let ((line-num (line-number-at-pos start))) - ;; When sending a region, add blank lines for non sent code so - ;; backtraces remain correct. - (make-string (1- line-num) ?\n)) - (buffer-substring start end)) - nil t)) + (let* ((python--use-fake-loc + (or python--use-fake-loc (not buffer-file-name))) + (string (python-shell-buffer-substring start end nomain)) + (process (python-shell-get-or-create-process)) + (_ (string-match "\\`\n*\\(.*\\)" string))) + (message "Sent: %s..." (match-string 1 string)) + (let* ((temp-file-name (python-shell--save-temp-file string)) + (file-name (or (buffer-file-name) temp-file-name))) + (python-shell-send-file file-name process temp-file-name t) + (unless python--use-fake-loc + (with-current-buffer (process-buffer process) + (compilation-fake-loc (copy-marker start) temp-file-name + 2)) ;; Not 1, because of the added coding line. + )))) (defun python-shell-send-buffer (&optional arg) "Send the entire buffer to inferior Python process. @@ -2059,13 +2292,7 @@ by \"if __name__== '__main__':\"" (interactive "P") (save-restriction (widen) - (let ((str (buffer-substring (point-min) (point-max)))) - (and - (not arg) - (setq str (replace-regexp-in-string - (python-rx if-name-main) - "if __name__ == '__main__ ':" str))) - (python-shell-send-string str)))) + (python-shell-send-region (point-min) (point-max) (not arg)))) (defun python-shell-send-defun (arg) "Send the current defun to inferior Python process. @@ -2088,11 +2315,12 @@ When argument ARG is non-nil do not include decorators." (end-of-line 1)) (point-marker))))) -(defun python-shell-send-file (file-name &optional process temp-file-name) +(defun python-shell-send-file (file-name &optional process temp-file-name + delete) "Send FILE-NAME to inferior Python PROCESS. If TEMP-FILE-NAME is passed then that file is used for processing instead, while internally the shell will continue to use -FILE-NAME." +FILE-NAME. If DELETE is non-nil, delete the file afterwards." (interactive "fFile to send: ") (let* ((process (or process (python-shell-get-or-create-process))) (temp-file-name (when temp-file-name @@ -2110,8 +2338,11 @@ FILE-NAME." (format (concat "__pyfile = open('''%s''');" "exec(compile(__pyfile.read(), '''%s''', 'exec'));" - "__pyfile.close()") - (or temp-file-name file-name) file-name) + "__pyfile.close()%s") + (or temp-file-name file-name) file-name + (if delete (format "; import os; os.remove('''%s''')" + (or temp-file-name file-name)) + "")) process))) (defun python-shell-switch-to-shell () @@ -2192,13 +2423,17 @@ and use the following as the value of this variable: LINE is used to detect the context on how to complete given INPUT." (let* ((prompt - ;; Get the last prompt for the inferior process - ;; buffer. This is used for the completion code selection - ;; heuristic. + ;; Get last prompt of the inferior process buffer (this + ;; intentionally avoids using `comint-last-prompt' because + ;; of incompatibilities with Emacs 24.x). (with-current-buffer (process-buffer process) - (buffer-substring-no-properties - (overlay-start comint-last-prompt-overlay) - (overlay-end comint-last-prompt-overlay)))) + (save-excursion + (buffer-substring-no-properties + (- (point) (length line)) + (progn + (re-search-backward "^") + (python-util-forward-comment) + (point)))))) (completion-context ;; Check whether a prompt matches a pdb string, an import ;; statement or just the standard prompt and use the @@ -2291,7 +2526,7 @@ to complete." :safe 'booleanp) (defcustom python-pdbtrack-stacktrace-info-regexp - "^> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()" + "> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()" "Regular Expression matching stacktrace information. Used to extract the current line and module being inspected." :type 'string @@ -2310,7 +2545,9 @@ Never set this variable directly, use "Set the buffer for FILE-NAME as the tracked buffer. Internally it uses the `python-pdbtrack-tracked-buffer' variable. Returns the tracked buffer." - (let ((file-buffer (get-file-buffer file-name))) + (let ((file-buffer (get-file-buffer + (concat (file-remote-p default-directory) + file-name)))) (if file-buffer (setq python-pdbtrack-tracked-buffer file-buffer) (setq file-buffer (find-file-noselect file-name)) @@ -2528,8 +2765,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (defun python-fill-string (&optional justify) "String fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." - (let* ((marker (point-marker)) - (str-start-pos + (let* ((str-start-pos (set-marker (make-marker) (or (python-syntax-context 'string) @@ -2595,7 +2831,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;; Again indent only if a newline is added. (indent-according-to-mode))))) t) -(defun python-fill-decorator (&optional justify) +(defun python-fill-decorator (&optional _justify) "Decorator fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." t) @@ -2644,8 +2880,8 @@ the if condition." (defvar python-skeleton-available '() "Internal list of available skeletons.") -(define-abbrev-table 'python-mode-abbrev-table () - "Abbrev table for Python mode." +(define-abbrev-table 'python-mode-skeleton-abbrev-table () + "Abbrev table for Python mode skeletons." :case-fixed t ;; Allow / inside abbrevs. :regexp "\\(?:^\\|[^/]\\)\\<\\([[:word:]/]+\\)\\W*" @@ -2658,13 +2894,13 @@ the if condition." (defmacro python-skeleton-define (name doc &rest skel) "Define a `python-mode' skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME and will -be added to `python-mode-abbrev-table'." +be added to `python-mode-skeleton-abbrev-table'." (declare (indent 2)) (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton-" name)))) `(progn - (define-abbrev python-mode-abbrev-table ,name "" ',function-name - :system t) + (define-abbrev python-mode-skeleton-abbrev-table + ,name "" ',function-name :system t) (setq python-skeleton-available (cons ',function-name python-skeleton-available)) (define-skeleton ,function-name @@ -2672,6 +2908,10 @@ be added to `python-mode-abbrev-table'." (format "Insert %s statement." name)) ,@skel)))) +(define-abbrev-table 'python-mode-abbrev-table () + "Abbrev table for Python mode." + :parents (list python-mode-skeleton-abbrev-table)) + (defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel) "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME." @@ -2753,8 +2993,7 @@ The skeleton will be bound to python-skeleton-NAME." (defun python-skeleton-add-menu-items () "Add menu items to Python->Skeletons menu." - (let ((skeletons (sort python-skeleton-available 'string<)) - (items)) + (let ((skeletons (sort python-skeleton-available 'string<))) (dolist (skeleton skeletons) (easy-menu-add-item nil '("Python" "Skeletons") @@ -2798,6 +3037,8 @@ The skeleton will be bound to python-skeleton-NAME." (when module-file (substring-no-properties module-file 1 -1)))))) +(defvar ffap-alist) + (eval-after-load "ffap" '(progn (push '(python-mode . python-ffap-module-path) ffap-alist) @@ -2840,7 +3081,7 @@ Runs COMMAND, a shell command, as if by `compile'. See (let ((process-environment (python-shell-calculate-process-environment)) (exec-path (python-shell-calculate-exec-path))) (compilation-start command nil - (lambda (mode-name) + (lambda (_modename) (format python-check-buffer-name command))))) @@ -2928,15 +3169,148 @@ Interactively, prompt for symbol." ;;; Imenu -(defun python-imenu-prev-index-position () - "Python mode's `imenu-prev-index-position-function'." - (let ((found)) - (while (and (setq found - (re-search-backward python-nav-beginning-of-defun-regexp nil t)) - (not (python-info-looking-at-beginning-of-defun)))) - (and found - (python-info-looking-at-beginning-of-defun) - (python-info-current-defun)))) +(defvar python-imenu-format-item-label-function + 'python-imenu-format-item-label + "Imenu function used to format an item label. +It must be a function with two arguments: TYPE and NAME.") + +(defvar python-imenu-format-parent-item-label-function + 'python-imenu-format-parent-item-label + "Imenu function used to format a parent item label. +It must be a function with two arguments: TYPE and NAME.") + +(defvar python-imenu-format-parent-item-jump-label-function + 'python-imenu-format-parent-item-jump-label + "Imenu function used to format a parent jump item label. +It must be a function with two arguments: TYPE and NAME.") + +(defun python-imenu-format-item-label (type name) + "Return imenu label for single node using TYPE and NAME." + (format "%s (%s)" name type)) + +(defun python-imenu-format-parent-item-label (type name) + "Return imenu label for parent node using TYPE and NAME." + (format "%s..." (python-imenu-format-item-label type name))) + +(defun python-imenu-format-parent-item-jump-label (type _name) + "Return imenu label for parent node jump using TYPE and NAME." + (if (string= type "class") + "*class definition*" + "*function definition*")) + +(defun python-imenu--put-parent (type name pos tree) + "Add the parent with TYPE, NAME and POS to TREE." + (let ((label + (funcall python-imenu-format-item-label-function type name)) + (jump-label + (funcall python-imenu-format-parent-item-jump-label-function type name))) + (if (not tree) + (cons label pos) + (cons label (cons (cons jump-label pos) tree))))) + +(defun python-imenu--build-tree (&optional min-indent prev-indent tree) + "Recursively build the tree of nested definitions of a node. +Arguments MIN-INDENT PREV-INDENT and TREE are internal and should +not be passed explicitly unless you know what you are doing." + (setq min-indent (or min-indent 0) + prev-indent (or prev-indent python-indent-offset)) + (let* ((pos (python-nav-backward-defun)) + (type) + (name (when (and pos (looking-at python-nav-beginning-of-defun-regexp)) + (let ((split (split-string (match-string-no-properties 0)))) + (setq type (car split)) + (cadr split)))) + (label (when name + (funcall python-imenu-format-item-label-function type name))) + (indent (current-indentation)) + (children-indent-limit (+ python-indent-offset min-indent))) + (cond ((not pos) + ;; Nothing found, probably near to bobp. + nil) + ((<= indent min-indent) + ;; The current indentation points that this is a parent + ;; node, add it to the tree and stop recursing. + (python-imenu--put-parent type name pos tree)) + (t + (python-imenu--build-tree + min-indent + indent + (if (<= indent children-indent-limit) + ;; This lies within the children indent offset range, + ;; so it's a normal child of its parent (i.e., not + ;; a child of a child). + (cons (cons label pos) tree) + ;; Oh no, a child of a child?! Fear not, we + ;; know how to roll. We recursively parse these by + ;; swapping prev-indent and min-indent plus adding this + ;; newly found item to a fresh subtree. This works, I + ;; promise. + (cons + (python-imenu--build-tree + prev-indent indent (list (cons label pos))) + tree))))))) + +(defun python-imenu-create-index () + "Return tree Imenu alist for the current python buffer. +Change `python-imenu-format-item-label-function', +`python-imenu-format-parent-item-label-function', +`python-imenu-format-parent-item-jump-label-function' to +customize how labels are formatted." + (goto-char (point-max)) + (let ((index) + (tree)) + (while (setq tree (python-imenu--build-tree)) + (setq index (cons tree index))) + index)) + +(defun python-imenu-create-flat-index (&optional alist prefix) + "Return flat outline of the current python buffer for Imenu. +Optional Argument ALIST is the tree to be flattened, when nil +`python-imenu-build-index' is used with +`python-imenu-format-parent-item-jump-label-function' +`python-imenu-format-parent-item-label-function' +`python-imenu-format-item-label-function' set to (lambda (type +name) name). Optional Argument PREFIX is used in recursive calls +and should not be passed explicitly. + +Converts this: + + \((\"Foo\" . 103) + (\"Bar\" . 138) + (\"decorator\" + (\"decorator\" . 173) + (\"wrap\" + (\"wrap\" . 353) + (\"wrapped_f\" . 393)))) + +To this: + + \((\"Foo\" . 103) + (\"Bar\" . 138) + (\"decorator\" . 173) + (\"decorator.wrap\" . 353) + (\"decorator.wrapped_f\" . 393))" + ;; Inspired by imenu--flatten-index-alist removed in revno 21853. + (apply + 'nconc + (mapcar + (lambda (item) + (let ((name (if prefix + (concat prefix "." (car item)) + (car item))) + (pos (cdr item))) + (cond ((or (numberp pos) (markerp pos)) + (list (cons name pos))) + ((listp pos) + (cons + (cons name (cdar pos)) + (python-imenu-create-flat-index (cddr item) name)))))) + (or alist + (let* ((fn (lambda (_type name) name)) + (python-imenu-format-item-label-function fn) + (python-imenu-format-parent-item-label-function fn) + (python-imenu-format-parent-item-jump-label-function fn)) + (python-imenu-create-index)))))) ;;; Misc helpers @@ -3257,14 +3631,39 @@ Optional argument DIRECTION defines the direction to move to." (goto-char comment-start)) (forward-comment factor))) +(defun python-util-popn (lst n) + "Return LST first N elements. +N should be an integer, when it's a natural negative number its +opposite is used. When N is bigger than the length of LST, the +list is returned as is." + (let* ((n (min (abs n))) + (len (length lst)) + (acc)) + (if (> n len) + lst + (while (< 0 n) + (setq acc (cons (car lst) acc) + lst (cdr lst) + n (1- n))) + (reverse acc)))) + +(defun python-electric-pair-string-delimiter () + (when (and electric-pair-mode + (memq last-command-event '(?\" ?\')) + (let ((count 0)) + (while (eq (char-before (- (point) count)) last-command-event) + (cl-incf count)) + (= count 3))) + (save-excursion (insert (make-string 3 last-command-event))))) + +(defvar electric-indent-inhibit) + ;;;###autoload (define-derived-mode python-mode prog-mode "Python" "Major mode for editing Python files. -\\{python-mode-map} -Entry to this mode calls the value of `python-mode-hook' -if that value is non-nil." +\\{python-mode-map}" (set (make-local-variable 'tab-width) 8) (set (make-local-variable 'indent-tabs-mode) nil) @@ -3286,10 +3685,17 @@ if that value is non-nil." (set (make-local-variable 'indent-line-function) #'python-indent-line-function) (set (make-local-variable 'indent-region-function) #'python-indent-region) + ;; Because indentation is not redundant, we cannot safely reindent code. + (setq-local electric-indent-inhibit t) + (setq-local electric-indent-chars (cons ?: electric-indent-chars)) + + ;; Add """ ... """ pairing to electric-pair-mode. + (add-hook 'post-self-insert-hook + #'python-electric-pair-string-delimiter 'append t) (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) - 'python-fill-paragraph) + #'python-fill-paragraph) (set (make-local-variable 'beginning-of-defun-function) #'python-nav-beginning-of-defun) @@ -3297,16 +3703,13 @@ if that value is non-nil." #'python-nav-end-of-defun) (add-hook 'completion-at-point-functions - 'python-completion-complete-at-point nil 'local) + #'python-completion-complete-at-point nil 'local) (add-hook 'post-self-insert-hook - 'python-indent-post-self-insert-function nil 'local) + #'python-indent-post-self-insert-function 'append 'local) - (set (make-local-variable 'imenu-extract-index-name-function) - #'python-info-current-defun) - - (set (make-local-variable 'imenu-prev-index-position-function) - #'python-imenu-prev-index-position) + (set (make-local-variable 'imenu-create-index-function) + #'python-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) #'python-info-current-defun) @@ -3324,7 +3727,7 @@ if that value is non-nil." (add-to-list 'hs-special-modes-alist `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" - ,(lambda (arg) + ,(lambda (_arg) (python-nav-end-of-defun)) nil)) (set (make-local-variable 'mode-require-final-newline) t) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 9b007c0063a..5cd054a22a8 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1,6 +1,6 @@ ;;; ruby-mode.el --- Major mode for editing Ruby files -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Authors: Yukihiro Matsumoto ;; Nobuyoshi Nakada @@ -39,18 +39,11 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup ruby nil "Major mode for editing Ruby code." :prefix "ruby-" :group 'languages) -(defconst ruby-keyword-end-re - (if (string-match "\\_>" "ruby") - "\\_>" - "\\>")) - (defconst ruby-block-beg-keywords '("class" "module" "def" "if" "unless" "case" "while" "until" "for" "begin" "do") "Keywords at the beginning of blocks.") @@ -60,7 +53,7 @@ "Regexp to match the beginning of blocks.") (defconst ruby-non-block-do-re - (concat (regexp-opt '("while" "until" "for" "rescue") t) ruby-keyword-end-re) + (regexp-opt '("while" "until" "for" "rescue") 'symbols) "Regexp to match keywords that nest without blocks.") (defconst ruby-indent-beg-re @@ -113,7 +106,7 @@ "Regexp to match the beginning of a heredoc.") (defconst ruby-expression-expansion-re - "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) + "\\(?:[^\\]\\|\\=\\)\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -137,28 +130,53 @@ This should only be called after matching against `ruby-here-doc-beg-re'." ruby-block-end-re "\\|}\\|\\]\\)") "Regexp to match where the indentation gets shallower.") -(defconst ruby-operator-re "[-,.+*/%&|^~=<>:]" +(defconst ruby-operator-re "[-,.+*/%&|^~=<>:]\\|\\\\$" "Regexp to match operators.") (defconst ruby-symbol-chars "a-zA-Z0-9_" "List of characters that symbol names may contain.") + (defconst ruby-symbol-re (concat "[" ruby-symbol-chars "]") "Regexp to match symbols.") -(define-abbrev-table 'ruby-mode-abbrev-table () - "Abbrev table in use in Ruby mode buffers.") +(defvar ruby-use-smie t) (defvar ruby-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-C-b") 'ruby-backward-sexp) - (define-key map (kbd "M-C-f") 'ruby-forward-sexp) + (unless ruby-use-smie + (define-key map (kbd "M-C-b") 'ruby-backward-sexp) + (define-key map (kbd "M-C-f") 'ruby-forward-sexp) + (define-key map (kbd "M-C-q") 'ruby-indent-exp)) + (when ruby-use-smie + (define-key map (kbd "M-C-d") 'smie-down-list)) (define-key map (kbd "M-C-p") 'ruby-beginning-of-block) (define-key map (kbd "M-C-n") 'ruby-end-of-block) - (define-key map (kbd "M-C-q") 'ruby-indent-exp) (define-key map (kbd "C-c {") 'ruby-toggle-block) map) "Keymap used in Ruby mode.") +(easy-menu-define + ruby-mode-menu + ruby-mode-map + "Ruby Mode Menu" + '("Ruby" + ["Beginning of Block" ruby-beginning-of-block t] + ["End of Block" ruby-end-of-block t] + ["Toggle Block" ruby-toggle-block t] + "--" + ["Backward Sexp" ruby-backward-sexp + :visible (not ruby-use-smie)] + ["Backward Sexp" backward-sexp + :visible ruby-use-smie] + ["Forward Sexp" ruby-forward-sexp + :visible (not ruby-use-smie)] + ["Forward Sexp" forward-sexp + :visible ruby-use-smie] + ["Indent Sexp" ruby-indent-exp + :visible (not ruby-use-smie)] + ["Indent Sexp" prog-indent-sexp + :visible ruby-use-smie])) + (defvar ruby-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\' "\"" table) @@ -168,7 +186,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?$ "." table) - (modify-syntax-entry ?? "_" table) (modify-syntax-entry ?_ "_" table) (modify-syntax-entry ?: "_" table) (modify-syntax-entry ?< "." table) @@ -193,48 +210,478 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (defcustom ruby-indent-tabs-mode nil "Indentation can insert tabs in Ruby mode if this is non-nil." - :type 'boolean :group 'ruby) + :type 'boolean + :group 'ruby + :safe 'booleanp) (defcustom ruby-indent-level 2 "Indentation of Ruby statements." - :type 'integer :group 'ruby) + :type 'integer + :group 'ruby + :safe 'integerp) -(defcustom ruby-comment-column 32 +(defcustom ruby-comment-column (default-value 'comment-column) "Indentation column of comments." - :type 'integer :group 'ruby) + :type 'integer + :group 'ruby + :safe 'integerp) + +(defconst ruby-alignable-keywords '(if while unless until begin case for def) + "Keywords that can be used in `ruby-align-to-stmt-keywords'.") + +(defcustom ruby-align-to-stmt-keywords '(def) + "Keywords after which we align the expression body to statement. + +When nil, an expression that begins with one these keywords is +indented to the column of the keyword. Example: + + tee = if foo + bar + else + qux + end + +If this value is t or contains a symbol with the name of given +keyword, the expression is indented to align to the beginning of +the statement: + + tee = if foo + bar + else + qux + end + +Only has effect when `ruby-use-smie' is t. +" + :type `(choice + (const :tag "None" nil) + (const :tag "All" t) + (repeat :tag "User defined" + (choice ,@(mapcar + (lambda (kw) (list 'const kw)) + ruby-alignable-keywords)))) + :group 'ruby + :safe 'listp + :version "24.4") + +(defcustom ruby-align-chained-calls nil + "If non-nil, align chained method calls. + +Each method call on a separate line will be aligned to the column +of its parent. + +Only has effect when `ruby-use-smie' is t." + :type 'boolean + :group 'ruby + :safe 'booleanp + :version "24.4") (defcustom ruby-deep-arglist t "Deep indent lists in parenthesis when non-nil. -Also ignores spaces after parenthesis when 'space." - :group 'ruby) +Also ignores spaces after parenthesis when `space'. +Only has effect when `ruby-use-smie' is nil." + :type 'boolean + :group 'ruby + :safe 'booleanp) +;; FIXME Woefully under documented. What is the point of the last `t'?. (defcustom ruby-deep-indent-paren '(?\( ?\[ ?\] t) "Deep indent lists in parenthesis when non-nil. The value t means continuous line. -Also ignores spaces after parenthesis when 'space." +Also ignores spaces after parenthesis when `space'. +Only has effect when `ruby-use-smie' is nil." + :type '(choice (const nil) + character + (repeat (choice character + (cons character (choice (const nil) + (const t))) + (const t) ; why? + ))) :group 'ruby) (defcustom ruby-deep-indent-paren-style 'space - "Default deep indent style." - :options '(t nil space) :group 'ruby) + "Default deep indent style. +Only has effect when `ruby-use-smie' is nil." + :type '(choice (const t) (const nil) (const space)) + :group 'ruby) -(defcustom ruby-encoding-map '((shift_jis . cp932) (shift-jis . cp932)) - "Alist to map encoding name from Emacs to Ruby." +(defcustom ruby-encoding-map + '((us-ascii . nil) ;; Do not put coding: us-ascii + (shift-jis . cp932) ;; Emacs charset name of Shift_JIS + (shift_jis . cp932) ;; MIME charset name of Shift_JIS + (japanese-cp932 . cp932)) ;; Emacs charset name of CP932 + "Alist to map encoding name from Emacs to Ruby. +Associating an encoding name with nil means it needs not be +explicitly declared in magic comment." + :type '(repeat (cons (symbol :tag "From") (symbol :tag "To"))) :group 'ruby) (defcustom ruby-insert-encoding-magic-comment t - "Insert a magic Emacs 'coding' comment upon save if this is non-nil." + "Insert a magic Ruby encoding comment upon save if this is non-nil. +The encoding will be auto-detected. The format of the encoding comment +is customizable via `ruby-encoding-magic-comment-style'. + +When set to `always-utf8' an utf-8 comment will always be added, +even if it's not required." :type 'boolean :group 'ruby) +(defcustom ruby-encoding-magic-comment-style 'ruby + "The style of the magic encoding comment to use." + :type '(choice + (const :tag "Emacs Style" emacs) + (const :tag "Ruby Style" ruby) + (const :tag "Custom Style" custom)) + :group 'ruby + :version "24.4") + +(defcustom ruby-custom-encoding-magic-comment-template "# encoding: %s" + "A custom encoding comment template. +It is used when `ruby-encoding-magic-comment-style' is set to `custom'." + :type 'string + :group 'ruby + :version "24.4") + (defcustom ruby-use-encoding-map t "Use `ruby-encoding-map' to set encoding magic comment if this is non-nil." :type 'boolean :group 'ruby) -;; Safe file variables -(put 'ruby-indent-tabs-mode 'safe-local-variable 'booleanp) -(put 'ruby-indent-level 'safe-local-variable 'integerp) -(put 'ruby-comment-column 'safe-local-variable 'integerp) -(put 'ruby-deep-arglist 'safe-local-variable 'booleanp) +;;; SMIE support + +(require 'smie) + +;; Here's a simplified BNF grammar, for reference: +;; http://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf +(defconst ruby-smie-grammar + (smie-prec2->grammar + (smie-merge-prec2s + (smie-bnf->prec2 + '((id) + (insts (inst) (insts ";" insts)) + (inst (exp) (inst "iuwu-mod" exp) + ;; Somewhat incorrect (both can be used multiple times), + ;; but avoids lots of conflicts: + (exp "and" exp) (exp "or" exp)) + (exp (exp1) (exp "," exp) (exp "=" exp) + (id " @ " exp)) + (exp1 (exp2) (exp2 "?" exp1 ":" exp1)) + (exp2 (exp3) (exp3 "." exp2)) + (exp3 ("def" insts "end") + ("begin" insts-rescue-insts "end") + ("do" insts "end") + ("class" insts "end") ("module" insts "end") + ("for" for-body "end") + ("[" expseq "]") + ("{" hashvals "}") + ("{" insts "}") + ("while" insts "end") + ("until" insts "end") + ("unless" insts "end") + ("if" if-body "end") + ("case" cases "end")) + (formal-params ("opening-|" exp "closing-|")) + (for-body (for-head ";" insts)) + (for-head (id "in" exp)) + (cases (exp "then" insts) + (cases "when" cases) (insts "else" insts)) + (expseq (exp) );;(expseq "," expseq) + (hashvals (id "=>" exp1) (hashvals "," hashvals)) + (insts-rescue-insts (insts) + (insts-rescue-insts "rescue" insts-rescue-insts) + (insts-rescue-insts "ensure" insts-rescue-insts)) + (itheni (insts) (exp "then" insts)) + (ielsei (itheni) (itheni "else" insts)) + (if-body (ielsei) (if-body "elsif" if-body))) + '((nonassoc "in") (assoc ";") (right " @ ") + (assoc ",") (right "=")) + '((assoc "when")) + '((assoc "elsif")) + '((assoc "rescue" "ensure")) + '((assoc ","))) + + (smie-precs->prec2 + '((right "=") + (right "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" + "<<=" ">>=" "&&=" "||=") + (left ".." "...") + (left "+" "-") + (left "*" "/" "%" "**") + (left "&&" "||") + (left "^" "&" "|") + (nonassoc "<=>") + (nonassoc ">" ">=" "<" "<=") + (nonassoc "==" "===" "!=") + (nonassoc "=~" "!~") + (left "<<" ">>") + (right ".")))))) + +(defun ruby-smie--bosp () + (save-excursion (skip-chars-backward " \t") + (or (bolp) (memq (char-before) '(?\; ?=))))) + +(defun ruby-smie--implicit-semi-p () + (save-excursion + (skip-chars-backward " \t") + (not (or (bolp) + (memq (char-before) '(?\[ ?\()) + (and (memq (char-before) + '(?\; ?- ?+ ?* ?/ ?: ?. ?, ?\\ ?& ?> ?< ?% ?~ ?^)) + ;; Not a binary operator symbol. + (not (eq (char-before (1- (point))) ?:)) + ;; Not the end of a regexp or a percent literal. + (not (memq (car (syntax-after (1- (point)))) '(7 15)))) + (and (eq (char-before) ?\?) + (equal (save-excursion (ruby-smie--backward-token)) "?")) + (and (eq (char-before) ?=) + ;; Not a symbol :==, :!=, or a foo= method. + (string-match "\\`\\s." (save-excursion + (ruby-smie--backward-token)))) + (and (eq (char-before) ?|) + (member (save-excursion (ruby-smie--backward-token)) + '("|" "||"))) + (and (eq (car (syntax-after (1- (point)))) 2) + (member (save-excursion (ruby-smie--backward-token)) + '("iuwu-mod" "and" "or"))) + (save-excursion + (forward-comment 1) + (eq (char-after) ?.)))))) + +(defun ruby-smie--redundant-do-p (&optional skip) + (save-excursion + (if skip (backward-word 1)) + (member (nth 2 (smie-backward-sexp ";")) '("while" "until" "for")))) + +(defun ruby-smie--opening-pipe-p () + (save-excursion + (if (eq ?| (char-before)) (forward-char -1)) + (skip-chars-backward " \t\n") + (or (eq ?\{ (char-before)) + (looking-back "\\_ (save-excursion (forward-comment (point-max)) (point)) + (line-end-position)) + (ruby-smie--forward-token)) ;Fully redundant. + (t ";"))) + (t tok))))))))) + +(defun ruby-smie--backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ((and (> pos (line-end-position)) (ruby-smie--implicit-semi-p)) + (skip-chars-forward " \t") ";") + ((and (bolp) (not (bobp))) ;Presumably a heredoc. + ;; Tokenize the whole heredoc as semicolon. + (goto-char (scan-sexps (point) -1)) + ";") + ((and (> pos (point)) (not (bolp)) + (ruby-smie--args-separator-p pos)) + ;; We have "ID SPC ID", which is a method call, but it binds less tightly + ;; than commas, since a method call can also be "ID ARG1, ARG2, ARG3". + ;; In some textbooks, "e1 @ e2" is used to mean "call e1 with arg e2". + " @ ") + (t + (let ((tok (smie-default-backward-token)) + (dot (ruby-smie--at-dot-call))) + (when dot + (setq tok (concat "." tok))) + (when (and (eq ?: (char-before)) (string-match "\\`\\s." tok)) + (forward-char -1) (setq tok (concat ":" tok))) ;; bug#15208. + (cond + ((member tok '("unless" "if" "while" "until")) + (if (ruby-smie--bosp) + tok "iuwu-mod")) + ((equal tok "|") + (cond + ((ruby-smie--opening-pipe-p) "opening-|") + ((ruby-smie--closing-pipe-p) "closing-|") + (t tok))) + ((string-match-p "\\`|[*&]\\'" tok) + (forward-char 1) + (substring tok 1)) + ((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n")) + (forward-char -1) (ruby-smie--backward-token)) + ((equal tok "do") + (cond + ((not (ruby-smie--redundant-do-p)) tok) + ((> (save-excursion (forward-word 1) + (forward-comment (point-max)) (point)) + (line-end-position)) + (ruby-smie--backward-token)) ;Fully redundant. + (t ";"))) + (t tok))))))) + +(defun ruby-smie--indent-to-stmt () + (save-excursion + (smie-backward-sexp ";") + (cons 'column (smie-indent-virtual)))) + +(defun ruby-smie--indent-to-stmt-p (keyword) + (or (eq t ruby-align-to-stmt-keywords) + (memq (intern keyword) ruby-align-to-stmt-keywords))) + +(defun ruby-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) ruby-indent-level) + ;; "foo" "bar" is the concatenation of the two strings, so the second + ;; should be aligned with the first. + (`(:elem . args) (if (looking-at "\\s\"") 0)) + ;; (`(:after . ",") (smie-rule-separator kind)) + (`(:before . ";") + (cond + ((smie-rule-parent-p "def" "begin" "do" "class" "module" "for" + "while" "until" "unless" + "if" "then" "elsif" "else" "when" + "rescue" "ensure" "{") + (smie-rule-parent ruby-indent-level)) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + )) + (`(:before . ,(or `"(" `"[" `"{")) + (cond + ((and (equal token "{") + (not (smie-rule-prev-p "(" "{" "[" "," "=>" "=" "return" ";")) + (save-excursion + (forward-comment -1) + (not (eq (preceding-char) ?:)))) + ;; Curly block opener. + (ruby-smie--indent-to-stmt)) + ((smie-rule-hanging-p) + ;; Treat purely syntactic block-constructs as being part of their parent, + ;; when the opening token is hanging and the parent is not an + ;; open-paren. + (cond + ((eq (car (smie-indent--parent)) t) nil) + ;; When after `.', let's always de-indent, + ;; because when `.' is inside the line, the + ;; additional indentation from it looks out of place. + ((smie-rule-parent-p ".") + (let (smie--parent) + (save-excursion + ;; Traverse up the parents until the parent is "." at + ;; indentation, or any other token. + (while (and (let ((parent (smie-indent--parent))) + (goto-char (cadr parent)) + (save-excursion + (unless (integerp (car parent)) (forward-char -1)) + (not (ruby-smie--bosp)))) + (progn + (setq smie--parent nil) + (smie-rule-parent-p ".")))) + (smie-rule-parent)))) + (t (smie-rule-parent)))))) + (`(:after . ,(or `"(" "[" "{")) + ;; FIXME: Shouldn't this be the default behavior of + ;; `smie-indent-after-keyword'? + (save-excursion + (forward-char 1) + (skip-chars-forward " \t") + ;; `smie-rule-hanging-p' is not good enough here, + ;; because we want to reject hanging tokens at bol, too. + (unless (or (eolp) (forward-comment 1)) + (cons 'column (current-column))))) + (`(:before . "do") (ruby-smie--indent-to-stmt)) + (`(:before . ".") + (if (smie-rule-sibling-p) + (and ruby-align-chained-calls 0) + ruby-indent-level)) + (`(:before . ,(or `"else" `"then" `"elsif" `"rescue" `"ensure")) + (smie-rule-parent)) + (`(:before . "when") + ;; Align to the previous `when', but look up the virtual + ;; indentation of `case'. + (if (smie-rule-sibling-p) 0 (smie-rule-parent))) + (`(:after . ,(or "=" "iuwu-mod" "+" "-" "*" "/" "&&" "||" "%" "**" "^" "&" + "<=>" ">" "<" ">=" "<=" "==" "===" "!=" "<<" ">>" + "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" "|" + "<<=" ">>=" "&&=" "||=" "and" "or")) + (and (smie-rule-parent-p ";" nil) + (smie-indent--hanging-p) + ruby-indent-level)) + (`(:after . ,(or "?" ":")) ruby-indent-level) + (`(:before . ,(guard (memq (intern-soft token) ruby-alignable-keywords))) + (when (not (ruby--at-indentation-p)) + (if (ruby-smie--indent-to-stmt-p token) + (ruby-smie--indent-to-stmt) + (cons 'column (current-column))))) + )) + +(defun ruby--at-indentation-p (&optional point) + (save-excursion + (unless point (setq point (point))) + (forward-line 0) + (skip-chars-forward " \t") + (eq (point) point))) (defun ruby-imenu-create-index-in-block (prefix beg end) "Create an imenu index of methods inside a block." @@ -279,65 +726,116 @@ Also ignores spaces after parenthesis when 'space." (nreverse (ruby-imenu-create-index-in-block nil (point-min) nil))) (defun ruby-accurate-end-of-block (&optional end) - "TODO: document." + "Jump to the end of the current block or END, whichever is closer." (let (state (end (or end (point-max)))) - (while (and (setq state (apply 'ruby-parse-partial end state)) - (>= (nth 2 state) 0) (< (point) end))))) + (if ruby-use-smie + (save-restriction + (back-to-indentation) + (narrow-to-region (point) end) + (smie-forward-sexp)) + (while (and (setq state (apply 'ruby-parse-partial end state)) + (>= (nth 2 state) 0) (< (point) end)))))) (defun ruby-mode-variables () "Set up initial buffer-local variables for Ruby mode." - (set-syntax-table ruby-mode-syntax-table) - (setq local-abbrev-table ruby-mode-abbrev-table) (setq indent-tabs-mode ruby-indent-tabs-mode) - (set (make-local-variable 'indent-line-function) 'ruby-indent-line) - (set (make-local-variable 'require-final-newline) t) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-column) ruby-comment-column) - (set (make-local-variable 'comment-start-skip) "#+ *") - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t)) + (if ruby-use-smie + (smie-setup ruby-smie-grammar #'ruby-smie-rules + :forward-token #'ruby-smie--forward-token + :backward-token #'ruby-smie--backward-token) + (setq-local indent-line-function 'ruby-indent-line)) + (setq-local require-final-newline t) + (setq-local comment-start "# ") + (setq-local comment-end "") + (setq-local comment-column ruby-comment-column) + (setq-local comment-start-skip "#+ *") + (setq-local parse-sexp-ignore-comments t) + (setq-local parse-sexp-lookup-properties t) + (setq-local paragraph-start (concat "$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t)) + +(defun ruby--insert-coding-comment (encoding) + "Insert a magic coding comment for ENCODING. +The style of the comment is controlled by `ruby-encoding-magic-comment-style'." + (let ((encoding-magic-comment-template + (pcase ruby-encoding-magic-comment-style + (`ruby "# coding: %s") + (`emacs "# -*- coding: %s -*-") + (`custom + ruby-custom-encoding-magic-comment-template)))) + (insert + (format encoding-magic-comment-template encoding) + "\n"))) + +(defun ruby--detect-encoding () + (if (eq ruby-insert-encoding-magic-comment 'always-utf8) + "utf-8" + (let ((coding-system + (or save-buffer-coding-system + buffer-file-coding-system))) + (if coding-system + (setq coding-system + (or (coding-system-get coding-system 'mime-charset) + (coding-system-change-eol-conversion coding-system nil)))) + (if coding-system + (symbol-name + (if ruby-use-encoding-map + (let ((elt (assq coding-system ruby-encoding-map))) + (if elt (cdr elt) coding-system)) + coding-system)) + "ascii-8bit")))) + +(defun ruby--encoding-comment-required-p () + (or (eq ruby-insert-encoding-magic-comment 'always-utf8) + (re-search-forward "[^\0-\177]" nil t))) (defun ruby-mode-set-encoding () "Insert a magic comment header with the proper encoding if necessary." (save-excursion (widen) (goto-char (point-min)) - (when (re-search-forward "[^\0-\177]" nil t) + (when (ruby--encoding-comment-required-p) (goto-char (point-min)) - (let ((coding-system - (or coding-system-for-write - buffer-file-coding-system))) - (if coding-system - (setq coding-system - (or (coding-system-get coding-system 'mime-charset) - (coding-system-change-eol-conversion coding-system nil)))) - (setq coding-system - (if coding-system - (symbol-name - (or (and ruby-use-encoding-map - (cdr (assq coding-system ruby-encoding-map))) - coding-system)) - "ascii-8bit")) - (if (looking-at "^#!") (beginning-of-line 2)) - (cond ((looking-at "\\s *#.*-\*-\\s *\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)\\s *\\(;\\|-\*-\\)") - (unless (string= (match-string 2) coding-system) - (goto-char (match-beginning 2)) - (delete-region (point) (match-end 2)) - (and (looking-at "-\*-") - (let ((n (skip-chars-backward " "))) - (cond ((= n 0) (insert " ") (backward-char)) - ((= n -1) (insert " ")) - ((forward-char))))) - (insert coding-system))) - ((looking-at "\\s *#.*coding\\s *[:=]")) - (t (when ruby-insert-encoding-magic-comment - (insert "# -*- coding: " coding-system " -*-\n")))))))) + (let ((coding-system (ruby--detect-encoding))) + (when coding-system + (if (looking-at "^#!") (beginning-of-line 2)) + (cond ((looking-at "\\s *#\\s *.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") + ;; update existing encoding comment if necessary + (unless (string= (match-string 2) coding-system) + (goto-char (match-beginning 2)) + (delete-region (point) (match-end 2)) + (insert coding-system))) + ((looking-at "\\s *#.*coding\\s *[:=]")) + (t (when ruby-insert-encoding-magic-comment + (ruby--insert-coding-comment coding-system)))) + (when (buffer-modified-p) + (basic-save-buffer-1))))))) +(defvar ruby--electric-indent-chars '(?. ?\) ?} ?\])) + +(defun ruby--electric-indent-p (char) + (cond + ((memq char ruby--electric-indent-chars) + ;; Reindent after typing a char affecting indentation. + (ruby--at-indentation-p (1- (point)))) + ((memq (char-after) ruby--electric-indent-chars) + ;; Reindent after inserting something in front of the above. + (ruby--at-indentation-p (1- (point)))) + ((or (and (>= char ?a) (<= char ?z)) (memq char '(?_ ?? ?! ?:))) + (let ((pt (point))) + (save-excursion + (skip-chars-backward "[:alpha:]:_?!") + (and (ruby--at-indentation-p) + (looking-at (regexp-opt (cons "end" ruby-block-mid-keywords))) + ;; Outdent after typing a keyword. + (or (eq (match-end 0) pt) + ;; Reindent if it wasn't a keyword after all. + (eq (match-end 0) (1- pt))))))))) + +;; FIXME: Remove this? It's unused here, but some redefinitions of +;; `ruby-calculate-indent' in user init files still call it. (defun ruby-current-indentation () "Return the indentation level of current line." (save-excursion @@ -354,7 +852,7 @@ Also ignores spaces after parenthesis when 'space." "Indent the current line to COLUMN." (when column (let (shift top beg) - (and (< column 0) (error "invalid nest")) + (and (< column 0) (error "Invalid nesting")) (setq shift (current-column)) (beginning-of-line) (setq beg (point)) @@ -424,7 +922,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." ruby-block-mid-keywords) 'words)) (goto-char (match-end 0)) - (not (looking-at "\\s_\\|!"))) + (not (looking-at "\\s_"))) ((eq option 'expr-qstr) (looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]")) ((eq option 'expr-re) @@ -432,11 +930,28 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (t nil))))))))) (defun ruby-forward-string (term &optional end no-error expand) - "TODO: document." + "Move forward across one balanced pair of string delimiters. +Skips escaped delimiters. If EXPAND is non-nil, also ignores +delimiters in interpolated strings. + +TERM should be a string containing either a single, self-matching +delimiter (e.g. \"/\"), or a pair of matching delimiters with the +close delimiter first (e.g. \"][\"). + +When non-nil, search is bounded by position END. + +Throws an error if a balanced match is not found, unless NO-ERROR +is non-nil, in which case nil will be returned. + +This command assumes the character after point is an opening +delimiter." (let ((n 1) (c (string-to-char term)) - (re (if expand - (concat "[^\\]\\(\\\\\\\\\\)*\\([" term "]\\|\\(#{\\)\\)") - (concat "[^\\]\\(\\\\\\\\\\)*[" term "]")))) + (re (concat "[^\\]\\(\\\\\\\\\\)*\\(" + (if (string= term "^") ;[^] is not a valid regexp + "\\^" + (concat "[" term "]")) + (when expand "\\|\\(#{\\)") + "\\)"))) (while (and (re-search-forward re end no-error) (if (match-beginning 3) (ruby-forward-string "}{" end no-error nil) @@ -445,7 +960,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (forward-char -1)) (cond ((zerop n)) (no-error nil) - ((error "unterminated string"))))) + ((error "Unterminated string"))))) (defun ruby-deep-indent-paren-p (c) "TODO: document." @@ -471,7 +986,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." ((looking-at "[\"`]") ;skip string (cond ((and (not (eobp)) - (ruby-forward-string (buffer-substring (point) (1+ (point))) end t t)) + (ruby-forward-string (buffer-substring (point) (1+ (point))) + end t t)) nil) (t (setq in-string (point)) @@ -584,7 +1100,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." ((looking-at (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>")) (and (save-match-data - (or (not (looking-at (concat "do" ruby-keyword-end-re))) + (or (not (looking-at "do\\_>")) (save-excursion (back-to-indentation) (not (looking-at ruby-non-block-do-re))))) @@ -656,7 +1172,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (setq in-string (match-end 0)) (goto-char ruby-indent-point))) (t - (error (format "bad string %s" + (error (format "Bad string %s" (buffer-substring (point) pnt) )))))) (list in-string nest depth pcol)) @@ -731,7 +1247,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (setq indent (current-column))))) ((and (nth 2 state) (> (nth 2 state) 0)) ; in nest (if (null (cdr (nth 1 state))) - (error "invalid nest")) + (error "Invalid nesting")) (goto-char (cdr (nth 1 state))) (forward-word -1) ; skip back a keyword (setq begin (point)) @@ -778,7 +1294,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (while (and (re-search-forward "#" pos t) (setq end (1- (point))) (or (ruby-special-char-p end) - (and (setq state (ruby-parse-region parse-start end)) + (and (setq state (ruby-parse-region + parse-start end)) (nth 0 state)))) (setq end nil)) (goto-char (or end pos)) @@ -789,13 +1306,18 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (and (or (and (looking-at ruby-symbol-re) (skip-chars-backward ruby-symbol-chars) - (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>")) + (looking-at (concat "\\<\\(" ruby-block-hanging-re + "\\)\\>")) (not (eq (point) (nth 3 state))) (save-excursion (goto-char (match-end 0)) (not (looking-at "[a-z_]")))) (and (looking-at ruby-operator-re) (not (ruby-special-char-p)) + (save-excursion + (forward-char -1) + (or (not (looking-at ruby-operator-re)) + (not (eq (char-before) ?:)))) ;; Operator at the end of line. (let ((c (char-after (point)))) (and @@ -829,7 +1351,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (cond ((and (null op-end) - (not (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>"))) + (not (looking-at (concat "\\<\\(" ruby-block-hanging-re + "\\)\\>"))) (eq (ruby-deep-indent-paren-p t) 'space) (not (bobp))) (widen) @@ -847,22 +1370,24 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." indent)))) (defun ruby-beginning-of-defun (&optional arg) - "Move backward to the beginning of the current top-level defun. + "Move backward to the beginning of the current defun. With ARG, move backward multiple defuns. Negative ARG means move forward." (interactive "p") - (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>") - nil t (or arg 1)) - (beginning-of-line))) + (let (case-fold-search) + (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>") + nil t (or arg 1)) + (beginning-of-line)))) -(defun ruby-end-of-defun (&optional arg) - "Move forward to the end of the current top-level defun. -With ARG, move forward multiple defuns. Negative ARG means -move backward." +(defun ruby-end-of-defun () + "Move point to the end of the current defun. +The defun begins at or after the point. This function is called +by `end-of-defun'." (interactive "p") (ruby-forward-sexp) - (when (looking-back (concat "^\\s *" ruby-block-end-re)) - (forward-line 1))) + (let (case-fold-search) + (when (looking-back (concat "^\\s *" ruby-block-end-re)) + (forward-line 1)))) (defun ruby-beginning-of-indent () "Backtrack to a line which can be used as a reference for @@ -876,12 +1401,14 @@ calculating indentation on the lines after it." (defun ruby-move-to-block (n) "Move to the beginning (N < 0) or the end (N > 0) of the current block, a sibling block, or an outer block. Do that (abs N) times." + (back-to-indentation) (let ((signum (if (> n 0) 1 -1)) (backward (< n 0)) - (depth (or (nth 2 (ruby-parse-region (line-beginning-position) - (line-end-position))) - 0)) + (depth (or (nth 2 (ruby-parse-region (point) (line-end-position))) 0)) + case-fold-search down done) + (when (looking-at ruby-block-mid-re) + (setq depth (+ depth signum))) (when (< (* depth signum) 0) ;; Moving end -> end or beginning -> beginning. (setq depth 0)) @@ -918,22 +1445,16 @@ current block, a sibling block, or an outer block. Do that (abs N) times." (unless (car state) ; Line ends with unfinished string. (setq depth (+ (nth 2 state) depth)))) (cond - ;; Deeper indentation, we found a block. - ;; FIXME: We can't recognize empty blocks this way. + ;; Increased depth, we found a block. ((> (* signum depth) 0) (setq down t)) - ;; Block found, and same indentation as when started, stop. + ;; We're at the same depth as when we started, and we've + ;; encountered a block before. Stop. ((and down (zerop depth)) (setq done t)) - ;; Shallower indentation, means outer block, can stop now. + ;; Lower depth, means outer block, can stop now. ((< (* signum depth) 0) - (setq done t))))) - (if done - (save-excursion - (back-to-indentation) - ;; Not really at the first or last line of the block, move on. - (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) - (setq done nil)))))) + (setq done t))))))) (back-to-indentation))) (defun ruby-beginning-of-block (&optional arg) @@ -953,8 +1474,10 @@ With ARG, move out of multiple blocks." With ARG, do it many times. Negative ARG means move backward." ;; TODO: Document body (interactive "p") - (if (and (numberp arg) (< arg 0)) - (ruby-backward-sexp (- arg)) + (cond + (ruby-use-smie (forward-sexp arg)) + ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg))) + (t (let ((i (or arg 1))) (condition-case nil (while (> i 0) @@ -966,7 +1489,8 @@ With ARG, do it many times. Negative ARG means move backward." (skip-chars-forward ",.:;|&^~=!?\\+\\-\\*") (looking-at "\\s(")) (goto-char (scan-sexps (point) 1))) - ((and (looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>")) + ((and (looking-at (concat "\\<\\(" ruby-block-beg-re + "\\)\\>")) (not (eq (char-before (point)) ?.)) (not (eq (char-before (point)) ?:))) (ruby-end-of-block) @@ -983,21 +1507,24 @@ With ARG, do it many times. Negative ARG means move backward." (progn (setq expr (or expr (ruby-expr-beg) (looking-at "%\\sw?\\Sw\\|[\"'`/]"))) - (nth 1 (setq state (apply 'ruby-parse-partial nil state)))) + (nth 1 (setq state (apply #'ruby-parse-partial + nil state)))) (setq expr t) (skip-chars-forward "<")) (not expr)))) (setq i (1- i))) ((error) (forward-word 1))) - i))) + i)))) (defun ruby-backward-sexp (&optional arg) "Move backward across one balanced expression (sexp). With ARG, do it many times. Negative ARG means move forward." ;; TODO: Document body (interactive "p") - (if (and (numberp arg) (< arg 0)) - (ruby-forward-sexp (- arg)) + (cond + (ruby-use-smie (backward-sexp arg)) + ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg))) + (t (let ((i (or arg 1))) (condition-case nil (while (> i 0) @@ -1005,10 +1532,11 @@ With ARG, do it many times. Negative ARG means move forward." (forward-char -1) (cond ((looking-at "\\s)") (goto-char (scan-sexps (1+ (point)) -1)) - (case (char-before) - (?% (forward-char -1)) - ((?q ?Q ?w ?W ?r ?x) - (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) + (pcase (char-before) + (`?% (forward-char -1)) + ((or `?q `?Q `?w `?W `?r `?x) + (if (eq (char-before (1- (point))) ?%) + (forward-char -2)))) nil) ((looking-at "\\s\"\\|\\\\\\S_") (let ((c (char-to-string (char-before (match-end 0))))) @@ -1022,13 +1550,14 @@ With ARG, do it many times. Negative ARG means move forward." (t (forward-char 1) (while (progn (forward-word -1) - (case (char-before) - (?_ t) - (?. (forward-char -1) t) - ((?$ ?@) + (pcase (char-before) + (`?_ t) + (`?. (forward-char -1) t) + ((or `?$ `?@) (forward-char -1) - (and (eq (char-before) (char-after)) (forward-char -1))) - (?: + (and (eq (char-before) (char-after)) + (forward-char -1))) + (`?: (forward-char -1) (eq (char-before) :))))) (if (looking-at ruby-block-end-re) @@ -1036,7 +1565,7 @@ With ARG, do it many times. Negative ARG means move forward." nil)) (setq i (1- i))) ((error))) - i))) + i)))) (defun ruby-indent-exp (&optional ignored) "Indent each line in the balanced expression following the point." @@ -1188,7 +1717,8 @@ See `add-log-current-defun-function'." (insert "}") (goto-char orig) (delete-char 2) - (insert "{") + ;; Maybe this should be customizable, let's see if anyone asks. + (insert "{ ") (setq beg-marker (point-marker)) (when (looking-at "\\s +|") (delete-char (- (match-end 0) (match-beginning 0) 1)) @@ -1218,8 +1748,9 @@ If the result is do-end block, it will always be multiline." (let ((start (point)) beg end) (end-of-line) (unless - (if (and (re-search-backward "\\({\\)\\|\\_\\)") (progn + (goto-char (or (match-beginning 1) (match-beginning 2))) (setq beg (point)) (save-match-data (ruby-forward-sexp)) (setq end (point)) @@ -1229,307 +1760,190 @@ If the result is do-end block, it will always be multiline." (ruby-do-end-to-brace beg end))) (goto-char start)))) -(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit)) -(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit)) -(declare-function ruby-syntax-propertize-percent-literal "ruby-mode" (limit)) +(eval-and-compile + (defconst ruby-percent-literal-beg-re + "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)" + "Regexp to match the beginning of percent literal.") -(if (eval-when-compile (fboundp #'syntax-propertize-rules)) - ;; New code that works independently from font-lock. - (progn - (eval-and-compile - (defconst ruby-percent-literal-beg-re - "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)" - "Regexp to match the beginning of percent literal.") + (defconst ruby-syntax-methods-before-regexp + '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match" + "assert_match" "Given" "Then" "When") + "Methods that can take regexp as the first argument. +It will be properly highlighted even when the call omits parens.") - (defconst ruby-syntax-methods-before-regexp - '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match" - "assert_match" "Given" "Then" "When") - "Methods that can take regexp as the first argument. -It will be properly highlighted even when the call omits parens.")) + (defvar ruby-syntax-before-regexp-re + (concat + ;; Special tokens that can't be followed by a division operator. + "\\(^\\|[[=(,~;<>]" + ;; Distinguish ternary operator tokens. + ;; FIXME: They don't really have to be separated with spaces. + "\\|[?:] " + ;; Control flow keywords and operators following bol or whitespace. + "\\|\\(?:^\\|\\s \\)" + (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and" + "or" "not" "&&" "||")) + ;; Method name from the list. + "\\|\\_<" + (regexp-opt ruby-syntax-methods-before-regexp) + "\\)\\s *") + "Regexp to match text that can be followed by a regular expression.")) - (defun ruby-syntax-propertize-function (start end) - "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." - (goto-char start) - (ruby-syntax-propertize-heredoc end) - (ruby-syntax-enclosing-percent-literal end) - (funcall - (syntax-propertize-rules - ;; $' $" $` .... are variables. - ;; ?' ?" ?` are ascii codes. - ("\\([?$]\\)[#\"'`]" - (1 (unless (save-excursion - ;; Not within a string. - (nth 3 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "\\")))) - ;; Regexps: regexps are distinguished from division because - ;; of the keyword, symbol, or method name before them. - ((concat - ;; Special tokens that can't be followed by a division operator. - "\\(^\\|[[=(,~?:;<>]" - ;; Control flow keywords and operators following bol or whitespace. - "\\|\\(?:^\\|\\s \\)" - (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and" - "or" "not" "&&" "||")) - ;; Method name from the list. - "\\|\\_<" - (regexp-opt ruby-syntax-methods-before-regexp) - "\\)\\s *" - ;; The regular expression itself. - "\\(/\\)[^/\n\\\\]*\\(?:\\\\.[^/\n\\\\]*\\)*\\(/\\)") - (2 (string-to-syntax "\"/")) - (3 (string-to-syntax "\"/"))) - ("^=en\\(d\\)\\_>" (1 "!")) - ("^\\(=\\)begin\\_>" (1 "!")) - ;; Handle here documents. - ((concat ruby-here-doc-beg-re ".*\\(\n\\)") - (7 (unless (ruby-singleton-class-p (match-beginning 0)) - (put-text-property (match-beginning 7) (match-end 7) - 'syntax-table (string-to-syntax "\"")) - (ruby-syntax-propertize-heredoc end)))) - ;; Handle percent literals: %w(), %q{}, etc. - ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) - (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) - (point) end) - (ruby-syntax-propertize-expansions start end)) +(defun ruby-syntax-propertize-function (start end) + "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." + (let (case-fold-search) + (goto-char start) + (remove-text-properties start end '(ruby-expansion-match-data)) + (ruby-syntax-propertize-heredoc end) + (ruby-syntax-enclosing-percent-literal end) + (funcall + (syntax-propertize-rules + ;; $' $" $` .... are variables. + ;; ?' ?" ?` are character literals (one-char strings in 1.9+). + ("\\([?$]\\)[#\"'`]" + (1 (unless (save-excursion + ;; Not within a string. + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "\\")))) + ;; Part of symbol when at the end of a method name. + ("[!?]" + (0 (unless (save-excursion + (or (nth 8 (syntax-ppss (match-beginning 0))) + (let (parse-sexp-lookup-properties) + (zerop (skip-syntax-backward "w_"))) + (memq (preceding-char) '(?@ ?$)))) + (string-to-syntax "_")))) + ;; Regular expressions. Start with matching unescaped slash. + ("\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(/\\)" + (1 (let ((state (save-excursion (syntax-ppss (match-beginning 1))))) + (when (or + ;; Beginning of a regexp. + (and (null (nth 8 state)) + (save-excursion + (forward-char -1) + (looking-back ruby-syntax-before-regexp-re + (point-at-bol)))) + ;; End of regexp. We don't match the whole + ;; regexp at once because it can have + ;; string interpolation inside, or span + ;; several lines. + (eq ?/ (nth 3 state))) + (string-to-syntax "\"/"))))) + ;; Expression expansions in strings. We're handling them + ;; here, so that the regexp rule never matches inside them. + (ruby-expression-expansion-re + (0 (ignore (ruby-syntax-propertize-expansion)))) + ("^=en\\(d\\)\\_>" (1 "!")) + ("^\\(=\\)begin\\_>" (1 "!")) + ;; Handle here documents. + ((concat ruby-here-doc-beg-re ".*\\(\n\\)") + (7 (unless (or (nth 8 (save-excursion + (syntax-ppss (match-beginning 0)))) + (ruby-singleton-class-p (match-beginning 0))) + (put-text-property (match-beginning 7) (match-end 7) + 'syntax-table (string-to-syntax "\"")) + (ruby-syntax-propertize-heredoc end)))) + ;; Handle percent literals: %w(), %q{}, etc. + ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) + (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) + (point) end))) - (defun ruby-syntax-propertize-heredoc (limit) - (let ((ppss (syntax-ppss)) - (res '())) - (when (eq ?\n (nth 3 ppss)) - (save-excursion - (goto-char (nth 8 ppss)) - (beginning-of-line) - (while (re-search-forward ruby-here-doc-beg-re - (line-end-position) t) - (unless (ruby-singleton-class-p (match-beginning 0)) - (push (concat (ruby-here-doc-end-match) "\n") res)))) - (let ((start (point))) - ;; With multiple openers on the same line, we don't know in which - ;; part `start' is, so we have to go back to the beginning. - (when (cdr res) - (goto-char (nth 8 ppss)) - (setq res (nreverse res))) - (while (and res (re-search-forward (pop res) limit 'move)) - (if (null res) - (put-text-property (1- (point)) (point) - 'syntax-table (string-to-syntax "\"")))) - ;; Make extra sure we don't move back, lest we could fall into an - ;; inf-loop. - (if (< (point) start) (goto-char start)))))) - - (defun ruby-syntax-enclosing-percent-literal (limit) - (let ((state (syntax-ppss)) - (start (point))) - ;; When already inside percent literal, re-propertize it. - (when (eq t (nth 3 state)) - (goto-char (nth 8 state)) - (when (looking-at ruby-percent-literal-beg-re) - (ruby-syntax-propertize-percent-literal limit)) - (when (< (point) start) (goto-char start))))) - - (defun ruby-syntax-propertize-percent-literal (limit) - (goto-char (match-beginning 2)) - ;; Not inside a simple string or comment. - (when (eq t (nth 3 (syntax-ppss))) - (let* ((op (char-after)) - (ops (char-to-string op)) - (cl (or (cdr (aref (syntax-table) op)) - (cdr (assoc op '((?< . ?>)))))) - parse-sexp-lookup-properties) - (condition-case nil - (progn - (if cl ; Paired delimiters. - ;; Delimiter pairs of the same kind can be nested - ;; inside the literal, as long as they are balanced. - ;; Create syntax table that ignores other characters. - (with-syntax-table (make-char-table 'syntax-table nil) - (modify-syntax-entry op (concat "(" (char-to-string cl))) - (modify-syntax-entry cl (concat ")" ops)) - (modify-syntax-entry ?\\ "\\") - (save-restriction - (narrow-to-region (point) limit) - (forward-list))) ; skip to the paired character - ;; Single character delimiter. - (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" - (regexp-quote ops)) limit nil)) - ;; Found the closing delimiter. - (put-text-property (1- (point)) (point) 'syntax-table - (string-to-syntax "|"))) - ;; Unclosed literal, leave the following text unpropertized. - ((scan-error search-failed) (goto-char limit)))))) - - (defun ruby-syntax-propertize-expansions (start end) - (remove-text-properties start end '(ruby-expansion-match-data)) - (goto-char start) - ;; Find all expression expansions and - ;; - save the match data to a text property, for font-locking later, - ;; - set the syntax of all double quotes and backticks to punctuation. - (while (re-search-forward ruby-expression-expansion-re end 'move) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (when (and beg (save-excursion (nth 3 (syntax-ppss beg)))) - (put-text-property beg (1+ beg) 'ruby-expansion-match-data - (match-data)) - (goto-char beg) - (while (re-search-forward "[\"`]" end 'move) - (put-text-property (match-beginning 0) (match-end 0) - 'syntax-table (string-to-syntax "."))))))) - ) - - ;; For Emacsen where syntax-propertize-rules is not (yet) available, - ;; fallback on the old font-lock-syntactic-keywords stuff. - - (defconst ruby-here-doc-end-re - "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)" - "Regexp to match the end of heredocs. - -This will actually match any line with one or more characters. -It's useful in that it divides up the match string so that -`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") - - (defun ruby-here-doc-beg-match () - "Return a regexp to find the beginning of a heredoc. - -This should only be called after matching against `ruby-here-doc-end-re'." - (let ((contents (concat - (regexp-quote (concat (match-string 2) (match-string 3))) - (if (string= (match-string 3) "_") "\\B" "\\b")))) - (concat "<<" - (let ((match (match-string 1))) - (if (and match (> (length match) 0)) - (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" - (match-string 1) "\\)" - contents "\\(\\1\\|\\2\\)") - (concat "-?\\([\"']\\|\\)" contents "\\1")))))) - - (defconst ruby-font-lock-syntactic-keywords - `( - ;; the last $', $", $` in the respective string is not variable - ;; the last ?', ?", ?` in the respective string is not ascii code - ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" - (2 (7 . nil)) - (4 (7 . nil))) - ;; $' $" $` .... are variables - ;; ?' ?" ?` are ascii codes - ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) - ;; regexps - ("\\(^\\|[[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" - (4 (7 . ?/)) - (6 (7 . ?/))) - ("^=en\\(d\\)\\_>" 1 "!") - ;; Percent literal. - ("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)" - (3 "\"") - (5 "\"")) - ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) - ;; Currently, the following case is highlighted incorrectly: - ;; - ;; <)))))) + parse-sexp-lookup-properties) + (save-excursion + (condition-case nil + (progn + (if cl ; Paired delimiters. + ;; Delimiter pairs of the same kind can be nested + ;; inside the literal, as long as they are balanced. + ;; Create syntax table that ignores other characters. + (with-syntax-table (make-char-table 'syntax-table nil) + (modify-syntax-entry op (concat "(" (char-to-string cl))) + (modify-syntax-entry cl (concat ")" ops)) + (modify-syntax-entry ?\\ "\\") + (save-restriction + (narrow-to-region (point) limit) + (forward-list))) ; skip to the paired character + ;; Single character delimiter. + (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" + (regexp-quote ops)) limit nil)) + ;; Found the closing delimiter. + (put-text-property (1- (point)) (point) 'syntax-table + (string-to-syntax "|"))) + ;; Unclosed literal, do nothing. + ((scan-error search-failed))))))) - (set-match-data beg-match-data) - (goto-char (match-end 0))) - (set-match-data end-match-data) - (goto-char (match-end 0)) - (point))))) +(defun ruby-syntax-propertize-expansion () + ;; Save the match data to a text property, for font-locking later. + ;; Set the syntax of all double quotes and backticks to punctuation. + (let* ((beg (match-beginning 2)) + (end (match-end 2)) + (state (and beg (save-excursion (syntax-ppss beg))))) + (when (ruby-syntax-expansion-allowed-p state) + (put-text-property beg (1+ beg) 'ruby-expansion-match-data + (match-data)) + (goto-char beg) + (while (re-search-forward "[\"`]" end 'move) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax ".")))))) - (defun ruby-here-doc-beg-syntax () - "Return the syntax cell for a line that may begin a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'. - -This sets the syntax cell for the newline ending the line -containing the heredoc beginning so that cases where multiple -heredocs are started on one line are handled correctly." - (save-excursion - (goto-char (match-beginning 0)) - (unless (or (ruby-in-ppss-context-p 'non-heredoc) - (ruby-in-here-doc-p)) - (string-to-syntax "\"")))) - - (defun ruby-here-doc-end-syntax () - "Return the syntax cell for a line that may end a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'." - (let ((pss (syntax-ppss)) (case-fold-search nil)) - ;; If we aren't in a string, we definitely aren't ending a heredoc, - ;; so we can just give up. - ;; This means we aren't doing a full-document search - ;; every time we enter a character. - (when (ruby-in-ppss-context-p 'heredoc pss) +(defun ruby-syntax-expansion-allowed-p (parse-state) + "Return non-nil if expression expansion is allowed." + (let ((term (nth 3 parse-state))) + (cond + ((memq term '(?\" ?` ?\n ?/))) + ((eq term t) + (save-match-data (save-excursion - (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. - (let ((eol (point))) - (beginning-of-line) - (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... - (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... - (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... - (not (re-search-forward ruby-here-doc-beg-re eol t)))) - (string-to-syntax "\""))))))) + (goto-char (nth 8 parse-state)) + (looking-at "%\\(?:[QWrxI]\\|\\W\\)"))))))) - (unless (functionp 'syntax-ppss) - (defun syntax-ppss (&optional pos) - (parse-partial-sexp (point-min) (or pos (point))))) - ) +(defun ruby-syntax-propertize-expansions (start end) + (save-excursion + (goto-char start) + (while (re-search-forward ruby-expression-expansion-re end 'move) + (ruby-syntax-propertize-expansion)))) (defun ruby-in-ppss-context-p (context &optional ppss) (let ((ppss (or ppss (syntax-ppss (point))))) @@ -1552,14 +1966,6 @@ See the definition of `ruby-font-lock-syntactic-keywords'." "context name `" (symbol-name context) "' is unknown")))) t))) -(if (featurep 'xemacs) - (put 'ruby-mode 'font-lock-defaults - '((ruby-font-lock-keywords) - nil nil nil - beginning-of-line - (font-lock-syntactic-keywords - . ruby-font-lock-syntactic-keywords)))) - (defvar ruby-font-lock-syntax-table (let ((tbl (copy-syntax-table ruby-mode-syntax-table))) (modify-syntax-entry ?_ "w" tbl) @@ -1567,84 +1973,166 @@ See the definition of `ruby-font-lock-syntactic-keywords'." "The syntax table to use for fontifying Ruby mode buffers. See `font-lock-syntax-table'.") +(defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$]\\|\\.\\.\\)") + (defconst ruby-font-lock-keywords - (list - ;; functions - '("^\\s *def\\s +\\([^( \t\n]+\\)" + `(;; Functions. + ("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)" 1 font-lock-function-name-face) - ;; keywords - (cons (concat - "\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(defined\\?\\|" - (regexp-opt - '("alias_method" - "alias" - "and" - "begin" - "break" - "case" - "catch" - "class" - "def" - "do" - "elsif" - "else" - "fail" - "ensure" - "for" - "end" - "if" - "in" - "module_function" - "module" - "next" - "not" - "or" - "public" - "private" - "protected" - "raise" - "redo" - "rescue" - "retry" - "return" - "then" - "throw" - "super" - "unless" - "undef" - "until" - "when" - "while" - "yield") - t) - "\\)" - ruby-keyword-end-re) - 2) - ;; here-doc beginnings - `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) - 'font-lock-string-face)) - ;; variables - '("\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(nil\\|self\\|true\\|false\\)\\>" - 2 font-lock-variable-name-face) - ;; symbols - '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" - 2 font-lock-constant-face) - ;; variables - '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" + ;; Keywords. + (,(concat + ruby-font-lock-keyword-beg-re + (regexp-opt + '("alias" + "and" + "begin" + "break" + "case" + "class" + "def" + "defined?" + "do" + "elsif" + "else" + "fail" + "ensure" + "for" + "end" + "if" + "in" + "module" + "next" + "not" + "or" + "redo" + "rescue" + "retry" + "return" + "then" + "super" + "unless" + "undef" + "until" + "when" + "while" + "yield") + 'symbols)) + (1 font-lock-keyword-face)) + ;; Core methods that have required arguments. + (,(concat + ruby-font-lock-keyword-beg-re + (regexp-opt + '( ;; built-in methods on Kernel + "at_exit" + "autoload" + "autoload?" + "catch" + "eval" + "exec" + "fork" + "format" + "lambda" + "load" + "loop" + "open" + "p" + "print" + "printf" + "proc" + "putc" + "puts" + "require" + "require_relative" + "spawn" + "sprintf" + "syscall" + "system" + "trap" + "warn" + ;; keyword-like private methods on Module + "alias_method" + "attr" + "attr_accessor" + "attr_reader" + "attr_writer" + "define_method" + "extend" + "include" + "module_function" + "prepend" + "refine" + "using") + 'symbols)) + (1 (unless (looking-at " *\\(?:[]|,.)}=]\\|$\\)") + font-lock-builtin-face))) + ;; Kernel methods that have no required arguments. + (,(concat + ruby-font-lock-keyword-beg-re + (regexp-opt + '("__callee__" + "__dir__" + "__method__" + "abort" + "at_exit" + "binding" + "block_given?" + "caller" + "exit" + "exit!" + "fail" + "private" + "protected" + "public" + "raise" + "rand" + "readline" + "readlines" + "sleep" + "srand" + "throw") + 'symbols)) + (1 font-lock-builtin-face)) + ;; Here-doc beginnings. + (,ruby-here-doc-beg-re + (0 (unless (ruby-singleton-class-p (match-beginning 0)) + 'font-lock-string-face))) + ;; Perl-ish keywords. + "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$" + ;; Variables. + (,(concat ruby-font-lock-keyword-beg-re + "\\_<\\(nil\\|self\\|true\\|false\\)\\_>") 1 font-lock-variable-name-face) - '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+" + ;; Keywords that evaluate to certain values. + ("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" + (0 font-lock-variable-name-face)) + ;; Symbols. + ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" + 2 font-lock-constant-face) + ;; Variables. + ("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" + 1 font-lock-variable-name-face) + ("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+" 0 font-lock-variable-name-face) - ;; constants - '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" - 1 font-lock-type-face) - '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) - ;; expression expansion - '(ruby-match-expression-expansion + ;; Constants. + ("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" + 1 (unless (eq ?\( (char-after)) font-lock-type-face)) + ("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" + (2 font-lock-constant-face)) + ;; Conversion methods on Kernel. + (,(concat ruby-font-lock-keyword-beg-re + (regexp-opt '("Array" "Complex" "Float" "Hash" + "Integer" "Rational" "String") 'symbols)) + (1 font-lock-builtin-face)) + ;; Expression expansion. + (ruby-match-expression-expansion 2 font-lock-variable-name-face t) - ;; warn lower camel case - ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" - ; 0 font-lock-warning-face) - ) + ;; Negation char. + ("[^[:alnum:]_]\\(!\\)[^=]" + 1 font-lock-negation-char-face) + ;; Character literals. + ;; FIXME: Support longer escape sequences. + ("\\_<\\?\\\\?\\S " 0 font-lock-string-face) + ) "Additional expressions to highlight in Ruby mode.") (defun ruby-match-expression-expansion (limit) @@ -1659,55 +2147,36 @@ See `font-lock-syntax-table'.") ;;;###autoload (define-derived-mode ruby-mode prog-mode "Ruby" - "Major mode for editing Ruby scripts. -\\[ruby-indent-line] properly indents subexpressions of multi-line -class, module, def, if, while, for, do, and case statements, taking -nesting into account. - -The variable `ruby-indent-level' controls the amount of indentation. + "Major mode for editing Ruby code. \\{ruby-mode-map}" (ruby-mode-variables) - (set (make-local-variable 'imenu-create-index-function) - 'ruby-imenu-create-index) - (set (make-local-variable 'add-log-current-defun-function) - 'ruby-add-log-current-method) - (set (make-local-variable 'beginning-of-defun-function) - 'ruby-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) - 'ruby-end-of-defun) + (setq-local imenu-create-index-function 'ruby-imenu-create-index) + (setq-local add-log-current-defun-function 'ruby-add-log-current-method) + (setq-local beginning-of-defun-function 'ruby-beginning-of-defun) + (setq-local end-of-defun-function 'ruby-end-of-defun) - (add-hook - (cond ((boundp 'before-save-hook) 'before-save-hook) - ((boundp 'write-contents-functions) 'write-contents-functions) - ((boundp 'write-contents-hooks) 'write-contents-hooks)) - 'ruby-mode-set-encoding nil 'local) + (add-hook 'after-save-hook 'ruby-mode-set-encoding nil 'local) + (add-hook 'electric-indent-functions 'ruby--electric-indent-p nil 'local) - (set (make-local-variable 'electric-indent-chars) - (append '(?\{ ?\}) electric-indent-chars)) + (setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil)) + (setq-local font-lock-keywords ruby-font-lock-keywords) + (setq-local font-lock-syntax-table ruby-font-lock-syntax-table) - (set (make-local-variable 'font-lock-defaults) - '((ruby-font-lock-keywords) nil nil)) - (set (make-local-variable 'font-lock-keywords) - ruby-font-lock-keywords) - (set (make-local-variable 'font-lock-syntax-table) - ruby-font-lock-syntax-table) - - (if (eval-when-compile (fboundp 'syntax-propertize-rules)) - (set (make-local-variable 'syntax-propertize-function) - #'ruby-syntax-propertize-function) - (set (make-local-variable 'font-lock-syntactic-keywords) - ruby-font-lock-syntactic-keywords))) + (setq-local syntax-propertize-function #'ruby-syntax-propertize-function)) ;;; Invoke ruby-mode when appropriate ;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode)) -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "Rakefile\\'") 'ruby-mode)) -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.gemspec\\'") 'ruby-mode)) +(add-to-list 'auto-mode-alist + (cons (purecopy (concat "\\(?:\\." + "rb\\|ru\\|rake\\|thor" + "\\|jbuilder\\|gemspec\\|podspec" + "\\|/" + "\\(?:Gem\\|Rake\\|Cap\\|Thor" + "\\|Vagrant\\|Guard\\|Pod\\)file" + "\\)\\'")) 'ruby-mode)) ;;;###autoload (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index aae5526ea82..81af43dbef0 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,6 +1,6 @@ ;;; scheme.el --- Scheme (and DSSSL) editing mode -;; Copyright (C) 1986-1988, 1997-1998, 2001-2013 Free Software +;; Copyright (C) 1986-1988, 1997-1998, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Bill Rozas @@ -210,9 +210,7 @@ start an inferior Scheme using the more general `cmuscheme' package. Commands: Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. -\\{scheme-mode-map} -Entry to this mode calls the value of `scheme-mode-hook' -if that value is non-nil." +\\{scheme-mode-map}" (scheme-mode-variables)) (defgroup scheme nil @@ -310,8 +308,10 @@ See `run-hooks'." "(" (regexp-opt '("begin" "call-with-current-continuation" "call/cc" "call-with-input-file" "call-with-output-file" "case" "cond" - "do" "else" "for-each" "if" "lambda" + "do" "else" "for-each" "if" "lambda" "λ" "let" "let*" "let-syntax" "letrec" "letrec-syntax" + ;; R6RS library subforms. + "export" "import" ;; SRFI 11 usage comes up often enough. "let-values" "let*-values" ;; Hannes Haug wants: @@ -330,6 +330,10 @@ See `run-hooks'." ;; ;; Scheme `:' and `#:' keywords as builtins. '("\\<#?:\\sw+\\>" . font-lock-builtin-face) + ;; R6RS library declarations. + '("(\\(\\\\)\\s-*(?\\(\\sw+\\)?" + (1 font-lock-keyword-face) + (2 font-lock-type-face)) ))) "Gaudy expressions to highlight in Scheme modes.") @@ -410,6 +414,7 @@ that variable's value is a string." (put 'make 'scheme-indent-function 1) (put 'style 'scheme-indent-function 1) (put 'root 'scheme-indent-function 1) +(put 'λ 'scheme-indent-function 1) (defvar dsssl-font-lock-keywords (eval-when-compile @@ -535,6 +540,7 @@ indentation." (put 'letrec-syntax 'scheme-indent-function 1) (put 'syntax-rules 'scheme-indent-function 1) (put 'syntax-case 'scheme-indent-function 2) ; not r5rs +(put 'library 'scheme-indent-function 1) ; R6RS (put 'call-with-input-file 'scheme-indent-function 1) (put 'with-input-from-file 'scheme-indent-function 1) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index da30edf272b..7c677df8592 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1,11 +1,11 @@ -;;; sh-script.el --- shell-script editing commands for Emacs +;;; sh-script.el --- shell-script editing commands for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1993-1997, 1999, 2001-2013 Free Software Foundation, +;; Copyright (C) 1993-1997, 1999, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Daniel Pfeiffer ;; Version: 2.0f -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, unix ;; This file is part of GNU Emacs. @@ -335,11 +335,11 @@ shell it really is." . ((nil ;; function FOO ;; function FOO() - "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*\\(?:()\\)?" + "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?" 1) ;; FOO() (nil - "^\\s-*\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" + "^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()" 1) ))) "Alist of regular expressions for recognizing shell function definitions. @@ -353,6 +353,28 @@ See `sh-feature' and `imenu-generic-expression'." :group 'sh-script :version "20.4") +(defun sh-current-defun-name () + "Find the name of function or variable at point. +For use in `add-log-current-defun-function'." + (save-excursion + (end-of-line) + (when (re-search-backward + (concat "\\(?:" + ;; function FOO + ;; function FOO() + "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?" + "\\)\\|\\(?:" + ;; FOO() + "^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()" + "\\)\\|\\(?:" + ;; FOO= + "^\\([[:alpha:]_][[:alnum:]_]*\\)=" + "\\)") + nil t) + (or (match-string-no-properties 1) + (match-string-no-properties 2) + (match-string-no-properties 3))))) + (defvar sh-shell-variables nil "Alist of shell variable names that should be included in completion. These are used for completion in addition to all the variables named @@ -475,6 +497,9 @@ This is buffer-local in every such buffer.") (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) + (define-key map "\C-c\C-n" 'sh-send-line-or-region-and-step) + (define-key map "\C-c\C-d" 'sh-cd-here) + (define-key map "\C-c\C-z" 'sh-show-shell) (define-key map [remap delete-backward-char] 'backward-delete-char-untabify) @@ -648,7 +673,9 @@ removed when closing the here document." "." "alias" "bg" "bind" "builtin" "caller" "compgen" "complete" "declare" "dirs" "disown" "enable" "fc" "fg" "help" "history" "jobs" "kill" "let" "local" "popd" "printf" "pushd" "shopt" - "source" "suspend" "typeset" "unalias") + "source" "suspend" "typeset" "unalias" + ;; bash4 + "mapfile" "readarray") ;; The next entry is only used for defining the others (bourne sh-append shell @@ -712,6 +739,7 @@ implemented as aliases. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice (repeat string) (sexp :format "Evaluate: %v")))) + :version "24.4" ; bash4 additions :group 'sh-script) @@ -915,6 +943,7 @@ See `sh-feature'.") (rpm sh-append rpm2 ("%{?\\(\\sw+\\)" 1 font-lock-keyword-face)) (rpm2 sh-append shell + ("^Summary:\\(.*\\)$" (1 font-lock-doc-face t)) ("^\\(\\sw+\\):" 1 font-lock-variable-name-face))) "Default expressions to highlight in Shell Script modes. See `sh-feature'.") @@ -946,11 +975,14 @@ See `sh-feature'.") (let ((ppss (syntax-ppss pos))) (when (nth 1 ppss) (goto-char (nth 1 ppss)) - (pcase (char-after) - ;; $((...)) or $[...] or ${...}. - (`?\( (and (eq ?\( (char-before)) - (eq ?\$ (char-before (1- (point)))))) - ((or `?\{ `?\[) (eq ?\$ (char-before)))))))) + (or + (pcase (char-after) + ;; ((...)) or $((...)) or $[...] or ${...}. Nested + ;; parenthesis can occur inside the first of these forms, so + ;; parse backward recursively. + (`?\( (eq ?\( (char-before))) + ((or `?\{ `?\[) (eq ?\$ (char-before)))) + (sh--inside-noncommand-expression (1- (point)))))))) (defun sh-font-lock-open-heredoc (start string eol) "Determine the syntax of the \\n after a <grammar ;; (smie-bnf->prec2 -;; '((exp) ;A constant, or a $var, or a sequence of them… +;; '((exp) ;A constant, or a $var, or a sequence of them... ;; (elseifcmd (cmd) ;; (cmd "else" "else-if" exp "then" elseifcmd)) ;; (cmd ("switch" branches "endsw") @@ -1928,7 +2074,7 @@ Point should be before the newline." ";") (let ((semi (sh-smie--rc-newline-semi-p))) (forward-line 1) - (if semi ";" + (if (or semi (eobp)) ";" (sh-smie-rc-forward-token)))) (forward-comment (point-max)) (cond @@ -1950,14 +2096,13 @@ Point should be before the newline." (not (save-excursion (goto-char pos) - (sh-smie--keyword-p tok)))) + (sh-smie--keyword-p)))) " word ") (t tok))))))) (defun sh-smie-rc-backward-token () ;; FIXME: Code duplication with sh-smie-sh-backward-token. - (let ((bol (line-beginning-position)) - pos tok) + (let ((bol (line-beginning-position))) (forward-comment (- (point))) (cond ((and (bolp) (not (bobp)) @@ -1989,7 +2134,7 @@ Point should be before the newline." ;; ((equal tok ")") "case-)") ((and tok (string-match "\\`[a-z]" tok) (assoc tok smie-grammar) - (not (save-excursion (sh-smie--keyword-p tok)))) + (not (save-excursion (sh-smie--keyword-p)))) " word ") (t tok))))))) @@ -1997,8 +2142,9 @@ Point should be before the newline." (pcase (cons kind token) (`(:elem . basic) sh-indentation) ;; (`(:after . "case") (or sh-indentation smie-indent-basic)) - (`(:after . ";") (if (smie-rule-parent-p "case") - (smie-rule-parent sh-indentation))) + (`(:after . ";") + (if (smie-rule-parent-p "case") + (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) (`(:before . "{") (save-excursion (when (sh-smie--rc-after-special-arg-p) @@ -2013,6 +2159,7 @@ Point should be before the newline." ;; with "(exp)", which is rarely the right thing to do, but is better ;; than nothing. (`(:list-intro . ,(or `"for" `"if" `"while")) t) + ;; sh-indent-after-switch: handled implicitly by the default { rule. )) ;;; End of SMIE code. @@ -2087,11 +2234,18 @@ the visited file executable, and NO-QUERY-FLAG (the second argument) controls whether to query about making the visited file executable. Calls the value of `sh-set-shell-hook' if set." - (interactive (list (completing-read (format "Shell \(default %s\): " - sh-shell-file) - interpreter-mode-alist - (lambda (x) (eq (cdr x) 'sh-mode)) - nil nil nil sh-shell-file) + (interactive (list (completing-read + (format "Shell \(default %s\): " + sh-shell-file) + ;; This used to use interpreter-mode-alist, but that is + ;; no longer appropriate now that uses regexps. + ;; Maybe there could be a separate variable that lists + ;; the shells, used here and to construct i-mode-alist. + ;; But the following is probably good enough: + (append (mapcar (lambda (e) (symbol-name (car e))) + sh-ancestor-alist) + '("csh" "rc" "sh")) + nil nil nil nil sh-shell-file) (eq executable-query 'function) t)) (if (string-match "\\.exe\\'" shell) @@ -2119,14 +2273,14 @@ Calls the value of `sh-set-shell-hook' if set." (sh-feature sh-indent-supported)) (progn (message "Setting up indent for shell type %s" sh-shell) - (if sh-use-smie - (let ((mksym (lambda (name) - (intern (format "sh-smie-%s-%s" - sh-indent-supported-here name))))) - (smie-setup (symbol-value (funcall mksym "grammar")) - (funcall mksym "rules") - :forward-token (funcall mksym "forward-token") - :backward-token (funcall mksym "backward-token"))) + (let ((mksym (lambda (name) + (intern (format "sh-smie-%s-%s" + sh-indent-supported-here name))))) + (smie-setup (symbol-value (funcall mksym "grammar")) + (funcall mksym "rules") + :forward-token (funcall mksym "forward-token") + :backward-token (funcall mksym "backward-token"))) + (unless sh-use-smie (setq-local parse-sexp-lookup-properties t) (setq-local sh-kw-alist (sh-feature sh-kw)) (let ((regexp (sh-feature sh-kws-for-done))) @@ -2146,6 +2300,7 @@ Calls the value of `sh-set-shell-hook' if set." (setq font-lock-set-defaults nil) (font-lock-set-defaults) (font-lock-fontify-buffer)) + (setq sh-shell-process nil) (run-hooks 'sh-set-shell-hook)) @@ -2378,7 +2533,6 @@ which in this buffer is currently %s. (defun sh-read-variable (var) "Read a new value for indentation variable VAR." - (interactive "*variable? ") ;; to test (let ((minibuffer-help-form `(sh-help-string-for-variable (quote ,var))) val) @@ -2968,6 +3122,7 @@ This takes into account that there may be nested open..close pairings. OPEN and CLOSE are regexps denoting the tokens to be matched. Optional parameter DEPTH (usually 1) says how many to look for." (let ((parse-sexp-ignore-comments t) + (forward-sexp-function nil) prev) (setq depth (or depth 1)) (save-excursion @@ -3024,12 +3179,9 @@ IGNORE-ERROR is non-nil." ((eq val '/) (/ (- sh-basic-offset) 2)) (t - (if ignore-error - (progn - (message "Don't know how to handle %s's value of %s" var val) - 0) - (error "Don't know how to handle %s's value of %s" var val)) - )))) + (funcall (if ignore-error #'message #'error) + "Don't know how to handle %s's value of %s" var val) + 0)))) (defun sh-set-var-value (var value &optional no-symbol) "Set variable VAR to VALUE. @@ -3154,33 +3306,35 @@ If variable `sh-blink' is non-nil then momentarily go to the line we are indenting relative to, if applicable." (interactive "P") (sh-must-support-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - (curr-indent (current-indentation)) - val msg) - (if (stringp var) - (message "%s" (setq msg var)) - (setq val (sh-calculate-indent info)) + (if sh-use-smie + (smie-config-show-indent) + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + (curr-indent (current-indentation)) + val msg) + (if (stringp var) + (message "%s" (setq msg var)) + (setq val (sh-calculate-indent info)) - (if (eq curr-indent val) - (setq msg (format "%s is %s" var (symbol-value var))) - (setq msg - (if val - (format "%s (%s) would change indent from %d to: %d" - var (symbol-value var) curr-indent val) - (format "%s (%s) would leave line as is" - var (symbol-value var))) - )) - (if (and arg var) - (describe-variable var))) - (if sh-blink - (let ((info (sh-get-indent-info))) - (if (and info (listp (car info)) - (eq (car (car info)) t)) - (sh-blink (nth 1 (car info)) msg) - (message "%s" msg))) - (message "%s" msg)) - )) + (if (eq curr-indent val) + (setq msg (format "%s is %s" var (symbol-value var))) + (setq msg + (if val + (format "%s (%s) would change indent from %d to: %d" + var (symbol-value var) curr-indent val) + (format "%s (%s) would leave line as is" + var (symbol-value var))) + )) + (if (and arg var) + (describe-variable var))) + (if sh-blink + (let ((info (sh-get-indent-info))) + (if (and info (listp (car info)) + (eq (car (car info)) t)) + (sh-blink (nth 1 (car info)) msg) + (message "%s" msg))) + (message "%s" msg)) + ))) (defun sh-set-indent () "Set the indentation for the current line. @@ -3188,34 +3342,36 @@ If the current line is controlled by an indentation variable, prompt for a new value for it." (interactive) (sh-must-support-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - val old-val indent-val) - (if (stringp var) - (message "Cannot set indent - %s" var) - (setq old-val (symbol-value var)) - (setq val (sh-read-variable var)) - (condition-case nil - (progn - (set var val) - (setq indent-val (sh-calculate-indent info)) - (if indent-val - (message "Variable: %s Value: %s would indent to: %d" - var (symbol-value var) indent-val) - (message "Variable: %s Value: %s would leave line as is." - var (symbol-value var))) - ;; I'm not sure about this, indenting it now? - ;; No. Because it would give the impression that an undo would - ;; restore thing, but the value has been altered. - ;; (sh-indent-line) - ) - (error - (set var old-val) - (message "Bad value for %s, restoring to previous value %s" - var old-val) - (sit-for 1) - nil)) - ))) + (if sh-use-smie + (smie-config-set-indent) + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + val old-val indent-val) + (if (stringp var) + (message "Cannot set indent - %s" var) + (setq old-val (symbol-value var)) + (setq val (sh-read-variable var)) + (condition-case nil + (progn + (set var val) + (setq indent-val (sh-calculate-indent info)) + (if indent-val + (message "Variable: %s Value: %s would indent to: %d" + var (symbol-value var) indent-val) + (message "Variable: %s Value: %s would leave line as is." + var (symbol-value var))) + ;; I'm not sure about this, indenting it now? + ;; No. Because it would give the impression that an undo would + ;; restore thing, but the value has been altered. + ;; (sh-indent-line) + ) + (error + (set var old-val) + (message "Bad value for %s, restoring to previous value %s" + var old-val) + (sit-for 1) + nil)) + )))) (defun sh-learn-line-indent (arg) @@ -3229,55 +3385,57 @@ If the value can be represented by one of the symbols then do so unless optional argument ARG (the prefix when interactive) is non-nil." (interactive "*P") (sh-must-support-indent) - ;; I'm not sure if we show allow learning on an empty line. - ;; Though it might occasionally be useful I think it usually - ;; would just be confusing. - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*$")) - (message "sh-learn-line-indent ignores empty lines.") - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - ival sval diff new-val - (no-symbol arg) - (curr-indent (current-indentation))) - (cond - ((stringp var) - (message "Cannot learn line - %s" var)) - ((eq var 'sh-indent-comment) - ;; This is arbitrary... - ;; - if curr-indent is 0, set to curr-indent - ;; - else if it has the indentation of a "normal" line, - ;; then set to t - ;; - else set to curr-indent. - (setq sh-indent-comment - (if (= curr-indent 0) - 0 - (let* ((sh-indent-comment t) - (val2 (sh-calculate-indent info))) - (if (= val2 curr-indent) - t - curr-indent)))) - (message "%s set to %s" var (symbol-value var)) - ) - ((numberp (setq sval (sh-var-value var))) - (setq ival (sh-calculate-indent info)) - (setq diff (- curr-indent ival)) + (if sh-use-smie + (smie-config-set-indent) + ;; I'm not sure if we show allow learning on an empty line. + ;; Though it might occasionally be useful I think it usually + ;; would just be confusing. + (if (save-excursion + (beginning-of-line) + (looking-at "\\s-*$")) + (message "sh-learn-line-indent ignores empty lines.") + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + ival sval diff new-val + (no-symbol arg) + (curr-indent (current-indentation))) + (cond + ((stringp var) + (message "Cannot learn line - %s" var)) + ((eq var 'sh-indent-comment) + ;; This is arbitrary... + ;; - if curr-indent is 0, set to curr-indent + ;; - else if it has the indentation of a "normal" line, + ;; then set to t + ;; - else set to curr-indent. + (setq sh-indent-comment + (if (= curr-indent 0) + 0 + (let* ((sh-indent-comment t) + (val2 (sh-calculate-indent info))) + (if (= val2 curr-indent) + t + curr-indent)))) + (message "%s set to %s" var (symbol-value var)) + ) + ((numberp (setq sval (sh-var-value var))) + (setq ival (sh-calculate-indent info)) + (setq diff (- curr-indent ival)) - (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" - curr-indent ival diff var sval) - (setq new-val (+ sval diff)) -;;; I commented out this because someone might want to replace -;;; a value of `+' with the current value of sh-basic-offset -;;; or vice-versa. -;;; (if (= 0 diff) -;;; (message "No change needed!") - (sh-set-var-value var new-val no-symbol) - (message "%s set to %s" var (symbol-value var)) - ) - (t - (debug) - (message "Cannot change %s" var)))))) + (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" + curr-indent ival diff var sval) + (setq new-val (+ sval diff)) + ;; I commented out this because someone might want to replace + ;; a value of `+' with the current value of sh-basic-offset + ;; or vice-versa. + ;;(if (= 0 diff) + ;; (message "No change needed!") + (sh-set-var-value var new-val no-symbol) + (message "%s set to %s" var (symbol-value var)) + ) + (t + (debug) + (message "Cannot change %s" var))))))) @@ -3309,26 +3467,23 @@ so that `occur-next' and `occur-prev' will work." ) (goto-char (point-max)) (setq start (point)) - (insert line) - (if occur-point - (setq occur-point (point))) - (insert message) - (if point - (add-text-properties - start (point) - '(mouse-face highlight - help-echo "mouse-2: go to the line where I learned this"))) - (insert "\n") - (if point - (progn - (put-text-property start (point) 'occur-target m1) - (if occur-point - (put-text-property start occur-point - 'occur-match t)) - )) - ))) - - + (let ((inhibit-read-only t)) + (insert line) + (if occur-point + (setq occur-point (point))) + (insert message) + (if point + (add-text-properties + start (point) + '(mouse-face highlight + help-echo "mouse-2: go to the line where I learned this"))) + (insert "\n") + (when point + (put-text-property start (point) 'occur-target m1) + (if occur-point + (put-text-property start occur-point + 'occur-match t)) + ))))) ;; Is this really worth having? (defvar sh-learned-buffer-hook nil @@ -3352,7 +3507,7 @@ so that `occur-next' and `occur-prev' will work." ;; Originally this was sh-learn-region-indent (beg end) ;; However, in practice this was awkward so I changed it to -;; use the whole buffer. Use narrowing if needbe. +;; use the whole buffer. Use narrowing if need be. (defun sh-learn-buffer-indent (&optional arg) "Learn how to indent the buffer the way it currently is. @@ -3378,202 +3533,204 @@ removed in the future. This command can often take a long time to run." (interactive "P") (sh-must-support-indent) - (save-excursion - (goto-char (point-min)) - (let ((learned-var-list nil) - (out-buffer "*indent*") - (num-diffs 0) - previous-set-info - (max 17) - vec - msg - (comment-col nil) ;; number if all same, t if seen diff values - (comments-always-default t) ;; nil if we see one not default - initial-msg - (specified-basic-offset (and arg (numberp arg) - (> arg 0))) - (linenum 0) - suggested) - (setq vec (make-vector max 0)) - (sh-mark-init out-buffer) + (if sh-use-smie + (smie-config-guess) + (save-excursion + (goto-char (point-min)) + (let ((learned-var-list nil) + (out-buffer "*indent*") + (num-diffs 0) + previous-set-info + (max 17) + vec + msg + (comment-col nil) ;; number if all same, t if seen diff values + (comments-always-default t) ;; nil if we see one not default + initial-msg + (specified-basic-offset (and arg (numberp arg) + (> arg 0))) + (linenum 0) + suggested) + (setq vec (make-vector max 0)) + (sh-mark-init out-buffer) - (if specified-basic-offset - (progn - (setq sh-basic-offset arg) - (setq initial-msg - (format "Using specified sh-basic-offset of %d" - sh-basic-offset))) - (setq initial-msg - (format "Initial value of sh-basic-offset: %s" - sh-basic-offset))) + (if specified-basic-offset + (progn + (setq sh-basic-offset arg) + (setq initial-msg + (format "Using specified sh-basic-offset of %d" + sh-basic-offset))) + (setq initial-msg + (format "Initial value of sh-basic-offset: %s" + sh-basic-offset))) - (while (< (point) (point-max)) - (setq linenum (1+ linenum)) - ;; (if (zerop (% linenum 10)) - (message "line %d" linenum) - ;; ) - (unless (looking-at "\\s-*$") ;; ignore empty lines! - (let* ((sh-indent-comment t) ;; info must return default indent - (info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - sval ival diff new-val - (curr-indent (current-indentation))) - (cond - ((null var) - nil) - ((stringp var) - nil) - ((numberp (setq sval (sh-var-value var 'no-error))) - ;; the numberp excludes comments since sval will be t. - (setq ival (sh-calculate-indent)) - (setq diff (- curr-indent ival)) - (setq new-val (+ sval diff)) - (sh-set-var-value var new-val 'no-symbol) - (unless (looking-at "\\s-*#") ;; don't learn from comments - (if (setq previous-set-info (assoc var learned-var-list)) - (progn - ;; it was already there, is it same value ? - (unless (eq (symbol-value var) - (nth 1 previous-set-info)) - (sh-mark-line - (format "Variable %s was set to %s" - var (symbol-value var)) - (point) out-buffer t t) - (sh-mark-line - (format " but was previously set to %s" - (nth 1 previous-set-info)) - (nth 2 previous-set-info) out-buffer t) - (setq num-diffs (1+ num-diffs)) - ;; (delete previous-set-info learned-var-list) - (setcdr previous-set-info - (list (symbol-value var) (point))) - ) - ) - (setq learned-var-list - (append (list (list var (symbol-value var) - (point))) - learned-var-list))) - (if (numberp new-val) - (progn - (sh-debug - "This line's indent value: %d" new-val) - (if (< new-val 0) - (setq new-val (- new-val))) - (if (< new-val max) - (aset vec new-val (1+ (aref vec new-val)))))) - )) - ((eq var 'sh-indent-comment) - (unless (= curr-indent (sh-calculate-indent info)) - ;; this is not the default indentation - (setq comments-always-default nil) - (if comment-col ;; then we have see one before - (or (eq comment-col curr-indent) - (setq comment-col t)) ;; seen a different one - (setq comment-col curr-indent)) - )) - (t - (sh-debug "Cannot learn this line!!!") - )) - (sh-debug - "at %s learned-var-list is %s" (point) learned-var-list) - )) - (forward-line 1) - ) ;; while - (if sh-debug - (progn - (setq msg (format - "comment-col = %s comments-always-default = %s" - comment-col comments-always-default)) - ;; (message msg) - (sh-mark-line msg nil out-buffer))) - (cond - ((eq comment-col 0) - (setq msg "\nComments are all in 1st column.\n")) - (comments-always-default - (setq msg "\nComments follow default indentation.\n") - (setq comment-col t)) - ((numberp comment-col) - (setq msg (format "\nComments are in col %d." comment-col))) - (t - (setq msg "\nComments seem to be mixed, leaving them as is.\n") - (setq comment-col nil) - )) - (sh-debug msg) - (sh-mark-line msg nil out-buffer) + (while (< (point) (point-max)) + (setq linenum (1+ linenum)) + ;; (if (zerop (% linenum 10)) + (message "line %d" linenum) + ;; ) + (unless (looking-at "\\s-*$") ;; ignore empty lines! + (let* ((sh-indent-comment t) ;; info must return default indent + (info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + sval ival diff new-val + (curr-indent (current-indentation))) + (cond + ((null var) + nil) + ((stringp var) + nil) + ((numberp (setq sval (sh-var-value var 'no-error))) + ;; the numberp excludes comments since sval will be t. + (setq ival (sh-calculate-indent)) + (setq diff (- curr-indent ival)) + (setq new-val (+ sval diff)) + (sh-set-var-value var new-val 'no-symbol) + (unless (looking-at "\\s-*#") ;; don't learn from comments + (if (setq previous-set-info (assoc var learned-var-list)) + (progn + ;; it was already there, is it same value ? + (unless (eq (symbol-value var) + (nth 1 previous-set-info)) + (sh-mark-line + (format "Variable %s was set to %s" + var (symbol-value var)) + (point) out-buffer t t) + (sh-mark-line + (format " but was previously set to %s" + (nth 1 previous-set-info)) + (nth 2 previous-set-info) out-buffer t) + (setq num-diffs (1+ num-diffs)) + ;; (delete previous-set-info learned-var-list) + (setcdr previous-set-info + (list (symbol-value var) (point))) + ) + ) + (setq learned-var-list + (append (list (list var (symbol-value var) + (point))) + learned-var-list))) + (if (numberp new-val) + (progn + (sh-debug + "This line's indent value: %d" new-val) + (if (< new-val 0) + (setq new-val (- new-val))) + (if (< new-val max) + (aset vec new-val (1+ (aref vec new-val)))))) + )) + ((eq var 'sh-indent-comment) + (unless (= curr-indent (sh-calculate-indent info)) + ;; this is not the default indentation + (setq comments-always-default nil) + (if comment-col ;; then we have see one before + (or (eq comment-col curr-indent) + (setq comment-col t)) ;; seen a different one + (setq comment-col curr-indent)) + )) + (t + (sh-debug "Cannot learn this line!!!") + )) + (sh-debug + "at %s learned-var-list is %s" (point) learned-var-list) + )) + (forward-line 1) + ) ;; while + (if sh-debug + (progn + (setq msg (format + "comment-col = %s comments-always-default = %s" + comment-col comments-always-default)) + ;; (message msg) + (sh-mark-line msg nil out-buffer))) + (cond + ((eq comment-col 0) + (setq msg "\nComments are all in 1st column.\n")) + (comments-always-default + (setq msg "\nComments follow default indentation.\n") + (setq comment-col t)) + ((numberp comment-col) + (setq msg (format "\nComments are in col %d." comment-col))) + (t + (setq msg "\nComments seem to be mixed, leaving them as is.\n") + (setq comment-col nil) + )) + (sh-debug msg) + (sh-mark-line msg nil out-buffer) - (sh-mark-line initial-msg nil out-buffer t t) + (sh-mark-line initial-msg nil out-buffer t t) - (setq suggested (sh-guess-basic-offset vec)) + (setq suggested (sh-guess-basic-offset vec)) - (if (and suggested (not specified-basic-offset)) - (let ((new-value - (cond - ;; t => set it if we have a single value as a number - ((and (eq sh-learn-basic-offset t) (numberp suggested)) - suggested) - ;; other non-nil => set it if only one value was found - (sh-learn-basic-offset - (if (numberp suggested) - suggested - (if (= (length suggested) 1) - (car suggested)))) - (t - nil)))) - (if new-value - (progn - (setq learned-var-list - (append (list (list 'sh-basic-offset - (setq sh-basic-offset new-value) - (point-max))) - learned-var-list)) - ;; Not sure if we need to put this line in, since - ;; it will appear in the "Learned variable settings". - (sh-mark-line - (format "Changed sh-basic-offset to: %d" sh-basic-offset) - nil out-buffer)) - (sh-mark-line - (if (listp suggested) - (format "Possible value(s) for sh-basic-offset: %s" - (mapconcat 'int-to-string suggested " ")) - (format "Suggested sh-basic-offset: %d" suggested)) - nil out-buffer)))) + (if (and suggested (not specified-basic-offset)) + (let ((new-value + (cond + ;; t => set it if we have a single value as a number + ((and (eq sh-learn-basic-offset t) (numberp suggested)) + suggested) + ;; other non-nil => set it if only one value was found + (sh-learn-basic-offset + (if (numberp suggested) + suggested + (if (= (length suggested) 1) + (car suggested)))) + (t + nil)))) + (if new-value + (progn + (setq learned-var-list + (append (list (list 'sh-basic-offset + (setq sh-basic-offset new-value) + (point-max))) + learned-var-list)) + ;; Not sure if we need to put this line in, since + ;; it will appear in the "Learned variable settings". + (sh-mark-line + (format "Changed sh-basic-offset to: %d" sh-basic-offset) + nil out-buffer)) + (sh-mark-line + (if (listp suggested) + (format "Possible value(s) for sh-basic-offset: %s" + (mapconcat 'int-to-string suggested " ")) + (format "Suggested sh-basic-offset: %d" suggested)) + nil out-buffer)))) - (setq learned-var-list - (append (list (list 'sh-indent-comment comment-col (point-max))) - learned-var-list)) - (setq sh-indent-comment comment-col) - (let ((name (buffer-name))) - (sh-mark-line "\nLearned variable settings:" nil out-buffer) - (if arg - ;; Set learned variables to symbolic rather than numeric - ;; values where possible. - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var)) - (val (nth 1 learned-var))) - (when (and (not (eq var 'sh-basic-offset)) - (numberp val)) - (sh-set-var-value var val))))) - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var))) - (sh-mark-line (format " %s %s" var (symbol-value var)) - (nth 2 learned-var) out-buffer))) - (with-current-buffer out-buffer - (goto-char (point-min)) - (insert - (format "Indentation values for buffer %s.\n" name) - (format "%d indentation variable%s different values%s\n\n" - num-diffs - (if (= num-diffs 1) - " has" "s have") - (if (zerop num-diffs) - "." ":")) - ))) - ;; Are abnormal hooks considered bad form? - (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) - (and (called-interactively-p 'any) - (or sh-popup-occur-buffer (> num-diffs 0)) - (pop-to-buffer out-buffer))))) + (setq learned-var-list + (append (list (list 'sh-indent-comment comment-col (point-max))) + learned-var-list)) + (setq sh-indent-comment comment-col) + (let ((name (buffer-name))) + (sh-mark-line "\nLearned variable settings:" nil out-buffer) + (if arg + ;; Set learned variables to symbolic rather than numeric + ;; values where possible. + (dolist (learned-var (reverse learned-var-list)) + (let ((var (car learned-var)) + (val (nth 1 learned-var))) + (when (and (not (eq var 'sh-basic-offset)) + (numberp val)) + (sh-set-var-value var val))))) + (dolist (learned-var (reverse learned-var-list)) + (let ((var (car learned-var))) + (sh-mark-line (format " %s %s" var (symbol-value var)) + (nth 2 learned-var) out-buffer))) + (with-current-buffer out-buffer + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (insert + (format "Indentation values for buffer %s.\n" name) + (format "%d indentation variable%s different values%s\n\n" + num-diffs + (if (= num-diffs 1) + " has" "s have") + (if (zerop num-diffs) + "." ":")))))) + ;; Are abnormal hooks considered bad form? + (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) + (and (called-interactively-p 'any) + (or sh-popup-occur-buffer (> num-diffs 0)) + (pop-to-buffer out-buffer)))))) (defun sh-guess-basic-offset (vec) "See if we can determine a reasonable value for `sh-basic-offset'. @@ -3589,11 +3746,11 @@ Return values: (i 1) (totals (make-vector max 0))) (while (< i max) - (aset totals i (+ (aref totals i) (* 4 (aref vec i)))) + (cl-incf (aref totals i) (* 4 (aref vec i))) (if (zerop (% i 2)) - (aset totals i (+ (aref totals i) (aref vec (/ i 2))))) + (cl-incf (aref totals i) (aref vec (/ i 2)))) (if (< (* i 2) max) - (aset totals i (+ (aref totals i) (aref vec (* i 2))))) + (cl-incf (aref totals i) (aref vec (* i 2)))) (setq i (1+ i))) (let ((x nil) @@ -3602,10 +3759,10 @@ Return values: (setq i 1) (while (< i max) (if (/= (aref totals i) 0) - (setq x (append x (list (cons i (aref totals i)))))) + (push (cons i (aref totals i)) x)) (setq i (1+ i))) - (setq x (sort x (lambda (a b) (> (cdr a) (cdr b))))) + (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b))))) (setq tot (apply '+ (append totals nil))) (sh-debug (format "vec: %s\ntotals: %s\ntot: %d" vec totals tot)) @@ -4111,7 +4268,8 @@ The document is bounded by `sh-here-document-word'." (or (not (looking-back "[^<]<<")) (save-excursion (backward-char 2) - (sh-quoted-p)) + (or (sh-quoted-p) + (sh--inside-noncommand-expression (point)))) (nth 8 (syntax-ppss)) (let ((tabs (if (string-match "\\`-" sh-here-document-word) (make-string (/ (current-indentation) tab-width) ?\t) diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 77732ed3241..2dfd893d2b3 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -1,6 +1,6 @@ ;;; simula.el --- SIMULA 87 code editing commands for Emacs -;; Copyright (C) 1992, 1994, 1996, 2001-2013 Free Software Foundation, +;; Copyright (C) 1992, 1994, 1996, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Hans Henrik Eriksen diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 781aa241802..3f935bbaf5f 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1,10 +1,10 @@ ;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*- -;; Copyright (C) 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Alex Schroeder -;; Maintainer: Michael Mauger -;; Version: 3.1 +;; Maintainer: Michael Mauger +;; Version: 3.4 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/projects/emacs/ @@ -209,7 +209,7 @@ ;; nino ;; Berend de Boer ;; Adam Jenkins -;; Michael Mauger -- improved product support +;; Michael Mauger -- improved product support ;; Drew Adams -- Emacs 20 support ;; Harald Maier -- sql-send-string ;; Stefan Monnier -- font-lock corrections; @@ -218,6 +218,9 @@ ;; Andrew Schein -- sql-port bug ;; Ian Bjorhovde -- db2 escape newlines ;; incorrectly enabled by default +;; Roman Scherer -- Connection documentation +;; Mark Wilkinson -- file-local variables ignored +;; @@ -230,6 +233,7 @@ (require 'regexp-opt)) (require 'custom) (require 'thingatpt) +(require 'view) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -243,7 +247,7 @@ :group 'languages :group 'processes) -;; These four variables will be used as defaults, if set. +;; These five variables will be used as defaults, if set. (defcustom sql-user "" "Default username." @@ -282,36 +286,49 @@ file. Since that is a plaintext file, this could be dangerous." (define-widget 'sql-login-params 'lazy "Widget definition of the login parameters list" - ;; FIXME: does not implement :default property for the user, - ;; database and server options. Anybody have some guidance on how to - ;; do this. :tag "Login Parameters" - :type '(repeat (choice - (const user) - (const password) - (choice :tag "server" - (const server) - (list :tag "file" - (const :format "" server) - (const :format "" :file) - regexp) - (list :tag "completion" - (const :format "" server) + :type '(set :tag "Login Parameters" + (choice :tag "user" + :value user + (const user) + (list :tag "Specify a default" + (const user) + (list :tag "Default" + :inline t (const :default) string))) + (const password) + (choice :tag "server" + :value server + (const server) + (list :tag "Specify a default" + (const server) + (list :tag "Default" + :inline t (const :default) string)) + (list :tag "file" + (const :format "" server) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" server) + (const :format "" :completion) + (restricted-sexp + :match-alternatives (listp stringp)))) + (choice :tag "database" + :value database + (const database) + (list :tag "Specify a default" + (const database) + (list :tag "Default" + :inline t (const :default) string)) + (list :tag "file" + (const :format "" database) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" database) (const :format "" :completion) (restricted-sexp :match-alternatives (listp stringp)))) - (choice :tag "database" - (const database) - (list :tag "file" - (const :format "" database) - (const :format "" :file) - regexp) - (list :tag "completion" - (const :format "" database) - (const :format "" :completion) - (restricted-sexp - :match-alternatives (listp stringp)))) - (const port)))) + (const port))) ;; SQL Product support @@ -421,7 +438,7 @@ file. Since that is a plaintext file, this could be dangerous." :completion-object sql-oracle-completion-object :prompt-regexp "^SQL> " :prompt-length 5 - :prompt-cont-regexp "^\\s-*[[:digit:]]+ " + :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}" :statement sql-oracle-statement-starters :syntax-alist ((?$ . "_") (?# . "_")) :terminator ("\\(^/\\|;\\)$" . "/") @@ -605,11 +622,12 @@ Each element of the alist is as follows: \(CONNECTION \(SQL-VARIABLE VALUE) ...) -Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE -is the symbol name of a SQL mode variable, and VALUE is the value to -be assigned to the variable. The most common SQL-VARIABLE settings -associated with a connection are: `sql-product', `sql-user', -`sql-password', `sql-port', `sql-server', and `sql-database'. +Where CONNECTION is a case-insensitive string identifying the +connection, SQL-VARIABLE is the symbol name of a SQL mode +variable, and VALUE is the value to be assigned to the variable. +The most common SQL-VARIABLE settings associated with a +connection are: `sql-product', `sql-user', `sql-password', +`sql-port', `sql-server', and `sql-database'. If a SQL-VARIABLE is part of the connection, it will not be prompted for during login. The command `sql-connect' starts a @@ -706,6 +724,8 @@ it automatically." Globally should be set to nil; it will be non-nil in `sql-mode', `sql-interactive-mode' and list all buffers.") +(defvar sql-login-delay 7.5 ;; Secs + "Maximum number of seconds you are willing to wait for a login connection.") (defcustom sql-pop-to-buffer-after-send-region nil "When non-nil, pop to the buffer SQL statements are sent to. @@ -831,10 +851,10 @@ You will find the file in your Orant\\bin directory." :type 'file :group 'SQL) -(defcustom sql-oracle-options nil +(defcustom sql-oracle-options '("-L") "List of additional options for `sql-oracle-program'." :type '(repeat string) - :version "20.8" + :version "24.4" :group 'SQL) (defcustom sql-oracle-login-params '(user password database) @@ -1299,7 +1319,7 @@ Based on `comint-mode-map'.") ;; double quotes (") don't delimit strings (modify-syntax-entry ?\" "." table) ;; Make these all punctuation - (mapc (lambda (c) (modify-syntax-entry c "." table)) + (mapc #'(lambda (c) (modify-syntax-entry c "." table)) (string-to-list "!#$%&+,.:;<=>?@\\|")) table) "Syntax table used in `sql-mode' and `sql-interactive-mode'.") @@ -1509,7 +1529,7 @@ to add functions and PL/SQL keywords.") (not (derived-mode-p 'sql-interactive-mode))) (not sql-buffer) (not (eq sql-product 'oracle))) - (error "Not an Oracle buffer") + (user-error "Not an Oracle buffer") (let ((b "*RESERVED WORDS*")) (sql-execute sql-buffer b @@ -1583,6 +1603,7 @@ to add functions and PL/SQL keywords.") "\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$") 0 'font-lock-doc-face t) + '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil @@ -1692,7 +1713,7 @@ to add functions and PL/SQL keywords.") "noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null" "nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online" "only" "open" "operator" "optimal" "option" "or" "order" -"organization" "out" "outer" "outline" "overflow" "overriding" +"organization" "out" "outer" "outline" "over" "overflow" "overriding" "package" "packages" "parallel" "parallel_enable" "parameters" "parent" "partition" "partitions" "password" "password_grace_time" "password_life_time" "password_lock_time" "password_reuse_max" @@ -1745,7 +1766,7 @@ to add functions and PL/SQL keywords.") ;; Oracle PL/SQL Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "delete" "trim" "extend" "exists" "first" "last" "count" "limit" -"prior" "next" +"prior" "next" "sqlcode" "sqlerrm" ) ;; Oracle PL/SQL Reserved words @@ -2402,7 +2423,7 @@ highlighting rules in SQL mode.") (let ((init (or (and initial (symbol-name initial)) "ansi"))) (intern (completing-read prompt - (mapcar (lambda (info) (symbol-name (car info))) + (mapcar #'(lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match init 'sql-product-history init)))) @@ -2418,10 +2439,10 @@ configuration." ;; Don't do anything if the product is already supported (if (assoc product sql-product-alist) - (message "Product `%s' is already defined" product) + (user-error "Product `%s' is already defined" product) ;; Add product to the alist - (add-to-list 'sql-product-alist `((,product :name ,display . ,plist))) + (add-to-list 'sql-product-alist `(,product :name ,display . ,plist)) ;; Add a menu item to the SQL->Product menu (easy-menu-add-item sql-mode-menu '("Product") ;; Each product is represented by a radio @@ -2437,11 +2458,11 @@ configuration." ;; after this product's name. (let ((next-item) (down-display (downcase display))) - (map-keymap (lambda (k b) - (when (and (not next-item) - (string-lessp down-display - (downcase (cadr b)))) - (setq next-item k))) + (map-keymap #'(lambda (k b) + (when (and (not next-item) + (string-lessp down-display + (downcase (cadr b)))) + (setq next-item k))) (easy-menu-get-map sql-mode-menu '("Product"))) next-item)) product)) @@ -2472,7 +2493,7 @@ argument must be a plist keyword accepted by (symbolp v)) (set v newvalue) (setcdr p (plist-put (cdr p) feature newvalue))) - (message "`%s' is not a known product; use `sql-add-product' to add it first." product)))) + (error "`%s' is not a known product; use `sql-add-product' to add it first." product)))) (defun sql-get-product-feature (product feature &optional fallback not-indirect) "Lookup FEATURE associated with a SQL PRODUCT. @@ -2502,7 +2523,7 @@ See `sql-product-alist' for a list of products and supported features." (symbolp v)) (symbol-value v) v)) - (message "`%s' is not a known product; use `sql-add-product' to add it first." product) + (error "`%s' is not a known product; use `sql-add-product' to add it first." product) nil))) (defun sql-product-font-lock (keywords-only imenu) @@ -2543,13 +2564,13 @@ also be configured." (font-lock-mode-internal t)) (add-hook 'font-lock-mode-hook - (lambda () - ;; Provide defaults for new font-lock faces. - (defvar font-lock-builtin-face - (if (boundp 'font-lock-preprocessor-face) - font-lock-preprocessor-face - font-lock-keyword-face)) - (defvar font-lock-doc-face font-lock-string-face)) + #'(lambda () + ;; Provide defaults for new font-lock faces. + (defvar font-lock-builtin-face + (if (boundp 'font-lock-preprocessor-face) + font-lock-preprocessor-face + font-lock-keyword-face)) + (defvar font-lock-doc-face font-lock-string-face)) nil t) ;; Setup imenu; it needs the same syntax-alist. @@ -2592,10 +2613,10 @@ adds a fontification pattern to fontify identifiers ending in "Iterate through login parameters and return a list of results." (delq nil (mapcar - (lambda (param) - (let ((token (or (car-safe param) param)) - (plist (cdr-safe param))) - (funcall body token plist))) + #'(lambda (param) + (let ((token (or (car-safe param) param)) + (plist (cdr-safe param))) + (funcall body token plist))) login-params))) @@ -2604,8 +2625,8 @@ adds a fontification pattern to fontify identifiers ending in (defun sql-product-syntax-table () (let ((table (copy-syntax-table sql-mode-syntax-table))) - (mapc (lambda (entry) - (modify-syntax-entry (car entry) (cdr entry) table)) + (mapc #'(lambda (entry) + (modify-syntax-entry (car entry) (cdr entry) table)) (sql-get-product-feature sql-product :syntax-alist)) table)) @@ -2613,10 +2634,10 @@ adds a fontification pattern to fontify identifiers ending in (append ;; Change all symbol character to word characters (mapcar - (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_") - (cons (car entry) - (concat "w" (substring (cdr entry) 1))) - entry)) + #'(lambda (entry) (if (string= (substring (cdr entry) 0 1) "_") + (cons (car entry) + (concat "w" (substring (cdr entry) 1))) + entry)) (sql-get-product-feature sql-product :syntax-alist)) '((?_ . "w")))) @@ -2639,7 +2660,7 @@ adds a fontification pattern to fontify identifiers ending in (list (sql-read-product "SQL product: "))) (if (stringp product) (setq product (intern product))) (when (not (assoc product sql-product-alist)) - (error "SQL product %s is not supported; treated as ANSI" product) + (user-error "SQL product %s is not supported; treated as ANSI" product) (setq product 'ansi)) ;; Save product setting and fontify. @@ -2765,6 +2786,7 @@ local variable." (comint-bol nil) (looking-at "go\\b"))) (comint-send-input))) +(put 'sql-magic-go 'delete-selection t) (defun sql-magic-semicolon (arg) "Insert semicolon and call `comint-send-input'. @@ -2773,6 +2795,7 @@ local variable." (self-insert-command (prefix-numeric-value arg)) (if (equal sql-electric-stuff 'semicolon) (comint-send-input))) +(put 'sql-magic-semicolon 'delete-selection t) (defun sql-accumulate-and-indent () "Continue SQL statement on the next line." @@ -2806,14 +2829,14 @@ each line with INDENT." "]\n")))) doc)) -;;;###autoload -(eval - ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled - ;; functions, because of the lazy-loading of docstrings, which strips away - ;; text properties. - '(defun sql-help () - #("Show short help for the SQL modes. +(defun sql-help () + "Show short help for the SQL modes." + (interactive) + (describe-function 'sql-help)) +(put 'sql-help 'function-documentation '(sql--make-help-docstring)) +(defvar sql--help-docstring + "Show short help for the SQL modes. Use an entry function to open an interactive SQL buffer. This buffer is usually named `*SQL*'. The name of the major mode is SQLi. @@ -2842,24 +2865,29 @@ anything. The name of the major mode is SQL. In this SQL buffer (SQL mode), you can send the region or the entire buffer to the interactive SQL buffer (SQLi mode). The results are -appended to the SQLi buffer without disturbing your SQL buffer." - 0 1 (dynamic-docstring-function sql--make-help-docstring)) - (interactive) - (describe-function 'sql-help))) +appended to the SQLi buffer without disturbing your SQL buffer.") -(defun sql--make-help-docstring (doc _fun) - "Insert references to loaded products into the help buffer string." +(defun sql--make-help-docstring () + "Return a docstring for `sql-help' listing loaded SQL products." + (let ((doc sql--help-docstring)) + ;; Insert FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) + t t doc 0))) + ;; Insert non-FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) + t t doc 0))) + doc)) - ;; Insert FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) - t t doc 0))) +(defun sql-default-value (var) + "Fetch the value of a variable. - ;; Insert non-FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) - t t doc 0))) - doc) +If the current buffer is in `sql-interactive-mode', then fetch +the global value, otherwise use the buffer local value." + (if (derived-mode-p 'sql-interactive-mode) + (default-value var) + (buffer-local-value var (current-buffer)))) (defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. @@ -2882,7 +2910,7 @@ value. (The property value is used as the PREDICATE argument to (set-default symbol (let* ((default (plist-get plist :default)) - (last-value (default-value symbol)) + (last-value (sql-default-value symbol)) (prompt-def (if default (if (string-match "\\(\\):[ \t]*\\'" prompt) @@ -2950,7 +2978,7 @@ function like this: (sql-get-login 'user 'password 'database)." (`password (setq-default sql-password - (read-passwd "Password: " nil sql-password))) + (read-passwd "Password: " nil (sql-default-value 'sql-password)))) (`server (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) @@ -2978,10 +3006,10 @@ In order to qualify, the SQLi buffer must be alive, be in (sql-buffer-live-p buf prod connection) buf) ;; Look thru each buffer - (car (apply 'append - (mapcar (lambda (b) - (and (sql-buffer-live-p b prod connection) - (list (buffer-name b)))) + (car (apply #'append + (mapcar #'(lambda (b) + (and (sql-buffer-live-p b prod connection) + (list (buffer-name b)))) (buffer-list))))))) (defun sql-set-sqli-buffer-generally () @@ -3022,10 +3050,10 @@ If you call it from anywhere else, it sets the global copy of (interactive) (let ((default-buffer (sql-find-sqli-buffer))) (if (null default-buffer) - (error "There is no suitable SQLi buffer") + (user-error "There is no suitable SQLi buffer") (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t))) (if (null (sql-buffer-live-p new-buffer)) - (error "Buffer %s is not a working SQLi buffer" new-buffer) + (user-error "Buffer %s is not a working SQLi buffer" new-buffer) (when new-buffer (setq sql-buffer new-buffer) (run-hooks 'sql-set-sqli-hook))))))) @@ -3038,10 +3066,10 @@ variable `sql-buffer'. See `sql-help' on how to create such a buffer." (interactive) (if (or (null sql-buffer) (null (buffer-live-p (get-buffer sql-buffer)))) - (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) + (user-error "%s has no SQLi buffer set" (buffer-name (current-buffer))) (if (null (get-buffer-process sql-buffer)) - (message "Buffer %s has no process." sql-buffer) - (message "Current SQLi buffer is %s." sql-buffer)))) + (user-error "Buffer %s has no process" sql-buffer) + (user-error "Current SQLi buffer is %s" sql-buffer)))) (defun sql-make-alternate-buffer-name () "Return a string that can be used to rename a SQLi buffer. @@ -3062,35 +3090,35 @@ server/database name." ;; Build a name using the :sqli-login setting (setq name - (apply 'concat + (apply #'concat (cdr - (apply 'append nil + (apply #'append nil (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) - (lambda (token plist) - (pcase token - (`user - (unless (string= "" sql-user) - (list "/" sql-user))) - (`port - (unless (or (not (numberp sql-port)) - (= 0 sql-port)) - (list ":" (number-to-string sql-port)))) - (`server - (unless (string= "" sql-server) - (list "." - (if (plist-member plist :file) - (file-name-nondirectory sql-server) - sql-server)))) - (`database - (unless (string= "" sql-database) - (list "@" - (if (plist-member plist :file) - (file-name-nondirectory sql-database) - sql-database)))) + #'(lambda (token plist) + (pcase token + (`user + (unless (string= "" sql-user) + (list "/" sql-user))) + (`port + (unless (or (not (numberp sql-port)) + (= 0 sql-port)) + (list ":" (number-to-string sql-port)))) + (`server + (unless (string= "" sql-server) + (list "." + (if (plist-member plist :file) + (file-name-nondirectory sql-server) + sql-server)))) + (`database + (unless (string= "" sql-database) + (list "@" + (if (plist-member plist :file) + (file-name-nondirectory sql-database) + sql-database)))) - ;; (`password nil) - (_ nil)))))))) + ;; (`password nil) + (_ nil)))))))) ;; If there's a connection, use it and the name thus far (if sql-connection @@ -3125,7 +3153,7 @@ NEW-NAME is empty, then the buffer name will be \"*SQL*\"." (interactive "P") (if (not (derived-mode-p 'sql-interactive-mode)) - (message "Current buffer is not a SQL interactive buffer") + (user-error "Current buffer is not a SQL interactive buffer") (setq sql-alternate-buffer-name (cond @@ -3135,6 +3163,7 @@ NEW-NAME is empty, then the buffer name will be \"*SQL*\"." sql-alternate-buffer-name)) (t sql-alternate-buffer-name))) + (setq sql-alternate-buffer-name (substring-no-properties sql-alternate-buffer-name)) (rename-buffer (if (string= "" sql-alternate-buffer-name) "*SQL*" (format "*SQL: %s*" sql-alternate-buffer-name)) @@ -3182,7 +3211,7 @@ Inserts SELECT or commas if appropriate." Placeholders are words starting with an ampersand like &this." (when sql-oracle-scan-on - (while (string-match "&\\(\\sw+\\)" string) + (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string) (setq string (replace-match (read-from-minibuffer (format "Enter value for %s: " (match-string 1 string)) @@ -3222,7 +3251,7 @@ Allows the suppression of continuation prompts.") (defun sql-input-sender (proc string) "Send STRING to PROC after applying filters." - (let* ((product (with-current-buffer (process-buffer proc) sql-product)) + (let* ((product (buffer-local-value 'sql-product (process-buffer proc))) (filter (sql-get-product-feature product :input-filter))) ;; Apply filter(s) @@ -3232,15 +3261,13 @@ Allows the suppression of continuation prompts.") ((functionp filter) (setq string (funcall filter string))) ((listp filter) - (mapc (lambda (f) (setq string (funcall f string))) filter)) + (mapc #'(lambda (f) (setq string (funcall f string))) filter)) (t nil)) ;; Count how many newlines in the string - (setq sql-output-newline-count 0) - (mapc (lambda (ch) - (when (eq ch ?\n) - (setq sql-output-newline-count (1+ sql-output-newline-count)))) - string) + (setq sql-output-newline-count + (apply #'+ (mapcar #'(lambda (ch) + (if (eq ch ?\n) 1 0)) string))) ;; Send the string (comint-simple-send proc string))) @@ -3249,6 +3276,17 @@ Allows the suppression of continuation prompts.") (defvar sql-preoutput-hold nil) +(defun sql-starts-with-prompt-re () + "Anchor the prompt expression at the beginning of the output line. +Remove the start of line regexp." + (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp)) + +(defun sql-ends-with-prompt-re () + "Anchor the prompt expression at the end of the output line. +Remove the start of line regexp from the prompt expression since +it may not follow newline characters in the output line." + (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'")) + (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. @@ -3266,38 +3304,52 @@ to the next chunk to properly match the broken-up prompt. If the filter gets confused, it should reset and stop filtering to avoid deleting non-prompt output." - (let (did-filter) - (setq oline (concat (or sql-preoutput-hold "") oline) - sql-preoutput-hold nil) + (when comint-prompt-regexp + (save-match-data + (let (prompt-found last-nl) - (if (and comint-prompt-regexp - (integerp sql-output-newline-count) - (>= sql-output-newline-count 1)) - (progn - (while (and (not (string= oline "")) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold "") + + ;; If we are looking for multiple prompts + (when (and (integerp sql-output-newline-count) + (>= sql-output-newline-count 1)) + ;; Loop thru each starting prompt and remove it + (let ((start-re (sql-starts-with-prompt-re))) + (while (and (not (string= oline "")) (> sql-output-newline-count 0) - (string-match comint-prompt-regexp oline) - (= (match-beginning 0) 0)) - - (setq oline (replace-match "" nil nil oline) - sql-output-newline-count (1- sql-output-newline-count) - did-filter t)) - + (string-match start-re oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count) + prompt-found t))) + + ;; If we've found all the expected prompts, stop looking (if (= sql-output-newline-count 0) (setq sql-output-newline-count nil oline (concat "\n" oline)) + ;; Still more possible prompts, leave them for the next pass (setq sql-preoutput-hold oline - oline "")) + oline ""))) - (unless did-filter - (setq oline (or sql-preoutput-hold "") - sql-preoutput-hold nil - sql-output-newline-count nil))) + ;; If no prompts were found, stop looking + (unless prompt-found + (setq sql-output-newline-count nil + oline (concat oline sql-preoutput-hold) + sql-preoutput-hold "")) - (setq sql-output-newline-count nil)) - - oline)) + ;; Break up output by physical lines if we haven't hit the final prompt + (unless (and (not (string= oline "")) + (string-match (sql-ends-with-prompt-re) oline) + (>= (match-end 0) (length oline))) + (setq last-nl 0) + (while (string-match "\n" oline last-nl) + (setq last-nl (match-end 0))) + (setq sql-preoutput-hold (concat (substring oline last-nl) + sql-preoutput-hold) + oline (substring oline 0 last-nl)))))) + oline) ;;; Sending the region to the SQLi buffer. @@ -3320,7 +3372,7 @@ to avoid deleting non-prompt output." (if sql-send-terminator (sql-send-magic-terminator sql-buffer s sql-send-terminator)) - (message "Sent string to buffer %s." sql-buffer))) + (message "Sent string to buffer %s" sql-buffer))) ;; Display the sql buffer (if sql-pop-to-buffer-after-send-region @@ -3328,7 +3380,7 @@ to avoid deleting non-prompt output." (display-buffer sql-buffer))) ;; We don't have no stinkin' sql - (message "No SQL process started.")))) + (user-error "No SQL process started")))) (defun sql-send-region (start end) "Send a region to the SQL process." @@ -3421,7 +3473,7 @@ list of SQLi command strings." (when visible (message "Executing SQL command...")) (if (consp command) - (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) + (mapc #'(lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) command) (sql-redirect-one sqlbuf command outbuf save-prior)) (when visible @@ -3435,7 +3487,8 @@ list of SQLi command strings." :prompt-regexp)) (start nil)) (with-current-buffer buf - (setq view-read-only nil) + (setq-local view-no-disable-on-exit t) + (read-only-mode -1) (unless save-prior (erase-buffer)) (goto-char (point-max)) @@ -3498,11 +3551,11 @@ for each match." (match-string regexp-groups)) ;; list of numbers; return the specified matches only ((consp regexp-groups) - (mapcar (lambda (c) - (cond - ((numberp c) (match-string c)) - ((stringp c) (match-substitute-replacement c)) - (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c)))) + (mapcar #'(lambda (c) + (cond + ((numberp c) (match-string c)) + ((stringp c) (match-substitute-replacement c)) + (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c)))) regexp-groups)) ;; String is specified; return replacement string ((stringp regexp-groups) @@ -3528,15 +3581,15 @@ strings are formatted with ARG and executed. If the results are empty the OUTBUF is deleted, otherwise the buffer is popped into a view window." (mapc - (lambda (c) - (cond - ((stringp c) - (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t) - ((functionp c) - (apply c sqlbuf outbuf enhanced arg nil)) - (t (error "Unknown sql-execute item %s" c)))) + #'(lambda (c) + (cond + ((stringp c) + (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t) + ((functionp c) + (apply c sqlbuf outbuf enhanced arg nil)) + (t (error "Unknown sql-execute item %s" c)))) (if (consp command) command (cons command nil))) - + (setq outbuf (get-buffer outbuf)) (if (zerop (buffer-size outbuf)) (kill-buffer outbuf) @@ -3544,18 +3597,18 @@ buffer is popped into a view window." (get-lru-window)))) (with-current-buffer outbuf (set-buffer-modified-p nil) - (setq view-read-only t)) - (view-buffer-other-window outbuf) + (read-only-mode +1)) + (pop-to-buffer outbuf) (when one-win (shrink-window-if-larger-than-buffer))))) (defun sql-execute-feature (sqlbuf outbuf feature enhanced arg) "List objects or details in a separate display buffer." - (let (command) - (with-current-buffer sqlbuf - (setq command (sql-get-product-feature sql-product feature))) + (let (command + (product (buffer-local-value 'sql-product (get-buffer sqlbuf)))) + (setq command (sql-get-product-feature product feature)) (unless command - (error "%s does not support %s" sql-product feature)) + (error "%s does not support %s" product feature)) (when (consp command) (setq command (if enhanced (cdr command) @@ -3582,7 +3635,7 @@ The list is maintained in SQL interactive buffers.") (apply f (current-buffer) (cons schema nil))) cl) (unless (member e cl) (setq cl (cons e cl)))) - (sort cl (function string<))))))) + (sort cl #'string<)))))) (defun sql-build-completions (schema) "Generate a list of names in the database for use as completions." @@ -3631,13 +3684,16 @@ The list is maintained in SQL interactive buffers.") (buffer-substring-no-properties (match-beginning 0) (match-end 0)))) (sql-completion-sqlbuf (sql-find-sqli-buffer)) - (product (with-current-buffer sql-completion-sqlbuf sql-product)) + (product (when sql-completion-sqlbuf + (with-current-buffer sql-completion-sqlbuf sql-product))) (completion-ignore-case t)) - (if (sql-get-product-feature product :completion-object) - (completing-read prompt #'sql--completion-table - nil nil tname) - (read-from-minibuffer prompt tname)))) + (if product + (if (sql-get-product-feature product :completion-object) + (completing-read prompt #'sql--completion-table + nil nil tname) + (read-from-minibuffer prompt tname)) + (user-error "There is no active SQLi buffer")))) (defun sql-list-all (&optional enhanced) "List all database objects. @@ -3646,7 +3702,7 @@ details or extends the listing to include other schemas objects." (interactive "P") (let ((sqlbuf (sql-find-sqli-buffer))) (unless sqlbuf - (error "No SQL interactive buffer found")) + (user-error "No SQL interactive buffer found")) (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil) (with-current-buffer sqlbuf ;; Contains the name of database objects @@ -3662,9 +3718,9 @@ ENHANCED, displays additional details about each column." current-prefix-arg)) (let ((sqlbuf (sql-find-sqli-buffer))) (unless sqlbuf - (error "No SQL interactive buffer found")) + (user-error "No SQL interactive buffer found")) (unless name - (error "No table name specified")) + (user-error "No table name specified")) (sql-execute-feature sqlbuf (format "*List %s*" name) :list-table enhanced name))) @@ -3720,7 +3776,9 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) + ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly + (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 (add-hook 'hack-local-variables-hook 'sql-highlight-product t t)) @@ -3898,7 +3956,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." "Read a connection name." (let ((completion-ignore-case t)) (completing-read prompt - (mapcar (lambda (c) (car c)) + (mapcar #'(lambda (c) (car c)) sql-connection-alist) nil t initial 'sql-connection-history default))) @@ -3917,7 +3975,7 @@ is specified in the connection settings." (if sql-connection-alist (list (sql-read-connection "Connection: " nil '(nil)) current-prefix-arg) - nil)) + (user-error "No SQL Connections defined"))) ;; Are there connections defined (if sql-connection-alist @@ -3941,27 +3999,27 @@ is specified in the connection settings." ;; Params in the connection (setq set-params (mapcar - (lambda (v) - (pcase (car v) - (`sql-user 'user) - (`sql-password 'password) - (`sql-server 'server) - (`sql-database 'database) - (`sql-port 'port) - (s s))) + #'(lambda (v) + (pcase (car v) + (`sql-user 'user) + (`sql-password 'password) + (`sql-server 'server) + (`sql-database 'database) + (`sql-port 'port) + (s s))) (cdr connect-set))) ;; the remaining params (w/o the connection params) (setq rem-params (sql-for-each-login login-params - (lambda (token plist) - (unless (member token set-params) - (if plist (cons token plist) token))))) + #'(lambda (token plist) + (unless (member token set-params) + (if plist (cons token plist) token))))) ;; Set the parameters and start the interactive session (mapc - (lambda (vv) - (set-default (car vv) (eval (cadr vv)))) + #'(lambda (vv) + (set-default (car vv) (eval (cadr vv)))) (cdr connect-set)) (setq-default sql-connection connection) @@ -3969,10 +4027,10 @@ is specified in the connection settings." (eval `(let ((,param-var ',rem-params)) (sql-product-interactive ',sql-product ',new-name)))) - (message "SQL Connection <%s> does not exist" connection) + (user-error "SQL Connection <%s> does not exist" connection) nil))) - (message "No SQL Connections defined") + (user-error "No SQL Connections defined") nil)) (defun sql-save-connection (name) @@ -3984,7 +4042,7 @@ optionally is saved to the user's init file." (interactive "sNew connection name: ") (unless (derived-mode-p 'sql-interactive-mode) - (error "Not in a SQL interactive mode!")) + (user-error "Not in a SQL interactive mode!")) ;; Capture the buffer local settings (let* ((buf (current-buffer)) @@ -4009,18 +4067,18 @@ optionally is saved to the user's init file." ;; Add the new connection if it doesn't exist (if (assoc name alist) - (message "Connection <%s> already exists" name) + (user-error "Connection <%s> already exists" name) (setq connect (cons name (sql-for-each-login `(product ,@login) - (lambda (token _plist) - (pcase token - (`product `(sql-product ',product)) - (`user `(sql-user ,user)) - (`database `(sql-database ,database)) - (`server `(sql-server ,server)) - (`port `(sql-port ,port))))))) + #'(lambda (token _plist) + (pcase token + (`product `(sql-product ',product)) + (`user `(sql-user ,user)) + (`database `(sql-database ,database)) + (`server `(sql-server ,server)) + (`port `(sql-port ,port))))))) (setq alist (append alist (list connect))) @@ -4033,21 +4091,20 @@ optionally is saved to the user's init file." "Generate menu entries for using each connection." (append (mapcar - (lambda (conn) - (vector - (format "Connection <%s>\t%s" (car conn) - (let ((sql-user "") (sql-database "") - (sql-server "") (sql-port 0)) - (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name))))) - (list 'sql-connect (car conn)) - t)) + #'(lambda (conn) + (vector + (format "Connection <%s>\t%s" (car conn) + (let ((sql-user "") (sql-database "") + (sql-server "") (sql-port 0)) + (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name))))) + (list 'sql-connect (car conn)) + t)) sql-connection-alist) tail)) ;;; Entry functions for different SQL interpreters. - ;;;###autoload (defun sql-product-interactive (&optional product new-name) "Run PRODUCT interpreter as an inferior process. @@ -4094,14 +4151,15 @@ the call to \\[sql-product-interactive] with ;; We have a new name or sql-buffer doesn't exist or match ;; Start by remembering where we start (let ((start-buffer (current-buffer)) - new-sqli-buffer) + new-sqli-buffer rpt) ;; Get credentials. (apply #'sql-get-login (sql-get-product-feature product :sqli-login)) ;; Connect to database. - (message "Login...") + (setq rpt (make-progress-reporter "Login")) + (let ((sql-user (default-value 'sql-user)) (sql-password (default-value 'sql-password)) (sql-server (default-value 'sql-server)) @@ -4131,16 +4189,26 @@ the call to \\[sql-product-interactive] with ;; Make sure the connection is complete ;; (Sometimes start up can be slow) ;; and call the login hook - (let ((proc (get-buffer-process new-sqli-buffer))) + (let ((proc (get-buffer-process new-sqli-buffer)) + (secs sql-login-delay) + (step 0.3)) (while (and (memq (process-status proc) '(open run)) - (accept-process-output proc 2.5) + (or (accept-process-output proc step) + (<= 0.0 (setq secs (- secs step)))) (progn (goto-char (point-max)) - (not (looking-back sql-prompt-regexp)))))) - (run-hooks 'sql-login-hook) + (not (re-search-backward sql-prompt-regexp 0 t)))) + (progress-reporter-update rpt))) + + (goto-char (point-max)) + (when (re-search-backward sql-prompt-regexp nil t) + (run-hooks 'sql-login-hook)) + ;; All done. - (message "Login...done") - (pop-to-buffer new-sqli-buffer))))) - (message "No default SQL product defined. Set `sql-product'."))) + (progress-reporter-done rpt) + (pop-to-buffer new-sqli-buffer) + (goto-char (point-max)) + (current-buffer))))) + (user-error "No default SQL product defined. Set `sql-product'."))) (defun sql-comint (product params) "Set up a comint buffer to run the SQL processor. @@ -4164,7 +4232,7 @@ passed as command line arguments." (setq buf-name (format "SQL-%s%d" product i)))) (setq i (1+ i)))))) (set-buffer - (apply 'make-comint buf-name program nil params)))) + (apply #'make-comint buf-name program nil params)))) ;;;###autoload (defun sql-oracle (&optional buffer) @@ -4211,8 +4279,9 @@ The default comes from `process-coding-system-alist' and (setq parameter sql-user))) (if (and parameter (not (string= "" sql-database))) (setq parameter (concat parameter "@" sql-database))) + ;; options must appear before the logon parameters (if parameter - (setq parameter (nconc (list parameter) options)) + (setq parameter (append options (list parameter))) (setq parameter options)) (sql-comint product parameter) ;; Set process coding system to agree with the interpreter @@ -4256,7 +4325,7 @@ The default comes from `process-coding-system-alist' and ;; (append - ;; (apply 'concat (append + ;; (apply #'concat (append ;; '("SET") ;; option value... @@ -4304,8 +4373,8 @@ The default comes from `process-coding-system-alist' and ;; Remove any settings that haven't changed (mapc - (lambda (one-cur-setting) - (setq saved-settings (delete one-cur-setting saved-settings))) + #'(lambda (one-cur-setting) + (setq saved-settings (delete one-cur-setting saved-settings))) (sql-oracle-save-settings sqlbuf)) ;; Restore the changed settings @@ -4822,10 +4891,10 @@ Try to set `comint-output-filter-functions' like this: (sql-redirect sqlbuf "\\a")) ;; Return the list of table names (public schema name can be omitted) - (mapcar (lambda (tbl) - (if (string= (car tbl) "public") - (cadr tbl) - (format "%s.%s" (car tbl) (cadr tbl)))) + (mapcar #'(lambda (tbl) + (if (string= (car tbl) "public") + (cadr tbl) + (format "%s.%s" (car tbl) (cadr tbl)))) cl)))) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 80e632c6ef6..f9efa3732c7 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -1,6 +1,6 @@ ;;; subword.el --- Handling capitalized subwords in a nomenclature -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Masatake YAMATO @@ -26,7 +26,8 @@ ;; This package provides `subword' oriented commands and a minor mode ;; (`subword-mode') that substitutes the common word handling -;; functions with them. +;; functions with them. It also provides the `superword-mode' minor +;; mode that treats symbols as words, the opposite of `subword-mode'. ;; In spite of GNU Coding Standards, it is popular to name a symbol by ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", @@ -43,12 +44,13 @@ ;; The subword oriented commands defined in this package recognize ;; subwords in a nomenclature to move between them and to edit them as -;; words. +;; words. You also get a mode to treat symbols as words instead, +;; called `superword-mode' (the opposite of `subword-mode'). ;; In the minor mode, all common key bindings for word oriented ;; commands are overridden by the subword oriented commands: -;; Key Word oriented command Subword oriented command +;; Key Word oriented command Subword oriented command (also superword) ;; ============================================================ ;; M-f `forward-word' `subword-forward' ;; M-b `backward-word' `subword-backward' @@ -67,8 +69,13 @@ ;; To make the mode turn on automatically, put the following code in ;; your .emacs: ;; -;; (add-hook 'c-mode-common-hook -;; (lambda () (subword-mode 1))) +;; (add-hook 'c-mode-common-hook 'subword-mode) +;; + +;; To make the mode turn `superword-mode' on automatically for +;; only some modes, put the following code in your .emacs: +;; +;; (add-hook 'c-mode-common-hook 'superword-mode) ;; ;; Acknowledgment: @@ -87,7 +94,7 @@ "Function to call for backward subword movement.") (defvar subword-forward-regexp - "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)" + "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)" "Regexp used by `subword-forward-internal'.") (defvar subword-backward-regexp @@ -98,7 +105,8 @@ (let ((map (make-sparse-keymap))) (dolist (cmd '(forward-word backward-word mark-word kill-word backward-kill-word transpose-words - capitalize-word upcase-word downcase-word)) + capitalize-word upcase-word downcase-word + left-word right-word)) (let ((othercmd (let ((name (symbol-name cmd))) (string-match "\\([[:alpha:]-]+\\)-word[s]?" name) (intern (concat "subword-" (match-string 1 name)))))) @@ -133,21 +141,21 @@ subwords in a nomenclature to move between subwords and to edit them as words. \\{subword-mode-map}" - nil - nil - subword-mode-map) + :lighter " ," + (when subword-mode (superword-mode -1))) (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") ;;;###autoload (define-global-minor-mode global-subword-mode subword-mode - (lambda () (subword-mode 1))) + (lambda () (subword-mode 1)) + :group 'convenience) (defun subword-forward (&optional arg) "Do the same as `forward-word' but on subwords. See the command `subword-mode' for a description of subwords. Optional argument ARG is the same as for `forward-word'." - (interactive "p") + (interactive "^p") (unless arg (setq arg 1)) (cond ((< 0 arg) @@ -165,9 +173,23 @@ Optional argument ARG is the same as for `forward-word'." "Do the same as `backward-word' but on subwords. See the command `subword-mode' for a description of subwords. Optional argument ARG is the same as for `backward-word'." - (interactive "p") + (interactive "^p") (subword-forward (- (or arg 1)))) +(defun subword-right (&optional arg) + "Do the same as `right-word' but on subwords." + (interactive "^p") + (if (eq (current-bidi-paragraph-direction) 'left-to-right) + (subword-forward arg) + (subword-backward arg))) + +(defun subword-left (&optional arg) + "Do the same as `left-word' but on subwords." + (interactive "^p") + (if (eq (current-bidi-paragraph-direction) 'left-to-right) + (subword-backward arg) + (subword-forward arg))) + (defun subword-mark (arg) "Do the same as `mark-word' but on subwords. See the command `subword-mode' for a description of subwords. @@ -235,60 +257,99 @@ Optional argument ARG is the same as for `upcase-word'." See the command `subword-mode' for a description of subwords. Optional argument ARG is the same as for `capitalize-word'." (interactive "p") - (let ((count (abs arg)) - (start (point)) - (advance (if (< arg 0) nil t))) - (dotimes (i count) - (if advance - (progn (re-search-forward - (concat "[[:alpha:]]") - nil t) - (goto-char (match-beginning 0))) - (subword-backward)) - (let* ((p (point)) - (pp (1+ p)) - (np (subword-forward))) - (upcase-region p pp) - (downcase-region pp np) - (goto-char (if advance np p)))) - (unless advance - (goto-char start)))) + (condition-case nil + (let ((count (abs arg)) + (start (point)) + (advance (>= arg 0))) + (dotimes (i count) + (if advance + (progn + (re-search-forward "[[:alpha:]]") + (goto-char (match-beginning 0))) + (subword-backward)) + (let* ((p (point)) + (pp (1+ p)) + (np (subword-forward))) + (upcase-region p pp) + (downcase-region pp np) + (goto-char (if advance np p)))) + (unless advance + (goto-char start))) + (search-failed nil))) + + + +(defvar superword-mode-map subword-mode-map + "Keymap used in `superword-mode' minor mode.") + +;;;###autoload +(define-minor-mode superword-mode + "Toggle superword movement and editing (Superword mode). +With a prefix argument ARG, enable Superword mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +Superword mode is a buffer-local minor mode. Enabling it remaps +word-based editing commands to superword-based commands that +treat symbols as words, e.g. \"this_is_a_symbol\". + +The superword oriented commands activated in this minor mode +recognize symbols as superwords to move between superwords and to +edit them as words. + +\\{superword-mode-map}" + :lighter " ²" + (when superword-mode (subword-mode -1))) + +;;;###autoload +(define-global-minor-mode global-superword-mode superword-mode + (lambda () (superword-mode 1)) + :group 'convenience) ;; ;; Internal functions ;; (defun subword-forward-internal () - (if (and - (save-excursion - (let ((case-fold-search nil)) - (re-search-forward subword-forward-regexp nil t))) - (> (match-end 0) (point))) - (goto-char - (cond - ((< 1 (- (match-end 2) (match-beginning 2))) - (1- (match-end 2))) - (t - (match-end 0)))) - (forward-word 1))) - + (if superword-mode + (forward-symbol 1) + (if (and + (save-excursion + (let ((case-fold-search nil)) + (re-search-forward subword-forward-regexp nil t))) + (> (match-end 0) (point))) + (goto-char + (cond + ((and (< 1 (- (match-end 2) (match-beginning 2))) + ;; If we have an all-caps word with no following lower-case or + ;; non-word letter, don't leave the last char (bug#13758). + (not (and (null (match-beginning 3)) + (eq (match-end 2) (match-end 1))))) + (1- (match-end 2))) + (t + (match-end 0)))) + (forward-word 1)))) (defun subword-backward-internal () - (if (save-excursion - (let ((case-fold-search nil)) - (re-search-backward subword-backward-regexp nil t))) - (goto-char - (cond - ((and (match-end 3) - (< 1 (- (match-end 3) (match-beginning 3))) - (not (eq (point) (match-end 3)))) - (1- (match-end 3))) - (t - (1+ (match-beginning 0))))) - (backward-word 1))) + (if superword-mode + (forward-symbol -1) + (if (save-excursion + (let ((case-fold-search nil)) + (re-search-backward subword-backward-regexp nil t))) + (goto-char + (cond + ((and (match-end 3) + (< 1 (- (match-end 3) (match-beginning 3))) + (not (eq (point) (match-end 3)))) + (1- (match-end 3))) + (t + (1+ (match-beginning 0))))) + (backward-word 1)))) + (provide 'subword) +(provide 'superword) ;;; subword.el ends here diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 9169a433015..c98c20424d7 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1,8 +1,8 @@ ;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994, 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1998-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Author: Tom Tromey ;; Chris Lindblad ;; Keywords: languages tcl modes @@ -151,7 +151,7 @@ to take place: 6. Move backward to start of comment, indenting if necessary." :type '(choice (const :tag "Always" t) (const :tag "Beginning only" nil) - (const :tag "Maybe move or make or delete comment" 'tcl)) + (other :tag "Maybe move or make or delete comment" tcl)) :group 'tcl) @@ -266,7 +266,7 @@ quoted for Tcl." ;; Maybe someone has a better set? (let ((map (make-sparse-keymap))) ;; Will inherit from `comint-mode-map' thanks to define-derived-mode. - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) (define-key map "\M-?" 'comint-dynamic-list-filename-completions) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\M-\C-x" 'tcl-eval-defun) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 7b59faca261..069e7119b90 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1,6 +1,6 @@ ;;; vera-mode.el --- major mode for editing Vera files -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Reto Zimmermann ;; Maintainer: Reto Zimmermann @@ -101,6 +101,8 @@ select and move operations. All parts of an identifier separated by underscore are treated as single words otherwise." :type 'boolean :group 'vera) +(make-obsolete-variable 'vera-underscore-is-part-of-word + 'superword-mode "24.4") (defcustom vera-intelligent-tab t "Non-nil means `TAB' does indentation, word completion and tab insertion. @@ -1353,6 +1355,11 @@ If `vera-intelligent-tab' is nil, always indent line." (defvar vera-expand-upper-case nil) (eval-when-compile (require 'hippie-exp)) +(declare-function he-init-string "hippie-exp" (beg end)) +(declare-function he-dabbrev-beg "hippie-exp" ()) +(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) +(declare-function he-reset-string "hippie-exp" ()) +(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) (defun vera-try-expand-abbrev (old) "Try expanding abbreviations from `vera-abbrev-list'." diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 5571a905f85..ee5f8cb046b 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -1,13 +1,12 @@ -;; verilog-mode.el --- major mode for editing verilog source in Emacs +;;; verilog-mode.el --- major mode for editing verilog source in Emacs -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. -;; Author: Michael McNamara (mac@verilog.com), -;; Wilson Snyder (wsnyder@wsnyder.org) -;; Please see our web sites: +;; Author: Michael McNamara +;; Wilson Snyder ;; http://www.verilog.com ;; http://www.veripool.org -;; +;; Created: 3 Jan 1996 ;; Keywords: languages ;; Yoni Rabkin contacted the maintainer of this @@ -38,25 +37,26 @@ ;;; Commentary: -;; This mode borrows heavily from the Pascal-mode and the cc-mode of Emacs - ;; USAGE ;; ===== -;; A major mode for editing Verilog HDL source code. When you have -;; entered Verilog mode, you may get more info by pressing C-h m. You -;; may also get online help describing various functions by: C-h f -;; +;; A major mode for editing Verilog and SystemVerilog HDL source code (IEEE +;; 1364-2005 and IEEE 1800-2012 standards). When you have entered Verilog +;; mode, you may get more info by pressing C-h m. You may also get online +;; help describing various functions by: C-h f ;; KNOWN BUGS / BUG REPORTS ;; ======================= -;; Verilog is a rapidly evolving language, and hence this mode is -;; under continuous development. Hence this is beta code, and likely -;; has bugs. Please report any issues to the issue tracker at -;; http://www.veripool.org/verilog-mode +;; SystemVerilog is a rapidly evolving language, and hence this mode is +;; under continuous development. Please report any issues to the issue +;; tracker at +;; +;; http://www.veripool.org/verilog-mode +;; ;; Please use verilog-submit-bug-report to submit a report; type C-c -;; C-b to invoke this and as a result I will have a much easier time +;; C-b to invoke this and as a result we will have a much easier time ;; of reproducing the bug you find, and hence fixing it. ;; INSTALLING THE MODE @@ -110,8 +110,8 @@ ; verilog-indent-begin-after-if t ; verilog-auto-lineup 'declarations ; verilog-highlight-p1800-keywords nil -; verilog-linter "my_lint_shell_command" -; ) +; verilog-linter "my_lint_shell_command" +; ) ;; @@ -123,10 +123,8 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3) +(defconst verilog-mode-version "2013-11-05-78e66ba-vpo" "Version of this Verilog mode.") -(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3) - "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -165,12 +163,12 @@ (condition-case nil (if (fboundp 'store-match-data) nil ;; fab - (defmacro store-match-data (&rest args) nil)) + (defmacro store-match-data (&rest _args) nil)) (error nil)) (condition-case nil (if (fboundp 'char-before) nil ;; great - (defmacro char-before (&rest body) + (defmacro char-before (&rest _body) (char-after (1- (point))))) (error nil)) (condition-case nil @@ -212,23 +210,23 @@ STRING should be given if the last search was by `string-match' on STRING." (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ;; We've got what we needed ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro customize (&rest args) + (defmacro defgroup (&rest _args) nil) + (defmacro customize (&rest _args) (message "Sorry, Customize is not available with this version of Emacs")) - (defmacro defcustom (var value doc &rest args) + (defmacro defcustom (var value doc &rest _args) `(defvar ,var ,value ,doc)) ) (if (fboundp 'defface) nil ; great! - (defmacro defface (var values doc &rest args) + (defmacro defface (var values doc &rest _args) `(make-face ,var)) ) (if (and (featurep 'custom) (fboundp 'customize-group)) nil ;; We've got what we needed ;; We have an intermediate custom-library, hack around it! - (defmacro customize-group (var &rest args) + (defmacro customize-group (var &rest _args) `(customize ,var)) ) @@ -261,23 +259,23 @@ STRING should be given if the last search was by `string-match' on STRING." ;with just a two input regexp (defun verilog-regexp-opt (a b) "Deal with differing number of required arguments for `regexp-opt'. - Call 'regexp-opt' on A and B." - (regexp-opt a b 't)) + Call `regexp-opt' on A and B." + (regexp-opt a b t)) (error nil)) ) ((eq args 2) ;; It takes 2 (defun verilog-regexp-opt (a b) - "Call 'regexp-opt' on A and B." + "Call `regexp-opt' on A and B." (regexp-opt a b)) ) (t nil))) ;; We can't tell; assume it takes 2 (defun verilog-regexp-opt (a b) - "Call 'regexp-opt' on A and B." + "Call `regexp-opt' on A and B." (regexp-opt a b)) ) ;; There is no regexp-opt, provide our own - (defun verilog-regexp-opt (strings &optional paren shy) + (defun verilog-regexp-opt (strings &optional paren _shy) (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) (concat open (mapconcat 'regexp-quote strings "\\|") close))) ) @@ -501,14 +499,14 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." "Type of statements to lineup across multiple lines. If 'all' is selected, then all line ups described below are done. -If 'declaration', then just declarations are lined up with any +If 'declarations', then just declarations are lined up with any preceding declarations, taking into account widths and the like, so or example the code: - reg [31:0] a; - reg b; + reg [31:0] a; + reg b; would become - reg [31:0] a; - reg b; + reg [31:0] a; + reg b; If 'assignment', then assignments are lined up with any preceding assignments, so for example the code @@ -663,7 +661,7 @@ to see the effect as font color choices are cached by Emacs." (put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp) (defcustom verilog-highlight-grouping-keywords nil - "Non-nil means highlight grouping keywords 'begin' and 'end' more dramatically. + "Non-nil means highlight grouping keywords more dramatically. If false, these words are in the `font-lock-type-face'; if True then they are in `verilog-font-lock-ams-face'. Some find that special highlighting on these grouping constructs allow the structure of the code to be understood at a glance." @@ -960,11 +958,11 @@ See also `verilog-library-flags', `verilog-library-directories'." (put 'verilog-library-extensions 'safe-local-variable 'listp) (defcustom verilog-active-low-regexp nil - "If set, treat signals matching this regexp as active low. + "If true, treat signals matching this regexp as active low. This is used for AUTORESET and AUTOTIEOFF. For proper behavior, you will probably also need `verilog-auto-reset-widths' set." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-active-low-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-sense-include-inputs nil @@ -1003,7 +1001,7 @@ those temporaries reset. See example in `verilog-auto-reset'." "True means AUTORESET should determine the width of signals. This is then used to set the width of the zero (32'h0 for example). This is required by some lint tools that aren't smart enough to ignore widths of -the constant zero. This may result in ugly code when parameters determine +the constant zero. This may result in ugly code when parameters determine the MSB or LSB of a signal inside an AUTORESET. If nil, AUTORESET uses \"0\" as the constant. @@ -1062,7 +1060,7 @@ inputs. This is then used by an upper module: module ExampInst; InstModule - #(PARAM(10)) + #(.PARAM(10)) instName (/*AUTOINST*/ .i (i[PARAM-1:0])); @@ -1073,7 +1071,7 @@ instead expand to: module ExampInst; InstModule - #(PARAM(10)) + #(.PARAM(10)) instName (/*AUTOINST*/ .i (i[9:0]));" @@ -1129,37 +1127,37 @@ won't merge conflict." (defcustom verilog-auto-inst-interfaced-ports nil "Non-nil means include interfaced ports in AUTOINST expansions." + :version "24.3" ;; rev773, default change rev815 :group 'verilog-mode-auto - :type 'boolean - :version "24.3") + :type 'boolean) (put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-input-ignore-regexp nil - "If set, when creating AUTOINPUT list, ignore signals matching this regexp. + "If non-nil, when creating AUTOINPUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-inout-ignore-regexp nil - "If set, when creating AUTOINOUT list, ignore signals matching this regexp. + "If non-nil, when creating AUTOINOUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-output-ignore-regexp nil - "If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. + "If non-nil, when creating AUTOOUTPUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-template-warn-unused nil "Non-nil means report warning if an AUTO_TEMPLATE line is not used. This feature is not supported before Emacs 21.1 or XEmacs 21.4." + :version "24.3" ;;rev787 :group 'verilog-mode-auto - :version "24.3" :type 'boolean) (put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp) @@ -1173,24 +1171,33 @@ assignment, else the data type for variable creation." (put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp) (defcustom verilog-auto-tieoff-ignore-regexp nil - "If set, when creating AUTOTIEOFF list, ignore signals matching this regexp. + "If non-nil, when creating AUTOTIEOFF, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-unused-ignore-regexp nil - "If set, when creating AUTOUNUSED list, ignore signals matching this regexp. + "If non-nil, when creating AUTOUNUSED, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp) +(defcustom verilog-case-fold t + "Non-nil means `verilog-mode' regexps should ignore case. +This variable is t for backward compatibility; nil is suggested." + :version "24.4" + :group 'verilog-mode + :type 'boolean) +(put 'verilog-case-fold 'safe-local-variable 'verilog-booleanp) + (defcustom verilog-typedef-regexp nil "If non-nil, regular expression that matches Verilog-2001 typedef names. -For example, \"_t$\" matches typedefs named with _t, as in the C language." +For example, \"_t$\" matches typedefs named with _t, as in the C language. +See also `verilog-case-fold'." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-typedef-regexp 'safe-local-variable 'stringp) (defcustom verilog-mode-hook 'verilog-set-compile-command @@ -1230,14 +1237,14 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language." (defcustom verilog-before-save-font-hook nil "Hook run before `verilog-save-font-mods' removes highlighting." + :version "24.3" ;;rev735 :group 'verilog-mode-auto - :version "24.3" :type 'hook) (defcustom verilog-after-save-font-hook nil "Hook run after `verilog-save-font-mods' restores highlighting." + :version "24.3" ;;rev735 :group 'verilog-mode-auto - :version "24.3" :type 'hook) (defvar verilog-imenu-generic-expression @@ -1437,6 +1444,8 @@ If set will become buffer local.") :help "Help on AUTOASCIIENUM - creating ASCII for enumerations"] ["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport) :help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"] + ["AUTOINOUT" (describe-function 'verilog-auto-inout) + :help "Help on AUTOINOUT - adding inouts from cells"] ["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp) :help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"] ["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in) @@ -1447,12 +1456,10 @@ If set will become buffer local.") :help "Help on AUTOINOUTMODULE - copying i/o from another file"] ["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param) :help "Help on AUTOINOUTPARAM - copying parameters from another file"] - ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp) - :help "Help on AUTOINSERTLISP - insert text from a lisp function"] - ["AUTOINOUT" (describe-function 'verilog-auto-inout) - :help "Help on AUTOINOUT - adding inouts from cells"] ["AUTOINPUT" (describe-function 'verilog-auto-input) :help "Help on AUTOINPUT - adding inputs from cells"] + ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp) + :help "Help on AUTOINSERTLISP - insert text from a lisp function"] ["AUTOINST" (describe-function 'verilog-auto-inst) :help "Help on AUTOINST - adding pins for cells"] ["AUTOINST (.*)" (describe-function 'verilog-auto-star) @@ -1471,7 +1478,7 @@ If set will become buffer local.") :help "Help on AUTOREGINPUT - declaring inputs for non-wires"] ["AUTORESET" (describe-function 'verilog-auto-reset) :help "Help on AUTORESET - resetting always blocks"] - ["AUTOSENSE" (describe-function 'verilog-auto-sense) + ["AUTOSENSE or AS" (describe-function 'verilog-auto-sense) :help "Help on AUTOSENSE - sensitivity lists for always blocks"] ["AUTOTIEOFF" (describe-function 'verilog-auto-tieoff) :help "Help on AUTOTIEOFF - tying off unused outputs"] @@ -1505,8 +1512,10 @@ If set will become buffer local.") :help "Insert a module .. (/*AUTOARG*/);.. endmodule block"] ["OVM Class" verilog-sk-ovm-class :help "Insert an OVM class block"] - ["UVM Class" verilog-sk-uvm-class - :help "Insert an UVM class block"] + ["UVM Object" verilog-sk-uvm-object + :help "Insert an UVM object block"] + ["UVM Component" verilog-sk-uvm-component + :help "Insert an UVM component block"] ["Primitive" verilog-sk-primitive :help "Insert a primitive .. (.. );.. endprimitive block"] "----" @@ -1594,6 +1603,14 @@ If set will become buffer local.") (defsubst verilog-within-string () (nth 3 (parse-partial-sexp (point-at-bol) (point)))) +(defsubst verilog-string-match-fold (regexp string &optional start) + "Like `string-match', but use `verilog-case-fold'. +Return index of start of first match for REGEXP in STRING, or nil. +Matching ignores case if `verilog-case-fold' is non-nil. +If third arg START is non-nil, start search at that index in STRING." + (let ((case-fold-search verilog-case-fold)) + (string-match regexp string start))) + (defsubst verilog-string-replace-matches (from-string to-string fixedcase literal string) "Replace occurrences of FROM-STRING with TO-STRING. FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace. @@ -2438,7 +2455,7 @@ find the errors." ;; verilog-forward-sexp and verilog-calc-indent (defconst verilog-beg-block-re-ordered ( concat "\\(\\\\)" ;1 - "\\|\\(\\\\|\\(\\\\)" ; 2,3 + "\\|\\(\\\\|\\(\\\\)" ; 2,3 "\\|\\(\\(\\\\s-+\\|\\\\s-+\\)?fork\\>\\)" ;4,5 "\\|\\(\\\\)" ;6 "\\|\\(\\\\)" ;7 @@ -2570,6 +2587,9 @@ find the errors." (eval-when-compile (verilog-regexp-words `("initial" "final" "always" "always_comb" "always_latch" "always_ff" "function" "task")))) (defconst verilog-coverpoint-re "\\w+\\s*:\\s*\\(coverpoint\\|cross\\constraint\\)" ) +(defconst verilog-in-constraint-re ;; keywords legal in constraint blocks starting a statement/block + (eval-when-compile (verilog-regexp-words `("if" "else" "solve" "foreach")))) + (defconst verilog-indent-re (eval-when-compile (verilog-regexp-words @@ -2682,7 +2702,7 @@ find the errors." "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" )))) (defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>") -(defconst verilog-extended-case-re "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)") +(defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)") (defconst verilog-extended-complete-re (concat "\\(\\(\\\\s-+\\)?virtual\\s-+\\|\\\\|\\\\)\\)" "\\|\\(\\(\\\\s-+\\)*\\(\\\\|\\\\|\\\\)\\)" @@ -2766,6 +2786,8 @@ find the errors." "let" "nexttime" "reject_on" "restrict" "s_always" "s_eventually" "s_nexttime" "s_until" "s_until_with" "strong" "sync_accept_on" "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" + ;; 1800-2012 + "implements" "interconnect" "nettype" "soft" ) "List of Verilog keywords.") @@ -2784,7 +2806,9 @@ find the errors." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?` "w" table) + ;; FIXME: This goes against Emacs conventions. Use "_" syntax instead and + ;; then use regexps with things like "\\_<...\\_>". + (modify-syntax-entry ?` "w" table) ;; ` is part of definition symbols in Verilog (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\' "." table) @@ -2930,6 +2954,11 @@ See also `verilog-font-lock-extra-types'.") "sync_accept_on" "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ) nil ))) + (verilog-1800-2012-keywords + (eval-when-compile + (verilog-regexp-opt + '("implements" "interconnect" "nettype" "soft" ) nil ))) + (verilog-ams-keywords (eval-when-compile (verilog-regexp-opt @@ -2993,6 +3022,12 @@ See also `verilog-font-lock-extra-types'.") 'verilog-font-lock-p1800-face) (cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>") 'font-lock-type-face)) + ;; Fontify IEEE-1800-2012 keywords appropriately + (if verilog-highlight-p1800-keywords + (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>") + 'verilog-font-lock-p1800-face) + (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>") + 'font-lock-type-face)) ;; Fontify Verilog-AMS keywords (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") 'verilog-font-lock-ams-face))) @@ -3111,7 +3146,7 @@ to full text form for parsing. Additional actions may be specified with ;; Comment detection and caching (defvar verilog-scan-cache-preserving nil - "If set, the specified buffer's comment properties are static. + "If true, the specified buffer's comment properties are static. Buffer changes will be ignored. See `verilog-inside-comment-or-string-p' and `verilog-scan'.") @@ -3254,7 +3289,7 @@ inserted using a single call to `verilog-insert'." (defun verilog-point-text (&optional pointnum) "Return text describing where POINTNUM or current point is (for errors). Use filename, if current buffer being edited shorten to just buffer name." - (concat (or (and (equal (window-buffer (selected-window)) (current-buffer)) + (concat (or (and (equal (window-buffer) (current-buffer)) (buffer-name)) buffer-file-name (buffer-name)) @@ -3348,7 +3383,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq reg "\\(\\\\)\\|\\(\\\\)" )) ((match-end 2) ;; Search forward for matching endcase - (setq reg "\\(\\\\|\\(\\\\s-+\\|\\\\s-+\\)?\\[^:]\\)\\|\\(\\\\)" ) + (setq reg "\\(\\\\|\\(\\\\s-+\\|\\\\s-+\\)?\\[^:]\\)\\|\\(\\\\)" ) (setq md 3) ;; ender is third item in regexp ) ((match-end 4) @@ -3588,7 +3623,8 @@ Some other functions are: \\[verilog-sk-fork] Insert a fork begin .. end .. join block. \\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block. \\[verilog-sk-ovm-class] Insert an OVM Class block. - \\[verilog-sk-uvm-class] Insert an UVM Class block. + \\[verilog-sk-uvm-object] Insert an UVM Object block. + \\[verilog-sk-uvm-component] Insert an UVM Component block. \\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block. \\[verilog-sk-repeat] Insert a repeat (..) begin .. end block. \\[verilog-sk-specify] Insert a specify .. endspecify block. @@ -3621,7 +3657,7 @@ Key bindings specific to `verilog-mode-map' are: (set-syntax-table verilog-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'verilog-indent-line-relative) - (setq comment-indent-function 'verilog-comment-indent) + (set (make-local-variable 'comment-indent-function) 'verilog-comment-indent) (set (make-local-variable 'parse-sexp-ignore-comments) nil) (set (make-local-variable 'comment-start) "// ") (set (make-local-variable 'comment-end) "") @@ -4045,14 +4081,7 @@ Uses `verilog-scan' cache." (interactive) (verilog-re-search-forward verilog-end-defun-re nil 'move)) -(defun verilog-get-beg-of-defun (&optional warn) - (save-excursion - (cond ((verilog-re-search-forward-quick verilog-defun-re nil t) - (point)) - (t - (error "%s: Can't find module beginning" (verilog-point-text)) - (point-max))))) -(defun verilog-get-end-of-defun (&optional warn) +(defun verilog-get-end-of-defun () (save-excursion (cond ((verilog-re-search-forward-quick verilog-end-defun-re nil t) (point)) @@ -4060,9 +4089,8 @@ Uses `verilog-scan' cache." (error "%s: Can't find endmodule" (verilog-point-text)) (point-max))))) -(defun verilog-label-be (&optional arg) - "Label matching begin ... end, fork ... join and case ... endcase statements. -With ARG, first kill any existing labels." +(defun verilog-label-be () + "Label matching begin ... end, fork ... join and case ... endcase statements." (interactive) (let ((cnt 0) (oldpos (point)) @@ -4488,7 +4516,7 @@ primitive or interface named NAME." ((looking-at "\\") (setq str "randcase") (setq err nil)) - ((looking-at "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)") + ((looking-at "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)") (goto-char (match-end 0)) (setq str (concat (match-string 0) " " (verilog-get-expr))) (setq err nil)) @@ -5106,6 +5134,7 @@ Save the result unless optional NO-SAVE is t." (setq-default make-backup-files nil) (setq enable-local-variables t) (setq enable-local-eval t) + (setq create-lockfiles nil) ;; Make sure any sub-files we read get proper mode (setq-default major-mode 'verilog-mode) ;; Ditto files already read in @@ -5226,6 +5255,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (par 0) (begin (looking-at "[ \t]*begin\\>")) (lim (save-excursion (verilog-re-search-backward "\\(\\\\)\\|\\(\\\\)" nil t))) + (structres nil) (type (catch 'nesting ;; Keep working backwards until we can figure out ;; what type of statement this is. @@ -5244,8 +5274,12 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (looking-at "[ \t]*`vmm_"))))) (throw 'nesting 'directive)) ;; indent structs as if there were module level - (if (verilog-in-struct-p) - (throw 'nesting 'block)) + (setq structres (verilog-in-struct-nested-p)) + (cond ((not structres) nil) + ;;((and structres (equal (char-after) ?\})) (throw 'nesting 'struct-close)) + ((> structres 0) (throw 'nesting 'nested-struct)) + ((= structres 0) (throw 'nesting 'block)) + (t nil)) ;; if we are in a parenthesized list, and the user likes to indent these, return. ;; unless we are in the newfangled coverpoint or constraint blocks @@ -5262,7 +5296,9 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ;; trap out if we crawl off the top of the buffer (if (bobp) (throw 'nesting 'cpp)) - (if (verilog-continued-line-1 lim) + (if (and (verilog-continued-line-1 lim) + (or (not (verilog-in-coverage-p)) + (looking-at verilog-in-constraint-re) )) ;; may still get hosed if concat in constraint (let ((sp (point))) (if (and (not (looking-at verilog-complete-reg)) @@ -5271,10 +5307,15 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (throw 'nesting 'cexp)) (goto-char sp)) - + (if (and (verilog-in-coverage-p) + (looking-at verilog-in-constraint-re)) + (progn + (beginning-of-line) + (skip-chars-forward " \t") + (throw 'nesting 'constraint))) (if (and begin - (not verilog-indent-begin-after-if) - (looking-at verilog-no-indent-begin-re)) + (not verilog-indent-begin-after-if) + (looking-at verilog-no-indent-begin-re)) (progn (beginning-of-line) (skip-chars-forward " \t") @@ -5371,6 +5412,10 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (list type (current-column))) ((eq type 'defun) (list type 0)) + ((eq type 'constraint) + (list 'block (current-column))) + ((eq type 'nested-struct) + (list 'block structres)) (t (list type (verilog-current-indent-level)))))))) @@ -5399,23 +5444,32 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (t (setq depth (verilog-current-indent-level))))) (message "You are at nesting %s depth %d" type depth)))) + (defun verilog-calc-1 () (catch 'nesting - (let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)"))) + (let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)")) + (inconstraint (verilog-in-coverage-p))) (while (verilog-re-search-backward re nil 'move) (catch 'continue (cond ((equal (char-after) ?\{) + ;; block type returned based on outer constraint { or inner (if (verilog-at-constraint-p) - (throw 'nesting 'block))) - + (cond (inconstraint (throw 'nesting 'constraint)) + (t (throw 'nesting 'statement))))) ((equal (char-after) ?\}) - (let ((there (verilog-at-close-constraint-p))) + (let (par-pos + (there (verilog-at-close-constraint-p))) (if there ;; we are at the } that closes a constraint. Find the { that opens it (progn - (forward-char 1) - (backward-list 1) - (verilog-beg-of-statement))))) + (if (> (verilog-in-paren-count) 0) + (forward-char 1)) + (setq par-pos (verilog-parenthesis-depth)) + (cond (par-pos + (goto-char par-pos) + (forward-char 1)) + (t + (backward-char 1))))))) ((looking-at verilog-beg-block-re-ordered) (cond @@ -5533,7 +5587,7 @@ of the appropriate enclosing block." (while (/= 0 nest) (verilog-re-search-backward (concat - "\\(\\\\|\\(\\\\)" + "\\(\\\\|\\(\\\\)" "\\|\\(\\\\)" ) nil 'move) (cond @@ -5949,6 +6003,14 @@ May cache result using `verilog-syntax-ppss'." (let ((state (save-excursion (verilog-syntax-ppss)))) (> (nth 0 state) 0 ))) +(defun verilog-in-paren-count () + "Return paren depth, floor to 0. +May cache result using `verilog-syntax-ppss'." + (let ((state (save-excursion (verilog-syntax-ppss)))) + (if (> (nth 0 state) 0) + (nth 0 state) + 0 ))) + (defun verilog-in-paren-quick () "Return true if in a parenthetical expression. Always starts from `point-min', to allow inserts with hooks disabled." @@ -5968,6 +6030,21 @@ Always starts from `point-min', to allow inserts with hooks disabled." ) nil))) +(defun verilog-in-struct-nested-p () + "Return nil for not in struct. +Return 0 for in non-nested struct. +Return >0 for nested struct." + (interactive) + (let (col) + (save-excursion + (if (verilog-in-paren) + (progn + (verilog-backward-up-list 1) + (setq col (verilog-at-struct-mv-p)) + (if col + (if (verilog-in-struct-p) (current-column) 0))) + nil)))) + (defun verilog-in-coverage-p () "Return true if in a constraint or coverpoint expression." (interactive) @@ -5982,11 +6059,13 @@ Always starts from `point-min', to allow inserts with hooks disabled." "If at the } that closes a constraint or covergroup, return true." (if (and (equal (char-after) ?\}) - (verilog-in-paren)) + (verilog-in-coverage-p)) (save-excursion (verilog-backward-ws&directives) - (if (equal (char-before) ?\;) + (if (or (equal (char-before) ?\;) + (equal (char-before) ?\}) ;; can end with inner constraint { } block or ; + (equal (char-before) ?\{)) ;; empty constraint block (point) nil)))) @@ -5998,20 +6077,64 @@ Always starts from `point-min', to allow inserts with hooks disabled." (forward-list) (progn (backward-char 1) (verilog-backward-ws&directives) - (equal (char-before) ?\;)))) - ;; maybe - (verilog-re-search-backward "\\" nil 'move) + (or (equal (char-before) ?\{) ;; empty case + (equal (char-before) ?\;) + (equal (char-before) ?\}))))) + (progn + (let ( (pt (point)) (pass 0)) + (verilog-backward-ws&directives) + (verilog-backward-token) + (if (looking-at (concat "\\\\|" verilog-in-constraint-re)) + (progn (setq pass 1) + (if (looking-at "\\") + (progn (verilog-backward-ws&directives) + (beginning-of-line) ;; 1 + (verilog-forward-ws&directives) + 1 ) + (verilog-beg-of-statement) + )) + ;; if first word token not keyword, it maybe the instance name + ;; check next word token + (if (looking-at "\\<\\w+\\>\\|\\s-*(\\s-*\\w+") + (progn (verilog-beg-of-statement) + (if (looking-at (concat "\\<\\(constraint\\|" + "\\(?:\\w+\\s-*:\\s-*\\)?\\(coverpoint\\|cross\\)" + "\\|with\\)\\>\\|" verilog-in-constraint-re)) + (setq pass 1))))) + (if (eq pass 0) + (progn (goto-char pt) nil) 1))) ;; not nil)) (defun verilog-at-struct-p () - "If at the { of a struct, return true, moving point to struct." + "If at the { of a struct, return true, not moving point." (save-excursion (if (and (equal (char-after) ?\{) (verilog-backward-token)) (looking-at "\\") nil))) +(defun verilog-at-struct-mv-p () + "If at the { of a struct, return true, moving point to struct." + (let ((pt (point))) + (if (and (equal (char-after) ?\{) + (verilog-backward-token)) + (if (looking-at "\\") + (progn (verilog-beg-of-statement) (point)) + (progn (goto-char pt) nil)) + (progn (goto-char pt) nil)))) + +(defun verilog-at-close-struct-p () + "If at the } that closes a struct, return true." + (if (and + (equal (char-after) ?\}) + (verilog-in-struct-p)) + ;; true + (save-excursion + (if (looking-at "}\\(?:\\s-*\\w+\\s-*\\)?;") 1)) + ;; false + nil)) + (defun verilog-parenthesis-depth () "Return non zero if in parenthetical-expression." (save-excursion (nth 1 (verilog-syntax-ppss)))) @@ -6245,8 +6368,9 @@ Only look at a few lines to determine indent level." (;-- Handle the ends (or - (looking-at verilog-end-block-re ) - (verilog-at-close-constraint-p)) + (looking-at verilog-end-block-re) + (verilog-at-close-constraint-p) + (verilog-at-close-struct-p)) (let ((val (if (eq type 'statement) (- ind verilog-indent-level) ind))) @@ -6355,9 +6479,9 @@ Do not count named blocks or case-statements." (looking-at "\*"))) (insert "* "))))) -(defun verilog-comment-indent (&optional arg) +(defun verilog-comment-indent (&optional _arg) "Return the column number the line should be indented to. -ARG is ignored, for `comment-indent-function' compatibility." +_ARG is ignored, for `comment-indent-function' compatibility." (cond ((verilog-in-star-comment-p) (save-excursion @@ -6519,8 +6643,8 @@ Be verbose about progress unless optional QUIET set." (forward-line 1)) (unless quiet (message ""))))))) -(defun verilog-pretty-expr (&optional quiet myre) - "Line up expressions around point, optionally QUIET with regexp MYRE ignored." +(defun verilog-pretty-expr (&optional quiet _myre) + "Line up expressions around point, optionally QUIET with regexp _MYRE ignored." (interactive) (if (not (verilog-in-comment-or-string-p)) (save-excursion @@ -6757,8 +6881,7 @@ Region is defined by B and EDPOS." ((b (prog2 (beginning-of-line) (point-marker) - (end-of-line))) - (e (point-marker))) + (end-of-line)))) (if (re-search-backward " /\\* \[#-\]# \[a-zA-Z\]+ \[0-9\]+ ## \\*/" b t) (progn (replace-match " /* -# ## */") @@ -6950,24 +7073,6 @@ for matches of `str' and adding the occurrence tp `all' through point END." (forward-line 1))) verilog-all) -(defun verilog-type-completion () - "Calculate all possible completions for types." - (let ((start (point)) - goon) - ;; Search for all reachable type declarations - (while (or (verilog-beg-of-defun) - (setq goon (not goon))) - (save-excursion - (if (and (< start (prog1 (save-excursion (verilog-end-of-defun) - (point)) - (forward-char 1))) - (verilog-re-search-forward - "\\\\|\\<\\(begin\\|function\\|procedure\\)\\>" - start t) - (not (match-end 1))) - ;; Check current type declaration - (verilog-get-completion-decl start)))))) - (defun verilog-var-completion () "Calculate all possible completions for variables (or constants)." (let ((start (point))) @@ -7051,6 +7156,7 @@ exact match, nil otherwise." ;; Return nil if there was no matching label nil ;; Get longest string common in the labels + ;; FIXME: Why not use `try-completion'? (let* ((elm (cdr verilog-all)) (match (car verilog-all)) (min (length match)) @@ -7087,6 +7193,7 @@ exact match, nil otherwise." "Complete word at current point. \(See also `verilog-toggle-completions', `verilog-type-keywords', and `verilog-separator-keywords'.)" + ;; FIXME: Provide completion-at-point-function. (interactive) (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) @@ -7464,11 +7571,11 @@ See also `verilog-sk-header' for an alternative format." (list name bits comment mem enum signed type multidim modport)) (defsubst verilog-sig-name (sig) (car sig)) -(defsubst verilog-sig-bits (sig) +(defsubst verilog-sig-bits (sig) ;; First element of packed array (pre signal-name) (nth 1 sig)) (defsubst verilog-sig-comment (sig) (nth 2 sig)) -(defsubst verilog-sig-memory (sig) +(defsubst verilog-sig-memory (sig) ;; Unpacked array (post signal-name) (nth 3 sig)) (defsubst verilog-sig-enum (sig) (nth 4 sig)) @@ -7478,7 +7585,7 @@ See also `verilog-sk-header' for an alternative format." (nth 6 sig)) (defsubst verilog-sig-type-set (sig type) (setcar (nthcdr 6 sig) type)) -(defsubst verilog-sig-multidim (sig) +(defsubst verilog-sig-multidim (sig) ;; Second and additional elements of packed array (nth 7 sig)) (defsubst verilog-sig-multidim-string (sig) (if (verilog-sig-multidim sig) @@ -7658,13 +7765,14 @@ Signals must be in standard (base vector) form." "Return list of signals in IN-LIST that aren't parameters or numeric constants." (let (out-list) (while in-list + ;; Namespace intentionally short for AUTOs and compatibility (unless (boundp (intern (concat "vh-" (verilog-sig-name (car in-list))))) (setq out-list (cons (car in-list) out-list))) (setq in-list (cdr in-list))) (nreverse out-list))) (defun verilog-signals-with (func in-list) - "Return IN-LIST with only signals where FUNC passed each signal is true." + "Return list of signals where FUNC is true executed on each signal in IN-LIST." (let (out-list) (while in-list (when (funcall func (car in-list)) @@ -7762,7 +7870,7 @@ Tieoff value uses `verilog-active-low-regexp' and `verilog-auto-reset-widths'." (concat (if (and verilog-active-low-regexp - (string-match verilog-active-low-regexp (verilog-sig-name sig))) + (verilog-string-match-fold verilog-active-low-regexp (verilog-sig-name sig))) "~" "") (cond ((not verilog-auto-reset-widths) "0") @@ -7771,9 +7879,12 @@ Tieoff value uses `verilog-active-low-regexp' and ;; Else presume verilog-auto-reset-widths is true (t (let* ((width (verilog-sig-width sig))) - (if (string-match "^[0-9]+$" width) - (concat width (if (verilog-sig-signed sig) "'sh0" "'h0")) - (concat "{" width "{1'b0}}"))))))) + (cond ((not width) + "`0/*NOWIDTH*/") + ((string-match "^[0-9]+$" width) + (concat width (if (verilog-sig-signed sig) "'sh0" "'h0"))) + (t + (concat "{" width "{1'b0}}")))))))) ;; ;; Dumping @@ -7866,6 +7977,12 @@ Tieoff value uses `verilog-active-low-regexp' and (verilog-backward-open-paren) (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)) (skip-chars-backward "a-zA-Z0-9'_$") + ;; #1 is legal syntax for gate primitives + (when (save-excursion + (verilog-backward-syntactic-ws-quick) + (eq ?# (char-before))) + (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil) + (skip-chars-backward "a-zA-Z0-9'_$")) (looking-at "[a-zA-Z0-9`_\$]+") ;; Important: don't use match string, this must work with Emacs 19 font-lock on (buffer-substring-no-properties (match-beginning 0) (match-end 0)) @@ -7946,7 +8063,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." (defun verilog-read-decls () "Compute signal declaration information for the current module at point. Return an array of [outputs inouts inputs wire reg assign const]." - (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max))) + (let ((end-mod-point (or (verilog-get-end-of-defun) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) in-modport in-clocking ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const @@ -7954,6 +8071,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." vec expect-signal keywd newsig rvalue enum io signed typedefed multidim modport varstack tmp) + ;;(if dbg (setq dbg (concat dbg (format "\n\nverilog-read-decls START PT %s END %s\n" (point) end-mod-point)))) (save-excursion (verilog-beg-of-defun-quick) (setq sigs-const (verilog-read-auto-constants (point) end-mod-point)) @@ -8008,7 +8126,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq paren (1- paren)) (forward-char 1) (when (< paren sig-paren) - (setq expect-signal nil))) ; ) that ends variables inside v2k arg list + (setq expect-signal nil rvalue nil))) ; ) that ends variables inside v2k arg list ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") (goto-char (match-end 0)) (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) @@ -8102,7 +8220,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;; Type? ((unless ptype (verilog-typedef-name-p keywd)) - (setq typedefed keywd)) + (cond (io + (setq typedefed + (if typedefed (concat typedefed " " keywd) keywd))) + (t (setq vec nil enum nil rvalue nil signed nil + typedefed nil multidim nil sig-paren paren + expect-signal 'sigs-var modport nil)))) ;; Interface with optional modport in v2k arglist? ;; Skip over parsing modport, and take the interface name as the type ((and v2kargs-ok @@ -8193,9 +8316,18 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;; - we want an error when we are debugging this code if they are refed. (defvar sigs-in) (defvar sigs-inout) - (defvar sigs-out) (defvar sigs-intf) - (defvar sigs-intfd)) + (defvar sigs-intfd) + (defvar sigs-out) + (defvar sigs-out-d) + (defvar sigs-out-i) + (defvar sigs-out-unk) + (defvar sigs-temp) + ;; These are known to be from other packages and may not be defined + (defvar diff-command nil) + (defvar vector-skip-list) + ;; There are known to be from newer versions of Emacs + (defvar create-lockfiles)) (defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim) "For `verilog-read-sub-decls-line', add a signal." @@ -8437,7 +8569,7 @@ Outputs comments above subcell signals, for example: // Inputs .in (in));" (save-excursion - (let ((end-mod-point (verilog-get-end-of-defun t)) + (let ((end-mod-point (verilog-get-end-of-defun)) st-point end-inst-point ;; below 3 modified by verilog-read-sub-decls-line sigs-out sigs-inout sigs-in sigs-intf sigs-intfd) @@ -8452,7 +8584,7 @@ Outputs comments above subcell signals, for example: (subprim (member submod verilog-gate-keywords)) (comment (concat inst " of " submod ".v")) submodi submoddecls) - (cond + (cond (subprim (setq submodi `primitive submoddecls (verilog-decls-new nil nil nil nil nil nil nil nil nil) @@ -8569,17 +8701,6 @@ Must call `verilog-read-auto-lisp-present' before this function." (verilog-in-hooks t)) (eval-region beg-pt end-pt nil)))))) -(eval-when-compile - ;; Prevent compile warnings; these are let's, not globals - ;; Do not remove the eval-when-compile - ;; - we want an error when we are debugging this code if they are refed. - (defvar sigs-in) - (defvar sigs-out-d) - (defvar sigs-out-i) - (defvar sigs-out-unk) - (defvar sigs-temp) - (defvar vector-skip-list)) - (defun verilog-read-always-signals-recurse (exit-keywd rvalue temp-next) "Recursive routine for parentheses/bracket matching. @@ -8743,7 +8864,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (defun verilog-read-instants () "Parse module at point and return list of ( ( file instance ) ... )." (verilog-beg-of-defun-quick) - (let* ((end-mod-point (verilog-get-end-of-defun t)) + (let* ((end-mod-point (verilog-get-end-of-defun)) (state nil) (instants-list nil)) (save-excursion @@ -8890,12 +9011,14 @@ If found returns `verilog-read-auto-template-inside' structure." "Set the definition DEFNAME to the DEFVALUE in the given BUFFER. Optionally associate it with the specified enumeration ENUMNAME." (with-current-buffer (or buffer (current-buffer)) + ;; Namespace intentionally short for AUTOs and compatibility (let ((mac (intern (concat "vh-" defname)))) ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) ;; Need to define to a constant if no value given (set (make-local-variable mac) (if (equal defvalue "") "1" defvalue))) (if enumname + ;; Namespace intentionally short for AUTOs and compatibility (let ((enumvar (intern (concat "venum-" enumname)))) ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) (unless (boundp enumvar) (set enumvar nil)) @@ -8965,8 +9088,9 @@ warning message, you need to add to your init file: (while (re-search-forward "^\\s-*`define\\s-+\\([a-zA-Z0-9_$]+\\)\\s-+\\(.*\\)$" nil t) (let ((defname (match-string-no-properties 1)) (defvalue (match-string-no-properties 2))) - (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue)) - (verilog-set-define defname defvalue origbuf))) + (unless (verilog-inside-comment-or-string-p (match-beginning 0)) + (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue)) + (verilog-set-define defname defvalue origbuf)))) ;; Hack: Read parameters (goto-char (point-min)) (while (re-search-forward @@ -8979,8 +9103,9 @@ warning message, you need to add to your init file: (forward-comment 99999) (while (looking-at (concat "\\s-*,?\\s-*\\(?:/[/*].*?$\\)?\\s-*\\([a-zA-Z0-9_$]+\\)" "\\s-*=\\s-*\\([^;,]*\\),?\\s-*\\(/[/*].*?$\\)?\\s-*")) - (verilog-set-define (match-string-no-properties 1) - (match-string-no-properties 2) origbuf enumname) + (unless (verilog-inside-comment-or-string-p (match-beginning 0)) + (verilog-set-define (match-string-no-properties 1) + (match-string-no-properties 2) origbuf enumname)) (goto-char (match-end 0)) (forward-comment 99999))))))) @@ -9183,7 +9308,7 @@ Used for __FLAGS__ in `verilog-expand-command'." ;; (defvar verilog-dir-cache-preserving nil - "If set, the directory cache is enabled, and file system changes are ignored. + "If true, the directory cache is enabled, and file system changes are ignored. See `verilog-dir-exists-p' and `verilog-dir-files'.") ;; If adding new cached variable, add also to verilog-preserve-dir-cache @@ -9278,10 +9403,12 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil." (while (and symbol (string-match "^`" symbol)) (setq symbol (substring symbol 1)) (setq symbol + ;; Namespace intentionally short for AUTOs and compatibility (if (boundp (intern (concat "vh-" symbol))) ;; Emacs has a bug where boundp on a buffer-local ;; variable in only one buffer returns t in another. ;; This can confuse, so check for nil. + ;; Namespace intentionally short for AUTOs and compatibility (let ((val (eval (intern (concat "vh-" symbol))))) (if (eq val nil) (if wing-it symbol nil) @@ -9314,10 +9441,12 @@ If the variable vh-{symbol} is defined, substitute that value." (setq symbol (match-string 1 text)) ;;(message symbol) (cond ((and + ;; Namespace intentionally short for AUTOs and compatibility (boundp (intern (concat "vh-" symbol))) ;; Emacs has a bug where boundp on a buffer-local ;; variable in only one buffer returns t in another. ;; This can confuse, so check for nil. + ;; Namespace intentionally short for AUTOs and compatibility (setq val (eval (intern (concat "vh-" symbol))))) (setq text (replace-match val nil nil text))) (t (setq ok nil))))) @@ -9661,6 +9790,7 @@ those clocking block's signals." (setq out-list (cons (car in-list) out-list))) (setq in-list (cdr in-list))) ;; New scheme + ;; Namespace intentionally short for AUTOs and compatibility (let* ((enumvar (intern (concat "venum-" enum))) (enumlist (and (boundp enumvar) (eval enumvar)))) (while enumlist @@ -9672,7 +9802,8 @@ those clocking block's signals." "Return all signals in IN-LIST matching the given REGEXP, if non-nil." (if (or (not regexp) (equal regexp "")) in-list - (let (out-list) + (let ((case-fold-search verilog-case-fold) + out-list) (while in-list (if (string-match regexp (verilog-sig-name (car in-list))) (setq out-list (cons (car in-list) out-list))) @@ -9683,7 +9814,8 @@ those clocking block's signals." "Return all signals in IN-LIST not matching the given REGEXP, if non-nil." (if (or (not regexp) (equal regexp "")) in-list - (let (out-list) + (let ((case-fold-search verilog-case-fold) + out-list) (while in-list (if (not (string-match regexp (verilog-sig-name (car in-list)))) (setq out-list (cons (car in-list) out-list))) @@ -9885,19 +10017,6 @@ This repairs those mis-inserted by an AUTOARG." (when (looking-at ",") (delete-char 1)))) -(defun verilog-get-list (start end) - "Return the elements of a comma separated list between START and END." - (interactive) - (let ((my-list (list)) - my-string) - (save-excursion - (while (< (point) end) - (when (re-search-forward "\\([^,{]+\\)" end t) - (setq my-string (verilog-string-remove-spaces (match-string 1))) - (setq my-list (nconc my-list (list my-string) )) - (goto-char (match-end 0)))) - my-list))) - (defun verilog-make-width-expression (range-exp) "Return an expression calculating the length of a range [x:y] in RANGE-EXP." ;; strip off the [] @@ -10013,7 +10132,7 @@ This repairs those mis-inserted by an AUTOARG." (defun verilog-typedef-name-p (variable-name) "Return true if the VARIABLE-NAME is a type definition." (when verilog-typedef-regexp - (string-match verilog-typedef-regexp variable-name))) + (verilog-string-match-fold verilog-typedef-regexp variable-name))) ;; ;; Auto deletion @@ -10382,7 +10501,7 @@ DIFFPT. This function is called via `verilog-diff-function'." (let ((name1 (with-current-buffer b1 (buffer-file-name)))) (verilog-warn "%s:%d: Difference in AUTO expansion found" name1 (with-current-buffer b1 - (1+ (count-lines (point-min) (point))))) + (count-lines (point-min) diffpt))) (cond (noninteractive (verilog-diff-file-with-buffer name1 b2 t t)) (t @@ -10390,8 +10509,8 @@ DIFFPT. This function is called via `verilog-diff-function'." (defun verilog-diff-auto () "Expand AUTOs in a temporary buffer and indicate any change. -Whitespace differences are ignored to determine identicalness, but -once a difference is detected, whitespace differences may be shown. +Whitespace is ignored when detecting differences, but once a +difference is detected, whitespace differences may be shown. To call this from the command line, see \\[verilog-batch-diff-auto]. @@ -10611,7 +10730,6 @@ See the example in `verilog-auto-inout-modport'." ;; Note this may raise an error (when (setq submodi (verilog-modi-lookup submod t)) (let* ((indent-pt (current-indentation)) - (modi (verilog-modi-current)) (submoddecls (verilog-modi-get-decls submodi)) (submodportdecls (verilog-modi-modport-lookup submodi modport-re)) (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve @@ -10652,7 +10770,7 @@ See the example in `verilog-auto-inout-modport'." (setq sigs (cdr sigs)))) (verilog-insert-indent "// End of automatics\n"))))))) -(defun verilog-auto-inst-port-map (port-st) +(defun verilog-auto-inst-port-map (_port-st) nil) (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning @@ -10688,7 +10806,7 @@ If PAR-VALUES replace final strings with these parameter values." "")) (case-fold-search nil) (check-values par-values) - tpl-net) + tpl-net dflt-bits) ;; Replace parameters in bit-width (when (and check-values (not (equal vl-bits ""))) @@ -10706,11 +10824,14 @@ If PAR-VALUES replace final strings with these parameter values." vl-mbits (verilog-simplify-range-expression vl-mbits) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed ;; Default net value if not found - (setq tpl-net (concat port + (setq dflt-bits (if (and (verilog-sig-bits port-st) + (or (verilog-sig-multidim port-st) + (verilog-sig-memory port-st))) + (concat "/*" vl-mbits vl-bits "*/") + (concat vl-bits)) + tpl-net (concat port (if vl-modport (concat "." vl-modport) "") - (if (verilog-sig-multidim port-st) - (concat "/*" vl-mbits vl-bits "*/") - (concat vl-bits)))) + dflt-bits)) ;; Find template (cond (tpl-ass ; Template of exact port name (setq tpl-net (nth 1 tpl-ass))) @@ -10737,12 +10858,13 @@ If PAR-VALUES replace final strings with these parameter values." (setq expr (verilog-string-replace-matches "\\\\\"" "\"" nil nil expr)) (setq expr (verilog-string-replace-matches "@" tpl-num nil nil expr)) (prin1 (eval (car (read-from-string expr))) - (lambda (ch) ()))))) + (lambda (_ch) ()))))) (if (numberp value) (setq value (number-to-string value))) value)) (substring tpl-net (match-end 0)))))) ;; Replace @ and [] magic variables in final output (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) + (setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net)) (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) ;; Insert it (indent-to indent-pt) @@ -10855,6 +10977,10 @@ Limitations: AUTOWIRE declarations, etc. Gates are the only case when position based connections are passed. + The array part of arrayed instances are ignored; this may + result in undesirable default AUTOINST connections; use a + template instead. + For example, first take the submodule InstModule.v: module InstModule (o,i); @@ -10934,6 +11060,19 @@ Templates: words and capitalized. Only signals that must be different for each instantiation need to be listed. + Inside a template, a [] in a connection name (with nothing else + inside the brackets) will be replaced by the same bus subscript + as it is being connected to, or the [] will be removed if it is + a single bit signal. + + Inside a template, a [][] in a connection name will behave + similarly to a [] for scalar or single-dimensional connection; + for a multidimensional connection it will print a comment + similar to that printed when a template is not used. Generally + it is a good idea to do this for all connections in a template, + as then they will work for any width signal, and with AUTOWIRE. + See PTL_BUS becoming PTL_BUSNEW below. + Inside a template, a [] in a connection name (with nothing else inside the brackets) will be replaced by the same bus subscript as it is being connected to, or the [] will be removed if it is a single bit signal. @@ -11153,7 +11292,7 @@ For more information see the \\[verilog-faq] and forums at URL ;; automatic variable instantiation program. (let* ((tpl-info (verilog-read-auto-template submod)) (tpl-regexp (aref tpl-info 0))) - (setq tpl-num (if (string-match tpl-regexp inst) + (setq tpl-num (if (verilog-string-match-fold tpl-regexp inst) (match-string 1 inst) "") tpl-list (aref tpl-info 1))) @@ -11296,7 +11435,7 @@ Templates: ;; automatic variable instantiation program. (let* ((tpl-info (verilog-read-auto-template submod)) (tpl-regexp (aref tpl-info 0))) - (setq tpl-num (if (string-match tpl-regexp inst) + (setq tpl-num (if (verilog-string-match-fold tpl-regexp inst) (match-string 1 inst) "") tpl-list (aref tpl-info 1))) @@ -11587,6 +11726,7 @@ same expansion will result from only extracting outputs starting with ov: (verilog-subdecls-get-outputs modsubdecls) (append (verilog-decls-get-outputs moddecls) (verilog-decls-get-inouts moddecls) + (verilog-decls-get-inputs moddecls) (verilog-subdecls-get-inputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) (when regexp @@ -11713,6 +11853,7 @@ same expansion will result from only extracting inputs starting with i: (verilog-subdecls-get-inputs modsubdecls) (append (verilog-decls-get-inputs moddecls) (verilog-decls-get-inouts moddecls) + (verilog-decls-get-outputs moddecls) (verilog-decls-get-vars moddecls) (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls) @@ -12056,67 +12197,36 @@ Limitations: If placed inside the parenthesis of a module declaration, it creates Verilog 2001 style, else uses Verilog 1995 style. - Concatenation and outputting partial buses is not supported. - Module names must be resolvable to filenames. See `verilog-auto-inst'. - Signals are not inserted in the same order as in the original module, - though they will appear to be in the same order to an AUTOINST - instantiating either module. + Parameters are inserted in the same order as in the original module. - Signals declared as \"output reg\" or \"output wire\" etc will - lose the wire/reg declaration so that shell modules may - generate those outputs differently. However, \"output logic\" - is propagated. + Parameters do not have values, which is SystemVerilog 2009 syntax. An example: - module ExampShell (/*AUTOARG*/); - /*AUTOINOUTMODULE(\"ExampMain\")*/ + module ExampShell (); + /*AUTOINOUTPARAM(\"ExampMain\")*/ endmodule - module ExampMain (i,o,io); - input i; - output o; - inout io; + module ExampMain (); + parameter PARAM = 22; endmodule Typing \\[verilog-auto] will make this into: module ExampShell (/*AUTOARG*/i,o,io); - /*AUTOINOUTMODULE(\"ExampMain\")*/ - // Beginning of automatic in/out/inouts (from specific module) - output o; - inout io; - input i; + /*AUTOINOUTPARAM(\"ExampMain\")*/ + // Beginning of automatic parameters (from specific module) + parameter PARAM; // End of automatics endmodule You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting signals starting with i: +parameters matching the regular expression will be included. For example the +same expansion will result from only extracting parameters starting with i: - /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/ - -You may also provide an optional second regular expression, in -which case only signals which have that pin direction and data -type will be included. This matches against everything before -the signal name in the declaration, for example against -\"input\" (single bit), \"output logic\" (direction and type) or -\"output [1:0]\" (direction and implicit type). You also -probably want to skip spaces in your regexp. - -For example, the below will result in matching the output \"o\" -against the previous example's module: - - /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/ - -You may also provide an optional third regular expression, in -which case any parameter names that match the given regexp will -be included. Including parameters is off by default. To include -all signals and parameters, use: - - /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/" + /*AUTOINOUTPARAM(\"ExampMain\",\"^i\")*/" (save-excursion (let* ((params (verilog-read-auto-params 1 2)) (submod (nth 0 params)) @@ -12164,7 +12274,7 @@ Limitations: Interface names must be resolvable to filenames. See `verilog-auto-inst'. As with other autos, any inputs/outputs declared in the module -will suppress the AUTO from redeclaring an input/output by +will suppress the AUTO from redeclaring an inputs/outputs by the same name. An example: @@ -12456,12 +12566,20 @@ used on the right hand side of assignments. By default, AUTORESET will include the width of the signal in the autos, SystemVerilog designs may want to change this. To control -this behavior, see `verilog-auto-reset-widths'. +this behavior, see `verilog-auto-reset-widths'. In some cases +AUTORESET must use a '0 assignment and it will print NOWIDTH; use +`verilog-auto-reset-widths' unbased to prevent this. AUTORESET ties signals to deasserted, which is presumed to be zero. Signals that match `verilog-active-low-regexp' will be deasserted by tying them to a one. +AUTORESET may try to reset arrays or structures that cannot be +reset by a simple assignment, resulting in compile errors. This +is a feature to be taken as a hint that you need to reset these +signals manually (or put them into a \"`ifdef NEVER signal<=`0; +`endif\" so Verilog-Mode ignores them.) + An example: always @(posedge clk or negedge reset_l) begin @@ -12882,7 +13000,7 @@ Typing \\[verilog-auto] will make this into: ;; count(enums) == width(sig) (equal (number-to-string (length enum-sigs)) (verilog-sig-width undecode-sig))))) - (enum-chars 0) + (enum-chars 0) (ascii-chars 0)) ;; ;; Find number of ascii chars needed @@ -13005,6 +13123,9 @@ Use \\[verilog-inject-auto] to insert AUTOs for the first time. Use \\[verilog-faq] for a pointer to frequently asked questions. +For new users, we recommend setting `verilog-case-fold' to nil +and `verilog-auto-arg-sort' to t. + The hooks `verilog-before-auto-hook' and `verilog-auto-hook' are called before and after this function, respectively. @@ -13030,12 +13151,12 @@ Using \\[describe-function], see also: `verilog-auto-arg' for AUTOARG module instantiations `verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding `verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport + `verilog-auto-inout' for AUTOINOUT making hierarchy inouts `verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o `verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o `verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport `verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere - `verilog-auto-inout' for AUTOINOUT making hierarchy inouts `verilog-auto-input' for AUTOINPUT making hierarchy inputs `verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function `verilog-auto-inst' for AUTOINST instantiation pins @@ -13047,7 +13168,7 @@ Using \\[describe-function], see also: `verilog-auto-reg' for AUTOREG registers `verilog-auto-reg-input' for AUTOREGINPUT instantiation registers `verilog-auto-reset' for AUTORESET flop resets - `verilog-auto-sense' for AUTOSENSE always sensitivity lists + `verilog-auto-sense' for AUTOSENSE or AS always sensitivity lists `verilog-auto-tieoff' for AUTOTIEOFF output tieoffs `verilog-auto-undef' for AUTOUNDEF `undef of local `defines `verilog-auto-unused' for AUTOUNUSED unused inputs/inouts @@ -13066,6 +13187,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-save-font-mods (let ((oldbuf (if (not (buffer-modified-p)) (buffer-string))) + (case-fold-search verilog-case-fold) ;; Cache directories; we don't write new files, so can't change (verilog-dir-cache-preserving t) ;; Cache current module @@ -13196,7 +13318,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." (define-key map "r" 'verilog-sk-repeat) (define-key map "s" 'verilog-sk-specify) (define-key map "t" 'verilog-sk-task) - (define-key map "u" 'verilog-sk-uvm-class) + (define-key map "u" 'verilog-sk-uvm-object) (define-key map "w" 'verilog-sk-while) (define-key map "x" 'verilog-sk-casex) (define-key map "z" 'verilog-sk-casez) @@ -13209,6 +13331,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." (define-key map "O" 'verilog-sk-output) (define-key map "S" 'verilog-sk-state-machine) (define-key map "=" 'verilog-sk-inout) + (define-key map "U" 'verilog-sk-uvm-component) (define-key map "W" 'verilog-sk-wire) (define-key map "R" 'verilog-sk-reg) (define-key map "D" 'verilog-sk-define-signal) @@ -13325,13 +13448,13 @@ See also `verilog-header' for an alternative format." > _ \n > "endclass" (progn (electric-verilog-terminate-line) nil)) -(define-skeleton verilog-sk-uvm-class +(define-skeleton verilog-sk-uvm-object "Insert a class definition" () > "class " (setq name (skeleton-read "Name: ")) " extends " (skeleton-read "Extends: ") ";" \n > _ \n > "`uvm_object_utils_begin(" name ")" \n - > (- verilog-indent-level) " `uvm_object_utils_end" \n + > (- verilog-indent-level) "`uvm_object_utils_end" \n > _ \n > "function new(name=\"" name "\");" \n > "super.new(name);" \n @@ -13339,6 +13462,20 @@ See also `verilog-header' for an alternative format." > _ \n > "endclass" (progn (electric-verilog-terminate-line) nil)) +(define-skeleton verilog-sk-uvm-component + "Insert a class definition" + () + > "class " (setq name (skeleton-read "Name: ")) " extends " (skeleton-read "Extends: ") ";" \n + > _ \n + > "`uvm_component_utils_begin(" name ")" \n + > (- verilog-indent-level) "`uvm_component_utils_end" \n + > _ \n + > "function new(name=\"\", uvm_component parent);" \n + > "super.new(name, parent);" \n + > (- verilog-indent-level) "endfunction" \n + > _ \n + > "endclass" (progn (electric-verilog-terminate-line) nil)) + (define-skeleton verilog-sk-primitive "Insert a task definition." () @@ -13600,7 +13737,7 @@ and the case items." "Map containing mouse bindings for `verilog-mode'.") -(defun verilog-highlight-region (beg end old-len) +(defun verilog-highlight-region (beg end _old-len) "Colorize included files and modules in the (changed?) region. Clicking on the middle-mouse button loads them in a buffer (as in dired)." (when (or verilog-highlight-includes @@ -13783,6 +13920,7 @@ Files are checked based on `verilog-library-flags'." verilog-before-getopt-flags-hook verilog-before-save-font-hook verilog-cache-enabled + verilog-case-fold verilog-case-indent verilog-cexp-indent verilog-compiler @@ -13809,7 +13947,6 @@ Files are checked based on `verilog-library-flags'." verilog-linter verilog-minimum-comment-distance verilog-mode-hook - verilog-mode-release-date verilog-mode-release-emacs verilog-mode-version verilog-preprocessor diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index e3b421efbe1..b422cf6c989 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -1,6 +1,6 @@ ;;; vhdl-mode.el --- major mode for editing VHDL code -;; Copyright (C) 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-2014 Free Software Foundation, Inc. ;; Authors: Reto Zimmermann ;; Rodney J. Whitby @@ -13,10 +13,10 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst vhdl-version "3.33.28" +(defconst vhdl-version "3.34.2" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2010-09-22" +(defconst vhdl-time-stamp "2012-11-21" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -72,8 +72,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Emacs Versions -;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X -;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally) +;; this updated version was only tested on: GNU Emacs 20.4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation @@ -84,7 +83,7 @@ ;; or into an arbitrary directory that is added to the load path by the ;; following line in your Emacs start-up file `.emacs': -;; (setq load-path (cons (expand-file-name "") load-path)) +;; (push (expand-file-name "") load-path) ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same ;; directory. Otherwise, byte-compile the source file: @@ -96,7 +95,7 @@ ;; (not required in Emacs 20 and higher): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) -;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)) +;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) ;; More detailed installation instructions are included in the official ;; VHDL Mode distribution. @@ -130,6 +129,7 @@ ;; Emacs 21+ handling (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 21, 22, ... is used.") +;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 22, ... is used.") @@ -210,22 +210,25 @@ Overrides local variable `indent-tabs-mode'." (defcustom vhdl-compiler-alist '( + ;; 60: docal <= false; + ;; ^^^^^ + ;; [Error] Assignment error: variable is illegal target of signal assignment ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1" nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms" - ("\\s-\\([0-9]+\\):" 0 1 0) ("Compiling file \\(.+\\)" 1) + ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/\\1.vif" upcase)) ;; Aldec - ;; COMP96 ERROR COMP96_0078: "Unknown identifier "Addr_Bits"." "" 40 30 - ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1" + ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 + ("Aldec" "vcom" "-work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" - (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 0) + (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) nil) ;; Cadence Leapfrog: cv -file test.vhd ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" - ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0) + ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) ;; Cadence Affirma NC vhdl: ncvhdl test.vhd @@ -233,21 +236,27 @@ Overrides local variable `indent-tabs-mode'." ;; (PLL_400X_TOP) is not declared [10.3]. ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" - ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" "\\1/package/pc.db" "\\1/body/pc.db" downcase)) ;; ghdl vhdl: ghdl test.vhd ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" - ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) + ;; IBM Compiler + ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6 + ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1" + nil "mkdir \\1" "./" "work/" "Makefile" "ibm" + ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) + nil) ;; Ikos Voyager: analyze test.vhd ;; analyze test.vhd ;; E L4/C5: this library unit is inaccessible ("Ikos" "analyze" "-l \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ikos" - ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2) + ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) nil) ;; ModelSim, Model Technology: vcom test.vhd @@ -257,29 +266,39 @@ Overrides local variable `indent-tabs-mode'." ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" - ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 0) + ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd ;; test.vhd:34: error message ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" - ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) + ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) + ;; Quartus compiler + ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used + ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text + ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal + ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library + ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ... + ("Quartus" "make" "-work \\1" "make" "-f \\1" + nil "mkdir \\1" "./" "work/" "Makefile" "quartus" + ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) + nil) ;; QuickHDL, Mentor Graphics: qvhcom test.vhd ;; ERROR: test.vhd(24): near "dnd": expecting: END ;; WARNING[4]: test.vhd(30): A space is required between ... ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" - ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) + ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; Savant: scram -publish-cc test.vhd ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" - ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) + ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" "\\1_config.vhdl" "\\1_package.vhdl" "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) @@ -287,39 +306,39 @@ Overrides local variable `indent-tabs-mode'." ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "simili" - ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0) + ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" "\\1/prim.var" "\\1/_body.var" downcase)) ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" - ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0) + ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) nil) ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" - ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) + ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" - ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) + ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) ;; Synplify: ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 ("Synplify" "n/a" "n/a" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synplify" - ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) + ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) nil) ;; Vantage: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "vantage" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; VeriBest: vc vhdl test.vhd @@ -329,21 +348,21 @@ Overrides local variable `indent-tabs-mode'." ;; [Error] Name BITA is unknown ("VeriBest" "vc" "vhdl" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "veribest" - ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0) + ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0) nil) ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; Xilinx XST: ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error ("Xilinx XST" "xflow" "" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" - ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0) + ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) nil) ) "List of available VHDL compilers and their properties. @@ -429,9 +448,13 @@ NOTE: Activate new error and file message regexps and reflect the new setting (string :tag "ID string ") (list :tag "Error message" :indent 4 (regexp :tag "Regexp ") - (integer :tag "File subexp index") + (choice :tag "File subexp " + (integer :tag "Index") + (const :tag "No file name" nil)) (integer :tag "Line subexp index") - (integer :tag "Column subexp idx")) + (choice :tag "Column subexp " + (integer :tag "Index") + (const :tag "No column number" nil))) (list :tag "File message" :indent 4 (regexp :tag "Regexp ") (integer :tag "File subexp index")) @@ -450,6 +473,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Downcase" downcase)))))) :set (lambda (variable value) (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + :version "24.4" :group 'vhdl-compile) (defcustom vhdl-compiler "GHDL" @@ -457,7 +481,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting Select a compiler name from the ones defined in option `vhdl-compiler-alist'." :type (let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice) (nreverse list))) :group 'vhdl-compile) @@ -602,7 +626,7 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' (list :tag "Compiler" :indent 6 ,(let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice :tag "Compiler name") (nreverse list))) @@ -637,7 +661,7 @@ headers and the source files/directories to be scanned in the hierarchy browser. The current project can also be changed temporarily in the menu." :type (let ((alist vhdl-project-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice (const :tag "None" nil) (const :tag "--")) (nreverse list))) @@ -1268,6 +1292,18 @@ The comments and empty lines between groups of ports are pasted: (const :tag "Always" always)) :group 'vhdl-port) +(defcustom vhdl-actual-generic-name '(".*" . "\\&") + (concat + "Specifies how actual generic names are obtained from formal generic names. +In a component instantiation, an actual generic name can be +obtained by modifying the formal generic name (e.g. attaching or stripping +off a substring)." + vhdl-name-doc-string) + :type '(cons (regexp :tag "From regexp") + (string :tag "To string ")) + :group 'vhdl-port + :version "24.4") + (defcustom vhdl-actual-port-name '(".*" . "\\&") (concat "Specifies how actual port names are obtained from formal port names. @@ -1469,21 +1505,21 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (defvar end-comment-column) -(defgroup vhdl-align nil - "Customizations for alignment." +(defgroup vhdl-beautify nil + "Customizations for beautification." :group 'vhdl) (defcustom vhdl-auto-align t "Non-nil means align some templates automatically after generation." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-groups t "Non-nil means align groups of code lines separately. A group of code lines is a region of consecutive lines between two lines that match the regexp in option `vhdl-align-group-separate'." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-group-separate "^\\s-*$" "Regexp for matching a line that separates groups of lines for alignment. @@ -1491,7 +1527,7 @@ Examples: \"^\\s-*$\": matches an empty line \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" :type 'regexp - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-same-indent t "Non-nil means align blocks with same indent separately. @@ -1500,7 +1536,18 @@ blocks of same indent which are aligned separately (except for argument/port lists). This gives nicer alignment in most cases. Option `vhdl-align-groups' still applies within these blocks." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) + +(defcustom vhdl-beautify-options '(t t t t t) + "List of options for beautifying code. Allows to disable individual +features of code beautification." + :type '(list (boolean :tag "Whitespace cleanup ") + (boolean :tag "Single statement per line") + (boolean :tag "Indentation ") + (boolean :tag "Alignment ") + (boolean :tag "Case fixing ")) + :group 'vhdl-beautify + :version "24.4") (defgroup vhdl-highlight nil @@ -1846,7 +1893,7 @@ useful in large files where syntax-based indentation gets very slow." :group 'vhdl-misc) (defcustom vhdl-indent-comment-like-next-code-line t - "*Non-nil means comment lines are indented like the following code line. + "Non-nil means comment lines are indented like the following code line. Otherwise, comment lines are indented like the preceding code line. Indenting comment lines like the following code line gives nicer indentation when comments precede the code that they refer to." @@ -1872,14 +1919,11 @@ NOTE: Activate the new setting by restarting Emacs." "Non-nil means consider the underscore character `_' as part of word. An identifier containing underscores is then treated as a single word in select and move operations. All parts of an identifier separated by underscore -are treated as single words otherwise. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." +are treated as single words otherwise." :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init)) :group 'vhdl-misc) +(make-obsolete-variable 'vhdl-underscore-is-part-of-word + 'superword-mode "24.4") (defgroup vhdl-related nil @@ -2070,7 +2114,7 @@ your style, only those that are different from the default.") (lambda (var) (cons var (symbol-value var)))) varlist)))) - (setq vhdl-style-alist (cons default vhdl-style-alist)))) + (push default vhdl-style-alist))) (defvar vhdl-mode-hook nil "Hook called by `vhdl-mode'.") @@ -2087,10 +2131,11 @@ your style, only those that are different from the default.") (require 'hippie-exp) ;; optional (minimize warning messages during compile) +(unless (featurep 'xemacs) (eval-when-compile (require 'font-lock) (require 'ps-print) - (require 'speedbar)) + (require 'speedbar))) ; for speedbar-with-writable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2190,6 +2235,17 @@ Ignore byte-compiler warnings you might see." (unless (fboundp 'member-ignore-case) (defalias 'member-ignore-case 'member)) +;; `last-input-char' obsolete in Emacs 24, `last-input-event' different +;; behavior in XEmacs +(defvar vhdl-last-input-event) +(if (featurep 'xemacs) + (defvaralias 'vhdl-last-input-event 'last-input-char) + (defvaralias 'vhdl-last-input-event 'last-input-event)) + +;; `help-print-return-message' changed to `print-help-return-message' in Emacs +;;;(unless (fboundp 'help-print-return-message) +;;; (defalias 'help-print-return-message 'print-help-return-message)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Compatibility with older VHDL Mode versions @@ -2210,7 +2266,7 @@ Ignore byte-compiler warnings you might see." (vhdl-warning (apply 'format args) t) (unless vhdl-warnings (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) - (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings)))) + (push (apply 'format args) vhdl-warnings))) (defun vhdl-warning (string &optional nobeep) "Print out warning STRING and beep." @@ -2244,7 +2300,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-model-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-model-alist (nreverse new-alist))) (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) @@ -2254,7 +2310,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-project-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-project-alist (nreverse new-alist))) (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) @@ -2342,7 +2398,6 @@ Ignore byte-compiler warnings you might see." (unless (get 'speedbar-indentation-width 'saved-value) (setq speedbar-indentation-width 2))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Help functions / inline substitutions / macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2433,6 +2488,7 @@ old environment. Used for consistent searching." (progn (set-buffer (create-file-buffer ,file-name)) (setq file-opened t) (vhdl-insert-file-contents ,file-name) + ;; FIXME: This modifies a global syntax-table! (modify-syntax-entry ?\- ". 12" (syntax-table)) (modify-syntax-entry ?\n ">" (syntax-table)) (modify-syntax-entry ?\^M ">" (syntax-table)) @@ -2489,7 +2545,7 @@ conversion." (defun vhdl-delete (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." - (setq list (cons nil list)) + (push nil list) (let ((list1 list)) (while (and (cdr list1) (not (equal elt (cadr list1)))) (setq list1 (cdr list1))) @@ -2497,6 +2553,9 @@ conversion." (setcdr list1 (cddr list1)))) (cdr list)) +(declare-function speedbar-refresh "speedbar" (&optional arg)) +(declare-function speedbar-do-function-pointer "speedbar" ()) + (defun vhdl-speedbar-refresh (&optional key) "Refresh directory or project with name KEY." (when (and (boundp 'speedbar-frame) @@ -2537,6 +2596,11 @@ conversion." (set-buffer (marker-buffer marker))) (goto-char marker)) +(defun vhdl-goto-line (line) + "Use this instead of calling user level function `goto-line'." + (goto-char (point-min)) + (forward-line (1- line))) + (defun vhdl-menu-split (list title) "Split menu LIST into several submenus, if number of elements > `vhdl-menu-max-size'." @@ -2547,19 +2611,19 @@ elements > `vhdl-menu-max-size'." (menuno 1) (i 0)) (while remain - (setq sublist (cons (car remain) sublist)) + (push (car remain) sublist) (setq remain (cdr remain)) (setq i (+ i 1)) (if (= i vhdl-menu-max-size) (progn - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result)) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result) (setq i 0) (setq menuno (+ menuno 1)) (setq sublist '())))) (and sublist - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result))) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result)) (nreverse result)) list)) @@ -2723,11 +2787,6 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) - ;; backspace/delete key bindings - (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify) - (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key vhdl-mode-map [delete] 'delete-char) - (define-key vhdl-mode-map [(meta delete)] 'kill-word)) ;; mode specific key bindings (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) @@ -2794,6 +2853,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) @@ -2864,56 +2925,51 @@ STRING are replaced by `-' and substrings are converted to lower case." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Syntax table -(defvar vhdl-mode-syntax-table nil +(defvar vhdl-mode-syntax-table + (let ((st (make-syntax-table))) + ;; define punctuation + (modify-syntax-entry ?\# "." st) + (modify-syntax-entry ?\$ "." st) + (modify-syntax-entry ?\% "." st) + (modify-syntax-entry ?\& "." st) + (modify-syntax-entry ?\' "." st) + (modify-syntax-entry ?\* "." st) + (modify-syntax-entry ?\+ "." st) + (modify-syntax-entry ?\. "." st) + (modify-syntax-entry ?\/ "." st) + (modify-syntax-entry ?\: "." st) + (modify-syntax-entry ?\; "." st) + (modify-syntax-entry ?\< "." st) + (modify-syntax-entry ?\= "." st) + (modify-syntax-entry ?\> "." st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?\| "." st) + ;; define string + (modify-syntax-entry ?\" "\"" st) + ;; define underscore + (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st) + ;; a single hyphen is punctuation, but a double hyphen starts a comment + (modify-syntax-entry ?\- ". 12" st) + ;; and \n and \^M end a comment + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\^M ">" st) + ;; define parentheses to match + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + (modify-syntax-entry ?\[ "(]" st) + (modify-syntax-entry ?\] ")[" st) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + st) "Syntax table used in `vhdl-mode' buffers.") -(defvar vhdl-mode-ext-syntax-table nil +(defvar vhdl-mode-ext-syntax-table + ;; Extended syntax table including '_' (for simpler search regexps). + (let ((st (copy-syntax-table vhdl-mode-syntax-table))) + (modify-syntax-entry ?_ "w" st) + st) "Syntax table extended by `_' used in `vhdl-mode' buffers.") -(defun vhdl-mode-syntax-table-init () - "Initialize `vhdl-mode-syntax-table'." - (setq vhdl-mode-syntax-table (make-syntax-table)) - ;; define punctuation - (modify-syntax-entry ?\# "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\% "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\& "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\' "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\* "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\. "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\: "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\; "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\< "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\= "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\> "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\| "." vhdl-mode-syntax-table) - ;; define string - (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table) - ;; define underscore - (when vhdl-underscore-is-part-of-word - (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table)) - ;; a single hyphen is punctuation, but a double hyphen starts a comment - (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table) - ;; and \n and \^M end a comment - (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table) - (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table) - ;; define parentheses to match - (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table) - (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table) - (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table) - (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table) - (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table) - (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table) - ;; extended syntax table including '_' (for simpler search regexps) - (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table)) - (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table)) - -;; initialize syntax table for VHDL Mode -(vhdl-mode-syntax-table-init) - (defvar vhdl-syntactic-context nil "Buffer local variable containing syntactic analysis list.") (make-variable-buffer-local 'vhdl-syntactic-context) @@ -3506,6 +3562,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] "--" + ["Statement Region" vhdl-fix-statement-region (mark)] + ["Statement Buffer" vhdl-fix-statement-buffer t] + "--" ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) ("Update" ["Sensitivity List" vhdl-update-sensitivity-list-process t] @@ -3814,6 +3873,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Always" (customize-set-variable 'vhdl-include-group-comments 'always) :style radio :selected (eq 'always vhdl-include-group-comments)]) + ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] ["Instance Name..." (customize-option 'vhdl-instance-name) t] ("Testbench" @@ -3910,7 +3970,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] "--" ["Customize Group..." (customize-group 'vhdl-comment) t]) - ("Align" + ("Beautify" ["Auto Align Templates" (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) :style toggle :selected vhdl-auto-align] @@ -3918,13 +3978,14 @@ STRING are replaced by `-' and substrings are converted to lower case." (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) :style toggle :selected vhdl-align-groups] ["Group Separation String..." - (customize-set-variable 'vhdl-align-group-separate) t] + (customize-option 'vhdl-align-group-separate) t] ["Align Lines with Same Indent" (customize-set-variable 'vhdl-align-same-indent (not vhdl-align-same-indent)) :style toggle :selected vhdl-align-same-indent] + ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] "--" - ["Customize Group..." (customize-group 'vhdl-align) t]) + ["Customize Group..." (customize-group 'vhdl-beautify) t]) ("Highlight" ["Highlighting On/Off..." (customize-option @@ -4188,14 +4249,13 @@ The directory of the current source file is scanned." (setq found nil) (while file-list (setq found t) - (setq menu-list (cons (vector (car file-list) - (list 'find-file (car file-list)) t) - menu-list)) + (push (vector (car file-list) (list 'find-file (car file-list)) t) + menu-list) (setq file-list (cdr file-list))) (setq menu-list (vhdl-menu-split menu-list "Sources")) - (when found (setq menu-list (cons "--" menu-list))) - (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list)) - (setq menu-list (cons "Sources" menu-list)) + (when found (push "--" menu-list)) + (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) + (push "Sources" menu-list) ;; Create menu (easy-menu-add menu-list) (easy-menu-define vhdl-sources-menu newmap @@ -4579,7 +4639,7 @@ Usage: option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is - larger than `font-lock-maximum-size'). Also, a source file menu can be + larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the current directory for VHDL source files. @@ -4706,7 +4766,7 @@ Usage: automatically recognized as VHDL source files. To add an extension \".xxx\", add the following line to your Emacs start-up file (`.emacs'): - \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) + \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist) HINTS: @@ -7277,7 +7337,7 @@ indentation change." (beginning-of-line 2) (setq syntax (vhdl-get-syntactic-context))))) (when is-comment - (setq syntax (cons (cons 'comment nil) syntax))) + (push (cons 'comment nil) syntax)) (apply '+ (mapcar 'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) @@ -7388,7 +7448,7 @@ ENDPOS is encountered." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Alignment, whitespace fixup, beautifying +;;; Alignment, beautifying ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst vhdl-align-alist @@ -7604,7 +7664,8 @@ the token in MATCH." (when vhdl-progress-interval (setq vhdl-progress-info (vector (count-lines (point-min) beg) (count-lines (point-min) end) 0)))) - (vhdl-fixup-whitespace-region beg end t) + (when (nth 0 vhdl-beautify-options) + (vhdl-fixup-whitespace-region beg end t)) (goto-char beg) (if (not vhdl-align-groups) ;; align entire region @@ -7728,14 +7789,14 @@ the token in MATCH." ;; search for comment start positions and lengths (while (< (point) end) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") + (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 2)) (vhdl-in-literal)))) (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) (setq length (- (match-end 2) (match-beginning 2))) (setq start-max (max start start-max)) (setq length-max (max length length-max)) - (setq comment-list (cons (cons start length) comment-list))) + (push (cons start length) comment-list)) (beginning-of-line 2)) (setq comment-list (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) @@ -7746,14 +7807,14 @@ the token in MATCH." (unless (or (= (caar comment-list) (car start-list)) (<= (+ (car start-list) (cdar comment-list)) end-comment-column)) - (setq start-list (cons (caar comment-list) start-list))) + (push (caar comment-list) start-list)) (setq comment-list (cdr comment-list))) ;; align lines as nicely as possible (goto-char beg) (while (< (point) end) (setq cur-start nil) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") + (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 3)) (vhdl-in-literal)))) @@ -7879,7 +7940,7 @@ end of line, do nothing in comments and strings." (replace-match "\\2"))) ;; surround operator symbols by one space (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t) + (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) (if (or (match-string 1) (<= (match-beginning 0) ; not if at boi (save-excursion (back-to-indentation) (point)))) @@ -7912,6 +7973,154 @@ end of line, do nothing in comments." (interactive) (vhdl-fixup-whitespace-region (point-min) (point-max))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Case fixing + +(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) + "Convert all words matching WORD-REGEXP in region to lower or upper case, +depending on parameter UPPER-CASE." + (let ((case-replace nil) + (last-update 0)) + (vhdl-prepare-search-2 + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward word-regexp end t) + (or (vhdl-in-literal) + (if upper-case + (upcase-word -1) + (downcase-word -1))) + (when (and count vhdl-progress-interval (not noninteractive) + (< vhdl-progress-interval + (- (nth 1 (current-time)) last-update))) + (message "Fixing case... (%2d%s)" + (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) + "%") + (setq last-update (nth 1 (current-time))))) + (goto-char end))))) + +(defun vhdl-fix-case-region (beg end &optional arg) + "Convert all VHDL words in region to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive "r\nP") + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-types vhdl-types-regexp 1) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-constants vhdl-constants-regexp 4) + (when vhdl-progress-interval (message "Fixing case...done"))) + +(defun vhdl-fix-case-buffer () + "Convert all VHDL words in buffer to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive) + (vhdl-fix-case-region (point-min) (point-max))) + +(defun vhdl-fix-case-word (&optional arg) + "Convert word after cursor to upper case if necessary." + (interactive "p") + (save-excursion + (when arg (backward-word 1)) + (vhdl-prepare-search-1 + (when (and vhdl-upper-case-keywords + (looking-at vhdl-keywords-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-types + (looking-at vhdl-types-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-attributes + (looking-at vhdl-attributes-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-enum-values + (looking-at vhdl-enum-values-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-constants + (looking-at vhdl-constants-regexp)) + (upcase-word 1))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Fix statements +;; - force each statement to be on a separate line except when on same line +;; with 'end' keyword + +(defun vhdl-fix-statement-region (beg end &optional arg) + "Force statements in region on separate line except when on same line +with 'end' keyword (necessary for correct indentation). +Currently supported keywords: 'begin', 'if'." + (interactive "r\nP") + (vhdl-prepare-search-2 + (let (point) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + ;; `begin' keyword + (while (re-search-forward + "^\\s-*[^ \t\n].*?\\(\\\\)\\(.*\\\\)?" end t) + (goto-char (match-end 0)) + (setq point (point-marker)) + (when (and (match-string 1) + (or (not (match-string 2)) + (save-excursion (goto-char (match-end 2)) + (vhdl-in-literal))) + (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal)))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)) + (goto-char beg) + ;; `for', `if' keywords + (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) + (goto-char (match-end 1)) + (setq point (point-marker)) + ;; exception: in literal or preceded by `end' or label + (when (and (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal))) + (save-excursion + (beginning-of-line 1) + (save-match-data + (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" + (match-beginning 1) t) + (not (string-match + "\\(\\\\|\\\\|\\w+\\s-*:\\)\\s-*$" + (match-string 1))))))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)))))) + +(defun vhdl-fix-statement-buffer () + "Force statements in buffer on separate line except when on same line +with 'end' keyword (necessary for correct indentation)." + (interactive) + (vhdl-fix-statement-region (point-min) (point-max))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Trailing spaces + +(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) + "Remove trailing spaces in region." + (interactive "r\nP") + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward "[ \t]+$" end t) + (unless (vhdl-in-literal) + (replace-match "" nil nil))))) + +(defun vhdl-remove-trailing-spaces () + "Remove trailing spaces in buffer." + (interactive) + (vhdl-remove-trailing-spaces-region (point-min) (point-max))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Beautify @@ -7922,10 +8131,17 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', `vhdl-fix-case-buffer'." (interactive "r") (setq end (save-excursion (goto-char end) (point-marker))) - (vhdl-indent-region beg end) + (save-excursion ; remove DOS EOL characters in UNIX file + (goto-char beg) + (while (search-forward " " nil t) + (replace-match "" nil t))) + (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) + (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) + (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) (let ((vhdl-align-groups t)) - (vhdl-align-region beg end)) - (vhdl-fix-case-region beg end)) + (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end))) + (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) + (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end))) (defun vhdl-beautify-buffer () "Beautify buffer by applying indentation, whitespace fixup, alignment, and @@ -8021,7 +8237,8 @@ buffer." (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) (goto-char (match-beginning 0)) (condition-case nil (vhdl-update-sensitivity-list) (error ""))) - (message "Updating sensitivity lists...done")))) + (message "Updating sensitivity lists...done"))) + (when noninteractive (save-buffer))) (defun vhdl-update-sensitivity-list () "Update sensitivity list." @@ -8047,57 +8264,57 @@ buffer." (scan-regions-list '(;; right-hand side of signal/variable assignment ;; (special case: "<=" is relational operator in a condition) - ((re-search-forward "[<:]=" proc-end t) - (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) + ((vhdl-re-search-forward "[<:]=" proc-end t) + (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) ;; if condition - ((re-search-forward "^\\s-*if\\>" proc-end t) - (re-search-forward "\\" proc-end t)) + ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) + (vhdl-re-search-forward "\\" proc-end t)) ;; elsif condition - ((re-search-forward "\\" proc-end t) - (re-search-forward "\\" proc-end t)) + ((vhdl-re-search-forward "\\" proc-end t) + (vhdl-re-search-forward "\\" proc-end t)) ;; while loop condition - ((re-search-forward "^\\s-*while\\>" proc-end t) - (re-search-forward "\\" proc-end t)) + ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) + (vhdl-re-search-forward "\\" proc-end t)) ;; exit/next condition - ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) - (re-search-forward ";" proc-end t)) + ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) + (vhdl-re-search-forward ";" proc-end t)) ;; assert condition - ((re-search-forward "\\" proc-end t) - (re-search-forward "\\(\\\\|\\\\|;\\)" proc-end t)) + ((vhdl-re-search-forward "\\" proc-end t) + (vhdl-re-search-forward "\\(\\\\|\\\\|;\\)" proc-end t)) ;; case expression - ((re-search-forward "^\\s-*case\\>" proc-end t) - (re-search-forward "\\" proc-end t)) + ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) + (vhdl-re-search-forward "\\" proc-end t)) ;; parameter list of procedure call, array index ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) (1- (point))) (progn (backward-char) (forward-sexp) (while (looking-at "(") (forward-sexp)) (point))))) - name field read-list sens-list signal-list + name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list (goto-char proc-beg) - (re-search-forward "\\" proc-mid t) + (vhdl-re-search-forward "\\" proc-mid t) (if (not (looking-at "[ \t\n\r\f]*(")) (setq sens-beg (point)) - (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) + (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) (goto-char (match-end 1)) (forward-sexp) (setq sens-end (1- (point))) (goto-char sens-beg) - (while (and (re-search-forward "\\(\\w+\\)" sens-end t) + (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) (setq sens-list (cons (downcase (match-string 0)) sens-list)) - (re-search-forward "\\s-*,\\s-*" sens-end t)))) + (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) (setq signal-list (append visible-list sens-list)) ;; search for sequential parts (goto-char proc-mid) (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) - (setq end (re-search-forward "\\" proc-end t)) - (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) + (setq end (vhdl-re-search-forward "\\" proc-end t)) + (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) (goto-char end) (backward-word 1) (vhdl-forward-sexp) - (setq seq-region-list (cons (cons end (point)) seq-region-list)) + (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process (while scan-regions-list @@ -8114,15 +8331,35 @@ buffer." (and tmp-list (< (point) (cdar tmp-list)))))) (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) (setq name (match-string 1)) + ;; get array index range (when vhdl-array-index-record-field-in-sensitivity-list - (setq field (match-string 2))) + (setq field (match-string 2)) + ;; not use if it includes a variable name + (save-match-data + (setq tmp-list visible-list) + (while (and field tmp-list) + (when (string-match + (concat "\\<" (car tmp-list) "\\>") field) + (setq field nil)) + (setq tmp-list (cdr tmp-list))))) (when (and (not (match-string 6)) ; not when formal parameter (not (and (match-string 5) ; not event attribute (not (member (downcase (match-string 5)) '("event" "last_event" "transaction"))))) (member (downcase name) signal-list)) - (unless (member-ignore-case (concat name field) read-list) - (setq read-list (cons (concat name field) read-list)))) + ;; not add if name or name+field already exists + (unless + (or (member-ignore-case name read-list) + (member-ignore-case (concat name field) read-list)) + (push (concat name field) read-list)) + (setq tmp-list read-list) + ;; remove existing name+field if name is added + (save-match-data + (while tmp-list + (when (string-match (concat "^" name field "[(.]") + (car tmp-list)) + (setq read-list (delete (car tmp-list) read-list))) + (setq tmp-list (cdr tmp-list))))) (goto-char (match-end 1))))) (setq scan-regions-list (cdr scan-regions-list))) ;; update sensitivity list @@ -8178,7 +8415,7 @@ buffer." (while (< (point) end) (when (looking-at "signal[ \t\n\r\f]+") (goto-char (match-end 0))) - (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+") + (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0)) @@ -8197,12 +8434,12 @@ buffer." (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) (if (match-string 2) ;; scan signal name - (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)") + (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0))) ;; scan alias name, check is alias of (declared) signal - (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\ \"" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) last-input-event) + (if (= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (insert-char ?\" 1)) (insert-char ?\' 1)) (self-insert-command count))) @@ -8406,7 +8630,7 @@ is omitted or nil." (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert ": ") @@ -8420,7 +8644,7 @@ is omitted or nil." (defun vhdl-electric-comma (count) "',,' --> ' <= '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "<= "))) @@ -8430,7 +8654,7 @@ is omitted or nil." (defun vhdl-electric-period (count) "'..' --> ' => '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "=> "))) @@ -8440,7 +8664,7 @@ is omitted or nil." (defun vhdl-electric-equal (count) "'==' --> ' == '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "== "))) @@ -8711,12 +8935,13 @@ since these are almost equivalent)." "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) (setq unit (upcase (or unit ""))) (cond ((equal unit "ENTITY") - (vhdl-template-field "library name" "." nil nil nil nil + (let ((begin (point))) + (vhdl-template-field "library name" "." t begin (point) nil (vhdl-work-library)) (vhdl-template-field "entity name" "(") (if (vhdl-template-field "[architecture name]" nil t) (insert ")") - (delete-char -1))) + (delete-char -1)))) ((equal unit "CONFIGURATION") (vhdl-template-field "library name" "." nil nil nil nil (vhdl-work-library)) @@ -9852,7 +10077,7 @@ otherwise." (let ((definition (upcase (or (vhdl-template-field - "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t) + "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) "")))) (cond ((equal definition "") (delete-char -4) @@ -9870,6 +10095,11 @@ otherwise." ((equal definition "FILE") (vhdl-insert-keyword " OF ") (vhdl-template-field "type" ";")) + ((equal definition "ENUM") + (kill-word -1) + (insert "(") + (setq end-pos (point-marker)) + (insert ");")) (t (insert ";"))) (when mid-pos (setq end-pos (point-marker)) @@ -10916,7 +11146,7 @@ but not if inside a comment or quote." (backward-word 1) (vhdl-case-word 1) (delete-char 1)) - (let ((invoke-char last-command-event) + (let ((invoke-char vhdl-last-input-event) (abbrev-mode -1) (vhdl-template-invoked-by-hook t)) (let ((caught (catch 'abort @@ -11640,7 +11870,8 @@ reflected in a subsequent paste operation." ;; paste formal and actual generic (insert (car (nth 0 generic)) " => " (if no-constants - (car (nth 0 generic)) + (vhdl-replace-string vhdl-actual-generic-name + (car (nth 0 generic))) (or (nth 2 generic) ""))) (setq generic-list (cdr generic-list)) (insert (if generic-list "," ")")) @@ -11783,7 +12014,7 @@ reflected in a subsequent paste operation." ;; paste generic constants (setq name (nth 0 generic)) (when name - (insert (car name)) + (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) ;; paste type (insert " : " (nth 1 generic)) ;; paste initialization @@ -11809,7 +12040,7 @@ reflected in a subsequent paste operation." (message "Pasting port as signals...") (unless no-indent (indent-according-to-mode)) (let ((margin (current-indentation)) - start port names + start port names type generic-list port-name constant-name pos (port-list (nth 2 vhdl-port-list))) (when port-list (setq start (point)) @@ -11829,7 +12060,21 @@ reflected in a subsequent paste operation." (setq names (cdr names)) (when names (insert ", "))) ;; paste type - (insert " : " (nth 3 port)) + (setq type (nth 3 port)) + (setq generic-list (nth 1 vhdl-port-list)) + (vhdl-prepare-search-1 + (setq pos 0) + ;; replace formal by actual generics + (while generic-list + (setq port-name (car (nth 0 (car generic-list)))) + (while (string-match (concat "\\<" port-name "\\>") type pos) + (setq constant-name + (save-match-data (vhdl-replace-string + vhdl-actual-generic-name port-name))) + (setq type (replace-match constant-name t nil type)) + (setq pos (match-end 0))) + (setq generic-list (cdr generic-list)))) + (insert " : " type) ;; paste initialization (inputs only) (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) (insert " := " @@ -12417,77 +12662,6 @@ expressions (e.g. for index ranges of types and signals)." '(try-expand-list try-expand-list-all-buffers))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Case fixing - -(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) - "Convert all words matching WORD-REGEXP in region to lower or upper case, -depending on parameter UPPER-CASE." - (let ((case-replace nil) - (last-update 0)) - (vhdl-prepare-search-2 - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char beg) - (while (re-search-forward word-regexp end t) - (or (vhdl-in-literal) - (if upper-case - (upcase-word -1) - (downcase-word -1))) - (when (and count vhdl-progress-interval (not noninteractive) - (< vhdl-progress-interval - (- (nth 1 (current-time)) last-update))) - (message "Fixing case... (%2d%s)" - (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) - "%") - (setq last-update (nth 1 (current-time))))) - (goto-char end))))) - -(defun vhdl-fix-case-region (beg end &optional arg) - "Convert all VHDL words in region to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-types vhdl-types-regexp 1) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-constants vhdl-constants-regexp 4) - (when vhdl-progress-interval (message "Fixing case...done"))) - -(defun vhdl-fix-case-buffer () - "Convert all VHDL words in buffer to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive) - (vhdl-fix-case-region (point-min) (point-max))) - -(defun vhdl-fix-case-word (&optional arg) - "Convert word after cursor to upper case if necessary." - (interactive "p") - (save-excursion - (when arg (backward-word 1)) - (vhdl-prepare-search-1 - (when (and vhdl-upper-case-keywords - (looking-at vhdl-keywords-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-types - (looking-at vhdl-types-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-attributes - (looking-at vhdl-attributes-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-enum-values - (looking-at vhdl-enum-values-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-constants - (looking-at vhdl-constants-regexp)) - (upcase-word 1))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Line handling functions @@ -12642,7 +12816,7 @@ it works within comments too." ;; print results (message "\n\ File statistics: \"%s\"\n\ ----------------------\n\ +-----------------------\n\ # statements : %5d\n\ # code lines : %5d\n\ # empty lines : %5d\n\ @@ -13493,9 +13667,9 @@ hierarchy otherwise.") (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) (equal "USE" (upcase (match-string 1)))) (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") - (setq lib-alist (cons (cons (match-string-no-properties 1) + (push (cons (match-string-no-properties 1) (vhdl-match-string-downcase 2)) - lib-alist)))))) + lib-alist))))) lib-alist)) (defun vhdl-scan-directory-contents (name &optional project update num-string @@ -13541,7 +13715,7 @@ hierarchy otherwise.") file-tmp-list) (while file-list (unless (string-match file-exclude-regexp (car file-list)) - (setq file-tmp-list (cons (car file-list) file-tmp-list))) + (push (car file-list) file-tmp-list)) (setq file-list (cdr file-list))) (setq file-list (nreverse file-tmp-list)))) ;; do for all files @@ -13576,7 +13750,7 @@ hierarchy otherwise.") "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" ent-name (nth 1 ent-entry) (nth 2 ent-entry) file-name (vhdl-current-line)) - (setq ent-list (cons ent-key ent-list)) + (push ent-key ent-list) (aput 'ent-alist ent-key (list ent-name file-name (vhdl-current-line) (nth 3 ent-entry) (nth 4 ent-entry) @@ -13628,7 +13802,7 @@ hierarchy otherwise.") "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" conf-name ent-name (nth 1 conf-entry) (nth 2 conf-entry) file-name conf-line) - (setq conf-list (cons conf-key conf-list)) + (push conf-key conf-list) ;; scan for subconfigurations and subentities (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t) (setq inst-comp-key (vhdl-match-string-downcase 3) @@ -13691,8 +13865,8 @@ hierarchy otherwise.") (setq func-alist (nreverse func-alist)) (setq comp-alist (nreverse comp-alist)) (if is-body - (setq pack-body-list (cons pack-key pack-body-list)) - (setq pack-list (cons pack-key pack-list))) + (push pack-key pack-body-list) + (push pack-key pack-list)) (aput 'pack-alist pack-key (if is-body @@ -13946,7 +14120,7 @@ of PROJECT." (let ((case-fold-search nil)) (while dir-list (unless (string-match file-exclude-regexp (car dir-list)) - (setq dir-list-tmp (cons (car dir-list) dir-list-tmp))) + (push (car dir-list) dir-list-tmp)) (setq dir-list (cdr dir-list))) (setq dir-list (nreverse dir-list-tmp)))) (message "Collecting source files...done") @@ -14338,12 +14512,19 @@ if required." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Add hierarchy browser functionality to speedbar -(defvar vhdl-speedbar-key-map nil +(defvar vhdl-speedbar-mode-map nil "Keymap used when in the VHDL hierarchy browser mode.") (defvar vhdl-speedbar-menu-items nil "Additional menu-items to add to speedbar frame.") +(declare-function speedbar-add-supported-extension "speedbar" (extension)) +(declare-function speedbar-add-mode-functions-list "speedbar" (new-list)) +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" + (new-default)) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) + (defun vhdl-speedbar-initialize () "Initialize speedbar." ;; general settings @@ -14366,24 +14547,24 @@ if required." (speedbar-item-info . vhdl-speedbar-item-info) (speedbar-line-directory . vhdl-speedbar-line-project))) ;; keymap - (unless vhdl-speedbar-key-map - (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches) + (unless vhdl-speedbar-mode-map + (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) + (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) (let ((key 0)) (while (<= key 9) - (define-key vhdl-speedbar-key-map (int-to-string key) + (define-key vhdl-speedbar-mode-map (int-to-string key) `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) (setq key (1+ key))))) (define-key speedbar-mode-map "h" @@ -14436,10 +14617,10 @@ if required." ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) ;; hook-ups (speedbar-add-expansion-list - '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-directory)) (speedbar-add-expansion-list - '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-projects)) (setq speedbar-stealthy-function-list (append @@ -14473,11 +14654,15 @@ if required." "Name of last selected project.") ;; macros must be defined in the file they are used (copied from `speedbar.el') -(defmacro speedbar-with-writable (&rest forms) - "Allow the buffer to be writable and evaluate FORMS." - (list 'let '((inhibit-read-only t)) - (cons 'progn forms))) -(put 'speedbar-with-writable 'lisp-indent-function 0) +;;; (defmacro speedbar-with-writable (&rest forms) +;;; "Allow the buffer to be writable and evaluate FORMS." +;;; (list 'let '((inhibit-read-only t)) +;;; (cons 'progn forms))) +;;; (put 'speedbar-with-writable 'lisp-indent-function 0) + +(declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) +(declare-function speedbar-directory-buttons "speedbar" (directory _index)) +(declare-function speedbar-file-lists "speedbar" (directory)) (defun vhdl-speedbar-display-directory (directory depth &optional rescan) "Display directory and hierarchy information in speedbar." @@ -14513,6 +14698,9 @@ if required." (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) (setq speedbar-full-text-cache nil)) ; prevent caching +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) + (defun vhdl-speedbar-insert-projects () "Insert all projects in speedbar." (vhdl-speedbar-make-title-line "Projects:") @@ -14616,6 +14804,8 @@ otherwise use cached data." depth) (setq pack-alist (cdr pack-alist)))))) +(declare-function speedbar-line-directory "speedbar" (&optional depth)) + (defun vhdl-speedbar-rescan-hierarchy () "Rescan hierarchy for the directory or project under the cursor." (interactive) @@ -14637,6 +14827,8 @@ otherwise use cached data." (abbreviate-file-name (match-string 1 path))))) (vhdl-speedbar-refresh key))) +(declare-function speedbar-goto-this-file "speedbar" (file)) + (defun vhdl-speedbar-expand-dirs (directory) "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." @@ -14686,6 +14878,8 @@ otherwise use cached data." (setq unit-alist (cdr unit-alist)))))) (vhdl-speedbar-update-current-unit nil t)) +(declare-function speedbar-center-buffer-smartly "speedbar" ()) + (defun vhdl-speedbar-contract-level () "Contract current level in current directory/project." (interactive) @@ -14726,21 +14920,24 @@ otherwise use cached data." (setq arch-alist (nth 4 (car ent-alist))) (setq subunit-alist nil) (while arch-alist - (setq subunit-alist (cons (caar arch-alist) subunit-alist)) + (push (caar arch-alist) subunit-alist) (setq arch-alist (cdr arch-alist))) - (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist)) + (push (list (caar ent-alist) subunit-alist) unit-alist) (setq ent-alist (cdr ent-alist))) (while conf-alist - (setq unit-alist (cons (list (caar conf-alist)) unit-alist)) + (push (list (caar conf-alist)) unit-alist) (setq conf-alist (cdr conf-alist))) (while pack-alist - (setq unit-alist (cons (list (caar pack-alist)) unit-alist)) + (push (list (caar pack-alist)) unit-alist) (setq pack-alist (cdr pack-alist))) (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (vhdl-speedbar-refresh) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) +(declare-function speedbar-change-expand-button-char "speedbar" (char)) +(declare-function speedbar-delete-subblock "speedbar" (indent)) + (defun vhdl-speedbar-expand-project (text token indent) "Expand/contract the project under the cursor." (cond @@ -15069,6 +15266,8 @@ otherwise use cached data." (setq vhdl-speedbar-last-selected-project vhdl-project))) t) +(declare-function speedbar-position-cursor-on-line "speedbar" ()) + (defun vhdl-speedbar-update-current-unit (&optional no-position always) "Highlight all design units that are contained in the current file. NO-POSITION non-nil means do not re-position cursor." @@ -15158,6 +15357,9 @@ NO-POSITION non-nil means do not re-position cursor." (setq unit-list (cdr unit-list))) pos) +(declare-function speedbar-make-button "speedbar" + (start end face mouse function &optional token)) + (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker ent-name ent-file-marker arch-name arch-file-marker @@ -15344,6 +15546,8 @@ NO-POSITION non-nil means do not re-position cursor." 'speedbar-directory-face level) (setq dirs (cdr dirs))))) +(declare-function speedbar-reset-scanners "speedbar" ()) + (defun vhdl-speedbar-dired (text token indent) "Speedbar click handler for directory expand button in hierarchy mode." (cond ((string-match "+" text) ; we have to expand this dir @@ -15374,7 +15578,7 @@ NO-POSITION non-nil means do not re-position cursor." (concat (speedbar-line-directory indent) token)))) (while oldl (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) - (setq newl (cons (car oldl) newl))) + (push (car oldl) newl)) (setq oldl (cdr oldl))) (setq speedbar-shown-directories (nreverse newl))) (speedbar-change-expand-button-char ?+) @@ -15383,6 +15587,8 @@ NO-POSITION non-nil means do not re-position cursor." (when (equal (selected-frame) speedbar-frame) (speedbar-center-buffer-smartly))) +(declare-function speedbar-files-item-info "speedbar" ()) + (defun vhdl-speedbar-item-info () "Derive and display information about this line item." (save-excursion @@ -15431,6 +15637,8 @@ NO-POSITION non-nil means do not re-position cursor." (vhdl-default-directory))))) (t (message ""))))) +(declare-function speedbar-line-text "speedbar" (&optional p)) + (defun vhdl-speedbar-line-text () "Calls `speedbar-line-text' and removes text properties." (let ((string (speedbar-line-text))) @@ -15481,7 +15689,7 @@ NO-POSITION non-nil means do not re-position cursor." (setq dir (car path-list)) (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) (if (file-directory-p (match-string 2 dir)) - (setq path-list-1 (cons dir path-list-1)) + (push dir path-list-1) (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) (setq path-list (cdr path-list))) ;; resolve path wildcards @@ -15503,13 +15711,13 @@ NO-POSITION non-nil means do not re-position cursor." dir-list) (while all-list (when (file-directory-p (car all-list)) - (setq dir-list (cons (car all-list) dir-list))) + (push (car all-list) dir-list)) (setq all-list (cdr all-list))) dir-list)) (cdr path-list-1)))) (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) (when (file-directory-p (match-string 2 dir)) - (setq path-list-2 (cons dir path-list-2))) + (push dir path-list-2)) (setq path-list-1 (cdr path-list-1)))) (nreverse path-list-2))) @@ -15525,6 +15733,11 @@ NO-POSITION non-nil means do not re-position cursor." (goto-char dest) nil))) +(declare-function speedbar-find-file-in-frame "speedbar" (file)) +(declare-function speedbar-set-timer "speedbar" (timeout)) +;; speedbar loads dframe at runtime. +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun vhdl-speedbar-find-file (text token indent) "When user clicks on TEXT, load file with name and position in TOKEN. Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file @@ -15534,12 +15747,11 @@ is already shown in a buffer." (let ((buffer (get-file-buffer (car token)))) (speedbar-find-file-in-frame (car token)) (when (or vhdl-speedbar-jump-to-unit buffer) - (goto-char (point-min)) - (forward-line (1- (cdr token))) + (vhdl-goto-line (cdr token)) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) - (speedbar-maybee-jump-to-attached-frame)))) + (dframe-maybee-jump-to-attached-frame)))) (defun vhdl-speedbar-port-copy () "Copy the port of the entity/component or subprogram under the cursor." @@ -15553,8 +15765,7 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) + (progn (vhdl-goto-line (cdr token)) (end-of-line) (if is-entity (vhdl-port-copy) @@ -15600,6 +15811,8 @@ is already shown in a buffer." (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) (speedbar-refresh)))) +(declare-function speedbar-line-file "speedbar" (&optional p)) + (defun vhdl-speedbar-make-design () "Make (compile) design unit or directory/project under the cursor." (interactive) @@ -16007,7 +16220,7 @@ component instantiation." (or (aget generic-alist (match-string 2) t) (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar generic-alist)))) - (setq constant-alist (cons constant-entry constant-alist)) + (push constant-entry constant-alist) (setq constant-name (downcase constant-name)) (if (or (member constant-name single-list) (member constant-name multi-list)) @@ -16027,7 +16240,7 @@ component instantiation." (or (aget port-alist (match-string 2) t) (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar port-alist)))) - (setq signal-alist (cons signal-entry signal-alist)) + (push signal-entry signal-alist) (setq signal-name (downcase signal-name)) (if (equal (upcase (nth 2 signal-entry)) "IN") ;; input signal @@ -16061,8 +16274,8 @@ component instantiation." (unless (match-string 1) (setq port-alist (cdr port-alist))) (vhdl-forward-syntactic-ws)) - (setq inst-alist (cons (list inst-name (nreverse constant-alist) - (nreverse signal-alist)) inst-alist))) + (push (list inst-name (nreverse constant-alist) + (nreverse signal-alist)) inst-alist)) ;; prepare signal insertion (vhdl-goto-marker arch-decl-pos) (forward-line 1) @@ -16129,6 +16342,7 @@ component instantiation." (while constant-alist (setq constant-name (downcase (caar constant-alist)) constant-entry (car constant-alist)) + (unless (string-match "^[0-9]+" constant-name) (cond ((member constant-name written-list) nil) ((member constant-name multi-list) @@ -16145,7 +16359,7 @@ component instantiation." (setq generic-end-pos (vhdl-compose-insert-generic constant-entry)) (setq generic-inst-pos (point-marker)) - (add-to-list 'written-list constant-name))) + (add-to-list 'written-list constant-name)))) (setq constant-alist (cdr constant-alist))) (when (/= constant-temp-pos generic-inst-pos) (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) @@ -16305,8 +16519,7 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) + (progn (vhdl-goto-line (nth 3 (car ent-alist))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) @@ -16562,12 +16775,12 @@ no project is defined." (setq sublist (nth 11 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons (list (nth 0 sublist) - (if (= 0 (nth 1 sublist)) - (if (featurep 'xemacs) 9 nil) + (push (list (nth 0 sublist) + (if (and (featurep 'xemacs) (not (nth 1 sublist))) + 9 (nth 1 sublist)) (nth 2 sublist) (nth 3 sublist)) - regexp-alist))) + regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-error-regexp-alist (append compilation-error-regexp-alist (nreverse regexp-alist)))) @@ -16580,7 +16793,7 @@ no project is defined." (setq sublist (nth 12 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons sublist regexp-alist))) + (push sublist regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-file-regexp-alist (append compilation-file-regexp-alist (nreverse regexp-alist)))))) @@ -16709,6 +16922,42 @@ specified by a target." (compile (concat (if (equal command "") "make" command) " " options " " vhdl-make-target)))) +;; Emacs 22+ setup +(defvar vhdl-error-regexp-emacs-alist + ;; Get regexps from `vhdl-compiler-alist' + (let ((compiler-alist vhdl-compiler-alist) + (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) + (while compiler-alist + ;; add error message regexps + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) + (nth 11 (car compiler-alist))) + error-regexp-alist)) + ;; add filename regexps + (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) + (nth 12 (car compiler-alist))) + error-regexp-alist))) + (setq compiler-alist (cdr compiler-alist))) + error-regexp-alist) + "List of regexps for VHDL compilers. For Emacs 22+.") + +;; Add error regexps using compilation-mode-hook. +(defun vhdl-error-regexp-add-emacs () + "Set up Emacs compile for VHDL." + (interactive) + (when (and (boundp 'compilation-error-regexp-alist-alist) + (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) + (mapcar + (lambda (item) + (push (car item) compilation-error-regexp-alist) + (push item compilation-error-regexp-alist-alist)) + vhdl-error-regexp-emacs-alist))) + +(when vhdl-emacs-22 + (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -16731,7 +16980,7 @@ specified by a target." (let (pack-list) (while lib-alist (when (equal (downcase (caar lib-alist)) (downcase work-library)) - (setq pack-list (cons (cdar lib-alist) pack-list))) + (push (cdar lib-alist) pack-list)) (setq lib-alist (cdr lib-alist))) pack-list)) @@ -16783,8 +17032,10 @@ specified by a target." (setq ent-entry (car ent-alist) ent-key (nth 0 ent-entry)) (when (nth 2 ent-entry) - (setq ent-file-name (file-relative-name - (nth 2 ent-entry) compile-directory) + (setq ent-file-name (if vhdl-compile-absolute-path + (nth 2 ent-entry) + (file-relative-name (nth 2 ent-entry) + compile-directory)) arch-alist (nth 4 ent-entry) lib-alist (nth 6 ent-entry) rule (aget rule-alist ent-file-name) @@ -16794,9 +17045,9 @@ specified by a target." subcomp-list nil) (setq tmp-key (vhdl-replace-string ent-regexp (funcall adjust-case ent-key))) - (setq unit-list (cons (cons ent-key tmp-key) unit-list)) + (push (cons ent-key tmp-key) unit-list) ;; rule target for this entity - (setq target-list (cons ent-key target-list)) + (push ent-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16808,8 +17059,10 @@ specified by a target." (setq arch-entry (car arch-alist) arch-key (nth 0 arch-entry) ent-arch-key (concat ent-key "-" arch-key) - arch-file-name (file-relative-name (nth 2 arch-entry) - compile-directory) + arch-file-name (if vhdl-compile-absolute-path + (nth 2 arch-entry) + (file-relative-name (nth 2 arch-entry) + compile-directory)) inst-alist (nth 4 arch-entry) lib-alist (nth 5 arch-entry) rule (aget rule-alist arch-file-name) @@ -16820,11 +17073,11 @@ specified by a target." (funcall adjust-case (concat arch-key " " ent-key)))) (setq unit-list (cons (cons ent-arch-key tmp-key) unit-list)) - (setq second-list (cons ent-arch-key second-list)) + (push ent-arch-key second-list) ;; rule target for this architecture - (setq target-list (cons ent-arch-key target-list)) + (push ent-arch-key target-list) ;; rule dependency for corresponding entity - (setq depend-list (cons ent-key depend-list)) + (push ent-key depend-list) ;; rule dependencies for contained component instantiations (while inst-alist (setq inst-entry (car inst-alist)) @@ -16842,9 +17095,8 @@ specified by a target." ;; add rule (aput 'rule-alist arch-file-name (list target-list depend-list)) (setq arch-alist (cdr arch-alist))) - (setq prim-list (cons (list ent-key second-list - (append subcomp-list all-pack-list)) - prim-list))) + (push (list ent-key second-list (append subcomp-list all-pack-list)) + prim-list)) (setq ent-alist (cdr ent-alist))) (setq ent-alist tmp-list) ;; rules for all configurations @@ -16852,8 +17104,10 @@ specified by a target." (while conf-alist (setq conf-entry (car conf-alist) conf-key (nth 0 conf-entry) - conf-file-name (file-relative-name - (nth 2 conf-entry) compile-directory) + conf-file-name (if vhdl-compile-absolute-path + (nth 2 conf-entry) + (file-relative-name (nth 2 conf-entry) + compile-directory)) ent-key (nth 4 conf-entry) arch-key (nth 5 conf-entry) inst-alist (nth 6 conf-entry) @@ -16864,9 +17118,9 @@ specified by a target." subcomp-list (list ent-key)) (setq tmp-key (vhdl-replace-string conf-regexp (funcall adjust-case conf-key))) - (setq unit-list (cons (cons conf-key tmp-key) unit-list)) + (push (cons conf-key tmp-key) unit-list) ;; rule target for this configuration - (setq target-list (cons conf-key target-list)) + (push conf-key target-list) ;; rule dependency for corresponding entity and architecture (setq depend-list (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) @@ -16884,16 +17138,14 @@ specified by a target." (setq depend-list (cons inst-ent-key depend-list) subcomp-list (cons inst-ent-key subcomp-list))) ; (when comp-arch-key -; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key) -; depend-list))) +; (push (concat comp-ent-key "-" comp-arch-key) depend-list)) (when inst-conf-key (setq depend-list (cons inst-conf-key depend-list) subcomp-list (cons inst-conf-key subcomp-list)))) (setq inst-alist (cdr inst-alist))) ;; add rule (aput 'rule-alist conf-file-name (list target-list depend-list)) - (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list)) - prim-list)) + (push (list conf-key nil (append subcomp-list pack-list)) prim-list) (setq conf-alist (cdr conf-alist))) (setq conf-alist tmp-list) ;; rules for all packages @@ -16903,16 +17155,18 @@ specified by a target." pack-key (nth 0 pack-entry) pack-body-key nil) (when (nth 2 pack-entry) - (setq pack-file-name (file-relative-name (nth 2 pack-entry) - compile-directory) + (setq pack-file-name (if vhdl-compile-absolute-path + (nth 2 pack-entry) + (file-relative-name (nth 2 pack-entry) + compile-directory)) lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) rule (aget rule-alist pack-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string pack-regexp (funcall adjust-case pack-key))) - (setq unit-list (cons (cons pack-key tmp-key) unit-list)) + (push (cons pack-key tmp-key) unit-list) ;; rule target for this package - (setq target-list (cons pack-key target-list)) + (push pack-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16922,8 +17176,10 @@ specified by a target." ;; rules for this package's body (when (nth 7 pack-entry) (setq pack-body-key (concat pack-key "-body") - pack-body-file-name (file-relative-name (nth 7 pack-entry) - compile-directory) + pack-body-file-name (if vhdl-compile-absolute-path + (nth 7 pack-entry) + (file-relative-name (nth 7 pack-entry) + compile-directory)) rule (aget rule-alist pack-body-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) @@ -16932,9 +17188,9 @@ specified by a target." (setq unit-list (cons (cons pack-body-key tmp-key) unit-list)) ;; rule target for this package's body - (setq target-list (cons pack-body-key target-list)) + (push pack-body-key target-list) ;; rule dependency for corresponding package declaration - (setq depend-list (cons pack-key depend-list)) + (push pack-key depend-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-body-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -17057,16 +17313,16 @@ specified by a target." (unless (equal unit-key unit-name) (insert " \\\n" unit-name)) (insert " :" - " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) - " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") - (while second-list - (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") - (setq second-list (cdr second-list))) + " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) (while subcomp-list (when (and (assoc (car subcomp-list) unit-list) (not (equal unit-key (car subcomp-list)))) (insert " \\\n\t\t" (car subcomp-list))) (setq subcomp-list (cdr subcomp-list))) + (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") + (while second-list + (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") + (setq second-list (cdr second-list))) (insert "\n") (setq prim-list (cdr prim-list))) ;; insert rule for each library unit file @@ -17205,6 +17461,7 @@ specified by a target." 'vhdl-include-direction-comments 'vhdl-include-type-comments 'vhdl-include-group-comments + 'vhdl-actual-generic-name 'vhdl-actual-port-name 'vhdl-instance-name 'vhdl-testbench-entity-name @@ -17287,12 +17544,20 @@ specified by a target." (defconst vhdl-doc-release-notes nil "\ -Release Notes for VHDL Mode 3.33 +Release Notes for VHDL Mode 3.34 ================================ - - New Features - - User Options +- Added support for GNU Emacs 22/23/24: + - Compilation error parsing fixed for new `compile.el' package. +- Port translation: Derive actual generic name from formal generic name. + +- New user options: + `vhdl-actual-generic-name': Specify how actual generic names are obtained. + + +Release Notes for VHDL Mode 3.33 +================================ New Features ------------ diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index edfe368479c..aa68f9fcc1a 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -1,6 +1,6 @@ ;;; which-func.el --- print current function in mode line -;; Copyright (C) 1994, 1997-1998, 2001-2013 Free Software Foundation, +;; Copyright (C) 1994, 1997-1998, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Alex Rezinsky @@ -343,6 +343,10 @@ If no function name is found, return nil." ;;; Integration with other packages +(defvar ediff-window-A) +(defvar ediff-window-B) +(defvar ediff-window-C) + (defun which-func-update-ediff-windows () "Update Which-Function mode display for Ediff windows. This function is meant to be called from `ediff-select-hook'." diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 2ad44b4b1c8..e22581445e5 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -1,9 +1,9 @@ ;;; xscheme.el --- run MIT Scheme under Emacs -;; Copyright (C) 1986-1987, 1989-1990, 2001-2013 Free Software +;; Copyright (C) 1986-1987, 1989-1990, 2001-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, lisp ;; This file is part of GNU Emacs. @@ -35,7 +35,6 @@ ;;;; Internal Variables (defvar xscheme-previous-mode) -(defvar xscheme-previous-process-state) (defvar xscheme-last-input-end) (defvar xscheme-process-command-line nil @@ -388,8 +387,6 @@ with no args, if that value is non-nil. (if (not preserve) (let ((previous-mode major-mode)) (kill-all-local-variables) - (make-local-variable 'xscheme-process-name) - (make-local-variable 'xscheme-previous-process-state) (make-local-variable 'xscheme-runlight-string) (make-local-variable 'xscheme-runlight) (set (make-local-variable 'xscheme-previous-mode) previous-mode) @@ -397,35 +394,29 @@ with no args, if that value is non-nil. (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) (set (make-local-variable 'xscheme-last-input-end) (make-marker)) (let ((process (get-buffer-process buffer))) - (if process - (progn - (setq xscheme-process-name (process-name process)) - (setq xscheme-previous-process-state - (cons (process-filter process) - (process-sentinel process))) - (xscheme-process-filter-initialize t) - (xscheme-mode-line-initialize xscheme-buffer-name) - (set-process-sentinel process 'xscheme-process-sentinel) - (set-process-filter process 'xscheme-process-filter)) - (setq xscheme-previous-process-state (cons nil nil))))))) + (when process + (setq-local xscheme-process-name (process-name process)) + ;; FIXME: Use add-function! + (xscheme-process-filter-initialize t) + (xscheme-mode-line-initialize xscheme-buffer-name) + (add-function :override (process-sentinel process) + #'xscheme-process-sentinel) + (add-function :override (process-filter process) + #'xscheme-process-filter)))))) (scheme-interaction-mode-initialize) (scheme-mode-variables) (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) (defun exit-scheme-interaction-mode () - "Take buffer out of scheme interaction mode" + "Take buffer out of scheme interaction mode." (interactive) (if (not (derived-mode-p 'scheme-interaction-mode)) (error "Buffer not in scheme interaction mode")) - (let ((previous-state xscheme-previous-process-state)) - (funcall xscheme-previous-mode) - (let ((process (get-buffer-process (current-buffer)))) - (if process - (progn - (if (eq (process-filter process) 'xscheme-process-filter) - (set-process-filter process (car previous-state))) - (if (eq (process-sentinel process) 'xscheme-process-sentinel) - (set-process-sentinel process (cdr previous-state)))))))) + (funcall xscheme-previous-mode) + (let ((process (get-buffer-process (current-buffer)))) + (when process + (remove-function (process-sentinel process) #'xscheme-process-sentinel) + (remove-function (process-filter process) #'xscheme-process-filter)))) (defvar scheme-interaction-mode-commands-alist nil) (defvar scheme-interaction-mode-map nil) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 832d1cf55bc..12e9541b4c7 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -1,6 +1,6 @@ ;;; ps-bdf.el --- BDF font file handler for ps-print -;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999, 2001-2014 Free Software Foundation, Inc. ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, ;; 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) @@ -91,12 +91,7 @@ If BDFNAME doesn't exist, return nil." (insert-file-contents bdfname) buf)))) -(defvar bdf-cache-file (if (eq system-type 'ms-dos) - ;; convert-standard-filename doesn't - ;; guarantee that the .el extension will be - ;; preserved. - "~/_bdfcache.el" - (convert-standard-filename "~/.bdfcache.el")) +(defvar bdf-cache-file (locate-user-emacs-file "bdfcache.el" ".bdfcache.el") "Name of cache file which contains information of `BDF' font files.") (defvar bdf-cache nil diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 468af28240f..06cef75cbbd 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -1,6 +1,6 @@ ;;; ps-def.el --- XEmacs and Emacs definitions for ps-print -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Kenichi Handa (multi-byte characters) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 4da5d1db244..21868b091d9 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1,6 +1,6 @@ ;;; ps-mule.el --- provide multi-byte character facility to ps-print -;; Copyright (C) 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Kenichi Handa (multi-byte characters) @@ -188,7 +188,32 @@ See also the variable `ps-font-info-database'.") (defcustom ps-mule-font-info-database-default ps-mule-font-info-database-latin "The default setting to use when `ps-multibyte-buffer' is nil." - :type '(symbol :tag "Multi-Byte Buffer Database Font Default") + :type '(alist :key-type symbol :tag "Charset" + :value-type + (list (list + (choice :tag "Font type" + (const normal) + (const bold) + (const italic) + (const bold-italic)) + (choice :tag "Font source" + (const builtin) + (const bdf) + (const vflib) + (const nil)) + ;; My guess as to what the doc is trying to say... + (choice :tag "Font name" + (const nil) + string + (repeat :tag "List" string)) + (choice :tag "Encoding" + (const nil) + coding-system + function) + (choice :tag "Bytes" + (const nil) + (const 1) + (const 2))))) :group 'ps-print-font) (defconst ps-mule-font-info-database-ps @@ -1033,6 +1058,7 @@ It checks if all multi-byte characters in the region are printable or not." (= (skip-chars-forward "\x00-\x7F" to) to))) ;; All characters can be printed by normal PostScript fonts. (setq ps-basic-plot-string-function 'ps-basic-plot-string + ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? ps-encode-header-string-function 'identity) (setq ps-basic-plot-string-function 'ps-mule-plot-string ps-encode-header-string-function 'ps-mule-encode-header-string diff --git a/lisp/ps-print.el b/lisp/ps-print.el index f7c03c2de85..6251a6caa87 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1,6 +1,6 @@ ;;; ps-print.el --- print text from the buffer as PostScript -;; Copyright (C) 1993-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-2014 Free Software Foundation, Inc. ;; Author: Jim Thompson (was ) ;; Jacques Duthen (was ) @@ -1472,12 +1472,6 @@ Please send all bug fixes and enhancements to (error "`ps-print' only supports Emacs 23 and higher"))) -(defconst ps-windows-system - (memq system-type '(ms-dos windows-nt))) -(defconst ps-lp-system - (memq system-type '(usg-unix-v hpux irix))) - - ;; Load XEmacs/Emacs definitions (require 'ps-def) @@ -1676,8 +1670,7 @@ For more information about PostScript document comments, see: :version "20" :group 'ps-print-miscellany) -(defcustom ps-printer-name (and (boundp 'printer-name) - (symbol-value 'printer-name)) +(defcustom ps-printer-name nil "The name of a local printer for printing PostScript files. On Unix-like systems, a string value should be a name understood by lpr's -P @@ -1709,12 +1702,8 @@ See also `ps-printer-name-option' for documentation." :group 'ps-print-printer) (defcustom ps-printer-name-option - (cond (ps-windows-system - "/D:") - (ps-lp-system - "-d") - (t - "-P" )) + (cond (lpr-windows-system "/D:") + (t lpr-printer-switch)) "Option for `ps-printer-name' variable (see it). On Unix-like systems, if `lpr' is in use, this should be the string @@ -1729,8 +1718,6 @@ Set this to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty printer name option--that is, pass the printer name with no special option preceding it. -Any value that is not a string is treated as nil. - This variable is used only when `ps-printer-name' is a non-empty string." :type '(choice :menu-tag "Printer Name Option" :tag "Printer Name Option" @@ -1782,11 +1769,14 @@ See `ps-lpr-command'." :version "20" :group 'ps-print-printer) -(defcustom ps-print-region-function nil +(defcustom ps-print-region-function + (if (memq system-type '(ms-dos windows-nt)) + #'w32-direct-ps-print-region-function + #'call-process-region) "Specify a function to print the region on a PostScript printer. See definition of `call-process-region' for calling conventions. The fourth and the sixth arguments are both nil." - :type '(choice (const nil) function) + :type 'function :version "20" :group 'ps-print-printer) @@ -1798,7 +1788,7 @@ If it's nil, automatic feeding takes place." :version "20" :group 'ps-print-printer) -(defcustom ps-end-with-control-d (and ps-windows-system t) +(defcustom ps-end-with-control-d (and lpr-windows-system t) "Non-nil means insert C-d at end of PostScript file generated." :version "21.1" :type 'boolean @@ -2636,7 +2626,7 @@ NOTE: page numbers are displayed as part of headers, :group 'ps-print-headers) (defcustom ps-spool-config - (if ps-windows-system + (if lpr-windows-system nil 'lpr-switches) "Specify who is responsible for setting duplex and page size. @@ -3017,7 +3007,6 @@ Any other value is ignored and black color will be used. This variable is used only when `ps-print-color-p' (which see) is neither nil nor black-white." :type '(choice :menu-tag "Default Foreground Gray/Color" - :tag "Default Foreground Gray/Color" (const :tag "Session Foreground" t) (const :tag "Frame Foreground" frame-parameter) (number :tag "Gray Scale" :value 0.0) @@ -3025,7 +3014,8 @@ nor black-white." (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") - (number :tag "Blue"))) + (number :tag "Blue")) + (other :tag "Default Foreground Gray/Color" nil)) :version "20" :group 'ps-print-color) @@ -3063,7 +3053,6 @@ nor black-white. See also `ps-use-face-background'." :type '(choice :menu-tag "Default Background Gray/Color" - :tag "Default Background Gray/Color" (const :tag "Session Background" t) (const :tag "Frame Background" frame-parameter) (number :tag "Gray Scale" :value 1.0) @@ -3071,7 +3060,8 @@ See also `ps-use-face-background'." (list :tag "RGB Color" :value (1.0 1.0 1.0) (number :tag "Red") (number :tag "Green") - (number :tag "Blue"))) + (number :tag "Blue")) + (other :tag "Default Background Gray/Color" nil)) :version "20" :group 'ps-print-color) @@ -3389,15 +3379,12 @@ It's like the very first character of buffer (or region) is ^L (\\014)." :group 'ps-print-headers) (defcustom ps-postscript-code-directory - (or (if (featurep 'xemacs) - (cond ((fboundp 'locate-data-directory) ; XEmacs - (funcall 'locate-data-directory "ps-print")) - ((boundp 'data-directory) ; XEmacs - (symbol-value 'data-directory)) - (t ; don't know what to do - nil)) - data-directory) ; Emacs - (error "`ps-postscript-code-directory' isn't set properly")) + (cond ((fboundp 'locate-data-directory) ; XEmacs + (locate-data-directory "ps-print")) + ((boundp 'data-directory) ; XEmacs and Emacs. + data-directory) + (t ; don't know what to do + (error "`ps-postscript-code-directory' isn't set properly"))) "Directory where it's located the PostScript prologue file used by ps-print. By default, this directory is the same as in the variable `data-directory'." :type 'directory @@ -3646,8 +3633,7 @@ The table depends on the current ps-print setup." ") ps-print version " ps-print-version "\n") ";; internal vars" (ps-comment-string "emacs-version " emacs-version) - (ps-comment-string "ps-windows-system " ps-windows-system) - (ps-comment-string "ps-lp-system " ps-lp-system) + (ps-comment-string "lpr-windows-system" lpr-windows-system) nil '(25 . ps-print-color-p) '(25 . ps-lpr-command) @@ -5426,8 +5412,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") "%%Title: " (buffer-name) ; Take job name from name of ; first buffer printed "\n%%Creator: ps-print v" ps-print-version - "\n%%For: " (user-full-name) - "\n%%CreationDate: " (format-time-string "%T %b %d %Y") + "\n%%For: " (user-full-name) ;FIXME: may need encoding! + "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding! "\n%%Orientation: " (if ps-landscape-mode "Landscape" "Portrait") "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font " @@ -6135,7 +6121,7 @@ to the equivalent Latin-1 characters.") (goto-char from) ;; ...break the region up into chunks separated by tabs, linefeeds, - ;; pagefeeds, control characters, and plot each chunk. + ;; formfeeds, control characters, and plot each chunk. (while (< from to) ;; skip lines between cut markers (and ps-begin-cut-regexp ps-end-cut-regexp @@ -6307,6 +6293,10 @@ If FACE is not a valid face name, use default face." ;; only background color, not a `real' face ((ps-face-background-color-p (car face-or-list)) (vector 0 nil (ps-face-extract-color face-or-list))) + ;; Anonymous face. + ((keywordp (car face-or-list)) + (vector 0 (plist-get face-or-list :foreground) + (plist-get face-or-list :background))) ;; list of faces (t (let ((effects 0) @@ -6569,96 +6559,36 @@ If FACE is not a valid face name, use default face." (write-region (point-min) (point-max) filename)) (and ps-razzle-dazzle (message "Wrote %s" filename))) ;; Else, spool to the printer - (and ps-razzle-dazzle (message "Printing...")) (with-current-buffer ps-spool-buffer (let* ((coding-system-for-write 'raw-text-unix) - (ps-printer-name (or ps-printer-name - (and (boundp 'printer-name) - (symbol-value 'printer-name)))) - (ps-lpr-switches - (append ps-lpr-switches - (and (stringp ps-printer-name) - (string< "" ps-printer-name) - (list (concat - (and (stringp ps-printer-name-option) - ps-printer-name-option) - ps-printer-name)))))) - (or (stringp ps-printer-name) - (setq ps-printer-name nil)) - (apply (or ps-print-region-function 'call-process-region) - (point-min) (point-max) ps-lpr-command nil - (and (fboundp 'start-process) 0) - nil - (ps-flatten-list ; dynamic evaluation - (ps-string-list - (mapcar 'ps-eval-switch ps-lpr-switches)))))) - (and ps-razzle-dazzle (message "Printing...done"))) + (printer-name (or ps-printer-name printer-name)) + (lpr-printer-switch ps-printer-name-option) + (print-region-function ps-print-region-function) + (lpr-command ps-lpr-command)) + (lpr-print-region (point-min) (point-max) ps-lpr-switches nil)))) (kill-buffer ps-spool-buffer))) -(defun ps-string-list (arg) - (let (lstr) - (dolist (elm arg) - (cond ((stringp elm) - (setq lstr (cons elm lstr))) - ((listp elm) - (let ((s (ps-string-list elm))) - (when s - (setq lstr (cons s lstr))))) - (t ))) ; ignore any other value - (nreverse lstr))) - -;; Dynamic evaluation -(defun ps-eval-switch (arg) - (cond ((stringp arg) arg) - ((functionp arg) (apply arg nil)) - ((symbolp arg) (symbol-value arg)) - ((consp arg) (apply (car arg) (cdr arg))) - (t nil))) - -;; `ps-flatten-list' is defined here (copied from "message.el" and -;; enhanced to handle dotted pairs as well) until we can get some -;; sensible autoloads, or `flatten-list' gets put somewhere decent. - -;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j)) -;; => (a b c d e f g h i j) - -(defun ps-flatten-list (&rest list) - (ps-flatten-list-1 list)) - -(defun ps-flatten-list-1 (list) - (cond ((null list) nil) - ((consp list) (append (ps-flatten-list-1 (car list)) - (ps-flatten-list-1 (cdr list)))) - (t (list list)))) - (defun ps-kill-emacs-check () - (let (ps-buffer) - (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) - (buffer-name ps-buffer) ; check if it's not killed + (let ((ps-buffer (get-buffer ps-spool-buffer-name))) + (and (buffer-live-p ps-buffer) (buffer-modified-p ps-buffer) (y-or-n-p "Unprinted PostScript waiting; print now? ") - (ps-despool)) - (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) - (buffer-name ps-buffer) ; check if it's not killed + (ps-despool))) + (let ((ps-buffer (get-buffer ps-spool-buffer-name))) + (and (buffer-live-p ps-buffer) (buffer-modified-p ps-buffer) (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")) (error "Unprinted PostScript")))) -(cond ((fboundp 'add-hook) - (unless noninteractive - (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))) - (kill-emacs-hook - (message "Won't override existing `kill-emacs-hook'")) - (t - (setq kill-emacs-hook 'ps-kill-emacs-check))) +(unless noninteractive + (add-hook 'kill-emacs-hook #'ps-kill-emacs-check)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. -;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "1f436e4d78c7dc983a503dac18298515") +;;;### (autoloads nil "ps-mule" "ps-mule.el" "173235d6520575a877c25be437fb9e5f") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index 3b228293716..319a26d71fc 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -1,6 +1,6 @@ ;;; ps-samp.el --- ps-print sample setup code -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Jim Thompson (was ) ;; Jacques Duthen (was ) diff --git a/lisp/recentf.el b/lisp/recentf.el index 02e5b09b981..dcdbd1fb43a 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1,6 +1,6 @@ ;;; recentf.el --- setup a menu of recently opened files -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: David Ponce ;; Created: July 19 1999 @@ -69,9 +69,10 @@ See the command `recentf-save-list'." :group 'recentf :type 'integer) -(defcustom recentf-save-file (convert-standard-filename "~/.recentf") +(defcustom recentf-save-file (locate-user-emacs-file "recentf" ".recentf") "File to save the recent list into." :group 'recentf + :version "24.4" :type 'file :initialize 'custom-initialize-default :set (lambda (symbol value) diff --git a/lisp/rect.el b/lisp/rect.el index ec234b6514f..e798b07b556 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -1,6 +1,6 @@ -;;; rect.el --- rectangle functions for GNU Emacs +;;; rect.el --- rectangle functions for GNU Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985, 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1999-2014 Free Software Foundation, Inc. ;; Maintainer: Didier Verna ;; Keywords: internal @@ -412,6 +412,166 @@ with a prefix argument, prompt for START-AT and FORMAT." (apply-on-rectangle 'rectangle-number-line-callback start end format))) +;;; New rectangle integration with kill-ring. + +;; FIXME: known problems with the new rectangle support: +;; - lots of commands handle the region without paying attention to its +;; rectangular shape. + +(add-function :around redisplay-highlight-region-function + #'rectangle--highlight-for-redisplay) +(add-function :around redisplay-unhighlight-region-function + #'rectangle--unhighlight-for-redisplay) +(add-function :around region-extract-function + #'rectangle--extract-region) + +(defvar rectangle-mark-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-o] 'open-rectangle) + (define-key map [?\C-t] 'string-rectangle) + ;; (define-key map [remap open-line] 'open-rectangle) + ;; (define-key map [remap transpose-chars] 'string-rectangle) + map) + "Keymap used while marking a rectangular region.") + +;;;###autoload +(define-minor-mode rectangle-mark-mode + "Toggle the region as rectangular. +Activates the region if needed. Only lasts until the region is deactivated." + nil nil nil + (when rectangle-mark-mode + (add-hook 'deactivate-mark-hook + (lambda () (rectangle-mark-mode -1))) + (unless (region-active-p) + (push-mark) + (activate-mark) + (message "Mark set (rectangle mode)")))) + +(defun rectangle--extract-region (orig &optional delete) + (if (not rectangle-mark-mode) + (funcall orig delete) + (let* ((strs (funcall (if delete + #'delete-extract-rectangle + #'extract-rectangle) + (region-beginning) (region-end))) + (str (mapconcat #'identity strs "\n"))) + (when (eq last-command 'kill-region) + ;; Try to prevent kill-region from appending this to some + ;; earlier element. + (setq last-command 'kill-region-dont-append)) + (when strs + (put-text-property 0 (length str) 'yank-handler + `(rectangle--insert-for-yank ,strs t) + str) + str)))) + +(defun rectangle--insert-for-yank (strs) + (push (point) buffer-undo-list) + (let ((undo-at-start buffer-undo-list)) + (insert-rectangle strs) + (setq yank-undo-function + (lambda (_start _end) + (undo-start) + (setcar undo-at-start nil) ;Turn it into a boundary. + (while (not (eq pending-undo-list (cdr undo-at-start))) + (undo-more 1)))))) + +(defun rectangle--highlight-for-redisplay (orig start end window rol) + (cond + ((not rectangle-mark-mode) + (funcall orig start end window rol)) + ((and (eq 'rectangle (car-safe rol)) + (eq (nth 1 rol) (buffer-chars-modified-tick)) + (eq start (nth 2 rol)) + (eq end (nth 3 rol))) + rol) + (t + (save-excursion + (let* ((nrol nil) + (old (if (eq 'rectangle (car-safe rol)) + (nthcdr 4 rol) + (funcall redisplay-unhighlight-region-function rol) + nil)) + (ptcol (progn (goto-char start) (current-column))) + (markcol (progn (goto-char end) (current-column))) + (leftcol (min ptcol markcol)) + (rightcol (max ptcol markcol))) + (goto-char start) + (while + (let* ((mleft (move-to-column leftcol)) + (left (point)) + (mright (move-to-column rightcol)) + (right (point)) + (ol + (if (not old) + (let ((ol (make-overlay left right))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'region) + ol) + (let ((ol (pop old))) + (move-overlay ol left right (current-buffer)) + ol)))) + ;; `move-to-column' may stop before the column (if bumping into + ;; EOL) or overshoot it a little, when column is in the middle + ;; of a char. + (cond + ((< mleft leftcol) ;`leftcol' is past EOL. + (overlay-put ol 'before-string + (spaces-string (- leftcol mleft))) + (setq mright (max mright leftcol))) + ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. + (eq (char-before left) ?\t)) + (setq left (1- left)) + (move-overlay ol left right) + (goto-char left) + (overlay-put ol 'before-string + (spaces-string (- leftcol (current-column))))) + ((overlay-get ol 'before-string) + (overlay-put ol 'before-string nil))) + (cond + ((< mright rightcol) ;`rightcol' is past EOL. + (let ((str (make-string (- rightcol mright) ?\s))) + (put-text-property 0 (length str) 'face 'region str) + ;; If cursor happens to be here, draw it *before* rather than + ;; after this highlighted pseudo-text. + (put-text-property 0 1 'cursor t str) + (overlay-put ol 'after-string str))) + ((and (> mright rightcol) ;`rightcol's in the middle of a char. + (eq (char-before right) ?\t)) + (setq right (1- right)) + (move-overlay ol left right) + (if (= rightcol leftcol) + (overlay-put ol 'after-string nil) + (goto-char right) + (let ((str (make-string + (- rightcol (max leftcol (current-column))) + ?\s))) + (put-text-property 0 (length str) 'face 'region str) + (when (= left right) + ;; If cursor happens to be here, draw it *before* rather + ;; than after this highlighted pseudo-text. + (put-text-property 0 1 'cursor 1 str)) + (overlay-put ol 'after-string str)))) + ((overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + (when (and (= leftcol rightcol) (display-graphic-p)) + ;; Make zero-width rectangles visible! + (overlay-put ol 'after-string + (concat (propertize " " + 'face '(region (:height 0.2))) + (overlay-get ol 'after-string)))) + (push ol nrol) + (and (zerop (forward-line 1)) + (<= (point) end)))) + (mapc #'delete-overlay old) + `(rectangle ,(buffer-chars-modified-tick) ,start ,end ,@nrol)))))) + +(defun rectangle--unhighlight-for-redisplay (orig rol) + (if (not (eq 'rectangle (car-safe rol))) + (funcall orig rol) + (mapc #'delete-overlay (nthcdr 4 rol)) + (setcar (cdr rol) nil))) + (provide 'rect) ;;; rect.el ends here diff --git a/lisp/register.el b/lisp/register.el index ae2f7cf3e2a..102ba6c60e4 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -1,9 +1,9 @@ -;;; register.el --- register commands for Emacs +;;; register.el --- register commands for Emacs -*- lexical-binding: t; -*- -;; Copyright (C) 1985, 1993-1994, 2001-2013 Free Software Foundation, +;; Copyright (C) 1985, 1993-1994, 2001-2014 Free Software Foundation, ;; Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -31,10 +31,6 @@ (eval-when-compile (require 'cl-lib)) -(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) -(declare-function semantic-tag-buffer "semantic/tag" (tag)) -(declare-function semantic-tag-start "semantic/tag" (tag)) - ;;; Code: (cl-defstruct @@ -93,6 +89,14 @@ text." :type '(choice (const :tag "None" nil) (character :tag "Use register" :value ?+))) +(defcustom register-preview-delay 1 + "If non-nil, time to wait in seconds before popping up a preview window. +If nil, do not show register previews, unless `help-char' (or a member of +`help-event-list') is pressed." + :version "24.4" + :type '(choice number (const :tag "No preview unless requested" nil)) + :group 'register) + (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." (cdr (assq register register-alist))) @@ -106,12 +110,78 @@ See the documentation of the variable `register-alist' for possible VALUEs." (push (cons register value) register-alist)) value)) +(defun register-describe-oneline (c) + "One-line description of register C." + (let ((d (replace-regexp-in-string + "\n[ \t]*" " " + (with-output-to-string (describe-register-1 c))))) + (if (string-match "Register.+? contains \\(?:an? \\|the \\)?" d) + (substring d (match-end 0)) + d))) + +(defun register-preview-default (r) + "Default function for the variable `register-preview-function'." + (format "%s %s\n" + (concat (single-key-description (car r)) ":") + (register-describe-oneline (car r)))) + +(defvar register-preview-function #'register-preview-default + "Function to format a register for previewing. +Takes one argument, a cons (NAME . CONTENTS) as found in `register-alist'. +Returns a string.") + +(defun register-preview (buffer &optional show-empty) + "Pop up a window to show register preview in BUFFER. +If SHOW-EMPTY is non-nil show the window even if no registers. +Format of each entry is controlled by the variable `register-preview-function'." + (when (or show-empty (consp register-alist)) + (with-temp-buffer-window + buffer + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer))) + nil + (with-current-buffer standard-output + (setq cursor-in-non-selected-windows nil) + (insert (mapconcat register-preview-function register-alist "")))))) + +(defun register-read-with-preview (prompt) + "Read and return a register name, possibly showing existing registers. +Prompt with the string PROMPT. If `register-alist' and +`register-preview-delay' are both non-nil, display a window +listing existing registers after `register-preview-delay' seconds. +If `help-char' (or a member of `help-event-list') is pressed, +display such a window regardless." + (let* ((buffer "*Register Preview*") + (timer (when (numberp register-preview-delay) + (run-with-timer register-preview-delay nil + (lambda () + (unless (get-buffer-window buffer) + (register-preview buffer)))))) + (help-chars (cl-loop for c in (cons help-char help-event-list) + when (not (get-register c)) + collect c))) + (unwind-protect + (progn + (while (memq (read-event (propertize prompt 'face 'minibuffer-prompt)) + help-chars) + (unless (get-buffer-window buffer) + (register-preview buffer 'show-empty))) + (if (characterp last-input-event) last-input-event + (error "Non-character input-event"))) + (and (timerp timer) (cancel-timer timer)) + (let ((w (get-buffer-window buffer))) + (and (window-live-p w) (delete-window w))) + (and (get-buffer buffer) (kill-buffer buffer))))) + (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \\[jump-to-register] to go to that location or restore that configuration. -Argument is a character, naming the register." - (interactive "cPoint to register: \nP") +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Point to register: ") + current-prefix-arg)) ;; Turn the marker into a file-ref if the buffer is killed. (add-hook 'kill-buffer-hook 'register-swap-out nil t) (set-register register @@ -121,33 +191,54 @@ Argument is a character, naming the register." (defun window-configuration-to-register (register &optional _arg) "Store the window configuration of the selected frame in register REGISTER. Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register." - (interactive "cWindow configuration to register: \nP") +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview + "Window configuration to register: ") + current-prefix-arg)) ;; current-window-configuration does not include the value ;; of point in the current buffer, so record that separately. (set-register register (list (current-window-configuration) (point-marker)))) +;; It has had the optional arg for ages, but never used it. +(set-advertised-calling-convention 'window-configuration-to-register + '(register) "24.4") + (defun frame-configuration-to-register (register &optional _arg) "Store the window configuration of all frames in register REGISTER. Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register." - (interactive "cFrame configuration to register: \nP") +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview + "Frame configuration to register: ") + current-prefix-arg)) ;; current-frame-configuration does not include the value ;; of point in the current buffer, so record that separately. (set-register register (list (current-frame-configuration) (point-marker)))) +;; It has had the optional arg for ages, but never used it. +(set-advertised-calling-convention 'frame-configuration-to-register + '(register) "24.4") + +(make-obsolete 'frame-configuration-to-register 'frameset-to-register' "24.4") + (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) "Move point to location stored in a register. If the register contains a file name, find that file. \(To put a file name in a register, you must use `set-register'.) -If the register contains a window configuration (one frame) or a frame -configuration (all frames), restore that frame or all frames accordingly. +If the register contains a window configuration (one frame) or a frameset +\(all frames), restore that frame or all frames accordingly. First argument is a character, naming the register. Optional second arg non-nil (interactively, prefix argument) says to -delete any existing frames that the frame configuration doesn't mention. -\(Otherwise, these frames are iconified.)" - (interactive "cJump to register: \nP") +delete any existing frames that the frameset doesn't mention. +\(Otherwise, these frames are iconified.) + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Jump to register: ") + current-prefix-arg)) (let ((val (get-register register))) (cond ((registerv-p val) @@ -174,11 +265,6 @@ delete any existing frames that the frame configuration doesn't mention. (error "Register access aborted")) (find-file (nth 1 val)) (goto-char (nth 2 val))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (switch-to-buffer (semantic-tag-buffer val)) - (goto-char (semantic-tag-start val))) (t (error "Register doesn't contain a buffer position or configuration"))))) @@ -198,8 +284,11 @@ delete any existing frames that the frame configuration doesn't mention. Two args, NUMBER and REGISTER (a character, naming the register). If NUMBER is nil, a decimal number is read from the buffer starting at point, and point moves to the end of that number. -Interactively, NUMBER is the prefix arg (none means nil)." - (interactive "P\ncNumber to register: ") +Interactively, NUMBER is the prefix arg (none means nil). + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list current-prefix-arg + (register-read-with-preview "Number to register: "))) (set-register register (if number (prefix-numeric-value number) @@ -217,8 +306,11 @@ If REGISTER contains a number, add `prefix-numeric-value' of PREFIX to it. If REGISTER is empty or if it contains text, call -`append-to-register' with `delete-flag' set to PREFIX." - (interactive "P\ncIncrement register: ") +`append-to-register' with `delete-flag' set to PREFIX. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list current-prefix-arg + (register-read-with-preview "Increment register: "))) (let ((register-val (get-register register))) (cond ((numberp register-val) @@ -230,8 +322,10 @@ If REGISTER is empty or if it contains text, call (defun view-register (register) "Display what is contained in register named REGISTER. -The Lisp value REGISTER is a character." - (interactive "cView register: ") +The Lisp value REGISTER is a character. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "View register: "))) (let ((val (get-register register))) (if (null val) (message "Register %s is empty" (single-key-description register)) @@ -303,6 +397,7 @@ The Lisp value REGISTER is a character." (princ (car val)))) ((stringp val) + (setq val (copy-sequence val)) (if (eq yank-excluded-properties t) (set-text-properties 0 (length val) nil val) (remove-list-of-text-properties 0 (length val) @@ -331,8 +426,13 @@ The Lisp value REGISTER is a character." "Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. -Interactively, second arg is non-nil if prefix arg is supplied." - (interactive "*cInsert register: \nP") +Interactively, second arg is non-nil if prefix arg is supplied. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (progn + (barf-if-buffer-read-only) + (list (register-read-with-preview "Insert register: ") + current-prefix-arg))) (push-mark) (let ((val (get-register register))) (cond @@ -349,24 +449,30 @@ Interactively, second arg is non-nil if prefix arg is supplied." (princ val (current-buffer))) ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (semantic-insert-foreign-tag val)) (t (error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark))) -(defun copy-to-register (register start end &optional delete-flag) +(defun copy-to-register (register start end &optional delete-flag region) "Copy region into register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. -START and END are buffer positions indicating what to copy." - (interactive "cCopy to register: \nr\nP") - (set-register register (filter-buffer-substring start end)) +START and END are buffer positions indicating what to copy. +The optional argument REGION if non-nil, indicates that we're not just copying +some text between START and END, but we're copying the region. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Copy to register: ") + (region-beginning) + (region-end) + current-prefix-arg + t)) + (set-register register (if region + (funcall region-extract-function delete-flag) + (prog1 (filter-buffer-substring start end) + (if delete-flag (delete-region start end))))) (setq deactivate-mark t) - (cond (delete-flag - (delete-region start end)) + (cond (delete-flag) ((called-interactively-p 'interactive) (indicate-copied-region)))) @@ -374,8 +480,13 @@ START and END are buffer positions indicating what to copy." "Append region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. -START and END are buffer positions indicating what to append." - (interactive "cAppend to register: \nr\nP") +START and END are buffer positions indicating what to append. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Append to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((reg (get-register register)) (text (filter-buffer-substring start end)) (separator (and register-separator (get-register register-separator)))) @@ -393,8 +504,13 @@ START and END are buffer positions indicating what to append." "Prepend region to text in register REGISTER. With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. -START and END are buffer positions indicating what to prepend." - (interactive "cPrepend to register: \nr\nP") +START and END are buffer positions indicating what to prepend. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Prepend to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((reg (get-register register)) (text (filter-buffer-substring start end)) (separator (and register-separator (get-register register-separator)))) @@ -414,8 +530,14 @@ With prefix arg, delete as well. To insert this register in the buffer, use \\[insert-register]. Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. -START and END are buffer positions giving two corners of rectangle." - (interactive "cCopy rectangle to register: \nr\nP") +START and END are buffer positions giving two corners of rectangle. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview + "Copy rectangle to register: ") + (region-beginning) + (region-end) + current-prefix-arg)) (let ((rectangle (if delete-flag (delete-extract-rectangle start end) (extract-rectangle start end)))) @@ -425,6 +547,5 @@ START and END are buffer positions giving two corners of rectangle." (setq deactivate-mark t) (indicate-copied-region (length (car rectangle)))))) - (provide 'register) ;;; register.el ends here diff --git a/lisp/repeat.el b/lisp/repeat.el index 01defa66695..0b3eed52e83 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -1,6 +1,6 @@ ;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*- -;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2001-2014 Free Software Foundation, Inc. ;; Author: Will Mengarini ;; Created: Mo 02 Mar 98 @@ -109,9 +109,11 @@ (defvar repeat-message-function nil "If non-nil, function used by `repeat' command to say what it's doing. Message is something like \"Repeating command glorp\". -To disable such messages, set this variable to `ignore'. To customize -display, assign a function that takes one string as an arg and displays -it however you want.") +A value of `ignore' will disable such messages. To customize +display, assign a function that takes one string as an arg and +displays it however you want. +If this variable is nil, the normal `message' function will be +used to display the messages.") (defcustom repeat-on-final-keystroke t "Allow `repeat' to re-execute for repeating lastchar of a key sequence. @@ -278,7 +280,7 @@ recently executed command not bound to an input event\"." (execute-kbd-macro last-repeatable-command)) (call-interactively last-repeatable-command)))) (when repeat-repeat-char - (set-temporary-overlay-map + (set-transient-map (let ((map (make-sparse-keymap))) (define-key map (vector repeat-repeat-char) (if (null repeat-message-function) 'repeat diff --git a/lisp/replace.el b/lisp/replace.el index 86b1aa27069..fda2213236b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,9 +1,9 @@ ;;; replace.el --- replace commands for Emacs -;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2013 Free +;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2014 Free ;; Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Package: emacs ;; This file is part of GNU Emacs. @@ -226,9 +226,11 @@ the original string if not." (let* ((from (query-replace-read-from prompt regexp-flag)) (to (if (consp from) (prog1 (cdr from) (setq from (car from))) (query-replace-read-to from prompt regexp-flag)))) - (list from to current-prefix-arg))) + (list from to + (and current-prefix-arg (not (eq current-prefix-arg '-))) + (and current-prefix-arg (eq current-prefix-arg '-))))) -(defun query-replace (from-string to-string &optional delimited start end) +(defun query-replace (from-string to-string &optional delimited start end backward) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -246,16 +248,22 @@ Matching is independent of case if `case-fold-search' is non-nil and FROM-STRING has no uppercase letters. Replacement transfers the case pattern of the old text to the new text, if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase -letters. \(Transferring the case pattern means that if the old text +letters. (Transferring the case pattern means that if the old text matched is all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using `isearch-filter-predicate'. + If `replace-lax-whitespace' is non-nil, a space or spaces in the string to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. +only matches surrounded by word boundaries. A negative prefix arg means +replace backward. + Fourth and fifth arg START and END specify the region to operate on. To customize possible responses, change the \"bindings\" in `query-replace-map'." @@ -263,7 +271,9 @@ To customize possible responses, change the \"bindings\" in `query-replace-map'. (let ((common (query-replace-read-args (concat "Query replace" - (if current-prefix-arg " word" "") + (if current-prefix-arg + (if (eq current-prefix-arg '-) " backward" " word") + "") (if (and transient-mark-mode mark-active) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) @@ -273,12 +283,13 @@ To customize possible responses, change the \"bindings\" in `query-replace-map'. (if (and transient-mark-mode mark-active) (region-beginning)) (if (and transient-mark-mode mark-active) - (region-end))))) - (perform-replace from-string to-string t nil delimited nil nil start end)) + (region-end)) + (nth 3 common)))) + (perform-replace from-string to-string t nil delimited nil nil start end backward)) (define-key esc-map "%" 'query-replace) -(defun query-replace-regexp (regexp to-string &optional delimited start end) +(defun query-replace-regexp (regexp to-string &optional delimited start end backward) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -300,12 +311,18 @@ pattern of the old text to the new text, if `case-replace' and all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using `isearch-filter-predicate'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. +only matches surrounded by word boundaries. A negative prefix arg means +replace backward. + Fourth and fifth arg START and END specify the region to operate on. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, @@ -333,7 +350,9 @@ Use \\[repeat-complex-command] after this command for details." (let ((common (query-replace-read-args (concat "Query replace" - (if current-prefix-arg " word" "") + (if current-prefix-arg + (if (eq current-prefix-arg '-) " backward" " word") + "") " regexp" (if (and transient-mark-mode mark-active) " in region" "")) t))) @@ -344,8 +363,9 @@ Use \\[repeat-complex-command] after this command for details." (if (and transient-mark-mode mark-active) (region-beginning)) (if (and transient-mark-mode mark-active) - (region-end))))) - (perform-replace regexp to-string t t delimited nil nil start end)) + (region-end)) + (nth 3 common)))) + (perform-replace regexp to-string t t delimited nil nil start end backward)) (define-key esc-map [?\C-%] 'query-replace-regexp) @@ -380,6 +400,10 @@ that reads REGEXP. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using `isearch-filter-predicate'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -426,6 +450,7 @@ of the region. Otherwise, operate from point to the end of the buffer. Non-interactively, TO-STRINGS may be a list of replacement strings. +Interactively, reads the regexp using `read-regexp'. Use \\\\[next-history-element] \ to pull the last incremental search regexp to the minibuffer that reads REGEXP. @@ -463,23 +488,29 @@ Fourth and fifth arg START and END specify the region to operate on." to-strings "")))) (perform-replace regexp replacements t t nil n nil start end))) -(defun replace-string (from-string to-string &optional delimited start end) +(defun replace-string (from-string to-string &optional delimited start end backward) "Replace occurrences of FROM-STRING with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using `isearch-filter-predicate'. + If `replace-lax-whitespace' is non-nil, a space or spaces in the string to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. -In Transient Mark mode, if the mark is active, operate on the contents -of the region. Otherwise, operate from point to the end of the buffer. - Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. -Fourth and fifth arg START and END specify the region to operate on. +only matches surrounded by word boundaries. A negative prefix arg means +replace backward. + +Operates on the region between START and END (if both are nil, from point +to the end of the buffer). Interactively, if Transient Mark mode is +enabled and the mark is active, operates on the contents of the region; +otherwise from point to the end of the buffer. Use \\\\[next-history-element] \ to pull the last incremental search string to the minibuffer @@ -496,7 +527,9 @@ and TO-STRING is also null.)" (let ((common (query-replace-read-args (concat "Replace" - (if current-prefix-arg " word" "") + (if current-prefix-arg + (if (eq current-prefix-arg '-) " backward" " word") + "") " string" (if (and transient-mark-mode mark-active) " in region" "")) nil))) @@ -504,14 +537,21 @@ and TO-STRING is also null.)" (if (and transient-mark-mode mark-active) (region-beginning)) (if (and transient-mark-mode mark-active) - (region-end))))) - (perform-replace from-string to-string nil nil delimited nil nil start end)) + (region-end)) + (nth 3 common)))) + (perform-replace from-string to-string nil nil delimited nil nil start end backward)) +(put 'replace-string 'interactive-only + "use `search-forward' and `replace-match' instead.") -(defun replace-regexp (regexp to-string &optional delimited start end) +(defun replace-regexp (regexp to-string &optional delimited start end backward) "Replace things after point matching REGEXP with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using `isearch-filter-predicate'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -520,7 +560,9 @@ In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. +only matches surrounded by word boundaries. A negative prefix arg means +replace backward. + Fourth and fifth arg START and END specify the region to operate on. In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, @@ -559,7 +601,9 @@ which will run faster and will not set the mark or print anything." (let ((common (query-replace-read-args (concat "Replace" - (if current-prefix-arg " word" "") + (if current-prefix-arg + (if (eq current-prefix-arg '-) " backward" " word") + "") " regexp" (if (and transient-mark-mode mark-active) " in region" "")) t))) @@ -567,8 +611,11 @@ which will run faster and will not set the mark or print anything." (if (and transient-mark-mode mark-active) (region-beginning)) (if (and transient-mark-mode mark-active) - (region-end))))) - (perform-replace regexp to-string nil t delimited nil nil start end)) + (region-end)) + (nth 3 common)))) + (perform-replace regexp to-string nil t delimited nil nil start end backward)) +(put 'replace-regexp 'interactive-only + "use `re-search-forward' and `replace-match' instead.") (defvar regexp-history nil @@ -580,48 +627,93 @@ of `history-length', which see.") (defvar occur-collect-regexp-history '("\\1") "History of regexp for occur's collect operation") +(defcustom read-regexp-defaults-function nil + "Function that provides default regexp(s) for `read-regexp'. +This function should take no arguments and return one of: nil, a +regexp, or a list of regexps. Interactively, `read-regexp' uses +the return value of this function for its DEFAULT argument. + +As an example, set this variable to `find-tag-default-as-regexp' +to default to the symbol at point. + +To provide different default regexps for different commands, +the function that you set this to can check `this-command'." + :type '(choice + (const :tag "No default regexp reading function" nil) + (const :tag "Latest regexp history" regexp-history-last) + (function-item :tag "Tag at point" + find-tag-default) + (function-item :tag "Tag at point as regexp" + find-tag-default-as-regexp) + (function-item :tag "Tag at point as symbol regexp" + find-tag-default-as-symbol-regexp) + (function :tag "Your choice of function")) + :group 'matching + :version "24.4") + +(defun read-regexp-suggestions () + "Return a list of standard suggestions for `read-regexp'. +By default, the list includes the tag at point, the last isearch regexp, +the last isearch string, and the last replacement regexp. `read-regexp' +appends the list returned by this function to the end of values available +via \\\\[next-history-element]." + (list + (find-tag-default-as-regexp) + (find-tag-default-as-symbol-regexp) + (car regexp-search-ring) + (regexp-quote (or (car search-ring) "")) + (car (symbol-value query-replace-from-history-variable)))) + (defun read-regexp (prompt &optional defaults history) "Read and return a regular expression as a string. -When PROMPT doesn't end with a colon and space, it adds a final \": \". -If the first element of DEFAULTS is non-nil, it's added to the prompt. +Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by +optional whitespace), use it as-is. Otherwise, add \": \" to the end, +possibly preceded by the default result (see below). -Optional arg DEFAULTS has the form (DEFAULT . SUGGESTIONS) -or simply DEFAULT where DEFAULT, if non-nil, should be a string that -is returned as the default value when the user enters empty input. -SUGGESTIONS is a list of strings that can be inserted into -the minibuffer using \\\\[next-history-element]. \ -The values supplied in SUGGESTIONS -are prepended to the list of standard suggestions that include -the tag at point, the last isearch regexp, the last isearch string, -and the last replacement regexp. +The optional argument DEFAULTS can be either: nil, a string, a list +of strings, or a symbol. We use DEFAULTS to construct the default +return value in case of empty input. -Optional arg HISTORY is a symbol to use for the history list. -If HISTORY is nil, `regexp-history' is used." - (let* ((default (if (consp defaults) (car defaults) defaults)) +If DEFAULTS is a string, we use it as-is. + +If DEFAULTS is a list of strings, the first element is the +default return value, but all the elements are accessible +using the history command \\\\[next-history-element]. + +If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function' +is non-nil, we use that in place of DEFAULTS in the following: + If DEFAULTS is the symbol `regexp-history-last', we use the first + element of HISTORY (if specified) or `regexp-history'. + If DEFAULTS is a function, we call it with no arguments and use + what it returns, which should be either nil, a string, or a list of strings. + +We append the standard values from `read-regexp-suggestions' to DEFAULTS +before using it. + +If the first element of DEFAULTS is non-nil (and if PROMPT does not end +in \":\", followed by optional whitespace), we add it to the prompt. + +The optional argument HISTORY is a symbol to use for the history list. +If nil, uses `regexp-history'." + (let* ((defaults + (if (and defaults (symbolp defaults)) + (cond + ((eq (or read-regexp-defaults-function defaults) + 'regexp-history-last) + (car (symbol-value (or history 'regexp-history)))) + ((functionp (or read-regexp-defaults-function defaults)) + (funcall (or read-regexp-defaults-function defaults)))) + defaults)) + (default (if (consp defaults) (car defaults) defaults)) (suggestions (if (listp defaults) defaults (list defaults))) - (suggestions - (append - suggestions - (list - ;; Regexp for tag at point. - (let* ((tagf (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default)) - (tag (funcall tagf))) - (cond ((not tag) "") - ((eq tagf 'find-tag-default) - (format "\\_<%s\\_>" (regexp-quote tag))) - (t (regexp-quote tag)))) - (car regexp-search-ring) - (regexp-quote (or (car search-ring) "")) - (car (symbol-value query-replace-from-history-variable))))) + (suggestions (append suggestions (read-regexp-suggestions))) (suggestions (delete-dups (delq nil (delete "" suggestions)))) ;; Do not automatically add default to the history for empty input. (history-add-new-input nil) (input (read-from-minibuffer (cond ((string-match-p ":[ \t]*\\'" prompt) prompt) - (default + ((and default (> (length default) 0)) (format "%s (default %s): " prompt (query-replace-descr default))) (t @@ -629,7 +721,9 @@ If HISTORY is nil, `regexp-history' is used." nil nil nil (or history 'regexp-history) suggestions t))) (if (equal input "") ;; Return the default value when the user enters empty input. - (or default input) + (prog1 (or default input) + (when default + (add-to-history (or history 'regexp-history) default))) ;; Otherwise, add non-empty input to the history and return input. (prog1 input (add-to-history (or history 'regexp-history) input))))) @@ -797,9 +891,12 @@ a previously found match." (keep-lines-read-args "How many matches for regexp")) (save-excursion (if rstart - (progn - (goto-char (min rstart rend)) - (setq rend (max rstart rend))) + (if rend + (progn + (goto-char (min rstart rend)) + (setq rend (max rstart rend))) + (goto-char rstart) + (setq rend (point-max))) (if (and interactive transient-mark-mode mark-active) (setq rstart (region-beginning) rend (region-end)) @@ -1133,6 +1230,14 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-prefix-face 'shadow + "Face used by \\[list-matching-lines] to show the prefix column. +If the face doesn't differ from the default face, +don't highlight the prefix with line numbers specially." + :type 'face + :group 'matching + :version "24.4") + (defcustom occur-excluded-properties '(read-only invisible intangible field mouse-face help-echo local-map keymap yank-handler follow-link) @@ -1148,7 +1253,7 @@ which means to discard all text properties." (regexp (read-regexp (if perform-collect "Collect strings matching regexp" "List lines matching regexp") - (car regexp-history)))) + 'regexp-history-last))) (list regexp (if perform-collect ;; Perform collect operation @@ -1322,7 +1427,9 @@ See also `multi-occur'." (isearch-no-upper-case-p regexp t) case-fold-search) list-matching-lines-buffer-name-face - nil list-matching-lines-face + (if (face-differs-from-default-p list-matching-lines-prefix-face) + list-matching-lines-prefix-face) + list-matching-lines-face (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) @@ -1347,16 +1454,18 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) (with-current-buffer out-buf - (let ((globalcount 0) + (let ((global-lines 0) ;; total count of matching lines + (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold)) ;; Map over all the buffers (dolist (buf buffers) (when (buffer-live-p buf) - (let ((matches 0) ;; count of matched lines - (lines 1) ;; line count - (prev-after-lines nil) ;; context lines of prev match - (prev-lines nil) ;; line number of prev match endpt + (let ((lines 0) ;; count of matching lines + (matches 0) ;; count of matches + (curr-line 1) ;; line count + (prev-line nil) ;; line number of prev match endpt + (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) (origpt nil) (begpt nil) @@ -1377,7 +1486,7 @@ See also `multi-occur'." (while (not (eobp)) (setq origpt (point)) (when (setq endpt (re-search-forward regexp nil t)) - (setq matches (1+ matches)) ;; increment match count + (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. (save-excursion @@ -1386,7 +1495,7 @@ See also `multi-occur'." (goto-char endpt) (setq endpt (line-end-position))) ;; Sum line numbers up to the first match line. - (setq lines (+ lines (count-lines origpt begpt))) + (setq curr-line (+ curr-line (count-lines origpt begpt))) (setq marker (make-marker)) (set-marker marker matchbeg) (setq curstring (occur-engine-line begpt endpt keep-props)) @@ -1395,23 +1504,25 @@ See also `multi-occur'." (start 0)) (while (and (< start len) (string-match regexp curstring start)) + (setq matches (1+ matches)) (add-text-properties (match-beginning 0) (match-end 0) - (append - `(occur-match t) - (when match-face - ;; Use `face' rather than `font-lock-face' here - ;; so as to override faces copied from the buffer. - `(face ,match-face))) - curstring) - (setq start (match-end 0)))) + '(occur-match t) curstring) + (when match-face + ;; Add `match-face' to faces copied from the buffer. + (add-face-text-property + (match-beginning 0) (match-end 0) + match-face nil curstring)) + ;; Avoid infloop (Bug#7593). + (let ((end (match-end 0))) + (setq start (if (= start end) (1+ start) end))))) ;; Generate the string to insert for this match (let* ((match-prefix ;; Using 7 digits aligns tabs properly. - (apply #'propertize (format "%7d:" lines) + (apply #'propertize (format "%7d:" curr-line) (append (when prefix-face - `(font-lock-face prefix-face)) + `(font-lock-face ,prefix-face)) `(occur-prefix t mouse-face (highlight) ;; Allow insertion of text at ;; the end of the prefix (for @@ -1435,7 +1546,9 @@ See also `multi-occur'." ;; of multi-line matches. (replace-regexp-in-string "\n" - "\n :" + (if prefix-face + (propertize "\n :" 'font-lock-face prefix-face) + "\n :") match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) @@ -1446,7 +1559,8 @@ See also `multi-occur'." ;; The complex multi-line display style. (setq ret (occur-context-lines out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines)) + curr-line prev-line prev-after-lines + prefix-face)) ;; Set first elem of the returned list to `data', ;; and the second elem to `prev-after-lines'. (setq prev-after-lines (nth 1 ret)) @@ -1458,28 +1572,34 @@ See also `multi-occur'." (if endpt (progn ;; Sum line numbers between first and last match lines. - (setq lines (+ lines (count-lines begpt endpt) - ;; Add 1 for empty last match line since - ;; count-lines returns 1 line less. - (if (and (bolp) (eolp)) 1 0))) + (setq curr-line (+ curr-line (count-lines begpt endpt) + ;; Add 1 for empty last match line since + ;; count-lines returns 1 line less. + (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) (goto-char (point-max))) - (setq prev-lines (1- lines))) + (setq prev-line (1- curr-line))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf (insert (apply #'concat (occur-engine-add-prefix - prev-after-lines))))))) - (when (not (zerop matches)) ;; is the count zero? - (setq globalcount (+ globalcount matches)) + prev-after-lines prefix-face))))))) + (when (not (zerop lines)) ;; is the count zero? + (setq global-lines (+ global-lines lines) + global-matches (+ global-matches matches)) (with-current-buffer out-buf (goto-char headerpt) (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s\n" matches (if (= matches 1) "" "es") + ;; Don't display the same number of lines + ;; and matches in case of 1 match per line. + (if (= lines matches) + "" (format " in %d line%s" + lines (if (= lines 1) "" "s"))) ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (format " for \"%s\"" @@ -1487,23 +1607,26 @@ See also `multi-occur'." (buffer-name buf)) 'read-only t)) (setq end (point)) - (add-text-properties beg end - (append - (when title-face - `(font-lock-face ,title-face)) - `(occur-title ,buf)))) + (add-text-properties beg end `(occur-title ,buf)) + (when title-face + (add-face-text-property beg end title-face))) (goto-char (point-min))))))) ;; Display total match count and regexp for multi-buffer. - (when (and (not (zerop globalcount)) (> (length buffers) 1)) + (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) (let ((beg (point)) end) - (insert (format "%d match%s total for \"%s\":\n" - globalcount (if (= globalcount 1) "" "es") + (insert (format "%d match%s%s total for \"%s\":\n" + global-matches (if (= global-matches 1) "" "es") + ;; Don't display the same number of lines + ;; and matches in case of 1 match per line. + (if (= global-lines global-matches) + "" (format " in %d line%s" + global-lines (if (= global-lines 1) "" "s"))) (query-replace-descr regexp))) (setq end (point)) - (add-text-properties beg end (when title-face - `(font-lock-face ,title-face)))) + (when title-face + (add-face-text-property beg end title-face))) (goto-char (point-min))) (if coding ;; CODING is buffer-file-coding-system of the first buffer @@ -1511,7 +1634,7 @@ See also `multi-occur'." ;; buffer. (set-buffer-file-coding-system coding)) ;; Return the number of matches - globalcount))) + global-matches))) (defun occur-engine-line (beg end &optional keep-props) (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) @@ -1525,10 +1648,13 @@ See also `multi-occur'." str) (buffer-substring-no-properties beg end))) -(defun occur-engine-add-prefix (lines) +(defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar #'(lambda (line) - (concat " :" line "\n")) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) @@ -1551,13 +1677,14 @@ See also `multi-occur'." ;; Generate context display for occur. ;; OUT-LINE is the line where the match is. ;; NLINES and KEEP-PROPS are args to occur-engine. -;; LINES is line count of the current match, -;; PREV-LINES is line count of the previous match, +;; CURR-LINE is line count of the current match, +;; PREV-LINE is line count of the previous match, ;; PREV-AFTER-LINES is a list of after-context lines of the previous match. ;; Generate a list of lines, add prefixes to all but OUT-LINE, ;; then concatenate them all together. (defun occur-context-lines (out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines) + curr-line prev-line prev-after-lines + &optional prefix-face) ;; Find after- and before-context lines of the current match. (let ((before-lines (nreverse (cdr (occur-accumulate-lines @@ -1572,22 +1699,22 @@ See also `multi-occur'." (when prev-after-lines ;; Don't overlap prev after-lines with current before-lines. - (if (>= (+ prev-lines (length prev-after-lines)) - (- lines (length before-lines))) + (if (>= (+ prev-line (length prev-after-lines)) + (- curr-line (length before-lines))) (setq prev-after-lines (butlast prev-after-lines (- (length prev-after-lines) - (- lines prev-lines (length before-lines) 1)))) + (- curr-line prev-line (length before-lines) 1)))) ;; Separate non-overlapping context lines with a dashed line. (setq separator "-------\n"))) - (when prev-lines + (when prev-line ;; Don't overlap current before-lines with previous match line. - (if (<= (- lines (length before-lines)) - prev-lines) + (if (<= (- curr-line (length before-lines)) + prev-line) (setq before-lines (nthcdr (- (length before-lines) - (- lines prev-lines 1)) + (- curr-line prev-line 1)) before-lines)) ;; Separate non-overlapping before-context lines. (unless (> nlines 0) @@ -1597,10 +1724,13 @@ See also `multi-occur'." ;; Return a list where the first element is the output line. (apply #'concat (append - (and prev-after-lines - (occur-engine-add-prefix prev-after-lines)) - (and separator (list separator)) - (occur-engine-add-prefix before-lines) + (if prev-after-lines + (occur-engine-add-prefix prev-after-lines prefix-face)) + (if separator + (list (if prefix-face + (propertize separator 'font-lock-face prefix-face) + separator))) + (occur-engine-add-prefix before-lines prefix-face) (list out-line))) ;; And the second element is the list of context after-lines. (if (> nlines 0) after-lines)))) @@ -1723,7 +1853,12 @@ type them using Lisp syntax." (defun replace-eval-replacement (expression count) (let* ((replace-count count) - (replacement (eval expression))) + err + (replacement + (condition-case err + (eval expression) + (error + (error "Error evaluating replacement expression: %S" err))))) (if (stringp replacement) replacement (prin1-to-string replacement t)))) @@ -1768,11 +1903,13 @@ but coerced to the correct value of INTEGERS." new))) (match-data integers reuse t))) -(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data) +(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data backward) "Make a replacement with `replace-match', editing `\\?'. -NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no -check for `\\?' is made to save time. MATCH-DATA is used for the -replacement. In case editing is done, it is changed to use markers. +FIXEDCASE, LITERAL are passed to `replace-match' (which see). +After possibly editing it (if `\\?' is present), NEWTEXT is also +passed to `replace-match'. If NOEDIT is true, no check for `\\?' +is made (to save time). MATCH-DATA is used for the replacement. +In case editing is done, it is changed to use markers. The return value is non-nil if there has been no `\\?' or NOEDIT was passed in. If LITERAL is set, no checking is done, anyway." @@ -1792,6 +1929,9 @@ passed in. If LITERAL is set, no checking is done, anyway." noedit nil))) (set-match-data match-data) (replace-match newtext fixedcase literal) + ;; `replace-match' leaves point at the end of the replacement text, + ;; so move point to the beginning when replacing backward. + (when backward (goto-char (nth 0 match-data))) noedit) (defvar replace-search-function nil @@ -1806,9 +1946,71 @@ It is used by `query-replace-regexp', `replace-regexp', It is called with three arguments, as if it were `re-search-forward'.") +(defun replace-search (search-string limit regexp-flag delimited-flag + case-fold-search backward) + "Search for the next occurrence of SEARCH-STRING to replace." + ;; Let-bind global isearch-* variables to values used + ;; to search the next replacement. These let-bindings + ;; should be effective both at the time of calling + ;; `isearch-search-fun-default' and also at the + ;; time of funcalling `search-function'. + ;; These isearch-* bindings can't be placed higher + ;; outside of this function because then another I-search + ;; used after `recursive-edit' might override them. + (let* ((isearch-regexp regexp-flag) + (isearch-word delimited-flag) + (isearch-lax-whitespace + replace-lax-whitespace) + (isearch-regexp-lax-whitespace + replace-regexp-lax-whitespace) + (isearch-case-fold-search case-fold-search) + (isearch-adjusted nil) + (isearch-nonincremental t) ; don't use lax word mode + (isearch-forward (not backward)) + (search-function + (or (if regexp-flag + replace-re-search-function + replace-search-function) + (isearch-search-fun-default)))) + (funcall search-function search-string limit t))) + +(defvar replace-overlay nil) + +(defun replace-highlight (match-beg match-end range-beg range-end + search-string regexp-flag delimited-flag + case-fold-search backward) + (if query-replace-highlight + (if replace-overlay + (move-overlay replace-overlay match-beg match-end (current-buffer)) + (setq replace-overlay (make-overlay match-beg match-end)) + (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays + (overlay-put replace-overlay 'face 'query-replace))) + (if query-replace-lazy-highlight + (let ((isearch-string search-string) + (isearch-regexp regexp-flag) + (isearch-word delimited-flag) + (isearch-lax-whitespace + replace-lax-whitespace) + (isearch-regexp-lax-whitespace + replace-regexp-lax-whitespace) + (isearch-case-fold-search case-fold-search) + (isearch-forward (not backward)) + (isearch-other-end match-beg) + (isearch-error nil)) + (isearch-lazy-highlight-new-loop range-beg range-end)))) + +(defun replace-dehighlight () + (when replace-overlay + (delete-overlay replace-overlay)) + (when query-replace-lazy-highlight + (lazy-highlight-cleanup lazy-highlight-cleanup) + (setq isearch-lazy-highlight-last-string nil)) + ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'. + (isearch-clean-overlays)) + (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag - &optional repeat-count map start end) + &optional repeat-count map start end backward) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: @@ -1840,6 +2042,9 @@ make, or the user didn't cancel the call." (keep-going t) (stack nil) (replace-count 0) + (skip-read-only-count 0) + (skip-filtered-count 0) + (skip-invisible-count 0) (nonempty-match nil) (multi-buffer nil) (recenter-last-op nil) ; Start cycling order with initial position. @@ -1859,10 +2064,15 @@ make, or the user didn't cancel the call." minibuffer-prompt-properties)))) ;; If region is active, in Transient Mark mode, operate on region. - (when start - (setq limit (copy-marker (max start end))) - (goto-char (min start end)) - (deactivate-mark)) + (if backward + (when end + (setq limit (copy-marker (min start end))) + (goto-char (max start end)) + (deactivate-mark)) + (when start + (setq limit (copy-marker (max start end))) + (goto-char (min start end)) + (deactivate-mark))) ;; If last typed key in previous call of multi-buffer perform-replace ;; was `automatic-all', don't ask more questions in next files @@ -1892,63 +2102,49 @@ make, or the user didn't cancel the call." (unwind-protect ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going - (not (or (eobp) (and limit (>= (point) limit)))) - ;; Let-bind global isearch-* variables to values used - ;; to search the next replacement. These let-bindings - ;; should be effective both at the time of calling - ;; `isearch-search-fun-default' and also at the - ;; time of funcalling `search-function'. - ;; These isearch-* bindings can't be placed higher - ;; outside of this loop because then another I-search - ;; used after `recursive-edit' might override them. - (let* ((isearch-regexp regexp-flag) - (isearch-word delimited-flag) - (isearch-lax-whitespace - replace-lax-whitespace) - (isearch-regexp-lax-whitespace - replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) - (isearch-adjusted nil) - (isearch-nonincremental t) ; don't use lax word mode - (isearch-forward t) - (search-function - (or (if regexp-flag - replace-re-search-function - replace-search-function) - (isearch-search-fun-default)))) - ;; Use the next match if it is already known; - ;; otherwise, search for a match after moving forward - ;; one char if progress is required. - (setq real-match-data - (cond ((consp match-again) - (goto-char (nth 1 match-again)) - (replace-match-data - t real-match-data match-again)) - ;; MATCH-AGAIN non-nil means accept an - ;; adjacent match. - (match-again - (and - (funcall search-function search-string - limit t) - ;; For speed, use only integers and - ;; reuse the list used last time. - (replace-match-data t real-match-data))) - ((and (< (1+ (point)) (point-max)) - (or (null limit) - (< (1+ (point)) limit))) - ;; If not accepting adjacent matches, - ;; move one char to the right before - ;; searching again. Undo the motion - ;; if the search fails. - (let ((opoint (point))) - (forward-char 1) - (if (funcall - search-function search-string - limit t) - (replace-match-data - t real-match-data) - (goto-char opoint) - nil))))))) + (if backward + (not (or (bobp) (and limit (<= (point) limit)))) + (not (or (eobp) (and limit (>= (point) limit))))) + ;; Use the next match if it is already known; + ;; otherwise, search for a match after moving forward + ;; one char if progress is required. + (setq real-match-data + (cond ((consp match-again) + (goto-char (if backward + (nth 0 match-again) + (nth 1 match-again))) + (replace-match-data + t real-match-data match-again)) + ;; MATCH-AGAIN non-nil means accept an + ;; adjacent match. + (match-again + (and + (replace-search search-string limit + regexp-flag delimited-flag + case-fold-search backward) + ;; For speed, use only integers and + ;; reuse the list used last time. + (replace-match-data t real-match-data))) + ((and (if backward + (> (1- (point)) (point-min)) + (< (1+ (point)) (point-max))) + (or (null limit) + (if backward + (> (1- (point)) limit) + (< (1+ (point)) limit)))) + ;; If not accepting adjacent matches, + ;; move one char to the right before + ;; searching again. Undo the motion + ;; if the search fails. + (let ((opoint (point))) + (forward-char (if backward -1 1)) + (if (replace-search search-string limit + regexp-flag delimited-flag + case-fold-search backward) + (replace-match-data + t real-match-data) + (goto-char opoint) + nil)))))) ;; Record whether the match is nonempty, to avoid an infinite loop ;; repeatedly matching the same empty string. @@ -1965,17 +2161,33 @@ make, or the user didn't cancel the call." (setq match-again (and nonempty-match (or (not regexp-flag) - (and (looking-at search-string) + (and (if backward + (looking-back search-string) + (looking-at search-string)) (let ((match (match-data))) (and (/= (nth 0 match) (nth 1 match)) match)))))) - ;; Optionally ignore matches that have a read-only property. - (unless (and query-replace-skip-read-only - (text-property-not-all - (nth 0 real-match-data) (nth 1 real-match-data) - 'read-only nil)) - + (cond + ;; Optionally ignore matches that have a read-only property. + ((not (or (not query-replace-skip-read-only) + (not (text-property-not-all + (nth 0 real-match-data) (nth 1 real-match-data) + 'read-only nil)))) + (setq skip-read-only-count (1+ skip-read-only-count))) + ;; Optionally filter out matches. + ((not (funcall isearch-filter-predicate + (nth 0 real-match-data) (nth 1 real-match-data))) + (setq skip-filtered-count (1+ skip-filtered-count))) + ;; Optionally ignore invisible matches. + ((not (or (eq search-invisible t) + ;; Don't open overlays for automatic replacements. + (and (not query-flag) search-invisible) + ;; Open hidden overlays for interactive replacements. + (not (isearch-range-invisible + (nth 0 real-match-data) (nth 1 real-match-data))))) + (setq skip-invisible-count (1+ skip-invisible-count))) + (t ;; Calculate the replacement string, if necessary. (when replacements (set-match-data real-match-data) @@ -1988,11 +2200,11 @@ make, or the user didn't cancel the call." (replace-highlight (nth 0 real-match-data) (nth 1 real-match-data) start end search-string - regexp-flag delimited-flag case-fold-search)) + regexp-flag delimited-flag case-fold-search backward)) (setq noedit (replace-match-maybe-edit next-replacement nocasify literal - noedit real-match-data) + noedit real-match-data backward) replace-count (1+ replace-count))) (undo-boundary) (let (done replaced key def) @@ -2007,7 +2219,7 @@ make, or the user didn't cancel the call." (replace-highlight (match-beginning 0) (match-end 0) start end search-string - regexp-flag delimited-flag case-fold-search) + regexp-flag delimited-flag case-fold-search backward) ;; Bind message-log-max so we don't fill up the message log ;; with a bunch of identical messages. (let ((message-log-max nil) @@ -2032,8 +2244,12 @@ make, or the user didn't cancel the call." (with-output-to-temp-buffer "*Help*" (princ (concat "Query replacing " - (if delimited-flag "word " "") + (if delimited-flag + (or (and (symbolp delimited-flag) + (get delimited-flag 'isearch-message-prefix)) + "word ") "") (if regexp-flag "regexp " "") + (if backward "backward " "") from-string " with " next-replacement ".\n\n" (substitute-command-keys @@ -2062,7 +2278,7 @@ make, or the user didn't cancel the call." (setq noedit (replace-match-maybe-edit next-replacement nocasify literal - noedit real-match-data) + noedit real-match-data backward) replace-count (1+ replace-count))) (setq done t replaced t)) ((eq def 'act-and-exit) @@ -2070,7 +2286,7 @@ make, or the user didn't cancel the call." (setq noedit (replace-match-maybe-edit next-replacement nocasify literal - noedit real-match-data) + noedit real-match-data backward) replace-count (1+ replace-count))) (setq keep-going nil) (setq done t replaced t)) @@ -2079,7 +2295,7 @@ make, or the user didn't cancel the call." (setq noedit (replace-match-maybe-edit next-replacement nocasify literal - noedit real-match-data) + noedit real-match-data backward) replace-count (1+ replace-count) real-match-data (replace-match-data t real-match-data) @@ -2089,7 +2305,7 @@ make, or the user didn't cancel the call." (setq noedit (replace-match-maybe-edit next-replacement nocasify literal - noedit real-match-data) + noedit real-match-data backward) replace-count (1+ replace-count))) (setq done t query-flag nil replaced t) (if (eq def 'automatic-all) (setq multi-buffer t))) @@ -2133,7 +2349,7 @@ make, or the user didn't cancel the call." (setq noedit (replace-match-maybe-edit next-replacement nocasify literal noedit - real-match-data) + real-match-data backward) replaced t)) (setq done t)) @@ -2180,45 +2396,31 @@ make, or the user didn't cancel the call." (match-end 0) (current-buffer)) (match-data t))) - stack))))) + stack)))))) (replace-dehighlight)) (or unread-command-events - (message "Replaced %d occurrence%s" + (message "Replaced %d occurrence%s%s" replace-count - (if (= replace-count 1) "" "s"))) + (if (= replace-count 1) "" "s") + (if (> (+ skip-read-only-count + skip-filtered-count + skip-invisible-count) 0) + (format " (skipped %s)" + (mapconcat + 'identity + (delq nil (list + (if (> skip-read-only-count 0) + (format "%s read-only" + skip-read-only-count)) + (if (> skip-invisible-count 0) + (format "%s invisible" + skip-invisible-count)) + (if (> skip-filtered-count 0) + (format "%s filtered out" + skip-filtered-count)))) + ", ")) + ""))) (or (and keep-going stack) multi-buffer))) -(defvar replace-overlay nil) - -(defun replace-highlight (match-beg match-end range-beg range-end - search-string regexp-flag delimited-flag - case-fold-search) - (if query-replace-highlight - (if replace-overlay - (move-overlay replace-overlay match-beg match-end (current-buffer)) - (setq replace-overlay (make-overlay match-beg match-end)) - (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays - (overlay-put replace-overlay 'face 'query-replace))) - (if query-replace-lazy-highlight - (let ((isearch-string search-string) - (isearch-regexp regexp-flag) - (isearch-word delimited-flag) - (isearch-lax-whitespace - replace-lax-whitespace) - (isearch-regexp-lax-whitespace - replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) - (isearch-forward t) - (isearch-other-end match-beg) - (isearch-error nil)) - (isearch-lazy-highlight-new-loop range-beg range-end)))) - -(defun replace-dehighlight () - (when replace-overlay - (delete-overlay replace-overlay)) - (when query-replace-lazy-highlight - (lazy-highlight-cleanup lazy-highlight-cleanup) - (setq isearch-lazy-highlight-last-string nil))) - ;;; replace.el ends here diff --git a/lisp/reposition.el b/lisp/reposition.el index 0bd27654065..ec5f5a1ddee 100644 --- a/lisp/reposition.el +++ b/lisp/reposition.el @@ -1,10 +1,10 @@ ;;; reposition.el --- center a Lisp function or comment on the screen -;; Copyright (C) 1991, 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Michael D. Ernst ;; Created: Jan 1991 -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -61,7 +61,7 @@ first comment line visible (if point is in a comment)." (here (point)) ;; change this name once I've gotten rid of references to ht. ;; this is actually the number of the last screen line - (ht (- (window-height (selected-window)) 2)) + (ht (- (window-height) 2)) (line (repos-count-screen-lines (window-start) (point))) (comment-height ;; The call to max deals with the case of cursor between defuns. diff --git a/lisp/reveal.el b/lisp/reveal.el index 92c1178041c..f251c05f5eb 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -1,6 +1,6 @@ ;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*- -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: outlines @@ -72,27 +72,26 @@ Each element has the form (WINDOW . OVERLAY).") ;; - we only refresh spots in the current window. ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? (with-local-quit - (condition-case err - (let ((old-ols - (delq nil - (mapcar - (lambda (x) - ;; We refresh any spot in the current window as well - ;; as any spots associated with a dead window or - ;; a window which does not show this buffer any more. - (cond - ((eq (car x) (selected-window)) (cdr x)) - ((not (and (window-live-p (car x)) - (eq (window-buffer (car x)) (current-buffer)))) - ;; Adopt this since it's owned by a window that's - ;; either not live or at least not showing this - ;; buffer any more. - (setcar x (selected-window)) - (cdr x)))) - reveal-open-spots)))) - (setq old-ols (reveal-open-new-overlays old-ols)) - (reveal-close-old-overlays old-ols)) - (error (message "Reveal: %s" err))))) + (with-demoted-errors "Reveal: %s" + (let ((old-ols + (delq nil + (mapcar + (lambda (x) + ;; We refresh any spot in the current window as well + ;; as any spots associated with a dead window or + ;; a window which does not show this buffer any more. + (cond + ((eq (car x) (selected-window)) (cdr x)) + ((not (and (window-live-p (car x)) + (eq (window-buffer (car x)) (current-buffer)))) + ;; Adopt this since it's owned by a window that's + ;; either not live or at least not showing this + ;; buffer any more. + (setcar x (selected-window)) + (cdr x)))) + reveal-open-spots)))) + (setq old-ols (reveal-open-new-overlays old-ols)) + (reveal-close-old-overlays old-ols))))) (defun reveal-open-new-overlays (old-ols) (let ((repeat t)) diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index cf5f1d16974..e54d6a49f2f 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -1,6 +1,6 @@ ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text ;; -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; ;; Author: Miles Bader ;; Keywords: convenience minibuffer @@ -176,11 +176,11 @@ This is intended to be used as a minibuffer `post-command-hook' for `file-name-shadow-mode'; the minibuffer should have already been set up by `rfn-eshadow-setup-minibuffer'." (condition-case nil - (let ((goal (substitute-in-file-name (minibuffer-contents))) - (mid (overlay-end rfn-eshadow-overlay)) - (start (minibuffer-prompt-end)) - (end (point-max)) - (non-essential t)) + (let* ((non-essential t) + (goal (substitute-in-file-name (minibuffer-contents))) + (mid (overlay-end rfn-eshadow-overlay)) + (start (minibuffer-prompt-end)) + (end (point-max))) (unless ;; Catch the common case where the shadow does not need to move. (and mid diff --git a/lisp/rot13.el b/lisp/rot13.el index 03beed3a85b..b185ba00ecf 100644 --- a/lisp/rot13.el +++ b/lisp/rot13.el @@ -1,9 +1,9 @@ ;;; rot13.el --- display a buffer in ROT13 -;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 2001-2014 Free Software Foundation, Inc. ;; Author: Howard Gayle -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -101,9 +101,9 @@ See also `toggle-rot13-mode'." (defun toggle-rot13-mode () "Toggle the use of ROT13 encoding for the current window." (interactive) - (if (eq (window-display-table (selected-window)) rot13-display-table) + (if (eq (window-display-table) rot13-display-table) (set-window-display-table (selected-window) nil) - (if (null (window-display-table (selected-window))) + (if (null (window-display-table)) (set-window-display-table (selected-window) rot13-display-table)))) (provide 'rot13) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 08c4ba51905..9e32a2f5c64 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -1,6 +1,6 @@ ;;; ruler-mode.el --- display a ruler in the header line -;; Copyright (C) 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001-2014 Free Software Foundation, Inc. ;; Author: David Ponce ;; Maintainer: David Ponce @@ -137,8 +137,8 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (format "Invalid character value: %S" value)) widget)))) -(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?) - ?\ +(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶) + ?\¶ ?\|) "Character used at the `fill-column' location." :group 'ruler-mode @@ -163,8 +163,8 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (integer :tag "Integer char value" :validate ruler-mode-character-validate))) -(defcustom ruler-mode-current-column-char (if (char-displayable-p ?) - ?\ +(defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦) + ?\¦ ?\@) "Character used at the `current-column' location." :group 'ruler-mode @@ -774,7 +774,7 @@ Optional argument PROPS specifies other text properties to apply." (provide 'ruler-mode) ;; Local Variables: -;; coding: iso-latin-1 +;; coding: utf-8 ;; End: ;;; ruler-mode.el ends here diff --git a/lisp/savehist.el b/lisp/savehist.el index 374e57feb1f..6abc29cccc2 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -1,9 +1,9 @@ ;;; savehist.el --- Save minibuffer history -;; Copyright (C) 1997, 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2005-2014 Free Software Foundation, Inc. ;; Author: Hrvoje Niksic -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: minibuffer ;; Version: 24 @@ -49,7 +49,7 @@ (require 'custom) (eval-when-compile - (require 'cl)) + (if (featurep 'xemacs) (require 'cl))) ;; User variables @@ -60,21 +60,21 @@ (defcustom savehist-save-minibuffer-history t "If non-nil, save all recorded minibuffer histories. -If you want to save only specific histories, use `savehist-save-hook' to -modify the value of `savehist-minibuffer-history-variables'." +If you want to save only specific histories, use `savehist-save-hook' +to modify the value of `savehist-minibuffer-history-variables'." :type 'boolean :group 'savehist) (defcustom savehist-additional-variables () "List of additional variables to save. Each element is a symbol whose value will be persisted across Emacs -sessions that use savehist. The contents of variables should be +sessions that use Savehist. The contents of variables should be printable with the Lisp printer. You don't need to add minibuffer history variables to this list, all minibuffer histories will be saved automatically as long as `savehist-save-minibuffer-history' is non-nil. -User options should be saved with the customize interface. This +User options should be saved with the Customize interface. This list is useful for saving automatically updated variables that are not minibuffer histories, such as `compile-command' or `kill-ring'." :type '(repeat variable) @@ -89,7 +89,7 @@ minibuffer histories, such as `compile-command' or `kill-ring'." (locate-user-emacs-file "history" ".emacs-history") "File name where minibuffer history is saved to and loaded from. The minibuffer history is a series of Lisp expressions loaded -automatically when `savehist-mode' is turned on. See `savehist-mode' +automatically when Savehist mode is turned on. See `savehist-mode' for more details. If you want your minibuffer history shared between Emacs and XEmacs, @@ -115,14 +115,14 @@ If set to nil, disables timer-based autosaving." :group 'savehist) (defcustom savehist-mode-hook nil - "Hook called when `savehist-mode' is turned on." + "Hook called when Savehist mode is turned on." :type 'hook :group 'savehist) (defcustom savehist-save-hook nil "Hook called by `savehist-save' before saving the variables. -You can use this hook to influence choice and content of variables to -save." +You can use this hook to influence choice and content of variables +to save." :type 'hook :group 'savehist) @@ -134,7 +134,7 @@ save." (<= emacs-major-version 21) (< emacs-minor-version 5)) 'iso-2022-8 'utf-8-unix) - "The coding system savehist uses for saving the minibuffer history. + "The coding system Savehist uses for saving the minibuffer history. Changing this value while Emacs is running is supported, but considered unwise, unless you know what you are doing.") @@ -158,7 +158,7 @@ buffer text.") (defvar savehist-loaded nil "Whether the history has already been loaded. -This prevents toggling `savehist-mode' from destroying existing +This prevents toggling Savehist mode from destroying existing minibuffer history.") (when (featurep 'xemacs) @@ -205,7 +205,7 @@ histories, which is probably undesirable." (savehist-install))) (defun savehist-load () - "Load the variables stored in `savehist-file' and turn on `savehist-mode'. + "Load the variables stored in `savehist-file' and turn on Savehist mode. If `savehist-file' is in the old format that doesn't record the value of `savehist-minibuffer-history-variables', that value is deducted from the contents of the file." @@ -228,7 +228,7 @@ value is deducted from the contents of the file." vars))))) (defun savehist-install () - "Hook savehist into Emacs. + "Hook Savehist into Emacs. Normally invoked by calling `savehist-mode' to set the minor mode. Installs `savehist-autosave' in `kill-emacs-hook' and on a timer. To undo this, call `savehist-uninstall'." @@ -356,7 +356,7 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (defun savehist-autosave () "Save the minibuffer history if it has been modified since the last save. -Does nothing if `savehist-mode' is off." +Does nothing if Savehist mode is off." (when savehist-mode (savehist-save t))) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index baa6b794fc4..6b234109512 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -1,9 +1,9 @@ ;;; saveplace.el --- automatically save place in files -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Karl Fogel -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: July, 1993 ;; Keywords: bookmarks, placeholders @@ -54,7 +54,6 @@ This alist is saved between Emacs sessions.") "Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. -This variable is automatically buffer-local. If you wish your place in any file to always be automatically saved, set this to t using the Customize facility, or put the @@ -68,8 +67,9 @@ following code in your init file: (make-variable-buffer-local 'save-place) -(defcustom save-place-file (convert-standard-filename "~/.emacs-places") +(defcustom save-place-file (locate-user-emacs-file "places" ".emacs-places") "Name of the file that records `save-place-alist' value." + :version "24.4" ; added locate-user-emacs-file :type 'file :group 'save-place) @@ -100,7 +100,7 @@ value of `version-control'." The filenames in `save-place-alist' that do not match `save-place-skip-check-regexp' are filtered through -`file-readable-p'. if nil, their alist entries are removed. +`file-readable-p'. If nil, their alist entries are removed. You may do this anytime by calling the complementary function, `save-place-forget-unreadable-files'. When this option is turned on, @@ -150,10 +150,11 @@ the argument is positive. To save places automatically in all files, put this in your init file: -\(setq-default save-place t\)" +\(setq-default save-place t)" (interactive "P") - (if (not buffer-file-name) - (message "Buffer `%s' not visiting a file" (buffer-name)) + (if (not (or buffer-file-name (and (derived-mode-p 'dired-mode) + dired-directory))) + (message "Buffer `%s' not visiting a file or directory" (buffer-name)) (if (and save-place (or (not parg) (<= parg 0))) (progn (message "No place will be saved in this file") @@ -161,6 +162,8 @@ file: (message "Place will be saved") (setq save-place t)))) +(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) + (defun save-place-to-alist () ;; put filename and point in a cons box and then cons that onto the ;; front of the save-place-alist, if save-place is non-nil. @@ -169,28 +172,41 @@ file: ;; file. If not, do so, then feel free to modify the alist. It ;; will be saved again when Emacs is killed. (or save-place-loaded (load-save-place-alist-from-file)) - (when (and buffer-file-name - (or (not save-place-ignore-files-regexp) - (not (string-match save-place-ignore-files-regexp - buffer-file-name)))) - (let ((cell (assoc buffer-file-name save-place-alist)) - (position (if (not (eq major-mode 'hexl-mode)) - (point) - (with-no-warnings - (1+ (hexl-current-address)))))) - (if cell - (setq save-place-alist (delq cell save-place-alist))) - (if (and save-place - (not (= position 1))) ;; Optimize out the degenerate case. - (setq save-place-alist - (cons (cons buffer-file-name position) - save-place-alist)))))) + (let ((item (or buffer-file-name + (and (derived-mode-p 'dired-mode) + dired-directory + (expand-file-name (if (consp dired-directory) + (car dired-directory) + dired-directory)))))) + (when (and item + (or (not save-place-ignore-files-regexp) + (not (string-match save-place-ignore-files-regexp + item)))) + (let ((cell (assoc item save-place-alist)) + (position (cond ((eq major-mode 'hexl-mode) + (with-no-warnings + (1+ (hexl-current-address)))) + ((and (derived-mode-p 'dired-mode) + dired-directory) + (let ((filename (dired-get-filename nil t))) + (if filename + `((dired-filename . ,filename)) + (point)))) + (t (point))))) + (if cell + (setq save-place-alist (delq cell save-place-alist))) + (if (and save-place + (not (and (integerp position) + (= position 1)))) ;; Optimize out the degenerate case. + (setq save-place-alist + (cons (cons item position) + save-place-alist))))))) (defun save-place-forget-unreadable-files () "Remove unreadable files from `save-place-alist'. For each entry in the alist, if `file-readable-p' returns nil for the -filename, remove the entry. Save the new alist \(as the first pair -may have changed\) back to `save-place-alist'." +filename, remove the entry. Save the new alist (as the first pair +may have changed) back to `save-place-alist'." (interactive) ;; the following was adapted from an in-place filtering function, ;; `filter-mod', used in the original. @@ -224,9 +240,7 @@ may have changed\) back to `save-place-alist'." (symbol-name coding-system-for-write))) (let ((print-length nil) (print-level nil)) - (pp (sort save-place-alist - (lambda (a b) (string< (car a) (car b)))) - (current-buffer))) + (pp save-place-alist (current-buffer))) (let ((version-control (cond ((null save-place-version-control) nil) @@ -255,8 +269,9 @@ may have changed\) back to `save-place-alist'." (insert-file-contents file) (goto-char (point-min)) (setq save-place-alist - (car (read-from-string - (buffer-substring (point-min) (point-max))))) + (with-demoted-errors "Error reading save-place-file: %S" + (car (read-from-string + (buffer-substring (point-min) (point-max)))))) ;; If there is a limit, and we're over it, then we'll ;; have to truncate the end of the list: @@ -289,7 +304,9 @@ may have changed\) back to `save-place-alist'." (with-current-buffer (car buf-list) ;; save-place checks buffer-file-name too, but we can avoid ;; overhead of function call by checking here too. - (and buffer-file-name (save-place-to-alist)) + (and (or buffer-file-name (and (derived-mode-p 'dired-mode) + dired-directory)) + (save-place-to-alist)) (setq buf-list (cdr buf-list)))))) (defun save-place-find-file-hook () @@ -298,7 +315,29 @@ may have changed\) back to `save-place-alist'." (if cell (progn (or revert-buffer-in-progress-p - (goto-char (cdr cell))) + (and (integerp (cdr cell)) + (goto-char (cdr cell)))) + ;; and make sure it will be saved again for later + (setq save-place t))))) + +(declare-function dired-goto-file "dired" (file)) + +(defun save-place-dired-hook () + "Position the point in a Dired buffer." + (or save-place-loaded (load-save-place-alist-from-file)) + (let ((cell (assoc (and (derived-mode-p 'dired-mode) + dired-directory + (expand-file-name (if (consp dired-directory) + (car dired-directory) + dired-directory))) + save-place-alist))) + (if cell + (progn + (or revert-buffer-in-progress-p + (if (integerp (cdr cell)) + (goto-char (cdr cell)) + (and (assq 'dired-filename (cdr cell)) + (dired-goto-file (cdr (assq 'dired-filename (cdr cell))))))) ;; and make sure it will be saved again for later (setq save-place t))))) @@ -312,6 +351,8 @@ may have changed\) back to `save-place-alist'." (add-hook 'find-file-hook 'save-place-find-file-hook t) +(add-hook 'dired-initial-position-hook 'save-place-dired-hook) + (unless noninteractive (add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)) diff --git a/lisp/sb-image.el b/lisp/sb-image.el index 856bea3de5c..1a2be9d60cd 100644 --- a/lisp/sb-image.el +++ b/lisp/sb-image.el @@ -1,6 +1,6 @@ ;;; sb-image --- Image management for speedbar -;; Copyright (C) 1999-2003, 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2003, 2005-2014 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: file, tags, tools diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index f4f160e77db..b56a020c795 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -1,6 +1,6 @@ ;;; scroll-all.el --- scroll all buffers together minor mode -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Gary D. Foster ;; Keywords: scroll crisp brief lock diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 7fb17916ad3..2990e8e5ffa 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -1,8 +1,8 @@ ;;; scroll-bar.el --- window system-independent scroll bar support -;; Copyright (C) 1993-1995, 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1999-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware ;; Package: emacs diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 590fade311b..bdae2e5a2d1 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -1,9 +1,9 @@ ;;; scroll-lock.el --- Scroll lock scrolling. -;; Copyright (C) 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 2005-2014 Free Software Foundation, Inc. ;; Author: Ralf Angeli -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: 2005-06-18 ;; This file is part of GNU Emacs. diff --git a/lisp/select.el b/lisp/select.el index 58fbe5f0f51..c4d020343af 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,8 +1,8 @@ ;;; select.el --- lisp portion of standard selection support -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; This file is part of GNU Emacs. @@ -89,7 +89,8 @@ all upper-case names. The most often used ones, in addition to `PRIMARY', are `SECONDARY' and `CLIPBOARD'. DATA-TYPE is usually `STRING', but can also be one of the symbols -in `selection-converter-alist', which see." +in `selection-converter-alist', which see. This argument is +ignored on MS-Windows and MS-DOS." (let ((data (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING))) coding) diff --git a/lisp/server.el b/lisp/server.el index 05ac345d904..a8e4444b999 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1,10 +1,10 @@ ;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*- -;; Copyright (C) 1986-1987, 1992, 1994-2013 Free Software Foundation, +;; Copyright (C) 1986-1987, 1992, 1994-2014 Free Software Foundation, ;; Inc. ;; Author: William Sommerfeld -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: processes ;; Changes by peck@sun.com and by rms. @@ -1557,7 +1557,7 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (setq next-buffer (car (process-get proc 'buffers)))) (setq rest (cdr rest))))) (and next-buffer (server-switch-buffer next-buffer killed-one)) - (unless (or next-buffer killed-one (window-dedicated-p (selected-window))) + (unless (or next-buffer killed-one (window-dedicated-p)) ;; (switch-to-buffer (other-buffer)) (message "No server buffers remain to edit"))) (if (not (buffer-live-p next-buffer)) @@ -1584,16 +1584,16 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (unless (frame-live-p server-window) (setq server-window (make-frame))) (select-window (frame-selected-window server-window)))) - (when (window-minibuffer-p (selected-window)) + (when (window-minibuffer-p) (select-window (next-window nil 'nomini 0))) ;; Move to a non-dedicated window, if we have one. - (when (window-dedicated-p (selected-window)) + (when (window-dedicated-p) (select-window (get-window-with-predicate (lambda (w) (and (not (window-dedicated-p w)) (equal (frame-terminal (window-frame w)) - (frame-terminal (selected-frame))))) + (frame-terminal)))) 'nomini 'visible (selected-window)))) (condition-case nil (switch-to-buffer next-buffer) @@ -1601,7 +1601,7 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." ;; a minibuffer/dedicated-window (if there's no other). (error (pop-to-buffer next-buffer))))))) (when server-raise-frame - (select-frame-set-input-focus (window-frame (selected-window)))))) + (select-frame-set-input-focus (window-frame))))) ;;;###autoload (defun server-save-buffers-kill-terminal (arg) @@ -1611,7 +1611,7 @@ With ARG non-nil, silently save all file-visiting buffers, then kill. If emacsclient was started with a list of filenames to edit, then only these files will be asked to be saved." - (let ((proc (frame-parameter (selected-frame) 'client))) + (let ((proc (frame-parameter nil 'client))) (cond ((eq proc 'nowait) ;; Nowait frames have no client buffer list. (if (cdr (frame-list)) diff --git a/lisp/ses.el b/lisp/ses.el index bf88364456f..1626147dab4 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,6 +1,6 @@ ;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Author: Jonathan Yavner ;; Maintainer: Vincent Belaïche @@ -67,6 +67,7 @@ "Simple Emacs Spreadsheet." :tag "SES" :group 'applications + :link '(custom-manual "(ses) Top") :prefix "ses-" :version "21.1") @@ -703,7 +704,6 @@ for this spreadsheet." (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) (let* ((col-str (match-string-no-properties 1 str)) (col 0) - (col-offset 0) (col-base 1) (col-idx (1- (length col-str))) (row (1- (string-to-number (match-string-no-properties 2 str))))) @@ -740,7 +740,7 @@ row and column of the cell, with numbering starting from 0. Return nil in case of failure." (unless (local-variable-p sym) (make-local-variable sym) - (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym))) + (if (let (case-fold-search) (string-match-p "\\`[A-Z]+[0-9]+\\'" (symbol-name sym))) (put sym 'ses-cell (cons row col)) (put sym 'ses-cell :ses-named) (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) @@ -1474,7 +1474,7 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed." (let (rowcol result) (if (or (atom formula) (eq (car formula) 'quote)) (if (and (setq rowcol (ses-sym-rowcol formula)) - (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name formula))) + (string-match-p "\\`[A-Z]+[0-9]+\\'" (symbol-name formula))) (ses-relocate-symbol formula rowcol startrow startcol rowincr colincr) formula) ; Pass through as-is. @@ -1735,7 +1735,7 @@ Does not execute cell formulas or print functions." (search-backward ";; Local Variables:\n" nil t) (backward-list 1) (setq ses--params-marker (point-marker)) - (let ((params (condition-case nil (read (current-buffer)) (error nil)))) + (let ((params (ignore-errors (read (current-buffer))))) (or (and (= (safe-length params) 3) (numberp (car params)) (numberp (cadr params)) @@ -1761,7 +1761,7 @@ Does not execute cell formulas or print functions." ;; Skip over print area, which we assume is correct. (goto-char (point-min)) (forward-line ses--numrows) - (or (looking-at ses-print-data-boundary) + (or (looking-at-p ses-print-data-boundary) (error "Missing marker between print and data areas")) (forward-char 1) (setq ses--data-marker (point-marker)) @@ -1774,12 +1774,12 @@ Does not execute cell formulas or print functions." (dotimes (col ses--numcols) (let* ((x (read (current-buffer))) (sym (car-safe (cdr-safe x)))) - (or (and (looking-at "\n") + (or (and (looking-at-p "\n") (eq (car-safe x) 'ses-cell) (ses-create-cell-variable sym row col)) (error "Cell-def error")) (eval x))) - (or (looking-at "\n\n") + (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) ;; Load global parameters. (let ((widths (read (current-buffer))) @@ -1805,8 +1805,8 @@ Does not execute cell formulas or print functions." (1value (eval head-row))) ;; Should be back at global-params. (forward-char 1) - (or (looking-at (replace-regexp-in-string "1" "[0-9]+" - ses-initial-global-parameters)) + (or (looking-at-p (replace-regexp-in-string "1" "[0-9]+" + ses-initial-global-parameters)) (error "Problem with column-defs or global-params")) ;; Check for overall newline count in definitions area. (forward-line 3) @@ -1887,13 +1887,39 @@ Delete overlays, remove special text properties." ;;;###autoload (defun ses-mode () "Major mode for Simple Emacs Spreadsheet. -See \"ses-example.ses\" (in `data-directory') for more info. -Key definitions: +When you invoke SES in a new buffer, it is divided into cells +that you can enter data into. You can navigate the cells with +the arrow keys and add more cells with the tab key. The contents +of these cells can be numbers, text, or Lisp expressions. (To +enter text, enclose it in double quotes.) + +In an expression, you can use cell coordinates to refer to the +contents of another cell. For example, you can sum a range of +cells with `(+ A1 A2 A3)'. There are specialized functions like +`ses+' (addition for ranges with empty cells), `ses-average' (for +performing calculations on cells), and `ses-range' and `ses-select' +\(for extracting ranges of cells). + +Each cell also has a print function that controls how it is +displayed. + +Each SES buffer is divided into a print area and a data area. +Normally, you can simply use SES to look at and manipulate the print +area, and let SES manage the data area outside the visible region. + +See \"ses-example.ses\" (in `data-directory') for an example +spreadsheet, and the Info node `(ses)Top.' + +In the following, note the separate keymaps for cell editing mode +and print mode specifications. Key definitions: + \\{ses-mode-map} -These key definitions are active only in the print area (the visible part): +These key definitions are active only in the print area (the visible +part): \\{ses-mode-print-map} -These are active only in the minibuffer, when entering or editing a formula: +These are active only in the minibuffer, when entering or editing a +formula: \\{ses-mode-edit-map}" (interactive) (unless (and (boundp 'ses--deferred-narrow) @@ -2077,9 +2103,8 @@ Based on the current set of columns and `window-hscroll' position." (defun ses-jump-safe (cell) "Like `ses-jump', but no error if invalid cell." - (condition-case nil - (ses-jump cell) - (error))) + (ignore-errors + (ses-jump cell))) (defun ses-reprint-all (&optional nonarrow) "Recreate the display area. Calls all printer functions. Narrows to @@ -2789,7 +2814,7 @@ We clear the killed cells instead of deleting them." ;; For some reason, the text-read-only error is not caught by `delete-region', ;; so we have to use subterfuge. (let ((buffer-read-only t)) - (1value (condition-case x + (1value (condition-case nil (noreturn (funcall (lookup-key (current-global-map) (this-command-keys)) beg end)) @@ -3001,7 +3026,7 @@ spot, or error signal if user requests cancel." (if rowbool (format "%d rows" needrows) "") (if (and rowbool colbool) " and " "") (if colbool (format "%d columns" needcols) ""))) - (error "Cancelled")) + (error "Canceled")) (when rowbool (let (ses--curcell) (save-excursion @@ -3014,13 +3039,13 @@ spot, or error signal if user requests cancel." (ses-col-printer (1- ses--numcols))))) rowcol)) -(defun ses-export-tsv (beg end) +(defun ses-export-tsv (_beg _end) "Export values from the current range, with tabs between columns and newlines between rows. Result is placed in kill ring." (interactive "r") (ses-export-tab nil)) -(defun ses-export-tsf (beg end) +(defun ses-export-tsf (_beg _end) "Export formulas from the current range, with tabs between columns and newlines between rows. Result is placed in kill ring." (interactive "r") @@ -3298,7 +3323,7 @@ highlighted range in the spreadsheet." (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) (ses-cell-references-aset xcell - (cons new-name (delq sym + (cons new-name (delq sym (ses-cell-references xcell)))))) (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) @@ -3579,7 +3604,7 @@ current column and continues until the next nonblank column." current column and continues until the next nonblank column." (ses-center-span value ?~)) -(defun ses-unsafe (value) +(defun ses-unsafe (_value) "Substitute for an unsafe formula or printer." (error "Unsafe formula or printer")) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index d10ea99afb1..2bf200d07dd 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -1,6 +1,6 @@ ;;; shadowfile.el --- automatic file copying -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: comm files @@ -34,21 +34,22 @@ ;; documentation for these functions for information on how and when to use ;; them). After doing this once, everything should be automatic. -;; The lists of clusters and shadows are saved in a file called .shadows, -;; so that they can be remembered from one Emacs session to another, even -;; (as much as possible) if the Emacs session terminates abnormally. The -;; files needing to be copied are stored in .shadow_todo; if a file cannot -;; be copied for any reason, it will stay on the list to be tried again -;; next time. The .shadows file should itself have shadows on all your -;; accounts so that the information in it is consistent everywhere, but -;; .shadow_todo is local information and should have no shadows. +;; The lists of clusters and shadows are saved in a ~/.emacs.d/shadows +;; (`shadow-info-file') file, so that they can be remembered from one +;; Emacs session to another, even (as much as possible) if the Emacs +;; session terminates abnormally. The files needing to be copied are +;; stored in `shadow-todo-file'; if a file cannot be copied for any +;; reason, it will stay on the list to be tried again next time. The +;; `shadow-info-file' file should itself have shadows on all your accounts +;; so that the information in it is consistent everywhere, but +;; `shadow-todo-file' is local information and should have no shadows. ;; If you do not want to copy a particular file, you can answer "no" and ;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not ;; want to be asked again, use shadow-cancel, and you will not be asked ;; until you change the file and save it again. If you do not want to -;; shadow that file ever again, you can edit it out of the .shadows -;; buffer. Anytime you edit the .shadows buffer, you must type M-x +;; shadow that file ever again, you can edit it out of the shadows +;; buffer. Anytime you edit the shadows buffer, you must type M-x ;; shadow-read-files to load in the new information, or your changes will ;; be overwritten! @@ -74,6 +75,7 @@ ;;; Code: +(require 'cl-lib) (require 'ange-ftp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -105,10 +107,13 @@ files that have been changed and need to be copied to other systems." :type 'boolean :group 'shadow) +;; FIXME in a sense, this changed in 24.4 (addition of locate-user-emacs-file), +;; but due to the weird way this variable is initialized to nil, it didn't +;; literally change. Same for shadow-todo-file. (defcustom shadow-info-file nil "File to keep shadow information in. The `shadow-info-file' should be shadowed to all your accounts to -ensure consistency. Default: ~/.shadows" +ensure consistency. Default: ~/.emacs.d/shadows" :type '(choice (const nil) file) :group 'shadow) @@ -118,7 +123,7 @@ This means that if a remote system is down, or for any reason you cannot or decide not to copy your shadow files at the end of one Emacs session, it will remember and ask you again in your next Emacs session. This file must NOT be shadowed to any other system, it is host-specific. -Default: ~/.shadow_todo" +Default: ~/.emacs.d/shadow_todo" :type '(choice (const nil) file) :group 'shadow) @@ -180,15 +185,6 @@ created by `shadow-define-regexp-group'.") (setq list (cdr list))) (car list)) -(defun shadow-remove-if (func list) - "Remove elements satisfying FUNC from LIST. -Nondestructive; actually returns a copy of the list with the elements removed." - (if list - (if (funcall func (car list)) - (shadow-remove-if func (cdr list)) - (cons (car list) (shadow-remove-if func (cdr list)))) - nil)) - (defun shadow-regexp-superquote (string) "Like `regexp-quote', but includes the ^ and $. This makes sure regexp matches nothing but STRING." @@ -238,9 +234,8 @@ instead." Replace old definition, if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call `shadow-define-cluster' instead." - (let ((rest (shadow-remove-if - (function (lambda (x) (equal name (car x)))) - shadow-clusters))) + (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) + shadow-clusters))) (setq shadow-clusters (cons (shadow-make-cluster name primary regexp) rest)))) @@ -602,9 +597,8 @@ and to are absolute file names." Consider them as regular expressions if third arg REGEXP is true." (if groups (let ((nonmatching - (shadow-remove-if - (function (lambda (x) (shadow-file-match x file regexp))) - (car groups)))) + (cl-remove-if (lambda (x) (shadow-file-match x file regexp)) + (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp (let ((realname (nth 2 (shadow-parse-fullname file)))) @@ -635,8 +629,7 @@ Consider them as regular expressions if third arg REGEXP is true." "Remove PAIR from `shadow-files-to-copy'. PAIR must be `eq' to one of the elements of that list." (setq shadow-files-to-copy - (shadow-remove-if (function (lambda (s) (eq s pair))) - shadow-files-to-copy))) + (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) (defun shadow-read-files () "Visit and load `shadow-info-file' and `shadow-todo-file'. @@ -651,7 +644,7 @@ Return t unless files were locked; then return nil." (beep) (sit-for 3) nil) - (save-excursion + (save-current-buffer (when shadow-info-file (set-buffer (setq shadow-info-buffer (find-file-noselect shadow-info-file))) @@ -683,7 +676,7 @@ Also clear `shadow-hashtable', since when there are new shadows defined, the old hashtable info is invalid." (shadow-invalidate-hashtable) (if shadow-info-file - (save-excursion + (save-current-buffer (if (not shadow-info-buffer) (setq shadow-info-buffer (find-file-noselect shadow-info-file))) (set-buffer shadow-info-buffer) @@ -802,11 +795,13 @@ look for files that have been changed and need to be copied to other systems." (file-name-as-directory (shadow-expand-file-name "~")))) (if (null shadow-info-file) (setq shadow-info-file - (shadow-expand-file-name (convert-standard-filename "~/.shadows")))) + ;; FIXME: Move defaults to their defcustom. + (shadow-expand-file-name + (locate-user-emacs-file "shadows" ".shadows")))) (if (null shadow-todo-file) (setq shadow-todo-file (shadow-expand-file-name - (convert-standard-filename "~/.shadow_todo")))) + (locate-user-emacs-file "shadow_todo" ".shadow_todo")))) (if (not (shadow-read-files)) (progn (message "Shadowfile information files not found - aborting") diff --git a/lisp/shell.el b/lisp/shell.el index d09d7aee43f..c5c1275f19f 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,11 +1,11 @@ ;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, +;; Copyright (C) 1988, 1993-1997, 2000-2014 Free Software Foundation, ;; Inc. ;; Author: Olin Shivers ;; Simon Marshall -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: processes ;; This file is part of GNU Emacs. @@ -111,9 +111,10 @@ "Directory support in shell mode." :group 'shell) -(defgroup shell-faces nil - "Faces in shell buffers." - :group 'shell) +;; Unused. +;;; (defgroup shell-faces nil +;;; "Faces in shell buffers." +;;; :group 'shell) ;;;###autoload (defcustom shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") @@ -283,21 +284,9 @@ Value is a list of strings, which may be nil." ;; Note: There are no explicit references to the variable `explicit-bash-args'. ;; It is used implicitly by M-x shell when the interactive shell is `bash'. (defcustom explicit-bash-args - (let* ((prog (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name) - (getenv "ESHELL") shell-file-name)) - (name (file-name-nondirectory prog))) - ;; Tell bash not to use readline, except for bash 1.x which - ;; doesn't grok --noediting. Bash 1.x has -nolineediting, but - ;; process-send-eof cannot terminate bash if we use it. - (if (and (not purify-flag) - (equal name "bash") - (file-executable-p prog) - (string-match "bad option" - (shell-command-to-string - (concat (shell-quote-argument prog) - " --noediting")))) - '("-i") - '("--noediting" "-i"))) + ;; Tell bash not to use readline. It's safe to assume --noediting now, + ;; as it was introduced in 1996 in Bash version 2. + '("--noediting" "-i") "Args passed to inferior shell by \\[shell], if the shell is bash. Value is a list of strings, which may be nil." :type '(repeat (string :tag "Argument")) @@ -803,7 +792,7 @@ and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'." (if shell-dirtrackp ;; We fail gracefully if we think the command will fail in the shell. - (condition-case nil + (with-demoted-errors "Couldn't cd: %s" (let ((start (progn (string-match (concat "^" shell-command-separator-regexp) str) ; skip whitespace @@ -836,8 +825,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." (setq start (progn (string-match shell-command-separator-regexp str end) ;; skip again - (match-end 0))))) - (error "Couldn't cd")))) + (match-end 0)))))))) (defun shell-unquote-argument (string) "Remove all kinds of shell quoting from STRING." @@ -919,7 +907,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." (cond ((> num (length shell-dirstack)) (message "Directory stack not that deep.")) ((= num 0) - (error (message "Couldn't cd"))) + (error "Couldn't cd")) (shell-pushd-dextract (let ((dir (nth (1- num) shell-dirstack))) (shell-process-popd arg) @@ -1026,12 +1014,11 @@ command again." ds)) (setq i (match-end 0))) (let ((ds (nreverse ds))) - (condition-case nil - (progn (shell-cd (car ds)) - (setq shell-dirstack (cdr ds) - shell-last-dir (car shell-dirstack)) - (shell-dirstack-message)) - (error (message "Couldn't cd")))))) + (with-demoted-errors "Couldn't cd: %s" + (shell-cd (car ds)) + (setq shell-dirstack (cdr ds) + shell-last-dir (car shell-dirstack)) + (shell-dirstack-message))))) (if started-at-pmark (goto-char (marker-position pmark))))) ;; For your typing convenience: @@ -1122,18 +1109,19 @@ See `shell-command-regexp'." (defun shell-dynamic-complete-command () "Dynamically complete the command at point. This function is similar to `comint-dynamic-complete-filename', except that it -searches `exec-path' (minus the trailing Emacs library path) for completion +searches `exec-path' (minus trailing `exec-directory') for completion candidates. Note that this may not be the same as the shell's idea of the path. -Completion is dependent on the value of `shell-completion-execonly', plus -those that effect file completion. +Completion is dependent on the value of `shell-completion-execonly', +`shell-completion-fignore', plus those that affect file completion. See Info +node `Shell Options'. Returns t if successful." (interactive) (let ((data (shell-command-completion))) (if data - (prog2 (unless (window-minibuffer-p (selected-window)) + (prog2 (unless (window-minibuffer-p) (message "Completing command name...")) (apply #'completion-in-region data))))) @@ -1152,7 +1140,9 @@ Returns t if successful." (start (if (zerop (length filename)) (point) (match-beginning 0))) (end (if (zerop (length filename)) (point) (match-end 0))) (filenondir (file-name-nondirectory filename)) - (path-dirs (cdr (reverse exec-path))) ;FIXME: Why `cdr'? + ; why cdr? see `shell-dynamic-complete-command' + (path-dirs (append (cdr (reverse exec-path)) + (if (memq system-type '(windows-nt ms-dos)) '(".")))) (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore @@ -1243,7 +1233,7 @@ Returns non-nil if successful." (interactive) (let ((data (shell-environment-variable-completion))) (if data - (prog2 (unless (window-minibuffer-p (selected-window)) + (prog2 (unless (window-minibuffer-p) (message "Completing variable name...")) (apply #'completion-in-region data))))) diff --git a/lisp/simple.el b/lisp/simple.el index 3ef700a6058..85a7476dbe0 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,8 +1,8 @@ ;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1993-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -372,41 +372,24 @@ Other major modes are defined by comparison with this one." "Parent major mode from which special major modes should inherit." (setq buffer-read-only t)) -;; Major mode meant to be the parent of programming modes. - -(defvar prog-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?\C-\M-q] 'prog-indent-sexp) - map) - "Keymap used for programming modes.") - -(defun prog-indent-sexp () - "Indent the expression after point." - (interactive) - (let ((start (point)) - (end (save-excursion (forward-sexp 1) (point)))) - (indent-region start end nil))) - -(define-derived-mode prog-mode fundamental-mode "Prog" - "Major mode for editing programming language source code." - (set (make-local-variable 'require-final-newline) mode-require-final-newline) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - ;; Any programming language is always written left to right. - (setq bidi-paragraph-direction 'left-to-right)) - ;; Making and deleting lines. (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) "Propertized string representing a hard newline character.") -(defun newline (&optional arg) +(defun newline (&optional arg interactive) "Insert a newline, and move to left margin of the new line if it's blank. If option `use-hard-newlines' is non-nil, the newline is marked with the text-property `hard'. With ARG, insert that many newlines. -Call `auto-fill-function' if the current column number is greater -than the value of `fill-column' and ARG is nil." - (interactive "*P") + +To turn off indentation by this command, disable Electric Indent mode +\(see \\[electric-indent-mode]). + +Calls `auto-fill-function' if the current column number is greater +than the value of `fill-column' and ARG is nil. +A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." + (interactive "*P\np") (barf-if-buffer-read-only) ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. ;; Set last-command-event to tell self-insert what to insert. @@ -437,14 +420,20 @@ than the value of `fill-column' and ARG is nil." ;; starts a page. (or was-page-start (move-to-left-margin nil t))))) - (unwind-protect - (progn - (add-hook 'post-self-insert-hook postproc) + (if (not interactive) + ;; FIXME: For non-interactive uses, many calls actually just want + ;; (insert "\n"), so maybe we should do just that, so as to avoid + ;; the risk of filling or running abbrevs unexpectedly. + (let ((post-self-insert-hook (list postproc))) (self-insert-command (prefix-numeric-value arg))) - ;; We first used let-binding to protect the hook, but that was naive - ;; since add-hook affects the symbol-default value of the variable, - ;; whereas the let-binding might only protect the buffer-local value. - (remove-hook 'post-self-insert-hook postproc))) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc) + (self-insert-command (prefix-numeric-value arg))) + ;; We first used let-binding to protect the hook, but that was naive + ;; since add-hook affects the symbol-default value of the variable, + ;; whereas the let-binding might only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc)))) nil) (defun set-hard-newline-properties (from to) @@ -621,7 +610,7 @@ In some text modes, where TAB inserts a tab, this command indents to the column specified by the function `current-left-margin'." (interactive "*") (delete-horizontal-space t) - (newline) + (newline 1 t) (indent-according-to-mode)) (defun reindent-then-newline-and-indent () @@ -651,6 +640,67 @@ column specified by the function `current-left-margin'." (delete-horizontal-space t)) (indent-according-to-mode))) +(defcustom read-quoted-char-radix 8 + "Radix for \\[quoted-insert] and other uses of `read-quoted-char'. +Legitimate radix values are 8, 10 and 16." + :type '(choice (const 8) (const 10) (const 16)) + :group 'editing-basics) + +(defun read-quoted-char (&optional prompt) + "Like `read-char', but do not allow quitting. +Also, if the first character read is an octal digit, +we read any number of octal digits and return the +specified character code. Any nondigit terminates the sequence. +If the terminator is RET, it is discarded; +any other terminator is used itself as input. + +The optional argument PROMPT specifies a string to use to prompt the user. +The variable `read-quoted-char-radix' controls which radix to use +for numeric input." + (let ((message-log-max nil) done (first t) (code 0) translated) + (while (not done) + (let ((inhibit-quit first) + ;; Don't let C-h get the help message--only help function keys. + (help-char nil) + (help-form + "Type the special character you want to use, +or the octal character code. +RET terminates the character code and is discarded; +any other non-digit terminates the character code and is then used as input.")) + (setq translated (read-key (and prompt (format "%s-" prompt)))) + (if inhibit-quit (setq quit-flag nil))) + (if (integerp translated) + (setq translated (char-resolve-modifiers translated))) + (cond ((null translated)) + ((not (integerp translated)) + (setq unread-command-events + (listify-key-sequence (this-single-command-raw-keys)) + done t)) + ((/= (logand translated ?\M-\^@) 0) + ;; Turn a meta-character into a character with the 0200 bit set. + (setq code (logior (logand translated (lognot ?\M-\^@)) 128) + done t)) + ((and (<= ?0 translated) + (< translated (+ ?0 (min 10 read-quoted-char-radix)))) + (setq code (+ (* code read-quoted-char-radix) (- translated ?0))) + (and prompt (setq prompt (message "%s %c" prompt translated)))) + ((and (<= ?a (downcase translated)) + (< (downcase translated) + (+ ?a -10 (min 36 read-quoted-char-radix)))) + (setq code (+ (* code read-quoted-char-radix) + (+ 10 (- (downcase translated) ?a)))) + (and prompt (setq prompt (message "%s %c" prompt translated)))) + ((and (not first) (eq translated ?\C-m)) + (setq done t)) + ((not first) + (setq unread-command-events + (listify-key-sequence (this-single-command-raw-keys)) + done t)) + (t (setq code translated + done t))) + (setq first nil)) + code)) + (defun quoted-insert (arg) "Read next input character and insert it. This is useful for inserting control characters. @@ -688,6 +738,9 @@ useful for editing binary files." ;; (>= char ?\240) ;; (<= char ?\377)) ;; (setq char (unibyte-char-to-multibyte char))) + (unless (characterp char) + (user-error "%s is not a valid character" + (key-description (vector char)))) (if (> arg 0) (if (eq overwrite-mode 'overwrite-mode-binary) (delete-char arg))) @@ -744,7 +797,8 @@ If BACKWARD-ONLY is non-nil, only delete them before point." (defun just-one-space (&optional n) "Delete all spaces and tabs around point, leaving one space (or N spaces). -If N is negative, delete newlines as well, leaving -N spaces." +If N is negative, delete newlines as well, leaving -N spaces. +See also `cycle-spacing'." (interactive "*p") (cycle-spacing n nil t)) @@ -755,31 +809,22 @@ position and original spacing around the point in this variable.") (defun cycle-spacing (&optional n preserve-nl-back single-shot) - "Manipulate spaces around the point in a smart way. + "Manipulate whitespace around point in a smart way. +In interactive use, this function behaves differently in successive +consecutive calls. -When run as an interactive command, the first time it's called -in a sequence, deletes all spaces and tabs around point leaving -one (or N spaces). If this does not change content of the -buffer, skips to the second step: +The first call in a sequence acts like `just-one-space'. +It deletes all spaces and tabs around point, leaving one space +\(or N spaces). N is the prefix argument. If N is negative, +it deletes newlines as well, leaving -N spaces. +\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.) -When run for the second time in a sequence, deletes all the -spaces it has previously inserted. +The second call in a sequence (or the first call if the above does +not result in any changes) deletes all spaces. -When run for the third time, returns the whitespace and point in -a state encountered when it had been run for the first time. +The third call in a sequence restores the original whitespace (and point). -For example, if buffer contains \"foo ^ bar\" with \"^\" denoting the -point, calling `cycle-spacing' command will replace two spaces with -a single space, calling it again immediately after, will remove all -spaces, and calling it for the third time will bring two spaces back -together. - -If N is negative, delete newlines as well. However, if -PRESERVE-NL-BACK is t new line characters prior to the point -won't be removed. - -If SINGLE-SHOT is non-nil, will only perform the first step. In -other words, it will work just like `just-one-space' command." +If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." (interactive "*p") (let ((orig-pos (point)) (skip-characters (if (and n (< n 0)) " \t\n\r" " \t")) @@ -842,6 +887,8 @@ Don't use this command in Lisp programs! (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if (and arg (not (consp arg))) (forward-line 1))) +(put 'beginning-of-buffer 'interactive-only + "use `(goto-char (point-min))' instead.") (defun end-of-buffer (&optional arg) "Move point to the end of the buffer. @@ -874,6 +921,7 @@ Don't use this command in Lisp programs! ;; then scroll specially to put it near, but not at, the bottom. (overlay-recenter (point)) (recenter -3)))) +(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.") (defcustom delete-active-region t "Whether single-char deletion commands delete an active region. @@ -889,6 +937,18 @@ instead of deleted." :group 'killing :version "24.1") +(defvar region-extract-function + (lambda (delete) + (when (region-beginning) + (if (eq delete 'delete-only) + (delete-region (region-beginning) (region-end)) + (filter-buffer-substring (region-beginning) (region-end) delete)))) + "Function to get the region's content. +Called with one argument DELETE. +If DELETE is `delete-only', then only delete the region and the return value +is undefined. If DELETE is nil, just return the content as a string. +If anything else, delete the region and return its content as a string.") + (defun delete-backward-char (n &optional killflag) "Delete the previous N characters (following if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, @@ -910,8 +970,8 @@ the end of the line." (= n 1)) ;; If a region is active, kill or delete it. (if (eq delete-active-region 'kill) - (kill-region (region-beginning) (region-end)) - (delete-region (region-beginning) (region-end)))) + (kill-region (region-beginning) (region-end) 'region) + (funcall region-extract-function 'delete-only))) ;; In Overwrite mode, maybe untabify while deleting ((null (or (null overwrite-mode) (<= n 0) @@ -924,6 +984,7 @@ the end of the line." (insert-char ?\s (- ocol (current-column)) nil)))) ;; Otherwise, do simple deletion. (t (delete-char (- n) killflag)))) +(put 'delete-backward-char 'interactive-only 'delete-char) (defun delete-forward-char (n &optional killflag) "Delete the following N characters (previous if N is negative). @@ -942,8 +1003,9 @@ KILLFLAG is set if N was explicitly specified." (= n 1)) ;; If a region is active, kill or delete it. (if (eq delete-active-region 'kill) - (kill-region (region-beginning) (region-end)) - (delete-region (region-beginning) (region-end)))) + (kill-region (region-beginning) (region-end) 'region) + (funcall region-extract-function 'delete-only))) + ;; Otherwise, do simple deletion. (t (delete-char n killflag)))) @@ -1020,6 +1082,7 @@ rather than line counts." (if (eq selective-display t) (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) +(put 'goto-line 'interactive-only 'forward-line) (defun count-words-region (start end &optional arg) "Count the number of words in the region. @@ -1236,13 +1299,33 @@ in *Help* buffer. See also the command `describe-char'." bidi-fixer encoding-msg pos total percent col hscroll)))))) ;; Initialize read-expression-map. It is defined at C level. -(let ((m (make-sparse-keymap))) - (define-key m "\M-\t" 'lisp-complete-symbol) - ;; Might as well bind TAB to completion, since inserting a TAB char is much - ;; too rarely useful. - (define-key m "\t" 'lisp-complete-symbol) - (set-keymap-parent m minibuffer-local-map) - (setq read-expression-map m)) +(defvar read-expression-map + (let ((m (make-sparse-keymap))) + (define-key m "\M-\t" 'completion-at-point) + ;; Might as well bind TAB to completion, since inserting a TAB char is + ;; much too rarely useful. + (define-key m "\t" 'completion-at-point) + (set-keymap-parent m minibuffer-local-map) + m)) + +(defun read-minibuffer (prompt &optional initial-contents) + "Return a Lisp object read using the minibuffer, unevaluated. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `x'. + (read-from-minibuffer prompt initial-contents minibuffer-local-map + t 'minibuffer-history)) + +(defun eval-minibuffer (prompt &optional initial-contents) + "Return value of Lisp expression read using the minibuffer. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `X'. + (eval (read--expression prompt initial-contents))) (defvar minibuffer-completing-symbol nil "Non-nil means completing a Lisp symbol in the minibuffer.") @@ -1280,37 +1363,54 @@ Return a formatted string which is displayed in the echo area in addition to the value printed by prin1 in functions which display the result of expression evaluation." (if (and (integerp value) - (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp))) - (eq this-command last-command) - (if (boundp 'edebug-active) edebug-active))) + (or (eq standard-output t) + (zerop (prefix-numeric-value current-prefix-arg)))) (let ((char-string - (if (or (if (boundp 'edebug-active) edebug-active) - (memq this-command '(eval-last-sexp eval-print-last-sexp))) - (prin1-char value)))) + (if (and (characterp value) + (char-displayable-p value)) + (prin1-char value)))) (if char-string (format " (#o%o, #x%x, %s)" value value char-string) (format " (#o%o, #x%x)" value value))))) +(defvar eval-expression-minibuffer-setup-hook nil + "Hook run by `eval-expression' when entering the minibuffer.") + +(defun read--expression (prompt &optional initial-contents) + (let ((minibuffer-completing-symbol t)) + (minibuffer-with-setup-hook + (lambda () + (add-hook 'completion-at-point-functions + #'lisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer prompt initial-contents + read-expression-map t + 'read-expression-history)))) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value) "Evaluate EXP and print value in the echo area. -When called interactively, read an Emacs Lisp expression and -evaluate it. +When called interactively, read an Emacs Lisp expression and evaluate it. Value is also consed on to front of the variable `values'. -Optional argument INSERT-VALUE non-nil (interactively, -with prefix argument) means insert the result into the current buffer -instead of printing it in the echo area. Truncates long output -according to the value of the variables `eval-expression-print-length' -and `eval-expression-print-level'. +Optional argument INSERT-VALUE non-nil (interactively, with prefix +argument) means insert the result into the current buffer instead of +printing it in the echo area. + +Normally, this function truncates long output according to the value +of the variables `eval-expression-print-length' and +`eval-expression-print-level'. With a prefix argument of zero, +however, there is no such truncation. Such a prefix argument +also causes integers to be printed in several additional formats +\(octal, hexadecimal, and character). + +Runs the hook `eval-expression-minibuffer-setup-hook' on entering the +minibuffer. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)) + (list (read--expression "Eval: ") current-prefix-arg)) (if (null eval-expression-debug-on-error) @@ -1326,13 +1426,19 @@ this command arranges for all errors to enter the debugger." (unless (eq old-value new-value) (setq debug-on-error new-value)))) - (let ((print-length eval-expression-print-length) - (print-level eval-expression-print-level) + (let ((print-length (and (not (zerop (prefix-numeric-value insert-value))) + eval-expression-print-length)) + (print-level (and (not (zerop (prefix-numeric-value insert-value))) + eval-expression-print-level)) (deactivate-mark)) (if insert-value (with-no-warnings (let ((standard-output (current-buffer))) - (prin1 (car values)))) + (prog1 + (prin1 (car values)) + (when (zerop (prefix-numeric-value insert-value)) + (let ((str (eval-expression-print-format (car values)))) + (if str (princ str))))))) (prog1 (prin1 (car values) t) (let ((str (eval-expression-print-format (car values)))) @@ -1395,11 +1501,25 @@ to get different commands to edit and resubmit." ;; add it to the history. (or (equal newcmd (car command-history)) (setq command-history (cons newcmd command-history))) - (eval newcmd)) + (unwind-protect + (progn + ;; Trick called-interactively-p into thinking that `newcmd' is + ;; an interactive call (bug#14136). + (add-hook 'called-interactively-p-functions + #'repeat-complex-command--called-interactively-skip) + (eval newcmd)) + (remove-hook 'called-interactively-p-functions + #'repeat-complex-command--called-interactively-skip))) (if command-history (error "Argument %d is beyond length of command history" arg) (error "There are no previous complex commands to repeat"))))) +(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2) + (and (eq 'eval (cadr frame2)) + (eq 'repeat-complex-command + (cadr (backtrace-frame i #'called-interactively-p))) + 1)) + (defvar extended-command-history nil) (defun read-extended-command () @@ -1447,13 +1567,11 @@ If the value is non-nil and not a number, we wait 2 seconds." (defun execute-extended-command (prefixarg &optional command-name) ;; Based on Fexecute_extended_command in keyboard.c of Emacs. ;; Aaron S. Hawley 2009-08-24 - "Read function name, then read its arguments and call it. - -To pass a numeric argument to the command you are invoking, specify -the numeric argument to this command. - + "Read a command name, then read the arguments and call the command. +Interactively, to pass a prefix argument to the command you are +invoking, give a prefix argument to `execute-extended-command'. Noninteractively, the argument PREFIXARG is the prefix argument to -give to the command you invoke, if it asks for an argument." +give to the command you invoke." (interactive (list current-prefix-arg (read-extended-command))) ;; Emacs<24 calling-convention was with a single `prefixarg' argument. (if (null command-name) @@ -2433,6 +2551,61 @@ which is defined in the `warnings' library.\n") (setq buffer-undo-list nil) t)) +(defcustom password-word-equivalents + '("password" "passphrase" "pass phrase" + ; These are sorted according to the GNU en_US locale. + "암호" ; ko + "パスワード" ; ja + "ପ୍ରବେଶ ସଙ୍କେତ" ; or + "ពាក្យសម្ងាត់" ; km + "adgangskode" ; da + "contraseña" ; es + "contrasenya" ; ca + "geslo" ; sl + "hasło" ; pl + "heslo" ; cs, sk + "iphasiwedi" ; zu + "jelszó" ; hu + "lösenord" ; sv + "lozinka" ; hr, sr + "mật khẩu" ; vi + "mot de passe" ; fr + "parola" ; tr + "pasahitza" ; eu + "passord" ; nb + "passwort" ; de + "pasvorto" ; eo + "salasana" ; fi + "senha" ; pt + "slaptažodis" ; lt + "wachtwoord" ; nl + "كلمة السر" ; ar + "ססמה" ; he + "лозинка" ; sr + "пароль" ; kk, ru, uk + "गुप्तशब्द" ; mr + "शब्दकूट" ; hi + "પાસવર્ડ" ; gu + "సంకేతపదము" ; te + "ਪਾਸਵਰਡ" ; pa + "ಗುಪ್ತಪದ" ; kn + "கடவுச்சொல்" ; ta + "അടയാളവാക്ക്" ; ml + "গুপ্তশব্দ" ; as + "পাসওয়ার্ড" ; bn_IN + "රහස්පදය" ; si + "密码" ; zh_CN + "密碼" ; zh_TW + ) + "List of words equivalent to \"password\". +This is used by Shell mode and other parts of Emacs to recognize +password prompts, including prompts in languages other than +English. Different case choices should not be assumed to be +included; callers should bind `case-fold-search' to t." + :type '(repeat string) + :version "24.4" + :group 'processes) + (defvar shell-command-history nil "History list for some commands that read shell commands. @@ -2530,6 +2703,12 @@ to execute it asynchronously. The output appears in the buffer `*Async Shell Command*'. That buffer is in shell mode. +You can configure `async-shell-command-buffer' to specify what to do in +case when `*Async Shell Command*' buffer is already taken by another +running shell command. To run COMMAND without displaying the output +in a window you can configure `display-buffer-alist' to use the action +`display-buffer-no-window' for the buffer `*Async Shell Command*'. + In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of a shell (with its need to quote arguments)." @@ -2716,7 +2895,7 @@ the use of a shell (with its need to quote arguments)." ;; which comint sometimes adds for prompts. (let ((inhibit-read-only t)) (erase-buffer)) - (display-buffer buffer) + (display-buffer buffer '(nil (allow-no-window . t))) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name shell-command-switch command)) @@ -2840,10 +3019,11 @@ output is inserted in the current buffer, the buffer `*Shell Command Output*' is deleted. Optional fourth arg OUTPUT-BUFFER specifies where to put the -command's output. If the value is a buffer or buffer name, put -the output there. Any other value, including nil, means to -insert the output in the current buffer. In either case, the -output is inserted after point (leaving mark after it). +command's output. If the value is a buffer or buffer name, +put the output there. If the value is nil, use the buffer +`*Shell Command Output*'. Any other value, excluding nil, +means to insert the output in the current buffer. In either case, +the output is inserted after point (leaving mark after it). Optional fifth arg REPLACE, if non-nil, means to insert the output in place of text from START to END, putting point and mark @@ -2890,7 +3070,7 @@ interactively, this is t." (goto-char start) (and replace (push-mark (point) 'nomsg)) (setq exit-status - (call-process-region start end shell-file-name t + (call-process-region start end shell-file-name replace (if error-file (list t error-file) t) @@ -3004,9 +3184,9 @@ subprocess is `default-directory'. File names in INFILE and BUFFER are handled normally, but file names in ARGS should be relative to `default-directory', as they -are passed to the process verbatim. \(This is a difference to +are passed to the process verbatim. (This is a difference to `call-process' which does not support file handlers for INFILE -and BUFFER.\) +and BUFFER.) Some file handlers might not support all variants, for example they might behave as if DISPLAY was nil, regardless of the actual @@ -3131,14 +3311,17 @@ Also, delete any process that is exited or signaled." (display-buffer (button-get button 'process-buffer))) (defun list-processes (&optional query-only buffer) - "Display a list of all processes. + "Display a list of all processes that are Emacs sub-processes. If optional argument QUERY-ONLY is non-nil, only processes with the query-on-exit flag set are listed. Any process listed as exited or signaled is actually eliminated after the listing is made. Optional argument BUFFER specifies a buffer to use, instead of \"*Process List*\". -The return value is always nil." +The return value is always nil. + +This function lists only processes that were launched by Emacs. To +see other processes running on the system, use `list-system-processes'." (interactive) (or (fboundp 'process-list) (error "Asynchronous subprocesses are not supported on this system")) @@ -3153,12 +3336,18 @@ The return value is always nil." nil) (defvar universal-argument-map - (let ((map (make-sparse-keymap))) - (define-key map [t] 'universal-argument-other-key) - (define-key map (vector meta-prefix-char t) 'universal-argument-other-key) - (define-key map [switch-frame] nil) + (let ((map (make-sparse-keymap)) + (universal-argument-minus + ;; For backward compatibility, minus with no modifiers is an ordinary + ;; command if digits have already been entered. + `(menu-item "" negative-argument + :filter ,(lambda (cmd) + (if (integerp prefix-arg) nil cmd))))) + (define-key map [switch-frame] + (lambda (e) (interactive "e") + (handle-switch-frame e) (universal-argument--mode))) (define-key map [?\C-u] 'universal-argument-more) - (define-key map [?-] 'universal-argument-minus) + (define-key map [?-] universal-argument-minus) (define-key map [?0] 'digit-argument) (define-key map [?1] 'digit-argument) (define-key map [?2] 'digit-argument) @@ -3179,30 +3368,12 @@ The return value is always nil." (define-key map [kp-7] 'digit-argument) (define-key map [kp-8] 'digit-argument) (define-key map [kp-9] 'digit-argument) - (define-key map [kp-subtract] 'universal-argument-minus) + (define-key map [kp-subtract] universal-argument-minus) map) "Keymap used while processing \\[universal-argument].") -(defvar universal-argument-num-events nil - "Number of argument-specifying events read by `universal-argument'. -`universal-argument-other-key' uses this to discard those events -from (this-command-keys), and reread only the final command.") - -(defvar saved-overriding-map t - "The saved value of `overriding-terminal-local-map'. -That variable gets restored to this value on exiting \"universal -argument mode\".") - -(defun save&set-overriding-map (map) - "Set `overriding-terminal-local-map' to MAP." - (when (eq saved-overriding-map t) - (setq saved-overriding-map overriding-terminal-local-map) - (setq overriding-terminal-local-map map))) - -(defun restore-overriding-map () - "Restore `overriding-terminal-local-map' to its saved value." - (setq overriding-terminal-local-map saved-overriding-map) - (setq saved-overriding-map t)) +(defun universal-argument--mode () + (set-transient-map universal-argument-map)) (defun universal-argument () "Begin a numeric argument for the following command. @@ -3216,33 +3387,27 @@ which is different in effect from any particular numeric argument. These commands include \\[set-mark-command] and \\[start-kbd-macro]." (interactive) (setq prefix-arg (list 4)) - (setq universal-argument-num-events (length (this-command-keys))) - (save&set-overriding-map universal-argument-map)) + (universal-argument--mode)) -;; A subsequent C-u means to multiply the factor by 4 if we've typed -;; nothing but C-u's; otherwise it means to terminate the prefix arg. (defun universal-argument-more (arg) + ;; A subsequent C-u means to multiply the factor by 4 if we've typed + ;; nothing but C-u's; otherwise it means to terminate the prefix arg. (interactive "P") - (if (consp arg) - (setq prefix-arg (list (* 4 (car arg)))) - (if (eq arg '-) - (setq prefix-arg (list -4)) - (setq prefix-arg arg) - (restore-overriding-map))) - (setq universal-argument-num-events (length (this-command-keys)))) + (setq prefix-arg (if (consp arg) + (list (* 4 (car arg))) + (if (eq arg '-) + (list -4) + arg))) + (when (consp prefix-arg) (universal-argument--mode))) (defun negative-argument (arg) "Begin a negative numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." (interactive "P") - (cond ((integerp arg) - (setq prefix-arg (- arg))) - ((eq arg '-) - (setq prefix-arg nil)) - (t - (setq prefix-arg '-))) - (setq universal-argument-num-events (length (this-command-keys))) - (save&set-overriding-map universal-argument-map)) + (setq prefix-arg (cond ((integerp arg) (- arg)) + ((eq arg '-) nil) + (t '-))) + (universal-argument--mode)) (defun digit-argument (arg) "Part of the numeric argument for the next command. @@ -3252,80 +3417,45 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." last-command-event (get last-command-event 'ascii-character))) (digit (- (logand char ?\177) ?0))) - (cond ((integerp arg) - (setq prefix-arg (+ (* arg 10) - (if (< arg 0) (- digit) digit)))) - ((eq arg '-) - ;; Treat -0 as just -, so that -01 will work. - (setq prefix-arg (if (zerop digit) '- (- digit)))) - (t - (setq prefix-arg digit)))) - (setq universal-argument-num-events (length (this-command-keys))) - (save&set-overriding-map universal-argument-map)) - -;; For backward compatibility, minus with no modifiers is an ordinary -;; command if digits have already been entered. -(defun universal-argument-minus (arg) - (interactive "P") - (if (integerp arg) - (universal-argument-other-key arg) - (negative-argument arg))) - -;; Anything else terminates the argument and is left in the queue to be -;; executed as a command. -(defun universal-argument-other-key (arg) - (interactive "P") - (setq prefix-arg arg) - (let* ((key (this-command-keys)) - (keylist (listify-key-sequence key))) - (setq unread-command-events - (append (nthcdr universal-argument-num-events keylist) - unread-command-events))) - (reset-this-command-lengths) - (restore-overriding-map)) + (setq prefix-arg (cond ((integerp arg) + (+ (* arg 10) + (if (< arg 0) (- digit) digit))) + ((eq arg '-) + ;; Treat -0 as just -, so that -01 will work. + (if (zerop digit) '- (- digit))) + (t + digit)))) + (universal-argument--mode)) (defvar filter-buffer-substring-functions nil - "This variable is a wrapper hook around `filter-buffer-substring'. -Each member of the hook should be a function accepting four arguments: -\(FUN BEG END DELETE), where FUN is itself a function of three arguments + "This variable is a wrapper hook around `filter-buffer-substring'.") +(make-obsolete-variable 'filter-buffer-substring-functions + 'filter-buffer-substring-function "24.4") + +(defvar filter-buffer-substring-function #'buffer-substring--filter + "Function to perform the filtering in `filter-buffer-substring'. +The function is called with 3 arguments: \(BEG END DELETE). The arguments BEG, END, and DELETE are the same as those of `filter-buffer-substring' in each case. - -The first hook function to be called receives a FUN equivalent -to the default operation of `filter-buffer-substring', -i.e. one that returns the buffer-substring between BEG and -END (processed by any `buffer-substring-filters'). Normally, -the hook function will call FUN and then do its own processing -of the result. The next hook function receives a FUN equivalent -to the previous hook function, calls it, and does its own -processing, and so on. The overall result is that of all hook -functions acting in sequence. - -Any hook may choose not to call FUN though, in which case it -effectively replaces the default behavior with whatever it chooses. -Of course, a later hook function may do the same thing.") +It should return the buffer substring between BEG and END, after filtering.") (defvar buffer-substring-filters nil "List of filter functions for `filter-buffer-substring'. Each function must accept a single argument, a string, and return a string. The buffer substring is passed to the first function in the list, and the return value of each function is passed to -the next. The final result (if `buffer-substring-filters' is -nil, this is the unfiltered buffer-substring) is passed to the -first function on `filter-buffer-substring-functions'. - +the next. As a special convention, point is set to the start of the buffer text being operated on (i.e., the first argument of `filter-buffer-substring') before these functions are called.") (make-obsolete-variable 'buffer-substring-filters - 'filter-buffer-substring-functions "24.1") + 'filter-buffer-substring-function "24.1") (defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. -The wrapper hook `filter-buffer-substring-functions' performs -the actual filtering. The obsolete variable `buffer-substring-filters' -is also consulted. If both of these are nil, no filtering is done. +The hook `filter-buffer-substring-function' performs the actual filtering. +By default, no filtering is done. If DELETE is non-nil, the text between BEG and END is deleted from the buffer. @@ -3333,9 +3463,13 @@ from the buffer. This function should be used instead of `buffer-substring', `buffer-substring-no-properties', or `delete-and-extract-region' when you want to allow filtering to take place. For example, -major or minor modes can use `filter-buffer-substring-functions' to +major or minor modes can use `filter-buffer-substring-function' to extract characters that are special to a buffer, and should not be copied into other buffers." + (funcall filter-buffer-substring-function beg end delete)) + +;; FIXME: `with-wrapper-hook' is obsolete +(defun buffer-substring--filter (beg end &optional delete) (with-wrapper-hook filter-buffer-substring-functions (beg end delete) (cond ((or delete buffer-substring-filters) @@ -3432,7 +3566,7 @@ The comparison is done using `equal-including-properties'." :group 'killing :version "23.2") -(defun kill-new (string &optional replace yank-handler) +(defun kill-new (string &optional replace) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. If `interprogram-cut-function' is non-nil, apply it to STRING. @@ -3447,13 +3581,6 @@ When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code may access and use elements from the kill ring directly, the STRING argument should still be a \"useful\" string for such uses." - (if (> (length string) 0) - (if yank-handler - (put-text-property 0 (length string) - 'yank-handler yank-handler string)) - (if yank-handler - (signal 'args-out-of-range - (list string "yank-handler specified for empty string")))) (unless (and kill-do-not-save-duplicates ;; Due to text properties such as 'yank-handler that ;; can alter the contents to yank, comparison using @@ -3481,19 +3608,15 @@ argument should still be a \"useful\" string for such uses." (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string))) -(set-advertised-calling-convention - 'kill-new '(string &optional replace) "23.3") -(defun kill-append (string before-p &optional yank-handler) +(defun kill-append (string before-p) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) (or (= (length cur) 0) - (equal yank-handler (get-text-property 0 'yank-handler cur))) - yank-handler))) -(set-advertised-calling-convention 'kill-append '(string before-p) "23.3") + (equal nil (get-text-property 0 'yank-handler cur)))))) (defcustom yank-pop-change-selection nil "Whether rotating the kill ring changes the window system selection. @@ -3554,7 +3677,7 @@ move the yanking point; just return the Nth kill forward." :type 'boolean :group 'killing) -(defun kill-region (beg end &optional yank-handler) +(defun kill-region (beg end &optional region) "Kill (\"cut\") text between point and mark. This deletes the text from the buffer and saves it in the kill ring. The command \\[yank] can retrieve it from there. @@ -3574,19 +3697,24 @@ Supply two arguments, character positions indicating the stretch of text Any command that calls this function is a \"kill command\". If the previous command was also a kill command, the text killed this time appends to the text killed last time -to make one entry in the kill ring." - ;; Pass point first, then mark, because the order matters - ;; when calling kill-append. - (interactive (list (point) (mark))) +to make one entry in the kill ring. + +The optional argument REGION if non-nil, indicates that we're not just killing +some text between BEG and END, but we're killing the region." + ;; Pass mark first, then point, because the order matters when + ;; calling `kill-append'. + (interactive (list (mark) (point) 'region)) (unless (and beg end) (error "The mark is not set now, so there is no region")) (condition-case nil - (let ((string (filter-buffer-substring beg end t))) + (let ((string (if region + (funcall region-extract-function 'delete) + (filter-buffer-substring beg end 'delete)))) (when string ;STRING is nil if BEG = END ;; Add that string to the kill ring, one way or another. (if (eq last-command 'kill-region) - (kill-append string (< end beg) yank-handler) - (kill-new string nil yank-handler))) + (kill-append string (< end beg)) + (kill-new string nil))) (when (or string (eq last-command 'kill-region)) (setq this-command 'kill-region)) (setq deactivate-mark t) @@ -3597,7 +3725,7 @@ to make one entry in the kill ring." ;; We should beep, in case the user just isn't aware of this. ;; However, there's no harm in putting ;; the region's text in the kill ring, anyway. - (copy-region-as-kill beg end) + (copy-region-as-kill beg end region) ;; Set this-command now, so it will be set even if we get an error. (setq this-command 'kill-region) ;; This should barf, if appropriate, and give us the correct error. @@ -3607,26 +3735,34 @@ to make one entry in the kill ring." (barf-if-buffer-read-only) ;; If the buffer isn't read-only, the text is. (signal 'text-read-only (list (current-buffer))))))) -(set-advertised-calling-convention 'kill-region '(beg end) "23.3") ;; copy-region-as-kill no longer sets this-command, because it's confusing ;; to get two copies of the text when the user accidentally types M-w and ;; then corrects it with the intended C-w. -(defun copy-region-as-kill (beg end) +(defun copy-region-as-kill (beg end &optional region) "Save the region as if killed, but don't kill it. In Transient Mark mode, deactivate the mark. If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste. +The optional argument REGION if non-nil, indicates that we're not just copying +some text between BEG and END, but we're copying the region. + This command's old key binding has been given to `kill-ring-save'." - (interactive "r") + ;; Pass mark first, then point, because the order matters when + ;; calling `kill-append'. + (interactive (list (mark) (point) + (prefix-numeric-value current-prefix-arg))) + (let ((str (if region + (funcall region-extract-function nil) + (filter-buffer-substring beg end)))) (if (eq last-command 'kill-region) - (kill-append (filter-buffer-substring beg end) (< end beg)) - (kill-new (filter-buffer-substring beg end))) + (kill-append str (< end beg)) + (kill-new str))) (setq deactivate-mark t) nil) -(defun kill-ring-save (beg end) +(defun kill-ring-save (beg end &optional region) "Save the region as if killed, but don't kill it. In Transient Mark mode, deactivate the mark. If `interprogram-cut-function' is non-nil, also save the text for a window @@ -3635,10 +3771,16 @@ system cut and paste. If you want to append the killed line to the last killed text, use \\[append-next-kill] before \\[kill-ring-save]. +The optional argument REGION if non-nil, indicates that we're not just copying +some text between BEG and END, but we're copying the region. + This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied." - (interactive "r") - (copy-region-as-kill beg end) + ;; Pass mark first, then point, because the order matters when + ;; calling `kill-append'. + (interactive (list (mark) (point) + (prefix-numeric-value current-prefix-arg))) + (copy-region-as-kill beg end region) ;; This use of called-interactively-p is correct because the code it ;; controls just gives the user visual feedback. (if (called-interactively-p 'interactive) @@ -3685,7 +3827,17 @@ of this sample text; it defaults to 40." (buffer-substring-no-properties mark (+ mark len)))))))) (defun append-next-kill (&optional interactive) - "Cause following command, if it kills, to append to previous kill. + "Cause following command, if it kills, to add to previous kill. +If the next command kills forward from point, the kill is +appended to the previous killed text. If the command kills +backward, the kill is prepended. Kill commands that act on the +region, such as `kill-region', are regarded as killing forward if +point is after mark, and killing backward if point is before +mark. + +If the next command is not a kill command, `append-next-kill' has +no effect. + The argument is used for internal purposes; do not supply one." (interactive "p") ;; We don't use (interactive-p), since that breaks kbd macros. @@ -3712,6 +3864,8 @@ end positions of the text. This is done prior to removing the properties specified by `yank-excluded-properties'." :group 'killing + :type '(repeat (cons (symbol :tag "property symbol") + function)) :version "24.3") ;; This is actually used in subr.el but defcustom does not work there. @@ -3953,7 +4107,7 @@ even beep.)" "Kill current line. With prefix ARG, kill that many lines starting from the current line. If ARG is negative, kill backward. Also kill the preceding newline. -\(This is meant to make \\[repeat] work well with negative arguments.\) +\(This is meant to make \\[repeat] work well with negative arguments.) If ARG is zero, kill current line but exclude the trailing newline." (interactive "p") (or arg (setq arg 1)) @@ -4095,15 +4249,16 @@ Don't call it from programs: use `insert-buffer-substring' instead!" (progn (barf-if-buffer-read-only) (read-buffer "Insert buffer: " - (if (eq (selected-window) (next-window (selected-window))) + (if (eq (selected-window) (next-window)) (other-buffer (current-buffer)) - (window-buffer (next-window (selected-window)))) + (window-buffer (next-window))) t)))) (push-mark (save-excursion (insert-buffer-substring (get-buffer buffer)) (point))) nil) +(put 'insert-buffer 'interactive-only 'insert-buffer-substring) (defun append-to-buffer (buffer start end) "Append to specified buffer the text of the region. @@ -4157,8 +4312,7 @@ START and END specify the portion of the current buffer to be copied." (save-excursion (insert-buffer-substring oldbuf start end))))) -(put 'mark-inactive 'error-conditions '(mark-inactive error)) -(put 'mark-inactive 'error-message (purecopy "The mark is not active now")) +(define-error 'mark-inactive (purecopy "The mark is not active now")) (defvar activate-mark-hook nil "Hook run when the mark becomes active. @@ -4182,7 +4336,13 @@ a mistake; see the documentation of `set-mark'." (marker-position (mark-marker)) (signal 'mark-inactive nil))) -(defsubst deactivate-mark (&optional force) +;; Behind display-selections-p. +(declare-function x-selection-owner-p "xselect.c" + (&optional selection terminal)) +(declare-function x-selection-exists-p "xselect.c" + (&optional selection terminal)) + +(defun deactivate-mark (&optional force) "Deactivate the mark. If Transient Mark mode is disabled, this function normally does nothing; but if FORCE is non-nil, it deactivates the mark anyway. @@ -4213,8 +4373,8 @@ run `deactivate-mark-hook'." (or (x-selection-owner-p 'PRIMARY) (null (x-selection-exists-p 'PRIMARY)))) (x-set-selection 'PRIMARY - (buffer-substring (region-beginning) - (region-end)))))) + (funcall region-extract-function nil))))) + (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382). (if (and (null force) (or (eq transient-mark-mode 'lambda) (and (eq (car-safe transient-mark-mode) 'only) @@ -4227,11 +4387,14 @@ run `deactivate-mark-hook'." (setq mark-active nil) (run-hooks 'deactivate-mark-hook)))) -(defun activate-mark () - "Activate the mark." +(defun activate-mark (&optional no-tmm) + "Activate the mark. +If NO-TMM is non-nil, leave `transient-mark-mode' alone." (when (mark t) + (unless (and mark-active transient-mark-mode) + (force-mode-line-update)) ;Refresh toolbar (bug#16382). (setq mark-active t) - (unless transient-mark-mode + (unless (or transient-mark-mode no-tmm) (setq transient-mark-mode 'lambda)) (run-hooks 'activate-mark-hook))) @@ -4252,16 +4415,13 @@ store it in a Lisp variable. Example: (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." + (set-marker (mark-marker) pos (current-buffer)) (if pos - (progn - (setq mark-active t) - (run-hooks 'activate-mark-hook) - (set-marker (mark-marker) pos (current-buffer))) + (activate-mark 'no-tmm) ;; Normally we never clear mark-active except in Transient Mark mode. ;; But when we actually clear out the mark value too, we must ;; clear mark-active in any mode. - (deactivate-mark t) - (set-marker (mark-marker) nil))) + (deactivate-mark t))) (defcustom use-empty-active-region nil "Whether \"region-aware\" commands should act on empty regions. @@ -4299,9 +4459,60 @@ mode is enabled. Usually, such commands should use also checks the value of `use-empty-active-region'." (and transient-mark-mode mark-active)) -(defvar mark-ring nil + +(defvar redisplay-unhighlight-region-function + (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) + +(defvar redisplay-highlight-region-function + (lambda (start end window rol) + (if (not (overlayp rol)) + (let ((nrol (make-overlay start end))) + (funcall redisplay-unhighlight-region-function rol) + (overlay-put nrol 'window window) + (overlay-put nrol 'face 'region) + nrol) + (unless (and (eq (overlay-buffer rol) (current-buffer)) + (eq (overlay-start rol) start) + (eq (overlay-end rol) end)) + (move-overlay rol start end (current-buffer))) + rol))) + +(defun redisplay--update-region-highlight (window) + (with-current-buffer (window-buffer window) + (let ((rol (window-parameter window 'internal-region-overlay))) + (if (not (region-active-p)) + (funcall redisplay-unhighlight-region-function rol) + (let* ((pt (window-point window)) + (mark (mark)) + (start (min pt mark)) + (end (max pt mark)) + (new + (funcall redisplay-highlight-region-function + start end window rol))) + (unless (equal new rol) + (set-window-parameter window 'internal-region-overlay + new))))))) + +(defun redisplay--update-region-highlights (windows) + (with-demoted-errors "redisplay--update-region-highlights: %S" + (if (null windows) + (redisplay--update-region-highlight (selected-window)) + (unless (listp windows) (setq windows (window-list-1 nil nil t))) + (if highlight-nonselected-windows + (mapc #'redisplay--update-region-highlight windows) + (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window)))) + (dolist (w windows) + (if (or (eq w (selected-window)) (eq w msw)) + (redisplay--update-region-highlight w) + (funcall redisplay-unhighlight-region-function + (window-parameter w 'internal-region-overlay))))))))) + +(add-function :before pre-redisplay-function + #'redisplay--update-region-highlights) + + +(defvar-local mark-ring nil "The list of former marks of the current buffer, most recent first.") -(make-variable-buffer-local 'mark-ring) (put 'mark-ring 'permanent-local t) (defcustom mark-ring-max 16 @@ -4320,7 +4531,7 @@ Start discarding off end if gets this big." (defun pop-to-mark-command () "Jump to mark, and pop a new position for mark off the ring. -\(Does not affect global mark ring\)." +\(Does not affect global mark ring)." (interactive) (if (null (mark t)) (error "No mark set in this buffer") @@ -4334,11 +4545,10 @@ Start discarding off end if gets this big." If no prefix ARG and mark is already set there, just activate it. Display `Mark set' unless the optional second arg NOMSG is non-nil." (interactive "P") - (let ((mark (marker-position (mark-marker)))) + (let ((mark (mark t))) (if (or arg (null mark) (/= mark (point))) (push-mark nil nomsg t) - (setq mark-active t) - (run-hooks 'activate-mark-hook) + (activate-mark 'no-tmm) (unless nomsg (message "Mark activated"))))) @@ -4367,11 +4577,11 @@ global mark ring, if the previous mark was set in another buffer. When Transient Mark Mode is off, immediately repeating this command activates `transient-mark-mode' temporarily. -With prefix argument \(e.g., \\[universal-argument] \\[set-mark-command]\), \ +With prefix argument (e.g., \\[universal-argument] \\[set-mark-command]), \ jump to the mark, and set the mark from -position popped off the local mark ring \(this does not affect the global -mark ring\). Use \\[pop-global-mark] to jump to a mark popped off the global -mark ring \(see `pop-global-mark'\). +position popped off the local mark ring (this does not affect the global +mark ring). Use \\[pop-global-mark] to jump to a mark popped off the global +mark ring (see `pop-global-mark'). If `set-mark-command-repeat-pop' is non-nil, repeating the \\[set-mark-command] command with no prefix argument pops the next position @@ -4476,7 +4686,6 @@ mode temporarily." (temp-highlight (eq (car-safe transient-mark-mode) 'only))) (if (null omark) (error "No mark set in this buffer")) - (deactivate-mark) (set-mark (point)) (goto-char omark) (cond (temp-highlight @@ -4602,6 +4811,12 @@ for it.") (defun next-line (&optional arg try-vscroll) "Move cursor vertically down ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4642,10 +4857,17 @@ and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move arg nil nil try-vscroll))) nil) +(put 'next-line 'interactive-only 'forward-line) (defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4675,6 +4897,8 @@ to use and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move (- arg) nil nil try-vscroll)) nil) +(put 'previous-line 'interactive-only + "use `forward-line' with negative argument instead.") (defcustom track-eol nil "Non-nil means vertical motion starting at end of line keeps to ends of lines. @@ -4725,61 +4949,159 @@ lines." :group 'editing-basics :version "23.1") +;; Only used if display-graphic-p. +(declare-function font-info "font.c" (name &optional frame)) + +(defun default-font-height () + "Return the height in pixels of the current buffer's default face font." + (let ((default-font (face-font 'default))) + (cond + ((and (display-multi-font-p) + ;; Avoid calling font-info if the frame's default font was + ;; not changed since the frame was created. That's because + ;; font-info is expensive for some fonts, see bug #14838. + (not (string= (frame-parameter nil 'font) default-font))) + (aref (font-info default-font) 3)) + (t (frame-char-height))))) + +(defun default-line-height () + "Return the pixel height of current buffer's default-face text line. + +The value includes `line-spacing', if any, defined for the buffer +or the frame." + (let ((dfh (default-font-height)) + (lsp (if (display-graphic-p) + (or line-spacing + (default-value 'line-spacing) + (frame-parameter nil 'line-spacing) + 0) + 0))) + (if (floatp lsp) + (setq lsp (* dfh lsp))) + (+ dfh lsp))) + +(defun window-screen-lines () + "Return the number of screen lines in the text area of the selected window. + +This is different from `window-text-height' in that this function counts +lines in units of the height of the font used by the default face displayed +in the window, not in units of the frame's default font, and also accounts +for `line-spacing', if any, defined for the window's buffer or frame. + +The value is a floating-point number." + (let ((canonical (window-text-height)) + (fch (frame-char-height)) + (dlh (default-line-height))) + (/ (* (float canonical) fch) dlh))) + ;; Returns non-nil if partial move was done. (defun line-move-partial (arg noerror to-end) (if (< arg 0) ;; Move backward (up). ;; If already vscrolled, reduce vscroll - (let ((vs (window-vscroll nil t))) - (when (> vs (frame-char-height)) - (set-window-vscroll nil (- vs (frame-char-height)) t))) + (let ((vs (window-vscroll nil t)) + (dlh (default-line-height))) + (when (> vs dlh) + (set-window-vscroll nil (- vs dlh) t))) ;; Move forward (down). (let* ((lh (window-line-height -1)) + (rowh (car lh)) (vpos (nth 1 lh)) (ypos (nth 2 lh)) (rbot (nth 3 lh)) - py vs) + (this-lh (window-line-height)) + (this-height (car this-lh)) + (this-ypos (nth 2 this-lh)) + (dlh (default-line-height)) + (wslines (window-screen-lines)) + (edges (window-inside-pixel-edges)) + (winh (- (nth 3 edges) (nth 1 edges) 1)) + py vs last-line) + (if (> (mod wslines 1.0) 0.0) + (setq wslines (round (+ wslines 0.5)))) (when (or (null lh) - (>= rbot (frame-char-height)) - (<= ypos (- (frame-char-height)))) + (>= rbot dlh) + (<= ypos (- dlh)) + (null this-lh) + (<= this-ypos (- dlh))) (unless lh (let ((wend (pos-visible-in-window-p t nil t))) (setq rbot (nth 3 wend) + rowh (nth 4 wend) vpos (nth 5 wend)))) + (unless this-lh + (let ((wstart (pos-visible-in-window-p nil nil t))) + (setq this-ypos (nth 2 wstart) + this-height (nth 4 wstart)))) + (setq py + (or (nth 1 this-lh) + (let ((ppos (posn-at-point)) + col-row) + (setq col-row (posn-actual-col-row ppos)) + (if col-row + (- (cdr col-row) (window-vscroll)) + (cdr (posn-col-row ppos)))))) + ;; VPOS > 0 means the last line is only partially visible. + ;; But if the part that is visible is at least as tall as the + ;; default font, that means the line is actually fully + ;; readable, and something like line-spacing is hidden. So in + ;; that case we accept the last line in the window as still + ;; visible, and consider the margin as starting one line + ;; later. + (if (and vpos (> vpos 0)) + (if (and rowh + (>= rowh (default-font-height)) + (< rowh dlh)) + (setq last-line (min (- wslines scroll-margin) vpos)) + (setq last-line (min (- wslines scroll-margin 1) (1- vpos))))) (cond - ;; If last line of window is fully visible, move forward. - ((or (null rbot) (= rbot 0)) + ;; If last line of window is fully visible, and vscrolling + ;; more would make this line invisible, move forward. + ((and (or (< (setq vs (window-vscroll nil t)) dlh) + (null this-height) + (<= this-height dlh)) + (or (null rbot) (= rbot 0))) nil) - ;; If cursor is not in the bottom scroll margin, move forward. - ((and (> vpos 0) - (< (setq py - (or (nth 1 (window-line-height)) - (let ((ppos (posn-at-point))) - (cdr (or (posn-actual-col-row ppos) - (posn-col-row ppos)))))) - (min (- (window-text-height) scroll-margin 1) (1- vpos)))) + ;; If cursor is not in the bottom scroll margin, and the + ;; current line is is not too tall, move forward. + ((and (or (null this-height) (<= this-height winh)) + vpos + (> vpos 0) + (< py last-line)) nil) ;; When already vscrolled, we vscroll some more if we can, ;; or clear vscroll and move forward at end of tall image. - ((> (setq vs (window-vscroll nil t)) 0) - (when (> rbot 0) - (set-window-vscroll nil (+ vs (min rbot (frame-char-height))) t))) + ((> vs 0) + (when (or (and rbot (> rbot 0)) + (and this-height (> this-height dlh))) + (set-window-vscroll nil (+ vs dlh) t))) ;; If cursor just entered the bottom scroll margin, move forward, - ;; but also vscroll one line so redisplay won't recenter. - ((and (> vpos 0) - (= py (min (- (window-text-height) scroll-margin 1) - (1- vpos)))) - (set-window-vscroll nil (frame-char-height) t) + ;; but also optionally vscroll one line so redisplay won't recenter. + ((and vpos + (> vpos 0) + (= py last-line)) + ;; Don't vscroll if the partially-visible line at window + ;; bottom is not too tall (a.k.a. "just one more text + ;; line"): in that case, we do want redisplay to behave + ;; normally, i.e. recenter or whatever. + ;; + ;; Note: ROWH + RBOT from the value returned by + ;; pos-visible-in-window-p give the total height of the + ;; partially-visible glyph row at the end of the window. As + ;; we are dealing with floats, we disregard sub-pixel + ;; discrepancies between that and DLH. + (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1)) + (set-window-vscroll nil dlh t)) (line-move-1 arg noerror to-end) t) ;; If there are lines above the last line, scroll-up one line. - ((> vpos 0) + ((and vpos (> vpos 0)) (scroll-up 1) t) ;; Finally, start vscroll. (t - (set-window-vscroll nil (frame-char-height) t))))))) + (set-window-vscroll nil dlh t))))))) ;; This is like line-move-1 except that it also performs @@ -4789,6 +5111,12 @@ lines." ;; a cleaner solution to the problem of making C-n do something ;; useful given a tall image. (defun line-move (arg &optional noerror to-end try-vscroll) + "Move forward ARG lines. +If NOERROR, don't signal an error if we can't move ARG lines. +TO-END is unused. +TRY-VSCROLL controls whether to vscroll tall lines: if either +`auto-window-vscroll' or TRY-VSCROLL is nil, this function will +not vscroll." (if noninteractive (forward-line arg) (unless (and auto-window-vscroll try-vscroll @@ -4808,14 +5136,38 @@ lines." ;; When the text in the window is scrolled to the left, ;; display-based motion doesn't make sense (because each ;; logical line occupies exactly one screen line). - (not (> (window-hscroll) 0))) - (line-move-visual arg noerror) + (not (> (window-hscroll) 0)) + ;; Likewise when the text _was_ scrolled to the left + ;; when the current run of vertical motion commands + ;; started. + (not (and (memq last-command + `(next-line previous-line ,this-command)) + auto-hscroll-mode + (numberp temporary-goal-column) + (>= temporary-goal-column + (- (window-width) hscroll-margin))))) + (prog1 (line-move-visual arg noerror) + ;; If we moved into a tall line, set vscroll to make + ;; scrolling through tall images more smooth. + (let ((lh (line-pixel-height)) + (edges (window-inside-pixel-edges)) + (dlh (default-line-height)) + winh) + (setq winh (- (nth 3 edges) (nth 1 edges) 1)) + (if (and (< arg 0) + (< (point) (window-start)) + (> lh winh)) + (set-window-vscroll + nil + (- lh dlh) t)))) (line-move-1 arg noerror to-end))))) ;; Display-based alternative to line-move-1. ;; Arg says how many lines to move. The value is t if we can move the ;; specified number of lines. (defun line-move-visual (arg &optional noerror) + "Move ARG lines forward. +If NOERROR, don't signal an error if we can't move that many lines." (let ((opoint (point)) (hscroll (window-hscroll)) target-hscroll) @@ -4840,13 +5192,25 @@ lines." (frame-char-width)) hscroll)))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) - (or (and (= (vertical-motion - (cons (or goal-column - (if (consp temporary-goal-column) - (car temporary-goal-column) - temporary-goal-column)) - arg)) - arg) + ;; vertical-motion can move more than it was asked to if it moves + ;; across display strings with newlines. We don't want to ring + ;; the bell and announce beginning/end of buffer in that case. + (or (and (or (and (>= arg 0) + (>= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg)) + (and (< arg 0) + (<= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg))) (or (>= arg 0) (/= (point) opoint) ;; If the goal column lies on a display string, @@ -5016,7 +5380,7 @@ lines." ;; the middle of a continued line. When we get to ;; line-move-finish, point is at the start of a new *screen* ;; line but the same text line; then line-move-to-column would - ;; move us backwards. Test using C-n with point on the "x" in + ;; move us backwards. Test using C-n with point on the "x" in ;; (insert "a" (propertize "x" 'field t) (make-string 89 ?y)) (and forward (< (point) old) @@ -5174,9 +5538,9 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (goto-char (previous-char-property-change (point))) (skip-chars-backward "^\n")) - ;; Now find first visible char in the line - (while (and (not (eobp)) (invisible-p (point))) - (goto-char (next-char-property-change (point)))) + ;; Now find first visible char in the line. + (while (and (< (point) orig) (invisible-p (point))) + (goto-char (next-char-property-change (point) orig))) (setq first-vis (point)) ;; See if fields would stop us from reaching FIRST-VIS. @@ -5398,8 +5762,7 @@ Mode' for details." (visual-line-mode 1)) (define-globalized-minor-mode global-visual-line-mode - visual-line-mode turn-on-visual-line-mode - :lighter " vl") + visual-line-mode turn-on-visual-line-mode) (defun transpose-chars (arg) @@ -5537,7 +5900,8 @@ current object." (defun backward-word (&optional arg) "Move backward until encountering the beginning of a word. -With argument ARG, do this that many times." +With argument ARG, do this that many times. +If ARG is omitted or nil, move point backward one word." (interactive "^p") (forward-word (- (or arg 1)))) @@ -5831,7 +6195,7 @@ The variable `selective-display' has a separate value for each buffer." (setq selective-display (and arg (prefix-numeric-value arg))) (recenter current-vpos)) - (set-window-start (selected-window) (window-start (selected-window))) + (set-window-start (selected-window) (window-start)) (princ "selective-display set to " t) (prin1 selective-display t) (princ "." t)) @@ -6033,8 +6397,15 @@ position just before the opening token and END is the position right after. START can be nil, if it was not found. The function should return non-nil if the two tokens do not match.") +(defvar blink-matching--overlay + (let ((ol (make-overlay (point) (point) nil t))) + (overlay-put ol 'face 'show-paren-match) + (delete-overlay ol) + ol) + "Overlay used to highlight the matching paren.") + (defun blink-matching-open () - "Move cursor momentarily to the beginning of the sexp before point." + "Momentarily highlight the beginning of the sexp before point." (interactive) (when (and (not (bobp)) blink-matching-paren) @@ -6076,13 +6447,17 @@ The function should return non-nil if the two tokens do not match.") (message "No matching parenthesis found")))) ((not blinkpos) nil) ((pos-visible-in-window-p blinkpos) - ;; Matching open within window, temporarily move to blinkpos but only - ;; if `blink-matching-paren-on-screen' is non-nil. + ;; Matching open within window, temporarily highlight char + ;; after blinkpos but only if `blink-matching-paren-on-screen' + ;; is non-nil. (and blink-matching-paren-on-screen (not show-paren-mode) - (save-excursion - (goto-char blinkpos) - (sit-for blink-matching-delay)))) + (unwind-protect + (progn + (move-overlay blink-matching--overlay blinkpos (1+ blinkpos) + (current-buffer)) + (sit-for blink-matching-delay)) + (delete-overlay blink-matching--overlay)))) (t (save-excursion (goto-char blinkpos) @@ -6135,10 +6510,14 @@ More precisely, a char with closeparen syntax is self-inserted.") (point)))))) (funcall blink-paren-function))) +(put 'blink-paren-post-self-insert-function 'priority 100) + (add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function ;; Most likely, this hook is nil, so this arg doesn't matter, ;; but I use it as a reminder that this function usually - ;; likes to be run after others since it does `sit-for'. + ;; likes to be run after others since it does + ;; `sit-for'. That's also the reason it get a `priority' prop + ;; of 100. 'append) ;; This executes C-g typed while Emacs is waiting for a command. @@ -6409,10 +6788,10 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (call-interactively `(lambda (arg) (interactive ,prop) arg)) - (read - (read-string prompt nil - 'set-variable-value-history - (format "%S" (symbol-value var)))))))) + (read-from-minibuffer prompt nil + read-expression-map t + 'set-variable-value-history + (format "%S" (symbol-value var))))))) (list var val current-prefix-arg))) (and (custom-variable-p variable) @@ -6495,8 +6874,7 @@ Go to the window from which completion was requested." (interactive) (let ((buf completion-reference-buffer)) (if (one-window-p t) - (if (window-dedicated-p (selected-window)) - (delete-frame (selected-frame))) + (if (window-dedicated-p) (delete-frame)) (delete-window (selected-window)) (if (get-buffer-window buf) (select-window (get-buffer-window buf)))))) @@ -6535,7 +6913,8 @@ With prefix argument N, move N items (negative N means move backward)." (setq n (1+ n)))))) (defun choose-completion (&optional event) - "Choose the completion at point." + "Choose the completion at point. +If EVENT, use EVENT's position to determine the starting position." (interactive (list last-nonmenu-event)) ;; In case this is run via the mouse, give temporary modes such as ;; isearch a chance to turn off. @@ -6606,12 +6985,10 @@ With prefix argument N, move N items (negative N means move backward)." (defvar choose-completion-string-functions nil "Functions that may override the normal insertion of a completion choice. -These functions are called in order with four arguments: +These functions are called in order with three arguments: CHOICE - the string to insert in the buffer, BUFFER - the buffer in which the choice should be inserted, -MINI-P - non-nil if BUFFER is a minibuffer, and -BASE-SIZE - the number of characters in BUFFER before -the string being completed. +BASE-POSITION - where to insert the completion. If a function in the list returns non-nil, that function is supposed to have inserted the CHOICE in the BUFFER, and possibly exited @@ -6623,7 +7000,9 @@ the default method of inserting the completion in BUFFER.") (defun choose-completion-string (choice &optional buffer base-position insert-function) "Switch to BUFFER and insert the completion choice CHOICE. -BASE-POSITION, says where to insert the completion." +BASE-POSITION says where to insert the completion. +INSERT-FUNCTION says how to insert the completion and falls +back on `completion-list-insert-choice-function' when nil." ;; If BUFFER is the minibuffer, exit the minibuffer ;; unless it is reading a file name and CHOICE is a directory, @@ -6717,15 +7096,21 @@ Called from `temp-buffer-show-hook'." (defun completion-setup-function () (let* ((mainbuf (current-buffer)) (base-dir - ;; When reading a file name in the minibuffer, - ;; try and find the right default-directory to set in the - ;; completion list buffer. - ;; FIXME: Why do we do that, actually? --Stef + ;; FIXME: This is a bad hack. We try to set the default-directory + ;; in the *Completions* buffer so that the relative file names + ;; displayed there can be treated as valid file names, independently + ;; from the completion context. But this suffers from many problems: + ;; - It's not clear when the completions are file names. With some + ;; completion tables (e.g. bzr revision specs), the listed + ;; completions can mix file names and other things. + ;; - It doesn't pay attention to possible quoting. + ;; - With fancy completion styles, the code below will not always + ;; find the right base directory. (if minibuffer-completing-file-name (file-name-as-directory (expand-file-name - (substring (minibuffer-completion-contents) - 0 (or completion-base-size 0))))))) + (buffer-substring (minibuffer-prompt-end) + (- (point) (or completion-base-size 0)))))))) (with-current-buffer standard-output (let ((base-size completion-base-size) ;Read before killing localvars. (base-position completion-base-position) @@ -6846,17 +7231,11 @@ PREFIX is the string that represents this modifier in an event type symbol." (normal (nth 1 keypad-normal))) (put keypad 'ascii-character normal) (define-key function-key-map (vector keypad) (vector normal)))) - '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4) - (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9) - (kp-space ?\s) + ;; See also kp-keys bound in bindings.el. + '((kp-space ?\s) (kp-tab ?\t) (kp-enter ?\r) - (kp-multiply ?*) - (kp-add ?+) (kp-separator ?,) - (kp-subtract ?-) - (kp-decimal ?.) - (kp-divide ?/) (kp-equal ?=) ;; Do the same for various keys that are represented as symbols under ;; GUIs but naturally correspond to characters. @@ -7153,7 +7532,7 @@ See also `normal-erase-is-backspace'." (if enabled (progn (define-key local-function-key-map [delete] [deletechar]) - (define-key local-function-key-map [kp-delete] [?\C-d]) + (define-key local-function-key-map [kp-delete] [deletechar]) (define-key local-function-key-map [backspace] [?\C-?]) (dolist (b bindings) ;; Not sure if input-decode-map is really right, but @@ -7228,6 +7607,24 @@ and setting it to nil." buffer-invisibility-spec) (setq buffer-invisibility-spec nil))) +(defvar messages-buffer-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) + (define-key map "g" nil) ; nothing to revert + map)) + +(define-derived-mode messages-buffer-mode special-mode "Messages" + "Major mode used in the \"*Messages*\" buffer.") + +(defun messages-buffer () + "Return the \"*Messages*\" buffer. +If it does not exist, create and it switch it to `messages-buffer-mode'." + (or (get-buffer "*Messages*") + (with-current-buffer (get-buffer-create "*Messages*") + (messages-buffer-mode) + (current-buffer)))) + + ;; Minibuffer prompt stuff. ;;(defun minibuffer-prompt-modification (start end) @@ -7276,8 +7673,7 @@ version and use the one distributed with Emacs.")) "Alist of packages known to cause problems in this version of Emacs. Each element has the form (PACKAGE SYMBOL REGEXP STRING). PACKAGE is either a regular expression to match file names, or a -symbol (a feature name); see the documentation of -`after-load-alist', to which this variable adds functions. +symbol (a feature name), like for `with-eval-after-load'. SYMBOL is either the name of a string variable, or `t'. Upon loading PACKAGE, if SYMBOL is t or matches REGEXP, display a warning using STRING as the message.") @@ -7295,10 +7691,115 @@ warning using STRING as the message.") (display-warning package (nth 3 list) :warning))) (error nil))) -(mapc (lambda (elem) - (eval-after-load (car elem) `(bad-package-check ',(car elem)))) - bad-packages-alist) +(dolist (elem bad-packages-alist) + (let ((pkg (car elem))) + (with-eval-after-load pkg + (bad-package-check pkg)))) + +;;; Generic dispatcher commands + +;; Macro `define-alternatives' is used to create generic commands. +;; Generic commands are these (like web, mail, news, encrypt, irc, etc.) +;; that can have different alternative implementations where choosing +;; among them is exclusively a matter of user preference. + +;; (define-alternatives COMMAND) creates a new interactive command +;; M-x COMMAND and a customizable variable COMMAND-alternatives. +;; Typically, the user will not need to customize this variable; packages +;; wanting to add alternative implementations should use +;; +;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives + +(defmacro define-alternatives (command &rest customizations) + "Define the new command `COMMAND'. + +The argument `COMMAND' should be a symbol. + +Running `M-x COMMAND RET' for the first time prompts for which +alternative to use and records the selected command as a custom +variable. + +Running `C-u M-x COMMAND RET' prompts again for an alternative +and overwrites the previous choice. + +The variable `COMMAND-alternatives' contains an alist with +alternative implementations of COMMAND. `define-alternatives' +does not have any effect until this variable is set. + +CUSTOMIZATIONS, if non-nil, should be composed of alternating +`defcustom' keywords and values to add to the declaration of +`COMMAND-alternatives' (typically :group and :version)." + (let* ((command-name (symbol-name command)) + (varalt-name (concat command-name "-alternatives")) + (varalt-sym (intern varalt-name)) + (varimp-sym (intern (concat command-name "--implementation")))) + `(progn + + (defcustom ,varalt-sym nil + ,(format "Alist of alternative implementations for the `%s' command. + +Each entry must be a pair (ALTNAME . ALTFUN), where: +ALTNAME - The name shown at user to describe the alternative implementation. +ALTFUN - The function called to implement this alternative." + command-name) + :type '(alist :key-type string :value-type function) + ,@customizations) + + (put ',varalt-sym 'definition-name ',command) + (defvar ,varimp-sym nil "Internal use only.") + + (defun ,command (&optional arg) + ,(format "Run generic command `%s'. +If used for the first time, or with interactive ARG, ask the user which +implementation to use for `%s'. The variable `%s' +contains the list of implementations currently supported for this command." + command-name command-name varalt-name) + (interactive "P") + (when (or arg (null ,varimp-sym)) + (let ((val (completing-read + ,(format "Select implementation for command `%s': " + command-name) + ,varalt-sym nil t))) + (unless (string-equal val "") + (when (null ,varimp-sym) + (message + "Use `C-u M-x %s RET' to select another implementation" + ,command-name) + (sit-for 3)) + (customize-save-variable ',varimp-sym + (cdr (assoc-string val ,varalt-sym)))))) + (if ,varimp-sym + (call-interactively ,varimp-sym) + (message ,(format "No implementation selected for command `%s'" + command-name))))))) + + +;; This is here because files in obsolete/ are not scanned for autoloads. + +(defvar iswitchb-mode nil "\ +Non-nil if Iswitchb mode is enabled. +See the command `iswitchb-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `iswitchb-mode'.") + +(custom-autoload 'iswitchb-mode "iswitchb" nil) + +(autoload 'iswitchb-mode "iswitchb" "\ +Toggle Iswitchb mode. +With a prefix argument ARG, enable Iswitchb mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +Iswitchb mode is a global minor mode that enables switching +between buffers using substrings. See `iswitchb' for details. + +\(fn &optional ARG)" t nil) + +(make-obsolete 'iswitchb-mode + "use `icomplete-mode' or `ido-mode' instead." "24.4") + (provide 'simple) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 01288b89132..767f0b3490b 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -1,9 +1,9 @@ ;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*- -;; Copyright (C) 1993-1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1996, 2001-2014 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: extensions, abbrev, languages, tools ;; This file is part of GNU Emacs. @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + ;; page 1: statement skeleton language definition & interpreter ;; page 2: paired insertion ;; page 3: mirror-mode, an example for setting up paired insertion @@ -84,13 +86,11 @@ The variables `v1' and `v2' are still set when calling this.") "When non-nil, indent rigidly under current line for element `\\n'. Else use mode's `indent-line-function'.") -(defvar skeleton-further-elements () +(defvar-local skeleton-further-elements () "A buffer-local varlist (see `let') of mode specific skeleton elements. These variables are bound while interpreting a skeleton. Their value may in turn be any valid skeleton element if they are themselves to be used as skeleton elements.") -(make-variable-buffer-local 'skeleton-further-elements) - (defvar skeleton-subprompt (substitute-command-keys @@ -260,8 +260,10 @@ When done with skeleton, but before going back to `_'-point call skeleton-modified skeleton-point resume: help input v1 v2) (setq skeleton-positions nil) (unwind-protect - (eval `(let ,skeleton-further-elements - (skeleton-internal-list skeleton str))) + (cl-progv + (mapcar #'car skeleton-further-elements) + (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) + (skeleton-internal-list skeleton str)) (run-hooks 'skeleton-end-hook) (sit-for 0) (or (pos-visible-in-window-p beg) @@ -354,15 +356,6 @@ automatically, and you are prompted to fill in the variable parts."))) (signal 'quit 'recursive) recursive)) -(defun skeleton-newline () - (if (or (eq (point) skeleton-point) - (eq (point) (car skeleton-positions))) - ;; If point is recorded, avoid `newline' since it may do things like - ;; strip trailing spaces, and since recorded points are commonly placed - ;; right after a trailing space, calling `newline' can destroy the - ;; position and renders the recorded position incorrect. - (insert "\n") - (newline))) (defun skeleton-internal-1 (element &optional literal recursive) (cond @@ -382,7 +375,7 @@ automatically, and you are prompted to fill in the variable parts."))) (let ((pos (if (eq element '>) (point)))) (cond ((and skeleton-regions (eq (nth 1 skeleton-il) '_)) - (or (eolp) (newline)) + (or (eolp) (insert "\n")) (if pos (save-excursion (goto-char pos) (indent-according-to-mode))) (indent-region (line-beginning-position) (car skeleton-regions) nil)) @@ -391,13 +384,13 @@ automatically, and you are prompted to fill in the variable parts."))) (if pos (indent-according-to-mode))) (skeleton-newline-indent-rigidly (let ((pt (point))) - (skeleton-newline) + (insert "\n") (indent-to (save-excursion (goto-char pt) (if pos (indent-according-to-mode)) (current-indentation))))) (t (if pos (reindent-then-newline-and-indent) - (skeleton-newline) + (insert "\n") (indent-according-to-mode)))))) ((eq element '>) (if (and skeleton-regions (eq (nth 1 skeleton-il) '_)) @@ -516,7 +509,6 @@ symmetrical ones, and the same character twice for the others." (let* ((mark (and skeleton-autowrap (or (eq last-command 'mouse-drag-region) (and transient-mark-mode mark-active)))) - (skeleton-end-hook) (char last-command-event) (skeleton (or (assq char skeleton-pair-alist) (assq char skeleton-pair-default-alist) @@ -527,7 +519,9 @@ symmetrical ones, and the same character twice for the others." (if (not skeleton-pair-on-word) (looking-at "\\w")) (funcall skeleton-pair-filter-function)))) (self-insert-command (prefix-numeric-value arg)) - (skeleton-insert (cons nil skeleton) (if mark -1)))))) + ;; Newlines not desirable for inserting pairs. See bug#16138. + (let ((skeleton-end-newline nil)) + (skeleton-insert (cons nil skeleton) (if mark -1))))))) ;; A more serious example can be found in sh-script.el diff --git a/lisp/sort.el b/lisp/sort.el index 56e97061d13..ed345cb8de6 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -1,10 +1,10 @@ ;;; sort.el --- commands to sort text in an Emacs buffer -;; Copyright (C) 1986-1987, 1994-1995, 2001-2013 Free Software +;; Copyright (C) 1986-1987, 1994-1995, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Howie Kaye -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: unix ;; This file is part of GNU Emacs. @@ -568,31 +568,34 @@ From a program takes two point or marker arguments, BEG and END." (insert (car ll))))) ;;;###autoload -(defun delete-duplicate-lines (beg end &optional reverse adjacent interactive) - "Delete duplicate lines in the region between BEG and END. +(defun delete-duplicate-lines (beg end &optional reverse adjacent keep-blanks + interactive) + "Delete all but one copy of any identical lines in the region. +Non-interactively, arguments BEG and END delimit the region. +Normally it searches forwards, keeping the first instance of +each identical line. If REVERSE is non-nil (interactively, with +a C-u prefix), it searches backwards and keeps the last instance of +each repeated line. -If REVERSE is nil, search and delete duplicates forward keeping the first -occurrence of duplicate lines. If REVERSE is non-nil (when called -interactively with C-u prefix), search and delete duplicates backward -keeping the last occurrence of duplicate lines. +Identical lines need not be adjacent, unless the argument +ADJACENT is non-nil (interactively, with a C-u C-u prefix). +This is a more efficient mode of operation, and may be useful +on large regions that have already been sorted. -If ADJACENT is non-nil (when called interactively with two C-u prefixes), -delete repeated lines only if they are adjacent. It works like the utility -`uniq' and is useful when lines are already sorted in a large file since -this is more efficient in performance and memory usage than when ADJACENT -is nil that uses additional memory to remember previous lines. +If the argument KEEP-BLANKS is non-nil (interactively, with a +C-u C-u C-u prefix), it retains repeated blank lines. -When called from Lisp and INTERACTIVE is omitted or nil, return the number -of deleted duplicate lines, do not print it; if INTERACTIVE is t, the -function behaves in all respects as if it had been called interactively." +Returns the number of deleted lines. Interactively, or if INTERACTIVE +is non-nil, it also prints a message describing the number of deletions." (interactive (progn (barf-if-buffer-read-only) (list (region-beginning) (region-end) (equal current-prefix-arg '(4)) (equal current-prefix-arg '(16)) + (equal current-prefix-arg '(64)) t))) - (let ((lines (unless adjacent (make-hash-table :weakness 'key :test 'equal))) + (let ((lines (unless adjacent (make-hash-table :test 'equal))) line prev-line (count 0) (beg (copy-marker beg)) @@ -605,14 +608,16 @@ function behaves in all respects as if it had been called interactively." (and (< (point) end) (not (eobp)))) (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) - (if (if adjacent (equal line prev-line) (gethash line lines)) - (progn - (delete-region (progn (forward-line 0) (point)) - (progn (forward-line 1) (point))) - (if reverse (forward-line -1)) - (setq count (1+ count))) - (if adjacent (setq prev-line line) (puthash line t lines)) - (forward-line (if reverse -1 1))))) + (if (and keep-blanks (string= "" line)) + (forward-line 1) + (if (if adjacent (equal line prev-line) (gethash line lines)) + (progn + (delete-region (progn (forward-line 0) (point)) + (progn (forward-line 1) (point))) + (if reverse (forward-line -1)) + (setq count (1+ count))) + (if adjacent (setq prev-line line) (puthash line t lines)) + (forward-line (if reverse -1 1)))))) (set-marker beg nil) (set-marker end nil) (when interactive diff --git a/lisp/soundex.el b/lisp/soundex.el index 0dc26e28d2e..1404afed2e6 100644 --- a/lisp/soundex.el +++ b/lisp/soundex.el @@ -1,9 +1,9 @@ ;;; soundex.el --- implement Soundex algorithm -;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2014 Free Software Foundation, Inc. ;; Author: Christian Plaunt -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: matching ;; Created: Sat May 15 14:48:18 1993 diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 70bf5f41518..c425d777306 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1,6 +1,6 @@ ;;; speedbar --- quick access to files and tags in a frame -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: file, tags, tools @@ -73,7 +73,7 @@ this version is not backward compatible to 0.14 or earlier.") ;; `speedbar-insert-generic-list'. If you use ;; `speedbar-insert-generic-list', also read the doc for ;; `speedbar-tag-hierarchy-method' in case you wish to override it. -;; The macro `speedbar-with-attached-buffer' brings you back to the +;; The macro `dframe-with-attached-buffer' brings you back to the ;; buffer speedbar is displaying for. ;; ;; For those functions that make buttons, the "function" should be a @@ -135,17 +135,21 @@ this version is not backward compatible to 0.14 or earlier.") :group 'etags :group 'tools :group 'convenience + :link '(custom-manual "(speedbar) Top") + :link '(info-link "(speedbar) Customizing") ; :version "20.3" ) (defgroup speedbar-faces nil "Faces used in speedbar." :prefix "speedbar-" + :link '(info-link "(speedbar) Frames and Faces") :group 'speedbar :group 'faces) (defgroup speedbar-vc nil "Version control display in speedbar." + :link '(info-link "(speedbar) Version Control") :prefix "speedbar-" :group 'speedbar) @@ -250,7 +254,7 @@ frame." (defcustom speedbar-query-confirmation-method 'all "Query control for file operations. -The 'always flag means to always query before file operations. +The 'all flag means to always query before file operations. The 'none-but-delete flag means to not query before any file operations, except before a file deletion." :group 'speedbar @@ -1007,9 +1011,9 @@ supported at a time. ;; with the selected frame. (list 'parent (selected-frame))) speedbar-frame-parameters) - speedbar-before-delete-hook - speedbar-before-popup-hook - speedbar-after-create-hook) + 'speedbar-before-delete-hook + 'speedbar-before-popup-hook + 'speedbar-after-create-hook) ;; Start up the timer (if (not speedbar-frame) (speedbar-set-timer nil) @@ -1137,10 +1141,7 @@ in the selected file. dframe-mouse-position-function #'speedbar-position-cursor-on-line)) speedbar-buffer) -(defmacro speedbar-message (fmt &rest args) - "Like `message', but for use in the speedbar frame. -Argument FMT is the format string, and ARGS are the arguments for message." - `(dframe-message ,fmt ,@args)) +(define-obsolete-function-alias 'speedbar-message 'dframe-message "24.4") (defsubst speedbar-y-or-n-p (prompt &optional deleting) "Like `y-or-n-p', but for use in the speedbar frame. @@ -1157,8 +1158,10 @@ return true without a query." (dframe-select-attached-frame (speedbar-current-frame))) ;; Backwards compatibility -(defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer) -(defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame) +(define-obsolete-function-alias 'speedbar-with-attached-buffer + 'dframe-with-attached-buffer "24.4") ; macro +(define-obsolete-function-alias 'speedbar-maybee-jump-to-attached-frame + 'dframe-maybee-jump-to-attached-frame "24.4") (defun speedbar-set-mode-line-format () "Set the format of the mode line based on the current speedbar environment. @@ -1285,7 +1288,7 @@ and the existence of packages." (if (eq major-mode 'speedbar-mode) ;; XEmacs may let us get in here in other mode buffers. (speedbar-item-info))) - (error (speedbar-message nil))))))) + (error (dframe-message nil))))))) (defun speedbar-show-info-under-mouse () "Call the info function for the line under the mouse." @@ -1417,13 +1420,13 @@ Argument ARG represents to force a refresh past any caches that may exist." (delq (assoc d speedbar-directory-contents-alist) speedbar-directory-contents-alist))) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Refreshing speedbar...")) + (dframe-message "Refreshing speedbar...")) (speedbar-update-contents) (speedbar-stealthy-updates) ;; Reset the timer in case it got really hosed for some reason... (speedbar-set-timer dframe-update-speed) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Refreshing speedbar...done")))) + (dframe-message "Refreshing speedbar...done")))) (defun speedbar-item-load () "Load the item under the cursor or mouse if it is a Lisp file." @@ -1467,7 +1470,7 @@ File style information is displayed with `speedbar-item-info'." ;; Skip items in "folder" type text characters. (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0))) ;; Get the text - (speedbar-message "Text: %s" (buffer-substring-no-properties + (dframe-message "Text: %s" (buffer-substring-no-properties (point) (line-end-position))))) (defun speedbar-item-info () @@ -1485,7 +1488,7 @@ Return nil if not applicable. If FILENAME, then use that instead of reading it from the speedbar buffer." (let* ((item (or filename (speedbar-line-file))) (attr (if item (file-attributes item) nil))) - (if (and item attr) (speedbar-message "%s %-6d %s" (nth 8 attr) + (if (and item attr) (dframe-message "%s %-6d %s" (nth 8 attr) (nth 7 attr) item) nil))) @@ -1506,14 +1509,14 @@ Return nil if not applicable." (when (and (semantic-tag-overlay attr) (semantic-tag-buffer attr)) (set-buffer (semantic-tag-buffer attr))) - (speedbar-message + (dframe-message (funcall semantic-sb-info-format-tag-function attr) ))) (looking-at "\\([0-9]+\\):") (setq item (file-name-nondirectory (speedbar-line-directory))) - (speedbar-message "Tag: %s in %s" tag item))) + (dframe-message "Tag: %s in %s" tag item))) (if (re-search-forward "{[+-]} \\([^\n]+\\)$" (line-end-position) t) - (speedbar-message "Group of tags \"%s\"" (match-string 1)) + (dframe-message "Group of tags \"%s\"" (match-string 1)) (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t) (let* ((detailtext (match-string 1)) (detail (or (speedbar-line-token) detailtext)) @@ -1532,18 +1535,18 @@ Return nil if not applicable." (if (featurep 'semantic) (with-no-warnings (if (semantic-tag-p detail) - (speedbar-message + (dframe-message (funcall semantic-sb-info-format-tag-function detail parent)) (if parent - (speedbar-message "Detail: %s of tag %s" detail + (dframe-message "Detail: %s of tag %s" detail (if (semantic-tag-p parent) (semantic-format-tag-name parent nil t) parent)) - (speedbar-message "Detail: %s" detail)))) + (dframe-message "Detail: %s" detail)))) ;; Not using `semantic': (if parent - (speedbar-message "Detail: %s of tag %s" detail parent) - (speedbar-message "Detail: %s" detail)))) + (dframe-message "Detail: %s of tag %s" detail parent) + (dframe-message "Detail: %s" detail)))) nil))))) (defun speedbar-files-item-info () @@ -1641,7 +1644,7 @@ Files can be renamed to new names or moved to new directories." (if (file-directory-p f) (delete-directory f t t) (delete-file f t)) - (speedbar-message "Okie dokie.") + (dframe-message "Okie dokie.") (let ((p (point))) (speedbar-refresh) (goto-char p)) @@ -1706,9 +1709,9 @@ variable `speedbar-obj-alist'." (defmacro speedbar-with-writable (&rest forms) "Allow the buffer to be writable and evaluate FORMS." - (list 'let '((inhibit-read-only t)) - (cons 'progn forms))) -(put 'speedbar-with-writable 'lisp-indent-function 0) + (declare (indent 0)) + `(let ((inhibit-read-only t)) + ,@forms)) (defun speedbar-insert-button (text face mouse function &optional token prevline) @@ -2437,7 +2440,7 @@ name will have the function FIND-FUN and not token." (car (car lst)) ;button name nil nil 'speedbar-tag-face (1+ level))) - (t (speedbar-message "speedbar-insert-generic-list: malformed list!") + (t (dframe-message "speedbar-insert-generic-list: malformed list!") )) (setq lst (cdr lst))))) @@ -2492,14 +2495,14 @@ name will have the function FIND-FUN and not token." (expand-file-name default-directory)))) nil (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Updating speedbar to: %s..." + (dframe-message "Updating speedbar to: %s..." default-directory)) (speedbar-update-directory-contents) (if (<= 1 speedbar-verbosity-level) (progn - (speedbar-message "Updating speedbar to: %s...done" + (dframe-message "Updating speedbar to: %s...done" default-directory) - (speedbar-message nil)))) + (dframe-message nil)))) ;; Else, we can do a short cut. No text cache. (let ((cbd (expand-file-name default-directory))) (set-buffer speedbar-buffer) @@ -2649,7 +2652,7 @@ Also resets scanner functions." (dframe-select-attached-frame speedbar-frame) ;; make sure we at least choose a window to ;; get a good directory from - (if (window-minibuffer-p (selected-window)) + (if (window-minibuffer-p) nil ;; Check for special modes (speedbar-maybe-add-localized-support (current-buffer)) @@ -2662,16 +2665,16 @@ Also resets scanner functions." ;;(eq (get major-mode 'mode-class 'special))) (progn (if (<= 2 speedbar-verbosity-level) - (speedbar-message + (dframe-message "Updating speedbar to special mode: %s..." major-mode)) (speedbar-update-special-contents) (if (<= 2 speedbar-verbosity-level) (progn - (speedbar-message + (dframe-message "Updating speedbar to special mode: %s...done" major-mode) - (speedbar-message nil)))) + (dframe-message nil)))) ;; Update all the contents if directories change! (unless (and (or (member major-mode speedbar-ignored-modes) @@ -2704,7 +2707,7 @@ interrupted by the user." (while (and l (funcall (car l))) ;;(sit-for 0) (setq l (cdr l)))) - ;;(speedbar-message "Exit with %S" (car l)) + ;;(dframe-message "Exit with %S" (car l)) )))) (defun speedbar-reset-scanners () @@ -2944,7 +2947,7 @@ the file being checked." (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) - (speedbar-message "Speedbar vc check...%s" fulln)) + (dframe-message "Speedbar vc check...%s" fulln)) (and (file-writable-p fulln) (speedbar-this-file-in-vc f fn)))) @@ -2970,7 +2973,7 @@ that will occur on your system." (run-hook-with-args 'speedbar-vc-in-control-hook directory name) )) -;; Objet File scanning +;; Object File scanning (defun speedbar-check-objects () "Scan all files in a directory, and for each see if there is an object. See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how @@ -3016,7 +3019,7 @@ the file being checked." (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) - (speedbar-message "Speedbar obj check...%s" fulln)) + (dframe-message "Speedbar obj check...%s" fulln)) (let ((oa speedbar-obj-alist)) (while (and oa (not (string-match (car (car oa)) fulln))) (setq oa (cdr oa))) @@ -3076,7 +3079,7 @@ a function if appropriate." (buffer-substring-no-properties (match-beginning 0) (match-end 0)) "0"))))) - ;;(speedbar-message "%S:%S:%S:%s" fn tok txt dent) + ;;(dframe-message "%S:%S:%S:%s" fn tok txt dent) (and fn (funcall fn txt tok dent))) (speedbar-position-cursor-on-line)) @@ -3513,7 +3516,7 @@ interested in." (set-buffer speedbar-buffer) (if (<= (count-lines (point-min) (point-max)) - (1- (window-height (selected-window)))) + (1- (window-height))) ;; whole buffer fits (let ((cp (point))) @@ -3546,7 +3549,7 @@ interested in." (setq end (point-max))))) ;; Now work out the details of centering (let ((nl (count-lines start end)) - (wl (1- (window-height (selected-window)))) + (wl (1- (window-height))) (cp (point))) (if (> nl wl) ;; We can't fit it all, so just center on cursor @@ -3559,12 +3562,12 @@ interested in." nil ;; we need to do something... (goto-char start) - (let ((newcent (/ (- (window-height (selected-window)) nl) 2)) + (let ((newcent (/ (- (window-height) nl) 2)) (lte (count-lines start (point-max)))) - (if (and (< (+ newcent lte) (window-height (selected-window))) - (> (- (window-height (selected-window)) lte 1) + (if (and (< (+ newcent lte) (window-height)) + (> (- (window-height) lte 1) newcent)) - (setq newcent (- (window-height (selected-window)) + (setq newcent (- (window-height) lte 1))) (recenter newcent)))) (goto-char cp)))))) @@ -3697,14 +3700,14 @@ Each symbol will be associated with its line position in FILE." (if (get-buffer "*etags tmp*") (kill-buffer "*etags tmp*")) ;kill to clean it up (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Fetching etags...")) + (dframe-message "Fetching etags...")) (set-buffer (get-buffer-create "*etags tmp*")) (apply 'call-process speedbar-fetch-etags-command nil (current-buffer) nil (append speedbar-fetch-etags-arguments (list file))) (goto-char (point-min)) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Fetching etags...")) + (dframe-message "Fetching etags...")) (let ((expr (let ((exprlst speedbar-fetch-etags-parse-list) (ans nil)) @@ -3721,7 +3724,7 @@ Each symbol will be associated with its line position in FILE." (setq tnl (speedbar-extract-one-symbol expr))) (if tnl (setq newlist (cons tnl newlist))) (forward-line 1))) - (speedbar-message + (dframe-message "Sorry, no support for a file of that extension")))) ) (if speedbar-sort-tags @@ -3908,7 +3911,7 @@ Argument BUFFER is the buffer being tested." (let* ((item (speedbar-line-text)) (buffer (if item (get-buffer item) nil))) (and buffer - (speedbar-message "%s%s %S %d %s" + (dframe-message "%s%s %S %d %s" (if (buffer-modified-p buffer) "* " "") item (with-current-buffer buffer major-mode) @@ -3998,7 +4001,7 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." (defun speedbar-recenter () "Recenter the current buffer so point is in the center of the window." - (recenter (/ (window-height (selected-window)) 2))) + (recenter (/ (window-height) 2))) ;;; Color loading section. diff --git a/lisp/startup.el b/lisp/startup.el index ad31a7a2a45..b3f2316729b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,9 +1,9 @@ ;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation, +;; Copyright (C) 1985-1986, 1992, 1994-2014 Free Software Foundation, ;; Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -53,7 +53,8 @@ or directory when no target file is specified." (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") (file :tag "File" :value "~/.emacs") - (function :tag "Function") + (const :tag "Notes buffer" remember-notes) + (function :tag "Function") (const :tag "Lisp scratch buffer" t)) :version "24.4" :group 'initialization) @@ -397,8 +398,6 @@ from being initialized." (defvar no-blinking-cursor nil) -(defvar default-frame-background-mode) - (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") @@ -413,14 +412,20 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :type 'directory :initialize 'custom-initialize-delay) -(defconst package-subdirectory-regexp - "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" - "Regular expression matching the name of a package subdirectory. -The first subexpression is the package name. -The second subexpression is the version string. +(defvar package--builtin-versions + ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions. + (purecopy `((emacs . ,(version-to-list emacs-version)))) + "Alist giving the version of each versioned builtin package. +I.e. each element of the list is of the form (NAME . VERSION) where +NAME is the package name as a symbol, and VERSION is its version +as a list.") -The regexp should not contain a starting \"\\`\" or a trailing - \"\\'\"; those are added automatically by callers.") +(defun package--description-file (dir) + (concat (let ((subdir (file-name-nondirectory + (directory-file-name dir)))) + (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir) + (match-string 1 subdir) subdir)) + "-pkg.el")) (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of `default-directory' to `load-path'. @@ -437,8 +442,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let* ((this-dir (car dirs)) (contents (directory-files this-dir)) (default-directory this-dir) - (canonicalized (if (fboundp 'untranslated-canonical-name) - (untranslated-canonical-name this-dir)))) + (canonicalized (if (fboundp 'w32-untranslated-canonical-name) + (w32-untranslated-canonical-name this-dir)))) ;; The Windows version doesn't report meaningful inode numbers, so ;; use the canonicalized absolute file name of the directory instead. (setq attrs (or canonicalized @@ -485,8 +490,93 @@ It is the default value of the variable `top-level'." (if command-line-processed (message "Back to top level.") (setq command-line-processed t) + + ;; Look in each dir in load-path for a subdirs.el file. If we + ;; find one, load it, which will add the appropriate subdirs of + ;; that dir into load-path. This needs to be done before setting + ;; the locale environment, because the latter might need to load + ;; some support files. + ;; Look for a leim-list.el file too. Loading it will register + ;; available input methods. + (let ((tail load-path) + (lispdir (expand-file-name "../lisp" data-directory)) + dir) + (while tail + (setq dir (car tail)) + (let ((default-directory dir)) + (load (expand-file-name "subdirs.el") t t t)) + ;; Do not scan standard directories that won't contain a leim-list.el. + ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html + ;; (Except the preloaded one in lisp/leim.) + (or (string-prefix-p lispdir dir) + (let ((default-directory dir)) + (load (expand-file-name "leim-list.el") t t t))) + ;; We don't use a dolist loop and we put this "setq-cdr" command at + ;; the end, because the subdirs.el files may add elements to the end + ;; of load-path and we want to take it into account. + (setq tail (cdr tail)))) + + ;; Set the default strings to display in mode line for end-of-line + ;; formats that aren't native to this platform. This should be + ;; done before calling set-locale-environment, as the latter might + ;; use these mnemonics. + (cond + ((memq system-type '(ms-dos windows-nt)) + (setq eol-mnemonic-unix "(Unix)" + eol-mnemonic-mac "(Mac)")) + (t ; this is for Unix/GNU/Linux systems + (setq eol-mnemonic-dos "(DOS)" + eol-mnemonic-mac "(Mac)"))) + + (set-locale-environment nil) + ;; Decode all default-directory's (probably, only *scratch* exists + ;; at this point). default-directory of *scratch* is the basis + ;; for many other file-name variables and directory lists, so it + ;; is important to decode it ASAP. + (when locale-coding-system + (let ((coding (if (eq system-type 'windows-nt) + ;; MS-Windows build converts all file names to + ;; UTF-8 during startup. + 'utf-8 + locale-coding-system))) + (save-excursion + (dolist (elt (buffer-list)) + (set-buffer elt) + (if default-directory + (setq default-directory + (decode-coding-string default-directory coding t))))) + + ;; Decode all the important variables and directory lists, now + ;; that we know the locale's encoding. This is because the + ;; values of these variables are until here unibyte undecoded + ;; strings created by build_unibyte_string. data-directory in + ;; particular is used to construct many other standard + ;; directory names, so it must be decoded ASAP. Note that + ;; charset-map-path cannot be decoded here, since we could + ;; then be trapped in infinite recursion below, when we load + ;; subdirs.el, because encoding a directory name might need to + ;; load a charset map, which will want to encode + ;; charset-map-path, which will want to load the same charset + ;; map... So decoding of charset-map-path is delayed until + ;; further down below. + (dolist (pathsym '(load-path exec-path)) + (let ((path (symbol-value pathsym))) + (if (listp path) + (set pathsym (mapcar (lambda (dir) + (decode-coding-string dir coding t)) + path))))) + (dolist (filesym '(data-directory doc-directory exec-directory + installation-directory + invocation-directory invocation-name + source-directory + shared-game-score-directory)) + (let ((file (symbol-value filesym))) + (if (stringp file) + (set filesym (decode-coding-string file coding t))))))) + (let ((dir default-directory)) (with-current-buffer "*Messages*" + (messages-buffer-mode) ;; Make it easy to do like "tail -f". (set (make-local-variable 'window-point-insertion-type) t) ;; Give *Messages* the same default-directory as *scratch*, @@ -495,29 +585,6 @@ It is the default value of the variable `top-level'." ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value (list (default-value 'user-full-name))) - ;; Look in each dir in load-path for a subdirs.el file. - ;; If we find one, load it, which will add the appropriate subdirs - ;; of that dir into load-path, - ;; Look for a leim-list.el file too. Loading it will register - ;; available input methods. - (let ((tail load-path) - (lispdir (expand-file-name "../lisp" data-directory)) - ;; For out-of-tree builds, leim-list is generated in the build dir. -;;; (leimdir (expand-file-name "../leim" doc-directory)) - dir) - (while tail - (setq dir (car tail)) - (let ((default-directory dir)) - (load (expand-file-name "subdirs.el") t t t)) - ;; Do not scan standard directories that won't contain a leim-list.el. - ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html - (or (string-match (concat "\\`" lispdir) dir) - (let ((default-directory dir)) - (load (expand-file-name "leim-list.el") t t t))) - ;; We don't use a dolist loop and we put this "setq-cdr" command at - ;; the end, because the subdirs.el files may add elements to the end - ;; of load-path and we want to take it into account. - (setq tail (cdr tail)))) ;; If the PWD environment variable isn't accurate, delete it. (let ((pwd (getenv "PWD"))) (and (stringp pwd) @@ -531,6 +598,17 @@ It is the default value of the variable `top-level'." (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) + ;; Now, that other directories were searched, and any charsets we + ;; need for encoding them are already loaded, we are ready to + ;; decode charset-map-path. + (if (listp charset-map-path) + (let ((coding (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))) + (setq charset-map-path + (mapcar (lambda (dir) + (decode-coding-string dir coding t)) + charset-map-path)))) (setq default-directory (abbreviate-file-name default-directory)) (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect @@ -715,7 +793,7 @@ opening the first frame (e.g. open a connection to an X server).") default-frame-alist)) (t (push argi rest))))) - (nreverse rest))) + (nconc (nreverse rest) args))) (declare-function x-get-resource "frame.c" (attribute class &optional component subclass)) @@ -751,18 +829,6 @@ Amongst another things, it parses the command-line arguments." ;;! ;; Choose a good default value for split-window-keep-point. ;;! (setq split-window-keep-point (> baud-rate 2400)) - ;; Set the default strings to display in mode line for - ;; end-of-line formats that aren't native to this platform. - (cond - ((memq system-type '(ms-dos windows-nt)) - (setq eol-mnemonic-unix "(Unix)" - eol-mnemonic-mac "(Mac)")) - (t ; this is for Unix/GNU/Linux systems - (setq eol-mnemonic-dos "(DOS)" - eol-mnemonic-mac "(Mac)"))) - - (set-locale-environment nil) - ;; Convert preloaded file names in load-history to absolute. (let ((simple-file-name ;; Look for simple.el or simple.elc and use their directory @@ -796,7 +862,7 @@ please check its value") load-history)))) ;; Convert the arguments to Emacs internal representation. - (let ((args (cdr command-line-args))) + (let ((args command-line-args)) (while args (setcar args (decode-coding-string (car args) locale-coding-system t)) @@ -1194,29 +1260,18 @@ the `--debug-init' option to view a complete error backtrace." (dolist (dir dirs) (when (file-directory-p dir) (dolist (subdir (directory-files dir)) - (when (and (file-directory-p (expand-file-name subdir dir)) - (string-match - (concat "\\`" package-subdirectory-regexp "\\'") - subdir)) + (when (let ((subdir (expand-file-name subdir dir))) + (and (file-directory-p subdir) + (file-exists-p + (expand-file-name + (package--description-file subdir) + subdir)))) (throw 'package-dir-found t))))))) (package-initialize)) (setq after-init-time (current-time)) (run-hooks 'after-init-hook) - ;; Decode all default-directory. - (if (and (default-value 'enable-multibyte-characters) locale-coding-system) - (save-excursion - (dolist (elt (buffer-list)) - (set-buffer elt) - (if default-directory - (setq default-directory - (decode-coding-string default-directory - locale-coding-system t)))) - (setq command-line-default-directory - (decode-coding-string command-line-default-directory - locale-coding-system t)))) - ;; If *scratch* exists and init file didn't change its mode, initialize it. (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" @@ -1238,6 +1293,29 @@ the `--debug-init' option to view a complete error backtrace." ;; Process the remaining args. (command-line-1 (cdr command-line-args)) + ;; This is a problem because, e.g. if emacs.d/gnus.el exists, + ;; trying to load gnus could load the wrong file. + ;; OK, it would not matter if .emacs.d were at the end of load-path. + ;; but for the sake of simplicity, we discourage it full-stop. + ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html + ;; + ;; A bad element could come from user-emacs-file, the command line, + ;; or EMACSLOADPATH, so we basically always have to check. + (let (warned) + (dolist (dir load-path) + (and (not warned) + (string-match-p "/[._]emacs\\.d/?\\'" dir) + (string-equal (file-name-as-directory (expand-file-name dir)) + (expand-file-name user-emacs-directory)) + (setq warned t) + (display-warning 'initialization + (format "Your `load-path' seems to contain +your `.emacs.d' directory: %s\n\ +This is likely to cause problems...\n\ +Consider using a subdirectory instead, e.g.: %s" dir +(expand-file-name "lisp" user-emacs-directory)) + :warning)))) + ;; If -batch, terminate after processing the command options. (if noninteractive (kill-emacs t)) @@ -1512,27 +1590,29 @@ a face or button specification." (declare-function image-size "image.c" (spec &optional pixels frame)) +(defun fancy-splash-image-file () + (cond ((stringp fancy-splash-image) fancy-splash-image) + ((display-color-p) + (cond ((<= (display-planes) 8) + (if (image-type-available-p 'xpm) + "splash.xpm" + "splash.pbm")) + ((or (image-type-available-p 'svg) + (image-type-available-p 'imagemagick)) + "splash.svg") + ((image-type-available-p 'png) + "splash.png") + ((image-type-available-p 'xpm) + "splash.xpm") + (t "splash.pbm"))) + (t "splash.pbm"))) + (defun fancy-splash-head () "Insert the head part of the splash screen into the current buffer." - (let* ((image-file (cond ((stringp fancy-splash-image) - fancy-splash-image) - ((display-color-p) - (cond ((<= (display-planes) 8) - (if (image-type-available-p 'xpm) - "splash.xpm" - "splash.pbm")) - ((or (image-type-available-p 'svg) - (image-type-available-p 'imagemagick)) - "splash.svg") - ((image-type-available-p 'png) - "splash.png") - ((image-type-available-p 'xpm) - "splash.xpm") - (t "splash.pbm"))) - (t "splash.pbm"))) + (let* ((image-file (fancy-splash-image-file)) (img (create-image image-file)) (image-width (and img (car (image-size img)))) - (window-width (window-width (selected-window)))) + (window-width (window-width))) (when img (when (> window-width image-width) ;; Center the image in the window. @@ -1665,6 +1745,7 @@ splash screen in another window." (insert "\n") (fancy-startup-tail concise)) (use-local-map splash-screen-keymap) + (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22 buffer-read-only t) (set-buffer-modified-p nil) @@ -1702,6 +1783,7 @@ splash screen in another window." (goto-char (point-min)) (force-mode-line-update)) (use-local-map splash-screen-keymap) + (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22) (setq buffer-read-only t) (goto-char (point-min)) @@ -1713,6 +1795,10 @@ Returning non-nil does not mean we should necessarily use the fancy splash screen, but if we do use it, we put it on this frame." (let (chosen-frame) + ;; MS-Windows needs this to have a chance to make the initial + ;; frame visible. + (if (eq system-type 'windows-nt) + (sit-for 0 t)) (dolist (frame (append (frame-list) (list (selected-frame)))) (if (and (frame-visible-p frame) (not (window-minibuffer-p (frame-selected-window frame)))) @@ -1723,14 +1809,11 @@ we put it on this frame." "Return t if fancy splash screens should be used." (when (and (display-graphic-p) (or (and (display-color-p) - (image-type-available-p 'xpm)) + (image-type-available-p 'xpm)) (image-type-available-p 'pbm))) (let ((frame (fancy-splash-frame))) (when frame - (let* ((img (create-image (or fancy-splash-image - (if (and (display-color-p) - (image-type-available-p 'xpm)) - "splash.xpm" "splash.pbm")))) + (let* ((img (create-image (fancy-splash-image-file))) (image-height (and img (cdr (image-size img nil frame)))) ;; We test frame-height so that, if the frame is split ;; by displaying a warning, that doesn't cause the normal @@ -1856,11 +1939,8 @@ To quit a partially entered command, type Control-g.\n") (insert "\n" (emacs-version) "\n" emacs-copyright)) -;; No mouse menus, so give help using kbd commands. (defun normal-no-mouse-startup-screen () - - ;; If keys have their default meanings, - ;; use precomputed string to save lots of time. + "Show a splash screen suitable for displays without mouse support." (let* ((c-h-accessible ;; If normal-erase-is-backspace is used on a tty, there's ;; no way to invoke C-h and you have to use F1 instead. @@ -1938,47 +2018,24 @@ If you have no Meta key, you may instead type ESC followed by the character.)") 'follow-link t) (insert "\n") (insert "\n" (emacs-version) "\n" emacs-copyright "\n") - - (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) - (eq (key-binding "\C-h\C-d") 'describe-distribution) - (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) - (progn - (insert - " -GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") - (insert-button "full details" - 'action (lambda (_button) (describe-no-warranty)) - 'follow-link t) - (insert ". -Emacs is Free Software--Free as in Freedom--so you can redistribute copies -of Emacs and modify it; type C-h C-c to see ") - (insert-button "the conditions" - 'action (lambda (_button) (describe-copying)) - 'follow-link t) - (insert ". -Type C-h C-d for information on ") - (insert-button "getting the latest version" - 'action (lambda (_button) (describe-distribution)) - 'follow-link t) - (insert ".")) - (insert (substitute-command-keys - " + (insert (substitute-command-keys + " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) - (insert-button "full details" - 'action (lambda (_button) (describe-no-warranty)) - 'follow-link t) - (insert (substitute-command-keys ". + (insert-button "full details" + 'action (lambda (_button) (describe-no-warranty)) + 'follow-link t) + (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type \\[describe-copying] to see ")) - (insert-button "the conditions" - 'action (lambda (_button) (describe-copying)) - 'follow-link t) - (insert (substitute-command-keys". + (insert-button "the conditions" + 'action (lambda (_button) (describe-copying)) + 'follow-link t) + (insert (substitute-command-keys". Type \\[describe-distribution] for information on ")) - (insert-button "getting the latest version" - 'action (lambda (_button) (describe-distribution)) - 'follow-link t) - (insert "."))) + (insert-button "getting the latest version" + 'action (lambda (_button) (describe-distribution)) + 'follow-link t) + (insert ".")) (defun normal-about-screen () (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n") @@ -2027,14 +2084,11 @@ Type \\[describe-distribution] for information on ")) (insert "\tBuying printed manuals from the FSF\n")) (defun startup-echo-area-message () - (cond ((daemonp) - "Starting Emacs daemon.") - ((eq (key-binding "\C-h\C-a") 'about-emacs) - "For information about GNU Emacs and the GNU system, type C-h C-a.") - (t - (substitute-command-keys - "For information about GNU Emacs and the GNU system, type \ -\\[about-emacs].")))) + (if (daemonp) + "Starting Emacs daemon." + (substitute-command-keys + "For information about GNU Emacs and the GNU system, type \ +\\[about-emacs]."))) (defun display-startup-echo-area-message () (let ((resize-mini-windows t)) @@ -2109,12 +2163,11 @@ A fancy display is used on graphic displays, normal otherwise." ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; - ;; ;; The directories listed in --directory/-L options will *appear* - ;; ;; at the front of `load-path' in the order they appear on the - ;; ;; command-line. We cannot do this by *placing* them at the front - ;; ;; in the order they appear, so we need this variable to hold them, - ;; ;; temporarily. - ;; extra-load-path + ;; The directories listed in --directory/-L options will *appear* + ;; at the front of `load-path' in the order they appear on the + ;; command-line. We cannot do this by *placing* them at the front + ;; in the order they appear, so we need this variable to hold them, + ;; temporarily. ;; ;; To DTRT we keep track of the splice point and modify `load-path' ;; straight away upon any --directory/-L option. @@ -2194,13 +2247,22 @@ A fancy display is used on graphic displays, normal otherwise." (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq tem (expand-file-name - (command-line-normalize-file-name - (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons tem (cdr splice))) - (setq splice (cdr splice))) - (t (setq load-path (cons tem load-path) - splice load-path)))) + ;; -L :/foo adds /foo to the _end_ of load-path. + (let (append) + (if (string-match-p + (format "\\`%s" path-separator) + (setq tem (or argval (pop command-line-args-left)))) + (setq tem (substring tem 1) + append t)) + (setq tem (expand-file-name + (command-line-normalize-file-name tem))) + (cond (append (setq load-path + (append load-path (list tem))) + (if splice (setq splice load-path))) + (splice (setcdr splice (cons tem (cdr splice))) + (setq splice (cdr splice))) + (t (setq load-path (cons tem load-path) + splice load-path))))) ((member argi '("-l" "-load")) (let* ((file (command-line-normalize-file-name @@ -2399,13 +2461,17 @@ A fancy display is used on graphic displays, normal otherwise." ;; Use arg 1 so that we don't collapse // at the start of the file name. ;; That is significant on some systems. ;; However, /// at the beginning is supposed to mean just /, not //. - (if (string-match "^///+" file) + (if (string-match + (if (memq system-type '(ms-dos windows-nt)) + "^\\([\\/][\\/][\\/]\\)+" + "^///+") + file) (setq file (replace-match "/" t t file))) - (and (memq system-type '(ms-dos windows-nt)) - (string-match "^[A-Za-z]:\\(\\\\[\\\\/]\\)" file) ; C:\/ or C:\\ - (setq file (replace-match "/" t t file 1))) - (while (string-match "//+" file 1) - (setq file (replace-match "/" t t file))) + (if (memq system-type '(ms-dos windows-nt)) + (while (string-match "\\([\\/][\\/]\\)+" file 1) + (setq file (replace-match "/" t t file))) + (while (string-match "//+" file 1) + (setq file (replace-match "/" t t file)))) file)) ;;; startup.el ends here diff --git a/lisp/strokes.el b/lisp/strokes.el index 5acd0dc0120..fdaf31a9312 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1,9 +1,9 @@ ;;; strokes.el --- control Emacs through mouse strokes -;; Copyright (C) 1997, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000-2014 Free Software Foundation, Inc. ;; Author: David Bakhash -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: lisp, mouse, extensions ;; This file is part of GNU Emacs. @@ -118,8 +118,7 @@ ;; > M-x strokes-prompt-user-save-strokes -;; and it will save your strokes in ~/.strokes, or you may wish to change -;; this by setting the variable `strokes-file'. +;; and it will save your strokes in your `strokes-file'. ;; Note that internally, all of the routines that are part of this ;; package are able to deal with complex strokes, as they are a superset @@ -260,8 +259,9 @@ WARNING: Changing the value of this variable will gravely affect the :type 'integer :group 'strokes) -(defcustom strokes-file (convert-standard-filename "~/.strokes") - "File containing saved strokes for Strokes mode (default is ~/.strokes)." +(defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes") + "File containing saved strokes for Strokes mode." + :version "24.4" ; added locate-user-emacs-file :type 'file :group 'strokes) @@ -991,11 +991,10 @@ down, then use a prefix argument: > C-u M-x strokes-list-strokes -Your strokes are stored as you enter them. They get saved in a file -called ~/.strokes, along with other strokes configuration variables. -You can change this location by setting the variable `strokes-file'. -You will be prompted to save them when you exit Emacs, or you can save -them with +Your strokes are stored as you enter them. They get saved into the +file specified by the `strokes-file' variable, along with other strokes +configuration variables. You will be prompted to save them when +you exit Emacs, or you can save them with > M-x strokes-prompt-user-save-strokes diff --git a/lisp/subr.el b/lisp/subr.el index db2b6a8eaad..ad783acc929 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,9 +1,9 @@ -;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8 -*- +;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software +;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -29,23 +29,13 @@ ;; Beware: while this file has tag `utf-8', before it's compiled, it gets ;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap. -(defvar custom-declare-variable-list nil - "Record `defcustom' calls made before `custom.el' is loaded to handle them. -Each element of this list holds the arguments to one call to `defcustom'.") - -;; Use this, rather than defcustom, in subr.el and other files loaded -;; before custom.el. -(defun custom-declare-variable-early (&rest arguments) - (setq custom-declare-variable-list - (cons arguments custom-declare-variable-list))) - -(defmacro declare-function (fn file &optional arglist fileonly) +(defmacro declare-function (_fn _file &optional _arglist _fileonly) "Tell the byte-compiler that function FN is defined, in FILE. -Optional ARGLIST is the argument list used by the function. The -FILE argument is not used by the byte-compiler, but by the +Optional ARGLIST is the argument list used by the function. +The FILE argument is not used by the byte-compiler, but by the `check-declare' package, which checks that FILE contains a -definition for FN. ARGLIST is used by both the byte-compiler and -`check-declare' to check for consistency. +definition for FN. ARGLIST is used by both the byte-compiler +and `check-declare' to check for consistency. FILE can be either a Lisp file (in which case the \".el\" extension is optional), or a C file. C files are expanded @@ -170,12 +160,16 @@ PLACE must be a generalized variable whose value is a list. If the value is nil, `pop' returns nil but does not actually change the list." (declare (debug (gv-place))) - (list 'car - (if (symbolp place) - ;; So we can use `pop' in the bootstrap before `gv' can be used. - (list 'prog1 place (list 'setq place (list 'cdr place))) - (gv-letplace (getter setter) place - `(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) + ;; We use `car-safe' here instead of `car' because the behavior is the same + ;; (if it's not a cons cell, the `cdr' would have signaled an error already), + ;; but `car-safe' is total, so the byte-compiler can safely remove it if the + ;; result is not used. + `(car-safe + ,(if (symbolp place) + ;; So we can use `pop' in the bootstrap before `gv' can be used. + (list 'prog1 place (list 'setq place (list 'cdr place))) + (gv-letplace (getter setter) place + `(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. @@ -297,9 +291,8 @@ This function accepts any number of arguments, but ignores them." In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention for the sake of consistency." - (while t - (signal 'error (list (apply 'format args))))) -(set-advertised-calling-convention 'error '(string &rest args) "23.1") + (declare (advertised-calling-convention (string &rest args) "23.1")) + (signal 'error (list (apply 'format args)))) (defun user-error (format &rest args) "Signal a pilot error, making error message by passing all args to `format'. @@ -309,8 +302,27 @@ for the sake of consistency. This is just like `error' except that `user-error's are expected to be the result of an incorrect manipulation on the part of the user, rather than the result of an actual problem." - (while t - (signal 'user-error (list (apply #'format format args))))) + (signal 'user-error (list (apply #'format format args)))) + +(defun define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'nconc + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message)))) ;; We put this here instead of in frame.el so that it's defined even on ;; systems where frame.el isn't loaded. @@ -352,12 +364,15 @@ If N is bigger than the length of LIST, return LIST." (nthcdr (1- (safe-length list)) list)))) (defun butlast (list &optional n) - "Return a copy of LIST with the last N elements removed." + "Return a copy of LIST with the last N elements removed. +If N is omitted or nil, the last element is removed from the +copy." (if (and n (<= n 0)) list (nbutlast (copy-sequence list) n))) (defun nbutlast (list &optional n) - "Modifies LIST to remove the last N elements." + "Modifies LIST to remove the last N elements. +If N is omitted or nil, remove the last element." (let ((m (length list))) (or n (setq n 1)) (and (< n m) @@ -376,12 +391,29 @@ one is kept." (setq tail (cdr tail)))) list) +;; See http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00204.html +(defun delete-consecutive-dups (list &optional circular) + "Destructively remove `equal' consecutive duplicates from LIST. +First and last elements are considered consecutive if CIRCULAR is +non-nil." + (let ((tail list) last) + (while (consp tail) + (if (equal (car tail) (cadr tail)) + (setcdr tail (cddr tail)) + (setq last (car tail) + tail (cdr tail)))) + (if (and circular + (cdr list) + (equal last (car list))) + (nbutlast list) + list))) + (defun number-sequence (from &optional to inc) "Return a sequence of numbers from FROM to TO (both inclusive) as a list. INC is the increment used between numbers in the sequence and defaults to 1. -So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from +So, the Nth element of the list is (+ FROM (* N INC)) where N counts from zero. TO is only included if there is an N for which TO = FROM + N * INC. -If TO is nil or numerically equal to FROM, return \(FROM). +If TO is nil or numerically equal to FROM, return (FROM). If INC is positive and TO is less than FROM, or INC is negative and TO is larger than FROM, return nil. If INC is zero and TO is neither nil nor numerically equal to @@ -391,11 +423,11 @@ This function is primarily designed for integer arguments. Nevertheless, FROM, TO and INC can be integer or float. However, floating point arithmetic is inexact. For instance, depending on the machine, it may quite well happen that -\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4), -whereas \(number-sequence 0.4 0.8 0.2) returns a list with three +\(number-sequence 0.4 0.6 0.2) returns the one element list (0.4), +whereas (number-sequence 0.4 0.8 0.2) returns a list with three elements. Thus, if some of the arguments are floats and one wants to make sure that TO is included, one may have to explicitly write -TO as \(+ FROM \(* N INC)) or use a variable whose value was +TO as (+ FROM (* N INC)) or use a variable whose value was computed with this exact expression. Alternatively, you can, of course, also replace TO with a slightly larger value \(or a slightly more negative value if INC is negative)." @@ -545,7 +577,15 @@ saving keyboard macros (see `edmacro-mode')." (defun undefined () "Beep to tell the user this binding is undefined." (interactive) - (ding)) + (ding) + (message "%s is undefined" (key-description (this-single-command-keys))) + (setq defining-kbd-macro nil) + (force-mode-line-update) + ;; If this is a down-mouse event, don't reset prefix-arg; + ;; pass it to the command run by the up event. + (setq prefix-arg + (when (memq 'down (event-modifiers last-command-event)) + current-prefix-arg))) ;; Prevent the \{...} documentation construct ;; from mentioning keys that run this command. @@ -767,8 +807,8 @@ KEY is a key sequence; noninteractively, it is a string or vector of characters or event types, and non-ASCII characters with codes above 127 (such as ISO Latin-1) can be included if you use a vector. -The binding goes in the current buffer's local map, -which in most cases is shared with all other buffers in the same major mode." +The binding goes in the current buffer's local map, which in most +cases is shared with all other buffers in the same major mode." (interactive "KSet key locally: \nCSet key %s locally to command: ") (let ((map (current-local-map))) (or map @@ -804,7 +844,7 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. If you don't specify OLDMAP, you can usually get the same results in a cleaner way with command remapping, like this: - \(define-key KEYMAP [remap OLDDEF] NEWDEF) + (define-key KEYMAP [remap OLDDEF] NEWDEF) \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" ;; Don't document PREFIX in the doc string because we don't want to ;; advertise it. It's meant for recursive calls only. Here's its @@ -979,38 +1019,37 @@ in the current Emacs session, then this function may return nil." (defun event-start (event) "Return the starting position of EVENT. -EVENT should be a click, drag, or key press event. -If it is a key press event, the return value has the form - (WINDOW POS (0 . 0) 0) -If it is a click or drag event, it has the form - (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) - IMAGE (DX . DY) (WIDTH . HEIGHT)) -The `posn-' functions access elements of such lists. -For more information, see Info node `(elisp)Click Events'. +EVENT should be a mouse click, drag, or key press event. If +EVENT is nil, the value of `posn-at-point' is used instead. -If EVENT is a mouse or key press or a mouse click, this is the -position of the event. If EVENT is a drag, this is the starting -position of the drag." +The following accessor functions are used to access the elements +of the position: + +`posn-window': The window the event is in. +`posn-area': A symbol identifying the area the event occurred in, +or nil if the event occurred in the text area. +`posn-point': The buffer position of the event. +`posn-x-y': The pixel-based coordinates of the event. +`posn-col-row': The estimated column and row corresponding to the +position of the event. +`posn-actual-col-row': The actual column and row corresponding to the +position of the event. +`posn-string': The string object of the event, which is either +nil or (STRING . POSITION)'. +`posn-image': The image object of the event, if any. +`posn-object': The image or string object of the event, if any. +`posn-timestamp': The time the event occurred, in milliseconds. + +For more information, see Info node `(elisp)Click Events'." (if (consp event) (nth 1 event) (or (posn-at-point) (list (selected-window) (point) '(0 . 0) 0)))) (defun event-end (event) - "Return the ending location of EVENT. + "Return the ending position of EVENT. EVENT should be a click, drag, or key press event. -If EVENT is a key press event, the return value has the form - (WINDOW POS (0 . 0) 0) -If EVENT is a click event, this function is the same as -`event-start'. For click and drag events, the return value has -the form - (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) - IMAGE (DX . DY) (WIDTH . HEIGHT)) -The `posn-' functions access elements of such lists. -For more information, see Info node `(elisp)Click Events'. -If EVENT is a mouse or key press or a mouse click, this is the -position of the event. If EVENT is a drag, this is the starting -position of the drag." +See `event-start' for a description of the value returned." (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) (or (posn-at-point) (list (selected-window) (point) '(0 . 0) 0)))) @@ -1044,14 +1083,17 @@ and `event-end' functions." (nth 1 position)))) (and (symbolp area) area))) -(defsubst posn-point (position) +(defun posn-point (position) "Return the buffer location in POSITION. POSITION should be a list of the form returned by the `event-start' -and `event-end' functions." +and `event-end' functions. +Returns nil if POSITION does not correspond to any buffer location (e.g. +a click on a scroll bar)." (or (nth 5 position) - (if (consp (nth 1 position)) - (car (nth 1 position)) - (nth 1 position)))) + (let ((pt (nth 1 position))) + (or (car-safe pt) + ;; Apparently this can also be `vertical-scroll-bar' (bug#13979). + (if (integerp pt) pt))))) (defun posn-set-point (position) "Move point to POSITION. @@ -1124,12 +1166,14 @@ POSITION should be a list of the form returned by the `event-start' and `event-end' functions." (nth 3 position)) -(defsubst posn-string (position) +(defun posn-string (position) "Return the string object of POSITION. Value is a cons (STRING . STRING-POS), or nil if not a string. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." - (nth 4 position)) + (let ((x (nth 4 position))) + ;; Apparently this can also be `handle' or `below-handle' (bug#13979). + (when (consp x) x))) (defsubst posn-image (position) "Return the image object of POSITION. @@ -1184,6 +1228,11 @@ is converted into a string by expressing it in decimal." (declare (obsolete make-hash-table "22.1")) (make-hash-table :test (or test 'eql))) +(defun log10 (x) + "Return (log X 10), the log base 10 of X." + (declare (obsolete log "24.4")) + (log x 10)) + ;; These are used by VM and some old programs (defalias 'focus-frame 'ignore "") (make-obsolete 'focus-frame "it does nothing." "22.1") @@ -1195,6 +1244,8 @@ is converted into a string by expressing it in decimal." 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") +(set-advertised-calling-convention 'decode-char '(ch charset) "21.4") +(set-advertised-calling-convention 'encode-char '(ch charset) "21.4") ;;;; Obsolescence declarations for variables, and aliases. @@ -1315,7 +1366,7 @@ function, it is changed to a list of functions." (setq local t))) (let ((hook-value (if local (symbol-value hook) (default-value hook)))) ;; If the hook value is a single function, turn it into a list. - (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda)) + (when (or (not (listp hook-value)) (functionp hook-value)) (setq hook-value (list hook-value))) ;; Do the actual addition if necessary (unless (member function hook-value) @@ -1409,7 +1460,9 @@ Of course, a subsequent hook function may do the same thing. Each hook function definition is used to construct the FUN passed to the next hook function, if any. The last (or \"outermost\") FUN is then called once." - (declare (indent 2) (debug (form sexp body))) + (declare (indent 2) (debug (form sexp body)) + (obsolete "use a -function variable modified by add-function." + "24.4")) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -1446,19 +1499,63 @@ FUN is then called once." (defun add-to-list (list-var element &optional append compare-fn) "Add ELEMENT to the value of LIST-VAR if it isn't there yet. -The test for presence of ELEMENT is done with `equal', -or with COMPARE-FN if that's non-nil. +The test for presence of ELEMENT is done with `equal', or with +COMPARE-FN if that's non-nil. If ELEMENT is added, it is added at the beginning of the list, unless the optional argument APPEND is non-nil, in which case ELEMENT is added at the end. The return value is the new value of LIST-VAR. -If you want to use `add-to-list' on a variable that is not defined -until a certain package is loaded, you should put the call to `add-to-list' -into a hook function that will be run only after loading the package. -`eval-after-load' provides one way to do this. In some cases -other hooks, such as major mode hooks, can do the job." +This is handy to add some elements to configuration variables, +but please do not abuse it in Elisp code, where you are usually +better off using `push' or `cl-pushnew'. + +If you want to use `add-to-list' on a variable that is not +defined until a certain package is loaded, you should put the +call to `add-to-list' into a hook function that will be run only +after loading the package. `eval-after-load' provides one way to +do this. In some cases other hooks, such as major mode hooks, +can do the job." + (declare + (compiler-macro + (lambda (exp) + ;; FIXME: Something like this could be used for `set' as well. + (if (or (not (eq 'quote (car-safe list-var))) + (special-variable-p (cadr list-var)) + (not (macroexp-const-p append))) + exp + (let* ((sym (cadr list-var)) + (append (eval append)) + (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" + sym)) + ;; Big ugly hack so we only output a warning during + ;; byte-compilation, and so we can use + ;; byte-compile-not-lexical-var-p to silence the warning + ;; when a defvar has been seen but not yet executed. + (warnfun (lambda () + ;; FIXME: We should also emit a warning for let-bound + ;; variables with dynamic binding. + (when (assq sym byte-compile--lexical-environment) + (byte-compile-log-warning msg t :error)))) + (code + (macroexp-let2 macroexp-copyable-p x element + `(if ,(if compare-fn + (progn + (require 'cl-lib) + `(cl-member ,x ,sym :test ,compare-fn)) + ;; For bootstrapping reasons, don't rely on + ;; cl--compiler-macro-member for the base case. + `(member ,x ,sym)) + ,sym + ,(if append + `(setq ,sym (append ,sym (list ,x))) + `(push ,x ,sym)))))) + (if (not (macroexp--compiling-p)) + code + `(progn + (macroexp--funcall-if-compiled ',warnfun) + ,code))))))) (if (cond ((null compare-fn) (member element (symbol-value list-var))) @@ -1686,7 +1783,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." (nconc found (list (cons toggle keymap)) rest)) (push (cons toggle keymap) minor-mode-map-alist))))))) -;;; Load history +;;;; Load history (defsubst autoloadp (object) "Non-nil if OBJECT is an autoload." @@ -1716,7 +1813,7 @@ If TYPE is nil, then any kind of definition is acceptable. If TYPE is `defun', `defvar', or `defface', that specifies function definition, variable definition, or face definition only." (if (and (or (null type) (eq type 'defun)) - (symbolp symbol) (fboundp symbol) + (symbolp symbol) (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) (let ((files load-history) @@ -1768,173 +1865,6 @@ and the file name is displayed in the echo area." (message "No library %s in search path" library))) file)) - -;;;; Specifying things to do later. - -(defun load-history-regexp (file) - "Form a regexp to find FILE in `load-history'. -FILE, a string, is described in the function `eval-after-load'." - (if (file-name-absolute-p file) - (setq file (file-truename file))) - (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") - (regexp-quote file) - (if (file-name-extension file) - "" - ;; Note: regexp-opt can't be used here, since we need to call - ;; this before Emacs has been fully started. 2006-05-21 - (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) - "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") - "\\)?\\'")) - -(defun load-history-filename-element (file-regexp) - "Get the first elt of `load-history' whose car matches FILE-REGEXP. -Return nil if there isn't one." - (let* ((loads load-history) - (load-elt (and loads (car loads)))) - (save-match-data - (while (and loads - (or (null (car load-elt)) - (not (string-match file-regexp (car load-elt))))) - (setq loads (cdr loads) - load-elt (and loads (car loads))))) - load-elt)) - -(put 'eval-after-load 'lisp-indent-function 1) -(defun eval-after-load (file form) - "Arrange that if FILE is loaded, FORM will be run immediately afterwards. -If FILE is already loaded, evaluate FORM right now. - -If a matching file is loaded again, FORM will be evaluated again. - -If FILE is a string, it may be either an absolute or a relative file -name, and may have an extension \(e.g. \".el\") or may lack one, and -additionally may or may not have an extension denoting a compressed -format \(e.g. \".gz\"). - -When FILE is absolute, this first converts it to a true name by chasing -symbolic links. Only a file of this name \(see next paragraph regarding -extensions) will trigger the evaluation of FORM. When FILE is relative, -a file whose absolute true name ends in FILE will trigger evaluation. - -When FILE lacks an extension, a file name with any extension will trigger -evaluation. Otherwise, its extension must match FILE's. A further -extension for a compressed format \(e.g. \".gz\") on FILE will not affect -this name matching. - -Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM -is evaluated at the end of any file that `provide's this feature. -If the feature is provided when evaluating code not associated with a -file, FORM is evaluated immediately after the provide statement. - -Usually FILE is just a library name like \"font-lock\" or a feature name -like 'font-lock. - -This function makes or adds to an entry on `after-load-alist'." - ;; Add this FORM into after-load-alist (regardless of whether we'll be - ;; evaluating it now). - (let* ((regexp-or-feature - (if (stringp file) - (setq file (purecopy (load-history-regexp file))) - file)) - (elt (assoc regexp-or-feature after-load-alist))) - (unless elt - (setq elt (list regexp-or-feature)) - (push elt after-load-alist)) - ;; Make sure `form' is evalled in the current lexical/dynamic code. - (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding))) - ;; Is there an already loaded file whose name (or `provide' name) - ;; matches FILE? - (prog1 (if (if (stringp file) - (load-history-filename-element regexp-or-feature) - (featurep file)) - (eval form)) - (when (symbolp regexp-or-feature) - ;; For features, the after-load-alist elements get run when `provide' is - ;; called rather than at the end of the file. So add an indirection to - ;; make sure that `form' is really run "after-load" in case the provide - ;; call happens early. - (setq form - `(if load-file-name - (let ((fun (make-symbol "eval-after-load-helper"))) - (fset fun `(lambda (file) - (if (not (equal file ',load-file-name)) - nil - (remove-hook 'after-load-functions ',fun) - ,',form))) - (add-hook 'after-load-functions fun)) - ;; Not being provided from a file, run form right now. - ,form))) - ;; Add FORM to the element unless it's already there. - (unless (member form (cdr elt)) - (nconc elt (list form)))))) - -(defvar after-load-functions nil - "Special hook run after loading a file. -Each function there is called with a single argument, the absolute -name of the file just loaded.") - -(defun do-after-load-evaluation (abs-file) - "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. -ABS-FILE, a string, should be the absolute true name of a file just loaded. -This function is called directly from the C code." - ;; Run the relevant eval-after-load forms. - (mapc #'(lambda (a-l-element) - (when (and (stringp (car a-l-element)) - (string-match-p (car a-l-element) abs-file)) - ;; discard the file name regexp - (mapc #'eval (cdr a-l-element)))) - after-load-alist) - ;; Complain when the user uses obsolete files. - (when (string-match-p "/obsolete/[^/]*\\'" abs-file) - (run-with-timer 0 nil - (lambda (file) - (message "Package %s is obsolete!" - (substring file 0 - (string-match "\\.elc?\\>" file)))) - (file-name-nondirectory abs-file))) - ;; Finally, run any other hook. - (run-hook-with-args 'after-load-functions abs-file)) - -(defun eval-next-after-load (file) - "Read the following input sexp, and run it whenever FILE is loaded. -This makes or adds to an entry on `after-load-alist'. -FILE should be the name of a library, with no directory name." - (declare (obsolete eval-after-load "23.2")) - (eval-after-load file (read))) - -(defun display-delayed-warnings () - "Display delayed warnings from `delayed-warnings-list'. -Used from `delayed-warnings-hook' (which see)." - (dolist (warning (nreverse delayed-warnings-list)) - (apply 'display-warning warning)) - (setq delayed-warnings-list nil)) - -(defun collapse-delayed-warnings () - "Remove duplicates from `delayed-warnings-list'. -Collapse identical adjacent warnings into one (plus count). -Used from `delayed-warnings-hook' (which see)." - (let ((count 1) - collapsed warning) - (while delayed-warnings-list - (setq warning (pop delayed-warnings-list)) - (if (equal warning (car delayed-warnings-list)) - (setq count (1+ count)) - (when (> count 1) - (setcdr warning (cons (format "%s [%d times]" (cadr warning) count) - (cddr warning))) - (setq count 1)) - (push warning collapsed))) - (setq delayed-warnings-list (nreverse collapsed)))) - -;; At present this is only used for Emacs internals. -;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html -(defvar delayed-warnings-hook '(collapse-delayed-warnings - display-delayed-warnings) - "Normal hook run to process and display delayed warnings. -By default, this hook contains functions to consolidate the -warnings listed in `delayed-warnings-list', display them, and set -`delayed-warnings-list' back to nil.") - ;;;; Process stuff. @@ -1958,9 +1888,11 @@ Signal an error if the program returns with a non-zero exit status." (defun process-live-p (process) "Returns non-nil if PROCESS is alive. A process is considered alive if its status is `run', `open', -`listen', `connect' or `stop'." - (memq (process-status process) - '(run open listen connect stop))) +`listen', `connect' or `stop'. Value is nil if PROCESS is not a +process." + (and (processp process) + (memq (process-status process) + '(run open listen connect stop)))) ;; compatibility @@ -2004,17 +1936,6 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." ;;;; Input and display facilities. -(defvar read-quoted-char-radix 8 - "Radix for \\[quoted-insert] and other uses of `read-quoted-char'. -Legitimate radix values are 8, 10 and 16.") - -(custom-declare-variable-early - 'read-quoted-char-radix 8 - "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. -Legitimate radix values are 8, 10 and 16." - :type '(choice (const 8) (const 10) (const 16)) - :group 'editing-basics) - (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2030,8 +1951,8 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." ;; disable quail's input methods, so although read-key-sequence ;; always inherits the input method, in practice read-key does not ;; inherit the input method (at least not if it's based on quail). - (let ((overriding-terminal-local-map read-key-empty-map) - (overriding-local-map nil) + (let ((overriding-terminal-local-map nil) + (overriding-local-map read-key-empty-map) (echo-keystrokes 0) (old-global-map (current-global-map)) (timer (run-with-idle-timer @@ -2070,66 +1991,6 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (cancel-timer timer) (use-global-map old-global-map)))) -(defun read-quoted-char (&optional prompt) - "Like `read-char', but do not allow quitting. -Also, if the first character read is an octal digit, -we read any number of octal digits and return the -specified character code. Any nondigit terminates the sequence. -If the terminator is RET, it is discarded; -any other terminator is used itself as input. - -The optional argument PROMPT specifies a string to use to prompt the user. -The variable `read-quoted-char-radix' controls which radix to use -for numeric input." - (let ((message-log-max nil) done (first t) (code 0) char translated) - (while (not done) - (let ((inhibit-quit first) - ;; Don't let C-h get the help message--only help function keys. - (help-char nil) - (help-form - "Type the special character you want to use, -or the octal character code. -RET terminates the character code and is discarded; -any other non-digit terminates the character code and is then used as input.")) - (setq char (read-event (and prompt (format "%s-" prompt)) t)) - (if inhibit-quit (setq quit-flag nil))) - ;; Translate TAB key into control-I ASCII character, and so on. - ;; Note: `read-char' does it using the `ascii-character' property. - ;; We should try and use read-key instead. - (let ((translation (lookup-key local-function-key-map (vector char)))) - (setq translated (if (arrayp translation) - (aref translation 0) - char))) - (if (integerp translated) - (setq translated (char-resolve-modifiers translated))) - (cond ((null translated)) - ((not (integerp translated)) - (setq unread-command-events (list char) - done t)) - ((/= (logand translated ?\M-\^@) 0) - ;; Turn a meta-character into a character with the 0200 bit set. - (setq code (logior (logand translated (lognot ?\M-\^@)) 128) - done t)) - ((and (<= ?0 translated) - (< translated (+ ?0 (min 10 read-quoted-char-radix)))) - (setq code (+ (* code read-quoted-char-radix) (- translated ?0))) - (and prompt (setq prompt (message "%s %c" prompt translated)))) - ((and (<= ?a (downcase translated)) - (< (downcase translated) - (+ ?a -10 (min 36 read-quoted-char-radix)))) - (setq code (+ (* code read-quoted-char-radix) - (+ 10 (- (downcase translated) ?a)))) - (and prompt (setq prompt (message "%s %c" prompt translated)))) - ((and (not first) (eq translated ?\C-m)) - (setq done t)) - ((not first) - (setq unread-command-events (list char) - done t)) - (t (setq code translated - done t))) - (setq first nil)) - code)) - (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with ;; minibuffer-local-map along the way! @@ -2179,6 +2040,8 @@ by doing (clear-string STRING)." (setq-local buffer-undo-list t) (setq-local select-active-regions nil) (use-local-map read-passwd-map) + (setq-local inhibit-modification-hooks nil) ;bug#15501. + (setq-local show-paren-mode nil) ;bug#16091. (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect (let ((enable-recursive-minibuffers t)) @@ -2193,11 +2056,11 @@ by doing (clear-string STRING)." ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -;; This should be used by `call-interactively' for `n' specs. (defun read-number (prompt &optional default) "Read a numeric value in the minibuffer, prompting with PROMPT. DEFAULT specifies a default value to return if the user just types RET. -The value of DEFAULT is inserted into PROMPT." +The value of DEFAULT is inserted into PROMPT. +This function is used by the `interactive' code letter `n'." (let ((n nil) (default1 (if (consp default) (car default) default))) (when default1 @@ -2218,7 +2081,7 @@ The value of DEFAULT is inserted into PROMPT." (condition-case nil (setq n (cond ((zerop (length str)) default1) - ((stringp str) (string-to-number str)))) + ((stringp str) (read str)))) (error nil))) (unless (numberp n) (message "Please enter a number.") @@ -2287,6 +2150,7 @@ An obsolete, but still supported form is where the optional arg MILLISECONDS specifies an additional wait period, in milliseconds; this was useful when Emacs was built without floating point support." + (declare (advertised-calling-convention (seconds &optional nodisp) "22.1")) (if (numberp nodisp) (setq seconds (+ seconds (* 1e-3 nodisp)) nodisp obsolete) @@ -2295,13 +2159,16 @@ floating point support." (noninteractive (sleep-for seconds) t) - ((input-pending-p) + ((input-pending-p t) nil) ((<= seconds 0) (or nodisp (redisplay))) (t (or nodisp (redisplay)) - (let ((read (read-event nil nil seconds))) + ;; FIXME: we should not read-event here at all, because it's much too + ;; difficult to reliably "undo" a read-event by pushing it onto + ;; unread-command-events. + (let ((read (read-event nil t seconds))) (or (null read) (progn ;; If last command was a prefix arg, e.g. C-u, push this event onto @@ -2311,7 +2178,9 @@ floating point support." (setq read (cons t read))) (push read unread-command-events) nil)))))) -(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1") + +;; Behind display-popup-menus-p test. +(declare-function x-popup-dialog "menu.c" (position contents &optional header)) (defun y-or-n-p (prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\". @@ -2341,7 +2210,8 @@ is nil and `use-dialog-box' is non-nil." (cond (noninteractive (setq prompt (concat prompt - (if (eq ?\s (aref prompt (1- (length prompt)))) + (if (or (zerop (length prompt)) + (eq ?\s (aref prompt (1- (length prompt))))) "" " ") "(y or n) ")) (let ((temp-prompt prompt)) @@ -2358,7 +2228,8 @@ is nil and `use-dialog-box' is non-nil." (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))) (t (setq prompt (concat prompt - (if (eq ?\s (aref prompt (1- (length prompt)))) + (if (or (zerop (length prompt)) + (eq ?\s (aref prompt (1- (length prompt))))) "" " ") "(y or n) ")) (while @@ -2517,14 +2388,6 @@ This finishes the change group by reverting all of its changes." (define-obsolete-function-alias 'redraw-modeline 'force-mode-line-update "24.3") -(defun force-mode-line-update (&optional all) - "Force redisplay of the current buffer's mode line and header line. -With optional non-nil ALL, force redisplay of all mode lines and -header lines. This function also forces recomputation of the -menu bar menus and the frame title." - (if all (with-current-buffer (other-buffer))) - (set-buffer-modified-p (buffer-modified-p))) - (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. Display remains until next event is input. @@ -2550,11 +2413,12 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." (recenter (/ (window-height) 2)))) (message (or message "Type %s to continue editing.") (single-key-description exit-char)) - (let ((event (read-event))) + (let ((event (read-key))) ;; `exit-char' can be an event, or an event description list. (or (eq event exit-char) (eq event (event-convert-list exit-char)) - (setq unread-command-events (list event))))) + (setq unread-command-events + (append (this-single-command-raw-keys)))))) (delete-overlay ol)))) @@ -2621,11 +2485,6 @@ When the hook runs, the temporary buffer is current. This hook is normally set up with a function to put the buffer in Help mode.") -;; The `assert' macro from the cl package signals -;; `cl-assertion-failed' at runtime so always define it. -(put 'cl-assertion-failed 'error-conditions '(error)) -(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed")) - (defconst user-emacs-directory (if (eq system-type 'ms-dos) ;; MS-DOS cannot have initial dot. @@ -2635,34 +2494,6 @@ mode.") Various programs in Emacs store information in this directory. Note that this should end with a directory separator. See also `locate-user-emacs-file'.") - -(defun locate-user-emacs-file (new-name &optional old-name) - "Return an absolute per-user Emacs-specific file name. -If NEW-NAME exists in `user-emacs-directory', return it. -Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. -Else return NEW-NAME in `user-emacs-directory', creating the -directory if it does not exist." - (convert-standard-filename - (let* ((home (concat "~" (or init-file-user ""))) - (at-home (and old-name (expand-file-name old-name home))) - (bestname (abbreviate-file-name - (expand-file-name new-name user-emacs-directory)))) - (if (and at-home (not (file-readable-p bestname)) - (file-readable-p at-home)) - at-home - ;; Make sure `user-emacs-directory' exists, - ;; unless we're in batch mode or dumping Emacs - (or noninteractive - purify-flag - (file-accessible-directory-p - (directory-file-name user-emacs-directory)) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (make-directory user-emacs-directory)) - (set-default-file-modes umask)))) - bestname)))) ;;;; Misc. useful functions. @@ -2670,8 +2501,9 @@ directory if it does not exist." "Return non-nil if the current buffer is narrowed." (/= (- (point-max) (point-min)) (buffer-size))) -(defun find-tag-default () - "Determine default tag to search for, based on text at point. +(defun find-tag-default-bounds () + "Determine the boundaries of the default tag, based on text at point. +Return a cons cell with the beginning and end of the found tag. If there is no plausible default, return nil." (let (from to bound) (when (or (progn @@ -2695,7 +2527,42 @@ If there is no plausible default, return nil." (< (setq from (point)) bound) (skip-syntax-forward "w_") (setq to (point))))) - (buffer-substring-no-properties from to)))) + (cons from to)))) + +(defun find-tag-default () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (let ((bounds (find-tag-default-bounds))) + (when bounds + (buffer-substring-no-properties (car bounds) (cdr bounds))))) + +(defun find-tag-default-as-regexp () + "Return regexp that matches the default tag at point. +If there is no tag at point, return nil. + +When in a major mode that does not provide its own +`find-tag-default-function', return a regexp that matches the +symbol at point exactly." + (let ((tag (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)))) + (if tag (regexp-quote tag)))) + +(defun find-tag-default-as-symbol-regexp () + "Return regexp that matches the default tag at point as symbol. +If there is no tag at point, return nil. + +When in a major mode that does not provide its own +`find-tag-default-function', return a regexp that matches the +symbol at point exactly." + (let ((tag-regexp (find-tag-default-as-regexp))) + (if (and tag-regexp + (eq (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default) + 'find-tag-default)) + (format "\\_<%s\\_>" tag-regexp) + tag-regexp))) (defun play-sound (sound) "SOUND is a list of the form `(sound KEYWORD VALUE...)'. @@ -2798,6 +2665,13 @@ Otherwise, return nil." (setq object (indirect-function object t))) (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) +(defun macrop (object) + "Non-nil if and only if OBJECT is a macro." + (let ((def (indirect-function object t))) + (when (consp def) + (or (eq 'macro (car def)) + (and (autoloadp def) (memq (nth 4 def) '(macro t))))))) + (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." (let ((raw-field (get-char-property (field-beginning pos) 'field))) @@ -2833,6 +2707,7 @@ if it's an autoloaded macro." val)) ;;;; Support for yanking and text properties. +;; Why here in subr.el rather than in simple.el? --Stef (defvar yank-handled-properties) (defvar yank-excluded-properties) @@ -3290,7 +3165,7 @@ than cosmetic ones, undo data may become corrupted. This macro will run BODY normally, but doesn't count its buffer modifications as being buffer modifications. This affects things -like buffer-modified-p, checking whether the file is locked by +like `buffer-modified-p', checking whether the file is locked by someone else, running buffer modification hooks, and other things of that nature. @@ -3372,16 +3247,26 @@ even if this catches the signal." (define-obsolete-function-alias 'condition-case-no-debug 'condition-case-unless-debug "24.1") -(defmacro with-demoted-errors (&rest body) +(defmacro with-demoted-errors (format &rest body) "Run BODY and demote any errors to simple messages. +FORMAT is a string passed to `message' to format any error message. +It should contain a single %-sequence; e.g., \"Error: %S\". + If `debug-on-error' is non-nil, run BODY without catching its errors. This is to be used around code which is not expected to signal an error -but which should be robust in the unexpected case that an error is signaled." - (declare (debug t) (indent 0)) - (let ((err (make-symbol "err"))) +but which should be robust in the unexpected case that an error is signaled. + +For backward compatibility, if FORMAT is not a constant string, it +is assumed to be part of BODY, in which case the message format +used is \"Error: %S\"." + (declare (debug t) (indent 1)) + (let ((err (make-symbol "err")) + (format (if (and (stringp format) body) format + (prog1 "Error: %S" + (if format (push format body)))))) `(condition-case-unless-debug ,err - (progn ,@body) - (error (message "Error: %S" ,err) nil)))) + ,(macroexp-progn body) + (error (message ,format ,err) nil)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -3495,7 +3380,10 @@ If GREEDY is non-nil, extend the match backwards as far as possible, stopping when a single additional previous character cannot be part of a match for REGEXP. When the match is extended, its starting position is allowed to occur before -LIMIT." +LIMIT. + +As a general recommendation, try to avoid using `looking-back' +wherever possible, since it is slow." (let ((start (point)) (pos (save-excursion @@ -3582,7 +3470,7 @@ likely to have undesired semantics.") ;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical ;; expression leads to the equivalent implementation that if SEPARATORS ;; is defaulted, OMIT-NULLS is treated as t. -(defun split-string (string &optional separators omit-nulls) +(defun split-string (string &optional separators omit-nulls trim) "Split STRING into substrings bounded by matches for SEPARATORS. The beginning and end of STRING, and each match for SEPARATORS, are @@ -3595,22 +3483,55 @@ which separates, but is not part of, the substrings. If nil it defaults to `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and OMIT-NULLS is forced to t. -If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so +If OMIT-NULLS is t, zero-length substrings are omitted from the list (so that for the default value of SEPARATORS leading and trailing whitespace are effectively trimmed). If nil, all zero-length substrings are retained, which correctly parses CSV format, for example. +If TRIM is non-nil, it should be a regular expression to match +text to trim from the beginning and end of each substring. If trimming +makes the substring empty, it is treated as null. + +If you want to trim whitespace from the substrings, the reliably correct +way is using TRIM. Making SEPARATORS match that whitespace gives incorrect +results when there is whitespace at the start or end of STRING. If you +see such calls to `split-string', please fix them. + Note that the effect of `(split-string STRING)' is the same as `(split-string STRING split-string-default-separators t)'. In the rare case that you wish to retain zero-length substrings when splitting on whitespace, use `(split-string STRING split-string-default-separators)'. Modifies the match data; use `save-match-data' if necessary." - (let ((keep-nulls (not (if separators omit-nulls t))) - (rexp (or separators split-string-default-separators)) - (start 0) - notfirst - (list nil)) + (let* ((keep-nulls (not (if separators omit-nulls t))) + (rexp (or separators split-string-default-separators)) + (start 0) + this-start this-end + notfirst + (list nil) + (push-one + ;; Push the substring in range THIS-START to THIS-END + ;; onto LIST, trimming it and perhaps discarding it. + (lambda () + (when trim + ;; Discard the trim from start of this substring. + (let ((tem (string-match trim string this-start))) + (and (eq tem this-start) + (setq this-start (match-end 0))))) + + (when (or keep-nulls (< this-start this-end)) + (let ((this (substring string this-start this-end))) + + ;; Discard the trim from end of this substring. + (when trim + (let ((tem (string-match (concat trim "\\'") this 0))) + (and tem (< tem (length this)) + (setq this (substring this 0 tem))))) + + ;; Trimming could make it empty; check again. + (when (or keep-nulls (> (length this) 0)) + (push this list))))))) + (while (and (string-match rexp string (if (and notfirst (= start (match-beginning 0)) @@ -3618,15 +3539,15 @@ Modifies the match data; use `save-match-data' if necessary." (1+ start) start)) (< start (length string))) (setq notfirst t) - (if (or keep-nulls (< start (match-beginning 0))) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (if (or keep-nulls (< start (length string))) - (setq list - (cons (substring string start) - list))) + (setq this-start start this-end (match-beginning 0) + start (match-end 0)) + + (funcall push-one)) + + ;; Handle the substring at the end of STRING. + (setq this-start start this-end (length string)) + (funcall push-one) + (nreverse list))) (defun combine-and-quote-strings (strings &optional separator) @@ -3736,6 +3657,15 @@ to case differences." (eq t (compare-strings str1 nil nil str2 0 (length str1) ignore-case))) +(defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case))))) + (defun bidi-string-mark-left-to-right (str) "Return a string that can be safely inserted in left-to-right text. @@ -3754,6 +3684,214 @@ consisting of STR followed by an invisible left-to-right mark (concat str (propertize (string ?\x200e) 'invisible t)) str)) +;;;; Specifying things to do later. + +(defun load-history-regexp (file) + "Form a regexp to find FILE in `load-history'. +FILE, a string, is described in the function `eval-after-load'." + (if (file-name-absolute-p file) + (setq file (file-truename file))) + (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") + (regexp-quote file) + (if (file-name-extension file) + "" + ;; Note: regexp-opt can't be used here, since we need to call + ;; this before Emacs has been fully started. 2006-05-21 + (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) + "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") + "\\)?\\'")) + +(defun load-history-filename-element (file-regexp) + "Get the first elt of `load-history' whose car matches FILE-REGEXP. +Return nil if there isn't one." + (let* ((loads load-history) + (load-elt (and loads (car loads)))) + (save-match-data + (while (and loads + (or (null (car load-elt)) + (not (string-match file-regexp (car load-elt))))) + (setq loads (cdr loads) + load-elt (and loads (car loads))))) + load-elt)) + +(put 'eval-after-load 'lisp-indent-function 1) +(defun eval-after-load (file form) + "Arrange that if FILE is loaded, FORM will be run immediately afterwards. +If FILE is already loaded, evaluate FORM right now. +FORM can be an Elisp expression (in which case it's passed to `eval'), +or a function (in which case it's passed to `funcall' with no argument). + +If a matching file is loaded again, FORM will be evaluated again. + +If FILE is a string, it may be either an absolute or a relative file +name, and may have an extension (e.g. \".el\") or may lack one, and +additionally may or may not have an extension denoting a compressed +format (e.g. \".gz\"). + +When FILE is absolute, this first converts it to a true name by chasing +symbolic links. Only a file of this name (see next paragraph regarding +extensions) will trigger the evaluation of FORM. When FILE is relative, +a file whose absolute true name ends in FILE will trigger evaluation. + +When FILE lacks an extension, a file name with any extension will trigger +evaluation. Otherwise, its extension must match FILE's. A further +extension for a compressed format (e.g. \".gz\") on FILE will not affect +this name matching. + +Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM +is evaluated at the end of any file that `provide's this feature. +If the feature is provided when evaluating code not associated with a +file, FORM is evaluated immediately after the provide statement. + +Usually FILE is just a library name like \"font-lock\" or a feature name +like 'font-lock. + +This function makes or adds to an entry on `after-load-alist'." + (declare (compiler-macro + (lambda (whole) + (if (eq 'quote (car-safe form)) + ;; Quote with lambda so the compiler can look inside. + `(eval-after-load ,file (lambda () ,(nth 1 form))) + whole)))) + ;; Add this FORM into after-load-alist (regardless of whether we'll be + ;; evaluating it now). + (let* ((regexp-or-feature + (if (stringp file) + (setq file (purecopy (load-history-regexp file))) + file)) + (elt (assoc regexp-or-feature after-load-alist)) + (func + (if (functionp form) form + ;; Try to use the "current" lexical/dynamic mode for `form'. + (eval `(lambda () ,form) lexical-binding)))) + (unless elt + (setq elt (list regexp-or-feature)) + (push elt after-load-alist)) + ;; Is there an already loaded file whose name (or `provide' name) + ;; matches FILE? + (prog1 (if (if (stringp file) + (load-history-filename-element regexp-or-feature) + (featurep file)) + (funcall func)) + (let ((delayed-func + (if (not (symbolp regexp-or-feature)) func + ;; For features, the after-load-alist elements get run when + ;; `provide' is called rather than at the end of the file. + ;; So add an indirection to make sure that `func' is really run + ;; "after-load" in case the provide call happens early. + (lambda () + (if (not load-file-name) + ;; Not being provided from a file, run func right now. + (funcall func) + (let ((lfn load-file-name) + ;; Don't use letrec, because equal (in + ;; add/remove-hook) would get trapped in a cycle. + (fun (make-symbol "eval-after-load-helper"))) + (fset fun (lambda (file) + (when (equal file lfn) + (remove-hook 'after-load-functions fun) + (funcall func)))) + (add-hook 'after-load-functions fun 'append))))))) + ;; Add FORM to the element unless it's already there. + (unless (member delayed-func (cdr elt)) + (nconc elt (list delayed-func))))))) + +(defmacro with-eval-after-load (file &rest body) + "Execute BODY after FILE is loaded. +FILE is normally a feature name, but it can also be a file name, +in case that file does not provide any feature." + (declare (indent 1) (debug t)) + `(eval-after-load ,file (lambda () ,@body))) + +(defvar after-load-functions nil + "Special hook run after loading a file. +Each function there is called with a single argument, the absolute +name of the file just loaded.") + +(defun do-after-load-evaluation (abs-file) + "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. +ABS-FILE, a string, should be the absolute true name of a file just loaded. +This function is called directly from the C code." + ;; Run the relevant eval-after-load forms. + (dolist (a-l-element after-load-alist) + (when (and (stringp (car a-l-element)) + (string-match-p (car a-l-element) abs-file)) + ;; discard the file name regexp + (mapc #'funcall (cdr a-l-element)))) + ;; Complain when the user uses obsolete files. + (when (string-match-p "/obsolete/[^/]*\\'" abs-file) + ;; Maybe we should just use display-warning? This seems yucky... + (let* ((file (file-name-nondirectory abs-file)) + (msg (format "Package %s is obsolete!" + (substring file 0 + (string-match "\\.elc?\\>" file))))) + ;; Cribbed from cl--compiling-file. + (if (and (boundp 'byte-compile--outbuffer) + (bufferp (symbol-value 'byte-compile--outbuffer)) + (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) + " *Compiler Output*")) + ;; Don't warn about obsolete files using other obsolete files. + (unless (and (stringp byte-compile-current-file) + (string-match-p "/obsolete/[^/]*\\'" + (expand-file-name + byte-compile-current-file + byte-compile-root-dir))) + (byte-compile-log-warning msg)) + (run-with-timer 0 nil + (lambda (msg) + (message "%s" msg)) msg)))) + + ;; Finally, run any other hook. + (run-hook-with-args 'after-load-functions abs-file)) + +(defun eval-next-after-load (file) + "Read the following input sexp, and run it whenever FILE is loaded. +This makes or adds to an entry on `after-load-alist'. +FILE should be the name of a library, with no directory name." + (declare (obsolete eval-after-load "23.2")) + (eval-after-load file (read))) + + +(defun display-delayed-warnings () + "Display delayed warnings from `delayed-warnings-list'. +Used from `delayed-warnings-hook' (which see)." + (dolist (warning (nreverse delayed-warnings-list)) + (apply 'display-warning warning)) + (setq delayed-warnings-list nil)) + +(defun collapse-delayed-warnings () + "Remove duplicates from `delayed-warnings-list'. +Collapse identical adjacent warnings into one (plus count). +Used from `delayed-warnings-hook' (which see)." + (let ((count 1) + collapsed warning) + (while delayed-warnings-list + (setq warning (pop delayed-warnings-list)) + (if (equal warning (car delayed-warnings-list)) + (setq count (1+ count)) + (when (> count 1) + (setcdr warning (cons (format "%s [%d times]" (cadr warning) count) + (cddr warning))) + (setq count 1)) + (push warning collapsed))) + (setq delayed-warnings-list (nreverse collapsed)))) + +;; At present this is only used for Emacs internals. +;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html +(defvar delayed-warnings-hook '(collapse-delayed-warnings + display-delayed-warnings) + "Normal hook run to process and display delayed warnings. +By default, this hook contains functions to consolidate the +warnings listed in `delayed-warnings-list', display them, and set +`delayed-warnings-list' back to nil.") + +(defun delay-warning (type message &optional level buffer-name) + "Display a delayed warning. +Aside from going through `delayed-warnings-list', this is equivalent +to `display-warning'." + (push (list type message level buffer-name) delayed-warnings-list)) + + ;;;; invisibility specs (defun add-to-invisibility-spec (element) @@ -3818,12 +3956,68 @@ node `(elisp)Syntax Table Internals' for a list of codes. If SYNTAX is nil, return nil." (and syntax (logand (car syntax) 65535))) +;; Utility motion commands + +;; Whitespace + +(defun forward-whitespace (arg) + "Move point to the end of the next sequence of whitespace chars. +Each such sequence may be a single newline, or a sequence of +consecutive space and/or tab characters. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (if (natnump arg) + (re-search-forward "[ \t]+\\|\n" nil 'move arg) + (while (< arg 0) + (if (re-search-backward "[ \t]+\\|\n" nil 'move) + (or (eq (char-after (match-beginning 0)) ?\n) + (skip-chars-backward " \t"))) + (setq arg (1+ arg))))) + +;; Symbols + +(defun forward-symbol (arg) + "Move point to the next position that is the end of a symbol. +A symbol is any sequence of characters that are in either the +word constituent or symbol constituent syntax class. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (if (natnump arg) + (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg) + (while (< arg 0) + (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) + (skip-syntax-backward "w_")) + (setq arg (1+ arg))))) + +;; Syntax blocks + +(defun forward-same-syntax (&optional arg) + "Move point past all characters with the same syntax class. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (or arg (setq arg 1)) + (while (< arg 0) + (skip-syntax-backward + (char-to-string (char-syntax (char-before)))) + (setq arg (1+ arg))) + (while (> arg 0) + (skip-syntax-forward (char-to-string (char-syntax (char-after)))) + (setq arg (1- arg)))) + + ;;;; Text clones -(defun text-clone-maintain (ol1 after beg end &optional _len) +(defvar text-clone--maintaining nil) + +(defun text-clone--maintain (ol1 after beg end &optional _len) "Propagate the changes made under the overlay OL1 to the other clones. This is used on the `modification-hooks' property of text clones." - (when (and after (not undo-in-progress) (overlay-start ol1)) + (when (and after (not undo-in-progress) + (not text-clone--maintaining) + (overlay-start ol1)) (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0))) (setq beg (max beg (+ (overlay-start ol1) margin))) (setq end (min end (- (overlay-end ol1) margin))) @@ -3854,7 +4048,7 @@ This is used on the `modification-hooks' property of text clones." (tail (- (overlay-end ol1) end)) (str (buffer-substring beg end)) (nothing-left t) - (inhibit-modification-hooks t)) + (text-clone--maintaining t)) (dolist (ol2 (overlay-get ol1 'text-clones)) (let ((oe (overlay-end ol2))) (unless (or (eq ol1 ol2) (null oe)) @@ -3865,7 +4059,7 @@ This is used on the `modification-hooks' property of text clones." (unless (> mod-beg (point)) (save-excursion (insert str)) (delete-region mod-beg (point))) - ;;(overlay-put ol2 'modification-hooks '(text-clone-maintain)) + ;;(overlay-put ol2 'modification-hooks '(text-clone--maintain)) )))) (if nothing-left (delete-overlay ol1)))))))) @@ -3896,17 +4090,18 @@ clone should be incorporated in the clone." (>= pt-end (point-max)) (>= start (point-max))) 0 1)) + ;; FIXME: Reuse overlays at point to extend dups! (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t)) (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t)) (dups (list ol1 ol2))) - (overlay-put ol1 'modification-hooks '(text-clone-maintain)) + (overlay-put ol1 'modification-hooks '(text-clone--maintain)) (when spreadp (overlay-put ol1 'text-clone-spreadp t)) (when syntax (overlay-put ol1 'text-clone-syntax syntax)) ;;(overlay-put ol1 'face 'underline) (overlay-put ol1 'evaporate t) (overlay-put ol1 'text-clones dups) ;; - (overlay-put ol2 'modification-hooks '(text-clone-maintain)) + (overlay-put ol2 'modification-hooks '(text-clone--maintain)) (when spreadp (overlay-put ol2 'text-clone-spreadp t)) (when syntax (overlay-put ol2 'text-clone-syntax syntax)) ;;(overlay-put ol2 'face 'underline) @@ -3961,21 +4156,7 @@ I is the index of the frame after FRAME2. It should return nil if those frames don't seem special and otherwise, it should return the number of frames to skip (minus 1).") -(defmacro internal--called-interactively-p--get-frame (n) - ;; `sym' will hold a global variable, which will be used kind of like C's - ;; "static" variables. - (let ((sym (make-symbol "base-index"))) - `(progn - (defvar ,sym) - (unless (boundp ',sym) - (let ((i 1)) - (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t) - (indirect-function 'called-interactively-p))) - (setq i (1+ i))) - (setq ,sym i))) - ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) - ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) - (backtrace-frame (+ ,sym ,n))))) +(defconst internal--call-interactively (symbol-function 'call-interactively)) (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. @@ -4011,7 +4192,7 @@ command is called from a keyboard macro?" (get-next-frame (lambda () (setq frame nextframe) - (setq nextframe (internal--called-interactively-p--get-frame i)) + (setq nextframe (backtrace-frame i 'called-interactively-p)) ;; (message "Frame %d = %S" i nextframe) (setq i (1+ i))))) (funcall get-next-frame) ;; Get the first frame. @@ -4049,9 +4230,9 @@ command is called from a keyboard macro?" (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) - ;; Somehow, I sometimes got `command-execute' rather than - ;; `call-interactively' on my stacktrace !? - ;;(`(,_ . (t command-execute . ,_)) t) + ;; In case # without going through the + ;; `call-interactively' symbol (bug#3984). + (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) (`(,_ . (t call-interactively . ,_)) t))))) (defun interactive-p () @@ -4074,65 +4255,70 @@ use `called-interactively-p'." (declare (obsolete called-interactively-p "23.2")) (called-interactively-p 'interactive)) -(defun function-arity (f &optional num) - "Return the (MIN . MAX) arity of F. -If the maximum arity is infinite, MAX is `many'. -F can be a function or a macro. -If NUM is non-nil, return non-nil iff F can be called with NUM args." - (if (symbolp f) (setq f (indirect-function f))) - (if (eq (car-safe f) 'macro) (setq f (cdr f))) - (let ((res - (if (subrp f) - (let ((x (subr-arity f))) - (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) - (let* ((args (if (consp f) (cadr f) (aref f 0))) - (max (length args)) - (opt (memq '&optional args)) - (rest (memq '&rest args)) - (min (- max (length opt)))) - (if opt - (cons min (if rest 'many (1- max))) - (if rest - (cons (- max (length rest)) 'many) - (cons min max))))))) - (if (not num) - res - (and (>= num (car res)) - (or (eq 'many (cdr res)) (<= num (cdr res))))))) +(defun internal-push-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (unless (memq keymap map) + (unless (memq 'add-keymap-witness (symbol-value symbol)) + (setq map (make-composed-keymap nil (symbol-value symbol))) + (push 'add-keymap-witness (cdr map)) + (set symbol map)) + (push keymap (cdr map))))) -(defun set-temporary-overlay-map (map &optional keep-pred) - "Set MAP as a temporary keymap taking precedence over most other keymaps. -Note that this does NOT take precedence over the \"overriding\" maps -`overriding-terminal-local-map' and `overriding-local-map' (or the -`keymap' text property). Unlike those maps, if no match for a key is -found in MAP, the normal key lookup sequence then continues. +(defun internal-pop-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (when (memq keymap map) + (setf (cdr map) (delq keymap (cdr map)))) + (let ((tail (cddr map))) + (and (or (null tail) (keymapp tail)) + (eq 'add-keymap-witness (nth 1 map)) + (set symbol tail))))) -Normally, MAP is used only once. If the optional argument -KEEP-PRED is t, MAP stays active if a key from MAP is used. -KEEP-PRED can also be a function of no arguments: if it returns -non-nil then MAP stays active." - (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) - (overlaysym (make-symbol "t")) - (alist (list (cons overlaysym map))) - (clearfun - ;; FIXME: Use lexical-binding. - `(lambda () - (unless ,(cond ((null keep-pred) nil) - ((eq t keep-pred) - `(eq this-command - (lookup-key ',map - (this-command-keys-vector)))) - (t `(funcall ',keep-pred))) - (set ',overlaysym nil) ;Just in case. - (remove-hook 'pre-command-hook ',clearfunsym) - (setq emulation-mode-map-alists - (delq ',alist emulation-mode-map-alists)))))) - (set overlaysym overlaysym) - (fset clearfunsym clearfun) - (add-hook 'pre-command-hook clearfunsym) - ;; FIXME: That's the keymaps with highest precedence, except for - ;; the `keymap' text-property ;-( - (push alist emulation-mode-map-alists))) +(define-obsolete-function-alias + 'set-temporary-overlay-map 'set-transient-map "24.4") + +(defun set-transient-map (map &optional keep-pred on-exit) + "Set MAP as a temporary keymap taking precedence over other keymaps. +Normally, MAP is used only once, to look up the very next key. +However, if the optional argument KEEP-PRED is t, MAP stays +active if a key from MAP is used. KEEP-PRED can also be a +function of no arguments: if it returns non-nil, then MAP stays +active. + +Optional arg ON-EXIT, if non-nil, specifies a function that is +called, with no arguments, after MAP is deactivated. + +This uses `overriding-terminal-local-map' which takes precedence over all other +keymaps. As usual, if no match for a key is found in MAP, the normal key +lookup sequence then continues." + (let ((clearfun (make-symbol "clear-transient-map"))) + ;; Don't use letrec, because equal (in add/remove-hook) would get trapped + ;; in a cycle. + (fset clearfun + (lambda () + (with-demoted-errors "set-transient-map PCH: %S" + (unless (cond + ((not (eq map (cadr overriding-terminal-local-map))) + ;; There's presumably some other transient-map in + ;; effect. Wait for that one to terminate before we + ;; remove ourselves. + ;; For example, if isearch and C-u both use transient + ;; maps, then the lifetime of the C-u should be nested + ;; within isearch's, so the pre-command-hook of + ;; isearch should be suspended during the C-u one so + ;; we don't exit isearch just because we hit 1 after + ;; C-u and that 1 exits isearch whereas it doesn't + ;; exit C-u. + t) + ((null keep-pred) nil) + ((eq t keep-pred) + (eq this-command + (lookup-key map (this-command-keys-vector)))) + (t (funcall keep-pred))) + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when on-exit (funcall on-exit)))))) + (add-hook 'pre-command-hook clearfun) + (internal-push-keymap map 'overriding-terminal-local-map))) ;;;; Progress reporters. @@ -4314,36 +4500,6 @@ convenience wrapper around `make-progress-reporter' and friends. (progress-reporter-done ,temp2) nil ,@(cdr (cdr spec))))) - -;;;; Support for watching filesystem events. - -(defun inotify-event-p (event) - "Check if EVENT is an inotify event." - (and (listp event) - (>= (length event) 3) - (eq (car event) 'file-inotify))) - -;;;###autoload -(defun inotify-handle-event (event) - "Handle inotify file system monitoring event. -If EVENT is an inotify filewatch event, call its callback. -Otherwise, signal a `filewatch-error'." - (interactive "e") - (unless (inotify-event-p event) - (signal 'filewatch-error (cons "Not a valid inotify event" event))) - (funcall (nth 2 event) (nth 1 event))) - -(defun w32notify-handle-event (event) - "Handle MS-Windows file system monitoring event. -If EVENT is an MS-Windows filewatch event, call its callback. -Otherwise, signal a `filewatch-error'." - (interactive "e") - (if (and (eq (car event) 'file-w32notify) - (= (length event) 3)) - (funcall (nth 2 event) (nth 1 event)) - (signal 'filewatch-error - (cons "Not a valid MS-Windows file-notify event" event)))) - ;;;; Comparing version strings. @@ -4354,11 +4510,14 @@ Usually the separator is \".\", but it can be any other string.") (defconst version-regexp-alist - '(("^[-_+ ]?alpha$" . -3) - ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases - ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release - ("^[-_+ ]?beta$" . -2) - ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1)) + '(("^[-_+ ]?snapshot$" . -4) + ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases + ("^[-_+]$" . -4) + ;; treat "1.2.3-CVS" as snapshot release + ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4) + ("^[-_+ ]?alpha$" . -3) + ("^[-_+ ]?beta$" . -2) + ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) "Specify association between non-numeric version and its priority. This association is used to handle version string like \"1.0pre2\", @@ -4366,6 +4525,8 @@ This association is used to handle version string like \"1.0pre2\", non-numeric part of a version string to an integer. For example: String Version Integer List Version + \"0.9snapshot\" (0 9 -4) + \"1.0-git\" (1 0 -4) \"1.0pre2\" (1 0 -1 2) \"1.0PRE2\" (1 0 -1 2) \"22.8beta3\" (22 8 -2 3) @@ -4422,6 +4583,8 @@ Examples of version conversion: \"0.9alpha1\" (0 9 -3 1) \"0.9AlphA1\" (0 9 -3 1) \"0.9alpha\" (0 9 -3) + \"0.9snapshot\" (0 9 -4) + \"1.0-git\" (1 0 -4) See documentation for `version-separator' and `version-regexp-alist'." (or (and (stringp ver) (> (length ver) 0)) @@ -4543,19 +4706,18 @@ If all LST elements are zeros or LST is nil, return zero." Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", etc. That is, the trailing \".0\"s are insignificant. Also, version string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", -which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated -as alpha versions." +which is higher than \"1alpha\", which is higher than \"1snapshot\". +Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." (version-list-< (version-to-list v1) (version-to-list v2))) - (defun version<= (v1 v2) "Return t if version V1 is lower (older) than or equal to V2. Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", etc. That is, the trailing \".0\"s are insignificant. Also, version string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", -which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated -as alpha versions." +which is higher than \"1alpha\", which is higher than \"1snapshot\". +Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." (version-list-<= (version-to-list v1) (version-to-list v2))) (defun version= (v1 v2) @@ -4564,8 +4726,8 @@ as alpha versions." Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", etc. That is, the trailing \".0\"s are insignificant. Also, version string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", -which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated -as alpha versions." +which is higher than \"1alpha\", which is higher than \"1snapshot\". +Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." (version-list-= (version-to-list v1) (version-to-list v2))) @@ -4580,4 +4742,20 @@ as alpha versions." (prin1-to-string (make-hash-table))))) (provide 'hashtable-print-readable)) +;; This is used in lisp/Makefile.in and in leim/Makefile.in to +;; generate file names for autoloads, custom-deps, and finder-data. +(defun unmsys--file-name (file) + "Produce the canonical file name for FILE from its MSYS form. + +On systems other than MS-Windows, just returns FILE. +On MS-Windows, converts /d/foo/bar form of file names +passed by MSYS Make into d:/foo/bar that Emacs can grok. + +This function is called from lisp/Makefile and leim/Makefile." + (when (and (eq system-type 'windows-nt) + (string-match "\\`/[a-zA-Z]/" file)) + (setq file (concat (substring file 1 2) ":" (substring file 2)))) + file) + + ;;; subr.el ends here diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index a9238ba60cb..fd4b3132125 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -1,10 +1,10 @@ ;;; t-mouse.el --- mouse support within the text terminal ;; Author: Nick Roberts -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: mouse gpm linux -;; Copyright (C) 1994-1995, 1998, 2006-2013 Free Software Foundation, +;; Copyright (C) 1994-1995, 1998, 2006-2014 Free Software Foundation, ;; Inc. ;; This file is part of GNU Emacs. diff --git a/lisp/tabify.el b/lisp/tabify.el index 6bf45b36886..7b973f1e41b 100644 --- a/lisp/tabify.el +++ b/lisp/tabify.el @@ -1,8 +1,8 @@ ;;; tabify.el --- tab conversion commands for Emacs -;; Copyright (C) 1985, 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1994, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Package: emacs ;; This file is part of GNU Emacs. @@ -28,12 +28,17 @@ ;;; Code: ;;;###autoload -(defun untabify (start end) +(defun untabify (start end &optional _arg) "Convert all tabs in region to multiple spaces, preserving columns. +If called interactively with prefix ARG, convert for the entire +buffer. + Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." - (interactive "r") + (interactive (if current-prefix-arg + (list (point-min) (point-max) current-prefix-arg) + (list (region-beginning) (region-end) nil))) (let ((c (current-column))) (save-excursion (save-restriction @@ -56,14 +61,19 @@ Usually this will be \" [ \\t]+\" to match a space followed by whitespace. \"^\\t* [ \\t]+\" is also useful, for tabifying only initial whitespace.") ;;;###autoload -(defun tabify (start end) +(defun tabify (start end &optional _arg) "Convert multiple spaces in region to tabs when possible. A group of spaces is partially replaced by tabs when this can be done without changing the column they end at. +If called interactively with prefix ARG, convert for the entire +buffer. + Called non-interactively, the region is specified by arguments START and END, rather than by the position of point and mark. The variable `tab-width' controls the spacing of tab stops." - (interactive "r") + (interactive (if current-prefix-arg + (list (point-min) (point-max) current-prefix-arg) + (list (region-beginning) (region-end) nil))) (save-excursion (save-restriction ;; Include the beginning of the line in the narrowing diff --git a/lisp/talk.el b/lisp/talk.el index 741571a8d78..16780365e88 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -1,8 +1,8 @@ ;;; talk.el --- allow several users to talk to each other through Emacs -;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, frames ;; This file is part of GNU Emacs. @@ -50,7 +50,7 @@ Each element has the form (DISPLAY FRAME BUFFER).") (let ((type (frame-live-p (selected-frame)))) (if (or (eq type t) (eq type 'x)) (talk-add-display - (terminal-name (frame-terminal (selected-frame)))) + (terminal-name (frame-terminal))) (error "Unknown frame type"))) (talk-update-buffers)) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 6e85925a69c..66118d3e288 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,9 +1,9 @@ ;;; tar-mode.el --- simple editing of tar files from GNU Emacs -;; Copyright (C) 1990-1991, 1993-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1991, 1993-2014 Free Software Foundation, Inc. ;; Author: Jamie Zawinski -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: 04 Apr 1990 ;; Keywords: unix @@ -133,8 +133,10 @@ This information is useful, but it takes screen space away from file names." :group 'tar) (defvar tar-parse-info nil) -(defvar tar-superior-buffer nil) -(defvar tar-superior-descriptor nil) +(defvar tar-superior-buffer nil + "Buffer containing the tar archive from which a member was extracted.") +(defvar tar-superior-descriptor nil + "Tar descriptor for a member extracted from an archive.") (defvar tar-file-name-coding-system nil) (put 'tar-superior-buffer 'permanent-local t) @@ -738,10 +740,8 @@ tar-file's buffer." nil (error "This line does not describe a tar-file entry")))) -(defun tar-get-descriptor () - (let* ((descriptor (tar-current-descriptor)) - (size (tar-header-size descriptor)) - (link-p (tar-header-link-type descriptor))) +(defun tar--check-descriptor (descriptor) + (let ((link-p (tar-header-link-type descriptor))) (if link-p (error "This is %s, not a real file" (cond ((eq link-p 5) "a directory") @@ -752,10 +752,24 @@ tar-file's buffer." ((eq link-p 38) "a volume header") ((eq link-p 55) "a pax global extended header") ((eq link-p 72) "a pax extended header") - (t "a link")))) + (t "a link")))))) + +(defun tar-get-descriptor () + (let* ((descriptor (tar-current-descriptor)) + (size (tar-header-size descriptor))) + (tar--check-descriptor descriptor) (if (zerop size) (message "This is a zero-length file")) descriptor)) +(defun tar-get-file-descriptor (file) + ;; Used by package.el. + (let ((desc ())) + (dolist (hdr tar-parse-info) + (when (equal file (tar-header-name hdr)) + (setq desc hdr))) + (tar--check-descriptor desc) + desc)) + (defun tar-mouse-extract (event) "Extract a file whose tar directory line you click on." (interactive "e") @@ -774,96 +788,99 @@ tar-file's buffer." (let ((file-name-handler-alist nil)) (apply op args)))) +(defun tar--extract (descriptor) + "Extract this entry of the tar file into its own buffer." + (let* ((name (tar-header-name descriptor)) + (size (tar-header-size descriptor)) + (start (tar-header-data-start descriptor)) + (end (+ start size)) + (tarname (buffer-name)) + (bufname (concat (file-name-nondirectory name) + " (" + tarname + ")")) + (buffer (generate-new-buffer bufname))) + (with-current-buffer buffer + (setq buffer-undo-list t)) + (with-current-buffer tar-data-buffer + (let (coding) + (narrow-to-region start end) + (goto-char start) + (setq coding (or coding-system-for-read + (and set-auto-coding-function + (funcall set-auto-coding-function + name (- end start))) + ;; The following binding causes + ;; find-buffer-file-type-coding-system + ;; (defined on dos-w32.el) to act as if + ;; the file being extracted existed, so + ;; that the file's contents' encoding and + ;; EOL format are auto-detected. + (let ((file-name-handler-alist + '(("" . tar-file-name-handler)))) + (car (find-operation-coding-system + 'insert-file-contents + (cons name (current-buffer)) t))))) + (if (or (not coding) + (eq (coding-system-type coding) 'undecided)) + (setq coding (detect-coding-region start end t))) + (if (and (default-value 'enable-multibyte-characters) + (coding-system-get coding :for-unibyte)) + (with-current-buffer buffer + (set-buffer-multibyte nil))) + (widen) + (decode-coding-region start end coding buffer))) + buffer)) + (defun tar-extract (&optional other-window-p) "In Tar mode, extract this entry of the tar file into its own buffer." (interactive) (let* ((view-p (eq other-window-p 'view)) (descriptor (tar-get-descriptor)) (name (tar-header-name descriptor)) - (size (tar-header-size descriptor)) - (start (tar-header-data-start descriptor)) - (end (+ start size))) - (let* ((tar-buffer (current-buffer)) - (tarname (buffer-name)) - (bufname (concat (file-name-nondirectory name) - " (" - tarname - ")")) - (read-only-p (or buffer-read-only view-p)) - (new-buffer-file-name (expand-file-name - ;; `:' is not allowed on Windows - (concat tarname "!" - (if (string-match "/" name) - name - ;; Make sure `name' contains a / - ;; so set-auto-mode doesn't try - ;; to look at `tarname' for hints. - (concat "./" name))))) - (buffer (get-file-buffer new-buffer-file-name)) - (just-created nil) - undo-list) - (unless buffer - (setq buffer (generate-new-buffer bufname)) - (with-current-buffer buffer - (setq undo-list buffer-undo-list - buffer-undo-list t)) - (setq bufname (buffer-name buffer)) - (setq just-created t) - (with-current-buffer tar-data-buffer - (let (coding) - (narrow-to-region start end) - (goto-char start) - (setq coding (or coding-system-for-read - (and set-auto-coding-function - (funcall set-auto-coding-function - name (- end start))) - ;; The following binding causes - ;; find-buffer-file-type-coding-system - ;; (defined on dos-w32.el) to act as if - ;; the file being extracted existed, so - ;; that the file's contents' encoding and - ;; EOL format are auto-detected. - (let ((file-name-handler-alist - '(("" . tar-file-name-handler)))) - (car (find-operation-coding-system - 'insert-file-contents - (cons name (current-buffer)) t))))) - (if (or (not coding) - (eq (coding-system-type coding) 'undecided)) - (setq coding (detect-coding-region start end t))) - (if (and (default-value 'enable-multibyte-characters) - (coding-system-get coding :for-unibyte)) - (with-current-buffer buffer - (set-buffer-multibyte nil))) - (widen) - (decode-coding-region start end coding buffer))) - (with-current-buffer buffer - (goto-char (point-min)) - (setq buffer-file-name new-buffer-file-name) - (setq buffer-file-truename - (abbreviate-file-name buffer-file-name)) - ;; Force buffer-file-coding-system to what - ;; decode-coding-region actually used. - (set-buffer-file-coding-system last-coding-system-used t) - ;; Set the default-directory to the dir of the - ;; superior buffer. - (setq default-directory - (with-current-buffer tar-buffer - default-directory)) - (rename-buffer bufname) - (set-buffer-modified-p nil) - (setq buffer-undo-list undo-list) - (normal-mode) ; pick a mode. - (set (make-local-variable 'tar-superior-buffer) tar-buffer) - (set (make-local-variable 'tar-superior-descriptor) descriptor) - (setq buffer-read-only read-only-p) - (tar-subfile-mode 1))) - (cond - (view-p - (view-buffer buffer (and just-created 'kill-buffer-if-not-modified))) - ((eq other-window-p 'display) (display-buffer buffer)) - (other-window-p (switch-to-buffer-other-window buffer)) - (t (switch-to-buffer buffer)))))) + (tar-buffer (current-buffer)) + (tarname (buffer-name)) + (read-only-p (or buffer-read-only view-p)) + (new-buffer-file-name (expand-file-name + ;; `:' is not allowed on Windows + (concat tarname "!" + (if (string-match "/" name) + name + ;; Make sure `name' contains a / + ;; so set-auto-mode doesn't try + ;; to look at `tarname' for hints. + (concat "./" name))))) + (buffer (get-file-buffer new-buffer-file-name)) + (just-created nil)) + (unless buffer + (setq buffer (tar--extract descriptor)) + (setq just-created t) + (with-current-buffer buffer + (goto-char (point-min)) + (setq buffer-file-name new-buffer-file-name) + (setq buffer-file-truename + (abbreviate-file-name buffer-file-name)) + ;; Force buffer-file-coding-system to what + ;; decode-coding-region actually used. + (set-buffer-file-coding-system last-coding-system-used t) + ;; Set the default-directory to the dir of the + ;; superior buffer. + (setq default-directory + (with-current-buffer tar-buffer + default-directory)) + (set-buffer-modified-p nil) + (setq buffer-undo-list t) + (normal-mode) ; pick a mode. + (set (make-local-variable 'tar-superior-buffer) tar-buffer) + (set (make-local-variable 'tar-superior-descriptor) descriptor) + (setq buffer-read-only read-only-p) + (tar-subfile-mode 1))) + (cond + (view-p + (view-buffer buffer (and just-created 'kill-buffer-if-not-modified))) + ((eq other-window-p 'display) (display-buffer buffer)) + (other-window-p (switch-to-buffer-other-window buffer)) + (t (switch-to-buffer buffer))))) (defun tar-extract-other-window () diff --git a/lisp/tempo.el b/lisp/tempo.el index 5ad62180a0a..9ff7a49146d 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -1,6 +1,6 @@ ;;; tempo.el --- Flexible template insertion -;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 2001-2014 Free Software Foundation, Inc. ;; Author: David K}gedal ;; Created: 16 Feb 1994 diff --git a/lisp/term.el b/lisp/term.el index b37e71280da..97108c330a8 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1,6 +1,6 @@ ;;; term.el --- general command interpreter in a window stuff -;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2013 Free Software +;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Per Bothner @@ -560,6 +560,13 @@ This variable is buffer-local." :type 'boolean :group 'term) +(defcustom term-suppress-hard-newline nil + "Non-nil means interpreter should not break long lines with newlines. +This means text can automatically reflow if the window is resized." + :version "24.4" + :type 'boolean + :group 'term) + ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for ;; indications of the current pc. @@ -953,7 +960,7 @@ is buffer-local." (when term-escape-char ;; Undo previous term-set-escape-char. (define-key term-raw-map term-escape-char 'term-send-raw)) - (setq term-escape-char (vector key)) + (setq term-escape-char (if (vectorp key) key (vector key))) (define-key term-raw-map term-escape-char term-raw-escape-map) ;; FIXME: If we later call term-set-escape-char again with another key, ;; we should undo this binding. @@ -968,8 +975,8 @@ is buffer-local." (display-graphic-p) overflow-newline-into-fringe (/= (frame-parameter nil 'right-fringe) 0)) - (window-width) - (1- (window-width)))) + (window-body-width) + (1- (window-body-width)))) (put 'term-mode 'mode-class 'special) @@ -1245,15 +1252,14 @@ without any interpretation." (setq this-command 'yank) (mouse-set-point click) (term-send-raw-string - (or (cond ; From `mouse-yank-primary': - ((eq system-type 'windows-nt) - (or (x-get-selection 'PRIMARY) - (x-get-selection-value))) - ((fboundp 'x-get-selection-value) - (or (x-get-selection-value) - (x-get-selection 'PRIMARY))) - (t - (x-get-selection 'PRIMARY))) + ;; From `mouse-yank-primary': + (or (if (fboundp 'x-get-selection-value) + (if (eq system-type 'windows-nt) + (or (x-get-selection 'PRIMARY) + (x-get-selection-value)) + (or (x-get-selection-value) + (x-get-selection 'PRIMARY))) + (x-get-selection 'PRIMARY)) (error "No selection is available"))))) (defun term-paste () @@ -2828,8 +2834,9 @@ See `term-prompt-regexp'." (setq count (length decoded-substring)) (setq temp (- (+ (term-horizontal-column) count) term-width)) - (cond ((<= temp 0)) ;; All count chars fit in line. - ((> count temp) ;; Some chars fit. + (cond ((or term-suppress-hard-newline (<= temp 0))) + ;; All count chars fit in line. + ((> count temp) ;; Some chars fit. ;; This iteration, handle only what fits. (setq count (- count temp)) (setq count-bytes @@ -2929,8 +2936,10 @@ See `term-prompt-regexp'." (let ((end (string-match "\r?$" str i))) (if end (funcall term-command-hook - (prog1 (substring str (1+ i) end) - (setq i (match-end 0)))) + (decode-coding-string + (prog1 (substring str (1+ i) end) + (setq i (match-end 0))) + locale-coding-system)) (setq term-terminal-parameter (substring str i)) (setq term-terminal-state 4) (setq i str-length)))) diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 1a152fc8a48..9750da15c72 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -1,6 +1,6 @@ ;;; AT386.el --- terminal support package for IBM AT keyboards -;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2014 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Keywords: terminals diff --git a/lisp/term/README b/lisp/term/README index 91306a89753..b8756c3873d 100644 --- a/lisp/term/README +++ b/lisp/term/README @@ -1,4 +1,4 @@ -Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc. +Copyright (C) 1993, 2001-2014 Free Software Foundation, Inc. See the end of the file for license conditions. @@ -55,7 +55,7 @@ are listed in src/term.c; look for the string `keys' in that file. terminal mode as on an X console. If there are differences, you can bet they'll frustrate you after you've forgotten about them. - For another, the X keysms provide a standard set of names that Emacs knows + For another, the X keysyms provide a standard set of names that Emacs knows about. It tries to bind many of them to useful things at startup, before your .emacs is read (so you can override them). In some ways, the X keysym standard is a admittedly poor one; it's incomplete, and not well matched to the set of diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 8fe10dc8e35..ba59c75c4ec 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -1,8 +1,8 @@ ;;; common-win.el --- common part of handling window systems -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: terminals ;; This file is part of GNU Emacs. @@ -44,6 +44,11 @@ This variable is not used by the Nextstep port." (defvar ns-last-selected-text) ; ns-win.el (declare-function ns-set-pasteboard "ns-win" (string)) +(defvar x-select-enable-primary) ; x-win.el +(defvar x-last-selected-text-primary) +(defvar x-last-selected-text-clipboard) +(defvar saved-region-selection) ; simple.el + (defun x-select-text (text) "Select TEXT, a string, according to the window system. @@ -73,6 +78,10 @@ is not used)." (x-set-selection 'PRIMARY text) (setq x-last-selected-text-primary text)) (when x-select-enable-clipboard + ;; When cutting, the selection is cleared and PRIMARY set to + ;; the empty string. Prevent that, PRIMARY should not be reset + ;; by cut (Bug#16382). + (setq saved-region-selection text) (x-set-selection 'CLIPBOARD text) (setq x-last-selected-text-clipboard text)))))) @@ -159,7 +168,7 @@ is not used)." initial-frame-alist))))) ;; Make -iconic apply only to the initial frame! -(defun x-handle-iconic (switch) +(defun x-handle-iconic (_switch) (setq initial-frame-alist (cons '(visibility . icon) initial-frame-alist))) @@ -175,7 +184,7 @@ is not used)." (declare-function x-parse-geometry "frame.c" (string)) ;; Handle the geometry option -(defun x-handle-geometry (switch) +(defun x-handle-geometry (_switch) (let* ((geo (x-parse-geometry (pop x-invocation-args))) (left (assq 'left geo)) (top (assq 'top geo)) @@ -216,7 +225,7 @@ is not used)." On X, the display name of individual X frames is recorded in the `display' frame parameter.") -(defun x-handle-display (switch) +(defun x-handle-display (_switch) "Handle -display DISPLAY option." (setq x-display-name (pop x-invocation-args)) ;; Make subshell programs see the same DISPLAY value Emacs really uses. diff --git a/lisp/term/internal.el b/lisp/term/internal.el index 43973604afc..33dc32f5da6 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -1,6 +1,6 @@ ;;; internal.el --- support for PC internal terminal -;; Copyright (C) 1993-1994, 1998-1999, 2001-2013 Free Software +;; Copyright (C) 1993-1994, 1998-1999, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Morten Welinder diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index 46bcbf0a52f..fa0e62147c2 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -1,6 +1,6 @@ ;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Dan Nicolaescu diff --git a/lisp/term/news.el b/lisp/term/news.el index 09c8eef6f8a..a58ff76aefe 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -1,6 +1,6 @@ ;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -;; Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1993, 2001-2014 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index b8baaa077ce..d91b594671f 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -1,6 +1,6 @@ ;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*- -;; Copyright (C) 1993-1994, 2005-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2005-2014 Free Software Foundation, Inc. ;; Authors: Carl Edman ;; Christian Limpach @@ -50,6 +50,7 @@ (require 'faces) (require 'menu-bar) (require 'fontset) +(require 'dnd) (defgroup ns nil "GNUstep/Mac OS X specific features." @@ -104,7 +105,6 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [?\s-~] 'ns-prev-frame) (define-key global-map [?\s--] 'center-line) (define-key global-map [?\s-:] 'ispell) -(define-key global-map [?\s-\;] 'ispell-next) (define-key global-map [?\s-?] 'info) (define-key global-map [?\s-^] 'kill-some-buffers) (define-key global-map [?\s-&] 'kill-this-buffer) @@ -161,10 +161,6 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (define-key global-map [ns-open-file] 'ns-find-file) (define-key global-map [ns-open-temp-file] [ns-open-file]) -(define-key global-map [ns-drag-file] 'ns-find-file) -(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse) -(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse) -(define-key global-map [ns-drag-text] 'ns-insert-text) (define-key global-map [ns-change-font] 'ns-respond-to-change-font) (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) @@ -366,14 +362,6 @@ See `ns-insert-working-text'." ;;;; Inter-app communications support. -(defvar ns-input-text) ; nsterm.m - -(defun ns-insert-text () - "Insert contents of `ns-input-text' at point." - (interactive) - (insert ns-input-text) - (setq ns-input-text nil)) - (defun ns-insert-file () "Insert contents of file `ns-input-file' like insert-file but with less prompting. If file is a directory perform a `find-file' on it." @@ -519,6 +507,50 @@ unless the current buffer is a scratch buffer." (ns-hide-emacs 'activate) (find-file f))))) + +(defun ns-drag-n-drop (event &optional new-frame force-text) + "Edit the files listed in the drag-n-drop EVENT. +Switch to a buffer editing the last file dropped." + (interactive "e") + (let* ((window (posn-window (event-start event))) + (arg (car (cdr (cdr event)))) + (type (car arg)) + (data (car (cdr arg))) + (url-or-string (cond ((eq type 'file) + (concat "file:" data)) + (t data)))) + (set-frame-selected-window nil window) + (when new-frame + (select-frame (make-frame))) + (raise-frame) + (setq window (selected-window)) + (if force-text + (dnd-insert-text window 'private data) + (dnd-handle-one-url window 'private url-or-string)))) + + +(defun ns-drag-n-drop-other-frame (event) + "Edit the files listed in the drag-n-drop EVENT, in other frames. +May create new frames, or reuse existing ones. The frame editing +the last file dropped is selected." + (interactive "e") + (ns-drag-n-drop event t)) + +(defun ns-drag-n-drop-as-text (event) + "Drop the data in EVENT as text." + (interactive "e") + (ns-drag-n-drop event nil t)) + +(defun ns-drag-n-drop-as-text-other-frame (event) + "Drop the data in EVENT as text in a new frame." + (interactive "e") + (ns-drag-n-drop event t t)) + +(global-set-key [drag-n-drop] 'ns-drag-n-drop) +(global-set-key [C-drag-n-drop] 'ns-drag-n-drop-other-frame) +(global-set-key [M-drag-n-drop] 'ns-drag-n-drop-as-text) +(global-set-key [C-M-drag-n-drop] 'ns-drag-n-drop-as-text-other-frame) + ;;;; Frame-related functions. ;; nsterm.m @@ -557,24 +589,9 @@ unless the current buffer is a scratch buffer." (interactive) (other-frame -1)) -;; If no position specified, make new frame offset by 25 from current. -(defvar parameters) ; dynamically bound in make-frame -(add-hook 'before-make-frame-hook - (lambda () - (let ((left (cdr (assq 'left (frame-parameters)))) - (top (cdr (assq 'top (frame-parameters))))) - (if (consp left) (setq left (cadr left))) - (if (consp top) (setq top (cadr top))) - (cond - ((or (assq 'top parameters) (assq 'left parameters))) - ((or (not left) (not top))) - (t - (setq parameters (cons (cons 'left (+ left 25)) - (cons (cons 'top (+ top 25)) - parameters)))))))) - -;; frame will be focused anyway, so select it +;; Frame will be focused anyway, so select it ;; (if this is not done, mode line is dimmed until first interaction) +;; FIXME: Sounds like we're working around a bug in the underlying code. (add-hook 'after-make-frame-functions 'select-frame) (defvar tool-bar-mode) @@ -609,7 +626,7 @@ unless the current buffer is a scratch buffer." `(mouse-1 POSITION 1)))) (if (y-or-n-p (format "Print buffer %s? " (buffer-name))) (print-buffer) - (error "Cancelled"))) + (error "Canceled"))) (print-buffer))) ;;;; Font support. @@ -846,39 +863,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (t nil)))) -(defvar ns-input-color) ; nsterm.m +(defun ns-suspend-error () + ;; Don't allow suspending if any of the frames are NS frames. + (if (memq 'ns (mapcar 'window-system (frame-list))) + (error "Cannot suspend Emacs while running under NS"))) -(defun ns-set-foreground-at-mouse () - "Set the foreground color at the mouse location to `ns-input-color'." - (interactive) - (let* ((pos (mouse-position)) - (frame (car pos)) - (face (ns-face-at-pos pos))) - (cond - ((eq face 'cursor) - (modify-frame-parameters frame (list (cons 'cursor-color - ns-input-color)))) - ((not face) - (modify-frame-parameters frame (list (cons 'foreground-color - ns-input-color)))) - (t - (set-face-foreground face ns-input-color frame))))) - -(defun ns-set-background-at-mouse () - "Set the background color at the mouse location to `ns-input-color'." - (interactive) - (let* ((pos (mouse-position)) - (frame (car pos)) - (face (ns-face-at-pos pos))) - (cond - ((eq face 'cursor) - (modify-frame-parameters frame (list (cons 'cursor-color - ns-input-color)))) - ((not face) - (modify-frame-parameters frame (list (cons 'background-color - ns-input-color)))) - (t - (set-face-background face ns-input-color frame))))) ;; Set some options to be as Nextstep-like as possible. (setq frame-title-format t @@ -888,6 +877,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (defvar ns-initialized nil "Non-nil if Nextstep windowing has been initialized.") +(declare-function x-handle-args "common-win" (args)) (declare-function ns-list-services "nsfns.m" ()) (declare-function x-open-connection "nsfns.m" (display &optional xrm-string must-succeed)) @@ -895,7 +885,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Do the actual Nextstep Windows setup here; the above code just ;; defines functions and variables that we use now. -(defun ns-initialize-window-system () +(defun ns-initialize-window-system (&optional _display) "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." (cl-assert (not ns-initialized)) @@ -914,6 +904,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (x-open-connection (system-name) nil t) + ;; Add GNUstep menu items Services, Hide and Quit. Rename Help to Info + ;; and put it first (i.e. omit from menu-bar-final-items. + (if (featurep 'gnustep) + (progn + (setq menu-bar-final-items '(buffer services hide-app quit)) + + ;; If running under GNUstep, "Help" is moved and renamed "Info". + (bindings--define-key global-map [menu-bar help-menu] + (cons "Info" menu-bar-help-menu)) + (bindings--define-key global-map [menu-bar quit] + '(menu-item "Quit" save-buffers-kill-emacs + :help "Save unsaved buffers, then exit")) + (bindings--define-key global-map [menu-bar hide-app] + '(menu-item "Hide" ns-do-hide-emacs + :help "Hide Emacs")) + (bindings--define-key global-map [menu-bar services] + (cons "Services" (make-sparse-keymap "Services"))))) + + (dolist (service (ns-list-services)) (if (eq (car service) 'undefined) (ns-define-service (cdr service)) @@ -927,15 +936,28 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings. (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1)) + ;; For Darwin nothing except UTF-8 makes sense. + (when (eq system-type 'darwin) + (add-hook 'before-init-hook + #'(lambda () + (setq locale-coding-system 'utf-8-unix) + (setq default-process-coding-system + '(utf-8-unix . utf-8-unix))))) + ;; OS X Lion introduces PressAndHold, which is unsupported by this port. ;; See this thread for more details: ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html (ns-set-resource nil "ApplePressAndHoldEnabled" "NO") (x-apply-session-resources) + + ;; Don't let Emacs suspend under NS. + (add-hook 'suspend-hook 'ns-suspend-error) + (setq ns-initialized t)) -(add-to-list 'display-format-alist '("\\`ns\\'" . ns)) +;; Any display name is OK. +(add-to-list 'display-format-alist '(".*" . ns)) (add-to-list 'handle-args-function-alist '(ns . x-handle-args)) (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index cf67aca8343..00b860f8dcc 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,10 +1,10 @@ ;;; pc-win.el --- setup support for `PC windows' (whatever that is) -;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 Free Software +;; Copyright (C) 1994, 1996-1997, 1999, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Morten Welinder -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -164,22 +164,22 @@ created." ;; platforms. (Bug#10783) ;; From src/xfns.c -(defun x-list-fonts (pattern &optional face frame maximum width) +(defun x-list-fonts (_pattern &optional _face _frame _maximum width) (if (or (null width) (and (numberp width) (= width 1))) (list "ms-dos") (list "no-such-font"))) (defun x-display-pixel-width (&optional frame) (frame-width frame)) (defun x-display-pixel-height (&optional frame) (frame-height frame)) -(defun x-display-planes (&optional frame) 4) ;bg switched to 16 colors as well -(defun x-display-color-cells (&optional frame) 16) -(defun x-server-max-request-size (&optional frame) 1000000) ; ??? -(defun x-server-vendor (&optional frame) t "GNU") -(defun x-server-version (&optional frame) '(1 0 0)) -(defun x-display-screens (&optional frame) 1) -(defun x-display-mm-height (&optional frame) 245) ; Guess the size of my -(defun x-display-mm-width (&optional frame) 322) ; monitor, EZ... -(defun x-display-backing-store (&optional frame) 'not-useful) -(defun x-display-visual-class (&optional frame) 'static-color) +(defun x-display-planes (&optional _frame) 4) ;bg switched to 16 colors as well +(defun x-display-color-cells (&optional _frame) 16) +(defun x-server-max-request-size (&optional _frame) 1000000) ; ??? +(defun x-server-vendor (&optional _frame) t "GNU") +(defun x-server-version (&optional _frame) '(1 0 0)) +(defun x-display-screens (&optional _frame) 1) +(defun x-display-mm-height (&optional _frame) 245) ; Guess the size of my +(defun x-display-mm-width (&optional _frame) 322) ; monitor, EZ... +(defun x-display-backing-store (&optional _frame) 'not-useful) +(defun x-display-visual-class (&optional _frame) 'static-color) (fset 'x-display-save-under 'ignore) (fset 'x-get-resource 'ignore) @@ -238,9 +238,8 @@ is not used)." (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. - (condition-case c - (setq text (w16-get-clipboard-data)) - (error (message "w16-get-clipboard-data:%s" c))) + (with-demoted-errors "w16-get-clipboard-data:%s" + (setq text (w16-get-clipboard-data))) (if (string= text "") (setq text nil)) (cond ((not text) nil) @@ -253,7 +252,7 @@ is not used)." (setq x-last-selected-text text)))))) ;; x-selection-owner-p is used in simple.el. -(defun x-selection-owner-p (&optional selection terminal) +(defun x-selection-owner-p (&optional _selection _terminal) "Whether the current Emacs process owns the given X Selection. The arg should be the name of the selection in question, typically one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. @@ -285,7 +284,7 @@ On Nextstep, TERMINAL is unused. ;; x-own-selection-internal and x-disown-selection-internal are used ;; in select.el:x-set-selection. -(defun x-own-selection-internal (selection value &optional frame) +(defun x-own-selection-internal (_selection value &optional _frame) "Assert an X selection of the type SELECTION with and value VALUE. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) @@ -302,7 +301,7 @@ On Nextstep, FRAME is unused. (x-select-text value)) value) -(defun x-disown-selection-internal (selection &optional time-object terminal) +(defun x-disown-selection-internal (selection &optional _time-object _terminal) "If we own the selection SELECTION, disown it. Disowning it means there is no such selection. @@ -321,7 +320,8 @@ On MS-DOS, all this does is return non-nil if we own the selection. t)) ;; x-get-selection-internal is used in select.el -(defun x-get-selection-internal (selection-symbol target-type &optional time-stamp terminal) +(defun x-get-selection-internal (_selection-symbol _target-type + &optional _time-stamp _terminal) "Return text selected from some X window. SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) @@ -403,7 +403,7 @@ Errors out because it is not supposed to be called, ever." (error "terminal-init-internal called for window-system `%s'" (window-system))) -(defun msdos-initialize-window-system () +(defun msdos-initialize-window-system (&optional _display) "Initialization function for the `pc' \"window system\"." (or (eq (window-system) 'pc) (error diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 0e026a8e4be..bdc378fbe19 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -1,6 +1,6 @@ ;;; rxvt.el --- define function key sequences and standard colors for rxvt -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Author: Eli Zaretskii ;; Keywords: terminals @@ -201,7 +201,7 @@ (defun rxvt-rgb-convert-to-16bit (prim) "Convert an 8-bit primary color value PRIM to a corresponding 16-bit value." - (min 65535 (round (* (/ prim 255.0) 65535.0)))) + (logior prim (lsh prim 8))) (defun rxvt-register-default-colors () "Register the default set of colors for rxvt or compatible emulator. @@ -233,9 +233,9 @@ for the currently selected frame." (tty-color-define (format "color-%d" (- 256 ncolors)) (- 256 ncolors) (mapcar 'rxvt-rgb-convert-to-16bit - (list (round (* r 42.5)) - (round (* g 42.5)) - (round (* b 42.5))))) + (list (if (zerop r) 0 (+ (* r 40) 55)) + (if (zerop g) 0 (+ (* g 40) 55)) + (if (zerop b) 0 (+ (* b 40) 55))))) (setq b (1+ b)) (if (> b 5) (setq g (1+ g) diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 4fc035191c7..216e8c31735 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -1,6 +1,6 @@ ;;; sun.el --- keybinding for standard default sunterm keys -;; Copyright (C) 1987, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1987, 2001-2014 Free Software Foundation, Inc. ;; Author: Jeff Peck ;; Keywords: terminals diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 8002c53151b..60be0a40f58 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -1,9 +1,9 @@ ;;; tty-colors.el --- color support for character terminals -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Eli Zaretskii -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: terminals, faces ;; This file is part of GNU Emacs. @@ -767,7 +767,7 @@ (yes . 8)) "An alist of supported standard tty color modes and their aliases.") -(defun tty-color-alist (&optional frame) +(defun tty-color-alist (&optional _frame) "Return an alist of colors supported by FRAME's terminal. FRAME defaults to the selected frame. Each element of the returned alist is of the form: @@ -840,7 +840,7 @@ If FRAME is not specified or is nil, it defaults to the selected frame." (tty-modify-color-alist (append (list (tty-color-canonicalize name) index) rgb) frame)) -(defun tty-color-clear (&optional frame) +(defun tty-color-clear (&optional _frame) "Clear the list of supported tty colors for frame FRAME. If FRAME is unspecified or nil, it defaults to the selected frame." (setq tty-defined-color-alist nil)) diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 2f9eb2614f6..841d88d4e19 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -1,6 +1,6 @@ ;;; tvi970.el --- terminal support for the Televideo 970 -;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2014 Free Software Foundation, Inc. ;; Author: Jim Blandy ;; Keywords: terminals diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 782924086df..19e64d2bd90 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -1,6 +1,6 @@ ;;; vt100.el --- define VT100 function key sequences in function-key-map -;; Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1993, 2001-2014 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals @@ -46,6 +46,7 @@ With a prefix argument ARG, switch to 132-column mode if ARG is positive, and 80-column mode otherwise. If called from Lisp, switch to 132-column mode if ARG is omitted or nil." :global t :init-value (= (frame-width) 132) + :group 'terminals (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index cbd08e68a39..96cf0838cb2 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -1,6 +1,6 @@ ;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*- -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Kevin Gallo ;; Keywords: terminals @@ -110,8 +110,13 @@ (let ((f (if (eq system-type 'cygwin) (cygwin-convert-file-name-from-windows file-name t) (subst-char-in-string ?\\ ?/ file-name))) - (coding (or file-name-coding-system - default-file-name-coding-system))) + (coding (if (eq system-type 'windows-nt) + ;; Native w32 build pretends that its file names + ;; are encoded in UTF-8, and converts to the + ;; appropriate encoding internally. + 'utf-8 + (or file-name-coding-system + default-file-name-coding-system)))) (setq file-name (mapconcat 'url-hexify-string @@ -216,20 +221,49 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; the version we were compiled against. (If we were compiled ;; without PNG support, libpng-version's value is -1.) (if (>= libpng-version 10400) - ;; libpng14-14.dll is libpng 1.4.3 from GTK+ - '(png "libpng14-14.dll" "libpng14.dll") + (let ((major (/ libpng-version 10000)) + (minor (mod (/ libpng-version 100) 10))) + (list 'png + ;; libpngXY.dll is the default name when building + ;; with CMake or from a lpngXYY tarball on w32, + ;; libpngXY-XY.dll is the DLL name when building + ;; with libtool / autotools + (format "libpng%d%d.dll" major minor) + (format "libpng%d%d-%d%d.dll" major minor major minor))) '(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll" ;; these are libpng 1.2.8 from GTK+ "libpng13d.dll" "libpng13.dll")) - '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") - '(tiff "libtiff3.dll" "libtiff.dll") - '(gif "giflib4.dll" "libungif4.dll" "libungif.dll") + '(tiff "libtiff-5.dll" "libtiff3.dll" "libtiff.dll") + (if (> libjpeg-version 62) + ;; Versions of libjpeg after 6b are incompatible with + ;; earlier versions, and each of versions 7, 8, and 9 is + ;; also incompatible with the preceding ones (the core data + ;; structures used for communications with the library + ;; gained additional members with each new version). So we + ;; must use only the version of the library which Emacs was + ;; compiled against. + (list 'jpeg (format "libjpeg-%d.dll" (/ libjpeg-version 10))) + '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")) + ;; Versions of giflib 5.0.0 and later changed signatures of + ;; several functions used by Emacs, which makes those versions + ;; incompatible with previous ones. We select the correct + ;; libraries according to the version of giflib we were + ;; compiled against. (If we were compiled without GIF support, + ;; libgif-version's value is -1.) + (if (>= libgif-version 50000) + ;; Yes, giflib 5.x uses 6 as the major version of the API, + ;; thus "libgif-6.dll" below (giflib 4.x used 5 as the + ;; major API version). + ;; giflib5.dll is from the lua-files project. + '(gif "libgif-6.dll" "giflib5.dll") + '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")) '(svg "librsvg-2-2.dll") '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") '(glib "libglib-2.0-0.dll") '(gobject "libgobject-2.0-0.dll") '(gnutls "libgnutls-28.dll" "libgnutls-26.dll") - '(libxml2 "libxml2-2.dll" "libxml2.dll"))) + '(libxml2 "libxml2-2.dll" "libxml2.dll") + '(zlib "zlib1.dll" "libz-1.dll"))) ;;; multi-tty support (defvar w32-initialized nil @@ -237,6 +271,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function x-open-connection "w32fns.c" (display &optional xrm-string must-succeed)) +(declare-function create-default-fontset "fontset" ()) (declare-function create-fontset-from-fontset-spec "fontset" (fontset-spec &optional style-variant noerror)) (declare-function create-fontset-from-x-resource "fontset" ()) @@ -246,7 +281,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function x-parse-geometry "frame.c" (string)) (defvar x-command-line-resources) -(defun w32-initialize-window-system () +(defun w32-initialize-window-system (&optional _display) "Initialize Emacs for W32 GUI frames." (cl-assert (not w32-initialized)) diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index 1a896eec4d6..96e234bbcf9 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -1,6 +1,6 @@ ;;; w32console.el -- Setup w32 console keys and colors. -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals @@ -47,6 +47,8 @@ (declare-function x-setup-function-keys "term/common-win" (frame)) (declare-function get-screen-color "w32console.c" ()) +(declare-function w32-get-console-codepage "w32proc.c" ()) +(declare-function w32-get-console-output-codepage "w32proc.c" ()) (defun terminal-init-w32console () "Terminal initialization function for w32 console." diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index b7f044ad0c5..a894801f985 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -1,6 +1,6 @@ ;;; wyse50.el --- terminal support code for Wyse 50 -;; Copyright (C) 1989, 1993-1994, 2001-2013 Free Software Foundation, +;; Copyright (C) 1989, 1993-1994, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Daniel Pfeiffer , diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 63ef2b402b0..6ba348d8c79 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,6 +1,6 @@ ;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals, i18n @@ -87,7 +87,7 @@ (defvar x-session-id) (defvar x-session-previous-id) -(defun x-handle-no-bitmap-icon (switch) +(defun x-handle-no-bitmap-icon (_switch) (setq default-frame-alist (cons '(icon-type) default-frame-alist))) ;; Handle the --parent-id option. @@ -118,13 +118,11 @@ See also `emacs-session-save'.") (defun emacs-session-filename (session-id) "Construct a filename to save the session in based on SESSION-ID. -If the directory ~/.emacs.d exists, we make a filename in there, otherwise -a file in the home directory." - (let ((basename (concat "session." session-id)) - (emacs-dir user-emacs-directory)) - (expand-file-name (if (file-directory-p emacs-dir) - (concat emacs-dir basename) - (concat "~/.emacs-" basename))))) +Return a filename in `user-emacs-directory', unless the session file +already exists in the home directory." + (let ((basename (concat "session." session-id))) + (locate-user-emacs-file basename + (concat ".emacs-" basename)))) (defun emacs-session-save () "This function is called when the window system is shutting down. @@ -427,7 +425,9 @@ as returned by `x-server-vendor'." (#x3fe . ?,D~(B) ;; Kana: Fixme: needs conversion to Japanese charset -- seems ;; to require jisx0213, for which the Unicode translation - ;; isn't clear. + ;; isn't clear. Using Emacs to convert this to Unicode and back changes + ;; this from "(J~(B" (i.e., bytes "ESC ( J ~ ESC ( B") to "$(G"#(B" (i.e., bytes + ;; "ESC $ ( G " # ESC ( B"). (#x47e . ?(J~(B) (#x4a1 . ?$A!#(B) (#x4a2 . ?\$A!8(B) @@ -1127,6 +1127,9 @@ as returned by `x-server-vendor'." (#x20a8 . ?$,1tH(B) (#x20aa . ?$,1tJ(B) (#x20ab . ?$,1tK(B) + ;; Kana: Fixme: needs checking. Using Emacs to convert this to Unicode + ;; and back changes this from ",b$(B" (i.e., bytes "ESC , b $ ESC ( B") to + ;; ",F$(B" (i.e., bytes "ESC , F $ ESC ( B"). (#x20ac . ?,b$(B))) (puthash (car pair) (cdr pair) x-keysym-table)) @@ -1214,6 +1217,8 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." (remove-text-properties 0 (length text) '(foreign-selection nil) text)) text)) +(defvar x-select-enable-clipboard) ; common-win + ;; Return the value of the current X selection. ;; Consult the selection. Treat empty strings as if they were unset. ;; If this function is called twice and finds the same text, @@ -1338,7 +1343,7 @@ Request data types in the order specified by `x-select-request-type'." (defvar x-display-name) (defvar x-command-line-resources) -(defun x-initialize-window-system () +(defun x-initialize-window-system (&optional display) "Initialize Emacs for X frames and open the first connection to an X server." (cl-assert (not x-initialized)) @@ -1352,7 +1357,7 @@ Request data types in the order specified by `x-select-request-type'." (while (setq i (string-match "[.*]" x-resource-name)) (aset x-resource-name i ?-)))) - (x-open-connection (or x-display-name + (x-open-connection (or display (setq x-display-name (or (getenv "DISPLAY" (selected-frame)) (getenv "DISPLAY")))) x-command-line-resources @@ -1590,6 +1595,8 @@ This uses `icon-map-list' to map icon file names to stock icon names." (and value (cdr value)))) x-gtk-stock-cache)))) +(global-set-key [XF86WakeUp] 'ignore) + (provide 'x-win) ;;; x-win.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index c03d64a2f54..eac40141979 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -1,6 +1,6 @@ -;;; xterm.el --- define function key sequences and standard colors for xterm +;;; xterm.el --- define function key sequences and standard colors for xterm -*- lexical-binding: t -*- -;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals @@ -27,7 +27,7 @@ (defgroup xterm nil "XTerm support." :version "24.1" - :group 'environment) + :group 'terminals) (defcustom xterm-extra-capabilities 'check "Whether Xterm supports some additional, more modern, features. @@ -37,8 +37,7 @@ If a list, assume that the listed features are supported, without checking. The relevant features are: modifyOtherKeys -- if supported, more key bindings work (e.g., \"\\C-,\") - reportBackground -- if supported, Xterm reports its background color -" + reportBackground -- if supported, Xterm reports its background color" :version "24.1" :group 'xterm :type '(choice (const :tag "No" nil) @@ -251,120 +250,124 @@ The relevant features are: ;; These keys are available in xterm starting from version 216 ;; if the modifyOtherKeys resource is set to 1. + (dolist (bind '((5 9 [C-tab]) + (5 13 [C-return]) + (5 39 [?\C-\']) + (5 44 [?\C-,]) + (5 45 [?\C--]) + (5 46 [?\C-.]) + (5 47 [?\C-/]) + (5 48 [?\C-0]) + (5 49 [?\C-1]) + ;; Not all C-DIGIT keys have a distinct binding. + (5 57 [?\C-9]) + (5 59 [?\C-\;]) + (5 61 [?\C-=]) + (5 92 [?\C-\\]) - (define-key map "\e[27;5;9~" [C-tab]) - (define-key map "\e[27;5;13~" [C-return]) - (define-key map "\e[27;5;39~" [?\C-\']) - (define-key map "\e[27;5;44~" [?\C-,]) - (define-key map "\e[27;5;45~" [?\C--]) - (define-key map "\e[27;5;46~" [?\C-.]) - (define-key map "\e[27;5;47~" [?\C-/]) - (define-key map "\e[27;5;48~" [?\C-0]) - (define-key map "\e[27;5;49~" [?\C-1]) - ;; Not all C-DIGIT keys have a distinct binding. - (define-key map "\e[27;5;57~" [?\C-9]) - (define-key map "\e[27;5;59~" [?\C-\;]) - (define-key map "\e[27;5;61~" [?\C-=]) - (define-key map "\e[27;5;92~" [?\C-\\]) + (6 33 [?\C-!]) + (6 34 [?\C-\"]) + (6 35 [?\C-#]) + (6 36 [?\C-$]) + (6 37 [?\C-%]) + (6 38 [?\C-&]) + (6 40 [?\C-\(]) + (6 41 [?\C-\)]) + (6 42 [?\C-*]) + (6 43 [?\C-+]) + (6 58 [?\C-:]) + (6 60 [?\C-<]) + (6 62 [?\C->]) + (6 63 [(control ??)]) - (define-key map "\e[27;6;33~" [?\C-!]) - (define-key map "\e[27;6;34~" [?\C-\"]) - (define-key map "\e[27;6;35~" [?\C-#]) - (define-key map "\e[27;6;36~" [?\C-$]) - (define-key map "\e[27;6;37~" [?\C-%]) - (define-key map "\e[27;6;38~" [?\C-&]) - (define-key map "\e[27;6;40~" [?\C-(]) - (define-key map "\e[27;6;41~" [?\C-)]) - (define-key map "\e[27;6;42~" [?\C-*]) - (define-key map "\e[27;6;43~" [?\C-+]) - (define-key map "\e[27;6;58~" [?\C-:]) - (define-key map "\e[27;6;60~" [?\C-<]) - (define-key map "\e[27;6;62~" [?\C->]) - (define-key map "\e[27;6;63~" [(control ??)]) + ;; These are the strings emitted for various C-M- + ;; combinations for keyboards whose Meta and Alt + ;; modifiers are on the same key (usually labeled "Alt"). + (13 9 [C-M-tab]) + (13 13 [C-M-return]) - ;; These are the strings emitted for various C-M- combinations - ;; for keyboards that the Meta and Alt modifiers are on the same - ;; key (usually labeled "Alt"). - (define-key map "\e[27;13;9~" [C-M-tab]) - (define-key map "\e[27;13;13~" [C-M-return]) + (13 39 [?\C-\M-\']) + (13 44 [?\C-\M-,]) + (13 45 [?\C-\M--]) + (13 46 [?\C-\M-.]) + (13 47 [?\C-\M-/]) + (13 48 [?\C-\M-0]) + (13 49 [?\C-\M-1]) + (13 50 [?\C-\M-2]) + (13 51 [?\C-\M-3]) + (13 52 [?\C-\M-4]) + (13 53 [?\C-\M-5]) + (13 54 [?\C-\M-6]) + (13 55 [?\C-\M-7]) + (13 56 [?\C-\M-8]) + (13 57 [?\C-\M-9]) + (13 59 [?\C-\M-\;]) + (13 61 [?\C-\M-=]) + (13 92 [?\C-\M-\\]) - (define-key map "\e[27;13;39~" [?\C-\M-\']) - (define-key map "\e[27;13;44~" [?\C-\M-,]) - (define-key map "\e[27;13;45~" [?\C-\M--]) - (define-key map "\e[27;13;46~" [?\C-\M-.]) - (define-key map "\e[27;13;47~" [?\C-\M-/]) - (define-key map "\e[27;13;48~" [?\C-\M-0]) - (define-key map "\e[27;13;49~" [?\C-\M-1]) - (define-key map "\e[27;13;50~" [?\C-\M-2]) - (define-key map "\e[27;13;51~" [?\C-\M-3]) - (define-key map "\e[27;13;52~" [?\C-\M-4]) - (define-key map "\e[27;13;53~" [?\C-\M-5]) - (define-key map "\e[27;13;54~" [?\C-\M-6]) - (define-key map "\e[27;13;55~" [?\C-\M-7]) - (define-key map "\e[27;13;56~" [?\C-\M-8]) - (define-key map "\e[27;13;57~" [?\C-\M-9]) - (define-key map "\e[27;13;59~" [?\C-\M-\;]) - (define-key map "\e[27;13;61~" [?\C-\M-=]) - (define-key map "\e[27;13;92~" [?\C-\M-\\]) + (14 33 [?\C-\M-!]) + (14 34 [?\C-\M-\"]) + (14 35 [?\C-\M-#]) + (14 36 [?\C-\M-$]) + (14 37 [?\C-\M-%]) + (14 38 [?\C-\M-&]) + (14 40 [?\C-\M-\(]) + (14 41 [?\C-\M-\)]) + (14 42 [?\C-\M-*]) + (14 43 [?\C-\M-+]) + (14 58 [?\C-\M-:]) + (14 60 [?\C-\M-<]) + (14 62 [?\C-\M->]) + (14 63 [(control meta ??)]) - (define-key map "\e[27;14;33~" [?\C-\M-!]) - (define-key map "\e[27;14;34~" [?\C-\M-\"]) - (define-key map "\e[27;14;35~" [?\C-\M-#]) - (define-key map "\e[27;14;36~" [?\C-\M-$]) - (define-key map "\e[27;14;37~" [?\C-\M-%]) - (define-key map "\e[27;14;38~" [?\C-\M-&]) - (define-key map "\e[27;14;40~" [?\C-\M-\(]) - (define-key map "\e[27;14;41~" [?\C-\M-\)]) - (define-key map "\e[27;14;42~" [?\C-\M-*]) - (define-key map "\e[27;14;43~" [?\C-\M-+]) - (define-key map "\e[27;14;58~" [?\C-\M-:]) - (define-key map "\e[27;14;60~" [?\C-\M-<]) - (define-key map "\e[27;14;62~" [?\C-\M->]) - (define-key map "\e[27;14;63~" [(control meta ??)]) + (7 9 [C-M-tab]) + (7 13 [C-M-return]) - (define-key map "\e[27;7;9~" [C-M-tab]) - (define-key map "\e[27;7;13~" [C-M-return]) + (7 32 [?\C-\M-\s]) + (7 39 [?\C-\M-\']) + (7 44 [?\C-\M-,]) + (7 45 [?\C-\M--]) + (7 46 [?\C-\M-.]) + (7 47 [?\C-\M-/]) + (7 48 [?\C-\M-0]) + (7 49 [?\C-\M-1]) + (7 50 [?\C-\M-2]) + (7 51 [?\C-\M-3]) + (7 52 [?\C-\M-4]) + (7 53 [?\C-\M-5]) + (7 54 [?\C-\M-6]) + (7 55 [?\C-\M-7]) + (7 56 [?\C-\M-8]) + (7 57 [?\C-\M-9]) + (7 59 [?\C-\M-\;]) + (7 61 [?\C-\M-=]) + (7 92 [?\C-\M-\\]) - (define-key map "\e[27;7;32~" [?\C-\M-\s]) - (define-key map "\e[27;7;39~" [?\C-\M-\']) - (define-key map "\e[27;7;44~" [?\C-\M-,]) - (define-key map "\e[27;7;45~" [?\C-\M--]) - (define-key map "\e[27;7;46~" [?\C-\M-.]) - (define-key map "\e[27;7;47~" [?\C-\M-/]) - (define-key map "\e[27;7;48~" [?\C-\M-0]) - (define-key map "\e[27;7;49~" [?\C-\M-1]) - (define-key map "\e[27;7;50~" [?\C-\M-2]) - (define-key map "\e[27;7;51~" [?\C-\M-3]) - (define-key map "\e[27;7;52~" [?\C-\M-4]) - (define-key map "\e[27;7;53~" [?\C-\M-5]) - (define-key map "\e[27;7;54~" [?\C-\M-6]) - (define-key map "\e[27;7;55~" [?\C-\M-7]) - (define-key map "\e[27;7;56~" [?\C-\M-8]) - (define-key map "\e[27;7;57~" [?\C-\M-9]) - (define-key map "\e[27;7;59~" [?\C-\M-\;]) - (define-key map "\e[27;7;61~" [?\C-\M-=]) - (define-key map "\e[27;7;92~" [?\C-\M-\\]) + (8 33 [?\C-\M-!]) + (8 34 [?\C-\M-\"]) + (8 35 [?\C-\M-#]) + (8 36 [?\C-\M-$]) + (8 37 [?\C-\M-%]) + (8 38 [?\C-\M-&]) + (8 40 [?\C-\M-\(]) + (8 41 [?\C-\M-\)]) + (8 42 [?\C-\M-*]) + (8 43 [?\C-\M-+]) + (8 58 [?\C-\M-:]) + (8 60 [?\C-\M-<]) + (8 62 [?\C-\M->]) + (8 63 [(control meta ??)]) - (define-key map "\e[27;8;33~" [?\C-\M-!]) - (define-key map "\e[27;8;34~" [?\C-\M-\"]) - (define-key map "\e[27;8;35~" [?\C-\M-#]) - (define-key map "\e[27;8;36~" [?\C-\M-$]) - (define-key map "\e[27;8;37~" [?\C-\M-%]) - (define-key map "\e[27;8;38~" [?\C-\M-&]) - (define-key map "\e[27;8;40~" [?\C-\M-\(]) - (define-key map "\e[27;8;41~" [?\C-\M-\)]) - (define-key map "\e[27;8;42~" [?\C-\M-*]) - (define-key map "\e[27;8;43~" [?\C-\M-+]) - (define-key map "\e[27;8;58~" [?\C-\M-:]) - (define-key map "\e[27;8;60~" [?\C-\M-<]) - (define-key map "\e[27;8;62~" [?\C-\M->]) - (define-key map "\e[27;8;63~" [(control meta ??)]) + (2 9 [S-tab]) + (2 13 [S-return]) - (define-key map "\e[27;2;9~" [S-tab]) - (define-key map "\e[27;2;13~" [S-return]) - - (define-key map "\e[27;6;9~" [C-S-tab]) - (define-key map "\e[27;6;13~" [C-S-return]) + (6 9 [C-S-tab]) + (6 13 [C-S-return]))) + (define-key map + (format "\e[27;%d;%d~" (nth 0 bind) (nth 1 bind)) (nth 2 bind)) + ;; For formatOtherKeys=1, the sequence is a bit shorter (bug#13839). + (define-key map + (format "\e[%d;%du" (nth 1 bind) (nth 0 bind)) (nth 2 bind))) ;; Other versions of xterm might emit these. (define-key map "\e[A" [up]) @@ -463,6 +466,94 @@ The relevant features are: ;; List of terminals for which modify-other-keys has been turned on. (defvar xterm-modify-other-keys-terminal-list nil) +(defun xterm--report-background-handler () + (let ((str "") + chr) + ;; The reply should be: \e ] 11 ; rgb: NUMBER1 / NUMBER2 / NUMBER3 \e \\ + (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?\\))) + (setq str (concat str (string chr)))) + (when (string-match + "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str) + (let ((recompute-faces + (xterm-maybe-set-dark-background-mode + (string-to-number (match-string 1 str) 16) + (string-to-number (match-string 2 str) 16) + (string-to-number (match-string 3 str) 16)))) + + ;; Recompute faces here in case the background mode was + ;; set to dark. We used to call + ;; `tty-set-up-initial-frame-faces' only once, but that + ;; caused the light background faces to be computed + ;; incorrectly. See: + ;; http://permalink.gmane.org/gmane.emacs.devel/119627 + (when recompute-faces + (tty-set-up-initial-frame-faces)))))) + +(defun xterm--version-handler () + (let ((str "") + chr) + ;; The reply should be: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c + ;; If the timeout is completely removed for read-event, this + ;; might hang for terminals that pretend to be xterm, but don't + ;; respond to this escape sequence. RMS' opinion was to remove + ;; it completely. That might be right, but let's first try to + ;; see if by using a longer timeout we get rid of most issues. + (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?c))) + (setq str (concat str (string chr)))) + ;; Since xterm-280, the terminal type (NUMBER1) is now 41 instead of 0. + (when (string-match "\\([0-9]+\\);\\([0-9]+\\);0" str) + (let ((version (string-to-number (match-string 2 str)))) + ;; If version is 242 or higher, assume the xterm supports + ;; reporting the background color (TODO: maybe earlier + ;; versions do too...) + (when (>= version 242) + (xterm--query "\e]11;?\e\\" + '(("\e]11;" . xterm--report-background-handler)))) + + ;; If version is 216 (the version when modifyOtherKeys was + ;; introduced) or higher, initialize the + ;; modifyOtherKeys support. + (when (>= version 216) + (terminal-init-xterm-modify-other-keys)))))) + +(defun xterm--query (query handlers) + "Send QUERY string to the terminal and watch for a response. +HANDLERS is an alist with elements of the form (STRING . FUNCTION). +We run the first FUNCTION whose STRING matches the input events." + ;; We used to query synchronously, but the need to use `discard-input' is + ;; rather annoying (bug#6758). Maybe we could always use the asynchronous + ;; approach, but it's less tested. + ;; FIXME: Merge the two branches. + (if (input-pending-p) + (progn + (dolist (handler handlers) + (define-key input-decode-map (car handler) + (lambda (&optional _prompt) + ;; Unregister the handler, since we don't expect further answers. + (dolist (handler handlers) + (define-key input-decode-map (car handler) nil)) + (funcall (cdr handler)) + []))) + (send-string-to-terminal query)) + ;; Pending input can be mistakenly returned by the calls to + ;; read-event below. Discard it. + (send-string-to-terminal query) + (while handlers + (let ((handler (pop handlers)) + (i 0)) + (while (and (< i (length (car handler))) + (let ((evt (read-event nil nil 2))) + (or (eq evt (aref (car handler) i)) + (progn (if evt (push evt unread-command-events)) + nil)))) + (setq i (1+ i))) + (if (= i (length (car handler))) + (progn (setq handlers nil) + (funcall (cdr handler))) + (while (> i 0) + (push (aref (car handler) (setq i (1- i))) + unread-command-events))))))) + (defun terminal-init-xterm () "Terminal initialization function for xterm." ;; rxvt terminals sometimes set the TERM variable to "xterm", but @@ -487,92 +578,24 @@ The relevant features are: (xterm-register-default-colors) (tty-set-up-initial-frame-faces) - ;; Try to turn on the modifyOtherKeys feature on modern xterms. - ;; When it is turned on many more key bindings work: things like - ;; C-. C-, etc. - ;; To do that we need to find out if the current terminal supports - ;; modifyOtherKeys. At this time only xterm does. - (when xterm-extra-capabilities - (let ((coding-system-for-read 'binary) - (chr nil) - (str "") - (recompute-faces nil) - ;; If `xterm-extra-capabilities' is 'check, we don't know - ;; the capabilities. We need to check for those defined - ;; as `xterm-extra-capabilities' set options. Otherwise, - ;; we don't need to check for any capabilities because - ;; they are given by setting `xterm-extra-capabilities' to - ;; a list (which could be empty). - (tocheck-capabilities (if (eq 'check xterm-extra-capabilities) - '(modifyOtherKeys reportBackground))) - ;; The given capabilities are either the contents of - ;; `xterm-extra-capabilities', if it's a list, or an empty list. - (given-capabilities (if (consp xterm-extra-capabilities) - xterm-extra-capabilities)) - version) - ;; 1. Set `version' - - ;; Pending input can be mistakenly returned by the calls to - ;; read-event below. Discard it. - (discard-input) + (if (eq xterm-extra-capabilities 'check) ;; Try to find out the type of terminal by sending a "Secondary ;; Device Attributes (DA)" query. - (send-string-to-terminal "\e[>0c") + (xterm--query "\e[>0c" + ;; Some terminals (like OS X's Terminal.app) respond to + ;; this query as if it were a "Primary Device Attributes" + ;; query instead, so we should handle that too. + '(("\e[?" . xterm--version-handler) + ("\e[>" . xterm--version-handler))) - ;; The reply should be: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c - ;; If the timeout is completely removed for read-event, this - ;; might hang for terminals that pretend to be xterm, but don't - ;; respond to this escape sequence. RMS' opinion was to remove - ;; it completely. That might be right, but let's first try to - ;; see if by using a longer timeout we get rid of most issues. - (when (and (equal (read-event nil nil 2) ?\e) - (equal (read-event nil nil 2) ?\[)) - (while (not (equal (setq chr (read-event nil nil 2)) ?c)) - (setq str (concat str (string chr)))) - (if (string-match ">0;\\([0-9]+\\);0" str) - (setq version (string-to-number (match-string 1 str))))) - ;; 2. If reportBackground is known to be supported, or the - ;; version is 242 or higher, assume the xterm supports - ;; reporting the background color (TODO: maybe earlier - ;; versions do too...) - (when (or (memq 'reportBackground given-capabilities) - (and (memq 'reportBackground tocheck-capabilities) - version - (>= version 242))) - (discard-input) - (send-string-to-terminal "\e]11;?\e\\") - (when (and (equal (read-event nil nil 2) ?\e) - (equal (read-event nil nil 2) ?\])) - (setq str "") - (while (not (equal (setq chr (read-event nil nil 2)) ?\\)) - (setq str (concat str (string chr)))) - (if (string-match - "11;rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str) - (setq recompute-faces - (xterm-maybe-set-dark-background-mode - (string-to-number (match-string 1 str) 16) - (string-to-number (match-string 2 str) 16) - (string-to-number (match-string 3 str) 16)))))) + (when (memq 'reportBackground xterm-extra-capabilities) + (xterm--query "\e]11;?\e\\" + '(("\e]11;" . xterm--report-background-handler)))) - ;; 3. If modifyOtherKeys is known to be supported or the - ;; version is 216 (the version when modifyOtherKeys was - ;; introduced) or higher, initialize the modifyOtherKeys support. - (if (or (memq 'modifyOtherKeys given-capabilities) - (and (memq 'modifyOtherKeys tocheck-capabilities) - version - (>= version 216))) - (terminal-init-xterm-modify-other-keys)) + (when (memq 'modifyOtherKeys xterm-extra-capabilities) + (terminal-init-xterm-modify-other-keys))) - ;; Recompute faces here in case the background mode was - ;; set to dark. We used to call - ;; `tty-set-up-initial-frame-faces' only once, but that - ;; caused the light background faces to be computed - ;; incorrectly. See: - ;; http://permalink.gmane.org/gmane.emacs.devel/119627 - (when recompute-faces - (tty-set-up-initial-frame-faces)))) - - (run-hooks 'terminal-init-xterm-hook)) + (run-hooks 'terminal-init-xterm-hook)) (defun terminal-init-xterm-modify-other-keys () "Terminal initialization for xterm's modifyOtherKeys support." @@ -584,7 +607,7 @@ The relevant features are: (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys) ;; Add the selected frame to the list of frames that ;; need to deal with modify-other-keys. - (push (frame-terminal (selected-frame)) + (push (frame-terminal) xterm-modify-other-keys-terminal-list) (xterm-turn-on-modify-other-keys)) @@ -706,7 +729,7 @@ versions of xterm." (defun xterm-turn-on-modify-other-keys () "Turn the modifyOtherKeys feature of xterm back on." - (let ((terminal (frame-terminal (selected-frame)))) + (let ((terminal (frame-terminal))) (when (and (terminal-live-p terminal) (memq terminal xterm-modify-other-keys-terminal-list)) (send-string-to-terminal "\e[>4;1m" terminal)))) @@ -720,7 +743,7 @@ versions of xterm." (defun xterm-remove-modify-other-keys (&optional terminal) "Turn off the modifyOtherKeys feature of xterm for good." - (setq terminal (or terminal (frame-terminal (selected-frame)))) + (setq terminal (or terminal (frame-terminal))) (when (and (terminal-live-p terminal) (memq terminal xterm-modify-other-keys-terminal-list)) (setq xterm-modify-other-keys-terminal-list @@ -734,4 +757,6 @@ versions of xterm." (set-terminal-parameter nil 'background-mode 'dark) t)) +(provide 'xterm) + ;;; xterm.el ends here diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 2bd7283676e..36d056a690c 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1,6 +1,6 @@ ;;; artist.el --- draw ascii graphics with your mouse -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Tomas Abrahamsson ;; Maintainer: Tomas Abrahamsson @@ -1449,6 +1449,8 @@ Keymap summary (message ""))) (artist-mode-line-show-curr-operation artist-key-is-drawing)) +(declare-function picture-mode-exit "picture" (&optional nostrip)) + (defun artist-mode-exit () "Exit Artist mode. This will call the hook `artist-mode-hook'." (if (and artist-picture-compatibility (eq major-mode 'picture-mode)) diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 5ef263542fe..84fa231ca95 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -1,10 +1,10 @@ ;;; bib-mode.el --- major mode for editing bib files -;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989, 2001-2014 Free Software Foundation, Inc. ;; Author: Henry Kautz ;; (according to authors.el) -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: bib ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el index 77b135de009..ab108a2c247 100644 --- a/lisp/textmodes/bibtex-style.el +++ b/lisp/textmodes/bibtex-style.el @@ -1,6 +1,6 @@ ;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*- -;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: tex diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index aa20b739946..ebb22d6f055 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1,6 +1,6 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994-1999, 2001-2013 Free Software Foundation, +;; Copyright (C) 1992, 1994-1999, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Stefan Schoef @@ -468,7 +468,7 @@ alternatives, starting from zero." nil (("editor") ("editora") ("editorb") ("editorc") ("translator") ("annotator") ("commentator") - ("introduction") ("foreword") ("afterword") ("titleaddon") + ("introduction") ("foreword") ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") ("maintitleaddon") ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") ("series") ("number") ("note") ("publisher") ("location") ("isbn") @@ -1224,7 +1224,10 @@ Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'." (function :tag "Personalized function"))) (defcustom bibtex-generate-url-list - '((("url" . ".*:.*"))) + '((("url" . ".*:.*")) + (("doi" . "10\\.[0-9]+/.+") + "http://dx.doi.org/%s" + ("doi" ".*" 0))) "List of schemes for generating the URL of a BibTeX entry. These schemes are used by `bibtex-url'. @@ -1261,6 +1264,7 @@ The following is a complex example, see URL `http://link.aps.org/'. (\"volume\" \".*\" 0) (\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))" :group 'bibtex + :version "24.4" :type '(repeat (cons :tag "Scheme" (cons :tag "Matcher" :extra-offset 4 @@ -3020,11 +3024,14 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'." Visit the BibTeX files defined by `bibtex-files' and return a list of corresponding buffers. Initialize in these buffers `bibtex-reference-keys' if not yet set. -List of BibTeX buffers includes current buffer if CURRENT is non-nil. +List of BibTeX buffers includes current buffer if CURRENT is non-nil +and the current buffer visits a file using `bibtex-mode'. If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if already set. If SELECT is non-nil interactively select a BibTeX buffer. -When called interactively, FORCE is t, CURRENT is t if current buffer uses -`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode'," + +When called interactively, FORCE is t, CURRENT is t if current buffer +visits a file using `bibtex-mode', and SELECT is t if current buffer +does not use `bibtex-mode'," (interactive (list (eq major-mode 'bibtex-mode) t (not (eq major-mode 'bibtex-mode)))) (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) @@ -3062,10 +3069,12 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses (if (file-readable-p file) (push (find-file-noselect file) buffer-list))) ;; Include current buffer iff we want it. - ;; Exclude current buffer if it doesn't use `bibtex-mode'. - ;; Thus calling `bibtex-initialize' gives meaningful results for - ;; any current buffer. - (unless (and current (eq major-mode 'bibtex-mode)) (setq current nil)) + ;; Exclude current buffer if it does not visit a file using `bibtex-mode'. + ;; This way we exclude BibTeX buffers such as `bibtex-search-buffer' + ;; that are not visiting a BibTeX file. Also, calling `bibtex-initialize' + ;; gives meaningful results for any current buffer. + (unless (and current (eq major-mode 'bibtex-mode) buffer-file-name) + (setq current nil)) (cond ((and current (not (memq (current-buffer) buffer-list))) (push (current-buffer) buffer-list)) ((and (not current) (memq (current-buffer) buffer-list)) @@ -3395,9 +3404,6 @@ if that value is non-nil. (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-via-font-lock bibtex-font-lock-syntactic-keywords)) - (setq imenu-generic-expression - (list (list nil bibtex-entry-head bibtex-key-in-head)) - imenu-case-fold-search t) ;; Allow `bibtex-dialect' as a file-local variable. (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t)) @@ -3474,7 +3480,10 @@ LOCAL is t for interactive calls." (concat "^[ \t]*@[ \t]*\\(?:" (regexp-opt (append '("String" "Preamble") - (mapcar 'car bibtex-entry-alist))) "\\)")))) + (mapcar 'car bibtex-entry-alist))) "\\)")) + (setq imenu-generic-expression + (list (list nil bibtex-entry-head bibtex-key-in-head)) + imenu-case-fold-search t))) ;; Entry commands and menus for BibTeX dialects ;; We do not use `easy-menu-define' here because this gets confused @@ -5163,6 +5172,9 @@ Return the URL or nil if none can be generated." (if (stringp (car scheme)) (setq fmt (pop scheme))) (dolist (step scheme) + ;; In the first STEP, if the field contains multiple + ;; matches, we want the match the closest to point. + ;; (if (eq step (car scheme)) (setq text (cdr (assoc-string (car step) fields-alist t))) (if (string-match (nth 1 step) text) (push (cond ((functionp (nth 2 step)) @@ -5233,19 +5245,22 @@ where FILE is the BibTeX file of ENTRY." (if (string= "" field) ;; Unrestricted search. (while (re-search-forward regexp nil t) - (let ((beg (bibtex-beginning-of-entry)) - (end (bibtex-end-of-entry)) - key) - (if (and (<= beg (match-beginning 0)) - (<= (match-end 0) end) - (save-excursion - (goto-char beg) - (and (looking-at bibtex-entry-head) - (setq key (bibtex-key-in-head)))) - (not (assoc key entries))) - (push (list key file - (buffer-substring-no-properties beg end)) - entries)))) + (save-excursion + (let ((mbeg (match-beginning 0)) + (mend (match-end 0)) + (beg (bibtex-beginning-of-entry)) + (end (bibtex-end-of-entry)) + key) + (if (and (<= beg mbeg) + (<= mend end) + (progn + (goto-char beg) + (looking-at bibtex-entry-head)) + (setq key (bibtex-key-in-head)) + (not (assoc key entries))) + (push (list key file + (buffer-substring-no-properties beg end)) + entries))))) ;; The following is slow. But it works reliably even in more ;; complicated cases with BibTeX string constants and crossrefed ;; entries. If you prefer speed over reliability, perform an diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 93ff179229b..7a5bc8afeea 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -1,6 +1,6 @@ -;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files +;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files -*- coding: utf-8 -*- -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer ;; Keywords: conf ini windows java @@ -23,7 +23,7 @@ ;;; Commentary: ;; ;; This mode is designed to edit many similar varieties of Conf/Ini files and -;; Java properties. It started out from Aurlien Tisn's ini-mode. +;; Java properties. It started out from Aurélien Tisné's ini-mode. ;; `conf-space-keywords' were inspired by Robert Fitzgerald's any-ini-mode. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index cb19c018839..dbb4988501f 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1,6 +1,6 @@ ;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: hypermedia @@ -263,6 +263,49 @@ (defvar css-font-lock-defaults '(css-font-lock-keywords nil t)) +(defcustom css-indent-offset 4 + "Basic size of one indentation step." + :version "22.2" + :type 'integer) + +(require 'smie) + +(defconst css-smie-grammar + (smie-prec2->grammar + (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) + +(defun css-smie--forward-token () + (cond + ((and (eq (char-before) ?\}) + ;; FIXME: If the next char is not whitespace, what should we do? + (or (memq (char-after) '(?\s ?\t ?\n)) + (looking-at comment-start-skip))) + (if (memq (char-after) '(?\s ?\t ?\n)) + (forward-char 1) (forward-comment 1)) + ";") + ((progn (forward-comment (point-max)) + (looking-at "[;,:]")) + (forward-char 1) (match-string 0)) + (t (smie-default-forward-token)))) + +(defun css-smie--backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ;; FIXME: If the next char is not whitespace, what should we do? + ((and (eq (char-before) ?\}) (> pos (point))) ";") + ((memq (char-before) '(?\; ?\, ?\:)) + (forward-char -1) (string (char-after))) + (t (smie-default-backward-token))))) + +(defun css-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) css-indent-offset) + (`(:elem . arg) 0) + (`(:list-intro . ,(or `";" `"")) t) ;"" stands for BOB (bug#15467). + (`(:before . "{") (if (smie-rule-hanging-p) + (smie-rule-parent 0))))) + ;;;###autoload (define-derived-mode css-mode fundamental-mode "CSS" "Major mode to edit Cascading Style Sheets." @@ -271,17 +314,15 @@ (setq-local comment-start-skip "/\\*+[ \t]*") (setq-local comment-end "*/") (setq-local comment-end-skip "[ \t]*\\*+/") - (setq-local forward-sexp-function 'css-forward-sexp) (setq-local parse-sexp-ignore-comments t) (setq-local indent-line-function 'css-indent-line) (setq-local fill-paragraph-function 'css-fill-paragraph) (setq-local add-log-current-defun-function #'css-current-defun-name) - (when css-electric-keys - (let ((fc (make-char-table 'auto-fill-chars))) - (set-char-table-parent fc auto-fill-chars) - (dolist (c css-electric-keys) - (aset fc c 'indent-according-to-mode)) - (setq-local auto-fill-chars fc)))) + (smie-setup css-smie-grammar #'css-smie-rules + :forward-token #'css-smie--forward-token + :backward-token #'css-smie--backward-token) + (setq-local electric-indent-chars + (append css-electric-keys electric-indent-chars))) (defvar comment-continue) @@ -355,132 +396,6 @@ ;; Don't use the default filling code. t))))))) -;;; Navigation and indentation. - -(defconst css-navigation-syntax-table - (let ((st (make-syntax-table css-mode-syntax-table))) - (map-char-table (lambda (c v) - ;; Turn punctuation (code = 1) into symbol (code = 1). - (if (eq (car-safe v) 1) - (set-char-table-range st c (cons 3 (cdr v))))) - st) - st)) - -(defun css-backward-sexp (n) - (let ((forward-sexp-function nil)) - (if (< n 0) (css-forward-sexp (- n)) - (while (> n 0) - (setq n (1- n)) - (forward-comment (- (point-max))) - (if (not (eq (char-before) ?\;)) - (backward-sexp 1) - (while (progn (backward-sexp 1) - (save-excursion - (forward-comment (- (point-max))) - ;; FIXME: We should also skip punctuation. - (not (or (bobp) (memq (char-before) '(?\; ?\{)))))))))))) - -(defun css-forward-sexp (n) - (let ((forward-sexp-function nil)) - (if (< n 0) (css-backward-sexp (- n)) - (while (> n 0) - (setq n (1- n)) - (forward-comment (point-max)) - (if (not (eq (char-after) ?\;)) - (forward-sexp 1) - (while (progn (forward-sexp 1) - (save-excursion - (forward-comment (point-max)) - ;; FIXME: We should also skip punctuation. - (not (memq (char-after) '(?\; ?\}))))))))))) - -(defun css-indent-calculate-virtual () - (if (or (save-excursion (skip-chars-backward " \t") (bolp)) - (if (looking-at "\\s(") - (save-excursion - (forward-char 1) (skip-chars-forward " \t") - (not (or (eolp) (looking-at comment-start-skip)))))) - (current-column) - (css-indent-calculate))) - -(defcustom css-indent-offset 4 - "Basic size of one indentation step." - :version "22.2" - :type 'integer - :group 'css) - -(defun css-indent-calculate () - (let ((ppss (syntax-ppss)) - pos) - (with-syntax-table css-navigation-syntax-table - (save-excursion - (cond - ;; Inside a string. - ((nth 3 ppss) 'noindent) - ;; Inside a comment. - ((nth 4 ppss) - (setq pos (point)) - (forward-line -1) - (skip-chars-forward " \t") - (if (>= (nth 8 ppss) (point)) - (progn - (goto-char (nth 8 ppss)) - (if (eq (char-after pos) ?*) - (forward-char 1) - (if (not (looking-at comment-start-skip)) - (error "Internal css-mode error") - (goto-char (match-end 0)))) - (current-column)) - (if (and (eq (char-after pos) ?*) (eq (char-after) ?*)) - (current-column) - ;; 'noindent - (current-column) - ))) - ;; In normal code. - (t - (or - (when (looking-at "\\s)") - (forward-char 1) - (backward-sexp 1) - (css-indent-calculate-virtual)) - (when (looking-at comment-start-skip) - (forward-comment (point-max)) - (css-indent-calculate)) - (when (save-excursion (forward-comment (- (point-max))) - (setq pos (point)) - (eq (char-syntax (preceding-char)) ?\()) - (goto-char (1- pos)) - (if (not (looking-at "\\s([ \t]*")) - (error "Internal css-mode error") - (if (or (memq (char-after (match-end 0)) '(?\n nil)) - (save-excursion (goto-char (match-end 0)) - (looking-at comment-start-skip))) - (+ (css-indent-calculate-virtual) css-indent-offset) - (progn (goto-char (match-end 0)) (current-column))))) - (progn - (css-backward-sexp 1) - (if (looking-at "\\s(") - (css-indent-calculate) - (css-indent-calculate-virtual)))))))))) - - -(defun css-indent-line () - "Indent current line according to CSS indentation rules." - (interactive) - (let* ((savep (point)) - (forward-sexp-function nil) - (indent (condition-case nil - (save-excursion - (forward-line 0) - (skip-chars-forward " \t") - (if (>= (point) savep) (setq savep nil)) - (css-indent-calculate)) - (error nil)))) - (if (not (numberp indent)) 'noindent - (if savep - (save-excursion (indent-line-to indent)) - (indent-line-to indent))))) - (defun css-current-defun-name () "Return the name of the CSS section at point, or nil." (save-excursion diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index fe7ae17373c..1fe1ac6347e 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -1,6 +1,6 @@ ;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files -;; Copyright (C) 2000-2001, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: DNS master zone file SOA comm diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index e22ad24ccae..e9bf6a1ea2b 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -1,6 +1,6 @@ ;;; enriched.el --- read and save files in text/enriched format -;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1996, 2001-2014 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: wp, faces @@ -31,7 +31,7 @@ ;; are supported except for and , which are currently not ;; possible to display. -;; A separate file, enriched.doc, contains further documentation and other +;; A separate file, enriched.txt, contains further documentation and other ;; important information about this code. It also serves as an example ;; file in text/enriched format. It should be in the etc directory of your ;; emacs distribution. @@ -199,7 +199,7 @@ if ARG is omitted or nil. Turning the mode on or off runs `enriched-mode-hook'. More information about Enriched mode is available in the file -etc/enriched.doc in the Emacs distribution directory. +\"enriched.txt\" in `data-directory'. Commands: diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 5b6d5f359e6..7a5b1812a65 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1,9 +1,9 @@ ;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*- -;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2013 Free +;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2014 Free ;; Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp ;; Package: emacs @@ -220,7 +220,7 @@ Remove indentation from each line." (let ((str (or (and adaptive-fill-function (funcall adaptive-fill-function)) (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) - (match-string-no-properties 0))))) + (match-string 0))))) (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) ;; Death to insanely long prefixes. nil @@ -329,13 +329,24 @@ places." (and (memq (preceding-char) '(?\t ?\s)) (eq (char-syntax (following-char)) ?w))))))) +(defun fill-single-char-nobreak-p () + "Return non-nil if a one-letter word is before point. +This function is suitable for adding to the hook `fill-nobreak-predicate', +to prevent the breaking of a line just after a one-letter word, +which is an error according to some typographical conventions." + (save-excursion + (skip-chars-backward " \t") + (backward-char 2) + (looking-at "[[:space:]][[:alpha:]]"))) + (defcustom fill-nobreak-predicate nil "List of predicates for recognizing places not to break a line. The predicates are called with no arguments, with point at the place to be tested. If it returns t, fill commands do not break the line there." :group 'fill :type 'hook - :options '(fill-french-nobreak-p fill-single-word-nobreak-p)) + :options '(fill-french-nobreak-p fill-single-word-nobreak-p + fill-single-char-nobreak-p)) (defcustom fill-nobreak-invisible nil "Non-nil means that fill commands do not break lines in invisible text." diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 6ab3e3d3f16..4ea2f54000c 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1,9 +1,9 @@ ;;; flyspell.el --- on-the-fly spell checker -;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000-2014 Free Software Foundation, Inc. ;; Author: Manuel Serrano -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience ;; This file is part of GNU Emacs. @@ -283,6 +283,7 @@ If this variable is nil, all regions are treated as small." (defcustom flyspell-auto-correct-binding [(control ?\;)] "The key binding for flyspell auto correction." + :type 'key-sequence :group 'flyspell) ;;*---------------------------------------------------------------------*/ @@ -738,7 +739,7 @@ before the current command." (let ((ispell-otherchars (ispell-get-otherchars))) (cond ((not (and (numberp flyspell-pre-point) - (buffer-live-p flyspell-pre-buffer))) + (eq flyspell-pre-buffer (current-buffer)))) nil) ((and (eq flyspell-pre-pre-point flyspell-pre-point) (eq flyspell-pre-pre-buffer flyspell-pre-buffer)) @@ -956,11 +957,10 @@ Mostly we check word delimiters." ;; Prevent anything we do from affecting the mark. deactivate-mark) (if (flyspell-check-pre-word-p) - (with-current-buffer flyspell-pre-buffer + (save-excursion '(flyspell-debug-signal-pre-word-checked) - (save-excursion - (goto-char flyspell-pre-point) - (flyspell-word)))) + (goto-char flyspell-pre-point) + (flyspell-word))) (if (flyspell-check-word-p) (progn '(flyspell-debug-signal-word-checked) @@ -974,16 +974,14 @@ Mostly we check word delimiters." ;; FLYSPELL-CHECK-PRE-WORD-P (setq flyspell-pre-pre-buffer (current-buffer)) (setq flyspell-pre-pre-point (point))) - (progn - (setq flyspell-pre-pre-buffer nil) - (setq flyspell-pre-pre-point nil) - ;; when a word is not checked because of a delayed command - ;; we do not disable the ispell cache. - (if (and (symbolp this-command) + (setq flyspell-pre-pre-buffer nil) + (setq flyspell-pre-pre-point nil) + ;; when a word is not checked because of a delayed command + ;; we do not disable the ispell cache. + (when (and (symbolp this-command) (get this-command 'flyspell-delayed)) - (progn - (setq flyspell-word-cache-end -1) - (setq flyspell-word-cache-result '_))))) + (setq flyspell-word-cache-end -1) + (setq flyspell-word-cache-result '_))) (while (and (not (input-pending-p)) (consp flyspell-changes)) (let ((start (car (car flyspell-changes))) (stop (cdr (car flyspell-changes)))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 92e21c300c7..5cdae22cc0f 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,6 +1,6 @@ ;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 1997-2014 Free Software Foundation, Inc. ;; Author: Ken Stevens ;; Maintainer: Ken Stevens @@ -1157,7 +1157,7 @@ all uninitialized dicts using that affix file." (use-for-dicts (list dict)) (dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict))) newlist) - ;; Get a list of unitialized dicts using the same affix file. + ;; Get a list of uninitialized dicts using the same affix file. (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-equivs-alist) (let ((dict-equiv-key (car dict-equiv-alist-entry)) (dict-equiv-value (cadr dict-equiv-alist-entry))) @@ -1383,7 +1383,8 @@ aspell is used along with Emacs).") ;; Unless default dict, re-add "-d" option with the mapped value (if dict-name (if dict-equiv - (nconc ispell-args (list "-d" dict-equiv)) + (setq ispell-args + (nconc ispell-args (list "-d" dict-equiv))) (message "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping." dict-name) @@ -2217,7 +2218,7 @@ Global `ispell-quit' set to start location to continue spell session." (window-min-height (min window-min-height ispell-choices-win-default-height)) (command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m )) - (dedicated (window-dedicated-p (selected-window))) + (dedicated (window-dedicated-p)) (skipped 0) char num result textwin dedicated-win) @@ -2328,10 +2329,14 @@ Global `ispell-quit' set to start location to continue spell session." ((= char ?i) ; accept and insert word into pers dict (ispell-send-string (concat "*" word "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! + (and (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) (add-to-list 'ispell-buffer-session-localwords word) + (and (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict (setq ispell-buffer-local-name (buffer-name))) (if (null ispell-pdict-modified-p) @@ -2402,7 +2407,7 @@ Global `ispell-quit' set to start location to continue spell session." " -- word-list: " (or ispell-complete-word-dict ispell-alternate-dictionary)) - miss (lookup-words new-word) + miss (ispell-lookup-words new-word) choices miss line ispell-choices-win-default-height) (while (and choices ; adjust choices window. @@ -2608,8 +2613,9 @@ SPC: Accept word this time. (sit-for 5)) (erase-buffer))))))) +(define-obsolete-function-alias 'lookup-words 'ispell-lookup-words "24.4") -(defun lookup-words (word &optional lookup-dict) +(defun ispell-lookup-words (word &optional lookup-dict) "Look up WORD in optional word-list dictionary LOOKUP-DICT. A `*' serves as a wild card. If no wild cards, `look' is used if it exists. Otherwise the variable `ispell-grep-command' contains the command used to @@ -2643,8 +2649,12 @@ if defined." (message "Starting \"%s\" process..." (file-name-nondirectory prog)) (if look-p nil + (insert "^" word) + ;; When there are no wildcards, append one, for consistency + ;; with `look' behavior. + (unless wild-p (insert "*")) + (insert "$") ;; Convert * to .* - (insert "^" word "$") (while (search-backward "*" nil t) (insert ".")) (setq word (buffer-string)) (erase-buffer)) @@ -3015,7 +3025,7 @@ Keeps argument list for future Ispell invocations for no async support." (setq ispell-filter nil ispell-filter-continue nil) ;; may need to restart to select new personal dictionary. (ispell-kill-ispell t) - (message "Starting new Ispell process [%s::%s] ..." + (message "Starting new Ispell process %s with %s dictionary..." ispell-program-name (or ispell-local-dictionary ispell-dictionary "default")) (sit-for 0) @@ -3295,7 +3305,8 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r ispell-start ispell-end (point-at-eol) in-comment add-comment string) (if add-comment ; account for comment chars added (setq ispell-start (- ispell-start (length add-comment)) - add-comment nil)) + ;; Reset `in-comment' (and indirectly `add-comment') for new line + in-comment nil)) (setq ispell-end (point)) ; "end" tracks region retrieved. (if string ; there is something to spell check! ;; (special start end) @@ -3761,7 +3772,7 @@ Use APPEND to append the info to previous buffer if exists." ;;;###autoload (defun ispell-complete-word (&optional interior-frag) - "Try to complete the word before or under point (see `lookup-words'). + "Try to complete the word before or under point. If optional INTERIOR-FRAG is non-nil then the word may be a character sequence inside of a word. @@ -3777,11 +3788,11 @@ Standard ispell choices are then available." word (car word) possibilities (or (string= word "") ; Will give you every word - (lookup-words (concat (and interior-frag "*") word - (if (or interior-frag (null ispell-look-p)) - "*")) - (or ispell-complete-word-dict - ispell-alternate-dictionary)))) + (ispell-lookup-words + (concat (and interior-frag "*") word + (and interior-frag "*")) + (or ispell-complete-word-dict + ispell-alternate-dictionary)))) (cond ((eq possibilities t) (message "No word to complete")) ((null possibilities) @@ -4331,8 +4342,13 @@ Both should not be used to define a buffer-local dictionary." (if (fboundp 'comment-padright) ;; Try and use the proper comment marker, ;; e.g. ";;" rather than ";". - (comment-padright comment-start - (comment-add nil)) + (progn + ;; XEmacs: comment-normalize-vars + ;; (newcomment.el) only in >= 21.5 + (and (fboundp 'comment-normalize-vars) + (comment-normalize-vars)) + (comment-padright comment-start + (comment-add nil))) comment-start) " ") "") diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el index 35c6e607569..b97c6325bf8 100644 --- a/lisp/textmodes/makeinfo.el +++ b/lisp/textmodes/makeinfo.el @@ -1,9 +1,9 @@ ;;; makeinfo.el --- run makeinfo conveniently -;; Copyright (C) 1991, 1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1993, 2001-2014 Free Software Foundation, Inc. ;; Author: Robert J. Chassell -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: docs convenience ;; This file is part of GNU Emacs. @@ -211,7 +211,7 @@ nonsensical results." (with-current-buffer buffer (revert-buffer t t)) (setq buffer (find-file-noselect makeinfo-output-file-name))) - (if (window-dedicated-p (selected-window)) + (if (window-dedicated-p) (switch-to-buffer-other-window buffer) (switch-to-buffer buffer))) (goto-char (point-min)))) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index 1ca5e8b1a63..cc1d6f5b77a 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -1,9 +1,9 @@ ;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source -;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2013 Free Software +;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 2c3271911fb..7fd8fa7a870 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -1,6 +1,6 @@ ;;; page-ext.el --- extended page handling commands -;; Copyright (C) 1990-1991, 1993-1994, 2001-2013 Free Software +;; Copyright (C) 1990-1991, 1993-1994, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Robert J. Chassell diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 60e49063c43..d5351089d51 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -1,8 +1,8 @@ ;;; page.el --- page motion commands for Emacs -;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp convenience ;; Package: emacs diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index e773b53a73f..3e77d3720bd 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -1,9 +1,9 @@ ;;; paragraphs.el --- paragraph and sentence parsing -;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2013 Free Software +;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp ;; Package: emacs @@ -468,7 +468,7 @@ sentences. Also, every paragraph boundary terminates sentences as well." (setq par-text-beg (point)) ;; Start of the first line of the paragraph. ;; We use this as the search limit - ;; to allow s1entence-end to match if it is anchored at + ;; to allow sentence-end to match if it is anchored at ;; BOL and the paragraph starts indented. (beginning-of-line) (setq par-beg (point))) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 21c86dd38f3..b11b773dee1 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -1,9 +1,9 @@ ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model -;; Copyright (C) 1985, 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: K. Shane Hartman -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience wp ;; This file is part of GNU Emacs. @@ -494,8 +494,12 @@ prefix argument, the rectangle is actually killed, shifting remaining text." (defun picture-clear-rectangle-to-register (start end register &optional killp) "Clear rectangle delineated by point and mark into REGISTER. The rectangle is saved in REGISTER and replaced with whitespace. With -prefix argument, the rectangle is actually killed, shifting remaining text." - (interactive "r\ncRectangle to register: \nP") +prefix argument, the rectangle is actually killed, shifting remaining text. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (region-beginning) (region-end) + (register-read-with-preview "Rectangle to register: ") + current-prefix-arg)) (set-register register (picture-snarf-rectangle start end killp))) (defun picture-snarf-rectangle (start end &optional killp) @@ -534,8 +538,11 @@ regardless of where you click." The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner -of rectangle and point at the other (diagonally opposed) corner." - (interactive "cRectangle from register: \nP") +of rectangle and point at the other (diagonally opposed) corner. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Rectangle from register: ") + current-prefix-arg)) (let ((rectangle (get-register register))) (if (not (consp rectangle)) (error "Register %c does not contain a rectangle" register) diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el index 331f220f95b..88ef4dafb76 100644 --- a/lisp/textmodes/po.el +++ b/lisp/textmodes/po.el @@ -1,8 +1,8 @@ -;;; po.el --- basic support of PO translation files -*- coding: latin-1; -*- +;;; po.el --- basic support of PO translation files -*- coding: utf-8; -*- -;; Copyright (C) 1995-1998, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-1998, 2000-2014 Free Software Foundation, Inc. -;; Authors: Franois Pinard , +;; Authors: François Pinard , ;; Greg McGary , ;; Bruno Haible . ;; Keywords: i18n, files diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index 975c9396d49..12b808635c5 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -1,9 +1,9 @@ ;;; refbib.el --- convert refer-style references to ones usable by Latex bib -;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989, 2001-2014 Free Software Foundation, Inc. ;; Author: Henry Kautz -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: bib, tex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 1e4d453e905..b70b19b7691 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -1,6 +1,6 @@ ;;; refer.el --- look up references in bibliography files -;; Copyright (C) 1992, 1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1996, 2001-2014 Free Software Foundation, Inc. ;; Author: Ashwin Ram ;; Maintainer: Gernot Heiser diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index f6a2c7eca05..4b78197ee65 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -1,6 +1,6 @@ ;;; refill.el --- `auto-fill' by refilling paragraphs on changes -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Maintainer: Miles Bader @@ -83,9 +83,10 @@ ;;; Code: -(defgroup refill nil - "Refilling paragraphs on changes." - :group 'fill) +;; Unused. +;;; (defgroup refill nil +;;; "Refilling paragraphs on changes." +;;; :group 'fill) (defvar refill-ignorable-overlay nil "Portion of the most recently filled paragraph not needing filling. @@ -222,7 +223,8 @@ characters only cause refilling if they would cause auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead." - :group 'refill + ;; Not global, so no effect. +;;; :group 'refill :lighter " Refill" :keymap '(("\177" . backward-delete-char-untabify)) ;; Remove old state if necessary diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 315b9d7fc30..ce69a64f4c0 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -1,6 +1,6 @@ ;;; reftex-auc.el --- RefTeX's interface to AUCTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 079101b56ee..a36fa17fca5 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -1,6 +1,6 @@ ;;; reftex-cite.el --- creating citations with RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -25,18 +25,16 @@ ;;; Code: (eval-when-compile (require 'cl)) -(provide 'reftex-cite) + (require 'reftex) -;;; -;; Variables and constants +;;; Variables and constants +(defvar reftex-cite-regexp-hist nil + "The history list of regular expressions used for citations") -;; The history list of regular expressions used for citations -(defvar reftex-cite-regexp-hist nil) - -;; Prompt and help string for citation selection (defconst reftex-citation-prompt - "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more") + "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more" + "Prompt and help string for citation selection") (defconst reftex-citation-help " n / p Go to next/previous entry (Cursor motion works as well). @@ -51,8 +49,7 @@ e / E Create BibTeX file with all (marked/unmarked) entries a / A Put all (marked) entries into one/many \\cite commands.") -;; Find bibtex files - +;;; Find bibtex files (defmacro reftex-with-special-syntax-for-bib (&rest body) `(let ((saved-syntax (syntax-table))) (unwind-protect @@ -62,8 +59,8 @@ (set-syntax-table saved-syntax)))) (defun reftex-default-bibliography () - ;; Return the expanded value of `reftex-default-bibliography'. - ;; The expanded value is cached. + "Return the expanded value of variable `reftex-default-bibliography'. +The expanded value is cached." (unless (eq (get 'reftex-default-bibliography :reftex-raw) reftex-default-bibliography) (put 'reftex-default-bibliography :reftex-expanded @@ -74,9 +71,8 @@ (get 'reftex-default-bibliography :reftex-expanded)) (defun reftex-bib-or-thebib () - ;; Tests if BibTeX or \begin{thebibliography} should be used for the - ;; citation - ;; Find the bof of the current file + "Test if BibTeX or \begin{thebibliography} should be used for the citation. +Find the bof of the current file" (let* ((docstruct (symbol-value reftex-docstruct-symbol)) (rest (or (member (list 'bof (buffer-file-name)) docstruct) docstruct)) @@ -94,11 +90,11 @@ (if thebib 'thebib nil)))) (defun reftex-get-bibfile-list () - ;; Return list of bibfiles for current document. - ;; When using the chapterbib or bibunits package you should either - ;; use the same database files everywhere, or separate parts using - ;; different databases into different files (included into the mater file). - ;; Then this function will return the applicable database files. + "Return list of bibfiles for current document. +When using the chapterbib or bibunits package you should either +use the same database files everywhere, or separate parts using +different databases into different files (included into the mater file). +Then this function will return the applicable database files." ;; Ensure access to scanning info (reftex-access-scan-info) @@ -115,16 +111,14 @@ (cdr (assq 'bib (symbol-value reftex-docstruct-symbol))) (error "\\bibliography statement missing or .bib files not found"))) -;; Find a certain reference in any of the BibTeX files. - +;;; Find a certain reference in any of the BibTeX files. (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill highlight item return) - ;; Find BibTeX KEY in any file in FILE-LIST in another window. - ;; If MARK-TO-KILL is non-nil, mark new buffer to kill. - ;; If HIGHLIGHT is non-nil, highlight the match. - ;; If ITEM in non-nil, search for bibitem instead of database entry. - ;; If RETURN is non-nil, just return the entry and restore point. - + "Find BibTeX KEY in any file in FILE-LIST in another window. +If MARK-TO-KILL is non-nil, mark new buffer to kill. +If HIGHLIGHT is non-nil, highlight the match. +If ITEM in non-nil, search for bibitem instead of database entry. +If RETURN is non-nil, just return the entry and restore point." (let* ((re (if item (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{" @@ -178,12 +172,11 @@ (progn (forward-list 1) (point))) (error (min (point-max) (+ 300 (point))))))) -;; Parse bibtex buffers - +;;; Parse bibtex buffers (defun reftex-extract-bib-entries (buffers) - ;; Extract bib entries which match regexps from BUFFERS. - ;; BUFFERS is a list of buffers or file names. - ;; Return list with entries." + "Extract bib entries which match regexps from BUFFERS. +BUFFERS is a list of buffers or file names. +Return list with entries." (let* (re-list first-re rest-re (buffer-list (if (listp buffers) buffers (list buffers))) found-list entry buffer1 buffer alist @@ -309,6 +302,8 @@ (t found-list)))) (defun reftex-bib-sort-author (e1 e2) + "Compare bib entries E1 and E2 by author. +The name of the first different author/editor is used." (let ((al1 (reftex-get-bib-names "author" e1)) (al2 (reftex-get-bib-names "author" e2))) (while (and al1 al2 (string= (car al1) (car al2))) @@ -320,15 +315,17 @@ (not (stringp (car al1)))))) (defun reftex-bib-sort-year (e1 e2) + "Compare bib entries E1 and E2 by year in ascending order." (< (string-to-number (or (cdr (assoc "year" e1)) "0")) (string-to-number (or (cdr (assoc "year" e2)) "0")))) (defun reftex-bib-sort-year-reverse (e1 e2) + "Compare bib entries E1 and E2 by year in descending order." (> (string-to-number (or (cdr (assoc "year" e1)) "0")) (string-to-number (or (cdr (assoc "year" e2)) "0")))) (defun reftex-get-crossref-alist (entry) - ;; return the alist from a crossref entry + "Return the alist from a crossref ENTRY." (let ((crkey (cdr (assoc "crossref" entry))) start) (save-excursion @@ -347,10 +344,9 @@ ;; Parse the bibliography environment (defun reftex-extract-bib-entries-from-thebibliography (files) - ;; Extract bib-entries from the \begin{thebibliography} environment. - ;; Parsing is not as good as for the BibTeX database stuff. - ;; The environment should be located in file FILE. - + "Extract bib-entries from the \begin{thebibliography} environment. +Parsing is not as good as for the BibTeX database stuff. +The environment should be located in FILES." (let* (start end buf entries re re-list file default) (unless files (error "Need file name to find thebibliography environment")) @@ -430,8 +426,8 @@ entries)) (defun reftex-get-bibkey-default () - ;; Return the word before the cursor. If the cursor is in a - ;; citation macro, return the word before the macro. + "Return the word before the cursor. +If the cursor is in a citation macro, return the word before the macro." (let* ((macro (reftex-what-macro 1))) (save-excursion (if (and macro (string-match "cite" (car macro))) @@ -439,10 +435,10 @@ (skip-chars-backward "^a-zA-Z0-9") (reftex-this-word)))) -;; Parse and format individual entries - +;;; Parse and format individual entries (defun reftex-get-bib-names (field entry) - ;; Return a list with the author or editor names in ENTRY + "Return a list with the author or editor names in ENTRY. +If FIELD is empty try \"editor\" field." (let ((names (reftex-get-bib-field field entry))) (if (equal "" names) (setq names (reftex-get-bib-field "editor" entry))) @@ -457,7 +453,9 @@ (split-string names "\n"))) (defun reftex-parse-bibtex-entry (entry &optional from to raw) - ; if RAW is non-nil, keep double quotes/curly braces delimiting fields + "Parse BibTeX ENTRY. +If ENTRY is nil then parse the entry in current buffer between FROM and TO. +If RAW is non-nil, keep double quotes/curly braces delimiting fields." (let (alist key start field) (save-excursion (save-restriction @@ -514,17 +512,12 @@ ;; remove extra whitespace (while (string-match "[\n\t\r]\\|[ \t][ \t]+" field) (setq field (replace-match " " nil t field))) - ;; remove leading garbage - (if (string-match (if raw "^[ \t]+" "^[ \t{]+") field) - (setq field (replace-match "" nil t field))) - ;; remove trailing garbage - (if (string-match (if raw "[ \t]+$" "[ \t}]+$") field) - (setq field (replace-match "" nil t field))) (push (cons key field) alist)))) alist)) (defun reftex-get-bib-field (fieldname entry &optional format) - ;; Extract the field FIELDNAME from an ENTRY + "Extract the field FIELDNAME from ENTRY. +If FORMAT is non-nil `format' entry accordingly." (let ((cell (assoc fieldname entry))) (if cell (if format @@ -533,7 +526,7 @@ ""))) (defun reftex-format-bib-entry (entry) - ;; Format a BibTeX ENTRY so that it is nice to look at + "Format a BibTeX ENTRY so that it is nice to look at." (let* ((auth-list (reftex-get-bib-names "author" entry)) (authors (mapconcat 'identity auth-list ", ")) @@ -576,7 +569,7 @@ (concat key "\n " authors " " year " " extra "\n " title "\n\n"))) (defun reftex-parse-bibitem (item) - ;; Parse a \bibitem entry + "Parse a \bibitem entry in ITEM." (let ((key "") (text "")) (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item) (setq key (match-string 1 item) @@ -592,7 +585,7 @@ (cons "&entry" (concat key " " text))))) (defun reftex-format-bibitem (item) - ;; Format a \bibitem entry so that it is (relatively) nice to look at. + "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at." (let ((text (reftex-get-bib-field "&text" item)) (key (reftex-get-bib-field "&key" item)) (lines nil)) @@ -609,7 +602,7 @@ (put-text-property 0 (length text) 'face reftex-bib-author-face text)) (concat key "\n " text "\n\n"))) -;; Make a citation +;;; Make a citation ;;;###autoload (defun reftex-citation (&optional no-insert format-key) @@ -633,7 +626,6 @@ The regular expression uses an expanded syntax: && is interpreted as `and'. Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. While entering the regexp, completion on knows citation keys is possible. `=' is a good regular expression to match all entries in all files." - (interactive) ;; check for recursive edit @@ -651,8 +643,7 @@ While entering the regexp, completion on knows citation keys is possible. (reftex-kill-temporary-buffers))) (defun reftex-do-citation (&optional arg no-insert format-key) - ;; This really does the work of reftex-citation. - + "This really does the work of `reftex-citation'." (let* ((format (reftex-figure-out-cite-format arg no-insert format-key)) (docstruct-symbol reftex-docstruct-symbol) (selected-entries (reftex-offer-bib-menu)) @@ -749,8 +740,8 @@ While entering the regexp, completion on knows citation keys is possible. (mapcar 'car selected-entries))) (defun reftex-figure-out-cite-format (arg &optional no-insert format-key) - ;; Check if there is already a cite command at point and change cite format - ;; in order to only add another reference in the same cite command. + "Check if there is already a cite command at point and change cite format +in order to only add another reference in the same cite command." (let ((macro (car (reftex-what-macro 1))) (cite-format-value (reftex-get-cite-format)) key format) @@ -808,8 +799,7 @@ While entering the regexp, completion on knows citation keys is possible. (defvar reftex-select-bib-map) (defun reftex-offer-bib-menu () - ;; Offer bib menu and return list of selected items - + "Offer bib menu and return list of selected items." (let ((bibtype (reftex-bib-or-thebib)) found-list rtn key data selected-entries) (while @@ -923,7 +913,7 @@ While entering the regexp, completion on knows citation keys is possible. selected-entries)) (defun reftex-restrict-bib-matches (found-list) - ;; Limit FOUND-LIST with more regular expressions + "Limit FOUND-LIST with more regular expressions." (let ((re-list (split-string (read-string "RegExp [ && RegExp...]: " nil 'reftex-cite-regexp-hist) @@ -946,7 +936,7 @@ While entering the regexp, completion on knows citation keys is possible. found-list))) (defun reftex-extract-bib-file (all &optional marked complement) - ;; Limit FOUND-LIST with more regular expressions + "Limit FOUND-LIST with more regular expressions." (let ((file (read-file-name "File to create: "))) (find-file-other-window file) (if (> (buffer-size) 0) @@ -969,7 +959,7 @@ While entering the regexp, completion on knows citation keys is possible. (goto-char (point-min)))) (defun reftex-insert-bib-matches (list) - ;; Insert the bib matches and number them correctly + "Insert the bib matches and number them correctly." (let ((mouse-face (if (memq reftex-highlight-selection '(mouse both)) reftex-mouse-selected-face @@ -1002,8 +992,7 @@ While entering the regexp, completion on knows citation keys is possible. last))))) (defun reftex-format-citation (entry format) - ;; Format a citation from the info in the BibTeX ENTRY - + "Format a citation from the info in the BibTeX ENTRY according to FORMAT." (unless (stringp format) (setq format "\\cite{%l}")) (if (and reftex-comment-citations @@ -1070,7 +1059,7 @@ While entering the regexp, completion on knows citation keys is possible. format) (defun reftex-make-cite-echo-string (entry docstruct-symbol) - ;; Format a bibtex entry for the echo area and cache the result. + "Format a bibtex ENTRY for the echo area and cache the result." (let* ((key (reftex-get-bib-field "&key" entry)) (string (let* ((reftex-cite-punctuation '(" " " & " " etal."))) @@ -1094,9 +1083,9 @@ While entering the regexp, completion on knows citation keys is possible. string)) (defun reftex-bibtex-selection-callback (data ignore no-revisit) - ;; Callback function to be called from the BibTeX selection, in - ;; order to display context. This function is relatively slow and not - ;; recommended for follow mode. It works OK for individual lookups. + "Callback function to be called from the BibTeX selection, in +order to display context. This function is relatively slow and not +recommended for follow mode. It works OK for individual lookups." (let ((win (selected-window)) (key (reftex-get-bib-field "&key" data)) bibfile-list item bibtype) @@ -1141,7 +1130,7 @@ While entering the regexp, completion on knows citation keys is possible. (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t) + (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^]]*\\]\\)?{\\([^}]+\\)}" nil t) (setq kk (match-string-no-properties 3)) (while (string-match "%.*\n?" kk) (setq kk (replace-match "" t t kk))) @@ -1163,7 +1152,7 @@ While entering the regexp, completion on knows citation keys is possible. alist)))) (defun reftex-create-bibtex-file (bibfile) - "Create a new BibTeX database file with all entries referenced in document. + "Create a new BibTeX database BIBFILE with all entries referenced in document. The command prompts for a filename and writes the collected entries to that file. Only entries referenced in the current document with any \\cite-like macros are used. The sequence in @@ -1253,5 +1242,5 @@ created files in the variables `reftex-create-bibtex-header' or (message "%d entries extracted and copied to new database" (length entries)))) - +(provide 'reftex-cite) ;;; reftex-cite.el ends here diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 12781f358eb..dc7448cc993 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -1,6 +1,6 @@ ;;; reftex-dcr.el --- viewing cross references and citations with RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 83a98891216..4311c99923e 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -1,6 +1,6 @@ ;;; reftex-global.el --- operations on entire documents with RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index a8e712f4f49..4a329b9999e 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1,6 +1,6 @@ ;;; reftex-index.el --- index support with RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -896,7 +896,7 @@ When index is restricted, select the previous section as restriction criterion." ;; If FINAL is t, stay there ;; If FINAL is 'hide, hide the *Index* window. ;; Otherwise, move cursor back into *Index* window. - ;; NO-REVISIT means don't visit files, just use live biffers. + ;; NO-REVISIT means don't visit files, just use live buffers. (let* ((data (get-text-property (point) :data)) (index-window (selected-window)) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index a86b10e21cc..40aa31a648b 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -1,6 +1,6 @@ ;;; reftex-parse.el --- parser functions for RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -49,7 +49,8 @@ (reftex-access-scan-info '(16))) (defun reftex-do-parse (rescan &optional file) - "Do a document rescan. When allowed, do only a partial scan from FILE." + "Do a document rescan. +When allowed, do only a partial scan from FILE." ;; Normalize the rescan argument (setq rescan (cond ((eq rescan t) t) @@ -191,7 +192,7 @@ of master file." (defvar index-tags) (defun reftex-parse-from-file (file docstruct master-dir) - ;; Scan the buffer for labels and save them in a list. + "Scan the buffer for labels and save them in a list." (let ((regexp (reftex-everything-regexp)) (bound 0) file-found tmp include-file @@ -234,8 +235,19 @@ of master file." ((match-end 1) ;; It is a label - (push (reftex-label-info (reftex-match-string 1) file bound) - docstruct)) + (when (or (null reftex-label-ignored-macros-and-environments) + ;; \label{} defs should always be honored, + ;; just no keyval style [label=foo] defs. + (string-equal "\label{" (substring (reftex-match-string 0) 0 7)) + (if (and (fboundp 'TeX-current-macro) + (fboundp 'LaTeX-current-environment)) + (not (or (member (save-match-data (TeX-current-macro)) + reftex-label-ignored-macros-and-environments) + (member (save-match-data (LaTeX-current-environment)) + reftex-label-ignored-macros-and-environments))) + t)) + (push (reftex-label-info (reftex-match-string 1) file bound) + docstruct))) ((match-end 3) ;; It is a section @@ -338,21 +350,38 @@ of master file." ;; Return the list docstruct)) -(defun reftex-locate-bibliography-files (master-dir &optional files) - ;; Scan buffer for bibliography macro and return file list. +(defun reftex-using-biblatex-p () + "Return non-nil iff we are using biblatex rather than bibtex." + (if (boundp 'TeX-active-styles) + ;; the sophisticated AUCTeX way + (member "biblatex" TeX-active-styles) + ;; poor-man's check... + (save-excursion + (re-search-forward "^[^%]*\\\\usepackage.*{biblatex}" nil t)))) +(defun reftex-locate-bibliography-files (master-dir &optional files) + "Scan buffer for bibliography macros and return file list." (unless files (save-excursion (goto-char (point-min)) - (if (re-search-forward - (concat -; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" - "\\(^\\)[^%\n\r]*\\\\\\(" - (mapconcat 'identity reftex-bibliography-commands "\\|") - "\\){[ \t]*\\([^}]+\\)") nil t) - (setq files - (split-string (reftex-match-string 3) - "[ \t\n\r]*,[ \t\n\r]*"))))) + ;; when biblatex is used, multiple \bibliography or + ;; \addbibresource macros are allowed. With plain bibtex, only + ;; the first is used. + (let ((using-biblatex (reftex-using-biblatex-p)) + (again t)) + (while (and again + (re-search-forward + (concat + ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" + "\\(^\\)[^%\n\r]*\\\\\\(" + (mapconcat 'identity reftex-bibliography-commands "\\|") + "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") nil t)) + (setq files + (append files + (split-string (reftex-match-string 4) + "[ \t\n\r]*,[ \t\n\r]*"))) + (unless using-biblatex + (setq again nil)))))) (when files (setq files (mapcar @@ -368,10 +397,10 @@ of master file." (delq nil files))) (defun reftex-replace-label-list-segment (old insert &optional entirely) - ;; Replace the segment in OLD which corresponds to INSERT. - ;; Works with side effects, directly changes old. - ;; If entirely is t, just return INSERT. - ;; This function also makes sure the old toc markers do not point anywhere. + "Replace the segment in OLD which corresponds to INSERT. +Works with side effects, directly changes old. +If ENTIRELY is t, just return INSERT. +This function also makes sure the old toc markers do not point anywhere." (cond (entirely @@ -393,8 +422,8 @@ of master file." new)))) (defun reftex-section-info (file) - ;; Return a section entry for the current match. - ;; Careful: This function expects the match-data to be still in place! + "Return a section entry for the current match. +Careful: This function expects the match-data to be still in place!" (let* ((marker (set-marker (make-marker) (1- (match-beginning 3)))) (macro (reftex-match-string 3)) (prefix (save-match-data @@ -429,9 +458,9 @@ of master file." literal (marker-position marker)))) (defun reftex-ensure-index-support (&optional abort) - ;; When index support is turned off, ask to turn it on and - ;; set the current prefix argument so that `reftex-access-scan-info' - ;; will rescan the entire document. + "When index support is turned off, ask to turn it on and +set the current prefix argument so that `reftex-access-scan-info' +will rescan the entire document." (cond (reftex-support-index t) ((y-or-n-p "Turn on index support and rescan entire document? ") @@ -449,8 +478,8 @@ of master file." (defvar test-dummy) (defun reftex-index-info (file) - ;; Return an index entry for the current match. - ;; Careful: This function expects the match-data to be still in place! + "Return an index entry for the current match. +Careful: This function expects the match-data to be still in place!" (catch 'exit (let* ((macro (reftex-match-string 10)) (bom (match-beginning 10)) @@ -497,7 +526,7 @@ of master file." (list 'index index-tag context file bom arg key showkey sortkey key-end)))) (defun reftex-short-context (env parse &optional bound derive) - ;; Get about one line of useful context for the label definition at point. + "Get about one line of useful context for the label definition at point." (if (consp parse) (setq parse (if derive (cdr parse) (car parse)))) @@ -557,9 +586,9 @@ of master file." "INVALID VALUE OF PARSE")))) (defun reftex-where-am-I () - ;; Return the docstruct entry above point. Actually returns a cons - ;; cell in which the cdr is a flag indicating if the information is - ;; exact (t) or approximate (nil). + "Return the docstruct entry above point. +Actually returns a cons cell in which the cdr is a flag indicating +if the information is exact (t) or approximate (nil)." (let ((docstruct (symbol-value reftex-docstruct-symbol)) (cnt 0) rtn rtn-if-no-other @@ -737,10 +766,10 @@ of master file." ) (defsubst reftex-move-to-previous-arg (&optional bound) - ;; Assuming that we are in front of a macro argument, - ;; move backward to the closing parenthesis of the previous argument. - ;; This function understands the splitting of macros over several lines - ;; in TeX. + "Assuming that we are in front of a macro argument, +move backward to the closing parenthesis of the previous argument. +This function understands the splitting of macros over several lines +in TeX." (cond ;; Just to be quick: ((memq (preceding-char) '(?\] ?\}))) @@ -753,28 +782,27 @@ of master file." (t nil))) (defun reftex-what-macro-safe (which &optional bound) - ;; reftex-what-macro with special syntax table. + "Call `reftex-what-macro' with special syntax table." (reftex-with-special-syntax (reftex-what-macro which bound))) (defun reftex-what-macro (which &optional bound) - ;; Find out if point is within the arguments of any TeX-macro. - ;; The return value is either ("\\macro" . (point)) or a list of them. + "Find out if point is within the arguments of any TeX-macro. +The return value is either (\"\\macro\" . (point)) or a list of them. - ;; If WHICH is nil, immediately return nil. - ;; If WHICH is 1, return innermost enclosing macro. - ;; If WHICH is t, return list of all macros enclosing point. - ;; If WHICH is a list of macros, look only for those macros and return the - ;; name of the first macro in this list found to enclose point. - ;; If the optional BOUND is an integer, bound backwards directed - ;; searches to this point. If it is nil, limit to nearest \section - - ;; like statement. - - ;; This function is pretty stable, but can be fooled if the text contains - ;; things like \macro{aa}{bb} where \macro is defined to take only one - ;; argument. As RefTeX cannot know this, the string "bb" would still be - ;; considered an argument of macro \macro. +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing macro. +If WHICH is t, return list of all macros enclosing point. +If WHICH is a list of macros, look only for those macros and return the + name of the first macro in this list found to enclose point. +If the optional BOUND is an integer, bound backwards directed + searches to this point. If it is nil, limit to nearest \\section - + like statement. +This function is pretty stable, but can be fooled if the text contains +things like \\macro{aa}{bb} where \\macro is defined to take only one +argument. As RefTeX cannot know this, the string \"bb\" would still be +considered an argument of macro \\macro." (unless reftex-section-regexp (reftex-compile-variables)) (catch 'exit (if (null which) (throw 'exit nil)) @@ -821,20 +849,19 @@ of master file." (nreverse cmd-list))))) (defun reftex-what-environment (which &optional bound) - ;; Find out if point is inside a LaTeX environment. - ;; The return value is (e.g.) either ("equation" . (point)) or a list of - ;; them. + "Find out if point is inside a LaTeX environment. +The return value is (e.g.) either (\"equation\" . (point)) or a list of +them. - ;; If WHICH is nil, immediately return nil. - ;; If WHICH is 1, return innermost enclosing environment. - ;; If WHICH is t, return list of all environments enclosing point. - ;; If WHICH is a list of environments, look only for those environments and - ;; return the name of the first environment in this list found to enclose - ;; point. - - ;; If the optional BOUND is an integer, bound backwards directed searches to - ;; this point. If it is nil, limit to nearest \section - like statement. +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point. +If the optional BOUND is an integer, bound backwards directed searches to +this point. If it is nil, limit to nearest \\section - like statement." (unless reftex-section-regexp (reftex-compile-variables)) (catch 'exit (save-excursion @@ -859,18 +886,17 @@ of master file." (nreverse env-list))))) (defun reftex-what-special-env (which &optional bound) - ;; Run the special environment parsers and return the matches. - ;; - ;; The return value is (e.g.) either ("my-parser-function" . (point)) - ;; or a list of them. + "Run the special environment parsers and return the matches. - ;; If WHICH is nil, immediately return nil. - ;; If WHICH is 1, return innermost enclosing environment. - ;; If WHICH is t, return list of all environments enclosing point. - ;; If WHICH is a list of environments, look only for those environments and - ;; return the name of the first environment in this list found to enclose - ;; point. +The return value is (e.g.) either (\"my-parser-function\" . (point)) +or a list of them. +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point." (unless reftex-section-regexp (reftex-compile-variables)) (catch 'exit (save-excursion @@ -900,10 +926,10 @@ of master file." (car specials)))))) (defsubst reftex-move-to-next-arg (&optional ignore) - ;; Assuming that we are at the end of a macro name or a macro argument, - ;; move forward to the opening parenthesis of the next argument. - ;; This function understands the splitting of macros over several lines - ;; in TeX. + "Assuming that we are at the end of a macro name or a macro argument, +move forward to the opening parenthesis of the next argument. +This function understands the splitting of macros over several lines +in TeX." (cond ;; Just to be quick: ((memq (following-char) '(?\[ ?\{))) @@ -919,8 +945,8 @@ of master file." (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) (defun reftex-nth-arg (n &optional opt-args) - ;; Return the nth following {} or [] parentheses content. - ;; OPT-ARGS is a list of argument numbers which are optional. + "Return the Nth following {} or [] parentheses content. +OPT-ARGS is a list of argument numbers which are optional." ;; If we are sitting at a macro start, skip to end of macro name. (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\")) @@ -963,8 +989,8 @@ of master file." (error nil))) (defun reftex-context-substring (&optional to-end) - ;; Return up to 150 chars from point - ;; When point is just after a { or [, limit string to matching parenthesis + "Return up to 150 chars from point. +When point is just after a { or [, limit string to matching parenthesis" (cond (to-end ;; Environment - find next \end @@ -996,8 +1022,7 @@ of master file." (defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) (defun reftex-init-section-numbers (&optional toc-entry appendix) - ;; Initialize the section numbers with zeros or with what is found - ;; in the toc entry. + "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY." (let* ((level (or (nth 5 toc-entry) -1)) (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\."))) (depth (1- (length reftex-section-numbers))) @@ -1015,8 +1040,8 @@ of master file." (put 'reftex-section-numbers 'appendix appendix)) (defun reftex-section-number (&optional level star) - ;; Return a string with the current section number. - ;; When LEVEL is non-nil, increase section numbers on that level. + "Return a string with the current section number. +When LEVEL is non-nil, increase section numbers on that level." (let* ((depth (1- (length reftex-section-numbers))) idx n (string "") (appendix (get 'reftex-section-numbers 'appendix)) (partspecial (and (not reftex-part-resets-chapter) @@ -1062,7 +1087,7 @@ of master file." string)))) (defun reftex-roman-number (n) - ;; Return as a string the roman number equal to N. + "Return as a string the roman number equal to N." (let ((nrest n) (string "") (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD") diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 575d885a322..f2fa815f479 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -1,6 +1,6 @@ ;;; reftex-ref.el --- code to create labels and references with RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index af1d1945f39..f589abbc778 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -1,6 +1,6 @@ ;;; reftex-sel.el --- the selection modes for RefTeX -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 248e36a5299..59f9de88111 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -1,6 +1,6 @@ ;;; reftex-toc.el --- RefTeX's table of contents mode -;; Copyright (C) 1997-2000, 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2000, 2003-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -229,7 +229,7 @@ When called with a raw C-u prefix, rescan the document first." (car (reftex-where-am-I)))) (unsplittable (if (fboundp 'frame-property) (frame-property (selected-frame) 'unsplittable) - (frame-parameter (selected-frame) 'unsplittable))) + (frame-parameter nil 'unsplittable))) offset toc-window) (if (setq toc-window (get-buffer-window @@ -587,7 +587,7 @@ With prefix arg 1, restrict index to the section at point." (let ((unsplittable (if (fboundp 'frame-property) (frame-property (selected-frame) 'unsplittable) - (frame-parameter (selected-frame) 'unsplittable))) + (frame-parameter nil 'unsplittable))) (reftex-rebuilding-toc t)) (if unsplittable (switch-to-buffer diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 2a5c9c55866..3b497f2fb11 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -1,6 +1,6 @@ ;;; reftex-vars.el --- configuration variables for RefTeX -;; Copyright (C) 1997-1999, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1999, 2001-2014 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Maintainer: auctex-devel@gnu.org @@ -89,7 +89,7 @@ (("wrapfigure" ?f nil nil caption))) (ctable "The ctable package" - (("\\ctable[]{}{}{}" ?t "tab:" "\\ref{%s}" 1 ("table" "Tabelle")))) + (("\\ctable[]{}{}{}" ?t "tab:" "~\\ref{%s}" 1 ("table" "Tabelle")))) (listings "The listings package" (("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) @@ -127,7 +127,10 @@ ;; The label macro is hard coded, but it *could* be defined like this: ;;("\\label{*}" nil nil nil nil) - ))) + )) + + ;; Texinfo + (Texinfo "Texinfo default environments" nil)) "The default label environment descriptions. Lower-case symbols correspond to a style file of the same name in the LaTeX distribution. Mixed-case symbols are convenience aliases.") @@ -863,6 +866,49 @@ DOWNCASE t: Downcase words before using them." (string :tag "")) (option (boolean :tag "Downcase words ")))) +(defcustom reftex-label-regexps + '(;; Normal \\label{foo} labels + "\\\\label{\\(?1:[^}]*\\)}" + ;; keyvals [..., label = {foo}, ...] forms used by ctable, + ;; listings, minted, ... + "\\[[^]]*\\ ;; Maintainer: auctex-devel@gnu.org @@ -135,7 +135,9 @@ "Make a citation using BibTeX database files." t) (autoload 'reftex-default-bibliography "reftex-cite") (autoload 'reftex-bib-or-thebib "reftex-cite") -(autoload 'reftex-create-bibtex-file "reftex-cite") +(autoload 'reftex-create-bibtex-file "reftex-cite" + "Create a new BibTeX database BIBFILE with all entries referenced in document." + t) ;; Selection (autoload 'reftex-select-label-mode "reftex-sel") @@ -547,7 +549,7 @@ will deactivate it." (when (member style list) (setq reftex-tables-dirty t changed t) - (delete style list))) + (setq list (delete style list)))) (t (if (member style list) (delete style list) @@ -1081,13 +1083,7 @@ This enforces rescanning the buffer on next use." (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because ; match numbers are hard coded (label-re (concat "\\(?:" - ;; Normal \label{...} - "\\\\label{\\([^}]*\\)}" - "\\|" - ;; keyvals [..., label = {foo}, ...] - ;; forms used by ctable, listings, - ;; minted, ... - "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?" + (mapconcat 'identity reftex-label-regexps "\\|") "\\)")) (include-re (concat wbol "\\\\\\(" @@ -2262,6 +2258,8 @@ IGNORE-WORDS List of words which should be removed from the string." (define-key reftex-mode-map [(shift mouse-2)] 'reftex-mouse-view-crossref))) +(defvar bibtex-mode-map) + ;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map (eval-after-load "bibtex" diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index eeb04ef250f..089f5b2d889 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -1,8 +1,9 @@ ;;; remember --- a mode for quickly jotting down things to remember -;; Copyright (C) 1999-2001, 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2001, 2003-2014 Free Software Foundation, Inc. ;; Author: John Wiegley +;; Maintainer: emacs-devel@gnu.org ;; Created: 29 Mar 1999 ;; Version: 2.0 ;; Keywords: data memory todo pim @@ -118,7 +119,7 @@ ;; ;; * Using "remember" ;; -;; As a rough beginning, what I do is to keep my .notes file in +;; As a rough beginning, what I do is to keep my `remember-data-file' in ;; outline-mode format, with a final entry called "* Raw data". Then, ;; at intervals, I can move the data that gets appended there into ;; other places. But certainly this should evolve into an intuitive @@ -178,8 +179,6 @@ ;;; Code: -(provide 'remember) - (defconst remember-version "2.0" "This version of remember.") @@ -216,10 +215,11 @@ All functions are run in the remember buffer." Each function is called with the current buffer narrowed to what the user wants remembered. If any function returns non-nil, the data is assumed to have been -recorded somewhere by that function. " +recorded somewhere by that function." :type 'hook :options '(remember-store-in-mailbox remember-append-to-file + remember-store-in-files remember-diary-extract-entries org-remember-handler) :group 'remember) @@ -229,6 +229,8 @@ recorded somewhere by that function. " :type 'boolean :group 'remember) +;; See below for more user variables. + ;;; Internal Variables: (defvar remember-buffer "*Remember*" @@ -275,7 +277,7 @@ With a prefix or a visible region, use the region as INITIAL." transient-mark-mode)) (buffer-substring (region-beginning) (region-end))))) (funcall (if remember-in-new-frame - #'frame-configuration-to-register + #'frameset-to-register #'window-configuration-to-register) remember-register) (let* ((annotation (if remember-run-all-annotation-functions-flag @@ -293,6 +295,7 @@ With a prefix or a visible region, use the region as INITIAL." (if remember-in-new-frame (set-window-dedicated-p (get-buffer-window (current-buffer) (selected-frame)) t)) + (setq buffer-offer-save t) (remember-mode) (when (= (point-max) (point-min)) (when initial (insert initial)) @@ -380,9 +383,20 @@ Subject: %s\n\n" ;; Remembering to plain files -(defcustom remember-data-file (convert-standard-filename "~/.notes") - "The file in which to store unprocessed data." +(defcustom remember-data-file (locate-user-emacs-file "notes" ".notes") + "The file in which to store unprocessed data. +When set via customize, visited file of the notes buffer (if it +exists) might be changed." + :version "24.4" ; added locate-user-emacs-file :type 'file + :set (lambda (symbol value) + (let ((buf (find-buffer-visiting (default-value symbol)))) + (set-default symbol value) + (when (buffer-live-p buf) + (with-current-buffer buf + (set-visited-file-name + (expand-file-name remember-data-file)))))) + :initialize 'custom-initialize-default :group 'remember) (defcustom remember-leader-text "** " @@ -392,21 +406,20 @@ Subject: %s\n\n" (defun remember-append-to-file () "Remember, with description DESC, the given TEXT." - (let ((text (buffer-string)) - (desc (remember-buffer-desc))) - (with-temp-buffer - (insert "\n" remember-leader-text (current-time-string) - " (" desc ")\n\n" text) - (if (not (bolp)) - (insert "\n")) - (if (find-buffer-visiting remember-data-file) - (let ((remember-text (buffer-string))) - (set-buffer (get-file-buffer remember-data-file)) - (save-excursion - (goto-char (point-max)) - (insert remember-text) - (when remember-save-after-remembering (save-buffer)))) - (append-to-file (point-min) (point-max) remember-data-file))))) + (let* ((text (buffer-string)) + (desc (remember-buffer-desc)) + (remember-text (concat "\n" remember-leader-text (current-time-string) + " (" desc ")\n\n" text + (save-excursion (goto-char (point-max)) + (if (bolp) nil "\n")))) + (buf (find-buffer-visiting remember-data-file))) + (if buf + (with-current-buffer buf + (save-excursion + (goto-char (point-max)) + (insert remember-text)) + (if remember-save-after-remembering (save-buffer))) + (append-to-file remember-text nil remember-data-file)))) (defun remember-region (&optional beg end) "Remember the data from BEG to END. @@ -429,6 +442,33 @@ If you want to remember a region, supply a universal prefix to (run-hook-with-args-until-success 'remember-handler-functions)) (remember-destroy)))) +(defcustom remember-data-directory "~/remember" + "The directory in which to store remember data as files. +Used by `remember-store-in-files'." + :type 'directory + :version "24.4" + :group 'remember) + +(defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z" + "Format string for the file name in which to store unprocessed data. +This is passed to `format-time-string'. +Used by `remember-store-in-files'." + :type 'string + :version "24.4" + :group 'remember) + +(defun remember-store-in-files () + "Store remember data in a file in `remember-data-directory'. +The file is named by calling `format-time-string' using +`remember-directory-file-name-format' as the format string." + (let ((name (format-time-string + remember-directory-file-name-format (current-time))) + (text (buffer-string))) + (with-temp-buffer + (insert text) + (write-file (convert-standard-filename + (format "%s/%s" remember-data-directory name)))))) + ;;;###autoload (defun remember-clipboard () "Remember the contents of the current clipboard. @@ -456,7 +496,7 @@ Most useful for remembering things from other applications." (defcustom remember-diary-file nil "File for extracted diary entries. If this is nil, then `diary-file' will be used instead." - :type 'file + :type '(choice (const :tag "diary-file" nil) file) :group 'remember) (defun remember-diary-convert-entry (entry) @@ -500,7 +540,7 @@ If this is nil, then `diary-file' will be used instead." (goto-char (point-min)) (let (list) (while (re-search-forward "^DIARY:\\s-*\\(.+\\)" nil t) - (add-to-list 'list (remember-diary-convert-entry (match-string 1)))) + (push (remember-diary-convert-entry (match-string 1)) list)) (when list (diary-make-entry (mapconcat 'identity list "\n") nil remember-diary-file)) @@ -514,7 +554,7 @@ If this is nil, then `diary-file' will be used instead." (define-key map "\C-c\C-c" 'remember-finalize) (define-key map "\C-c\C-k" 'remember-destroy) map) - "Keymap used in Remember mode.") + "Keymap used in `remember-mode'.") (define-derived-mode remember-mode indented-text-mode "Remember" "Major mode for output from \\[remember]. @@ -526,4 +566,103 @@ the data away for latter retrieval, and possible indexing. \\{remember-mode-map}" (set-keymap-parent remember-mode-map nil)) +;; Notes buffer showing the notes: + +(defcustom remember-notes-buffer-name "*notes*" + "Name of the notes buffer. +Setting it to *scratch* will hijack the *scratch* buffer for the +purpose of storing notes." + :type 'string + :version "24.4") + +(defcustom remember-notes-initial-major-mode nil + "Major mode to use in the notes buffer when it's created. +If this is nil, use `initial-major-mode'." + :type '(choice (const :tag "Use `initial-major-mode'" nil) + (function :tag "Major mode" text-mode)) + :version "24.4") + +(defcustom remember-notes-bury-on-kill t + "Non-nil means `kill-buffer' will bury the notes buffer instead of killing." + :type 'boolean + :version "24.4") + +(defun remember-notes-save-and-bury-buffer () + "Save (if it is modified) and bury the current buffer." + (interactive) + (when (buffer-modified-p) + (save-buffer)) + (bury-buffer)) + + + +(defvar remember-notes-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'remember-notes-save-and-bury-buffer) + map) + "Keymap used in `remember-notes-mode'.") + +(define-minor-mode remember-notes-mode + "Minor mode for the `remember-notes' buffer. +This sets `buffer-save-without-query' so that `save-some-buffers' will +save the notes buffer without asking. + +\\{remember-notes-mode-map}" + nil nil nil + (cond + (remember-notes-mode + (add-hook 'kill-buffer-query-functions + #'remember-notes--kill-buffer-query nil t) + (setq buffer-save-without-query t)))) + +;;;###autoload +(defun remember-notes (&optional switch-to) + "Return the notes buffer, creating it if needed, and maybe switch to it. +This buffer is for notes that you want to preserve across Emacs sessions. +The notes are saved in `remember-data-file'. + +If a buffer is already visiting that file, just return it. + +Otherwise, create the buffer, and rename it to `remember-notes-buffer-name', +unless a buffer of that name already exists. Set the major mode according +to `remember-notes-initial-major-mode', and enable `remember-notes-mode' +minor mode. + +Use \\\\[remember-notes-save-and-bury-buffer] to save and bury the notes buffer. + +Interactively, or if SWITCH-TO is non-nil, switch to the buffer. +Return the buffer. + +Set `initial-buffer-choice' to `remember-notes' to visit your notes buffer +when Emacs starts. Set `remember-notes-buffer-name' to \"*scratch*\" +to turn the *scratch* buffer into your notes buffer." + (interactive "p") + (let ((buf (or (find-buffer-visiting remember-data-file) + (with-current-buffer (find-file-noselect remember-data-file) + (and remember-notes-buffer-name + (not (get-buffer remember-notes-buffer-name)) + (rename-buffer remember-notes-buffer-name)) + (funcall (or remember-notes-initial-major-mode + initial-major-mode)) + (remember-notes-mode 1) + (current-buffer))))) + (when switch-to + (switch-to-buffer buf)) + buf)) + +(defun remember-notes--kill-buffer-query () + "Function that `remember-notes-mode' adds to `kill-buffer-query-functions'. +Save the current buffer if modified. If `remember-notes-bury-on-kill' +is non-nil, bury it and return nil; otherwise return t." + (when (buffer-modified-p) + (save-buffer)) + (if remember-notes-bury-on-kill + (progn + ;; bury-buffer always returns nil, but let's be explicit. + (bury-buffer) + nil) + t)) + +(provide 'remember) + ;;; remember.el ends here diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index b3503c6c982..516431006f6 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1,6 +1,6 @@ ;;; rst.el --- Mode for viewing and editing reStructuredText-documents. -;; Copyright (C) 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2003-2014 Free Software Foundation, Inc. ;; Maintainer: Stefan Merten ;; Author: Stefan Merten , @@ -611,17 +611,28 @@ KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key definitions should be in vector notation. These are defined as well but give an additional message." (define-key keymap key def) - (dolist (dep-key deprecated) - (define-key keymap dep-key - `(lambda () - ,(format "Deprecated binding for %s, use \\[%s] instead." def def) - (interactive) - (call-interactively ',def) - (message "[Deprecated use of key %s; use key %s instead]" - (key-description (this-command-keys)) - (key-description ,key)))))) - -;; Key bindings. + (when deprecated + (let* ((command-name (symbol-name def)) + (forwarder-function-name + (if (string-match "^rst-\\(.*\\)$" command-name) + (concat "rst-deprecated-" + (match-string 1 command-name)) + (error "not an RST command: %s" command-name))) + (forwarder-function (intern forwarder-function-name))) + (unless (fboundp forwarder-function) + (defalias forwarder-function + (lexical-let ((key key) (def def)) + (lambda () + (interactive) + (call-interactively def) + (message "[Deprecated use of key %s; use key %s instead]" + (key-description (this-command-keys)) + (key-description key)))) + (format "Deprecated binding for %s, use \\[%s] instead." + def def))) + (dolist (dep-key deprecated) + (define-key keymap dep-key forwarder-function))))) + ;; Key bindings. (defvar rst-mode-map (let ((map (make-sparse-keymap))) @@ -864,7 +875,10 @@ highlighting. (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) ;; Text after a changed line may need new fontification. - (set (make-local-variable 'jit-lock-contextually) t)) + (set (make-local-variable 'jit-lock-contextually) t) + + ;; Indentation is not deterministic. + (setq electric-indent-inhibit t)) ;;;###autoload (define-minor-mode rst-minor-mode @@ -2296,6 +2310,7 @@ any." (defcustom rst-toc-indent 2 "Indentation for table-of-contents display. Also used for formatting insertion, when numbering is disabled." + :type 'integer :group 'rst-toc) (rst-testcover-defcustom) @@ -2307,11 +2322,16 @@ indentation style: - fixed: numbering, but fixed indentation - aligned: numbering, titles aligned under each other - listed: numbering, with dashes like list items (EXPERIMENTAL)" + :type '(choice (const plain) + (const fixed) + (const aligned) + (const listed)) :group 'rst-toc) (rst-testcover-defcustom) (defcustom rst-toc-insert-number-separator " " "Separator that goes between the TOC number and the title." + :type 'string :group 'rst-toc) (rst-testcover-defcustom) @@ -2324,6 +2344,7 @@ indentation style: (defcustom rst-toc-insert-max-level nil "If non-nil, maximum depth of the inserted TOC." + :type '(choice (const nil) integer) :group 'rst-toc) (rst-testcover-defcustom) @@ -2419,8 +2440,8 @@ level to align." ;; for the numbers. (if (cdr node) (setq fmt (format "%%-%dd" - (1+ (floor (log10 (length - (cdr node)))))))))) + (1+ (floor (log (length (cdr node)) + 10)))))))) (dolist (child (cdr node)) (rst-toc-insert-node child @@ -3932,7 +3953,7 @@ string)) to be used for converting the document." (choice :tag "Command options" (const :tag "No options" nil) (string :tag "Options")))) - :group 'rst + :group 'rst-compile :package-version "1.2.0") (rst-testcover-defcustom) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 33dfa277330..d2f1307b6c9 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1,10 +1,10 @@ ;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*- -;; Copyright (C) 1992, 1995-1996, 1998, 2001-2013 Free Software +;; Copyright (C) 1992, 1995-1996, 1998, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: James Clark -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Adapted-By: ESR, Daniel Pfeiffer , ;; F.Potorti@cnuce.cnr.it ;; Keywords: wp, hypermedia, comm, languages diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 4d8a74323c7..60aabc32c9f 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -1,6 +1,6 @@ ;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*- -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Keywords: wp, convenience ;; Author: Takaaki Ota @@ -559,7 +559,7 @@ ;; Todo: (in the order of priority, some are just possibility) ;; ----- ;; -;; Fix compatibilities with other input method than quail +;; Fix incompatibilities with input methods other than quail ;; Resolve conflict with flyspell ;; Use mouse for resizing cells ;; A mechanism to link cells internally diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 7b16262233d..dce99607074 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1,9 +1,9 @@ ;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- coding: utf-8 -*- -;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2013 Free +;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2014 Free ;; Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: tex ;; Contributions over the years by William F. Schelter, Dick King, @@ -2680,6 +2680,8 @@ Runs the shell command defined by `tex-show-queue-command'." (defvar tex-indent-item tex-indent-basic) (defvar tex-indent-item-re "\\\\\\(bib\\)?item\\>") (defvar latex-noindent-environments '("document")) +(put 'latex-noindent-environments 'safe-local-variable + (lambda (x) (null (delq t (mapcar 'stringp x))))) (defvar tex-latex-indent-syntax-table (let ((st (make-syntax-table tex-mode-syntax-table))) @@ -2801,7 +2803,7 @@ There might be text before point." (t (let ((col (current-column))) (if (or (not (eq (char-syntax (or (char-after pos) ?\s)) ?\()) - ;; Can't be an arg if there's an empty line inbetween. + ;; Can't be an arg if there's an empty line in between. (save-excursion (re-search-forward "^[ \t]*$" pos t))) ;; If the first char was not an open-paren, there's ;; a risk that this is really not an argument to the diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index ed6ed4932e9..218b6dbc709 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -1,6 +1,6 @@ ;;; texinfmt.el --- format Texinfo files into Info files -;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2013 Free Software +;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2014 Free Software ;; Foundation, Inc. ;; Maintainer: Robert J. Chassell diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 44e839d2474..e1e2656275c 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -1,11 +1,11 @@ ;;; texinfo.el --- major mode for editing Texinfo files -*- coding: utf-8 -*- -;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2013 Free Software +;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2014 Free Software ;; Foundation, Inc. ;; Author: Robert J. Chassell ;; Date: [See date below for texinfo-version] -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: maint, tex, docs ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index 40c96ad5fb5..e345f8a5028 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1,6 +1,6 @@ ;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files -;; Copyright (C) 1989-1992, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1989-1992, 2001-2014 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: bug-texinfo@gnu.org diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index d9ff04c9b2f..727697b5533 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -1,9 +1,9 @@ ;;; text-mode.el --- text mode, and its idiosyncratic commands -;; Copyright (C) 1985, 1992, 1994, 2001-2013 Free Software Foundation, +;; Copyright (C) 1985, 1992, 1994, 2001-2014 Free Software Foundation, ;; Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp ;; Package: emacs @@ -51,6 +51,27 @@ Use (derived-mode-p 'text-mode) instead.") (defvar text-mode-map (let ((map (make-sparse-keymap))) (define-key map "\e\t" 'ispell-complete-word) + (define-key map [menu-bar text] + (cons "Text" (make-sparse-keymap "Text"))) + (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill] + '(menu-item "Auto Fill" toggle-text-mode-auto-fill + :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook)) + :help "Automatically fill text while typing in text modes (Auto Fill mode)")) + (bindings--define-key map [menu-bar text paragraph-indent-minor-mode] + '(menu-item "Paragraph Indent" paragraph-indent-minor-mode + :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode)) + :help "Toggle paragraph indent minor mode")) + (bindings--define-key map [menu-bar text sep] menu-bar-separator) + (bindings--define-key map [menu-bar text center-region] + '(menu-item "Center Region" center-region + :help "Center the marked region" + :enable (region-active-p))) + (bindings--define-key map [menu-bar text center-paragraph] + '(menu-item "Center Paragraph" center-paragraph + :help "Center the current paragraph")) + (bindings--define-key map [menu-bar text center-line] + '(menu-item "Center Line" center-line + :help "Center the current line")) map) "Keymap for `text-mode'. Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode', @@ -101,9 +122,10 @@ Turning on Paragraph-Indent minor mode runs the normal hook (concat ps-re paragraph-start))))) ;; Change the indentation function. (if paragraph-indent-minor-mode - (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) - (if (eq indent-line-function 'indent-to-left-margin) - (set (make-local-variable 'indent-line-function) 'indent-region)))) + (add-function :override (local 'indent-line-function) + #'indent-to-left-margin) + (remove-function (local 'indent-line-function) + #'indent-to-left-margin))) (defalias 'indented-text-mode 'text-mode) diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 3ba19bb9f40..9732e7fa649 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -1,6 +1,6 @@ ;;; tildify.el --- adding hard spaces into texts -;; Copyright (C) 1997-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Milan Zamazal ;; Version: 4.5 @@ -40,7 +40,7 @@ ;; The default variable settings are suited for Czech, so do not try to ;; understand them if you are not familiar with Czech grammar and spelling. ;; -;; The algorithm was inspired by Petr Olk's program `vlna'. Abilities of +;; The algorithm was inspired by Petr Olšák's program `vlna'. Abilities of ;; `tildify.el' are a little limited; if you have improvement suggestions, let ;; me know. @@ -349,7 +349,7 @@ further questions)." ;; Local variables: -;; coding: iso-latin-2 +;; coding: utf-8 ;; End: ;;; tildify.el ends here diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index 23e90552096..a2d605e2218 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el @@ -1,6 +1,6 @@ ;;; two-column.el --- minor mode for editing of two-column text -;; Copyright (C) 1992-1995, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-1995, 2001-2014 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer ;; Adapted-By: ESR, Daniel Pfeiffer @@ -349,6 +349,9 @@ accepting the proposed default buffer. (if b1 (setq 2C-window-width (- (frame-width) b1))) (2C-two-columns b2))) +(autoload 'scroll-bar-columns "scroll-bar") +(eval-when-compile + (require 'fringe)) ; fringe-columns defsubst ;;;###autoload (defun 2C-split (arg) diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el index 485ccd80ac8..deda372a638 100644 --- a/lisp/textmodes/underline.el +++ b/lisp/textmodes/underline.el @@ -1,8 +1,8 @@ ;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs -;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: wp ;; This file is part of GNU Emacs. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 9526cb76e74..ea5819e4889 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -1,9 +1,9 @@ ;;; thingatpt.el --- get the `thing' at point -;; Copyright (C) 1991-1998, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-1998, 2000-2014 Free Software Foundation, Inc. ;; Author: Mike Williams -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: extensions, matching, mouse ;; Created: Thu Mar 28 13:48:23 1991 @@ -84,64 +84,70 @@ positions of the thing found." (if (get thing 'bounds-of-thing-at-point) (funcall (get thing 'bounds-of-thing-at-point)) (let ((orig (point))) - (condition-case nil - (save-excursion - ;; Try moving forward, then back. - (funcall ;; First move to end. - (or (get thing 'end-op) - (lambda () (forward-thing thing 1)))) - (funcall ;; Then move to beg. - (or (get thing 'beginning-op) - (lambda () (forward-thing thing -1)))) - (let ((beg (point))) - (if (<= beg orig) - ;; If that brings us all the way back to ORIG, - ;; it worked. But END may not be the real end. - ;; So find the real end that corresponds to BEG. - ;; FIXME: in which cases can `real-end' differ from `end'? - (let ((real-end - (progn - (funcall - (or (get thing 'end-op) - (lambda () (forward-thing thing 1)))) - (point)))) - (when (and (<= orig real-end) (< beg real-end)) - (cons beg real-end))) - (goto-char orig) - ;; Try a second time, moving backward first and then forward, - ;; so that we can find a thing that ends at ORIG. - (funcall ;; First, move to beg. - (or (get thing 'beginning-op) - (lambda () (forward-thing thing -1)))) - (funcall ;; Then move to end. - (or (get thing 'end-op) - (lambda () (forward-thing thing 1)))) - (let ((end (point)) - (real-beg + (ignore-errors + (save-excursion + ;; Try moving forward, then back. + (funcall ;; First move to end. + (or (get thing 'end-op) + (lambda () (forward-thing thing 1)))) + (funcall ;; Then move to beg. + (or (get thing 'beginning-op) + (lambda () (forward-thing thing -1)))) + (let ((beg (point))) + (if (<= beg orig) + ;; If that brings us all the way back to ORIG, + ;; it worked. But END may not be the real end. + ;; So find the real end that corresponds to BEG. + ;; FIXME: in which cases can `real-end' differ from `end'? + (let ((real-end (progn (funcall - (or (get thing 'beginning-op) - (lambda () (forward-thing thing -1)))) + (or (get thing 'end-op) + (lambda () (forward-thing thing 1)))) (point)))) - (if (and (<= real-beg orig) (<= orig end) (< real-beg end)) - (cons real-beg end)))))) - (error nil))))) + (when (and (<= orig real-end) (< beg real-end)) + (cons beg real-end))) + (goto-char orig) + ;; Try a second time, moving backward first and then forward, + ;; so that we can find a thing that ends at ORIG. + (funcall ;; First, move to beg. + (or (get thing 'beginning-op) + (lambda () (forward-thing thing -1)))) + (funcall ;; Then move to end. + (or (get thing 'end-op) + (lambda () (forward-thing thing 1)))) + (let ((end (point)) + (real-beg + (progn + (funcall + (or (get thing 'beginning-op) + (lambda () (forward-thing thing -1)))) + (point)))) + (if (and (<= real-beg orig) (<= orig end) (< real-beg end)) + (cons real-beg end)))))))))) ;;;###autoload -(defun thing-at-point (thing) +(defun thing-at-point (thing &optional no-properties) "Return the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', `email', `word', `sentence', `whitespace', `line', `number', and `page'. +When the optional argument NO-PROPERTIES is non-nil, +strip text properties from the return value. + See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING." - (if (get thing 'thing-at-point) - (funcall (get thing 'thing-at-point)) - (let ((bounds (bounds-of-thing-at-point thing))) - (if bounds - (buffer-substring (car bounds) (cdr bounds)))))) + (let ((text + (if (get thing 'thing-at-point) + (funcall (get thing 'thing-at-point)) + (let ((bounds (bounds-of-thing-at-point thing))) + (when bounds + (buffer-substring (car bounds) (cdr bounds))))))) + (when (and text no-properties) + (set-text-properties 0 (length text) nil text)) + text)) ;; Go to beginning/end @@ -182,7 +188,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." (defun end-of-sexp () "Move point to the end of the current sexp. \[This is an internal function.]" - (let ((char-syntax (char-syntax (char-after)))) + (let ((char-syntax (syntax-after (point)))) (if (or (eq char-syntax ?\)) (and (eq char-syntax ?\") (in-string-p))) (forward-char 1) @@ -210,21 +216,19 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." \[Internal function used by `bounds-of-thing-at-point'.]" (save-excursion (let ((opoint (point)) - (beg (condition-case nil - (progn (up-list -1) - (point)) - (error nil)))) - (condition-case nil - (if beg - (progn (forward-sexp) - (cons beg (point))) - ;; Are we are at the beginning of a top-level sexp? - (forward-sexp) - (let ((end (point))) - (backward-sexp) - (if (>= opoint (point)) - (cons opoint end)))) - (error nil))))) + (beg (ignore-errors + (up-list -1) + (point)))) + (ignore-errors + (if beg + (progn (forward-sexp) + (cons beg (point))) + ;; Are we are at the beginning of a top-level sexp? + (forward-sexp) + (let ((end (point))) + (backward-sexp) + (if (>= opoint (point)) + (cons opoint end)))))))) ;; Defuns @@ -351,7 +355,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)." (if found (cons (match-beginning 1) (match-end 1)))))) -(defun thing-at-point--bounds-of-well-formed-url (beg end pt) +(defun thing-at-point--bounds-of-well-formed-url (beg end _pt) (save-excursion (goto-char beg) (let (url-beg paren-end regexp) @@ -446,16 +450,14 @@ looks like an email address, \"ftp://\" if it starts with htb ret) (while htbs (setq htb (car htbs) htbs (cdr htbs)) - (condition-case nil - (progn - ;; errs: htb symbol may be unbound, or not a hash-table. - ;; gnus-gethash is just a macro for intern-soft. - (and (symbol-value htb) - (intern-soft string (symbol-value htb)) - (setq ret string htbs nil)) - ;; If we made it this far, gnus is running, so ignore "heads": - (setq heads nil)) - (error nil))) + (ignore-errors + ;; errs: htb symbol may be unbound, or not a hash-table. + ;; gnus-gethash is just a macro for intern-soft. + (and (symbol-value htb) + (intern-soft string (symbol-value htb)) + (setq ret string htbs nil)) + ;; If we made it this far, gnus is running, so ignore "heads": + (setq heads nil))) (or ret (not heads) (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string))) (and head (setq head (substring string 0 (match-end 1))) @@ -474,19 +476,22 @@ looks like an email address, \"ftp://\" if it starts with ;; matches that straddle the start position so we search forwards once ;; and then back repeatedly and then back up a char at a time. -(defun thing-at-point-looking-at (regexp) +(defun thing-at-point-looking-at (regexp &optional distance) "Return non-nil if point is in or just after a match for REGEXP. Set the match data from the earliest such match ending at or after point." (save-excursion - (let ((old-point (point)) match) + (let ((old-point (point)) + (forward-bound (and distance (+ (point) distance))) + (backward-bound (and distance (- (point) distance))) + match) (and (looking-at regexp) (>= (match-end 0) old-point) (setq match (point))) ;; Search back repeatedly from end of next match. ;; This may fail if next match ends before this match does. - (re-search-forward regexp nil 'limit) - (while (and (re-search-backward regexp nil t) + (re-search-forward regexp forward-bound 'limit) + (while (and (re-search-backward regexp backward-bound t) (or (> (match-beginning 0) old-point) (and (looking-at regexp) ; Extend match-end past search start (>= (match-end 0) old-point) @@ -516,7 +521,8 @@ with angle brackets.") (put 'email 'bounds-of-thing-at-point (lambda () - (let ((thing (thing-at-point-looking-at thing-at-point-email-regexp))) + (let ((thing (thing-at-point-looking-at + thing-at-point-email-regexp 500))) (if thing (let ((beginning (match-beginning 0)) (end (match-end 0))) @@ -529,60 +535,11 @@ with angle brackets.") (buffer-substring-no-properties (car boundary-pair) (cdr boundary-pair)))))) -;; Whitespace - -(defun forward-whitespace (arg) - "Move point to the end of the next sequence of whitespace chars. -Each such sequence may be a single newline, or a sequence of -consecutive space and/or tab characters. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (if (natnump arg) - (re-search-forward "[ \t]+\\|\n" nil 'move arg) - (while (< arg 0) - (if (re-search-backward "[ \t]+\\|\n" nil 'move) - (or (eq (char-after (match-beginning 0)) ?\n) - (skip-chars-backward " \t"))) - (setq arg (1+ arg))))) - ;; Buffer (put 'buffer 'end-op (lambda () (goto-char (point-max)))) (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) -;; Symbols - -(defun forward-symbol (arg) - "Move point to the next position that is the end of a symbol. -A symbol is any sequence of characters that are in either the -word constituent or symbol constituent syntax class. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (if (natnump arg) - (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg) - (while (< arg 0) - (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) - (skip-syntax-backward "w_")) - (setq arg (1+ arg))))) - -;; Syntax blocks - -(defun forward-same-syntax (&optional arg) - "Move point past all characters with the same syntax class. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (or arg (setq arg 1)) - (while (< arg 0) - (skip-syntax-backward - (char-to-string (char-syntax (char-before)))) - (setq arg (1+ arg))) - (while (> arg 0) - (skip-syntax-forward (char-to-string (char-syntax (char-after)))) - (setq arg (1- arg)))) - ;; Aliases (defun word-at-point () @@ -608,9 +565,8 @@ Signal an error if the entire string was not used." (car read-data)))) (defun form-at-point (&optional thing pred) - (let ((sexp (condition-case nil - (read-from-whole-string (thing-at-point (or thing 'sexp))) - (error nil)))) + (let ((sexp (ignore-errors + (read-from-whole-string (thing-at-point (or thing 'sexp)))))) (if (or (not pred) (funcall pred sexp)) sexp))) ;;;###autoload diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 3d591303414..de2fd21a01b 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -1,9 +1,9 @@ ;;; thumbs.el --- Thumbnails previewer for images files -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Jean-Philippe Theberge -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: Multimedia ;; This file is part of GNU Emacs. @@ -57,6 +57,7 @@ ;;; Code: (require 'dired) +(require 'cl-lib) ; for cl-gensym ;; CUSTOMIZATIONS @@ -179,21 +180,6 @@ this value can let another user see some of your images." (make-variable-buffer-local 'thumbs-marked-list) (put 'thumbs-marked-list 'permanent-local t) -(defalias 'thumbs-gensym - (if (fboundp 'gensym) - 'gensym - ;; Copied from cl-macs.el - (defvar thumbs-gensym-counter 0) - (lambda (&optional prefix) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 thumbs-gensym-counter - (setq thumbs-gensym-counter - (1+ thumbs-gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))))) - (defsubst thumbs-temp-dir () (file-name-as-directory (expand-file-name thumbs-temp-dir))) @@ -202,7 +188,7 @@ The name is made by appending a number to PREFIX, default \"G\"." (format "%s%s-%s.jpg" (thumbs-temp-dir) thumbs-temp-prefix - (thumbs-gensym "T"))) + (cl-gensym "T"))) (defun thumbs-thumbsdir () "Return the current thumbnails directory (from `thumbs-thumbsdir'). diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 8fa5d997945..99d185690d1 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -1,6 +1,6 @@ ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs -;; Copyright (C) 1989, 1993-1995, 1997, 2000-2013 Free Software +;; Copyright (C) 1989, 1993-1995, 1997, 2000-2014 Free Software ;; Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/lisp/time.el b/lisp/time.el index 4b5ecf16be1..ae04077a136 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -1,9 +1,9 @@ ;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*- -;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2013 Free Software +;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -323,8 +323,6 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'." (defun display-time-event-handler () (display-time-update) - ;; Do redisplay right now, if no input pending. - (sit-for 0) (let* ((current (current-time)) (timer display-time-timer) ;; Compute the time when this timer will run again, next. @@ -352,8 +350,7 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1." (interactive) (if (= 3 (setq display-time-load-average (1+ display-time-load-average))) (setq display-time-load-average 0)) - (display-time-update) - (sit-for 0)) + (display-time-update)) (defun display-time-mail-check-directory () (let ((mail-files (directory-files display-time-mail-directory t)) @@ -474,7 +471,7 @@ update which can wait for the next redisplay." ;; This is inside the let binding, but we are not going to document ;; what variables are available. (run-hooks 'display-time-hook)) - (force-mode-line-update)) + (force-mode-line-update 'all)) (defun display-time-file-nonempty-p (file) (let ((remote-file-name-inhibit-cache (- display-time-interval 5))) diff --git a/lisp/timezone.el b/lisp/timezone.el index 4b501624b1c..1135092b039 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el @@ -1,6 +1,6 @@ ;;; timezone.el --- time zone package for GNU Emacs -;; Copyright (C) 1990-1993, 1996, 1999, 2001-2013 Free Software +;; Copyright (C) 1990-1993, 1996, 1999, 2001-2014 Free Software ;; Foundation, Inc. ;; Author: Masanobu Umeda diff --git a/lisp/tmm.el b/lisp/tmm.el index cd91742649d..09729755c14 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -1,9 +1,9 @@ ;;; tmm.el --- text mode access to menu-bar -*- lexical-binding: t -*- -;; Copyright (C) 1994-1996, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1996, 2000-2014 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience ;; This file is part of GNU Emacs. @@ -50,7 +50,11 @@ "Text-mode emulation of looking and choosing from a menubar. See the documentation for `tmm-prompt'. X-POSITION, if non-nil, specifies a horizontal position within the menu bar; -we make that menu bar item (the one at that position) the default choice." +we make that menu bar item (the one at that position) the default choice. + +Note that \\[menu-bar-open] by default drops down TTY menus; if you want it +to invoke `tmm-menubar' instead, customize the variable +\`tty-menu-open-use-tmm' to a non-nil value." (interactive) (run-hooks 'menu-bar-update-hook) ;; Obey menu-bar-final-items; put those items last. @@ -145,6 +149,8 @@ specify nil for this variable." '(metadata (display-sort-function . identity)) (complete-with-action action items string pred)))) +(defvar tmm--history nil) + ;;;###autoload (defun tmm-prompt (menu &optional in-popup default-item) "Text-mode emulation of calling the bindings in keymap. @@ -163,7 +169,7 @@ Its value should be an event that has a binding in MENU." ;; That is used for recursive calls only. (let ((gl-str "Menu bar") ;; The menu bar itself is not a menu keymap ; so it doesn't have a name. - tmm-km-list out history history-len tmm-table-undef tmm-c-prompt + tmm-km-list out history-len tmm-table-undef tmm-c-prompt tmm-old-mb-map tmm-short-cuts chosen-string choice (not-menu (not (keymapp menu)))) @@ -217,16 +223,18 @@ Its value should be an event that has a binding in MENU." (setq index-of-default (1+ index-of-default))) (setq tail (cdr tail))))) (let ((prompt (concat "^." (regexp-quote tmm-mid-prompt)))) - (setq history + (setq tmm--history (reverse (delq nil (mapcar (lambda (elt) (if (string-match prompt (car elt)) (car elt))) tmm-km-list))))) - (setq history-len (length history)) - (setq history (append history history history history)) - (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history)) + (setq history-len (length tmm--history)) + (setq tmm--history (append tmm--history tmm--history + tmm--history tmm--history)) + (setq tmm-c-prompt (nth (- history-len 1 index-of-default) + tmm--history)) (setq out (if default-item (car (nth index-of-default tmm-km-list)) @@ -235,7 +243,7 @@ Its value should be an event that has a binding in MENU." (concat gl-str " (up/down to change, PgUp to menu): ") (tmm--completion-table tmm-km-list) nil t nil - (cons 'history + (cons 'tmm--history (- (* 2 history-len) index-of-default)))))))) (setq choice (cdr (assoc out tmm-km-list))) (and (null choice) diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 506e11399ba..6e5c8b7c44c 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,6 +1,6 @@ ;;; tool-bar.el --- setting up the tool bar -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Keywords: mouse frames diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 261e34b440e..059370f2eee 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -1,6 +1,6 @@ ;;; tooltip.el --- show tooltip windows -;; Copyright (C) 1997, 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999-2014 Free Software Foundation, Inc. ;; Author: Gerd Moellmann ;; Keywords: help c mouse tools @@ -58,9 +58,7 @@ echo area, instead of making a pop-up window." :init-value t :initialize 'custom-initialize-delay :group 'tooltip - (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) - (error "Sorry, tooltips are not yet available on this system")) - (if tooltip-mode + (if (and tooltip-mode (fboundp 'x-show-tip)) (progn (add-hook 'pre-command-hook 'tooltip-hide) (add-hook 'tooltip-functions 'tooltip-help-tips)) @@ -151,7 +149,7 @@ This variable is obsolete; instead of setting it to t, disable :group 'tooltip) (make-obsolete-variable 'tooltip-use-echo-area - "disable Tooltip mode instead" "24.1") + "disable Tooltip mode instead" "24.1" 'set) ;;; Variables that are not customizable. diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index 2f73aee3ed4..a48c50ff219 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el @@ -1,6 +1,6 @@ ;;; tree-widget.el --- Tree widget -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: David Ponce ;; Maintainer: David Ponce diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 39eb9e8b9aa..8925a02a9e7 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -1,8 +1,8 @@ ;;; tutorial.el --- tutorial for Emacs -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: help, internal ;; Package: emacs @@ -156,7 +156,7 @@ options: " RET instead.")) (insert "\n\nWith your current key bindings" " you can use " - (if (string-match "^the .*menus?$" where) + (if (string-match-p "^the .*menus?$" where) "" "the key") where @@ -346,10 +346,8 @@ from the Emacs default:\n\n" ) (def-fun-txt (nth 2 tk)) (where (nth 3 tk)) (remark (nth 4 tk)) - (rem-fun (command-remapping def-fun)) (key-txt (key-description key)) - (key-fun (with-current-buffer tutorial-buffer (key-binding key))) - tot-len) + (key-fun (with-current-buffer tutorial-buffer (key-binding key)))) (unless (eq def-fun key-fun) ;; Insert key binding description: (when (string= key-txt explain-key-desc) @@ -723,9 +721,7 @@ See `tutorial--save-tutorial' for more information." saved-file (error-message-string err)))) ;; An error is raised here?? Is this a bug? - (condition-case nil - (undo-only) - (error nil)) + (ignore-errors (undo-only)) ;; Restore point (goto-char old-point) (if save-err @@ -881,7 +877,7 @@ Run the Viper tutorial? ")) ;; or just delete the <<...>> line if a [...] line follows. (cond ((save-excursion (forward-line 1) - (looking-at "\\[")) + (looking-at-p "\\[")) (delete-region (point) (progn (forward-line 1) (point)))) ((looking-at "<>") (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) @@ -896,7 +892,7 @@ Run the Viper tutorial? ")) ;; inserted at the start of the buffer, the "type C-v to ;; move to the next screen" might not be visible on the ;; first screen (n < 0). How will the novice know what to do? - (let ((n (- (window-height (selected-window)) + (let ((n (- (window-height) (count-lines (point-min) (point)) 6))) (if (< n 8) diff --git a/lisp/type-break.el b/lisp/type-break.el index 212ac392e01..f954e5d1c26 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1,7 +1,6 @@ ;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*- -;; Copyright (C) 1994-1995, 1997, 2000-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1994-1995, 1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Maintainer: Noah Friedman @@ -95,7 +94,7 @@ When this variable is non-nil, its value is considered to be a \"good\" length (in seconds) for a break initiated by the command `type-break', overriding `type-break-good-rest-interval'. This provides querying of break interruptions when `type-break-good-rest-interval' is nil." - :type 'integer + :type '(choice (const nil) integer) :group 'type-break) (defcustom type-break-keystroke-threshold @@ -204,11 +203,12 @@ key is pressed." :type 'boolean :group 'type-break) -(defcustom type-break-file-name (convert-standard-filename "~/.type-break") +(defcustom type-break-file-name + (locate-user-emacs-file "type-break" ".type-break") "Name of file used to save state across sessions. If this is nil, no data will be saved across sessions." - :type 'file - :group 'type-break) + :version "24.4" ; added locate-user + :type 'file) (defvar type-break-post-command-hook '(type-break-check) "Hook run indirectly by `post-command-hook' for typing break functions. @@ -418,7 +418,7 @@ Variables controlling the display of messages in the mode line include: `global-mode-string' `type-break-mode-line-break-message' `type-break-mode-line-warning'" - :global t) + :global t :group 'type-break) (define-minor-mode type-break-query-mode "Toggle typing break queries. @@ -428,7 +428,7 @@ enable them if ARG is omitted or nil. The user may also enable or disable this mode simply by setting the variable of the same name." - :global t) + :global t :group 'type-break) ;;; session file functions diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 546796b619a..5d973c72897 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,10 +1,10 @@ ;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*- -;; Copyright (C) 1989, 1995-1997, 2001-2013 Free Software Foundation, +;; Copyright (C) 1989, 1995-1997, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Dick King -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: files ;; Created: 15 May 86 ;; Package: emacs @@ -93,7 +93,7 @@ :group 'files) -(defcustom uniquify-buffer-name-style nil +(defcustom uniquify-buffer-name-style 'post-forward-angle-brackets "If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of `forward', `reverse', `post-forward', or `post-forward-angle-brackets'. @@ -111,6 +111,7 @@ of `uniquify-strip-common-suffix'." (const post-forward) (const post-forward-angle-brackets) (const :tag "standard Emacs behavior (nil)" nil)) + :version "24.4" :require 'uniquify :group 'uniquify) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f8f24de6b68..0cdcc139905 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,113 @@ +2014-02-05 Glenn Morris + + * url-cookie.el (url-cookie-list): Doc fix. + +2014-01-25 Rüdiger Sonderfeld + + * url-vars.el (url): Link to info manual. + +2014-01-08 Jarosław Rzeszótko (tiny change) + + * url-http.el (url-http-create-request): Don't add extra \r\n after + http data (bug#16220). + +2013-12-28 Glenn Morris + + * url-history.el (url-history-track): + * url-vars.el (url-honor-refresh-requests): Fix custom types. + +2013-12-20 Leo Liu + + * url.el (url-retrieve-synchronously): Add optional arg SILENT and + INHIBIT-COOKIES. + +2013-09-29 Leo Liu + + * url-util.el (url-pretty-length): Make obsolete and all uses + changed to file-size-human-readable. + +2013-09-18 Glenn Morris + + * url-http.el (zlib-decompress-region): Declare. + +2013-09-16 Glenn Morris + + * url-misc.el (url-data): Avoid match-data mix-up with base64 case. + Use Content-Transfer-Encoding rather than Content-Encoding. (Bug#15285) + +2013-09-13 Glenn Morris + + * url-http.el (url-handle-content-transfer-encoding): + * url-vars.el (url-mime-encoding-string): Silence compiler. + +2013-08-14 Lars Magne Ingebrigtsen + + * url-http.el (url-http-parse-headers): Always place point at the + start of the buffer instead of just 80% of the time. + +2013-08-12 Lars Magne Ingebrigtsen + + * url-http.el (url-handle-content-transfer-encoding): Renamed + `zlib-decompress-gzipped-region' and check whether it's available, + too. + (url-handle-content-transfer-encoding): Renamed + `zlib-decompress-region' again. + +2013-08-11 Lars Magne Ingebrigtsen + + * url-vars.el (url-mime-encoding-string): If we have built-in gzip + support, say that we accept gzipped content. + + * url-http.el (url-handle-content-transfer-encoding): Support + decompressing gzipped content. + +2013-07-31 Stefan Monnier + + * url-handlers.el (url-file-name-completion) + (url-file-name-all-completions): Don't signal errors (bug#14806). + +2013-07-22 Stefan Monnier + + * url-http.el (status): Remove, unused. + (success): Remove var. + (url-http-handle-authentication): Return the value that `success' + should take instead of setting `success' directly. Don't set `status' + since it's not used. + (url-http-parse-headers): Avoid unneeded setq. + Move the `setq success'. + (url-http): Use pcase. + (url-http-file-exists-p): Simplify. + +2013-06-26 Lars Magne Ingebrigtsen + + * url-cookie.el: Implement a command and mode for displaying and + editing cookies. + (url-cookie-mode): Fix mode name. + +2013-06-21 Glenn Morris + + * url-future.el (url-future-call): Remove useless value call. + +2013-05-23 Glenn Morris + + * url.el (mm-dissect-buffer, mm-display-part): Declare. + +2013-05-22 Glenn Morris + + * url-handlers.el (mm-save-part-to-file, mm-destroy-parts) + (mm-decode-string, mail-content-type-get): Declare. + +2013-05-21 Glenn Morris + + * url-dav.el (url-http): Require it. + (url-http-head-file-attributes): Don't autoload it. + + * url-proxy.el (url-http): Autoload it. + +2013-05-15 Glenn Morris + + * url-news.el (url-news): Remove empty custom group. + 2013-02-16 Glenn Morris * url-http.el (url-http-wait-for-headers-change-function): @@ -194,7 +304,7 @@ 2012-04-10 Lars Magne Ingebrigtsen - * url-domsurf.el: New file (bug#1401). + * url-domsuf.el: New file (bug#1401). * url-cookie.el (url-cookie-two-dot-domains): Remove. (url-cookie-host-can-set-p): Use `url-domsuf-cookie-allowed-p' @@ -1507,6 +1617,16 @@ * url-cookie.el (url-cookie-multiple-line): Fix spelling in docstring. +2005-06-04 David Reitter (tiny change) + + * url-http.el (url-http-chunked-encoding-after-change-function): + Use `url-http-debug' instead of `message'. + +2005-06-04 Thierry Emery (tiny change) + + * url-http.el (url-http-parse-headers): Pass redirected URL + as a callback argument. + 2005-05-19 Juanma Barranquero * url-cookie.el (url-cookie-multiple-line): @@ -1530,6 +1650,11 @@ * url.el (url-retrieve-synchronously): Work around the fact that url-http sometimes doesn't call the callback. +2005-04-10 Chong Yidong + + * url-ldap.el (url-ldap): Add docstring. Fix call to + `ldap-search-internal'. + 2005-04-04 Lute Kamstra * url-handlers.el (url-handler-mode): Specify :group. @@ -1788,27 +1913,27 @@ 2003-07-16 Dave Love - * lisp/url.el (url-retrieve-synchronously): Revert last change. + * url.el (url-retrieve-synchronously): Revert last change. Should be revisited. 2003-06-26 Sam Steingold - * lisp/url-handlers.el (url-handlers-create-wrapper): Do not call + * url-handlers.el (url-handlers-create-wrapper): Do not call method on invalid urls. 2003-05-29 Dave Love - * lisp/url.el (url-retrieve-synchronously): Use sleep-for, not + * url.el (url-retrieve-synchronously): Use sleep-for, not sit-for. From monnier@gnu.org. 2002-11-04 Walter C. Pelissero - * lisp/url-methods.el (url-scheme-register-proxy): Make sure to convert + * url-methods.el (url-scheme-register-proxy): Make sure to convert port numbers to integers when creating the URL objects for proxies. 2002-10-29 William M. Perry - * lisp/url-http.el (url-http-parse-headers): When doing a + * url-http.el (url-http-parse-headers): When doing a redirect, some broken software (sourceforge) sends a redirect to '/', which is blatantly illegal (see section 14.30 of the HTTP/1.1 specification). I wish we could deal with such lame software @@ -1817,13 +1942,13 @@ 2002-10-27 William M. Perry - * lisp/url-http.el (url-http-create-request): If we are talking to + * url-http.el (url-http-create-request): If we are talking to the default port for a the selected protocol, do NOT send the port in the HOST header. This fixes the login page at sourceforge. 2002-09-17 William M. Perry - * lisp/url-http.el (url-http-handle-cookies): New function to deal + * url-http.el (url-http-handle-cookies): New function to deal with cookie headers. (url-http-parse-headers): Call `url-http-handle-cookies' here so that cookie additions and deletions get handled immediately. @@ -1835,67 +1960,56 @@ methods to GET in redirects. Too many web sites do this now, and it is just likely to confuse users. -2002-05-17 Dave Love - - * texi/url.txi: Start making it vaguely useful. - - * texi/Makefile.in (install): Cope with Debian install-info. - From Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Grossjohann). - 2002-04-22 Dave Love - * lisp/url-misc.el (man): Autoload to avoid warning. + * url-misc.el (man): Autoload to avoid warning. (url-man): Don't require man here. (url-data): Generalize in line with the RFC. - * lisp/url-gw.el (url-open-stream): Remove obsolete `tcp' case. + * url-gw.el (url-open-stream): Remove obsolete `tcp' case. - * lisp/url-vars.el: Doc fixes. + * url-vars.el: Doc fixes. (url-mime-charset-string): New function. (url-mime-charset-string): Use it to set the variable. (url-set-mime-charset-string): New function. (set-language-environment-hook): Use it. (url-vars-unload-hook): New function. - * lisp/url-cookie.el (url-header-comparison): Delete. + * url-cookie.el (url-header-comparison): Delete. (url-cookie-handle-set-cookie): Use assoc-ignore-case to avoid assoc*. (url-cookie-save-interval): Make value agree with doc. - * lisp/url.el: Doc fixes. + * url.el: Doc fixes. (url-mm-callback): Don't call mm-destroy-parts immediately for external viewing -- set up a process sentinel. -2002-02-02 William M. Perry - - * lisp/Makefile.in (SOURCES): Remove mule-sysdp.el from the build rules. - 2001-12-12 William M. Perry - * lisp/url-vars.el (url-nonrelative-link): Patch from Stefan + * url-vars.el (url-nonrelative-link): Patch from Stefan Monnier to use ` instead of ^ to match the relative link. 2001-12-10 William M. Perry - * lisp/url-dav.el (url-dav-file-attributes): Fix bad call to + * url-dav.el (url-dav-file-attributes): Fix bad call to plist-get (reversed args). - * lisp/url-file.el (url-file-build-filename): Make sure that we + * url-file.el (url-file-build-filename): Make sure that we have a parsed URL in this function. 2002-01-22 Dave Love - * lisp/url-cache.el (url-cache-file-writable-p): Doc fix. + * url-cache.el (url-cache-file-writable-p): Doc fix. - * lisp/url-imap.el (url-imap): Maybe disable multibyte. + * url-imap.el (url-imap): Maybe disable multibyte. Bind coding-system-for-read. Require mm-util. - * lisp/url.el (url-do-setup): Use (featurep 'xemacs). + * url.el (url-do-setup): Use (featurep 'xemacs). - * lisp/mule-sysdp.el: Removed (obsolete). + * mule-sysdp.el: Removed (obsolete). 2001-12-09 William M. Perry - * lisp/url-dav.el (url-dav-delete-something): Utility macro to + * url-dav.el (url-dav-delete-something): Utility macro to remove an arbitrary resource. (url-dav-delete-directory): Use it. (url-dav-delete-file): Ditto. @@ -1908,14 +2022,14 @@ 2001-12-08 William M. Perry - * lisp/url-dav.el (url-dav-directory-files): New function to + * url-dav.el (url-dav-directory-files): New function to mimic `directory-files' for WebDAV. (url-dav-delete-directory): New function to mimic `delete-directory' for WebDAV. 2001-12-06 William M. Perry - * lisp/url-dav.el (url-dav-process-DAV:locktoken): Parse the + * url-dav.el (url-dav-process-DAV:locktoken): Parse the DAV:locktoken hrefs into a usable format. (url-dav-process-response): Use an unwind-protect to make sure that we clean up the buffer, even if there is a parsing error. @@ -1938,23 +2052,23 @@ using the PUT method. I can now successfully save files to an HTTP server with some manual steps from a lisp-interaction buffer. - * lisp/url-http.el (url-http-wait-for-headers-change-function): + * url-http.el (url-http-wait-for-headers-change-function): Special case the 204/205 response codes. Some servers do not send back a 0 content-length for these, and we would hang. (url-http-parse-headers): Mark 204/205 response codes as 'successful' so that the callbacks get activated. (url-http-options): Fix unbound variable usage. - * lisp/url-dav.el: Added full copyright information. + * url-dav.el: Added full copyright information. (url-dav-process-response): Make sure that we create a DAV:status property when parsing a singleton response. (url-dav-file-attributes): If the properties returned did not have a successful HTTP response code, then ignore them and use the HEAD-based attributes. - * lisp/vc-dav.el: Added full copyright information. + * vc-dav.el: Added full copyright information. - * lisp/url-dav.el (url-dav-process-supportedlock-property): + * url-dav.el (url-dav-process-supportedlock-property): Deal with text nodes in DAV:supportedlock nodes. (url-dav-file-attributes-mode-string): This now gets the entire property list instead of just the DAV:supportedlock node. @@ -2009,18 +2123,18 @@ 2001-12-05 William M. Perry - * lisp/url-dav.el (url-dav-get-properties): New argument + * url-dav.el (url-dav-get-properties): New argument ATTRIBUTES that allows you to ask for specific properties instead of getting all properties via DAV:allprop. - * lisp/url-http.el (url-http-real-basic-auth-storage): + * url-http.el (url-http-real-basic-auth-storage): New variable for normal HTTP basic authentication. (url-http-proxy-basic-auth-storage): New variable for HTTP proxy basic authentication. (url-http-handle-authentication): Follow new semantics for url-basic-auth-storage. - * lisp/url-auth.el (url-basic-auth-storage): Change meaning of + * url-auth.el (url-basic-auth-storage): Change meaning of this variable. It is now a symbol pointing to where we really want to store the authorization information. This fixes proxy auth and normal basic auth because of some local bindings that were @@ -2028,13 +2142,13 @@ (url-basic-auth): Make sure we dereference url-basic-auth-storage everywhere. - * lisp/url-util.el (url-debug): Add new types 'dav and + * url-util.el (url-debug): Add new types 'dav and 'retrieval to the customization list. - * lisp/url.el (url-retrieve-synchronously): Put in some debugging + * url.el (url-retrieve-synchronously): Put in some debugging statements. - * lisp/url-http.el (url-http-head-file-attributes): Rename old + * url-http.el (url-http-head-file-attributes): Rename old url-http-file-attributes so that we can have a smarter one that tries WebDAV first, then HEAD. (url-http-file-attributes): New smart version that tries WebDAV first. @@ -2051,7 +2165,7 @@ data. Otherwise we can deadlock if the headers and the entire body exist arrive in one chunk. - * lisp/url-dav.el: New file to contain the WebDAV + * url-dav.el: New file to contain the WebDAV (http://www.webdav.org/) implementation. (url-dav-supported-p): Cheap way to figure out whether we will be able to do DAV at all. We rely on the XML parser expanding @@ -2074,7 +2188,7 @@ 2001-12-04 William M. Perry - * lisp/url-handlers.el (file-name-absolute-p): New hooked + * url-handlers.el (file-name-absolute-p): New hooked version. If the filename matches our regexp, then it is always absolute, so just return `t'. (expand-file-name): New hooked version. If the fragment is an @@ -2083,30 +2197,30 @@ want the file-name-handlers to work off of. (url-setup-file-name-handlers): Use it when installing the handlers. - * lisp/url-http.el (url-http-find-free-connection): Better logging + * url-http.el (url-http-find-free-connection): Better logging about whether we are reusing an existing connection or not. - * lisp/url-methods.el (url-scheme-register-proxy): Fix bad call + * url-methods.el (url-scheme-register-proxy): Fix bad call to string-match instead of match-string (and with reversed arguments even). - * lisp/url-http.el (url-http-debug): Change to now use the + * url-http.el (url-http-debug): Change to now use the generic url-debug function to do the actual logging. Still a separate function so that we can do our magic on the network connection if the user quits while we are downloading. - * lisp/url-handlers.el (url-file-handler): Now logs the result of + * url-handlers.el (url-file-handler): Now logs the result of the hooked or real call. - * lisp/url-util.el (url-debug): New function for generic debug logging. + * url-util.el (url-debug): New function for generic debug logging. 2001-11-28 William M. Perry - * lisp/url-imap.el (url-imap-open-host): Use backquote. + * url-imap.el (url-imap-open-host): Use backquote. (url-imap): Now switches to 'login as the imap authenticator if the URL provides a username and password. - * lisp/url-handlers.el (url-setup-file-name-handlers): Use cl & + * url-handlers.el (url-setup-file-name-handlers): Use cl & push to replace some strange logic in here. (url-run-real-handler): New function to run the real hooks in case we get a false positive or an operation that we do not @@ -2129,7 +2243,7 @@ 2001-11-26 William M. Perry - * lisp/url-handlers.el (file-writable-p): Add NULL handler for + * url-handlers.el (file-writable-p): Add NULL handler for this so that visiting a URL directly will work. (file-symlink-p): Ditto. (url-insert-file-contents): If `visit' is non-nil then make sure @@ -2140,16 +2254,16 @@ 2001-11-25 William M. Perry - * lisp/url-util.el (url-hexify-string): Fix bad use of mapconcat. + * url-util.el (url-hexify-string): Fix bad use of mapconcat. 2001-11-24 William M. Perry - * lisp/url-about.el (url-about): New loader scheme to handle + * url-about.el (url-about): New loader scheme to handle about:foo URLs. Automatically tries to find a `url-about-foo' function to display the actual data. (url-about-protocols): Implement about:protocols. - * lisp/url-http.el (url-http): Make sure that we signal an error + * url-http.el (url-http): Make sure that we signal an error when we cannot open a network connection for whatever reason. Before, it would just silently clean up after itself and the user got absolutely no indication that an error had occurred. If the @@ -2160,13 +2274,13 @@ 2001-11-22 William M. Perry - * lisp/url-https.el: Fixed definition of url-https - was using the + * url-https.el: Fixed definition of url-https - was using the wrong signature. Too much cut & paste. (url-https-create-secure-wrapper): Fix so that url-https works at all. Was not taking a null `method' into account when calling the wrapped function so url-https tried to call url-http-nil. *sigh* - * lisp/url-http.el + * url-http.el (url-http-chunked-encoding-after-change-function): Add some feedback when not debugging about what content-type and chunk # we are reading. @@ -2181,7 +2295,7 @@ 2001-11-21 William M. Perry - * lisp/url-http.el (url-http-debug): Document this variable. + * url-http.el (url-http-debug): Document this variable. People other than I might want to use it. (url-http-debug): Put some code in here to check quit-flag directly. When the chunked encoding went into a tight spin, your @@ -2206,10 +2320,10 @@ url-http-chunked-encoding-after-change-function. It is no longer needed. I should use my brain sometime. - * lisp/url-vars.el (and): Fix feature test for xemacs and + * url-vars.el (and): Fix feature test for xemacs and coding-system-list behavior. - * lisp/url-http.el + * url-http.el (url-http-chunked-encoding-after-change-function): Add optional no-initial-crlf flag that modifies the regular expression. This is only set from url-http-wait-for-headers-change-function so that @@ -2232,78 +2346,78 @@ 2001-10-11 Dave Love - * lisp/url-handlers.el: Doc fixes. + * url-handlers.el: Doc fixes. (string-match): Use (featurep 'xemacs). - * lisp/url-methods.el (url-scheme-get-property): Avoid `mapc'. + * url-methods.el (url-scheme-get-property): Avoid `mapc'. - * lisp/url-proxy.el (url-find-proxy-for-url): Avoid `pop'. + * url-proxy.el (url-find-proxy-for-url): Avoid `pop'. - * lisp/url-vars.el (url-running-xemacs): Delete. + * url-vars.el (url-running-xemacs): Delete. (url-gateway-unplugged): New variable. - * lisp/url-gw.el (url-open-stream): Use url-gateway-unplugged. + * url-gw.el (url-open-stream): Use url-gateway-unplugged. Comment out OS/2 stuff. 2001-10-05 Dave Love - * lisp/url-mailto.el (url-mailto): Don't send auto-generated mail + * url-mailto.el (url-mailto): Don't send auto-generated mail without confirmation. 2001-10-02 Dave Love - * lisp/url-http.el (url-http-create-request): Check cache for + * url-http.el (url-http-create-request): Check cache for proxy-obj, if defined, rather than url. (url-http): Use dolist, not mapc (runtime cl dependency). - * lisp/url-methods.el: Maybe require cl at runtime. + * url-methods.el: Maybe require cl at runtime. (url-scheme-register-proxy): Fix fetching from environment. Don't concat a number. 2001-10-01 Dave Love - * lisp/url-parse.el: Use modern backquote syntax. + * url-parse.el: Use modern backquote syntax. - * lisp/url-vars.el (url-uncompressor-alist): Add bzip2. + * url-vars.el (url-uncompressor-alist): Add bzip2. (url-mail-command): Prefer compose-mail. (tcp-binary-process-input-services): Comment out. (url-working-buffer): New constant. - * lisp/url-util.el (url-extract-mime-headers): New function. + * url-util.el (url-extract-mime-headers): New function. - * lisp/url-mailto.el (url-mailto): Set source-url. Don't add + * url-mailto.el (url-mailto): Set source-url. Don't add User-Agent. 2001-09-20 Dave Love - * lisp/url-http.el (url-http-create-request): Don't concat a number. + * url-http.el (url-http-create-request): Don't concat a number. 2001-06-05 Dave Love - * lisp/url.el (url-do-setup): Doc fix. Don't try to frob + * url.el (url-do-setup): Doc fix. Don't try to frob tcp-binary-process-input-services. Remove function wrapper for lambda. (url-retrieve): Barf with sensible message if url-type is null. - * lisp/url-http.el (url-http): Don't try to set process + * url-http.el (url-http): Don't try to set process coding-system here -- done in url-gw. - * lisp/url-gw.el (url-gw-inhibit-code-conversion): Remove. + * url-gw.el (url-gw-inhibit-code-conversion): Remove. (url-open-stream): Bind coding-system-for{read,write} when setting up the connection. Don't call url-gw-inhibit-code-conversion. 2001-05-24 William M. Perry - * lisp/url.el (url-retrieve-synchronously): Avoid accept-process-output + * url.el (url-retrieve-synchronously): Avoid accept-process-output in url-retrieve-synchronously. 2001-05-23 William M. Perry - * lisp/url.el (url-retrieve-synchronously): Don't put a timeout on + * url.el (url-retrieve-synchronously): Don't put a timeout on accept-process-output. This is evidently causing hangs in Emacs 21 when viewing complex pages with images or stylesheets. www.yahoo.com is now viewable. - * lisp/url-gw.el (url-open-stream): Avoid using mule-sysdp + * url-gw.el (url-open-stream): Avoid using mule-sysdp (mule-inhibit-code-conversion) and just have a local function that does this minimal cruft. (url-gw-inhibit-code-conversion): New function to turn off code @@ -2311,7 +2425,7 @@ 2001-05-22 William M. Perry - * lisp/url.el (url-retrieve-synchronously): Use lexical-let so + * url.el (url-retrieve-synchronously): Use lexical-let so that we can allow multiple asynch retrievals to happen at once. (url-retrieve-synchronously): Use a much smaller timeout when doing the accept-process-output. This gets rid of the long delays @@ -2322,39 +2436,39 @@ (url-retrieve): Ditto. (url-mm-url): Ditto. - * lisp/url-vars.el: Replaced `HTTP/1.0' with just `HTTP' in some + * url-vars.el: Replaced `HTTP/1.0' with just `HTTP' in some documentation strings. Ok, so I'm anal. - * lisp/url-methods.el (url-scheme-methods): Add default methods + * url-methods.el (url-scheme-methods): Add default methods for file-directory-p and file-truename. 2001-05-22 Dave Love - * lisp/url-auth.el (url-warn): Autoload. + * url-auth.el (url-warn): Autoload. - * lisp/url-proxy.el (url-warn): Autoload. + * url-proxy.el (url-warn): Autoload. - * lisp/url-nfs.el: Fix `file-truname' typo. + * url-nfs.el: Fix `file-truname' typo. - * lisp/url-news.el: Require cl when compiling. + * url-news.el: Require cl when compiling. (url-warn, gnus-group-read-ephemeral-group): Autoload. (url-nntp-default-port, url-news-default-port, url-nntp): Delete. (url-news-fetch-newsgroup): Declare gnus-group-buffer special. - * lisp/url-util.el (mule-decode-string): Don't autoload. + * url-util.el (mule-decode-string): Don't autoload. (url-hexify-string): Just barf on multibyte characters. (url-generate-unique-filename): New function. - * lisp/url-file.el (url-file): Use url-generate-unique-filename, + * url-file.el (url-file): Use url-generate-unique-filename, not mm-generate-unique-filename. - * lisp/url-http.el: Declare things special in various places. + * url-http.el: Declare things special in various places. (url-http-activate-callback): Don't set url-http-real-after-change-function. 2001-05-22 William M. Perry - * lisp/url-http.el (url-http-attempt-keepalives): New variable to + * url-http.el (url-http-attempt-keepalives): New variable to control whether we try to do keep-alives for our connections. (url-http-version): New variable to control whether we advertise ourselves as an HTTP/1.1 client or not. This can be useful for @@ -2364,13 +2478,13 @@ 2001-05-21 Dave Love - * lisp/url-vars.el (mm-mime-mule-charset-alist): Don't readjust it + * url-vars.el (mm-mime-mule-charset-alist): Don't readjust it in XEmacs. (url-mime-charset-string): Don't reverse the list before sorting. 2001-05-17 William M. Perry - * lisp/url-http.el (url-http-generic-filter): Avoid using + * url-http.el (url-http-generic-filter): Avoid using after-change-functions natively. There are just too many ways that this screws up in Emacs 21. Use a filter function on the process instead, and call the hook on @@ -2378,111 +2492,111 @@ in Emacs 21, but one problem that has been fixed in Emacs 21 exists in Emacs 20. -- fx] - * lisp/url-vars.el (url-mime-charset-string): sort-coding-systems + * url-vars.el (url-mime-charset-string): sort-coding-systems does not exist on older versions of Emacs, or any version of XEmacs. Do not call it unless it is bound. 2001-05-17 Dave Love - * lisp/url-http.el (url-http-create-request): Fix non-GET requests. + * url-http.el (url-http-create-request): Fix non-GET requests. 2001-05-16 Dave Love - * lisp/url-vars.el: Doc fixes. Require mm-util. + * url-vars.el: Doc fixes. Require mm-util. (url-mime-charset-string): New variable. - * lisp/url-http.el: Doc fixes. + * url-http.el: Doc fixes. (url-http-create-request): Rearrange how we assemble the request. Avoid generating bogus requests with an empty real-fname. (url-http-handle-authentication): Declare status and success special. (url-http): Call mm-disable-multibyte. Set process buffer's coding systems to binary. - * lisp/url-misc.el (url-data): Call mm-disable-multibyte. + * url-misc.el (url-data): Call mm-disable-multibyte. - * lisp/url-file.el: Don't require mule-sysdp. Fix `file-truname' typo. + * url-file.el: Don't require mule-sysdp. Fix `file-truname' typo. (url-file-find-possibly-compressed-file): Doc fix. (url-file): Bind coding-system-for-read. Call mm-disable-multibyte. - * lisp/url-cache.el: Don't require mule-sysdp. + * url-cache.el: Don't require mule-sysdp. (url-store-in-cache): Avoid mule-write-region-no-coding-system. - * lisp/url.el: Don't require mule-sysdp. + * url.el: Don't require mule-sysdp. (url-retrieve): Only set text properties if url is a string. 2001-05-14 Dave Love - * lisp/url-http.el (url-http-create-request): + * url-http.el (url-http-create-request): Declare proxy-object, proxy-info special. (url-http-handle-authentication): Declare success special. 2001-05-12 Dave Love - * lisp/url-http.el: Revert last change. + * url-http.el: Revert last change. 2001-05-10 Dave Love - * lisp/url-http.el (url-http-generic-after-change-function): + * url-http.el (url-http-generic-after-change-function): Make it permanent-local. 2001-05-05 Dave Love - * lisp/url-http.el: Autoload some functions. + * url-http.el: Autoload some functions. (cl): Require when compiling. (url-http-extra-headers): Defvar when compiling. (url-http): Treat after-change-functions as a local hook. - * lisp/url-history.el (url-parse): Require. + * url-history.el (url-parse): Require. (url-do-setup): Autoload. - * lisp/url-gw.el: Require url-vars. Autoload some functions. + * url-gw.el: Require url-vars. Autoload some functions. - * lisp/url-file.el: Require mailcap. Require cl when compiling. + * url-file.el: Require mailcap. Require cl when compiling. Use (featurep 'xemacs). (url-file-build-filename): Bind pos-index. (url-file): Call url-find-file-dired, not url-dired-find-file. - * lisp/url-dired.el: Add copyright notice. Autoload some functions. + * url-dired.el: Add copyright notice. Autoload some functions. (url-dired-minor-mode-map): Use (featurep 'xemacs). (url-dired-find-file-mouse): Use mouse-set-point, not event-point. (url-find-file-dired): Rename from one version of url-dired-find-file. - * lisp/url-cid.el: Don't require widget. Require mm-decode + * url-cid.el: Don't require widget. Require mm-decode unconditionally. - * lisp/url-util.el: Autoload mule-decode-string, + * url-util.el: Autoload mule-decode-string, timezone-parse-date, timezone-make-date-arpa-standard. (url-unreserved-chars): Fix list per RFC 2396. (url-hexify-string): Maybe string-make-unibyte. - * lisp/url-news.el: Require nntp. + * url-news.el: Require nntp. - * lisp/url-imap.el: Require cl when compiling. Require nnimap + * url-imap.el: Require cl when compiling. Require nnimap unconditionally. 2001-05-04 Dave Love - * lisp/url-handlers.el (url-file-local-copy): Use make-temp-file, + * url-handlers.el (url-file-local-copy): Use make-temp-file, not non-existent mailcap-generate-unique-filename. - * lisp/url-privacy.el: Require url-vars. Require cl when compiling. + * url-privacy.el: Require url-vars. Require cl when compiling. - * lisp/url-parse.el: Require url-vars. + * url-parse.el: Require url-vars. Autoload url-scheme-get-property. - * lisp/url-nfs.el: Require cl when compiling. Test for XEmacs + * url-nfs.el: Require cl when compiling. Test for XEmacs with featurep. - * lisp/url-mailto.el: Require cl when compiling. + * url-mailto.el: Require cl when compiling. - * lisp/url-cookie.el (url-cookie-handle-set-cookie): + * url-cookie.el (url-cookie-handle-set-cookie): Call url-parse-args, not url-util-parse-args. - * lisp/url-cache.el (url-cache-expired): Remove bogus `return'. + * url-cache.el (url-cache-expired): Remove bogus `return'. 2001-04-09 Dave Love - * lisp/mule-sysdp.el (mule-detect-coding-version) + * mule-sysdp.el (mule-detect-coding-version) (mule-code-convert-region, mule-inhibit-code-conversion) (mule-write-region-no-coding-system, mule-encode-string) (mule-decode-string, mule-truncate-string) @@ -2493,109 +2607,106 @@ 2001-01-03 Sam Steingold - * lisp/url-http.el (url-http-wait-for-headers-change-function): + * url-http.el (url-http-wait-for-headers-change-function): set `url-http-end-of-headers' to 0 for HTTP 0.9. 2001-01-02 Sam Steingold - * lisp/url-auth.el (provide): `url-auth', not `urlauth'. + * url-auth.el (provide): `url-auth', not `urlauth'. 2000-12-22 Dave Love - * lisp/url-history.el (url): Don't require (to avoid recursion). + * url-history.el (url): Don't require (to avoid recursion). (cl): Require when compiling. - * lisp/url-http.el (url-auth): Require. + * url-http.el (url-auth): Require. (url-http-handle-authentication): Fix typo. - * lisp/url-cookie.el (url-cookie-setup-save-timer): Fix typo. + * url-cookie.el (url-cookie-setup-save-timer): Fix typo. 2000-12-20 Dave Love - * lisp/url.el: Require mm-decode, mm-view when compiling. + * url.el: Require mm-decode, mm-view when compiling. : Define puthash and autoload other has functions rather than using cl-...hash. (url-warn): Define. - * lisp/url-ns.el, lisp/url-methods.el, lisp/url-http.el: + * url-ns.el, url-methods.el, url-http.el: Avoid cl-...hash functions. - * lisp/url-history.el: Avoid cl-...hash functions. + * url-history.el: Avoid cl-...hash functions. (url): Require. - * lisp/url-gw.el, lisp/url-cookie.el: Require cl only when compiling. + * url-gw.el, url-cookie.el: Require cl only when compiling. 2000-10-03 William M. Perry - * lisp/url-util.el (url-get-url-at-point): Guard against 'url' + * url-util.el (url-get-url-at-point): Guard against 'url' getting set to nil due to bad string matching. Subsequent matches would then choke because we passed string-match a nil. - * lisp/url-http.el (url-http-parse-headers): Need to make the + * url-http.el (url-http-parse-headers): Need to make the connection as 'free' when we get a 304 response (found in cache), or when a keep-alive connection timed out, it would re-parse the headers and dispatch to the callback again. Eek. 2000-10-02 William M. Perry - * lisp/url-http.el (url-http-chunked-encoding-after-change-function): + * url-http.el (url-http-chunked-encoding-after-change-function): implement chunked transfer-coding. (url-http-create-request): We can now advertise ourselves as a 1.1 compliant browser! 2000-07-28 Sam Steingold - * lisp/url-methods.el (url-scheme-default-loader): `callback' and + * url-methods.el (url-scheme-default-loader): `callback' and `cbargs' are optional args (for calling from w3). (url-scheme-register-proxy): Typos fixes: `url-match' replaced with `string-match' and `protocol' with `scheme'. 2000-07-18 Sam Steingold - * lisp/url-handlers.el (require 'url): For url-retrieve-synchronously. - * lisp/url-history.el (url-history-save-interval): Avoid circularity. + * url-handlers.el (require 'url): For url-retrieve-synchronously. + * url-history.el (url-history-save-interval): Avoid circularity. 2000-07-10 William M. Perry - * lisp/mule-sysdp.el (mule-make-iso-character): If we are not in + * mule-sysdp.el (mule-make-iso-character): If we are not in mule, and the character requested is > 255, then return "~" instead of letting whoever call us signal an error when they try to insert the character. (mule-make-iso-character): Also wrap the whole thing in a condition case and return "~" on error, in case make-char bombs on us. - * lisp/url-cid.el (url-cid): Fix stupid mistake in the loader + * url-cid.el (url-cid): Fix stupid mistake in the loader for cid parts. - * lisp/url-util.el (url-display-percentage): New routine that uses + * url-util.el (url-display-percentage): New routine that uses the progress bar under XEmacs if available. Looks very sexy under XEmacs/GTK hacked to use the GNOME statusbar. - * lisp/url-http.el + * url-http.el (url-http-content-length-after-change-function): Use new function url-display-percentage instead of url-lazy-message. 2000-01-27 William M. Perry - * lisp/url-file.el (url-file-build-filename): Work around for + * url-file.el (url-file-build-filename): Work around for differences in ange-ftp / efs handling of port numbers other than 21. 1999-12-24 William M. Perry - * lisp/url-irc.el: Added pointer to draft specification for the + * url-irc.el: Added pointer to draft specification for the IRC URL so people don't think I'm crazy. - * configure.in: Checks to make sure that Gnus was found, since we - HAVE to have it now. Removed conditional compilation of url-cid.el. - 1999-12-16 Eric Marsden - * lisp/url-util.el (url-get-url-at-point): Allow URLs wrapped in + * url-util.el (url-get-url-at-point): Allow URLs wrapped in () to have periods at the end of the chunk. 1999-12-14 William M. Perry - * lisp/url-misc.el (url-man): Implement `man' URL types. + * url-misc.el (url-man): Implement `man' URL types. (url-info): Autoload. (url-man): Ditto. (url-rlogin): Ditto. @@ -2603,14 +2714,14 @@ (url-tn3270): Ditto. (url-generic-emulator-loader): Ditto. - * lisp/url-https.el (url-https-create-secure-wrapper): New macro + * url-https.el (url-https-create-secure-wrapper): New macro to wrap arbitrary `http' methods with the appropriate magic to turn SSL on. (file-exists-p): Use it. (file-readable-p): Use it. (file-attributes): Use it. - * lisp/url-news.el (url-news-fetch-newsgroup): When building the + * url-news.el (url-news-fetch-newsgroup): When building the server spec for Gnus, make sure we set nntp-open-connection-function directly, so that other news-related functions above us can set it. @@ -2621,7 +2732,7 @@ 1999-12-12 William M. Perry - * lisp/url-http.el (url-http-parse-response): New function to + * url-http.el (url-http-parse-response): New function to parse just the HTTP response code out of the buffer, without taking any other actions. (url-http-wait-for-headers-change-function): Use it here when we @@ -2633,161 +2744,151 @@ 1999-12-11 William M. Perry - * aclocal.m4 (AC_CHECK_CUSTOMLOADS): Don't use $(EMACS) in here - - the Makefile does that for us. We just need to provide what files - to load/functions to run. - - * lisp/url-imap.el (url-imap-open-host): Need to bind + * url-imap.el (url-imap-open-host): Need to bind nnimap-server-buffer or `nnimap-open-server' chokes trying to use the current buffer as the IMAP server buffer, which fails miserably. 1999-12-11 Simon Josefsson - * lisp/url-imap.el: Initial (rough) implementation for IMAP urls. + * url-imap.el: Initial (rough) implementation for IMAP urls. 1999-12-11 William M. Perry - * lisp/url-file.el (url-file-asynch-callback): Make the checks for + * url-file.el (url-file-asynch-callback): Make the checks for ange-ftp vs. efs calling semantics consistent, so that if someone has NEITHER of them loaded, everything should still work. - * lisp/url-handlers.el (url-copy-file): Autoload. + * url-handlers.el (url-copy-file): Autoload. (url-file-local-copy): Ditto. (url-insert-file-contents): Ditto. (url-setup-file-name-handlers): Ditto. 1999-12-10 William M. Perry - * lisp/url-http.el (mail-parse): Since we use functions from here, + * url-http.el (mail-parse): Since we use functions from here, we should require it, eh? 1999-12-10 Shenghuo ZHU - * lisp/url-cookie.el (url-cookie-multiple-line): One line cookie + * url-cookie.el (url-cookie-multiple-line): One line cookie if nil. (url-cookie-generate-header-lines): Use it. 1999-12-06 William M. Perry - * lisp/mule-sysdp.el (mule-code-convert-region): Deal with Mule + * mule-sysdp.el (mule-code-convert-region): Deal with Mule 4.1 gracefully. - * lisp/url-news.el: Reimplemented news and nntp URL support. + * url-news.el: Reimplemented news and nntp URL support. No longer bothers to check for outdated Gnus versions, since this will not work without them anyway. 1999-12-05 Dave Love - * lisp/url-methods.el, lisp/url-proxy.el, lisp/url-util.el, - lisp/url.el: + * url-methods.el, url-proxy.el, url-util.el, + url.el: Require url-parse. 1999-12-05 William M. Perry - * lisp/url-http.el (url-http-find-free-connection): Spit out a + * url-http.el (url-http-find-free-connection): Spit out a message when we have to contact a host so the user always gets at least some feedback. - * lisp/url-expand.el (url-expander-remove-relative-links): Move and + * url-expand.el (url-expander-remove-relative-links): Move and renamed function. (url-default-expander): Use it. - * lisp/url-file.el (url-file-asynch-callback): Deal with just efs-auto + * url-file.el (url-file-asynch-callback): Deal with just efs-auto as well as efs. (url-file): Add default content-type of application/octet-stream if none known. (url-file): Correct bad call to url-host-is-local-p. - * lisp/url-handlers.el (url-insert-file-contents): Emacs doesn't + * url-handlers.el (url-insert-file-contents): Emacs doesn't like buffer-substring with nil arguments. (url-copy-file): Use mm-destroy-parts instead of just killing the buffer. Use defined interfaces when available! (url-insert-file-contents): Ditto. - * lisp/url-http.el (url-http-create-request): Lots of changes to + * url-http.el (url-http-create-request): Lots of changes to get proxying working. - * lisp/url-methods.el (url-scheme-register-proxy): New function to + * url-methods.el (url-scheme-register-proxy): New function to find and register a proxy for a specific scheme. (url-scheme-get-property): Use it when we load a URL scheme for the first time. - * lisp/url-util.el (url-get-url-at-point): Re-integrated. + * url-util.el (url-get-url-at-point): Re-integrated. 1999-12-04 William M. Perry - * lisp/url-file.el (url-file): Signal an error if + * url-file.el (url-file): Signal an error if url-file-build-filename could not find the filename. 1999-12-01 William M. Perry - * lisp/url.el (url-retrieve): Use url-history-update-url instead + * url.el (url-retrieve): Use url-history-update-url instead of manipulating the hash table directly. - * lisp/url-history.el (url-completion-function): New function to + * url-history.el (url-completion-function): New function to use for reading a URL with completion. (url-history-update-url): New function to hide the hashtable implementation from people inserting things into the history. 1999-11-30 William M. Perry - * lisp/url-proxy.el (url-proxy): Minor tweaks to get proxy support + * url-proxy.el (url-proxy): Minor tweaks to get proxy support working. - * lisp/url-parse.el (url-generic-parse-url): Fix bad call to + * url-parse.el (url-generic-parse-url): Fix bad call to url-parse-args, which had changed the type of arguments it expects. - * lisp/url-handlers.el (url-insert-file-contents): Ditto. + * url-handlers.el (url-insert-file-contents): Ditto. (url-copy-file): Ditto. - * lisp/url.el (url-mm-callback): Use mm-destroy-parts instead of + * url.el (url-mm-callback): Use mm-destroy-parts instead of just killing the buffer. Use defined interfaces when available! - * aclocal.m4 (AC_EMACS_LISP): Correctly redirect things out to - AC_FD_CC so they show up in config.log - (AC_EMACS_CHECK_LIB): Duh, fixed stupid mistake that would make - this always return 't' instead of 'yes' on successfully finding - the library. - - * lisp/url-http.el (url-http-parse-headers): Add some + * url-http.el (url-http-parse-headers): Add some DAV-specific error codes. - * lisp/url.el (url-retrieve): Allow pre-parsed URLs to be passed in. + * url.el (url-retrieve): Allow pre-parsed URLs to be passed in. (url-retrieve-synchronously): Duh, make this function actually work again. Numerous problems with it, including variable name collisions - I love dynamically scoped lisps! - * lisp/url-nfs.el (url-nfs-create-wrapper): New function to create + * url-nfs.el (url-nfs-create-wrapper): New function to create wrappers onto the appropriate file-based URLs for file-name-handlers. - * lisp/url-ftp.el: Moved the FTP stuff into its own file - it + * url-ftp.el: Moved the FTP stuff into its own file - it might get messy with file-name-handlers and things. - * lisp/url-http.el (url-http-clean-headers): Fix problem when + * url-http.el (url-http-clean-headers): Fix problem when using 'HEAD' requests. Thou shalt not change the length of the region during an after-change-function. - * lisp/url-methods.el (url-scheme-methods): New variable that + * url-methods.el (url-scheme-methods): New variable that holds a list of the methods/variables we look for in a URL scheme. (url-scheme-get-property): Use it. 1999-11-29 William M. Perry - * lisp/url-http.el (url-http-file-attributes): Reimplement. + * url-http.el (url-http-file-attributes): Reimplement. (url-http-file-exists-p): Ditto. - * lisp/url-nfs.el: Reimplemented the `nfs' URL scheme. + * url-nfs.el: Reimplemented the `nfs' URL scheme. - * lisp/url-file.el (url-file-create-wrapper): New macro to create + * url-file.el (url-file-create-wrapper): New macro to create file-name-handler stubs for all the FTP/FILE stuff. - * lisp/url-handlers.el: New file to handle file-name-handler-alist + * url-handlers.el: New file to handle file-name-handler-alist cruft. Generic interface on top of functions that each URL loader provides, if capable. 1999-11-27 William M. Perry - * lisp/url-https.el: Implemented HTTPS support. + * url-https.el: Implemented HTTPS support. 1999-11-26 William M. Perry @@ -2812,8 +2913,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1999, 2001-2002, 2004-2013 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2002, 2004-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el index e01172894ab..017b5b0e621 100644 --- a/lisp/url/url-about.el +++ b/lisp/url/url-about.el @@ -1,6 +1,6 @@ ;;; url-about.el --- Show internal URLs -;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index c339a2dc2ed..3d17edb750c 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -1,6 +1,6 @@ ;;; url-auth.el --- Uniform Resource Locator authorization modules -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index cb0281b87f2..50ce38f064b 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -1,6 +1,6 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 5f78d0e95a0..cc9dc20a6ad 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el @@ -1,6 +1,6 @@ ;;; url-cid.el --- Content-ID URL loader -;; Copyright (C) 1998-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 6692c812871..55e0fb33951 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -1,6 +1,6 @@ ;;; url-cookie.el --- URL cookie support -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -349,6 +349,95 @@ to run the `url-cookie-setup-save-timer' function manually." url-cookie-save-interval #'url-cookie-write-file)))) +;;; Mode for listing and editing cookies. + +(defun url-cookie-list () + "Display a buffer listing the current URL cookies, if there are any. +Use \\\\\[url-cookie-delete] to remove cookies." + (interactive) + (when (and (null url-cookie-secure-storage) + (null url-cookie-storage)) + (error "No cookies are defined")) + + (pop-to-buffer "*url cookies*") + (let ((inhibit-read-only t) + (domains (sort + (copy-sequence + (append url-cookie-secure-storage + url-cookie-storage)) + (lambda (e1 e2) + (string< (car e1) (car e2))))) + (domain-length 0) + start name format domain) + (erase-buffer) + (url-cookie-mode) + (dolist (elem domains) + (setq domain-length (max domain-length (length (car elem))))) + (setq format (format "%%-%ds %%-20s %%s" domain-length) + header-line-format + (concat " " (format format "Domain" "Name" "Value"))) + (dolist (elem domains) + (setq domain (car elem)) + (dolist (cookie (sort (copy-sequence (cdr elem)) + (lambda (c1 c2) + (string< (url-cookie-name c1) + (url-cookie-name c2))))) + (setq start (point) + name (url-cookie-name cookie)) + (when (> (length name) 20) + (setq name (substring name 0 20))) + (insert (format format domain name + (url-cookie-value cookie)) + "\n") + (setq domain "") + (put-text-property start (1+ start) 'url-cookie cookie))) + (goto-char (point-min)))) + +(defun url-cookie-delete () + "Delete the cookie on the current line." + (interactive) + (let ((cookie (get-text-property (line-beginning-position) 'url-cookie)) + (inhibit-read-only t) + variable) + (unless cookie + (error "No cookie on the current line")) + (setq variable (if (url-cookie-secure cookie) + 'url-cookie-secure-storage + 'url-cookie-storage)) + (let* ((list (symbol-value variable)) + (elem (assoc (url-cookie-domain cookie) list))) + (setq elem (delq cookie elem)) + (when (zerop (length (cdr elem))) + (setq list (delq elem list))) + (set variable list)) + (setq url-cookies-changed-since-last-save t) + (url-cookie-write-file) + (delete-region (line-beginning-position) + (progn + (forward-line 1) + (point))))) + +(defun url-cookie-quit () + "Kill the current buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defvar url-cookie-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'url-cookie-quit) + (define-key map [delete] 'url-cookie-delete) + (define-key map [(control k)] 'url-cookie-delete) + map)) + +(define-derived-mode url-cookie-mode nil "URL Cookie" + "Mode for listing cookies. + +\\{url-cookie-mode-map}" + (buffer-disable-undo) + (setq buffer-read-only t + truncate-lines t)) + (provide 'url-cookie) ;;; url-cookie.el ends here diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 6e4191ae7b5..fcb6e70f4d7 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -1,6 +1,6 @@ ;;; url-dav.el --- WebDAV support -;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry ;; Maintainer: Bill Perry @@ -32,10 +32,12 @@ (require 'xml) (require 'url-util) (require 'url-handlers) +(require 'url-http) (defvar url-dav-supported-protocols '(1 2) "List of supported DAV versions.") +;; Dynamically bound. (defvar url-http-content-type) (defvar url-http-response-status) (defvar url-http-end-of-headers) @@ -621,8 +623,6 @@ Returns t if the lock was successfully released." (url-debug 'dav "Unrecognized DAV:locktype (%S)" (car lock))))) modes)) -(autoload 'url-http-head-file-attributes "url-http") - (defun url-dav-file-attributes (url &optional id-format) (let ((properties (cdar (url-dav-get-properties url)))) (if (and properties diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el index 0ac0dfbcf71..516a362cb37 100644 --- a/lisp/url/url-dired.el +++ b/lisp/url/url-dired.el @@ -1,6 +1,6 @@ ;;; url-dired.el --- URL Dired minor mode -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, files diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el index 0db33b8151f..6cedd3c3ca7 100644 --- a/lisp/url/url-domsuf.el +++ b/lisp/url/url-domsuf.el @@ -1,6 +1,6 @@ ;;; url-domsuf.el --- Say what domain names can have cookies set. -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index 51a3e64064a..1142532e1a1 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -1,6 +1,6 @@ ;;; url-expand.el --- expand-file-name for URLs -;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index e4d6b649a5b..03a2ea11577 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -1,6 +1,6 @@ ;;; url-file.el --- File retrieval code -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el index 16e82cbe115..243240cb1f2 100644 --- a/lisp/url/url-ftp.el +++ b/lisp/url/url-ftp.el @@ -1,6 +1,6 @@ ;;; url-ftp.el --- FTP wrapper -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index 35a78cf0c05..0505218326b 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -1,6 +1,6 @@ ;;; url-future.el --- general futures facility for url.el -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. ;; Author: Teodor Zlatanov ;; Keywords: data @@ -84,7 +84,9 @@ (setf (url-future-value url-future) (funcall ff)) (error (url-future-errored url-future catcher))) - (url-future-value url-future))) + ;; Unused return value. +;;; (url-future-value url-future) + )) (if (url-future-errored-p url-future) url-future (url-future-finish url-future)))) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 7910460910d..2a9c6ead029 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -1,6 +1,6 @@ ;;; url-gw.el --- Gateway munging for URL loading -;; Copyright (C) 1997-1998, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry ;; Keywords: comm, data, processes diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 67d72bcfb61..e52aad83e47 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -1,6 +1,6 @@ ;;; url-handlers.el --- file-name-handler stuff for URL loading -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -28,16 +28,20 @@ ;; (require 'url-util) (eval-when-compile (require 'mm-decode)) ;; (require 'mailcap) -;; The following functions in the byte compiler's warnings are known not -;; to cause any real problem for the following reasons: -;; - mm-save-part-to-file, mm-destroy-parts: always used -;; after mm-dissect-buffer and defined in the same file. ;; The following are autoloaded instead of `require'd to avoid eagerly ;; loading all of URL when turning on url-handler-mode in the .emacs. (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") +;; Always used after mm-dissect-buffer and defined in the same file. +(declare-function mm-save-part-to-file "mm-decode" (handle file)) +(declare-function mm-destroy-parts "mm-decode" (handles)) +;; mm-decode loads mm-bodies. +(declare-function mm-decode-string "mm-bodies" (string charset)) +;; mm-decode loads mail-parse. +(declare-function mail-content-type-get "mail-parse" (ct attribute)) + ;; Implementation status ;; --------------------- ;; Function Status @@ -307,11 +311,17 @@ They count bytes from the beginning of the body." (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) (defun url-file-name-completion (url directory &optional predicate) - (error "Unimplemented")) + ;; Even if it's not implemented, it's not an error to ask for completion, + ;; in case it's available (bug#14806). + ;; (error "Unimplemented") + url) (put 'file-name-completion 'url-file-handlers 'url-file-name-completion) (defun url-file-name-all-completions (file directory) - (error "Unimplemented")) + ;; Even if it's not implemented, it's not an error to ask for completion, + ;; in case it's available (bug#14806). + ;; (error "Unimplemented") + nil) (put 'file-name-all-completions 'url-file-handlers 'url-file-name-all-completions) diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index d0635d3f6bb..1fe0e9e1bdc 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el @@ -1,6 +1,6 @@ ;;; url-history.el --- Global history tracking for URL package -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -44,7 +44,7 @@ session." (url-history-setup-save-timer))) :type '(choice (const :tag "off" nil) (const :tag "on" t) - (const :tag "within session" 'session)) + (other :tag "within session" session)) :group 'url-history) (defcustom url-history-file nil diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 33fc5722759..ac2e1403d03 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1,6 +1,6 @@ ;;; url-http.el --- HTTP retrieval routines -;; Copyright (C) 1999, 2001, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry ;; Keywords: comm, data, processes @@ -51,7 +51,6 @@ (defvar url-show-status) (require 'url-gw) -(require 'url-util) (require 'url-parse) (require 'url-cookie) (require 'mail-parse) @@ -357,9 +356,7 @@ request.") ;; End request "\r\n" ;; Any data - url-http-data - ;; If `url-http-data' is nil, avoid two CRLFs (Bug#8931). - (if url-http-data "\r\n"))) + url-http-data)) "")) (url-http-debug "Request is: \n%s" request) request)) @@ -375,9 +372,6 @@ Return the number of characters removed." (replace-match "")) (- end url-http-end-of-headers))) -(defvar status) -(defvar success) - (defun url-http-handle-authentication (proxy) (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal")) (let ((auths (or (nreverse @@ -404,9 +398,9 @@ Return the number of characters removed." (url-strip-leading-spaces this-auth))) (let* ((this-type - (if (string-match "[ \t]" this-auth) - (downcase (substring this-auth 0 (match-beginning 0))) - (downcase this-auth))) + (downcase (if (string-match "[ \t]" this-auth) + (substring this-auth 0 (match-beginning 0)) + this-auth))) (registered (url-auth-registered this-type)) (this-strength (cddr registered))) (when (and registered (> this-strength strength)) @@ -421,20 +415,26 @@ Return the number of characters removed." (insert "
    Sorry, but I do not know how to handle " type " authentication. If you'd like to write it," " send it to " url-bug-address ".
    ") - (setq status t)) + ;; We used to set a `status' var (declared "special") but I can't + ;; find the corresponding let-binding, so it's probably an error. + ;; FIXME: Maybe it was supposed to set `success', i.e. to return t? + ;; (setq status t) + nil) ;; Not success yet. + (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth))) (auth (url-get-authentication auth-url (cdr-safe (assoc "realm" args)) type t args))) (if (not auth) - (setq success t) + t ;Success. (push (cons (if proxy "Proxy-Authorization" "Authorization") auth) url-http-extra-headers) (let ((url-request-method url-http-method) (url-request-data url-http-data) (url-request-extra-headers url-http-extra-headers)) (url-retrieve-internal url url-callback-function - url-callback-arguments))))))) + url-callback-arguments)) + nil))))) ;; Not success yet. (defun url-http-parse-response () "Parse just the response code." @@ -498,12 +498,11 @@ should be shown to the user." (when (and connection (string= (downcase connection) "close")) (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (setq class (/ url-http-response-status 100)) + (let* ((buffer (current-buffer)) + (class (/ url-http-response-status 100)) + (success nil) + ;; other status symbols: jewelry and luxury cars + (status-symbol (cadr (assq url-http-response-status url-http-codes)))) (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) (when (url-use-cookies url-http-target-url) @@ -536,15 +535,14 @@ should be shown to the user." (pcase status-symbol ((or `no-content `reset-content) ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) + (url-mark-buffer-as-dead buffer)) (_ ;; Generic success for all others. Store in the cache, and ;; mark it as successful. (widen) (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) + (url-store-in-cache buffer)))) + (setq success t)) (3 ; Redirection ;; 300 Multiple choices ;; 301 Moved permanently @@ -684,106 +682,107 @@ should be shown to the user." ;; 422 Unprocessable Entity (Added by DAV) ;; 423 Locked ;; 424 Failed Dependency - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (`not-found ; 404 - ;; Not found - (setq success t)) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) + (setq success + (pcase status-symbol + (`unauthorized ; 401 + ;; The request requires user authentication. The response + ;; MUST include a WWW-Authenticate header field containing a + ;; challenge applicable to the requested resource. The + ;; client MAY repeat the request with a suitable + ;; Authorization header field. + (url-http-handle-authentication nil)) + (`payment-required ; 402 + ;; This code is reserved for future use + (url-mark-buffer-as-dead buffer) + (error "Somebody wants you to give them money")) + (`forbidden ; 403 + ;; The server understood the request, but is refusing to + ;; fulfill it. Authorization will not help and the request + ;; SHOULD NOT be repeated. + t) + (`not-found ; 404 + ;; Not found + t) + (`method-not-allowed ; 405 + ;; The method specified in the Request-Line is not allowed + ;; for the resource identified by the Request-URI. The + ;; response MUST include an Allow header containing a list of + ;; valid methods for the requested resource. + t) + (`not-acceptable ; 406 + ;; The resource identified by the request is only capable of + ;; generating response entities which have content + ;; characteristics not acceptable according to the accept + ;; headers sent in the request. + t) + (`proxy-authentication-required ; 407 + ;; This code is similar to 401 (Unauthorized), but indicates + ;; that the client must first authenticate itself with the + ;; proxy. The proxy MUST return a Proxy-Authenticate header + ;; field containing a challenge applicable to the proxy for + ;; the requested resource. + (url-http-handle-authentication t)) + (`request-timeout ; 408 + ;; The client did not produce a request within the time that + ;; the server was prepared to wait. The client MAY repeat + ;; the request without modifications at any later time. + t) + (`conflict ; 409 + ;; The request could not be completed due to a conflict with + ;; the current state of the resource. This code is only + ;; allowed in situations where it is expected that the user + ;; might be able to resolve the conflict and resubmit the + ;; request. The response body SHOULD include enough + ;; information for the user to recognize the source of the + ;; conflict. + t) + (`gone ; 410 + ;; The requested resource is no longer available at the + ;; server and no forwarding address is known. + t) + (`length-required ; 411 + ;; The server refuses to accept the request without a defined + ;; Content-Length. The client MAY repeat the request if it + ;; adds a valid Content-Length header field containing the + ;; length of the message-body in the request message. + ;; + ;; NOTE - this will never happen because + ;; `url-http-create-request' automatically calculates the + ;; content-length. + t) + (`precondition-failed ; 412 + ;; The precondition given in one or more of the + ;; request-header fields evaluated to false when it was + ;; tested on the server. + t) + ((or `request-entity-too-large `request-uri-too-large) ; 413 414 + ;; The server is refusing to process a request because the + ;; request entity|URI is larger than the server is willing or + ;; able to process. + t) + (`unsupported-media-type ; 415 + ;; The server is refusing to service the request because the + ;; entity of the request is in a format not supported by the + ;; requested resource for the requested method. + t) + (`requested-range-not-satisfiable ; 416 + ;; A server SHOULD return a response with this status code if + ;; a request included a Range request-header field, and none + ;; of the range-specifier values in this field overlap the + ;; current extent of the selected resource, and the request + ;; did not include an If-Range request-header field. + t) + (`expectation-failed ; 417 + ;; The expectation given in an Expect request-header field + ;; could not be met by this server, or, if the server is a + ;; proxy, the server has unambiguous evidence that the + ;; request could not be met by the next-hop server. + t) + (_ + ;; The request could not be understood by the server due to + ;; malformed syntax. The client SHOULD NOT repeat the + ;; request without modifications. + t))) ;; Tell the callback that an error occurred, and what the ;; status code was. (when success @@ -849,11 +848,27 @@ should be shown to the user." (error "Unknown class of HTTP response code: %d (%d)" class url-http-response-status))) (if (not success) - (url-mark-buffer-as-dead buffer)) + (url-mark-buffer-as-dead buffer) + (url-handle-content-transfer-encoding)) (url-http-debug "Finished parsing HTTP headers: %S" success) (widen) + (goto-char (point-min)) success)) +(declare-function zlib-decompress-region "decompress.c" (start end)) + +(defun url-handle-content-transfer-encoding () + (let ((encoding (mail-fetch-field "content-encoding"))) + (when (and encoding + (fboundp 'zlib-available-p) + (zlib-available-p) + (equal (downcase encoding) "gzip")) + (save-restriction + (widen) + (goto-char (point-min)) + (when (search-forward "\n\n") + (zlib-decompress-region (point) (point-max))))))) + ;; Miscellaneous (defun url-http-activate-callback () "Activate callback specified when this buffer was created." @@ -901,7 +916,7 @@ should be shown to the user." (defun url-http-simple-after-change-function (st nd length) ;; Function used when we do NOT know how long the document is going to be ;; Just _very_ simple 'downloaded %d' type of info. - (url-lazy-message "Reading %s..." (url-pretty-length nd))) + (url-lazy-message "Reading %s..." (file-size-human-readable nd))) (defun url-http-content-length-after-change-function (st nd length) "Function used when we DO know how long the document is going to be. @@ -914,16 +929,16 @@ the callback to be triggered." (url-percentage (- nd url-http-end-of-headers) url-http-content-length) url-http-content-type - (url-pretty-length (- nd url-http-end-of-headers)) - (url-pretty-length url-http-content-length) + (file-size-human-readable (- nd url-http-end-of-headers)) + (file-size-human-readable url-http-content-length) (url-percentage (- nd url-http-end-of-headers) url-http-content-length)) (url-display-percentage "Reading... %s of %s (%d%%)" (url-percentage (- nd url-http-end-of-headers) url-http-content-length) - (url-pretty-length (- nd url-http-end-of-headers)) - (url-pretty-length url-http-content-length) + (file-size-human-readable (- nd url-http-end-of-headers)) + (file-size-human-readable url-http-content-length) (url-percentage (- nd url-http-end-of-headers) url-http-content-length))) @@ -1222,18 +1237,17 @@ previous `url-http' call, which is being re-attempted." (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) - (let ((status (process-status connection))) - (cond - ((eq status 'connect) - ;; Asynchronous connection - (set-process-sentinel connection 'url-http-async-sentinel)) - ((eq status 'failed) - ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) - (t - (set-process-sentinel connection - 'url-http-end-of-document-sentinel) - (process-send-string connection (url-http-create-request))))))) + (pcase (process-status connection) + (`connect + ;; Asynchronous connection + (set-process-sentinel connection 'url-http-async-sentinel)) + (`failed + ;; Asynchronous connection failed + (error "Could not create connection to %s:%d" host port)) + (_ + (set-process-sentinel connection + 'url-http-end-of-document-sentinel) + (process-send-string connection (url-http-create-request)))))) buffer)) (defun url-http-async-sentinel (proc why) @@ -1302,17 +1316,14 @@ previous `url-http' call, which is being re-attempted." (url-retrieve-synchronously url))) (defun url-http-file-exists-p (url) - (let ((status nil) - (exists nil) - (buffer (url-http-head url))) - (if (not buffer) - (setq exists nil) - (setq status (url-http-symbol-value-in-buffer 'url-http-response-status - buffer 500) - exists (and (integerp status) - (>= status 200) (< status 300))) - (kill-buffer buffer)) - exists)) + (let ((buffer (url-http-head url))) + (when buffer + (let ((status (url-http-symbol-value-in-buffer 'url-http-response-status + buffer 500))) + (prog1 + (and (integerp status) + (>= status 200) (< status 300)) + (kill-buffer buffer)))))) (defalias 'url-http-file-readable-p 'url-http-file-exists-p) diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el index b8dcaecd668..81d117bfa27 100644 --- a/lisp/url/url-imap.el +++ b/lisp/url/url-imap.el @@ -1,6 +1,6 @@ ;;; url-imap.el --- IMAP retrieval routines -;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2004-2014 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: comm, data, processes diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index b0622ebebe9..07d1a124ac8 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -1,6 +1,6 @@ ;;; url-irc.el --- IRC URL interface -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index bfb5458bc03..e1c4eb0e5ff 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el @@ -1,6 +1,6 @@ ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -;; Copyright (C) 1998-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index 55f477c2522..e3b62e4eb03 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -1,6 +1,6 @@ ;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index d4fa59e9720..84294ab68cf 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -1,6 +1,6 @@ ;;; url-methods.el --- Load URL schemes as needed -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el index c8e9b591790..31c37d0cd45 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el @@ -1,6 +1,6 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code -;; Copyright (C) 1996-1999, 2002, 2004-2013 Free Software Foundation, +;; Copyright (C) 1996-1999, 2002, 2004-2014 Free Software Foundation, ;; Inc. ;; Keywords: comm, data, processes @@ -89,19 +89,19 @@ (save-excursion (if (not (string-match "\\([^,]*\\)?," desc)) (error "Malformed data URL: %s" desc) - (setq mediatype (match-string 1 desc)) + (setq mediatype (match-string 1 desc) + data (url-unhex-string (substring desc (match-end 0)))) (if (and mediatype (string-match ";base64\\'" mediatype)) (setq mediatype (substring mediatype 0 (match-beginning 0)) encoding "base64")) (if (or (null mediatype) (eq ?\; (aref mediatype 0))) - (setq mediatype (concat "text/plain" mediatype))) - (setq data (url-unhex-string (substring desc (match-end 0))))) + (setq mediatype (concat "text/plain" mediatype)))) (set-buffer (generate-new-buffer " *url-data*")) (mm-disable-multibyte) (insert (format "Content-Length: %d\n" (length data)) "Content-Type: " mediatype "\n" - "Content-Encoding: " encoding "\n" + "Content-Transfer-Encoding: " encoding "\n" "\n") (if data (insert data)) (current-buffer)))) diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 391974d79f8..105fb677374 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -1,6 +1,6 @@ ;;; url-news.el --- News Uniform Resource Locator retrieval code -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -28,9 +28,10 @@ (autoload 'url-warn "url") (autoload 'gnus-group-read-ephemeral-group "gnus-group") -(defgroup url-news nil - "News related options." - :group 'url) +;; Unused. +;;; (defgroup url-news nil +;;; "News related options." +;;; :group 'url) (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el index 2870a9a5af9..82eb1b397f7 100644 --- a/lisp/url/url-nfs.el +++ b/lisp/url/url-nfs.el @@ -1,6 +1,6 @@ ;;; url-nfs.el --- NFS URL interface -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el index 3fe074f1e0c..30506d43349 100644 --- a/lisp/url/url-ns.el +++ b/lisp/url/url-ns.el @@ -1,6 +1,6 @@ ;;; url-ns.el --- Various netscape-ish functions for proxy definitions -;; Copyright (C) 1997-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 1628290a358..50de84f5167 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -1,6 +1,6 @@ ;;; url-parse.el --- Uniform Resource Locator parser -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 0c091680507..5ab0147839a 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -1,6 +1,6 @@ ;;; url-privacy.el --- Global history tracking for URL package -;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index e858545e121..eee2be799ee 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -1,6 +1,6 @@ ;;; url-proxy.el --- Proxy server support -;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -63,6 +63,8 @@ (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) nil)))) +(autoload 'url-http "url-http") + (defun url-proxy (url callback &optional cbargs) ;; Retrieve URL from a proxy. ;; Expects `url-using-proxy' to be bound to the specific proxy to use." @@ -73,7 +75,7 @@ (url-http url callback cbargs)) (t (error "Don't know how to use proxy `%s'" url-using-proxy)))) - + (provide 'url-proxy) ;;; url-proxy.el ends here diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index f4b9093f086..87469b91032 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -1,6 +1,6 @@ ;;; url-queue.el --- Fetching web pages in parallel -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: comm @@ -69,7 +69,7 @@ The variable `url-queue-timeout' sets a timeout." :inhibit-cookiesp inhibit-cookies)))) (url-queue-setup-runners)) -;; To ensure asynch behaviour, we start the required number of queue +;; To ensure asynch behavior, we start the required number of queue ;; runners from `run-with-idle-timer'. So we're basically going ;; through the queue in two ways: 1) synchronously when a program ;; calls `url-queue-retrieve' (which will then start the required diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index c40768ba42a..a7d7e3e0fed 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -1,6 +1,6 @@ ;;; url-util.el --- Miscellaneous helper routines for URL library -;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation, +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, ;; Inc. ;; Author: Bill Perry @@ -211,15 +211,9 @@ Will not do anything if `url-show-status' is nil." (setq z (1+ z))) (substring x z nil))) -;;;###autoload -(defun url-pretty-length (n) - (cond - ((< n 1024) - (format "%d bytes" n)) - ((< n (* 1024 1024)) - (format "%dk" (/ n 1024.0))) - (t - (format "%2.2fM" (/ n (* 1024 1024.0)))))) + +(define-obsolete-function-alias 'url-pretty-length + 'file-size-human-readable "24.4") ;;;###autoload (defun url-display-percentage (fmt perc &rest args) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 6cd0e9aec3c..4cdb59deb27 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,6 +1,6 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation, +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, ;; Inc. ;; Keywords: comm, data, processes, hypermedia @@ -28,6 +28,8 @@ (defgroup url nil "Uniform Resource Locator tool." :version "22.1" + :link '(custom-manual "(url) Top") + :link '(info-link "(url) Customization") :group 'comm) (defgroup url-file nil @@ -72,7 +74,7 @@ requests will be honored. If t, all refresh requests will be honored. If non-nil and not t, the user will be asked for each refresh request." :type '(choice (const :tag "off" nil) (const :tag "on" t) - (const :tag "ask" 'ask)) + (other :tag "ask" ask)) :group 'url-hairy) (defcustom url-automatic-caching nil @@ -210,8 +212,9 @@ Should be an assoc list of headers/contents.") (defvar url-request-method nil "The method to use for the next request.") -;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.) -(defvar url-mime-encoding-string nil +(defvar url-mime-encoding-string (and (fboundp 'zlib-available-p) + (zlib-available-p) + "gzip") "String to send in the Accept-encoding: field in HTTP requests.") (defvar mm-mime-mule-charset-alist) diff --git a/lisp/url/url.el b/lisp/url/url.el index a1f0415d5fd..cbbcfd4f18b 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -1,6 +1,6 @@ ;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*- -;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation, +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, ;; Inc. ;; Author: Bill Perry @@ -220,7 +220,7 @@ URL-encoded before it's used." buffer)) ;;;###autoload -(defun url-retrieve-synchronously (url) +(defun url-retrieve-synchronously (url &optional silent inhibit-cookies) "Retrieve URL synchronously. Return the buffer containing the data, or nil if there are no data associated with it (the case for dired, info, or mailto URLs that need @@ -233,7 +233,8 @@ no further processing). URL is either a string or a parsed URL." (url-retrieve url (lambda (&rest ignored) (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) (setq retrieval-done t - asynch-buffer (current-buffer))))) + asynch-buffer (current-buffer))) + nil silent inhibit-cookies)) (if (null asynch-buffer) ;; We do not need to do anything, it was a mailto or something ;; similar that takes processing completely outside of the URL @@ -290,6 +291,12 @@ no further processing). URL is either a string or a parsed URL." (get-buffer-process asynch-buffer))))))) asynch-buffer))) +;; url-mm-callback called from url-mm, which requires mm-decode. +(declare-function mm-dissect-buffer "mm-decode" + (&optional no-strict-mime loose-mime from)) +(declare-function mm-display-part "mm-decode" + (handle &optional no-default force)) + (defun url-mm-callback (&rest ignored) (let ((handle (mm-dissect-buffer t))) (url-mark-buffer-as-dead (current-buffer)) diff --git a/lisp/userlock.el b/lisp/userlock.el index 4ad96eb41ce..698c17698bb 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -1,8 +1,8 @@ ;;; userlock.el --- handle file access contention between multiple users -;; Copyright (C) 1985-1986, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -30,8 +30,7 @@ ;;; Code: -(put 'file-locked 'error-conditions '(file-locked file-error error)) -(put 'file-locked 'error-message "File is locked") +(define-error 'file-locked "File is locked" 'file-error) ;;;###autoload (defun ask-user-about-lock (file opponent) @@ -94,8 +93,7 @@ You can uit; don't modify this file.") (with-current-buffer standard-output (help-mode)))) -(put - 'file-supersession 'error-conditions '(file-supersession file-error error)) +(define-error 'file-supersession nil 'file-error) ;;;###autoload (defun ask-user-about-supersession-threat (fn) diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index f0ea9c68464..8e44c024dc4 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1,9 +1,9 @@ ;;; add-log.el --- change log maintenance commands for Emacs -;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2013 Free +;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2014 Free ;; Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: vc tools ;; This file is part of GNU Emacs. @@ -813,12 +813,12 @@ non-nil, otherwise in local time." (unless (equal file-name buffer-file-name) (cond - ((equal file-name (buffer-file-name (window-buffer (selected-window)))) + ((equal file-name (buffer-file-name (window-buffer))) ;; If the selected window already shows the desired buffer don't show ;; it again (particularly important if other-window is true). ;; This is important for diff-add-change-log-entries-other-window. - (set-buffer (window-buffer (selected-window)))) - ((or other-window (window-dedicated-p (selected-window))) + (set-buffer (window-buffer))) + ((or other-window (window-dedicated-p)) (find-file-other-window file-name)) (t (find-file file-name)))) (or (derived-mode-p 'change-log-mode) diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index fa451ccbe20..25d4cf77f53 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -1,9 +1,9 @@ ;;; compare-w.el --- compare text between windows for Emacs -;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2013 Free Software +;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience files vc ;; This file is part of GNU Emacs. @@ -35,7 +35,7 @@ :prefix "compare-" :group 'tools) -(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" +(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\|\240\\)+" "Regexp or function that defines whitespace sequences for `compare-windows'. That command optionally ignores changes in whitespace. @@ -49,6 +49,7 @@ any text before that point. If the function returns the same value for both windows, then the whitespace is considered to match, and is skipped." + :version "24.4" ; added \240 :type '(choice regexp function) :group 'compare-windows) @@ -178,7 +179,7 @@ on third call it again advances points to the next difference and so on." 'compare-windows-sync-regexp compare-windows-sync))) (setq p1 (point) b1 (current-buffer)) - (setq w2 (next-window (selected-window))) + (setq w2 (next-window)) (if (eq w2 (selected-window)) (setq w2 (next-window (selected-window) nil 'visible))) (if (eq w2 (selected-window)) diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 4f87d1ac44d..10cff7b0403 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -1,6 +1,6 @@ ;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs cvs status tree vc tools diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d9224b29c2e..923de9a0ca6 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1,6 +1,6 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*- -;; Copyright (C) 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: convenience patch diff vc @@ -124,7 +124,6 @@ when editing big diffs)." ("A" . diff-ediff-patch) ("r" . diff-restrict-view) ("R" . diff-reverse-direction) - ("/" . diff-undo) ([remap undo] . diff-undo)) "Basic keymap for `diff-mode', bound to various prefix keys." :inherit special-mode-map) @@ -1367,7 +1366,8 @@ a diff with \\[diff-reverse-direction]. (diff-setup-whitespace) - (setq buffer-read-only diff-default-read-only) + (if diff-default-read-only + (setq buffer-read-only t)) ;; setup change hooks (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 0fc0d2e3f73..b789b80df8e 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -1,11 +1,11 @@ ;;; diff.el --- run `diff' -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994, 1996, 2001-2013 Free Software Foundation, +;; Copyright (C) 1992, 1994, 1996, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Frank Bresz ;; (according to authors.el) -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: unix, vc, tools ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index b4d986fb036..96e8acca294 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -1,6 +1,6 @@ ;;; ediff-diff.el --- diff-related utilities -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -27,10 +27,8 @@ (provide 'ediff-diff) -(eval-when-compile - (require 'ediff-util)) - (require 'ediff-init) +(require 'ediff-util) (defgroup ediff-diff nil "Diff related utilities." @@ -213,7 +211,7 @@ one optional arguments, diff-number to refine.") ;; ediff-setup-diff-regions is called via a funcall to ;; ediff-setup-diff-regions-function, which can also have the value ;; ediff-setup-diff-regions3, which takes 4 arguments. -(defun ediff-setup-diff-regions (file-A file-B file-C) +(defun ediff-setup-diff-regions (file-A file-B _file-C) ;; looking for '-c', '-i', '-u', or 'c', 'i', 'u' among clustered non-long options (if (string-match "^-[ciu]\\| -[ciu]\\|\\(^\\| \\)-[^- ]+[ciu]" ediff-diff-options) @@ -1225,7 +1223,7 @@ delimiter regions")) ;; like shell-command-sentinel but doesn't print an exit status message ;; we do this because diff always exits with status 1, if diffs are found ;; so shell-command-sentinel displays a confusing message to the user -(defun ediff-process-sentinel (process signal) +(defun ediff-process-sentinel (process _signal) (if (and (memq (process-status process) '(exit signal)) (buffer-name (process-buffer process))) (progn diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el index 833e84b6cea..020a1c33cf1 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -1,6 +1,6 @@ ;;; ediff-help.el --- Code related to the contents of Ediff help buffers -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -253,7 +253,7 @@ the value of this variable and the variables `ediff-help-message-*' in (defun ediff-indent-help-message () - (let* ((shift (/ (max 0 (- (window-width (selected-window)) + (let* ((shift (/ (max 0 (- (window-width) (ediff-help-message-line-length))) 2)) (str (make-string shift ?\ ))) diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el index cf0f3de44c3..c87d52f6856 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -1,6 +1,6 @@ ;;; ediff-hook.el --- setup for Ediff's menus and autoloads -;; Copyright (C) 1995-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 075775923a5..000fdb916e3 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -1,6 +1,6 @@ ;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -567,7 +567,8 @@ and ediff-after-flag. On a non-window system, differences are always highlighted using ASCII flags." :type 'boolean :group 'ediff-highlighting) -(ediff-defvar-local ediff-use-faces t "") +(make-variable-buffer-local 'ediff-use-faces) +(put 'ediff-use-faces 'permanent-local t) ;; this indicates that diff regions are word-size, so fine diffs are ;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise @@ -610,7 +611,8 @@ Otherwise, all difference regions are highlighted, but the selected region is shown in brighter colors." :type 'boolean :group 'ediff-highlighting) -(ediff-defvar-local ediff-highlight-all-diffs t "") +(make-variable-buffer-local 'ediff-highlight-all-diffs) +(put 'ediff-highlight-all-diffs 'permanent-local t) ;; The suffix of the control buffer name. @@ -810,7 +812,7 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs." (ediff-overlay-put extent 'face face) (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo)) -(defun ediff-region-help-echo (extent-or-window &optional overlay point) +(defun ediff-region-help-echo (extent-or-window &optional overlay _point) (unless overlay (setq overlay extent-or-window)) (let ((is-current (ediff-overlay-get overlay 'ediff)) @@ -1768,7 +1770,7 @@ Unless optional argument INPLACE is non-nil, return a new string." (or n (setq n ediff-current-difference)) (and (>= n 0) (< n ediff-number-of-differences))) -(defsubst ediff-show-all-diffs (n) +(defsubst ediff-show-all-diffs (_n) "Don't skip difference regions." nil) diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index dea872bd142..0f7d0628a1d 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -1,6 +1,6 @@ ;;; ediff-merg.el --- merging utilities -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -32,11 +32,8 @@ (defvar ediff-merge-window-share) (defvar ediff-window-config-saved) -(eval-when-compile - (require 'ediff-util)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-util) (defcustom ediff-quit-merge-hook 'ediff-maybe-save-and-delete-merge "Hooks to run before quitting a merge job. @@ -95,6 +92,8 @@ Buffer B." ) (make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default) +(defvar state-of-merge) ; dynamic var + ;; check if there is no clash between the ancestor and one of the variants. ;; if it is not a merge job then return true (defun ediff-merge-region-is-non-clash (n) @@ -354,8 +353,6 @@ Combining is done according to the specifications in variable (reverse delim-regs-list) ))) -(defvar state-of-merge) ; dynamic var - ;; Check if the non-preferred merge has been modified since originally set. ;; This affects only the regions that are marked as default-A/B or combined. ;; If PREFERS-TOO is non-nil, then look at the regions marked as prefers-A/B as diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 3e3bc6c9663..9837c20b84d 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -1,6 +1,6 @@ ;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff -;; Copyright (C) 1995-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -110,14 +110,11 @@ :prefix "ediff-" :group 'ediff) - -;; compiler pacifier -(eval-when-compile - (require 'ediff-ptch) - (require 'ediff)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-diff) +(require 'ediff-wind) +(require 'ediff-util) + ;; meta-buffer (ediff-defvar-local ediff-meta-buffer nil "") @@ -1118,7 +1115,7 @@ behavior." (setq overl (if (featurep 'xemacs) (map-extents - (lambda (ext maparg) + (lambda (ext _maparg) (if (and (ediff-overlay-get ext 'ediff-meta-info) (eq (ediff-overlay-get ext 'ediff-meta-session-number) @@ -1447,7 +1444,7 @@ Useful commands: ;; argument is ignored -(defun ediff-redraw-registry-buffer (&optional ignore) +(defun ediff-redraw-registry-buffer (&optional _ignore) (ediff-with-current-buffer ediff-registry-buffer (let ((point (point)) elt bufAname bufBname bufCname cur-diff total-diffs pt @@ -1795,6 +1792,14 @@ all marked sessions must be active." )) (error "The patch buffer wasn't found")))) +(declare-function ediff-directories-internal "ediff" + (dir1 dir2 dir3 regexp action jobname + &optional startup-hooks merge-autostore-dir)) + +(declare-function ediff-directory-revisions-internal "ediff" + (dir1 regexp action jobname + &optional startup-hooks merge-autostore-dir)) + ;; This function executes in meta buffer. It knows where event happened. (defun ediff-filegroup-action () @@ -2360,6 +2365,8 @@ If this is a session registry buffer then just bury it." (setq point (point-min))) point)))) +(autoload 'ediff-patch-file-internal "ediff-ptch") + ;; this is the action invoked when the user selects a patch from the meta ;; buffer. (defun ediff-patch-file-form-meta (file &optional startup-hooks) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 64f4ee4a6ac..d1332351a74 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -1,6 +1,6 @@ ;;; ediff-ptch.el --- Ediff's patch support -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -33,12 +33,8 @@ :prefix "ediff-" :group 'ediff) -;; compiler pacifier -(eval-when-compile - (require 'ediff)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-util) (defcustom ediff-patch-program "patch" "Name of the program that applies patches. @@ -472,6 +468,8 @@ are two possible targets for this patch. However, these files do not exist." (set-window-buffer ediff-window-B ediff-patch-diagnostics)) (t (display-buffer ediff-patch-diagnostics 'not-this-window)))) +(defvar ediff-use-last-dir) + ;; prompt for file, get the buffer (defun ediff-prompt-for-patch-file () (let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch) @@ -642,6 +640,11 @@ optional argument, then use it." ;;; (eq code 0) ;;; (not (eq code 2)))) +(autoload 'ediff-find-file "ediff") +(declare-function ediff-buffers-internal "ediff" + (buf-a buf-b buf-c startup-hooks job-name + &optional merge-buffer-file)) + (defun ediff-patch-file-internal (patch-buf source-filename &optional startup-hooks) (setq source-filename (expand-file-name source-filename)) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 81146c0c931..127e6b2cfc0 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1,6 +1,6 @@ ;;; ediff-util.el --- the core commands and utilities of ediff -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -40,10 +40,7 @@ (defvar ediff-after-quit-hook-internal nil) (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(eval-when-compile - (require 'ediff)) + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))) ;; end pacifier @@ -540,7 +537,7 @@ to invocation.") ;; to reside. (defun ediff-setup-control-buffer (ctl-buf) "Set up window for control buffer." - (if (window-dedicated-p (selected-window)) + (if (window-dedicated-p) (set-buffer ctl-buf) ; we are in control frame but just in case (switch-to-buffer ctl-buf)) (let ((window-min-height 2)) @@ -1605,7 +1602,7 @@ the width of the A/B/C windows." ;;BEG, END show the region to be positioned. ;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions ;;differently. -(defun ediff-position-region (beg end pos job-name) +(defun ediff-position-region (beg end pos _job-name) (if (> end (point-max)) (setq end (point-max))) (if ediff-windows-job @@ -1632,7 +1629,7 @@ the width of the A/B/C windows." (setq lines (1+ lines))) ;; And position the beginning on the right line (goto-char beg) - (recenter (/ (1+ (max (- (1- (window-height (selected-window))) + (recenter (/ (1+ (max (- (1- (window-height)) lines) 1) ) @@ -1688,7 +1685,7 @@ the width of the A/B/C windows." 'ediff-get-lines-to-region-start) ((eq op 'scroll-up) 'ediff-get-lines-to-region-end) - (t (lambda (a b c) 0)))) + (t (lambda (_a _b _c) 0)))) (max-lines (max (funcall func 'A n ctl-buf) (funcall func 'B n ctl-buf) (if (ediff-buffer-live-p ediff-buffer-C) @@ -2821,7 +2818,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (with-output-to-temp-buffer ediff-msg-buffer (ediff-with-current-buffer standard-output (fundamental-mode)) - (raise-frame (selected-frame)) + (raise-frame) (princ (ediff-version)) (princ "\n\n") (ediff-with-current-buffer ediff-buffer-A @@ -3471,12 +3468,15 @@ Without an argument, it saves customized diff argument, if available (ediff-with-current-buffer buf (goto-char (point-min))) (switch-to-buffer buf) - (raise-frame (selected-frame))))) + (raise-frame)))) (if (frame-live-p ediff-control-frame) (ediff-reset-mouse ediff-control-frame)) (if (window-live-p ediff-control-window) (select-window ediff-control-window))) +(declare-function ediff-regions-internal "ediff" + (buffer-a beg-a end-a buffer-b beg-b end-b + startup-hooks job-name word-mode setup-parameters)) (defun ediff-inferior-compare-regions () "Compare regions in an active Ediff session. diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el index dc004fd1ff1..83dbf84347c 100644 --- a/lisp/vc/ediff-vers.el +++ b/lisp/vc/ediff-vers.el @@ -1,6 +1,6 @@ ;;; ediff-vers.el --- version control interface to Ediff -;; Copyright (C) 1995-1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 81109906262..48cca4d1b6c 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -1,6 +1,6 @@ ;;; ediff-wind.el --- window manipulation utilities -;; Copyright (C) 1994-1997, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Package: ediff @@ -40,19 +40,18 @@ ;; declare-function does not exist in XEmacs (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(eval-when-compile - (require 'ediff-util) - (require 'ediff-help)) -;; end pacifier + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))) (require 'ediff-init) +(require 'ediff-help) +;; end pacifier + ;; be careful with ediff-tbar -(if (featurep 'xemacs) - (require 'ediff-tbar) - (defun ediff-compute-toolbar-width () 0)) +(eval-and-compile + (if (featurep 'xemacs) + (require 'ediff-tbar) + (defun ediff-compute-toolbar-width () 0))) (defgroup ediff-window nil "Ediff window manipulation." @@ -281,7 +280,7 @@ into icons, regardless of the window manager." ;;; Functions -(defun ediff-get-window-by-clicking (wind prev-wind wind-number) +(defun ediff-get-window-by-clicking (_wind _prev-wind wind-number) (let (event) (message "Select windows by clicking. Please click on Window %d " wind-number) @@ -290,9 +289,9 @@ into icons, regardless of the window manager." (beep 1)) (message "Please click on Window %d " wind-number)) (ediff-read-event) ; discard event - (setq wind (if (featurep 'xemacs) - (event-window event) - (posn-window (event-start event)))))) + (if (featurep 'xemacs) + (event-window event) + (posn-window (event-start event))))) ;; Select the lowest window on the frame. @@ -358,6 +357,8 @@ into icons, regardless of the window manager." (ediff-setup-windows-plain-compare buffer-A buffer-B buffer-C control-buffer))) +(autoload 'ediff-setup-control-buffer "ediff-util") + (defun ediff-setup-windows-plain-merge (buf-A buf-B buf-C control-buffer) ;; skip dedicated and unsplittable frames (ediff-destroy-control-frame control-buffer) @@ -860,7 +861,7 @@ into icons, regardless of the window manager." ;; create a new splittable frame if none is found (defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) (if (ediff-window-display-p) - (let ((wind-frame (window-frame (selected-window))) + (let ((wind-frame (window-frame)) seen-windows) (while (and (not (memq (selected-window) seen-windows)) (or @@ -876,7 +877,7 @@ into icons, regardless of the window manager." (setq seen-windows (cons (selected-window) seen-windows)) ;; try new window (other-window 1 t) - (setq wind-frame (window-frame (selected-window))) + (setq wind-frame (window-frame)) ) (if (memq (selected-window) seen-windows) ;; fed up, no appropriate frames @@ -908,6 +909,8 @@ into icons, regardless of the window manager." (not (ediff-frame-has-dedicated-windows (window-frame wind))) ))) +(declare-function ediff-make-bottom-toolbar "ediff-util" (&optional frame)) + ;; Prepare or refresh control frame (defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) (let ((window-min-height 1) @@ -936,7 +939,7 @@ into icons, regardless of the window manager." (setq ctl-frame-iconified-p (ediff-frame-iconified-p ctl-frame)) (select-frame ctl-frame) - (if (window-dedicated-p (selected-window)) + (if (window-dedicated-p) () (delete-other-windows) (switch-to-buffer ctl-buffer)) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index aba23b06535..d8abe89d17b 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -1,6 +1,6 @@ ;;; ediff.el --- a comprehensive visual interface to diff & patch -;; Copyright (C) 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994-2014 Free Software Foundation, Inc. ;; Author: Michael Kifer ;; Created: February 2, 1994 @@ -12,8 +12,8 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst ediff-version "2.81.4" "The current version of Ediff") -(defconst ediff-date "December 7, 2009" "Date of last update") +(defconst ediff-version "2.81.5" "The current version of Ediff") +(defconst ediff-date "July 4, 2013" "Date of last update") ;; This file is part of GNU Emacs. @@ -114,13 +114,9 @@ ;; Compiler pacifier (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))) - -(eval-when-compile - (require 'dired) - (require 'ediff-util) - (require 'ediff-ptch)) +(require 'ediff-util) ;; end pacifier (require 'ediff-init) @@ -154,6 +150,11 @@ (ediff-with-current-buffer ediff-buffer-A (setq buffer-read-only t))) +(declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep)) +(declare-function dired-get-marked-files "dired" + (&optional localp arg filter distinguish-one-marked)) + ;; Return a plausible default for ediff's first file: ;; In dired, return the file number FILENO (or 0) in the list ;; (all-selected-files, filename under the cursor), where directories are @@ -1345,6 +1346,12 @@ buffer." rev1 rev2 ancestor-rev startup-hooks merge-buffer-file))) ;;; Apply patch +(defvar ediff-last-dir-patch) +(defvar ediff-patch-default-directory) +(declare-function ediff-get-patch-buffer "ediff-ptch" + (&optional arg patch-buf)) +(declare-function ediff-dispatch-file-patching-job "ediff-ptch" + (patch-buf filename &optional startup-hooks)) ;;;###autoload (defun ediff-patch-file (&optional arg patch-buf) @@ -1373,6 +1380,9 @@ buffer. If odd -- assume it is in a file." source-dir nil nil (ediff-get-default-file-name))) (ediff-dispatch-file-patching-job patch-buf source-file))) +(declare-function ediff-patch-buffer-internal "ediff-ptch" + (patch-buf buf-to-patch-name &optional startup-hooks)) + ;;;###autoload (defun ediff-patch-buffer (&optional arg patch-buf) "Run Ediff by patching the buffer specified at prompt. @@ -1464,14 +1474,14 @@ Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'." "Return string describing the version of Ediff. When called interactively, displays the version." (interactive) - ;; called-interactively-p - not in XEmacs - ;; (if (called-interactively-p 'interactive) - (if (interactive-p) + (if (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "%s" (ediff-version)) (format "Ediff %s of %s" ediff-version ediff-date))) ;; info is run first, and will autoload info.el. -(declare-function Info-goto-node "info" (nodename &optional fork)) +(declare-function Info-goto-node "info" (nodename &optional fork strict-case)) ;;;###autoload (defun ediff-documentation (&optional node) @@ -1489,7 +1499,7 @@ With optional NODE, goes to that node." (if node (Info-goto-node node) (message "Type `i' to search for a specific topic")) - (raise-frame (selected-frame))) + (raise-frame)) (error (beep 1) (with-output-to-temp-buffer ediff-msg-buffer (ediff-with-current-buffer standard-output @@ -1550,6 +1560,75 @@ With optional NODE, goes to that node." (add-to-list 'debug-ignored-errors mess)) + +;;; Command line interface + +;;;###autoload +(defun ediff-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff file-a file-b))) + +;;;###autoload +(defun ediff3-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff3 file-a file-b file-c))) + +;;;###autoload +(defun ediff-merge-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff-merge-files file-a file-b))) + +;;;###autoload +(defun ediff-merge-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-files-with-ancestor file-a file-b ancestor))) + +;;;###autoload +(defun ediff-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-directories3-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-directories3 file-a file-b file-c regexp))) + +;;;###autoload +(defun ediff-merge-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-merge-directories-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-merge-directories-with-ancestor file-a file-b ancestor regexp))) + + + (require 'ediff-util) (run-hooks 'ediff-load-hook) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index 0a1bd044125..0cf4484aac1 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -849,7 +849,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;;; Functions to start Emerge on files ;;;###autoload -(defun emerge-files (arg file-A file-B file-out &optional startup-hooks +(defun emerge-files (_arg file-A file-B file-out &optional startup-hooks quit-hooks) "Run Emerge on two files." (interactive @@ -869,7 +869,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") file-out)) ;;;###autoload -(defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out +(defun emerge-files-with-ancestor (_arg file-A file-B file-ancestor file-out &optional startup-hooks quit-hooks) "Run Emerge on two files, giving another file as the ancestor." (interactive @@ -1063,7 +1063,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") quit-hooks))) (defun emerge-revisions-internal (file revision-A revision-B &optional - startup-hooks quit-hooks output-file) + startup-hooks quit-hooks _output-file) (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) (emerge-file-A (emerge-make-temp-file "A")) @@ -1770,7 +1770,7 @@ to the left margin, if they are in windows." (setq lines (1+ lines))) ;; And position the beginning on the right line (goto-char beg) - (recenter (/ (1+ (- (1- (window-height (selected-window))) + (recenter (/ (1+ (- (1- (window-height)) lines)) 2)))))) (goto-char pos)) @@ -2516,8 +2516,12 @@ for how the template is interpreted. Refuses to function if this difference has been edited, i.e., if it is neither the A nor the B variant. An argument forces the variant to be selected even if the difference has -been edited." - (interactive "cRegister containing template: \nP") +been edited. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list + (register-read-with-preview "Register containing template: ") + current-prefix-arg)) (let ((template (get-register char))) (if (not (stringp template)) (error "Register does not contain text")) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index dfc7eee81a6..e6bd897f4ac 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1,6 +1,6 @@ ;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs cvs commit log vc @@ -32,6 +32,7 @@ (require 'add-log) ; for all the ChangeLog goodies (require 'pcvs-util) (require 'ring) +(require 'message) ;;;; ;;;; Global Variables @@ -55,6 +56,8 @@ ("\C-c\C-a" . log-edit-insert-changelog) ("\C-c\C-d" . log-edit-show-diff) ("\C-c\C-f" . log-edit-show-files) + ("\C-c\C-k" . log-edit-kill-buffer) + ("\C-a" . log-edit-beginning-of-line) ("\M-n" . log-edit-next-comment) ("\M-p" . log-edit-previous-comment) ("\M-r" . log-edit-comment-search-backward) @@ -116,15 +119,27 @@ If SETUP is 'force, this variable has no effect." :group 'log-edit :type 'boolean) -(defcustom log-edit-hook '(log-edit-insert-cvs-template - log-edit-show-files - log-edit-insert-changelog) +(defcustom log-edit-setup-add-author nil + "Non-nil means `log-edit' may add the `Author:' header. +This applies when its SETUP argument is non-nil." + :version "24.4" + :group 'log-edit + :type 'boolean + :safe 'booleanp) + +(defcustom log-edit-hook '(log-edit-insert-message-template + log-edit-insert-cvs-template + log-edit-insert-changelog + log-edit-show-files) "Hook run at the end of `log-edit'." :group 'log-edit - :type '(hook :options (log-edit-insert-changelog - log-edit-insert-cvs-rcstemplate - log-edit-insert-cvs-template - log-edit-insert-filenames))) + :type '(hook :options (log-edit-insert-message-template + log-edit-insert-cvs-rcstemplate + log-edit-insert-cvs-template + log-edit-insert-changelog + log-edit-insert-filenames + log-edit-insert-filenames-without-changelog + log-edit-show-files))) (defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook) "Hook run when entering `log-edit-mode'." @@ -256,7 +271,7 @@ WHOAMI (interactive prefix) non-nil means prompt for user name and site. FILE-NAME is the name of the change log; if nil, use `change-log-default-name'. -This may be useful as a `log-edit-checkin-hook' to update change logs +This may be useful as a `vc-checkin-hook' to update change logs automatically." (interactive (if current-prefix-arg (list current-prefix-arg @@ -340,6 +355,21 @@ The first subexpression is the actual text of the field.") (set-match-data (list start (point))) (point)))) +(defun log-edit--match-first-line (limit) + (let ((start (point))) + (rfc822-goto-eoh) + (skip-chars-forward "\n") + (and (< start (line-end-position)) + (< (point) limit) + (save-excursion + (not (re-search-backward "^Summary:[ \t]*[^ \t\n]" nil t))) + (looking-at ".+") + (progn + (goto-char (match-end 0)) + (put-text-property (point-min) (point) + 'jit-lock-defer-multiline t) + (point))))) + (defvar log-edit-font-lock-keywords ;; Copied/inspired by message-font-lock-keywords. `((log-edit-match-to-eoh @@ -355,7 +385,8 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(:height 0.1 :inverse-video t)))))) + (0 '(:height 0.1 :inverse-video t)))) + (log-edit--match-first-line (0 'log-edit-summary)))) (defvar log-edit-font-lock-gnu-style nil "If non-nil, highlight common failures to follow the GNU coding standards.") @@ -427,10 +458,6 @@ done. Otherwise, it uses the current buffer." (if buffer (pop-to-buffer buffer)) (when (and log-edit-setup-invert (not (eq setup 'force))) (setq setup (not setup))) - (when setup - (erase-buffer) - (insert "Summary: \nAuthor: ") - (save-excursion (insert "\n\n"))) (if mode (funcall mode) (log-edit-mode)) @@ -444,8 +471,10 @@ done. Otherwise, it uses the current buffer." (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent)) (set (make-local-variable 'log-edit-initial-files) (log-edit-files)) - (when setup (run-hooks 'log-edit-hook)) - (goto-char (point-min)) (push-mark (point-max)) + (when setup + (erase-buffer) + (run-hooks 'log-edit-hook)) + (push-mark (point-max)) (message "%s" (substitute-command-keys "Press \\[log-edit-done] when you are done editing.")))) @@ -460,14 +489,26 @@ commands (under C-x v for VC, for example). \\{log-edit-mode-map}" (set (make-local-variable 'font-lock-defaults) '(log-edit-font-lock-keywords t)) + (setq-local jit-lock-contextually t) ;For the "first line is summary". (make-local-variable 'log-edit-comment-ring-index) + (add-hook 'kill-buffer-hook 'log-edit-remember-comment nil t) (hack-dir-local-variables-non-file-buffer)) (defun log-edit-hide-buf (&optional buf where) (when (setq buf (get-buffer (or buf log-edit-files-buf))) - (let ((win (get-buffer-window buf where))) - (if win (ignore-errors (delete-window win)))) - (bury-buffer buf))) + ;; FIXME: Should use something like `quit-windows-on' here, but + ;; that function never deletes this buffer's window because it + ;; was created using `cvs-pop-to-buffer-same-frame'. + (save-selected-window + (let ((win (get-buffer-window buf where))) + (if win (ignore-errors (delete-window win)))) + (bury-buffer buf)))) + +(defun log-edit-remember-comment (&optional comment) + (unless comment (setq comment (buffer-string))) + (when (or (ring-empty-p log-edit-comment-ring) + (not (equal comment (ring-ref log-edit-comment-ring 0)))) + (ring-insert log-edit-comment-ring comment))) (defun log-edit-done () "Finish editing the log message and commit the files. @@ -500,10 +541,7 @@ If you want to abort the commit, simply delete the buffer." (save-excursion (goto-char (point-max)) (insert ?\n))) - (let ((comment (buffer-string))) - (when (or (ring-empty-p log-edit-comment-ring) - (not (equal comment (ring-ref log-edit-comment-ring 0)))) - (ring-insert log-edit-comment-ring comment))) + (log-edit-remember-comment) (let ((win (get-buffer-window log-edit-files-buf))) (if (and log-edit-confirm (not (and (eq log-edit-confirm 'changed) @@ -519,6 +557,16 @@ If you want to abort the commit, simply delete the buffer." (cvs-bury-buffer (current-buffer) log-edit-parent-buffer)) (call-interactively log-edit-callback)))) +(defun log-edit-kill-buffer () + "Kill the current buffer. +Also saves its contents in the comment history and hides +`log-edit-files-buf'." + (interactive) + (log-edit-hide-buf) + (let ((buf (current-buffer))) + (quit-windows-on buf) + (kill-buffer buf))) + (defun log-edit-files () "Return the list of files that are about to be committed." (ignore-errors (funcall log-edit-listfun))) @@ -572,8 +620,18 @@ If you want to abort the commit, simply delete the buffer." (save-selected-window (cvs-pop-to-buffer-same-frame buf) (shrink-window-if-larger-than-buffer) + (set-window-dedicated-p (selected-window) t) (selected-window))))) +(defun log-edit-beginning-of-line (&optional n) + "Move point to beginning of header value or to beginning of line. + +It works the same as `message-beginning-of-line', but it uses a +different header separator appropriate for `log-edit-mode'." + (interactive "p") + (let ((mail-header-separator "")) + (message-beginning-of-line n))) + (defun log-edit-empty-buffer-p () "Return non-nil if the buffer is \"empty\"." (or (= (point-min) (point-max)) @@ -583,6 +641,17 @@ If you want to abort the commit, simply delete the buffer." (zerop (forward-line 1)))) (eobp)))) +(defun log-edit-insert-message-template () + "Insert the default template with Summary and Author." + (interactive) + (when (or (called-interactively-p 'interactive) + (log-edit-empty-buffer-p)) + (insert "Summary: ") + (when log-edit-setup-add-author + (insert "\nAuthor: ")) + (insert "\n\n") + (message-position-point))) + (defun log-edit-insert-cvs-template () "Insert the template specified by the CVS administrator, if any. This simply uses the local CVS/Template file." @@ -614,12 +683,25 @@ can thus take some time." (insert "Affected files: \n" (mapconcat 'identity (log-edit-files) " \n"))) +(defun log-edit-insert-filenames-without-changelog () + "Insert the list of files that have no ChangeLog message." + (interactive) + (let ((files + (delq nil + (mapcar + (lambda (file) + (unless (or (cdr-safe (log-edit-changelog-entries file)) + (equal (file-name-nondirectory file) "ChangeLog")) + file)) + (log-edit-files))))) + (when files + (goto-char (point-max)) + (insert (mapconcat 'identity files ", ") ": ")))) + (defun log-edit-add-to-changelog () "Insert this log message into the appropriate ChangeLog file." (interactive) - ;; Yuck! - (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0)) - (ring-insert log-edit-comment-ring (buffer-string))) + (log-edit-remember-comment) (dolist (f (log-edit-files)) (let ((buffer-file-name (expand-file-name f))) (save-excursion @@ -660,39 +742,39 @@ If the optional prefix arg USE-FIRST is given (via \\[universal-argument]), or if the command is repeated a second time in a row, use the first log entry regardless of user name or time." (interactive "P") - (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) - (when (<= (point) eoh) - (goto-char eoh) - (if (looking-at "\n") (forward-char 1)))) - (let ((author - (let ((log-edit-changelog-use-first - (or use-first (eq last-command 'log-edit-insert-changelog)))) - (log-edit-insert-changelog-entries (log-edit-files))))) - (log-edit-set-common-indentation) - ;; Add an Author: field if appropriate. - (when author (log-edit-add-field "Author" author)) - ;; Add a Fixes: field if applicable. - (when (consp log-edit-rewrite-fixes) - (rfc822-goto-eoh) - (when (re-search-forward (car log-edit-rewrite-fixes) nil t) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (fixes (match-substitute-replacement - (cdr log-edit-rewrite-fixes)))) - (delete-region start end) - (log-edit-add-field "Fixes" fixes)))) - (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)))) + (save-excursion + (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) + (when (<= (point) eoh) + (goto-char eoh) + (if (looking-at "\n") (forward-char 1)))) + (let ((author + (let ((log-edit-changelog-use-first + (or use-first (eq last-command 'log-edit-insert-changelog)))) + (log-edit-insert-changelog-entries (log-edit-files))))) + (log-edit-set-common-indentation) + ;; Add an Author: field if appropriate. + (when author (log-edit-add-field "Author" author)) + ;; Add a Fixes: field if applicable. + (when (consp log-edit-rewrite-fixes) + (rfc822-goto-eoh) + (when (re-search-forward (car log-edit-rewrite-fixes) nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (fixes (match-substitute-replacement + (cdr log-edit-rewrite-fixes)))) + (delete-region start end) + (log-edit-add-field "Fixes" fixes)))) + (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)))))))) ;;;; ;;;; functions for getting commit message from ChangeLog a file... @@ -904,10 +986,14 @@ Rename relative filenames in the ChangeLog entry as FILES." (defun log-edit-toggle-header (header value) "Toggle a boolean-type header in the current buffer. -If the value of HEADER is VALUE, clear it. Otherwise, add the -header if it's not present and set it to VALUE. Then make sure -there is an empty line after the headers. Return t if toggled -on, otherwise nil." +See `log-edit-set-header' for details." + (log-edit-set-header header value t)) + +(defun log-edit-set-header (header value &optional toggle) + "Set the value of HEADER to VALUE in the current buffer. +If TOGGLE is non-nil, and the value of HEADER already is VALUE, +clear it. Make sure there is an empty line after the headers. +Return t if toggled on (or TOGGLE is nil), otherwise nil." (let ((val t) (line (concat header ": " value "\n"))) (save-excursion @@ -918,7 +1004,7 @@ on, otherwise nil." (if (re-search-forward (concat "^" header ":" log-edit-header-contents-regexp) nil t) - (if (setq val (not (string= (match-string 1) value))) + (if (setq val (not (and toggle (string= (match-string 1) value)))) (replace-match line t t) (replace-match "" t t nil 1)) (insert line))) @@ -966,7 +1052,7 @@ line of MSG." (goto-char (point-min)) (when (looking-at "\\([ \t]*\n\\)+") (delete-region (match-beginning 0) (match-end 0))) - (if summary (insert summary "\n")) + (if summary (insert summary "\n\n")) (cons (buffer-string) res)))) (provide 'log-edit) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index b74ff77bc41..484e40f7ac0 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -1,9 +1,9 @@ -;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*- +;;; log-view.el --- Major mode for browsing revision log histories -*- lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Keywords: rcs, sccs, cvs, log, vc, tools +;; Keywords: tools, vc ;; This file is part of GNU Emacs. @@ -24,10 +24,12 @@ ;; Major mode to browse revision log histories. ;; Currently supports the format output by: -;; RCS, SCCS, CVS, Subversion, and DaRCS. +;; SCCS, RCS, CVS, Subversion, DaRCS, and Mercurial. ;; Examples of log output: +;;;; SCCS: + ;;;; RCS/CVS: ;; ---------------------------- @@ -43,8 +45,6 @@ ;; Change release version from 21.4 to 22.1 throughout. ;; Change development version from 21.3.50 to 22.0.50. -;;;; SCCS: - ;;;; Subversion: ;; ------------------------------------------------------------------------ @@ -117,18 +117,25 @@ (defvar cvs-force-command) (defgroup log-view nil - "Major mode for browsing log output of RCS/CVS/SCCS." + "Major mode for browsing log output of revision log histories." :group 'pcl-cvs :prefix "log-view-") (easy-mmode-defmap log-view-mode-map '( - ;; FIXME: (copy-keymap special-mode-map) instead - ("z" . kill-this-buffer) - ("q" . quit-window) - ("g" . revert-buffer) - ("\C-m" . log-view-toggle-entry-display) + ("-" . negative-argument) + ("0" . digit-argument) + ("1" . digit-argument) + ("2" . digit-argument) + ("3" . digit-argument) + ("4" . digit-argument) + ("5" . digit-argument) + ("6" . digit-argument) + ("7" . digit-argument) + ("8" . digit-argument) + ("9" . digit-argument) + ("\C-m" . log-view-toggle-entry-display) ("m" . log-view-toggle-mark-entry) ("e" . log-view-modify-change-comment) ("d" . log-view-diff) @@ -145,6 +152,7 @@ ("\M-n" . log-view-file-next) ("\M-p" . log-view-file-prev)) "Log-View's keymap." + :inherit special-mode-map :group 'log-view) (easy-menu-define log-view-mode-menu log-view-mode-map @@ -275,6 +283,7 @@ The match group number 1 should match the revision number itself.") (easy-mmode-define-navigation log-view-file log-view-file-re "file") (defun log-view-goto-rev (rev) + "Go to revision REV." (goto-char (point-min)) (ignore-errors (while (not (equal rev (log-view-current-tag))) @@ -288,6 +297,7 @@ The match group number 1 should match the revision number itself.") (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$") (defun log-view-current-file () + "Return the current file." (save-excursion (forward-line 1) (or (re-search-backward log-view-file-re nil t) @@ -317,7 +327,9 @@ Otherwise, don't move point." result) (save-excursion (when pos (goto-char pos)) - (forward-line 1) + (forward-line 0) + ;; Treat "---" separator lines as part of the following revision. + (forward-line (if (looking-at "-\\{20,\\}$") 2 1)) (while looping (setq pos (re-search-backward log-view-message-re nil 'move) looping (and pos (log-view-inside-comment-p (point))))) @@ -338,7 +350,7 @@ if POS is omitted or nil, it defaults to point." (defun log-view-toggle-mark-entry () "Toggle the marked state for the log entry at point. -Individual log entries can be marked and unmarked. The marked +Individual log entries can be marked and unmarked. The marked entries are denoted by changing their background color. `log-view-get-marked' returns the list of tags for the marked log entries." @@ -417,18 +429,31 @@ 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)) + (when (null arg) (setf 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)))) + ;; In log view, the end of one defun is the beginning of the + ;; next, so punting to log-view-end-of-defun is safe in this + ;; context. + (log-view-end-of-defun (- arg)) + (let ((found t)) + (while (> arg 0) + (setf arg (1- arg)) + (let ((cur-start (log-view-current-entry))) + (setf found + (cond ((null cur-start) + (goto-char (point-min)) + nil) + ((>= (car cur-start) (point)) + (unless (bobp) + (forward-line -1) + (setf arg (1+ arg))) + nil) + (t + (goto-char (car cur-start)) + t))))) + found))) -(defun log-view-end-of-defun () +(defun log-view-end-of-defun-1 () "Move forward to the next Log View entry." (let ((looping t)) (if (looking-at log-view-message-re) @@ -445,6 +470,16 @@ It assumes that a log entry starts with a line matching (setq looping nil) (forward-line -1)))))) +(defun log-view-end-of-defun (&optional arg) + "Move forward to the next Log View entry. +Works like `end-of-defun'." + (when (null arg) (setf arg 1)) + (if (< arg 0) + (log-view-beginning-of-defun (- arg)) + (dotimes (_n arg) + (log-view-end-of-defun-1) + t))) + (defvar cvs-minor-current-files) (defvar cvs-branch-prefix) (defvar cvs-secondary-branch-prefix) @@ -477,7 +512,8 @@ It assumes that a log entry starts with a line matching (funcall f)))) (defun log-view-find-revision (pos) - "Visit the version at point." + "Visit the version at POS. +If called interactively, visit the version at point." (interactive "d") (unless log-view-per-file-logs (when (> (length log-view-vc-fileset) 1) @@ -498,7 +534,8 @@ It assumes that a log entry starts with a line matching (cond ((eq backend 'SVN) (forward-line -1))) (setq en (point)) - (log-view-beginning-of-defun) + (or (log-view-current-entry nil t) + (throw 'beginning-of-buffer nil)) (cond ((memq backend '(SCCS RCS CVS MCVS SVN)) (forward-line 2)) ((eq backend 'Hg) @@ -519,7 +556,8 @@ It assumes that a log entry starts with a line matching (log-view-extract-comment))) (defun log-view-annotate-version (pos) - "Annotate the version at point." + "Annotate the version at POS. +If called interactively, annotate the version at point." (interactive "d") (unless log-view-per-file-logs (when (> (length log-view-vc-fileset) 1) @@ -548,19 +586,7 @@ file(s)." (interactive (list (if (use-region-p) (region-beginning) (point)) (if (use-region-p) (region-end) (point)))) - (let ((fr (log-view-current-tag beg)) - (to (log-view-current-tag end))) - (when (string-equal fr to) - (save-excursion - (goto-char end) - (log-view-msg-next) - (setq to (log-view-current-tag)))) - (vc-diff-internal - t (list log-view-vc-backend - (if log-view-per-file-logs - (list (log-view-current-file)) - log-view-vc-fileset)) - to fr))) + (log-view-diff-common beg end)) (defun log-view-diff-changeset (beg end) "Get the diff between two revisions. @@ -575,20 +601,29 @@ considered file(s)." (interactive (list (if (use-region-p) (region-beginning) (point)) (if (use-region-p) (region-end) (point)))) - (when (eq (vc-call-backend log-view-vc-backend 'revision-granularity) 'file) + (log-view-diff-common beg end t)) + +(defun log-view-diff-common (beg end &optional whole-changeset) + (when (and whole-changeset + (eq (vc-call-backend log-view-vc-backend 'revision-granularity) + 'file)) (error "The %s backend does not support changeset diffs" log-view-vc-backend)) - (let ((fr (log-view-current-tag beg)) - (to (log-view-current-tag end))) + (let ((to (log-view-current-tag beg)) + (fr (log-view-current-tag end))) (when (string-equal fr to) ;; TO and FR are the same, look at the previous revision. - (setq to (vc-call-backend log-view-vc-backend 'previous-revision nil fr))) + (setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr))) (vc-diff-internal - t - ;; We want to see the diff for all the files in the changeset, so - ;; pass NIL for the file list. The value passed here should - ;; follow what `vc-deduce-fileset' returns. - (list log-view-vc-backend nil) - to fr))) + t (list log-view-vc-backend + ;; The value passed here should follow what + ;; `vc-deduce-fileset' returns. If we want to see the + ;; diff for all the files in the changeset, pass NIL for + ;; the file list. + (unless whole-changeset + (if log-view-per-file-logs + (list (log-view-current-file)) + log-view-vc-fileset))) + fr to))) (provide 'log-view) diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 9dc378e4e27..0d3f81d7a47 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -1,6 +1,6 @@ ;;; pcvs-defs.el --- variable definitions for PCL-CVS -;; Copyright (C) 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs @@ -244,13 +244,6 @@ Output from cvs is placed here for asynchronous commands.") "Run after `cvs-mode' was setup.") -;;;; -;;;; Internal variables, used in the process buffer. -;;;; - -(defvar cvs-postprocess nil - "(Buffer local) what to do once the process exits.") - ;;;; ;;;; Internal variables for the *cvs* buffer. ;;;; @@ -431,6 +424,7 @@ This variable is buffer local and only used in the *cvs* buffer.") (defcustom cvs-minor-mode-prefix "\C-xc" "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'." + :type 'string :group 'pcl-cvs) (easy-mmode-defmap cvs-minor-mode-map diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 2719a7fb54a..51e15d2ea6a 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -1,6 +1,6 @@ ;;; pcvs-info.el --- internal representation of a fileinfo entry -;; Copyright (C) 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index c267f32b2d7..23225d178fd 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -1,6 +1,6 @@ ;;; pcvs-parse.el --- the CVS output parser -;; Copyright (C) 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 28ae4ed3de3..8ef3b30759e 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -1,6 +1,6 @@ ;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*- -;; Copyright (C) 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs @@ -97,7 +97,7 @@ try to split a new window instead." BUF is assumed to be a temporary buffer used from the buffer MAINBUF." (interactive (list (current-buffer))) (save-current-buffer - (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window) + (let ((win (if (eq buf (window-buffer)) (selected-window) (get-buffer-window buf t)))) (when win (if (window-dedicated-p win) @@ -111,8 +111,8 @@ BUF is assumed to be a temporary buffer used from the buffer MAINBUF." ;;; ) ))) (with-current-buffer buf - (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) - (not (window-dedicated-p (selected-window)))) + (bury-buffer (unless (and (eq buf (window-buffer)) + (not (window-dedicated-p))) buf))) (when mainbuf (let ((mainwin (or (get-buffer-window mainbuf) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 208b93d9670..4f0f1e8e7fe 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -1,6 +1,6 @@ -;;; pcvs.el --- a front-end to CVS +;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*- -;; Copyright (C) 1991-2013 Free Software Foundation, Inc. +;; Copyright (C) 1991-2014 Free Software Foundation, Inc. ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com ;; (Per Cederqvist) ceder@lysator.liu.se @@ -122,6 +122,7 @@ (require 'pcvs-util) (require 'pcvs-parse) (require 'pcvs-info) +(require 'vc-cvs) ;;;; @@ -348,7 +349,7 @@ information and will be read-only unless NORMAL is non-nil. It will be emptied from the current buffer." (let* ((cvs-buf (current-buffer)) (info (cdr (assoc cmd cvs-buffer-name-alist))) - (name (eval (nth 0 info))) + (name (eval (nth 0 info) `((cmd . ,cmd)))) (mode (nth 1 info)) (dir default-directory) (buf (cond @@ -358,9 +359,10 @@ from the current buffer." (t (set (make-local-variable 'cvs-temp-buffer) (cvs-get-buffer-create - (eval cvs-temp-buffer-name) 'noreuse)))))) + (eval cvs-temp-buffer-name `((dir . ,dir))) + 'noreuse)))))) - ;; handle the potential pre-existing process + ;; Handle the potential pre-existing process. (let ((proc (get-buffer-process buf))) (when (and (not normal) (processp proc) (memq (process-status proc) '(run stop))) @@ -415,7 +417,7 @@ from the current buffer." If non-nil, NEW means to create a new buffer no matter what." ;; the real cvs-buffer creation (setq dir (cvs-expand-dir-name dir)) - (let* ((buffer-name (eval cvs-buffer-name)) + (let* ((buffer-name (eval cvs-buffer-name `((dir . ,dir)))) (buffer (or (and (not new) (eq cvs-reuse-cvs-buffer 'current) @@ -568,9 +570,9 @@ If non-nil, NEW means to create a new buffer no matter what." process 'cvs-postprocess (if (null rest) ;; this is the last invocation - postprocess + postprocess ;; else, we have to register ourselves to be rerun on the rest - `(cvs-run-process ',args ',rest ',postprocess ',single-dir))) + (lambda () (cvs-run-process args rest postprocess single-dir)))) (set-process-sentinel process 'cvs-sentinel) (set-process-filter process 'cvs-update-filter) (set-marker (process-mark process) (point-max)) @@ -647,7 +649,7 @@ If non-nil, NEW means to create a new buffer no matter what." done)))) -(defun cvs-sentinel (proc msg) +(defun cvs-sentinel (proc _msg) "Sentinel for the cvs update process. This is responsible for parsing the output from the cvs update when it is finished." @@ -674,7 +676,8 @@ it is finished." (error "cvs' process buffer was killed") (with-current-buffer procbuf ;; Do the postprocessing like parsing and such. - (save-excursion (eval cvs-postproc))))))) + (save-excursion + (funcall cvs-postproc))))))) ;; Check whether something is left. (when (and procbuf (not (get-buffer-process procbuf))) (with-current-buffer procbuf @@ -754,7 +757,8 @@ clear what alternative to use. - NOARGS will get all the arguments from the *cvs* buffer and will always behave as if called interactively. - DOUBLE is the generic case." - (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)) + (declare (debug (&define sexp lambda-list stringp + ("interactive" interactive) def-body)) (doc-string 3)) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) @@ -980,7 +984,7 @@ The files are stored to DIR." ;;;; (defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE) - (&optional ignore-auto noconfirm) + (&optional _ignore-auto _noconfirm) "Rerun `cvs-examine' on the current directory with the default flags." (interactive) (cvs-examine default-directory t)) @@ -994,7 +998,7 @@ If in a *cvs* buffer, don't prompt unless a prefix argument is given." (read-directory-name prompt nil default-directory nil))) ;;;###autoload -(defun cvs-quickdir (dir &optional flags noshow) +(defun cvs-quickdir (dir &optional _flags noshow) "Open a *cvs* buffer on DIR without running cvs. With a prefix argument, prompt for a directory to use. A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]), @@ -1464,7 +1468,7 @@ The POSTPROC specified there (typically `log-edit') is then called, (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap) (run-hooks 'cvs-mode-commit-hook))) -(defun cvs-commit-minor-wrap (buf f) +(defun cvs-commit-minor-wrap (_buf f) (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit"))) (funcall f))) @@ -1597,24 +1601,25 @@ With prefix argument, prompt for cvs flags." (interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags"))) (let ((fis (cvs-mode-marked 'add)) (needdesc nil) (dirs nil)) - ;; find directories and look for fis needing a description + ;; Find directories and look for fis needing a description. (dolist (fi fis) (cond ((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs)) ((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t)))) - ;; prompt for description if necessary + ;; Prompt for description if necessary. (let* ((msg (if (and needdesc (or current-prefix-arg (not cvs-add-default-message))) (read-from-minibuffer "Enter description: ") (or cvs-add-default-message ""))) (flags `("-m" ,msg ,@flags)) (postproc - ;; setup postprocessing for the directory entries + ;; Setup postprocessing for the directory entries. (when dirs - `((cvs-run-process (list "-n" "update") - ',dirs - '(cvs-parse-process t)) - (cvs-mark-fis-dead ',dirs))))) + (lambda () + (cvs-run-process (list "-n" "update") + dirs + (lambda () (cvs-parse-process t))) + (cvs-mark-fis-dead dirs))))) (cvs-mode-run "add" flags fis :postproc postproc)))) (defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags) @@ -1665,10 +1670,7 @@ or \"Conflict\" in the *cvs* buffer." (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked)))) (unless (consp fis) (error "No files with a backup file selected!")) - ;; let's extract some info into the environment for `buffer-name' - (let* ((dir (cvs-fileinfo->dir (car fis))) - (file (cvs-fileinfo->file (car fis)))) - (set-buffer (cvs-temp-buffer "diff"))) + (set-buffer (cvs-temp-buffer "diff")) (message "cvs diff backup...") (cvs-execute-single-file-list fis 'cvs-diff-backup-extractor cvs-diff-program flags)) @@ -1850,15 +1852,16 @@ Signal an error if there is no backup file." ret))) (cl-defun cvs-mode-run (cmd flags fis - &key (buf (cvs-temp-buffer)) - dont-change-disc cvsargs postproc) + &key (buf (cvs-temp-buffer)) + dont-change-disc cvsargs postproc) "Generic cvs-mode- function. Executes `cvs CVSARGS CMD FLAGS FIS'. BUF is the buffer to be used for cvs' output. DONT-CHANGE-DISC non-nil indicates that the command will not change the contents of files. This is only used by the parser. -POSTPROC is a list of expressions to be evaluated at the very end (after - parsing if applicable). It will be prepended with `progn' if necessary." +POSTPROC is a function of no argument to be evaluated at the very end (after + parsing if applicable)." + (unless postproc (setq postproc #'ignore)) (let ((def-dir default-directory)) ;; Save the relevant buffers (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir)))) @@ -1877,14 +1880,17 @@ POSTPROC is a list of expressions to be evaluated at the very end (after (cvs-cleanup-collection cvs-cookies ;cleanup remaining messages (eq cvs-auto-remove-handled 'delayed) nil t) (when (fboundp after-mode) - (setq postproc (append postproc `((,after-mode))))) + (setq postproc (let ((pp postproc)) + (lambda () (funcall pp) (funcall after-mode))))) (when parse (let ((old-fis (when (member cmd '("status" "update")) ;FIXME: Yuck!! ;; absence of `cvs update' output has a specific meaning. - (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))) - (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc))) - (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc))) + (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))) + (pp postproc)) + (setq postproc (lambda () + (cvs-parse-process dont-change-disc nil old-fis) + (funcall pp))))) (with-current-buffer buf (let ((inhibit-read-only t)) (erase-buffer)) (message "Running cvs %s ..." cmd) @@ -1892,7 +1898,7 @@ POSTPROC is a list of expressions to be evaluated at the very end (after (cl-defun cvs-mode-do (cmd flags filter - &key show dont-change-disc cvsargs postproc) + &key show dont-change-disc cvsargs postproc) "Generic cvs-mode- function. Executes `cvs CVSARGS CMD FLAGS' on the selected files. FILTER is passed to `cvs-applicable-p' to only apply the command to @@ -1914,8 +1920,11 @@ With prefix argument, prompt for cvs flags." (interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags"))) (cvs-mode-do "status" flags nil :dont-change-disc t :show t :postproc (when (eq cvs-auto-remove-handled 'status) - `((with-current-buffer ,(current-buffer) - (cvs-mode-remove-handled)))))) + (let ((buf (current-buffer))) + (lambda () (with-current-buffer buf + (cvs-mode-remove-handled))))))) + +(autoload 'cvs-status-cvstrees "cvs-status") (defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags) "Call cvstree using the file under the point as a keyfile." @@ -1923,7 +1932,7 @@ With prefix argument, prompt for cvs flags." (cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status") :buf (cvs-temp-buffer "tree") :dont-change-disc t - :postproc '((cvs-status-cvstrees)))) + :postproc #'cvs-status-cvstrees)) ;; cvs log @@ -1957,36 +1966,18 @@ With a prefix argument, prompt for cvs flags." (cvs-mode-do "update" flags nil :cvsargs '("-n") :dont-change-disc t)) -(defun-cvs-mode cvs-mode-ignore (&optional pattern) +(defun-cvs-mode cvs-mode-ignore () "Arrange so that CVS ignores the selected files. This command ignores files that are not flagged as `Unknown'." (interactive) (dolist (fi (cvs-mode-marked 'ignore)) - (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi) + (vc-cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi) (eq (cvs-fileinfo->subtype fi) 'NEW-DIR)) (setf (cvs-fileinfo->type fi) 'DEAD)) (cvs-cleanup-collection cvs-cookies nil nil nil)) -(declare-function vc-editable-p "vc" (file)) -(declare-function vc-checkout "vc" (file &optional writable rev)) - -(defun cvs-append-to-ignore (dir str &optional old-dir) - "Add STR to the .cvsignore file in DIR. -If OLD-DIR is non-nil, then this is a directory that we don't want -to hear about anymore." - (with-current-buffer - (find-file-noselect (expand-file-name ".cvsignore" dir)) - (when (ignore-errors - (and buffer-read-only - (eq 'CVS (vc-backend buffer-file-name)) - (not (vc-editable-p buffer-file-name)))) - ;; CVSREAD=on special case - (vc-checkout buffer-file-name t)) - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (insert str (if old-dir "/\n" "\n")) - (if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max))) - (save-buffer))) +(define-obsolete-function-alias 'cvs-append-to-ignore 'vc-cvs-append-to-ignore + "24.4") (defun cvs-mode-find-file-other-window (e) @@ -2083,8 +2074,10 @@ The file is removed and `cvs update FILE' is run." (cvs-mode-run "update" flags fis-other :postproc (when fis-removed - `((with-current-buffer ,(current-buffer) - (cvs-mode-run "add" nil ',fis-removed))))))))) + (let ((buf (current-buffer))) + (lambda () + (with-current-buffer buf + (cvs-mode-run "add" nil fis-removed)))))))))) (defun-cvs-mode (cvs-mode-revert-to-rev . NOARGS) (rev) @@ -2095,11 +2088,14 @@ The file is removed and `cvs update FILE' is run." (cvs-flags-query 'cvs-idiff-version))))) (let* ((fis (cvs-mode-marked 'revert "revert" :file t)) (tag (concat "tmp_pcl_tag_" (make-temp-name ""))) - (untag `((with-current-buffer ,(current-buffer) - (cvs-mode-run "tag" (list "-d" ',tag) ',fis)))) - (update `((with-current-buffer ,(current-buffer) - (cvs-mode-run "update" (list "-j" ',tag "-j" ',rev) ',fis - :postproc ',untag))))) + (buf (current-buffer)) + (untag (lambda () + (with-current-buffer buf + (cvs-mode-run "tag" (list "-d" tag) fis)))) + (update (lambda () + (with-current-buffer buf + (cvs-mode-run "update" (list "-j" tag "-j" rev) fis + :postproc untag))))) (cvs-mode-run "tag" (list tag) fis :postproc update))) @@ -2203,7 +2199,8 @@ to use it on individual files." With prefix argument, prompt for cvs flags." (interactive (list (setq cvs-tag-name - (cvs-query-read cvs-tag-name "Tag to delete: " cvs-qtypedesc-tag)) + (cvs-query-read cvs-tag-name "Tag to delete: " + cvs-qtypedesc-tag)) (cvs-flags-query 'cvs-tag-flags "tag flags"))) (cvs-mode-do "tag" (append '("-d") flags (list tag)) (when cvs-force-dir-tag 'tag))) @@ -2221,6 +2218,7 @@ With prefix argument, prompt for cvs flags." (byte-compile-file filename)))))) ;; ChangeLog support. +(defvar add-log-buffer-file-name-function) (defun-cvs-mode cvs-mode-add-change-log-entry-other-window () "Add a ChangeLog entry in the ChangeLog of the current directory." diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index f61e97216a9..cc9c4673345 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1,6 +1,6 @@ ;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*- -;; Copyright (C) 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict @@ -57,7 +57,6 @@ (defcustom smerge-diff-buffer-name "*vc-diff*" "Buffer name to use for displaying diffs." - :group 'smerge :type '(choice (const "*vc-diff*") (const "*cvs-diff*") @@ -69,12 +68,10 @@ (if (listp diff-switches) diff-switches (list diff-switches))) "A list of strings specifying switches to be passed to diff. Used in `smerge-diff-base-mine' and related functions." - :group 'smerge :type '(repeat string)) (defcustom smerge-auto-leave t "Non-nil means to leave `smerge-mode' when the last conflict is resolved." - :group 'smerge :type 'boolean) (defface smerge-mine @@ -84,8 +81,7 @@ Used in `smerge-diff-base-mine' and related functions." :background "#553333") (((class color)) :foreground "red")) - "Face for your code." - :group 'smerge) + "Face for your code.") (define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1") (defvar smerge-mine-face 'smerge-mine) @@ -96,8 +92,7 @@ Used in `smerge-diff-base-mine' and related functions." :background "#335533") (((class color)) :foreground "green")) - "Face for the other code." - :group 'smerge) + "Face for the other code.") (define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1") (defvar smerge-other-face 'smerge-other) @@ -108,8 +103,7 @@ Used in `smerge-diff-base-mine' and related functions." :background "#888833") (((class color)) :foreground "yellow")) - "Face for the base code." - :group 'smerge) + "Face for the base code.") (define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1") (defvar smerge-base-face 'smerge-base) @@ -118,15 +112,13 @@ Used in `smerge-diff-base-mine' and related functions." (:background "grey85")) (((background dark)) (:background "grey30"))) - "Face for the conflict markers." - :group 'smerge) + "Face for the conflict markers.") (define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1") (defvar smerge-markers-face 'smerge-markers) (defface smerge-refined-change '((t nil)) - "Face used for char-based changes shown by `smerge-refine'." - :group 'smerge) + "Face used for char-based changes shown by `smerge-refine'.") (defface smerge-refined-removed '((default @@ -137,7 +129,6 @@ Used in `smerge-diff-base-mine' and related functions." :background "#aa2222") (t :inverse-video t)) "Face used for removed characters shown by `smerge-refine'." - :group 'smerge :version "24.3") (defface smerge-refined-added @@ -149,7 +140,6 @@ Used in `smerge-diff-base-mine' and related functions." :background "#22aa22") (t :inverse-video t)) "Face used for added characters shown by `smerge-refine'." - :group 'smerge :version "24.3") (easy-mmode-defmap smerge-basic-map @@ -172,7 +162,6 @@ Used in `smerge-diff-base-mine' and related functions." (defcustom smerge-command-prefix "\C-c^" "Prefix for `smerge-mode' commands." - :group 'smerge :type '(choice (const :tag "ESC" "\e") (const :tag "C-c ^" "\C-c^" ) (const :tag "none" "") @@ -254,8 +243,8 @@ Used in `smerge-diff-base-mine' and related functions." "Font lock patterns for `smerge-mode'.") (defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n") -(defconst smerge-end-re "^>>>>>>> .*\n") -(defconst smerge-base-re "^||||||| .*\n") +(defconst smerge-end-re "^>>>>>>> \\(.*\\)\n") +(defconst smerge-base-re "^||||||| \\(.*\\)\n") (defconst smerge-other-re "^=======\n") (defvar smerge-conflict-style nil @@ -1193,6 +1182,14 @@ repeating the command will highlight other two parts." (defvar ediff-quit-hook) (declare-function ediff-cleanup-mess "ediff-util" nil) +(defun smerge--get-marker (regexp default) + (save-excursion + (goto-char (point-min)) + (if (and (search-forward-regexp regexp nil t) + (> (match-end 1) (match-beginning 1))) + (concat default "=" (match-string-no-properties 1)) + default))) + ;;;###autoload (defun smerge-ediff (&optional name-mine name-other name-base) "Invoke ediff to resolve the conflicts. @@ -1203,11 +1200,17 @@ buffer names." (mode major-mode) ;;(ediff-default-variant 'default-B) (config (current-window-configuration)) - (filename (file-name-nondirectory buffer-file-name)) + (filename (file-name-nondirectory (or buffer-file-name "-"))) (mine (generate-new-buffer - (or name-mine (concat "*" filename " MINE*")))) + (or name-mine + (concat "*" filename " " + (smerge--get-marker smerge-begin-re "MINE") + "*")))) (other (generate-new-buffer - (or name-other (concat "*" filename " OTHER*")))) + (or name-other + (concat "*" filename " " + (smerge--get-marker smerge-end-re "OTHER") + "*")))) base) (with-current-buffer mine (buffer-disable-undo) @@ -1232,7 +1235,10 @@ buffer names." (when base (setq base (generate-new-buffer - (or name-base (concat "*" filename " BASE*")))) + (or name-base + (concat "*" filename " " + (smerge--get-marker smerge-base-re "BASE") + "*")))) (with-current-buffer base (buffer-disable-undo) (insert-buffer-substring buf) diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 8af488789de..424b48a4ffa 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -1,9 +1,9 @@ -;;; vc-annotate.el --- VC Annotate Support +;;; vc-annotate.el --- VC Annotate Support -*- lexical-binding: t -*- -;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2000-2014 Free Software Foundation, Inc. ;; Author: Martin Lorentzson -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: vc tools ;; Package: vc @@ -306,9 +306,9 @@ use; you may override this using the second optional arg MODE." (vc-annotate-display-default (or vc-annotate-ratio 1.0))) ;; One of the auto-scaling modes ((eq vc-annotate-display-mode 'scale) - (vc-exec-after `(vc-annotate-display-autoscale))) + (vc-run-delayed (vc-annotate-display-autoscale))) ((eq vc-annotate-display-mode 'fullscale) - (vc-exec-after `(vc-annotate-display-autoscale t))) + (vc-run-delayed (vc-annotate-display-autoscale t))) ((numberp vc-annotate-display-mode) ; A fixed number of days lookback (vc-annotate-display-default (/ vc-annotate-display-mode @@ -316,6 +316,8 @@ use; you may override this using the second optional arg MODE." (t (error "No such display mode: %s" vc-annotate-display-mode)))) +(defvar vc-sentinel-movepoint) + ;;;###autoload (defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk) "Display the edit history of the current FILE using colors. @@ -397,16 +399,16 @@ mode-specific menu. `vc-annotate-color-map' and display-mode)))) (with-current-buffer temp-buffer-name - (vc-exec-after - `(progn - ;; Ideally, we'd rather not move point if the user has already - ;; moved it elsewhere, but really point here is not the position - ;; of the user's cursor :-( - (when ,current-line ;(and (bobp)) - (goto-line ,current-line) - (setq vc-sentinel-movepoint (point))) - (unless (active-minibuffer-window) - (message "Annotating... done"))))))) + (vc-run-delayed + ;; Ideally, we'd rather not move point if the user has already + ;; moved it elsewhere, but really point here is not the position + ;; of the user's cursor :-( + (when current-line ;(and (bobp)) + (goto-char (point-min)) + (forward-line (1- current-line)) + (setq vc-sentinel-movepoint (point))) + (unless (active-minibuffer-window) + (message "Annotating... done")))))) (defun vc-annotate-prev-revision (prefix) "Visit the annotation of the revision previous to this one. @@ -630,7 +632,7 @@ or OFFSET if present." (vc-call-backend vc-annotate-backend 'annotate-current-time)) next-time)))) -(defun vc-default-annotate-current-time (backend) +(defun vc-default-annotate-current-time (_backend) "Return the current time, encoded as fractional days." (vc-annotate-convert-time (current-time))) diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index 52609457ebc..2bc8b7b4339 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -1,6 +1,6 @@ ;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*- -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -227,6 +227,10 @@ Only the value `maybe' can be trusted :-(." (vc-file-setprop file 'arch-root root))))) +(defun vc-arch-find-admin-dir (file) + "Return the administrative directory of FILE." + (expand-file-name "{arch}" (vc-arch-root file))) + (defun vc-arch-register (files &optional rev _comment) (if rev (error "Explicit initial revision not supported for Arch")) (dolist (file files) @@ -311,6 +315,9 @@ Only the value `maybe' can be trusted :-(." 'up-to-date 'edited))))))))) +;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-arch-dir-status (dir callback) "Run 'tla inventory' for DIR and pass results to CALLBACK. CALLBACK expects (ENTRIES &optional MORE-TO-COME); see @@ -318,8 +325,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (let ((default-directory dir)) (vc-arch-command t 'async nil "changes")) ;; The updating could be done asynchronously. - (vc-exec-after - `(vc-arch-after-dir-status ',callback))) + (vc-run-delayed + (vc-arch-after-dir-status callback))) (defun vc-arch-after-dir-status (callback) (let* ((state-map '(("M " . edited) @@ -432,6 +439,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) +(autoload 'vc-switches "vc") + (defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index d0912cb719c..0730a9c72ce 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1,10 +1,10 @@ ;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*- -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Dave Love ;; Riccardo Murri -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: vc tools ;; Created: Sept 2006 ;; Package: vc @@ -47,8 +47,8 @@ (eval-when-compile (require 'cl-lib) - (require 'vc) ;; for vc-exec-after - (require 'vc-dir)) + (require 'vc-dispatcher) + (require 'vc-dir)) ; vc-dir-at-event ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -320,6 +320,11 @@ in the repository root directory of FILE." ("^Using saved parent location: \\(.+\\)" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") +;; To be called via vc-pull from vc.el, which requires vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) +(declare-function vc-compilation-mode "vc-dispatcher" (backend)) + (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. Normally, this runs \"bzr pull\". However, if the branch is a @@ -348,8 +353,9 @@ prompt for the Bzr command to run." (setq vc-bzr-program (car args) command (cadr args) args (cddr args))) + (require 'vc-dispatcher) (let ((buf (apply 'vc-bzr-async-command command args))) - (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr))) + (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) (defun vc-bzr-merge-branch () @@ -380,7 +386,7 @@ default if it is available." (command (cadr cmd)) (args (cddr cmd))) (let ((buf (apply 'vc-bzr-async-command command args))) - (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr))) + (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) (defun vc-bzr-status (file) @@ -646,6 +652,11 @@ REV non-nil gets an error." (vc-bzr-command "cat" t 0 file "-r" rev) (vc-bzr-command "cat" t 0 file)))) +(defun vc-bzr-find-ignore-file (file) + "Return the root directory of the repository of FILE." + (expand-file-name ".bzrignore" + (vc-bzr-root file))) + (defun vc-bzr-checkout (_file &optional _editable rev) (if rev (error "Operation not supported") ;; Else, there's nothing to do. @@ -653,7 +664,7 @@ REV non-nil gets an error." (defun vc-bzr-revert (file &optional contents-done) (unless contents-done - (with-temp-buffer (vc-bzr-command "revert" t 0 file)))) + (with-temp-buffer (vc-bzr-command "revert" t 0 file "--no-backup")))) (defvar log-view-message-re) (defvar log-view-file-re) @@ -693,8 +704,13 @@ REV non-nil gets an error." (2 'change-log-email)) ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))) +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-bzr-print-log (files buffer &optional shortlog start-revision limit) - "Get bzr change log for FILES into specified BUFFER." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use --line format. +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -707,8 +723,33 @@ REV non-nil gets an error." (apply 'vc-bzr-command "log" buffer 'async files (append (when shortlog '("--line")) - (when start-revision (list (format "-r..%s" start-revision))) + ;; The extra complications here when start-revision and limit + ;; are set are due to bzr log's --forward argument, which + ;; could be enabled via an alias in bazaar.conf. + ;; Svn, for example, does not have this problem, because + ;; it doesn't have --forward. Instead, you can use + ;; svn --log -r HEAD:0 or -r 0:HEAD as you prefer. + ;; Bzr, however, insists in -r X..Y that X come before Y. + (if start-revision + (list (format + (if (and limit (= limit 1)) + ;; This means we don't have to use --no-aliases. + ;; Is -c any different to -r in this case? + "-r%s" + "-r..%s") start-revision))) (when limit (list "-l" (format "%s" limit))) + ;; There is no sensible way to combine --limit and --forward, + ;; and it breaks the meaning of START-REVISION as the + ;; _newest_ revision. See bug#14168. + ;; Eg bzr log --forward -r ..100 --limit 50 prints + ;; revisions 1-50 rather than 50-100. There + ;; seems no way in general to get bzr to print revisions + ;; 50-100 in --forward order in that case. + ;; FIXME There may be other alias stuff we want to keep. + ;; Is there a way to just suppress --forward? + ;; As of 2013/4 the only caller uses limit = 1, so it does + ;; not matter much. + (and start-revision limit (> limit 1) '("--no-aliases")) (if (stringp vc-bzr-log-switches) (list vc-bzr-log-switches) vc-bzr-log-switches))))) @@ -750,6 +791,8 @@ REV non-nil gets an error." (goto-char (point-min))) found))) +(autoload 'vc-switches "vc") + (defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." (let* ((switches (vc-switches 'bzr 'diff)) @@ -870,6 +913,8 @@ stream. Standard error output is discarded." (:conc-name vc-bzr-extra-fileinfo->)) extra-name) ;; original name for rename targets, new name for +(declare-function vc-default-dir-printer "vc-dir" (backend fileentry)) + (defun vc-bzr-dir-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." (let ((extra (vc-dir-fileinfo->extra info))) @@ -951,23 +996,23 @@ stream. Standard error output is discarded." (defun vc-bzr-dir-status (dir update-function) "Return a list of conses (file . state) for DIR." (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S") - (vc-exec-after - `(vc-bzr-after-dir-status (quote ,update-function) - ;; "bzr status" results are relative to - ;; the bzr root directory, NOT to the - ;; directory "bzr status" was invoked in. - ;; Ugh. - ;; We pass the relative directory here so - ;; that `vc-bzr-after-dir-status' can - ;; frob the results accordingly. - (file-relative-name ,dir (vc-bzr-root ,dir))))) + (vc-run-delayed + (vc-bzr-after-dir-status update-function + ;; "bzr status" results are relative to + ;; the bzr root directory, NOT to the + ;; directory "bzr status" was invoked in. + ;; Ugh. + ;; We pass the relative directory here so + ;; that `vc-bzr-after-dir-status' can + ;; frob the results accordingly. + (file-relative-name dir (vc-bzr-root dir))))) (defun vc-bzr-dir-status-files (dir files _default-state update-function) "Return a list of conses (file . state) for DIR." (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) - (vc-exec-after - `(vc-bzr-after-dir-status (quote ,update-function) - (file-relative-name ,dir (vc-bzr-root ,dir))))) + (vc-run-delayed + (vc-bzr-after-dir-status update-function + (file-relative-name dir (vc-bzr-root dir))))) (defvar vc-bzr-shelve-map (let ((map (make-sparse-keymap))) @@ -1082,6 +1127,10 @@ stream. Standard error output is discarded." 'help-echo shelve-help-echo 'face 'font-lock-variable-name-face)))))) +;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-resynch-buffer "vc-dispatcher" + (file &optional keep noquery reset-vc-info)) + (defun vc-bzr-shelve (name) "Create a shelve." (interactive "sShelf name: ") @@ -1141,6 +1190,9 @@ stream. Standard error output is discarded." (match-string 1) (error "Cannot find shelf at point")))) +;; vc-bzr-shelve-delete-at-point must be called from a vc-dir buffer. +(declare-function vc-dir-refresh "vc-dir" ()) + (defun vc-bzr-shelve-delete-at-point () (interactive) (let ((shelve (vc-bzr-shelve-get-at-point (point)))) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 407e691439b..f7684a3b82c 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1,6 +1,6 @@ ;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*- -;; Copyright (C) 1995, 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1998-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel @@ -115,7 +115,7 @@ This is only meaningful if you don't use the implicit checkout model This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. -If value is the symbol `only-file' `vc-dir' will connect to the +If value is the symbol `only-file', `vc-dir' will connect to the server, but heuristics will be used to determine the status for all other VC operations. @@ -280,6 +280,8 @@ committed and support display of sticky tags." ;;; State-changing functions ;;; +(autoload 'vc-switches "vc") + (defun vc-cvs-register (files &optional _rev comment) "Register FILES into the CVS version-control system. COMMENT can be used to provide an initial description of FILES. @@ -415,6 +417,8 @@ REV is the revision to check out." (defun vc-cvs-delete-file (file) (vc-cvs-command nil 0 file "remove" "-f")) +(autoload 'vc-default-revert "vc") + (defun vc-cvs-revert (file &optional contents-done) "Revert FILE to the working revision on which it was based." (vc-default-revert 'CVS file contents-done) @@ -501,9 +505,12 @@ Will fail unless you have administrative privileges on the repo." ;;; (declare-function vc-rcs-print-log-cleanup "vc-rcs" ()) +;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit) - "Get change logs associated with FILES." + "Print commit log associated with FILES into specified BUFFER. +Remaining arguments are ignored." (require 'vc-rcs) ;; It's just the catenation of the individual logs. (vc-cvs-command @@ -511,13 +518,16 @@ Will fail unless you have administrative privileges on the repo." (if (vc-stay-local-p files 'CVS) 'async 0) files "log") (with-current-buffer buffer - (vc-exec-after (vc-rcs-print-log-cleanup))) + (vc-run-delayed (vc-rcs-print-log-cleanup))) (when limit 'limit-unsupported)) (defun vc-cvs-comment-history (file) "Get comment history of a file." (vc-call-backend 'RCS 'comment-history file)) +(autoload 'vc-version-backup-file "vc") +(declare-function vc-coding-system-for-diff "vc" (file)) + (defun vc-cvs-diff (files &optional oldvers newvers buffer) "Get a difference report using CVS between two revisions of FILE." (let* (process-file-side-effects @@ -562,14 +572,13 @@ Will fail unless you have administrative privileges on the repo." (defconst vc-cvs-annotate-first-line-re "^[0-9]") -(defun vc-cvs-annotate-process-filter (process string) +(defun vc-cvs-annotate-process-filter (filter process string) (setq string (concat (process-get process 'output) string)) (if (not (string-match vc-cvs-annotate-first-line-re string)) ;; Still waiting for the first real line. (process-put process 'output string) - (let ((vc-filter (process-get process 'vc-filter))) - (set-process-filter process vc-filter) - (funcall vc-filter process (substring string (match-beginning 0)))))) + (remove-function (process-filter process) #'vc-cvs-annotate-process-filter) + (funcall filter process (substring string (match-beginning 0))))) (defun vc-cvs-annotate-command (file buffer &optional revision) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. @@ -583,9 +592,8 @@ Optional arg REVISION is a revision to annotate from." (let ((proc (get-buffer-process buffer))) (if proc ;; If running asynchronously, use a process filter. - (progn - (process-put proc 'vc-filter (process-filter proc)) - (set-process-filter proc 'vc-cvs-annotate-process-filter)) + (add-function :around (process-filter proc) + #'vc-cvs-annotate-process-filter) (with-current-buffer buffer (goto-char (point-min)) (re-search-forward vc-cvs-annotate-first-line-re) @@ -666,6 +674,10 @@ workspace is immediately moved to that new branch)." (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) (when branchp (vc-cvs-command nil 0 dir "update" "-r" name))) +;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-resynch-buffer "vc-dispatcher" + (file &optional keep noquery reset-vc-info)) + (defun vc-cvs-retrieve-tag (dir name update) "Retrieve a tag at and below DIR. NAME is the name of the tag; if it is empty, do a `cvs update'. @@ -1003,14 +1015,14 @@ state." ;; (vc-cvs-command (current-buffer) 'async ;; (file-relative-name dir) ;; "-f" "-n" "update" "-d" "-P") - (vc-exec-after - `(vc-cvs-after-dir-status (quote ,update-function)))))) + (vc-run-delayed + (vc-cvs-after-dir-status update-function))))) (defun vc-cvs-dir-status-files (dir files _default-state update-function) "Create a list of conses (file . state) for DIR." (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files) - (vc-exec-after - `(vc-cvs-after-dir-status (quote ,update-function)))) + (vc-run-delayed + (vc-cvs-after-dir-status update-function))) (defun vc-cvs-file-to-string (file) "Read the content of FILE and return it as a string." @@ -1214,6 +1226,33 @@ is non-nil." table (lambda () (vc-cvs-revision-table (car files)))))) table)) +(defun vc-cvs-find-admin-dir (file) + "Return the administrative directory of FILE." + (vc-find-root file "CVS")) + +(defun vc-cvs-ignore (file &optional _directory _remove) + "Ignore FILE under CVS." + (vc-cvs-append-to-ignore (file-name-directory file) file)) + +(defun vc-cvs-append-to-ignore (dir str &optional old-dir) + "In DIR, add STR to the .cvsignore file. +If OLD-DIR is non-nil, then this is a directory that we don't want +to hear about anymore." + (with-current-buffer + (find-file-noselect (expand-file-name ".cvsignore" dir)) + (when (ignore-errors + (and buffer-read-only + (eq 'CVS (vc-backend buffer-file-name)) + (not (vc-editable-p buffer-file-name)))) + ;; CVSREAD=on special case + (vc-checkout buffer-file-name t)) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert str (if old-dir "/\n" "\n")) + ;; FIXME this is a pcvs variable. + (if (bound-and-true-p cvs-sort-ignore-file) + (sort-lines nil (point-min) (point-max))) + (save-buffer))) (provide 'vc-cvs) diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 83fc0bceb66..9b67d74c779 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -1,6 +1,6 @@ ;;; vc-dav.el --- vc.el support for WebDAV -;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry ;; Maintainer: Bill Perry diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d10e3934680..5e074191577 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1,6 +1,6 @@ ;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*- -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Dan Nicolaescu ;; Keywords: vc tools @@ -215,6 +215,9 @@ See `run-hooks'." (define-key map [register] '(menu-item "Register" vc-register :help "Register file set into the version control system")) + (define-key map [ignore] + '(menu-item "Ignore Current File" vc-dir-ignore + :help "Ignore the current file under current version control system")) map) "Menu for VC dir.") @@ -237,9 +240,12 @@ See `run-hooks'." ;; VC commands (define-key map "v" 'vc-next-action) ;; C-x v v (define-key map "=" 'vc-diff) ;; C-x v = + (define-key map "D" 'vc-root-diff) ;; C-x v D (define-key map "i" 'vc-register) ;; C-x v i (define-key map "+" 'vc-update) ;; C-x v + (define-key map "l" 'vc-print-log) ;; C-x v l + (define-key map "L" 'vc-print-root-log) ;; C-x v L + (define-key map "I" 'vc-log-incoming) ;; C-x v I ;; More confusing than helpful, probably ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark. ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer @@ -277,6 +283,7 @@ See `run-hooks'." (define-key map "Q" 'vc-dir-query-replace-regexp) (define-key map (kbd "M-s a C-s") 'vc-dir-isearch) (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp) + (define-key map "G" 'vc-dir-ignore) ;; Hook up the menu. (define-key map [menu-bar vc-dir-mode] @@ -789,6 +796,11 @@ with the command \\[tags-loop-continue]." (tags-query-replace from to delimited '(mapcar 'car (vc-dir-marked-only-files-and-states)))) +(defun vc-dir-ignore () + "Ignore the current file." + (interactive) + (vc-ignore (vc-dir-current-file))) + (defun vc-dir-current-file () (let ((node (ewoc-locate vc-ewoc))) (unless node @@ -930,8 +942,6 @@ If it is a file, return the corresponding cons for the file itself." (defvar use-vc-backend) ;; dynamically bound -;; Autoload cookie needed by desktop.el. -;;;###autoload (define-derived-mode vc-dir-mode special-mode "VC dir" "Major mode for VC directory buffers. Marking/Unmarking key bindings and actions: @@ -1301,6 +1311,8 @@ These are the commands available for use in the file status buffer: "Auxiliary information to be saved in desktop file." (cons (desktop-file-name default-directory dirname) vc-dir-backend)) +(defvar desktop-missing-file-warning) + (defun vc-dir-restore-desktop-buffer (_filename _buffername misc-data) "Restore a `vc-dir' buffer specified in a desktop file." (let ((dir (car misc-data)) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index b03619e03d9..a0efe023a1d 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -1,6 +1,6 @@ -;;; vc-dispatcher.el -- generic command-dispatcher facility. +;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*- -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. ;; Author: FSF (see below for full credits) ;; Maintainer: Eric S. Raymond @@ -182,32 +182,29 @@ Another is that undo information is not kept." (defvar vc-sentinel-movepoint) ;Dynamically scoped. -(defun vc-process-sentinel (p s) - (let ((previous (process-get p 'vc-previous-sentinel)) - (buf (process-buffer p))) +(defun vc--process-sentinel (p code) + (let ((buf (process-buffer p))) ;; Impatient users sometime kill "slow" buffers; check liveness ;; to avoid "error in process sentinel: Selecting deleted buffer". (when (buffer-live-p buf) - (when previous (funcall previous p s)) (with-current-buffer buf (setq mode-line-process (let ((status (process-status p))) ;; Leave mode-line uncluttered, normally. (unless (eq 'exit status) (format " (%s)" status)))) - (let (vc-sentinel-movepoint) + (let (vc-sentinel-movepoint + (m (process-mark p))) ;; Normally, we want async code such as sentinels to not move point. (save-excursion - (goto-char (process-mark p)) - (let ((cmds (process-get p 'vc-sentinel-commands))) - (process-put p 'vc-sentinel-commands nil) - (dolist (cmd cmds) - ;; Each sentinel may move point and the next one should be run - ;; at that new point. We could get the same result by having - ;; each sentinel read&set process-mark, but since `cmd' needs - ;; to work both for async and sync processes, this would be - ;; difficult to achieve. - (vc-exec-after cmd)))) + (goto-char m) + ;; Each sentinel may move point and the next one should be run + ;; at that new point. We could get the same result by having + ;; each sentinel read&set process-mark, but since `cmd' needs + ;; to work both for async and sync processes, this would be + ;; difficult to achieve. + (vc-exec-after code) + (move-marker m (point))) ;; But sometimes the sentinels really want to move point. (when vc-sentinel-movepoint (let ((win (get-buffer-window (current-buffer) 0))) @@ -226,7 +223,8 @@ Another is that undo information is not kept." (defun vc-exec-after (code) "Eval CODE when the current buffer's process is done. If the current buffer has no process, just evaluate CODE. -Else, add CODE to the process' sentinel." +Else, add CODE to the process' sentinel. +CODE should be a function of no arguments." (let ((proc (get-buffer-process (current-buffer)))) (cond ;; If there's no background process, just execute the code. @@ -237,23 +235,21 @@ Else, add CODE to the process' sentinel." ((or (null proc) (eq (process-status proc) 'exit)) ;; Make sure we've read the process's output before going further. (when proc (accept-process-output proc)) - (eval code)) + (if (functionp code) (funcall code) (eval code))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) (vc-set-mode-line-busy-indicator) - (let ((previous (process-sentinel proc))) - (unless (eq previous 'vc-process-sentinel) - (process-put proc 'vc-previous-sentinel previous)) - (set-process-sentinel proc 'vc-process-sentinel)) - (process-put proc 'vc-sentinel-commands - ;; We keep the code fragments in the order given - ;; so that vc-diff-finish's message shows up in - ;; the presence of non-nil vc-command-messages. - (append (process-get proc 'vc-sentinel-commands) - (list code)))) + (letrec ((fun (lambda (p _msg) + (remove-function (process-sentinel p) fun) + (vc--process-sentinel p code)))) + (add-function :after (process-sentinel proc) fun))) (t (error "Unexpected process state")))) nil) +(defmacro vc-run-delayed (&rest body) + (declare (indent 0) (debug t)) + `(vc-exec-after (lambda () ,@body))) + (defvar vc-post-command-functions nil "Hook run at the end of `vc-do-command'. Each function is called inside the buffer in which the command was run @@ -329,12 +325,14 @@ case, and the process object in the asynchronous case." command squeezed)))) (when vc-command-messages (message "Running %s in background..." full-command)) - ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) + ;; Get rid of the default message insertion, in case we don't + ;; set a sentinel explicitly. + (set-process-sentinel proc #'ignore) (set-process-filter proc 'vc-process-filter) (setq status proc) (when vc-command-messages - (vc-exec-after - `(message "Running %s in background... done" ',full-command)))) + (vc-run-delayed + (message "Running %s in background... done" full-command)))) ;; Run synchronously (when vc-command-messages (message "Running %s in foreground..." full-command)) @@ -351,9 +349,9 @@ case, and the process object in the asynchronous case." (if (integerp status) (format "status %d" status) status))) (when vc-command-messages (message "Running %s...OK = %d" full-command status)))) - (vc-exec-after - `(run-hook-with-args 'vc-post-command-functions - ',command ',file-or-list ',flags)) + (vc-run-delayed + (run-hook-with-args 'vc-post-command-functions + command file-or-list flags)) status)))) (defun vc-do-async-command (buffer root command &rest args) @@ -386,16 +384,21 @@ Display the buffer in some window, but don't select it." (set-window-start window new-window-start)) buffer)) +(defvar compilation-error-regexp-alist) + (defun vc-compilation-mode (backend) "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." + (require 'compile) (let* ((error-regexp-alist (vc-make-backend-sym backend 'error-regexp-alist)) - (compilation-error-regexp-alist - (and (boundp error-regexp-alist) - (symbol-value error-regexp-alist)))) - (compilation-mode) + (error-regexp-alist (and (boundp error-regexp-alist) + (symbol-value error-regexp-alist)))) + (let ((compilation-error-regexp-alist error-regexp-alist)) + (compilation-mode)) (set (make-local-variable 'compilation-error-regexp-alist) - compilation-error-regexp-alist))) + error-regexp-alist))) + +(declare-function vc-dir-refresh "vc-dir" ()) (defun vc-set-async-update (process-buffer) "Set a `vc-exec-after' action appropriate to the current buffer. @@ -410,17 +413,17 @@ If the current buffer is a Dired buffer, revert it." (cond ((derived-mode-p 'vc-dir-mode) (with-current-buffer process-buffer - (vc-exec-after - `(if (buffer-live-p ,buf) - (with-current-buffer ,buf - (vc-dir-refresh)))))) + (vc-run-delayed + (if (buffer-live-p buf) + (with-current-buffer buf + (vc-dir-refresh)))))) ((derived-mode-p 'dired-mode) (with-current-buffer process-buffer - (vc-exec-after - `(and (buffer-live-p ,buf) - (= (buffer-modified-tick ,buf) ,tick) - (with-current-buffer ,buf - (revert-buffer))))))))) + (vc-run-delayed + (and (buffer-live-p buf) + (= (buffer-modified-tick buf) tick) + (with-current-buffer buf + (revert-buffer))))))))) ;; These functions are used to ensure that the view the user sees is up to date ;; even if the dispatcher client mode has messed with file contents (as in, @@ -477,7 +480,7 @@ Used by `vc-restore-buffer-context' to later restore the context." (vc-position-context (mark-marker)))) ;; Make the right thing happen in transient-mark-mode. (mark-active nil)) - (list point-context mark-context nil))) + (list point-context mark-context))) (defun vc-restore-buffer-context (context) "Restore point/mark, and reparse any affected compilation buffers. @@ -516,6 +519,8 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'." (make-variable-buffer-local 'vc-mode-line-hook) (put 'vc-mode-line-hook 'permanent-local t) +(defvar view-old-buffer-read-only) + (defun vc-resynch-window (file &optional keep noquery reset-vc-info) "If FILE is in the current buffer, either revert or unvisit it. The choice between revert (to see expanded keywords) and unvisit @@ -591,7 +596,7 @@ NOT-URGENT means it is ok to continue if the user says not to save." (setq default-directory (buffer-local-value 'default-directory vc-parent-buffer)) (log-edit 'vc-finish-logentry - nil + t `((log-edit-listfun . (lambda () ;; FIXME: Should expand the list ;; for directories. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 17de931628b..06e46eeb663 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1,6 +1,6 @@ ;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*- -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Alexandre Julliard ;; Keywords: vc tools @@ -103,6 +103,8 @@ ;; - rename-file (old new) OK ;; - find-file-hook () NOT NEEDED +;;; Code: + (eval-when-compile (require 'cl-lib) (require 'vc) @@ -234,30 +236,30 @@ matching the resulting Git log output, and KEYWORDS is a list of (vc-git--state-code diff-letter))) (if (vc-git--empty-db-p) 'added 'up-to-date)))) -(defun vc-git-working-revision (_file) +(defun vc-git-working-revision (file) "Git-specific version of `vc-working-revision'." (let* (process-file-side-effects - (str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD"))))) - (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) - (match-string 2 str) - str))) + (str (vc-git--run-command-string nil "symbolic-ref" "HEAD"))) + (vc-file-setprop file 'vc-git-detached (null str)) + (if str + (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) + (match-string 2 str) + str) + (vc-git--rev-parse "HEAD")))) (defun vc-git-workfile-unchanged-p (file) (eq 'up-to-date (vc-git-state file))) (defun vc-git-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." - (let* ((branch (vc-working-revision file)) + (let* ((rev (vc-working-revision file)) + (detached (vc-file-getprop file 'vc-git-detached)) (def-ml (vc-default-mode-line-string 'Git file)) (help-echo (get-text-property 0 'help-echo def-ml))) - (if (zerop (length branch)) - (propertize - (concat def-ml "!") - 'help-echo (concat help-echo "\nNo current branch (detached HEAD)")) - (propertize def-ml - 'help-echo (concat help-echo "\nCurrent branch: " branch))))) + (propertize (if detached + (substring def-ml 0 (- 7 (length rev))) + def-ml) + 'help-echo (concat help-echo "\nCurrent revision: " rev)))) (cl-defstruct (vc-git-extra-fileinfo (:copier nil) @@ -443,6 +445,12 @@ or an empty string if none." (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function)))) +;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command +;; from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +;; Follows vc-exec-after. +(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) + (defun vc-git-dir-status-goto-stage (stage files update-function) (erase-buffer) (pcase stage @@ -469,8 +477,8 @@ or an empty string if none." (`diff-index (vc-git-command (current-buffer) 'async files "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) - (vc-exec-after - `(vc-git-after-dir-status-stage ',stage ',files ',update-function))) + (vc-run-delayed + (vc-git-after-dir-status-stage stage files update-function))) (defun vc-git-dir-status (_dir update-function) "Return a list of (FILE STATE EXTRA) entries for DIR." @@ -513,7 +521,7 @@ or an empty string if none." :help "Show the contents of the current stash")) map)) -(defun vc-git-dir-extra-headers (_dir) +(defun vc-git-dir-extra-headers (dir) (let ((str (with-output-to-string (with-current-buffer standard-output (vc-git--out-ok "symbolic-ref" "HEAD")))) @@ -551,6 +559,11 @@ or an empty string if none." (propertize remote-url 'face 'font-lock-variable-name-face))) "\n" + ;; For now just a heading, key bindings can be added later for various bisect actions + (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir))) + (propertize "Bisect : in progress\n" 'face 'font-lock-warning-face)) + (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir))) + (propertize "Rebase : in progress\n" 'face 'font-lock-warning-face)) (if stash (concat (propertize "Stash :\n" 'face 'font-lock-type-face @@ -611,6 +624,7 @@ The car of the list is the current branch." (declare-function log-edit-mode "log-edit" ()) (declare-function log-edit-toggle-header "log-edit" (header value)) (declare-function log-edit-extract-headers "log-edit" (headers string)) +(declare-function log-edit-set-header "log-edit" (header value &optional toggle)) (defun vc-git-log-edit-toggle-signoff () "Toggle whether to add the \"Signed-off-by\" line at the end of @@ -628,7 +642,17 @@ If toggling on, also insert its message into the buffer." (insert (with-output-to-string (vc-git-command standard-output 1 nil - "log" "--max-count=1" "--pretty=format:%B" "HEAD"))))) + "log" "--max-count=1" "--pretty=format:%B" "HEAD"))) + (save-excursion + (rfc822-goto-eoh) + (forward-line 1) + (let ((pt (point))) + (and (zerop (forward-line 1)) + (looking-at "\n\\|\\'") + (let ((summary (buffer-substring-no-properties pt (1- (point))))) + (skip-chars-forward " \n") + (delete-region pt (point)) + (log-edit-set-header "Summary" summary))))))) (defvar vc-git-log-edit-mode-map (let ((map (make-sparse-keymap "Git-Log-Edit"))) @@ -641,11 +665,18 @@ If toggling on, also insert its message into the buffer." It is based on `log-edit-mode', and has Git-specific extensions.") (defun vc-git-checkin (files _rev comment) - (let ((coding-system-for-write vc-git-commits-coding-system)) + (let* ((file1 (or (car files) default-directory)) + (root (vc-git-root file1)) + (default-directory (expand-file-name root)) + (only (or (cdr files) + (not (equal root (abbreviate-file-name file1))))) + (coding-system-for-write vc-git-commits-coding-system)) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) - (apply 'vc-git-command nil 0 files + ;; When operating on the whole tree, better pass nil than ".", since "." + ;; fails when we're committing a merge. + (apply 'vc-git-command nil 0 (if only files) (nconc (list "commit" "-m") (log-edit-extract-headers `(("Author" . "--author") @@ -653,7 +684,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") ("Amend" . ,(boolean-arg-fn "--amend")) ("Sign-Off" . ,(boolean-arg-fn "--signoff"))) comment) - (list "--only" "--")))))) + (if only (list "--only" "--"))))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -672,6 +703,11 @@ It is based on `log-edit-mode', and has Git-specific extensions.") nil "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname)))) +(defun vc-git-find-ignore-file (file) + "Return the root directory of the repository of FILE." + (expand-file-name ".gitignore" + (vc-git-root file))) + (defun vc-git-checkout (file &optional _editable rev) (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) @@ -686,6 +722,9 @@ It is based on `log-edit-mode', and has Git-specific extensions.") '(("^ \\(.+\\) |" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") +;; To be called via vc-pull from vc.el, which requires vc-dispatcher. +(declare-function vc-compilation-mode "vc-dispatcher" (backend)) + (defun vc-git-pull (prompt) "Pull changes into the current Git branch. Normally, this runs \"git pull\". If PROMPT is non-nil, prompt @@ -705,8 +744,9 @@ for the Git command to run." (setq git-program (car args) command (cadr args) args (cddr args))) + (require 'vc-dispatcher) (apply 'vc-do-async-command buffer root git-program command args) - (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git))) + (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) (vc-set-async-update buffer))) (defun vc-git-merge-branch () @@ -726,15 +766,19 @@ This prompts for a branch to merge from." nil t))) (apply 'vc-do-async-command buffer root vc-git-program "merge" (list merge-source)) - (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git))) + (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) (vc-set-async-update buffer))) ;;; HISTORY FUNCTIONS +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) - "Get change log associated with FILES. -Note that using SHORTLOG requires at least Git version 1.5.6, -for the --graph option." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. +\(This requires at least Git version 1.5.6, for the --graph option.) +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." (let ((coding-system-for-read vc-git-commits-coding-system)) ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. @@ -855,6 +899,8 @@ or BRANCH^ (where \"^\" can be repeated)." (indent-region (point-min) (point-max) 2) (buffer-string)))) +(autoload 'vc-switches "vc") + (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) @@ -896,7 +942,7 @@ or BRANCH^ (where \"^\" can be repeated)." (defun vc-git-annotate-extract-revision-at-line () (save-excursion - (move-beginning-of-line 1) + (beginning-of-line) (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?") (let ((revision (match-string-no-properties 1))) (if (match-beginning 2) @@ -941,10 +987,13 @@ or BRANCH^ (where \"^\" can be repeated)." (point) (1- (point-max))))))) (or (vc-git-symbolic-commit prev-rev) prev-rev)) - (with-temp-buffer - (and - (vc-git--out-ok "rev-parse" (concat rev "^")) - (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))) + (vc-git--rev-parse (concat rev "^")))) + +(defun vc-git--rev-parse (rev) + (with-temp-buffer + (and + (vc-git--out-ok "rev-parse" rev) + (buffer-substring-no-properties (point-min) (+ (point-min) 40))))) (defun vc-git-next-revision (file rev) "Git-specific version of `vc-next-revision'." @@ -1005,6 +1054,12 @@ or BRANCH^ (where \"^\" can be repeated)." (or (vc-file-getprop file 'git-root) (vc-file-setprop file 'git-root (vc-find-root file ".git")))) +;; grep-compute-defaults autoloads grep. +(declare-function grep-read-regexp "grep" ()) +(declare-function grep-read-files "grep" (regexp)) +(declare-function grep-expand-template "grep" + (template &optional regexp files dir excl)) + ;; Derived from `lgrep'. (defun vc-git-grep (regexp &optional files dir) "Run git grep, searching for REGEXP in FILES in directory DIR. @@ -1043,7 +1098,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (setq command nil)) (setq dir (file-name-as-directory (expand-file-name dir))) (setq command - (grep-expand-template "git grep -n -e -- " + (grep-expand-template "git --no-pager grep -n -e -- " regexp files)) (when command (if (equal current-prefix-arg '(4)) @@ -1060,6 +1115,10 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) +;; Everywhere but here, follows vc-git-command, which uses vc-do-command +;; from vc-dispatcher. +(autoload 'vc-resynch-buffer "vc-dispatcher") + (defun vc-git-stash (name) "Create a stash." (interactive "sStash name: ") @@ -1117,6 +1176,9 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (match-string 1) (error "Cannot find stash at point")))) +;; vc-git-stash-delete-at-point must be called from a vc-dir buffer. +(declare-function vc-dir-refresh "vc-dir" ()) + (defun vc-git-stash-delete-at-point () (interactive) (let ((stash (vc-git-stash-get-at-point (point)))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index f39ef568e8b..a53ed8758c4 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1,9 +1,9 @@ ;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*- -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Ivan Kanis -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: vc tools ;; Package: vc @@ -152,7 +152,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (2 'change-log-list) (3 'change-log-name) (4 'change-log-date))) - "Mercurial log template for `vc-print-root-log'. + "Mercurial log template for `vc-hg-print-log' short format. 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 @@ -245,8 +245,13 @@ highlighting the Log View buffer." (repeat :tag "Argument List" :value ("") string)) :group 'vc-hg) +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit) - "Get change log associated with FILES." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -257,7 +262,7 @@ highlighting the Log View buffer." buffer (apply 'vc-hg-command buffer 0 files "log" (nconc - (when start-revision (list (format "-r%s:" start-revision))) + (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) (when shortlog (list "--template" (car vc-hg-root-log-format))) vc-hg-log-switches))))) @@ -303,6 +308,8 @@ highlighting the Log View buffer." ("^tag: +\\([^ ]+\\)$" (1 'highlight)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) +(autoload 'vc-switches "vc") + (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) @@ -357,7 +364,7 @@ Optional arg REVISION is a revision to annotate from." ;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS ;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS (defconst vc-hg-annotate-re - "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\(.+\\): \\)\\)") + "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\([^:\n]+\\(?::\\(?:[^: \n][^:\n]*\\)?\\)*\\): \\)\\)") (defun vc-hg-annotate-time () (when (looking-at vc-hg-annotate-re) @@ -452,6 +459,11 @@ REV is ignored." (vc-hg-command buffer 0 file "cat" "-r" rev) (vc-hg-command buffer 0 file "cat")))) +(defun vc-hg-find-ignore-file (file) + "Return the root directory of the repository of FILE." + (expand-file-name ".hgignore" + (vc-hg-root file))) + ;; Modeled after the similar function in vc-bzr.el (defun vc-hg-checkout (file &optional _editable rev) "Retrieve a revision of FILE. @@ -588,15 +600,21 @@ REV is the revision to check out into WORKFILE." (forward-line)) (funcall update-function result))) +;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command +;; from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +;; Follows vc-exec-after. +(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) + (defun vc-hg-dir-status (dir update-function) (vc-hg-command (current-buffer) 'async dir "status" "-C") - (vc-exec-after - `(vc-hg-after-dir-status (quote ,update-function)))) + (vc-run-delayed + (vc-hg-after-dir-status update-function))) (defun vc-hg-dir-status-files (dir files _default-state update-function) (apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files) - (vc-exec-after - `(vc-hg-after-dir-status (quote ,update-function)))) + (vc-run-delayed + (vc-hg-after-dir-status update-function))) (defun vc-hg-dir-extra-header (name &rest commands) (concat (propertize name 'face 'font-lock-type-face) @@ -648,6 +666,8 @@ REV is the revision to check out into WORKFILE." ;; modified files "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") +(autoload 'vc-do-async-command "vc-dispatcher") + (defun vc-hg-pull (prompt) "Issue a Mercurial pull command. If called interactively with a set of marked Log View buffers, @@ -688,7 +708,8 @@ then attempts to update the working directory." args (cddr args))) (apply 'vc-do-async-command buffer root hg-program command args) - (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg))) + (with-current-buffer buffer + (vc-run-delayed (vc-compilation-mode 'hg))) (vc-set-async-update buffer))))) (defun vc-hg-merge-branch () @@ -697,7 +718,7 @@ This runs the command \"hg merge\"." (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root)))) (apply 'vc-do-async-command buffer root vc-hg-program '("merge")) - (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg))) + (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg))) (vc-set-async-update buffer))) ;;; Internal functions diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 5c8a4515b7e..1cd297ae43a 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1,6 +1,6 @@ ;;; vc-hooks.el --- resident support for version-control -;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-1996, 1998-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel @@ -128,7 +128,7 @@ See also variable `vc-consult-headers'." This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. -If value is the symbol `only-file' `vc-dir' will connect to the +If value is the symbol `only-file', `vc-dir' will connect to the server, but heuristics will be used to determine the status for all other VC operations. @@ -190,7 +190,7 @@ individually should stay local." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) -(defun vc-mode (&optional arg) +(defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. This minor mode is automatically activated whenever you visit a file under @@ -631,7 +631,7 @@ this function." (define-obsolete-function-alias 'vc-toggle-read-only 'toggle-read-only "24.1") -(defun vc-default-make-version-backups-p (backend file) +(defun vc-default-make-version-backups-p (_backend _file) "Return non-nil if unmodified versions should be backed up locally. The default is to switch off this feature." nil) @@ -834,7 +834,7 @@ current, and kill the buffer that visits the link." (set-buffer true-buffer) (kill-buffer this-buffer)))) -(defun vc-default-find-file-hook (backend) +(defun vc-default-find-file-hook (_backend) nil) (defun vc-find-file-hook () @@ -918,6 +918,7 @@ current, and kill the buffer that visits the link." (define-key map "c" 'vc-rollback) (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) + (define-key map "G" 'vc-ignore) (define-key map "h" 'vc-insert-headers) (define-key map "i" 'vc-register) (define-key map "l" 'vc-print-log) @@ -1002,6 +1003,9 @@ current, and kill the buffer that visits the link." (bindings--define-key map [vc-register] '(menu-item "Register" vc-register :help "Register file set into a version control system")) + (bindings--define-key map [vc-ignore] + '(menu-item "Ignore File..." vc-ignore + :help "Ignore a file under current version control system")) (bindings--define-key map [vc-dir] '(menu-item "VC Dir" vc-dir :help "Show the VC status of files in a directory")) @@ -1029,7 +1033,7 @@ current, and kill the buffer that visits the link." '((ext-menu-separator "--")) ext-binding)))) -(defun vc-default-extra-menu (backend) +(defun vc-default-extra-menu (_backend) nil) (provide 'vc-hooks) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 06827a5e027..ea071c8586a 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -1,6 +1,6 @@ ;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*- -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: vc @@ -86,6 +86,9 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (vc-file-setprop file 'vc-mtn-root (vc-find-root file vc-mtn-admin-format)))) +(defun vc-mtn-find-admin-dir (file) + "Return the administrative directory of FILE." + (expand-file-name vc-mtn-admin-dir (vc-mtn-root file))) (defun vc-mtn-registered (file) (let ((root (vc-mtn-root file))) @@ -123,10 +126,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ((match-end 2) (push (list (match-string 3) 'added) result)))) (funcall update-function result))) +;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-mtn-dir-status (dir update-function) (vc-mtn-command (current-buffer) 'async dir "status") - (vc-exec-after - `(vc-mtn-after-dir-status (quote ,update-function)))) + (vc-run-delayed + (vc-mtn-after-dir-status update-function))) (defun vc-mtn-working-revision (file) ;; If `mtn' fails or returns status>0, or if the search fails, just @@ -202,6 +208,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; ) (defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit) + "Print commit logs associated with FILES into specified BUFFER. +_SHORTLOG is ignored. +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." (apply 'vc-mtn-command buffer 0 files "log" (append (when start-revision (list "--from" (format "%s" start-revision))) @@ -229,6 +239,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; (defun vc-mtn-show-log-entry (revision) ;; ) +(autoload 'vc-switches "vc") + (defun vc-mtn-diff (files &optional rev1 rev2 buffer) "Get a difference report using monotone between two revisions of FILES." (apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff" diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 40d8acb7e07..703b46eb113 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -1,6 +1,6 @@ -;;; vc-rcs.el --- support for RCS version-control +;;; vc-rcs.el --- support for RCS version-control -*- lexical-binding:t -*- -;; Copyright (C) 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel @@ -200,6 +200,8 @@ For a description of possible values, see `vc-check-master-templates'." (vc-rcs-state file)))) (vc-rcs-state file))))) +(autoload 'vc-expand-dirs "vc") + (defun vc-rcs-dir-status (dir update-function) ;; FIXME: this function should be rewritten or `vc-expand-dirs' ;; should be changed to take a backend parameter. Using @@ -270,6 +272,8 @@ When VERSION is given, perform check for that version." ;; RCS is totally file-oriented, so all we have to do is make the directory. (make-directory "RCS")) +(autoload 'vc-switches "vc") + (defun vc-rcs-register (files &optional rev comment) "Register FILES into the RCS version-control system. REV is the optional revision number for the files. COMMENT can be used @@ -290,7 +294,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." nil ".*,v$" t)) (yes-or-no-p "Create RCS subdirectory? ") (make-directory subdir)) - (apply 'vc-do-command "*vc*" 0 "ci" file + (apply #'vc-do-command "*vc*" 0 "ci" file ;; if available, use the secure registering option (and (vc-rcs-release-p "5.6.4") "-i") (concat (if vc-keep-workfiles "-u" "-r") rev) @@ -371,7 +375,7 @@ whether to remove it." (setq switches (cons "-f" switches))) (if (and (not rev) old-version) (setq rev (vc-branch-part old-version))) - (apply 'vc-do-command "*vc*" 0 "ci" (vc-name file) + (apply #'vc-do-command "*vc*" 0 "ci" (vc-name file) ;; if available, use the secure check-in option (and (vc-rcs-release-p "5.6.4") "-j") (concat (if vc-keep-workfiles "-u" "-r") rev) @@ -407,7 +411,7 @@ whether to remove it." (concat "-u" old-version))))))))) (defun vc-rcs-find-revision (file rev buffer) - (apply 'vc-do-command + (apply #'vc-do-command (or buffer "*vc*") 0 "co" (vc-name file) "-q" ;; suppress diagnostic output (concat "-p" rev) @@ -439,7 +443,7 @@ attempt the checkout for all registered files beneath it." (and rev (string= rev "") (vc-rcs-set-default-branch file nil)) ;; now do the checkout - (apply 'vc-do-command + (apply #'vc-do-command "*vc*" 0 "co" (vc-name file) ;; If locking is not strict, force to overwrite ;; the writable workfile. @@ -516,7 +520,7 @@ expanded to all registered subfiles in them." ;; No, it was some other error: re-signal it. (signal (car err) (cdr err))))))))) -(defun vc-rcs-revert (file &optional contents-done) +(defun vc-rcs-revert (file &optional _contents-done) "Revert FILE to the version it was based on. If FILE is a directory, revert all registered files beneath it." (if (file-directory-p file) @@ -567,17 +571,21 @@ directory the operation is applied to all registered files beneath it." (when (looking-at "[\b\t\n\v\f\r ]+") (delete-char (- (match-end 0) (match-beginning 0)))))) -(defun vc-rcs-print-log (files buffer &optional shortlog start-revision-ignored limit) - "Get change log associated with FILE. If FILE is a -directory the operation is applied to all registered files beneath it." - (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))) +(defun vc-rcs-print-log (files buffer &optional _shortlog + _start-revision-ignored limit) + "Print commit log associated with FILES into specified BUFFER. +Remaining arguments are ignored. +If FILE is a directory the operation is applied to all registered +files beneath it." + (vc-do-command (or buffer "*vc*") 0 "rlog" + (mapcar 'vc-name (vc-expand-dirs files))) (with-current-buffer (or buffer "*vc*") (vc-rcs-print-log-cleanup)) (when limit 'limit-unsupported)) (defun vc-rcs-diff (files &optional oldvers newvers buffer) "Get a difference report using RCS between two sets of files." - (apply 'vc-do-command (or buffer "*vc-diff*") + (apply #'vc-do-command (or buffer "*vc-diff*") 1 ;; Always go synchronous, the repo is local "rcsdiff" (vc-expand-dirs files) (append (list "-q" @@ -585,6 +593,10 @@ directory the operation is applied to all registered files beneath it." (and newvers (concat "-r" newvers))) (vc-switches 'RCS 'diff)))) +(defun vc-rcs-find-admin-dir (file) + "Return the administrative directory of FILE." + (vc-find-root file "RCS")) + (defun vc-rcs-comment-history (file) "Return a string with all log entries stored in BACKEND for FILE." (with-current-buffer "*vc*" @@ -775,7 +787,7 @@ Optional arg REVISION is a revision to annotate from." (cl-flet ((pad (w) (substring-no-properties padding w)) (render (rda &rest ls) (propertize - (apply 'concat + (apply #'concat (format-time-string "%Y-%m-%d" (aref rda 1)) " " (aref rda 0) @@ -799,7 +811,7 @@ Optional arg REVISION is a revision to annotate from." "Return the current time, based at midnight of the current day, and encoded as fractional days." (vc-annotate-convert-time - (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) + (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) (defun vc-rcs-annotate-time () "Return the time of the next annotation (as fraction of days) @@ -817,6 +829,9 @@ systime, or nil if there is none. Also, reposition point." ;;; Tag system ;;; +(autoload 'vc-tag-precondition "vc") +(declare-function vc-file-tree-walk "vc" (dirname func &rest args)) + (defun vc-rcs-create-tag (dir name branchp) (when branchp (error "RCS backend does not support module branches")) @@ -842,7 +857,7 @@ systime, or nil if there is none. Also, reposition point." (string-match "[0-9]+\\'" rev) (substring rev (match-beginning 0) (match-end 0))) -(defun vc-rcs-previous-revision (file rev) +(defun vc-rcs-previous-revision (_file rev) "Return the revision number immediately preceding REV for FILE, or nil if there is no previous revision. This default implementation works for MAJOR.MINOR-style revision numbers as @@ -888,6 +903,8 @@ and CVS." (t "rcs2log"))) "Path to the `rcs2log' program (normally in `exec-directory').") +(autoload 'vc-buffer-sync "vc-dispatcher") + (defun vc-rcs-update-changelog (files) "Default implementation of update-changelog. Uses `rcs2log' which only works for RCS and CVS." @@ -918,7 +935,7 @@ Uses `rcs2log' which only works for RCS and CVS." (unwind-protect (progn (setq default-directory odefault) - (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program + (if (eq 0 (apply #'call-process vc-rcs-rcs2log-program nil (list t tempfile) nil "-c" changelog "-u" (concat login-name @@ -954,6 +971,8 @@ Uses `rcs2log' which only works for RCS and CVS." nil t) (replace-match "$\\1$")))) +(autoload 'vc-rename-master "vc") + (defun vc-rcs-rename-file (old new) ;; Just move the master file (using vc-rcs-master-templates). (vc-rename-master (vc-name old) new vc-rcs-master-templates)) @@ -1321,11 +1340,10 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." (to-one@ () (setq @-holes nil b (progn (search-forward "@") (point)) e (progn (while (and (search-forward "@") - (= ?@ (char-after)) - (progn - (push (point) @-holes) - (forward-char 1) - (push (point) @-holes)))) + (= ?@ (char-after))) + (push (point) @-holes) + (forward-char 1) + (push (point) @-holes)) (1- (point))))) (tok+val (set-b+e name &optional proc) (unless (eq name (setq tok (read buffer))) @@ -1336,18 +1354,18 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." (funcall proc) (buffer-substring-no-properties b e)))) (k-semi (name &optional proc) (tok+val #'to-semi name proc)) - (gather () (let ((pairs `(,e ,@@-holes ,b)) - acc) - (while pairs - (push (buffer-substring-no-properties - (cadr pairs) (car pairs)) - acc) - (setq pairs (cddr pairs))) - (apply 'concat acc))) - (k-one@ (name &optional later) (tok+val #'to-one@ name - (if later - (lambda () t) - #'gather)))) + (gather (b e @-holes) + (let ((pairs `(,e ,@@-holes ,b)) + acc) + (while pairs + (push (buffer-substring-no-properties + (cadr pairs) (car pairs)) + acc) + (setq pairs (cddr pairs))) + (apply #'concat acc))) + (gather1 () (gather b e @-holes)) + (k-one@ (name &optional later) + (tok+val #'to-one@ name (if later (lambda () t) #'gather1)))) (save-excursion (goto-char (point-min)) ;; headers @@ -1394,7 +1412,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." ;; same algorithm used in RCS 5.7. (when (< (car ls) 100) (setcar ls (+ 1900 (car ls)))) - (apply 'encode-time (nreverse ls))))) + (apply #'encode-time (nreverse ls))))) ,@(mapcar #'k-semi '(author state)) ,(k-semi 'branches (lambda () @@ -1428,6 +1446,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." (cl-flet ((incg (beg end) (let ((b beg) (e end) @-holes) (while (and asc (< (car asc) e)) + (push (pop asc) @-holes) (push (pop asc) @-holes)) ;; Self-deprecate when work is done. ;; Folding many dimensions into one. @@ -1435,7 +1454,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." ;; O beauteous math! --the Unvexed Bum (unless asc (setq sub #'buffer-substring-no-properties)) - (gather)))) + (gather b e @-holes)))) (while (and (sw) (not (eobp)) (setq context (to-eol) @@ -1451,7 +1470,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." ;; other revisions, replace the `text' tag+value with `:insn' ;; plus value, always scanning in-place. (if (string= context (cdr (assq 'head headers))) - (setcdr (cadr rev) (gather)) + (setcdr (cadr rev) (gather b e @-holes)) (if @-holes (setq asc (nreverse @-holes) sub #'incg) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index bfbe42222e9..fb7d9596822 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -1,6 +1,6 @@ -;;; vc-sccs.el --- support for SCCS version-control +;;; vc-sccs.el --- support for SCCS version-control -*- lexical-binding:t -*- -;; Copyright (C) 1992-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel @@ -101,7 +101,7 @@ For a description of possible values, see `vc-check-master-templates'." ;;; Properties of the backend (defun vc-sccs-revision-granularity () 'file) -(defun vc-sccs-checkout-model (files) 'locking) +(defun vc-sccs-checkout-model (_files) 'locking) ;;; ;;; State-querying functions @@ -155,6 +155,8 @@ For a description of possible values, see `vc-check-master-templates'." (vc-sccs-state file)))) (vc-sccs-state file))) +(autoload 'vc-expand-dirs "vc") + (defun vc-sccs-dir-status (dir update-function) ;; FIXME: this function should be rewritten, using `vc-expand-dirs' ;; is not TRTD because it returns files from multiple backends. @@ -216,6 +218,8 @@ Optional string REV is a revision." ;; SCCS is totally file-oriented, so all we have to do is make the directory (make-directory "SCCS")) +(autoload 'vc-switches "vc") + (defun vc-sccs-register (files &optional rev comment) "Register FILES into the SCCS version-control system. REV is the optional revision number for the file. COMMENT can be used @@ -317,7 +321,7 @@ are expanded to all version-controlled subfiles." (vc-name file) (concat "-r" discard)) (vc-sccs-do-command nil 0 "get" (vc-name file) nil)))) -(defun vc-sccs-revert (file &optional contents-done) +(defun vc-sccs-revert (file &optional _contents-done) "Revert FILE to the version it was based on. If FILE is a directory, revert all subfiles." (if (file-directory-p file) @@ -349,12 +353,18 @@ revert all subfiles." ;;; History functions ;;; -(defun vc-sccs-print-log (files buffer &optional shortlog start-revision-ignored limit) - "Get change log associated with FILES." +(defun vc-sccs-print-log (files buffer &optional _shortlog _start-revision-ignored limit) + "Print commit log associated with FILES into specified BUFFER. +Remaining arguments are ignored." (setq files (vc-expand-dirs files)) (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files)) (when limit 'limit-unsupported)) +(autoload 'vc-setup-buffer "vc-dispatcher") +(autoload 'vc-delistify "vc-dispatcher") + +(defvar w32-quote-process-args) + ;; FIXME use sccsdiff if present? (defun vc-sccs-diff (files &optional oldvers newvers buffer) "Get a difference report using SCCS between two filesets." @@ -431,6 +441,9 @@ revert all subfiles." ;;; our own set of name-to-revision mappings. ;;; +(autoload 'vc-tag-precondition "vc") +(declare-function vc-file-tree-walk "vc" (dirname func &rest args)) + (defun vc-sccs-create-tag (dir name branchp) (when branchp (error "SCCS backend does not support module branches")) @@ -459,6 +472,8 @@ revert all subfiles." (goto-char (point-min)) (re-search-forward "%[A-Z]%" nil t))) +(autoload 'vc-rename-master "vc") + (defun vc-sccs-rename-file (old new) ;; Move the master file (using vc-rcs-master-templates). (vc-rename-master (vc-name old) new vc-sccs-master-templates) @@ -491,7 +506,7 @@ revert all subfiles." ;; a (autoload 'vc-sccs-search-project-dir "vc-sccs") which would not ;; help us avoid loading vc-sccs. ;;;###autoload -(progn (defun vc-sccs-search-project-dir (dirname basename) +(progn (defun vc-sccs-search-project-dir (_dirname basename) "Return the name of a master file in the SCCS project directory. Does not check whether the file exists but returns nil if it does not find any project directory." diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 923888b460b..85976db78bd 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -1,6 +1,6 @@ -;;; vc-svn.el --- non-resident support for Subversion version-control +;;; vc-svn.el --- non-resident support for Subversion version-control -*- lexical-binding:t -*- -;; Copyright (C) 2003-2013 Free Software Foundation, Inc. +;; Copyright (C) 2003-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -115,7 +115,7 @@ If you want to force an empty list of arguments, use t." ;;; Properties of the backend (defun vc-svn-revision-granularity () 'repository) -(defun vc-svn-checkout-model (files) 'implicit) +(defun vc-svn-checkout-model (_files) 'implicit) ;;; ;;; State-querying functions @@ -215,6 +215,9 @@ If you want to force an empty list of arguments, use t." (setq result (cons (list filename state) result))))) (funcall callback result))) +;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-svn-dir-status (dir callback) "Run 'svn status' for DIR and update BUFFER via CALLBACK. CALLBACK is called as (CALLBACK RESULT BUFFER), where @@ -228,15 +231,15 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (remote (or t (not local) (eq local 'only-file)))) (vc-svn-command (current-buffer) 'async nil "status" (if remote "-u")) - (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback) ,remote)))) + (vc-run-delayed + (vc-svn-after-dir-status callback remote)))) -(defun vc-svn-dir-status-files (dir files default-state callback) +(defun vc-svn-dir-status-files (_dir files _default-state callback) (apply 'vc-svn-command (current-buffer) 'async nil "status" files) - (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback)))) + (vc-run-delayed + (vc-svn-after-dir-status callback))) -(defun vc-svn-dir-extra-headers (dir) +(defun vc-svn-dir-extra-headers (_dir) "Generate extra status headers for a Subversion working copy." (let (process-file-side-effects) (vc-svn-command "*vc*" 0 nil "info")) @@ -265,7 +268,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." ;; vc-svn-mode-line-string doesn't exist because the default implementation ;; works just fine. -(defun vc-svn-previous-revision (file rev) +(defun vc-svn-previous-revision (_file rev) (let ((newrev (1- (string-to-number rev)))) (when (< 0 newrev) (number-to-string newrev)))) @@ -290,10 +293,14 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (defun vc-svn-create-repo () "Create a new SVN repository." (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN")) + ;; Expand default-directory because svn gets confused by eg + ;; file://~/path/to/file. (Bug#15446). (vc-svn-command "*vc*" 0 "." "checkout" - (concat "file://" default-directory "SVN"))) + (concat "file://" (expand-file-name default-directory) "SVN"))) -(defun vc-svn-register (files &optional rev comment) +(autoload 'vc-switches "vc") + +(defun vc-svn-register (files &optional _rev _comment) "Register FILES into the SVN version-control system. The COMMENT argument is ignored This does an add but not a commit. Passes either `vc-svn-register-switches' or `vc-register-switches' @@ -309,7 +316,7 @@ to the SVN command." "Return non-nil if FILE could be registered in SVN. This is only possible if SVN is responsible for FILE's directory.") -(defun vc-svn-checkin (files rev comment &optional extra-args-ignored) +(defun vc-svn-checkin (files rev comment &optional _extra-args-ignored) "SVN-specific version of `vc-backend-checkin'." (if rev (error "Committing to a specific revision is unsupported in SVN")) (let ((status (apply @@ -347,6 +354,19 @@ This is only possible if SVN is responsible for FILE's directory.") (concat "-r" rev)) (vc-switches 'SVN 'checkout)))) +(defun vc-svn-ignore (file &optional _directory _remove) + "Ignore FILE under Subversion. +FILE is a file wildcard, relative to the root directory of DIRECTORY." + (vc-svn-command t 0 file "propedit" "svn:ignore")) + +(defun vc-svn-ignore-completion-table (_file) + "Return the list of ignored files." + ) + +(defun vc-svn-find-admin-dir (file) + "Return the administrative directory of FILE." + (expand-file-name vc-svn-admin-directory (vc-svn-root file))) + (defun vc-svn-checkout (file &optional editable rev) (message "Checking out %s..." file) (with-current-buffer (or (get-file-buffer file) (current-buffer)) @@ -354,7 +374,7 @@ This is only possible if SVN is responsible for FILE's directory.") (vc-mode-line file 'SVN) (message "Checking out %s...done" file)) -(defun vc-svn-update (file editable rev switches) +(defun vc-svn-update (file _editable rev switches) (if (and (file-exists-p file) (not rev)) ;; If no revision was specified, there's nothing to do. nil @@ -443,7 +463,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (error "Couldn't analyze svn update result"))) (message "Merging changes into %s...done" file)))) -(defun vc-svn-modify-change-comment (files rev comment) +(defun vc-svn-modify-change-comment (_files rev comment) "Modify the change comments for a specified REV. You must have ssh access to the repository host, and the directory Emacs uses locally for temp files must also be writable by you on that host. @@ -493,8 +513,13 @@ or svn+ssh://." (require 'add-log) (set (make-local-variable 'log-view-per-file-logs) nil)) -(defun vc-svn-print-log (files buffer &optional shortlog start-revision limit) - "Get change log(s) associated with FILES." +(autoload 'vc-setup-buffer "vc-dispatcher") + +(defun vc-svn-print-log (files buffer &optional _shortlog start-revision limit) + "Print commit log associated with FILES into specified BUFFER. +SHORTLOG is ignored. +If START-REVISION is non-nil, it is the newest revision to show. +If LIMIT is non-nil, show no more than this many entries." (save-current-buffer (vc-setup-buffer buffer) (let ((inhibit-read-only t)) @@ -512,7 +537,7 @@ or svn+ssh://." (append (list (if start-revision - (format "-r%s" start-revision) + (format "-r%s:1" start-revision) ;; By default Subversion only shows the log up to the ;; working revision, whereas we also want the log of the ;; subsequent commits. At least that's what the @@ -574,7 +599,7 @@ NAME is assumed to be a URL." (vc-svn-command nil 0 dir "copy" name) (when branchp (vc-svn-retrieve-tag dir name nil))) -(defun vc-svn-retrieve-tag (dir name update) +(defun vc-svn-retrieve-tag (dir name _update) "Retrieve a tag at and below DIR. NAME is the name of the tag; if it is empty, do a `svn update'. If UPDATE is non-nil, then update (resynch) any affected buffers. @@ -655,19 +680,23 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (defun vc-svn-parse-status (&optional filename) "Parse output of \"svn status\" command in the current buffer. -Set file properties accordingly. Unless FILENAME is non-nil, parse only -information about FILENAME and return its status." - (let (file status propstat) +Set file properties accordingly. If FILENAME is non-nil, return its status." + (let (multifile file status propstat) (goto-char (point-min)) (while (re-search-forward ;; Ignore the files with status X. "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) ;; If the username contains spaces, the output format is ambiguous, ;; so don't trust the output's filename unless we have to. - (setq file (or filename + (setq file (or (unless multifile filename) (expand-file-name - (buffer-substring (point) (line-end-position))))) - (setq status (char-after (line-beginning-position)) + (buffer-substring (point) (line-end-position)))) + ;; If we are parsing the result of running status on a directory, + ;; there could be multiple files in the output. + ;; We assume that filename, if supplied, applies to the first + ;; listed file (ie, the directory). Bug#15322. + multifile t + status (char-after (line-beginning-position)) ;; Status of the item's properties ([ MC]). propstat (char-after (1+ (line-beginning-position)))) (if (eq status ??) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a0ef6f9d6d7..4a536900eb3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1,6 +1,6 @@ ;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1992-1998, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1992-1998, 2000-2014 Free Software Foundation, Inc. ;; Author: FSF (see below for full credits) ;; Maintainer: Andre Spiegel @@ -115,10 +115,10 @@ ;; Return non-nil if FILE is registered in this backend. Both this ;; function as well as `state' should be careful to fail gracefully ;; in the event that the backend executable is absent. It is -;; preferable that this function's body is autoloaded, that way only +;; preferable that this function's *body* is autoloaded, that way only ;; calling vc-registered does not cause the backend to be loaded ;; (all the vc-FOO-registered functions are called to try to find -;; the controlling backend for FILE. +;; the controlling backend for FILE). ;; ;; * state (file) ;; @@ -233,6 +233,7 @@ ;; The implementation should pass the value of vc-register-switches ;; to the backend command. (Note: in older versions of VC, this ;; command took a single file argument and not a list.) +;; The REV argument is a historical leftover and is never used. ;; ;; - init-revision (file) ;; @@ -346,6 +347,10 @@ ;; ;; Mark conflicts as resolved. Some VC systems need to run a ;; command to mark conflicts as resolved. +;; +;; - find-admin-dir (file) +;; +;; Return the administrative directory of FILE. ;; HISTORY FUNCTIONS ;; @@ -356,9 +361,11 @@ ;; If LIMIT is true insert only insert LIMIT log entries. If the ;; backend does not support limiting the number of entries to show ;; it should return `limit-unsupported'. -;; If START-REVISION is given, then show the log starting from the -;; revision. At this point START-REVISION is only required to work -;; in conjunction with LIMIT = 1. +;; If START-REVISION is given, then show the log starting from that +;; revision ("starting" in the sense of it being the _newest_ +;; revision shown, rather than the working revision, which is normally +;; the case). Not all backends support this. At present, this is +;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line). ;; ;; * log-outgoing (backend remote-location) ;; @@ -483,6 +490,7 @@ ;; default implementation always returns nil. ;; ;; - root (file) +;; ;; Return the root of the VC controlled hierarchy for file. ;; ;; - repository-hostname (dirname) @@ -493,6 +501,21 @@ ;; This function is used in `vc-stay-local-p' which backends can use ;; for their convenience. ;; +;; - ignore (file &optional directory) +;; +;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory'). +;; FILE is a file wildcard. +;; When called interactively and with a prefix argument, remove FILE +;; from ignored files. +;; When called from Lisp code, if DIRECTORY is non-nil, the +;; repository to use will be deduced by DIRECTORY. +;; +;; - ignore-completion-table +;; +;; Return the completion table for files ignored by the current +;; version control system, e.g., the entries in `.gitignore' and +;; `.bzrignore'. +;; ;; - previous-revision (file rev) ;; ;; Return the revision number that precedes REV for FILE, or nil if no such @@ -573,9 +596,6 @@ ;; ;; - deal with push/pull operations. ;; -;; - add a mechanism for editing the underlying VCS's list of files -;; to be ignored, when that's possible. -;; ;;;; Primitives that need changing: ;; ;; - vc-update/vc-merge should deal with VC systems that don't @@ -735,13 +755,6 @@ not specific to any particular backend." :group 'vc :version "21.1") -(defcustom vc-diff-knows-L nil - "Indicates whether diff understands the -L option. -The value is either `yes', `no', or nil. If it is nil, VC tries -to use -L and sets this variable to remember whether it worked." - :type '(choice (const :tag "Work out" nil) (const yes) (const no)) - :group 'vc) - (defcustom vc-log-show-limit 2000 "Limit the number of items shown by the VC log commands. Zero means unlimited. @@ -949,7 +962,8 @@ Within directories, only files already under version control are noticed." "Deduce a set of files and a backend to which to apply an operation. Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL). -If we're in VC-dir mode, FILESET is the list of marked files. +If we're in VC-dir mode, FILESET is the list of marked files, +or the directory if no files are marked. Otherwise, if in a buffer visiting a version-controlled file, FILESET is a single-file fileset containing that file. Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file @@ -997,7 +1011,7 @@ current buffer." nil) (list (vc-backend-for-registration (buffer-file-name)) (list buffer-file-name)))) - (t (error "No fileset is available here"))))) + (t (error "File is not under version control"))))) (defun vc-dired-deduce-fileset () (let ((backend (vc-responsible-backend default-directory))) @@ -1039,6 +1053,11 @@ current buffer." (eq p q) (and (member p '(edited added removed)) (member q '(edited added removed))))) +(defun vc-read-backend (prompt) + (intern + (completing-read prompt (mapcar 'symbol-name vc-handled-backends) + nil 'require-match))) + ;; Here's the major entry point. ;;;###autoload @@ -1097,8 +1116,9 @@ For old-style locking-based version control systems, like RCS: ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) (cond (verbose - ;; go to a different revision + ;; Go to a different revision. (let* ((revision + ;; FIXME: Provide completion. (read-string "Branch, revision, or backend to move to: ")) (revision-downcase (downcase revision))) (if (member @@ -1159,15 +1179,10 @@ For old-style locking-based version control systems, like RCS: (message "No files remain to be committed") (if (not verbose) (vc-checkin ready-for-commit backend) - (let* ((revision (read-string "New revision or backend: ")) - (revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) - (let ((vsym (intern revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (vc-checkin ready-for-commit backend revision))))))) + (let ((new-backend (vc-read-backend "New backend: "))) + (if new-backend + (dolist (file files) + (vc-transfer-file file new-backend)))))))) ;; locked by somebody else (locking VCSes only) ((stringp state) ;; In the old days, we computed the revision once and used it on @@ -1328,6 +1343,79 @@ first backend that could register the file is used." (let ((vc-handled-backends (list backend))) (call-interactively 'vc-register))) +(defun vc-ignore (file &optional directory remove) + "Ignore FILE under the VCS of DIRECTORY. + +Normally, FILE is a wildcard specification that matches the files +to be ignored. When REMOVE is non-nil, remove FILE from the list +of ignored files. + +DIRECTORY defaults to `default-directory' and is used to +determine the responsible VC backend. + +When called interactively, prompt for a FILE to ignore, unless a +prefix argument is given, in which case prompt for a file FILE to +remove from the list of ignored files." + (interactive + (list + (if (not current-prefix-arg) + (read-file-name "File to ignore: ") + (completing-read + "File to remove: " + (vc-call-backend + (or (vc-responsible-backend default-directory) + (error "Unknown backend")) + 'ignore-completion-table default-directory))) + nil current-prefix-arg)) + (let* ((directory (or directory default-directory)) + (backend (or (vc-responsible-backend default-directory) + (error "Unknown backend")))) + (vc-call-backend backend 'ignore file directory remove))) + +(defun vc-default-ignore (backend file &optional directory remove) + "Ignore FILE under the VCS of DIRECTORY (default is `default-directory'). +FILE is a file wildcard, relative to the root directory of DIRECTORY. +When called from Lisp code, if DIRECTORY is non-nil, the +repository to use will be deduced by DIRECTORY; if REMOVE is +non-nil, remove FILE from ignored files. +Argument BACKEND is the backend you are using." + (let ((ignore + (vc-call-backend backend 'find-ignore-file (or directory default-directory))) + (pattern (file-relative-name + (expand-file-name file) (file-name-directory file)))) + (if remove + (vc--remove-regexp pattern ignore) + (vc--add-line pattern ignore)))) + +(defun vc-default-ignore-completion-table (backend file) + "Return the list of ignored files under BACKEND." + (vc--read-lines + (vc-call-backend backend 'find-ignore-file file))) + +(defun vc--read-lines (file) + "Return a list of lines of FILE." + (with-temp-buffer + (insert-file-contents file) + (split-string (buffer-string) "\n" t))) + +;; Subroutine for `vc-git-ignore' and `vc-hg-ignore'. +(defun vc--add-line (string file) + "Add STRING as a line to FILE." + (with-temp-buffer + (insert-file-contents file) + (unless (re-search-forward (concat "^" (regexp-quote string) "$") nil t) + (goto-char (point-max)) + (insert (concat "\n" string)) + (write-region (point-min) (point-max) file)))) + +(defun vc--remove-regexp (regexp file) + "Remove all matching for REGEXP in FILE." + (with-temp-buffer + (insert-file-contents file) + (while (re-search-forward regexp nil t) + (replace-match "")) + (write-region (point-min) (point-max) file))) + (defun vc-checkout (file &optional writable rev) "Retrieve a copy of the revision REV of FILE. If WRITABLE is non-nil, make sure the retrieved file is writable. @@ -1456,11 +1544,11 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; (vc-file-tree-walk ;; default-directory ;; (lambda (f) -;; (vc-exec-after -;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f))) -;; (message "Looking at %s" ',f) -;; (vc-call-backend ',(vc-backend f) -;; 'diff (list ',f) ',rev1 ',rev2)))))) +;; (vc-run-delayed +;; (let ((coding-system-for-read (vc-coding-system-for-diff f))) +;; (message "Looking at %s" f) +;; (vc-call-backend (vc-backend f) +;; 'diff (list f) rev1 rev2)))))) (defvar vc-coding-system-inherit-eol t "When non-nil, inherit the EOL format for reading Diff output from the file. @@ -1563,6 +1651,13 @@ Return t if the buffer had changes, nil otherwise." ;; be to call the back end separately for each file. (coding-system-for-read (if files (vc-coding-system-for-diff (car files)) 'undecided))) + ;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style + ;; EOLs, which will look ugly if (car files) happens to have Unix + ;; EOLs. + (if (memq system-type '(windows-nt ms-dos)) + (setq coding-system-for-read + (coding-system-change-eol-conversion coding-system-for-read + 'dos))) (vc-setup-buffer buffer) (message "%s" (car messages)) ;; Many backends don't handle well the case of a file that has been @@ -1598,8 +1693,8 @@ Return t if the buffer had changes, nil otherwise." (diff-mode) (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) (set (make-local-variable 'revert-buffer-function) - `(lambda (ignore-auto noconfirm) - (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose))) + (lambda (_ignore-auto _noconfirm) + (vc-diff-internal async vc-fileset rev1 rev2 verbose))) ;; Make the *vc-diff* buffer read only, the diff-mode key ;; bindings are nicer for read only buffers. pcl-cvs does the ;; same thing. @@ -1615,8 +1710,8 @@ Return t if the buffer had changes, nil otherwise." ;; The diff process may finish early, so call `vc-diff-finish' ;; after `pop-to-buffer'; the former assumes the diff buffer is ;; shown in some window. - (vc-exec-after `(vc-diff-finish ,(current-buffer) - ',(when verbose messages))) + (let ((buf (current-buffer))) + (vc-run-delayed (vc-diff-finish buf (when verbose messages)))) ;; In the async case, we return t even if there are no differences ;; because we don't know that yet. t))) @@ -1654,13 +1749,12 @@ Return t if the buffer had changes, nil otherwise." ;; if the file is not up-to-date, use working revision as older revision ((not (vc-up-to-date-p first)) (setq rev1-default (vc-working-revision first))) - ;; if the file is not locked, use last and previous revisions as defaults + ;; if the file is not locked, use last revision and current source as defaults (t (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work. (vc-call-backend backend 'previous-revision first (vc-working-revision first)))) - (when (string= rev1-default "") (setq rev1-default nil)) - (setq rev2-default (vc-working-revision first)))) + (when (string= rev1-default "") (setq rev1-default nil)))) ;; construct argument list (let* ((rev1-prompt (if rev1-default (concat "Older revision (default " @@ -2084,6 +2178,11 @@ Not all VC backends support short logs!") (defvar log-view-vc-fileset) (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) + "Insert at the end of the current buffer buttons to show more log entries. +In the new log, leave point at WORKING-REVISION (if non-nil). +LIMIT is the number of entries currently shown. +Does nothing if IS-START-REVISION is non-nil, or if LIMIT is nil, +or if PL-RETURN is 'limit-unsupported." (when (and limit (not (eq 'limit-unsupported pl-return)) (not is-start-revision)) (goto-char (point-max)) @@ -2104,6 +2203,14 @@ Not all VC backends support short logs!") (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) + "For specified BACKEND and FILES, show the VC log. +Leave point at WORKING-REVISION, if it is non-nil. +If IS-START-REVISION is non-nil, start the log from WORKING-REVISION +\(not all backends support this); i.e., show only WORKING-REVISION and +earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." + ;; As of 2013/04 the only thing that passes IS-START-REVISION non-nil + ;; is vc-annotate-show-log-revision-at-line, which sets LIMIT = 1. + ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled ;; buffer can be accessed by the command. @@ -2137,6 +2244,7 @@ Not all VC backends support short logs!") (defvar vc-log-view-type nil "Set this to differentiate the different types of logs.") (put 'vc-log-view-type 'permanent-local t) +(defvar vc-sentinel-movepoint) (defun vc-log-internal-common (backend buffer-name @@ -2159,13 +2267,13 @@ Not all VC backends support short logs!") (set (make-local-variable 'log-view-vc-fileset) files) (set (make-local-variable 'revert-buffer-function) rev-buff-func)) - (vc-exec-after - `(let ((inhibit-read-only t)) - (funcall ',setup-buttons-func ',backend ',files ',retval) - (shrink-window-if-larger-than-buffer) - (funcall ',goto-location-func ',backend) - (setq vc-sentinel-movepoint (point)) - (set-buffer-modified-p nil))))) + (vc-run-delayed + (let ((inhibit-read-only t)) + (funcall setup-buttons-func backend files retval) + (shrink-window-if-larger-than-buffer) + (funcall goto-location-func backend) + (setq vc-sentinel-movepoint (point)) + (set-buffer-modified-p nil))))) (defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) (vc-log-internal-common @@ -2189,7 +2297,7 @@ WORKING-REVISION and LIMIT." (interactive (cond (current-prefix-arg - (let ((rev (read-from-minibuffer "Log from revision (default: last revision): " nil + (let ((rev (read-from-minibuffer "Leave point at revision (default: last revision): " nil nil nil nil)) (lim (string-to-number (read-from-minibuffer @@ -2204,7 +2312,8 @@ WORKING-REVISION and LIMIT." (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef (backend (car vc-fileset)) (files (cadr vc-fileset)) - (working-revision (or working-revision (vc-working-revision (car files))))) +;; (working-revision (or working-revision (vc-working-revision (car files)))) + ) (vc-print-log-internal backend files working-revision nil limit))) ;;;###autoload @@ -2232,16 +2341,16 @@ When called interactively with a prefix argument, prompt for LIMIT." (setq rootdir (vc-call-backend backend 'root default-directory)) (setq rootdir (read-directory-name "Directory for VC root-log: ")) (setq backend (vc-responsible-backend rootdir)) - (if backend - (setq default-directory rootdir) - (error "Directory is not version controlled"))) - (setq working-revision (vc-working-revision rootdir)) + (unless backend + (error "Directory is not version controlled"))) + (setq working-revision (vc-working-revision rootdir) + default-directory rootdir) (vc-print-log-internal backend (list rootdir) working-revision nil limit))) ;;;###autoload (defun vc-log-incoming (&optional remote-location) "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION.." +When called interactively with a prefix argument, prompt for REMOTE-LOCATION." (interactive (when current-prefix-arg (list (read-string "Remote location (empty for default): ")))) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index b6ea3383bec..05ce9372d2a 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -1,10 +1,10 @@ ;;; vcursor.el --- manipulate an alternative ("virtual") cursor -;; Copyright (C) 1994, 1996, 1998, 2001-2013 Free Software Foundation, +;; Copyright (C) 1994, 1996, 1998, 2001-2014 Free Software Foundation, ;; Inc. ;; Author: Peter Stephenson -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: virtual cursor, convenience ;; This file is part of GNU Emacs. diff --git a/lisp/version.el b/lisp/version.el index 5db45da860c..68b502ce451 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -1,9 +1,9 @@ ;;; version.el --- record version number of Emacs -;; Copyright (C) 1985, 1992, 1994-1995, 1999-2013 Free Software +;; Copyright (C) 1985, 1992, 1994-1995, 1999-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -85,11 +85,13 @@ to the system configuration; look at `system-configuration' instead." (defalias 'version 'emacs-version) ;; Set during dumping, this is a defvar so that it can be setq'd. -(defvar emacs-bzr-version nil - "String giving the bzr revision from which this Emacs was built. -The format is: [revno] revision_id, where revno may be absent. -Value is nil if Emacs was not built from a bzr checkout, or if we could -not determine the revision.") +(defvar emacs-repository-version nil + "String giving the repository revision from which this Emacs was built. +Value is nil if Emacs was not built from a repository checkout, +or if we could not determine the revision.") + +(define-obsolete-variable-alias 'emacs-bzr-version + 'emacs-repository-version "24.4") (defun emacs-bzr-version-dirstate (dir) "Try to return as a string the bzr revision ID of directory DIR. @@ -123,55 +125,73 @@ Returns nil if unable to find this information." (call-process "bzr" nil '(t nil) nil "version-info" "--custom" "--template={revno} {revision_id} (clean = {clean})" - "dir")) + dir)) (buffer-string)))) -(defun emacs-bzr-get-version (&optional dir external) - "Try to return as a string the bzr revision of the Emacs sources. -The format is: [revno] revision_id, where revno may be absent. -Value is nil if the sources do not seem to be under bzr, or if we could -not determine the revision. Note that this reports on the current state -of the sources, which may not correspond to the running Emacs. +(define-obsolete-function-alias 'emacs-bzr-get-version + 'emacs-repository-get-version "24.4") -Optional argument DIR is a directory to use instead of `source-directory'. -Optional argument EXTERNAL non-nil means to maybe ask `bzr' itself, -if the sources appear to be under bzr. If `force', always ask bzr. -Otherwise only ask bzr if we cannot find any information ourselves." +(defun emacs-repository-get-version (&optional dir external) + "Try to return as a string the repository revision of the Emacs sources. +The format of the returned string is dependent on the VCS in use. +Value is nil if the sources do not seem to be under version +control, or if we could not determine the revision. Note that +this reports on the current state of the sources, which may not +correspond to the running Emacs. + +Optional argument DIR is a directory to use instead of +`source-directory'. Optional argument EXTERNAL non-nil means to +maybe ask the VCS itself, if the sources appear to be under +version control. If `force', always ask. the VCS. Otherwise +only ask the VCS if we cannot find any information ourselves." (or dir (setq dir source-directory)) - (when (file-directory-p (expand-file-name ".bzr/branch" dir)) - (if (eq external 'force) - (emacs-bzr-version-bzr dir) - (let (file loc rev) - (cond ((file-readable-p - (setq file (expand-file-name ".bzr/branch/last-revision" dir))) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-max)) - (if (looking-back "\n") - (delete-char -1)) - (buffer-string))) - ;; OK, no last-revision. Is it a lightweight checkout? - ((file-readable-p - (setq file (expand-file-name ".bzr/branch/location" dir))) - (setq rev (emacs-bzr-version-dirstate dir)) - ;; If the parent branch is local, try looking there for the rev. - ;; Note: there is no guarantee that the parent branch's rev - ;; corresponds to this branch. This branch could have - ;; been made with a specific -r revno argument, or the - ;; parent could have been updated since this branch was created. - ;; To try and detect this, we check the dirstate revids - ;; to see if they match. - (if (and (setq loc (with-temp-buffer - (insert-file-contents file) - (if (looking-at "file://\\(.*\\)") - (match-string 1)))) - (equal rev (emacs-bzr-version-dirstate loc))) - (emacs-bzr-get-version loc) - ;; If parent does not match, the best we can do without - ;; calling external commands is to use the dirstate rev. - rev)) - (external - (emacs-bzr-version-bzr dir))))))) + (cond ((file-directory-p (expand-file-name ".bzr/branch" dir)) + (if (eq external 'force) + (emacs-bzr-version-bzr dir) + (let (file loc rev) + (cond ((file-readable-p + (setq file (expand-file-name + ".bzr/branch/last-revision" dir))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-max)) + (if (looking-back "\n") + (delete-char -1)) + (buffer-string))) + ;; OK, no last-revision. Is it a lightweight checkout? + ((file-readable-p + (setq file (expand-file-name ".bzr/branch/location" dir))) + (setq rev (emacs-bzr-version-dirstate dir)) + ;; If parent branch is local, try looking there for the rev. + ;; Note: there is no guarantee that the parent branch's rev + ;; corresponds to this branch. This branch could have + ;; been made with a specific -r revno argument, or the + ;; parent could have been updated since this branch was + ;; created. + ;; To try and detect this, we check the dirstate revids + ;; to see if they match. + (if (and (setq loc (with-temp-buffer + (insert-file-contents file) + (if (looking-at "file://\\(.*\\)") + (match-string 1)))) + (equal rev (emacs-bzr-version-dirstate loc))) + (emacs-repository-get-version loc) + ;; If parent does not match, the best we can do without + ;; calling external commands is to use the dirstate rev. + rev)) + (external + (emacs-bzr-version-bzr dir)))))) + ((file-directory-p (expand-file-name ".git" dir)) + (message "Waiting for git...") + (with-temp-buffer + (let ((default-directory (file-name-as-directory dir))) + (and (eq 0 + (condition-case nil + (call-process "git" nil '(t nil) nil "log" + "-1" "--pretty=format:%N") + (error nil))) + (not (zerop (buffer-size))) + (replace-regexp-in-string "\n" "" (buffer-string)))))))) ;; We put version info into the executable in the form that `ident' uses. (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) diff --git a/lisp/view.el b/lisp/view.el index f9326399a26..a5992ccb62a 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -1,6 +1,6 @@ ;;; view.el --- peruse file or buffer without editing -;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2013 Free Software +;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2014 Free Software ;; Foundation, Inc. ;; Author: K. Shane Hartman @@ -322,7 +322,7 @@ own View-like bindings." (view-mode-enter nil exit-action))) ;;;###autoload -(defun view-buffer-other-window (buffer &optional not-return exit-action) +(defun view-buffer-other-window (buffer &optional _not-return exit-action) "View BUFFER in View mode in another window. Emacs commands editing the buffer contents are not available; instead, a special set of commands (mostly letters and @@ -349,7 +349,7 @@ own View-like bindings." (view-mode-enter nil exit-action))) ;;;###autoload -(defun view-buffer-other-frame (buffer &optional not-return exit-action) +(defun view-buffer-other-frame (buffer &optional _not-return exit-action) "View BUFFER in View mode in another frame. Emacs commands editing the buffer contents are not available; instead, a special set of commands (mostly letters and diff --git a/lisp/vt-control.el b/lisp/vt-control.el index 158df4fc195..8d96d722fb9 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -1,6 +1,6 @@ ;;; vt-control.el --- Common VTxxx control functions -;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Rob Riepel ;; Maintainer: Rob Riepel diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index 44e691d52b0..aca45207450 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -1,9 +1,9 @@ ;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1988, 2001-2014 Free Software Foundation, Inc. ;; Author: Howard Gayle -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware ;; This file is part of GNU Emacs. diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el index 9f3501a01d7..72946f9bb96 100644 --- a/lisp/w32-common-fns.el +++ b/lisp/w32-common-fns.el @@ -1,6 +1,6 @@ ;;; w32-common-fns.el --- Lisp routines for Windows and Cygwin-w32 -;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -23,6 +23,8 @@ ;;; and Cygwin Emacs compiled to use the native Windows widget ;;; library. +(declare-function x-server-version "w32fns.c" (&optional terminal)) + (defun w32-version () "Return the MS-Windows version numbers. The value is a list of three integers: the major and minor version @@ -77,7 +79,8 @@ all upper-case names. The most often used ones, in addition to `PRIMARY', are `SECONDARY' and `CLIPBOARD'. DATA-TYPE is usually `STRING', but can also be one of the symbols -in `selection-converter-alist', which see." +in `selection-converter-alist', which see. This argument is +ignored on MS-Windows and MS-DOS." (get 'x-selections (or type 'PRIMARY))) ;; x-selection-owner-p is used in simple.el @@ -100,6 +103,7 @@ in `selection-converter-alist', which see." ;; current selection against it, and avoid passing back our own text ;; from x-selection-value. (defvar x-last-selected-text nil) +(defvar x-select-enable-clipboard) (defun x-get-selection-value () "Return the value of the current selection. @@ -107,9 +111,8 @@ Consult the selection. Treat empty strings as if they were unset." (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. - (condition-case c - (setq text (w32-get-clipboard-data)) - (error (message "w32-get-clipboard-data:%s" c))) + (with-demoted-errors "w32-get-clipboard-data:%s" + (setq text (w32-get-clipboard-data))) (if (string= text "") (setq text nil)) (cond ((not text) nil) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index e0d1abe94c7..fda51b1532b 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -1,6 +1,6 @@ ;;; w32-fns.el --- Lisp routines for 32-bit Windows -;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. ;; Author: Geoff Voelker ;; Keywords: internal @@ -250,6 +250,8 @@ This function is provided for backward compatibility, since ;; Set to a system sound if you want a fancy bell. (set-message-beep nil) +(defvar w32-charset-info-alist) ; w32font.c + (defun w32-add-charset-info (xlfd-charset windows-charset codepage) "Function to add character sets to display with Windows fonts. Creates entries in `w32-charset-info-alist'. @@ -305,11 +307,6 @@ bit output with no translation." (w32-add-charset-info "tis620-0" 'w32-charset-thai 874) (w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252) -(make-obsolete-variable 'w32-enable-italics - 'w32-enable-synthesized-fonts "21.1") -(make-obsolete-variable 'w32-charset-to-codepage-alist - 'w32-charset-info-alist "21.1") - ;;;; Support for build process diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el index e51ac174a45..30087d533d4 100644 --- a/lisp/w32-vars.el +++ b/lisp/w32-vars.el @@ -1,6 +1,6 @@ ;;; w32-vars.el --- MS-Windows specific user options -;; Copyright (C) 2002-2013 Free Software Foundation, Inc. +;; Copyright (C) 2002-2014 Free Software Foundation, Inc. ;; Author: Jason Rumney ;; Keywords: internal @@ -149,6 +149,8 @@ menu if the variable `w32-use-w32-font-dialog' is nil." (string :tag "Font"))))))) :group 'w32) +(make-obsolete-variable 'w32-enable-synthesized-fonts nil "24.4") + (provide 'w32-vars) ;;; w32-vars.el ends here diff --git a/lisp/wdired.el b/lisp/wdired.el index 59a09d6d5a0..2e539448962 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -1,9 +1,9 @@ ;;; wdired.el --- Rename files editing their names in dired buffers -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Filename: wdired.el -;; Author: Juan Len Lahoz Garca +;; Author: Juan León Lahoz García ;; Version: 2.0 ;; Keywords: dired, environment, files, renaming @@ -73,8 +73,6 @@ ;;; Code: -(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var - (require 'dired) (autoload 'dired-do-create-files-regexp "dired-aux") @@ -185,7 +183,8 @@ renamed by `dired-do-rename' and `dired-do-rename-regexp'." (define-key map [remap capitalize-word] 'wdired-capitalize-word) (define-key map [remap downcase-word] 'wdired-downcase-word) - map)) + map) + "Keymap used in `wdired-mode'.") (defvar wdired-mode-hook nil "Hooks run when changing to WDired mode.") @@ -239,8 +238,8 @@ See `wdired-mode'." (dired-remember-marks (point-min) (point-max))) (set (make-local-variable 'wdired-old-point) (point)) (set (make-local-variable 'query-replace-skip-read-only) t) - (set (make-local-variable 'isearch-filter-predicate) - 'wdired-isearch-filter-read-only) + (add-function :after-while (local 'isearch-filter-predicate) + #'wdired-isearch-filter-read-only) (use-local-map wdired-mode-map) (force-mode-line-update) (setq buffer-read-only nil) @@ -268,9 +267,8 @@ or \\[wdired-abort-changes] to abort changes"))) (defun wdired-isearch-filter-read-only (beg end) "Skip matches that have a read-only property." - (and (isearch-filter-visible beg end) - (not (text-property-not-all (min beg end) (max beg end) - 'read-only nil)))) + (not (text-property-not-all (min beg end) (max beg end) + 'read-only nil))) ;; Protect the buffer so only the filenames can be changed, and put ;; properties so filenames (old and new) can be easily found. @@ -851,7 +849,7 @@ Like original function but it skips read-only words." (provide 'wdired) ;; Local Variables: -;; coding: latin-1 +;; coding: utf-8 ;; byte-compile-dynamic: t ;; End: diff --git a/lisp/whitespace.el b/lisp/whitespace.el index ed7edbc5a68..83bd4e06074 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1,6 +1,6 @@ ;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre @@ -344,7 +344,7 @@ ;; Thanks to Andreas Roehler for ;; indicating defface byte-compilation warnings. ;; -;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight +;; Thanks to Tim O'Callaghan (EmacsWiki) for the idea about highlight ;; "long" lines. See EightyColumnRule (EmacsWiki). ;; ;; Thanks to Yanghui Bian for indicating a new @@ -554,13 +554,10 @@ See also `whitespace-display-mappings' for documentation." (const :tag "(Mark) NEWLINEs" newline-mark))) :group 'whitespace) - -(defcustom whitespace-space 'whitespace-space +(defvar whitespace-space 'whitespace-space "Symbol face used to visualize SPACE. - -Used when `whitespace-style' includes the value `spaces'." - :type 'face - :group 'whitespace) +Used when `whitespace-style' includes the value `spaces'.") +(make-obsolete-variable 'whitespace-space "use the face instead." "24.4") (defface whitespace-space @@ -573,13 +570,10 @@ Used when `whitespace-style' includes the value `spaces'." :group 'whitespace) -(defcustom whitespace-hspace 'whitespace-hspace +(defvar whitespace-hspace 'whitespace-hspace "Symbol face used to visualize HARD SPACE. - -Used when `whitespace-style' includes the value `spaces'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `spaces'.") +(make-obsolete-variable 'whitespace-hspace "use the face instead." "24.4") (defface whitespace-hspace ; 'nobreak-space '((((class color) (background dark)) @@ -591,13 +585,10 @@ Used when `whitespace-style' includes the value `spaces'." :group 'whitespace) -(defcustom whitespace-tab 'whitespace-tab +(defvar whitespace-tab 'whitespace-tab "Symbol face used to visualize TAB. - -Used when `whitespace-style' includes the value `tabs'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `tabs'.") +(make-obsolete-variable 'whitespace-tab "use the face instead." "24.4") (defface whitespace-tab '((((class color) (background dark)) @@ -609,16 +600,12 @@ Used when `whitespace-style' includes the value `tabs'." :group 'whitespace) -(defcustom whitespace-newline 'whitespace-newline +(defvar whitespace-newline 'whitespace-newline "Symbol face used to visualize NEWLINE char mapping. - See `whitespace-display-mappings'. - Used when `whitespace-style' includes the values `newline-mark' -and `newline'." - :type 'face - :group 'whitespace) - +and `newline'.") +(make-obsolete-variable 'whitespace-newline "use the face instead." "24.4") (defface whitespace-newline '((default :weight normal) @@ -634,13 +621,10 @@ See `whitespace-display-mappings'." :group 'whitespace) -(defcustom whitespace-trailing 'whitespace-trailing +(defvar whitespace-trailing 'whitespace-trailing "Symbol face used to visualize trailing blanks. - -Used when `whitespace-style' includes the value `trailing'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `trailing'.") +(make-obsolete-variable 'whitespace-trailing "use the face instead." "24.4") (defface whitespace-trailing ; 'trailing-whitespace '((default :weight bold) @@ -650,15 +634,11 @@ Used when `whitespace-style' includes the value `trailing'." :group 'whitespace) -(defcustom whitespace-line 'whitespace-line +(defvar whitespace-line 'whitespace-line "Symbol face used to visualize \"long\" lines. - See `whitespace-line-column'. - -Used when `whitespace-style' includes the value `line'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `line'.") +(make-obsolete-variable 'whitespace-line "use the face instead." "24.4") (defface whitespace-line '((((class mono)) :inverse-video t :weight bold :underline t) @@ -669,13 +649,11 @@ See `whitespace-line-column'." :group 'whitespace) -(defcustom whitespace-space-before-tab 'whitespace-space-before-tab +(defvar whitespace-space-before-tab 'whitespace-space-before-tab "Symbol face used to visualize SPACEs before TAB. - -Used when `whitespace-style' includes the value `space-before-tab'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `space-before-tab'.") +(make-obsolete-variable 'whitespace-space-before-tab + "use the face instead." "24.4") (defface whitespace-space-before-tab '((((class mono)) :inverse-video t :weight bold :underline t) @@ -684,13 +662,10 @@ Used when `whitespace-style' includes the value `space-before-tab'." :group 'whitespace) -(defcustom whitespace-indentation 'whitespace-indentation +(defvar whitespace-indentation 'whitespace-indentation "Symbol face used to visualize 8 or more SPACEs at beginning of line. - -Used when `whitespace-style' includes the value `indentation'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `indentation'.") +(make-obsolete-variable 'whitespace-indentation "use the face instead." "24.4") (defface whitespace-indentation '((((class mono)) :inverse-video t :weight bold :underline t) @@ -699,13 +674,10 @@ Used when `whitespace-style' includes the value `indentation'." :group 'whitespace) -(defcustom whitespace-empty 'whitespace-empty +(defvar whitespace-empty 'whitespace-empty "Symbol face used to visualize empty lines at beginning and/or end of buffer. - -Used when `whitespace-style' includes the value `empty'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `empty'.") +(make-obsolete-variable 'whitespace-empty "use the face instead." "24.4") (defface whitespace-empty '((((class mono)) :inverse-video t :weight bold :underline t) @@ -714,13 +686,11 @@ Used when `whitespace-style' includes the value `empty'." :group 'whitespace) -(defcustom whitespace-space-after-tab 'whitespace-space-after-tab +(defvar whitespace-space-after-tab 'whitespace-space-after-tab "Symbol face used to visualize 8 or more SPACEs after TAB. - -Used when `whitespace-style' includes the value `space-after-tab'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `space-after-tab'.") +(make-obsolete-variable 'whitespace-space-after-tab + "use the face instead." "24.4") (defface whitespace-space-after-tab '((((class mono)) :inverse-video t :weight bold :underline t) @@ -730,15 +700,9 @@ Used when `whitespace-style' includes the value `space-after-tab'." (defcustom whitespace-hspace-regexp - "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" + "\\(\u00A0+\\)" "Specify HARD SPACE characters regexp. -If you're using `mule' package, there may be other characters besides: - - \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" - -that should be considered HARD SPACE. - Here are some examples: \"\\\\(^\\xA0+\\\\)\" \ @@ -806,7 +770,7 @@ Used when `whitespace-style' includes `tabs'." "\\([\t \u00A0]+\\)$" "Specify trailing characters regexp. -If you're using `mule' package, there may be other characters besides: +There may be other characters besides: \" \" \"\\t\" \"\\u00A0\" @@ -823,13 +787,6 @@ Used when `whitespace-style' includes `trailing'." (defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)" "Specify SPACEs before TAB regexp. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `space-before-tab', `space-before-tab::tab' or `space-before-tab::space'." :type '(regexp :tag "SPACEs Before TAB") @@ -844,30 +801,16 @@ Used when `whitespace-style' includes `space-before-tab', It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `indentation', `indentation::tab' or `indentation::space'." - :type '(cons (regexp :tag "Indentation SPACEs") - (regexp :tag "Indentation TABs")) + :type '(cons (string :tag "Indentation SPACEs") + (string :tag "Indentation TABs")) :group 'whitespace) (defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)" "Specify regexp for empty lines at beginning of buffer. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `empty'." :type '(regexp :tag "Empty Lines At Beginning Of Buffer") :group 'whitespace) @@ -876,13 +819,6 @@ Used when `whitespace-style' includes `empty'." (defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)" "Specify regexp for empty lines at end of buffer. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `empty'." :type '(regexp :tag "Empty Lines At End Of Buffer") :group 'whitespace) @@ -896,16 +832,10 @@ Used when `whitespace-style' includes `empty'." It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `space-after-tab', `space-after-tab::tab' or `space-after-tab::space'." - :type '(regexp :tag "SPACEs After TAB") + :type '(cons (string :tag "SPACEs After TAB") + string) :group 'whitespace) @@ -1145,29 +1075,31 @@ See also `whitespace-style', `whitespace-newline' and (unless whitespace-mode (whitespace-turn-off))))))) +(defvar whitespace-enable-predicate + (lambda () + (and (cond + ((eq whitespace-global-modes t)) + ((listp whitespace-global-modes) + (if (eq (car-safe whitespace-global-modes) 'not) + (not (memq major-mode (cdr whitespace-global-modes))) + (memq major-mode whitespace-global-modes))) + (t nil)) + ;; ...we have a display (not running a batch job) + (not noninteractive) + ;; ...the buffer is not internal (name starts with a space) + (not (eq (aref (buffer-name) 0) ?\ )) + ;; ...the buffer is not special (name starts with *) + (or (not (eq (aref (buffer-name) 0) ?*)) + ;; except the scratch buffer. + (string= (buffer-name) "*scratch*")))) + "Predicate to decide which buffers obey `global-whitespace-mode'. +This function is called with no argument and should return non-nil +if the current buffer should obey `global-whitespace-mode'. +This variable is normally modified via `add-function'.") (defun whitespace-turn-on-if-enabled () - (when (cond - ((eq whitespace-global-modes t)) - ((listp whitespace-global-modes) - (if (eq (car-safe whitespace-global-modes) 'not) - (not (memq major-mode (cdr whitespace-global-modes))) - (memq major-mode whitespace-global-modes))) - (t nil)) - (let (inhibit-quit) - ;; Don't turn on whitespace mode if... - (or - ;; ...we don't have a display (we're running a batch job) - noninteractive - ;; ...or if the buffer is invisible (name starts with a space) - (eq (aref (buffer-name) 0) ?\ ) - ;; ...or if the buffer is temporary (name starts with *) - (and (eq (aref (buffer-name) 0) ?*) - ;; except the scratch buffer. - (not (string= (buffer-name) "*scratch*"))) - ;; Otherwise, turn on whitespace mode. - (whitespace-turn-on))))) - + (when (funcall whitespace-enable-predicate) + (whitespace-turn-on))) ;;;###autoload (define-minor-mode global-whitespace-newline-mode @@ -1539,6 +1471,12 @@ documentation." ;; PROBLEM 6: 8 or more SPACEs after TAB (whitespace-cleanup-region (point-min) (point-max))))) +(defun whitespace-ensure-local-variables () + "Set `whitespace-indent-tabs-mode' and `whitespace-tab-width' locally." + (set (make-local-variable 'whitespace-indent-tabs-mode) + indent-tabs-mode) + (set (make-local-variable 'whitespace-tab-width) + tab-width)) ;;;###autoload (defun whitespace-cleanup-region (start end) @@ -1585,6 +1523,7 @@ documentation." ;; read-only buffer (whitespace-warn-read-only "cleanup region") ;; non-read-only buffer + (whitespace-ensure-local-variables) (let ((rstart (min start end)) (rend (copy-marker (max start end))) (indent-tabs-mode whitespace-indent-tabs-mode) @@ -1930,14 +1869,8 @@ cleaning up these problems." ;;;; Internal functions -(defvar whitespace-font-lock-mode nil - "Used to remember whether a buffer had font lock mode on or not.") - -(defvar whitespace-font-lock nil - "Used to remember whether a buffer initially had font lock on or not.") - (defvar whitespace-font-lock-keywords nil - "Used to save locally `font-lock-keywords' value.") + "Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.") (defconst whitespace-help-text @@ -2169,14 +2102,11 @@ resultant list will be returned." (defvar whitespace-display-table-was-local nil "Used to remember whether a buffer initially had a local display table.") - (defun whitespace-turn-on () "Turn on whitespace visualization." ;; prepare local hooks (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) ;; create whitespace local buffer environment - (set (make-local-variable 'whitespace-font-lock-mode) nil) - (set (make-local-variable 'whitespace-font-lock) nil) (set (make-local-variable 'whitespace-font-lock-keywords) nil) (set (make-local-variable 'whitespace-display-table) nil) (set (make-local-variable 'whitespace-display-table-was-local) nil) @@ -2184,10 +2114,7 @@ resultant list will be returned." (if (listp whitespace-style) whitespace-style (list whitespace-style))) - (set (make-local-variable 'whitespace-indent-tabs-mode) - indent-tabs-mode) - (set (make-local-variable 'whitespace-tab-width) - tab-width) + (whitespace-ensure-local-variables) ;; turn on whitespace (when whitespace-active-style (whitespace-color-on) @@ -2226,10 +2153,6 @@ resultant list will be returned." (defun whitespace-color-on () "Turn on color visualization." (when (whitespace-style-face-p) - (unless whitespace-font-lock - (setq whitespace-font-lock t - whitespace-font-lock-keywords - (copy-sequence font-lock-keywords))) ;; save current point and refontify when necessary (set (make-local-variable 'whitespace-point) (point)) @@ -2243,163 +2166,100 @@ resultant list will be returned." nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) - ;; turn off font lock - (set (make-local-variable 'whitespace-font-lock-mode) - font-lock-mode) - (font-lock-mode 0) - ;; add whitespace-mode color into font lock - (when (memq 'spaces whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs - (list whitespace-space-regexp 1 whitespace-space t) - ;; Show HARD SPACEs - (list whitespace-hspace-regexp 1 whitespace-hspace t)) - t)) - (when (memq 'tabs whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show TABs - (list whitespace-tab-regexp 1 whitespace-tab t)) - t)) - (when (memq 'trailing whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show trailing blanks - (list #'whitespace-trailing-regexp 1 whitespace-trailing t)) - t)) - (when (or (memq 'lines whitespace-active-style) - (memq 'lines-tail whitespace-active-style)) - (font-lock-add-keywords - nil - (list - ;; Show "long" lines - (list - (let ((line-column (or whitespace-line-column fill-column))) - (format - "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" - whitespace-tab-width - (1- whitespace-tab-width) - (/ line-column whitespace-tab-width) - (let ((rem (% line-column whitespace-tab-width))) - (if (zerop rem) - "" - (format ".\\{%d\\}" rem))))) - (if (memq 'lines whitespace-active-style) - 0 ; whole line - 2) ; line tail - whitespace-line t)) - t)) - (cond - ((memq 'space-before-tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (indent-tabs-mode) - (list whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 1 2) - whitespace-space-before-tab t)) - t)) - ((memq 'space-before-tab::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (SPACEs) - (list whitespace-space-before-tab-regexp - 1 whitespace-space-before-tab t)) - t)) - ((memq 'space-before-tab::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (TABs) - (list whitespace-space-before-tab-regexp - 2 whitespace-space-before-tab t)) - t))) - (cond - ((memq 'indentation whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (indent-tabs-mode) - (list (whitespace-indentation-regexp) - 1 whitespace-indentation t)) - t)) - ((memq 'indentation::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (SPACEs) - (list (whitespace-indentation-regexp 'tab) - 1 whitespace-indentation t)) - t)) - ((memq 'indentation::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (TABs) - (list (whitespace-indentation-regexp 'space) - 1 whitespace-indentation t)) - t))) - (when (memq 'empty whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at beginning of buffer - (list #'whitespace-empty-at-bob-regexp - 1 whitespace-empty t)) - t) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at end of buffer - (list #'whitespace-empty-at-eob-regexp - 1 whitespace-empty t)) - t)) - (cond - ((memq 'space-after-tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (indent-tabs-mode) - (list (whitespace-space-after-tab-regexp) - 1 whitespace-space-after-tab t)) - t)) - ((memq 'space-after-tab::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (SPACEs) - (list (whitespace-space-after-tab-regexp 'tab) - 1 whitespace-space-after-tab t)) - t)) - ((memq 'space-after-tab::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (TABs) - (list (whitespace-space-after-tab-regexp 'space) - 1 whitespace-space-after-tab t)) - t))) - ;; now turn on font lock and highlight blanks - (font-lock-mode 1))) + ;; Add whitespace-mode color into font lock. + (setq + whitespace-font-lock-keywords + `( + ,@(when (memq 'spaces whitespace-active-style) + ;; Show SPACEs. + `((,whitespace-space-regexp 1 whitespace-space t) + ;; Show HARD SPACEs. + (,whitespace-hspace-regexp 1 whitespace-hspace t))) + ,@(when (memq 'tabs whitespace-active-style) + ;; Show TABs. + `((,whitespace-tab-regexp 1 whitespace-tab t))) + ,@(when (memq 'trailing whitespace-active-style) + ;; Show trailing blanks. + `((,#'whitespace-trailing-regexp 1 whitespace-trailing t))) + ,@(when (or (memq 'lines whitespace-active-style) + (memq 'lines-tail whitespace-active-style)) + ;; Show "long" lines. + `((,(let ((line-column (or whitespace-line-column fill-column))) + (format + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + whitespace-tab-width + (1- whitespace-tab-width) + (/ line-column whitespace-tab-width) + (let ((rem (% line-column whitespace-tab-width))) + (if (zerop rem) + "" + (format ".\\{%d\\}" rem))))) + ,(if (memq 'lines whitespace-active-style) + 0 ; whole line + 2) ; line tail + whitespace-line prepend))) + ,@(when (or (memq 'space-before-tab whitespace-active-style) + (memq 'space-before-tab::tab whitespace-active-style) + (memq 'space-before-tab::space whitespace-active-style)) + `((,whitespace-space-before-tab-regexp + ,(cond + ((memq 'space-before-tab whitespace-active-style) + ;; Show SPACEs before TAB (indent-tabs-mode). + (if whitespace-indent-tabs-mode 1 2)) + ((memq 'space-before-tab::tab whitespace-active-style) + 1) + ((memq 'space-before-tab::space whitespace-active-style) + 2)) + whitespace-space-before-tab t))) + ,@(when (or (memq 'indentation whitespace-active-style) + (memq 'indentation::tab whitespace-active-style) + (memq 'indentation::space whitespace-active-style)) + `((,(cond + ((memq 'indentation whitespace-active-style) + ;; Show indentation SPACEs (indent-tabs-mode). + (whitespace-indentation-regexp)) + ((memq 'indentation::tab whitespace-active-style) + ;; Show indentation SPACEs (SPACEs). + (whitespace-indentation-regexp 'tab)) + ((memq 'indentation::space whitespace-active-style) + ;; Show indentation SPACEs (TABs). + (whitespace-indentation-regexp 'space))) + 1 whitespace-indentation t))) + ,@(when (memq 'empty whitespace-active-style) + ;; Show empty lines at beginning of buffer. + `((,#'whitespace-empty-at-bob-regexp + 1 whitespace-empty t) + ;; Show empty lines at end of buffer. + (,#'whitespace-empty-at-eob-regexp + 1 whitespace-empty t))) + ,@(when (or (memq 'space-after-tab whitespace-active-style) + (memq 'space-after-tab::tab whitespace-active-style) + (memq 'space-after-tab::space whitespace-active-style)) + `((,(cond + ((memq 'space-after-tab whitespace-active-style) + ;; Show SPACEs after TAB (indent-tabs-mode). + (whitespace-space-after-tab-regexp)) + ((memq 'space-after-tab::tab whitespace-active-style) + ;; Show SPACEs after TAB (SPACEs). + (whitespace-space-after-tab-regexp 'tab)) + ((memq 'space-after-tab::space whitespace-active-style) + ;; Show SPACEs after TAB (TABs). + (whitespace-space-after-tab-regexp 'space))) + 1 whitespace-space-after-tab t))))) + (font-lock-add-keywords nil whitespace-font-lock-keywords t) + (when font-lock-mode + (font-lock-fontify-buffer)))) (defun whitespace-color-off () "Turn off color visualization." ;; turn off font lock (when (whitespace-style-face-p) - (font-lock-mode 0) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) - (when whitespace-font-lock - (setq whitespace-font-lock nil - font-lock-keywords whitespace-font-lock-keywords)) - ;; restore original font lock state - (font-lock-mode whitespace-font-lock-mode))) + (font-lock-remove-keywords nil whitespace-font-lock-keywords) + (when font-lock-mode + (font-lock-fontify-buffer)))) (defun whitespace-trailing-regexp (limit) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index caf41427538..4394c29ea1b 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -1,6 +1,6 @@ ;;; wid-browse.el --- functions for browsing widgets ;; -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: extensions diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index fb62b039d79..a857407820c 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,9 +1,9 @@ ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*- ;; -;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 1999-2014 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: extensions ;; Package: emacs @@ -55,6 +55,7 @@ ;; See `widget.el'. ;;; Code: +(require 'cl-lib) ;;; Compatibility. @@ -221,7 +222,7 @@ minibuffer." ((or widget-menu-minibuffer-flag (> (length items) widget-menu-max-shortcuts)) ;; Read the choice of name from the minibuffer. - (setq items (widget-remove-if 'stringp items)) + (setq items (cl-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -295,14 +296,6 @@ minibuffer." (error "Canceled")) value)))) -(defun widget-remove-if (predicate list) - (let (result (tail list)) - (while tail - (or (funcall predicate (car tail)) - (setq result (cons (car tail) result))) - (setq tail (cdr tail))) - (nreverse result))) - ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. @@ -528,6 +521,7 @@ Otherwise, just return the value." (or (widget-get widget :value) (progn (when (widget-get widget :args) + (setq widget (widget-copy widget)) (let (args) (dolist (arg (widget-get widget :args)) (setq args (append args @@ -3468,14 +3462,14 @@ To use this type, you must define :match or :match-alternatives." ;; Recursive datatypes. (define-widget 'lazy 'default - "Base widget for recursive datastructures. + "Base widget for recursive data structures. The `lazy' widget will, when instantiated, contain a single inferior widget, of the widget type specified by the :type parameter. The value of the `lazy' widget is the same as the value of the inferior widget. When deriving a new widget from the 'lazy' widget, the :type parameter is allowed to refer to the widget currently being defined, -thus allowing recursive datastructures to be described. +thus allowing recursive data structures to be described. The :type parameter takes the same arguments as the defcustom parameter with the same name. @@ -3485,7 +3479,7 @@ not allow recursion. That is, when you define a new widget type, none of the inferior widgets may be of the same type you are currently defining. -In Lisp, however, it is custom to define datastructures in terms of +In Lisp, however, it is custom to define data structures in terms of themselves. A list, for example, is defined as either nil, or a cons cell whose cdr itself is a list. The obvious way to translate this into a widget type would be @@ -3508,7 +3502,7 @@ example: :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))" :format "%{%t%}: %v" ;; We don't convert :type because we want to allow recursive - ;; datastructures. This is slow, so we should not create speed + ;; data structures. This is slow, so we should not create speed ;; critical widgets by deriving from this. :convert-widget 'widget-value-convert-widget :value-create 'widget-type-value-create diff --git a/lisp/widget.el b/lisp/widget.el index 917dde61872..f82b275385f 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -1,10 +1,9 @@ ;;; widget.el --- a library of user interface components ;; -;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 2001-2014 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9920 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; Package: emacs diff --git a/lisp/windmove.el b/lisp/windmove.el index 01ae1804d01..ff41ebbbcd5 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -1,6 +1,6 @@ ;;; windmove.el --- directional window-selection routines ;; -;; Copyright (C) 1998-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; ;; Author: Hovav Shacham (hovav@cs.stanford.edu) ;; Created: 17 October 1998 @@ -459,24 +459,17 @@ movement is relative to." windmove-window-distance-delta))) ; (x, y1+d-1) (t (error "Invalid direction of movement: %s" dir))))) +;; Rewritten on 2013-12-13 using `window-in-direction'. After the +;; pixelwise change the old approach didn't work any more. martin (defun windmove-find-other-window (dir &optional arg window) "Return the window object in direction DIR. DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'." - (let* ((actual-current-window (or window (selected-window))) - (raw-other-window-loc - (windmove-other-window-loc dir arg actual-current-window)) - (constrained-other-window-loc - (windmove-constrain-loc-for-movement raw-other-window-loc - actual-current-window - dir)) - (other-window-loc - (if windmove-wrap-around - (windmove-wrap-loc-for-movement constrained-other-window-loc - actual-current-window) - constrained-other-window-loc))) - (window-at (car other-window-loc) - (cdr other-window-loc)))) - + (window-in-direction + (cond + ((eq dir 'up) 'above) + ((eq dir 'down) 'below) + (t dir)) + window nil arg windmove-wrap-around t)) ;; Selects the window that's hopefully at the location returned by ;; `windmove-other-window-loc', or screams if there's no window there. diff --git a/lisp/window.el b/lisp/window.el index 627b9a425eb..72b3138fd73 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,9 +1,9 @@ ;;; window.el --- GNU Emacs window commands aside from those written in C -;; Copyright (C) 1985, 1989, 1992-1994, 2000-2013 Free Software +;; Copyright (C) 1985, 1989, 1992-1994, 2000-2014 Free Software ;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -189,8 +189,8 @@ argument replaces this)." `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) (standard-output ,buffer) ,window ,value) + (setq ,value (progn ,@body)) (with-current-buffer ,buffer - (setq ,value (progn ,@body)) (setq ,window (temp-buffer-window-show ,buffer ,action))) (if (functionp ,quit-function) @@ -279,6 +279,28 @@ Otherwise, signal an error." (t (error "%s is not a valid window" window)))) +;; Maybe this should go to frame.el. +(defun frame-char-size (&optional window-or-frame horizontal) + "Return the value of `frame-char-height' for WINDOW-OR-FRAME. +If WINDOW-OR-FRAME is a live frame, return the value of +`frame-char-height' for that frame. If WINDOW-OR-FRAME is a +valid window, return the value of `frame-char-height' for that +window's frame. In any other case, return the value of +`frame-char-height' for the selected frame. + +Optional argument HORIZONTAL non-nil means to return the value of +`frame-char-width' for WINDOW-OR-FRAME." + (let ((frame + (cond + ((window-valid-p window-or-frame) + (window-frame window-or-frame)) + ((frame-live-p window-or-frame) + window-or-frame) + (t (selected-frame))))) + (if horizontal + (frame-char-width frame) + (frame-char-height frame)))) + (defvar ignore-window-parameters nil "If non-nil, standard functions ignore window parameters. The functions currently affected by this are `split-window', @@ -287,10 +309,16 @@ The functions currently affected by this are `split-window', An application may bind this to a non-nil value around calls to these functions to inhibit processing of window parameters.") +;; This must go to C, finally (or get removed). (defconst window-safe-min-height 1 - "The absolute minimum number of lines of a window. + "The absolute minimum number of lines of any window. Anything less might crash Emacs.") +(defun window-safe-min-pixel-height (&optional window) + "Return the absolute minimum pixel height of WINDOW." + (* window-safe-min-height + (frame-char-size (window-normalize-window window)))) + (defcustom window-min-height 4 "The minimum number of lines of any window. The value has to accommodate a mode- or header-line if present. @@ -306,10 +334,21 @@ shorter, explicitly specify the SIZE argument of that function." :version "24.1" :group 'windows) +(defun window-min-pixel-height (&optional window) + "Return the minimum pixel height of window WINDOW." + (* (max window-min-height window-safe-min-height) + (frame-char-size window))) + +;; This must go to C, finally (or get removed). (defconst window-safe-min-width 2 "The absolute minimum number of columns of a window. Anything less might crash Emacs.") +(defun window-safe-min-pixel-width (&optional window) + "Return the absolute minimum pixel width of WINDOW." + (* window-safe-min-width + (frame-char-size (window-normalize-window window) t))) + (defcustom window-min-width 10 "The minimum number of columns of any window. The value has to accommodate margins, fringes, or scrollbars if @@ -326,15 +365,27 @@ narrower, explicitly specify the SIZE argument of that function." :version "24.1" :group 'windows) +(defun window-min-pixel-width (&optional window) + "Return the minimum pixel width of window WINDOW." + (* (max window-min-width window-safe-min-width) + (frame-char-size window t))) + +(defun window-safe-min-pixel-size (&optional window horizontal) + "Return the absolute minimum pixel height of WINDOW. +Optional argument HORIZONTAL non-nil means return the absolute +minimum pixel width of WINDOW." + (if horizontal + (window-safe-min-pixel-width window) + (window-safe-min-pixel-height window))) + (defun window-combined-p (&optional window horizontal) "Return non-nil if WINDOW has siblings in a given direction. WINDOW must be a valid window and defaults to the selected one. -HORIZONTAL determines a direction for the window combination. -If HORIZONTAL is omitted or nil, return non-nil if WINDOW is part -of a vertical window combination. -If HORIZONTAL is non-nil, return non-nil if WINDOW is part of a -horizontal window combination." +HORIZONTAL determines a direction for the window combination. If +HORIZONTAL is omitted or nil, return non-nil if WINDOW is part of +a vertical window combination. If HORIZONTAL is non-nil, return +non-nil if WINDOW is part of a horizontal window combination." (setq window (window-normalize-window window)) (let ((parent (window-parent window))) (and parent @@ -342,6 +393,16 @@ horizontal window combination." (window-left-child parent) (window-top-child parent))))) +(defun window-combination-p (&optional window horizontal) + "Return WINDOW's first child if WINDOW is a vertical combination. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return WINDOW's first +child if WINDOW is a horizontal combination." + (setq window (window-normalize-window window)) + (if horizontal + (window-left-child window) + (window-top-child window))) + (defun window-combinations (window &optional horizontal) "Return largest number of windows vertically arranged within WINDOW. WINDOW must be a valid window and defaults to the selected one. @@ -477,7 +538,8 @@ WINDOW must be an internal window. Return WINDOW." (error "Window %s is not an internal window" window) (walk-window-subtree (lambda (window) - (set-window-parameter window 'window-atom t)) + (unless (window-parameter window 'window-atom) + (set-window-parameter window 'window-atom t))) window t) window)) @@ -498,24 +560,39 @@ following symbols can be used. sibling of an atomic window's root. If an internal window is specified here, all children of that window become part of the atomic window too. If no window is specified, the new window - becomes a sibling of the selected window. + becomes a sibling of the selected window. By default, the + `window-atom' parameter of the existing window is set to `main' + provided it is live and was not set before. `side' denotes the side of the existing window where the new window shall be located. Valid values are `below', `right', - `above' and `left'. The default is `below'. + `above' and `left'. The default is `below'. By default, the + `window-atom' parameter of the new window is set to this value. The return value is the new window, nil when creating that window failed." - (let ((ignore-window-parameters t) - (window-combination-limit t) - (window (cdr (assq 'window alist))) - (side (cdr (assq 'side alist))) - new) + (let* ((ignore-window-parameters t) + (window-combination-limit t) + (window-combination-resize 'atom) + (window (cdr (assq 'window alist))) + (side (cdr (assq 'side alist))) + (atom (when window (window-parameter window 'window-atom))) + root new) (setq window (window-normalize-window window)) - ;; Split off new window + (setq root (window-atom-root window)) + ;; Split off new window. (when (setq new (split-window window nil side)) - ;; Make sure we have a valid atomic window. - (window-make-atom (window-parent window)) + (window-make-atom + (if (and root (not (eq root window))) + ;; When WINDOW was part of an atomic window and we did not + ;; split its root, root atomic window at old root. + root + ;; Otherwise, root atomic window at WINDOW's new parent. + (window-parent window))) + ;; Assign `window-atom' parameters, if needed. + (when (and (not atom) (window-live-p window)) + (set-window-parameter window 'window-atom 'main)) + (set-window-parameter new 'window-atom side) ;; Display BUFFER in NEW and return NEW. (window--display-buffer buffer new 'window alist display-buffer-mark-dedicated)))) @@ -631,7 +708,7 @@ its root window." (and (setq sibling (window-next-sibling window)) (window-parameter sibling 'window-side))) (setq major window))) - frame t) + frame t 'nomini) (or major (frame-root-window frame)))) (defun window--major-side-window (side) @@ -685,10 +762,8 @@ symbols and values as passed to `display-buffer-in-side-window'. This function may be called only if no window on SIDE exists yet. The new window automatically becomes the \"major\" side window on SIDE. Return the new window, nil if its creation window failed." - (let* ((root (frame-root-window)) - (left-or-right (memq side '(left right))) + (let* ((left-or-right (memq side '(left right))) (major (window--major-side-window side)) - (selected-window (selected-window)) (on-side (cond ((eq side 'top) 'above) ((eq side 'bottom) 'below) @@ -698,8 +773,7 @@ SIDE. Return the new window, nil if its creation window failed." ;; parent window unless needed. (window-combination-resize 'side) (window-combination-limit nil) - (new (split-window major nil on-side)) - fun) + (new (split-window major nil on-side))) (when new ;; Initialize `window-side' parameter of new window to SIDE. (set-window-parameter new 'window-side side) @@ -719,8 +793,8 @@ SIDE. Return the new window, nil if its creation window failed." (cons (if left-or-right 'window-width 'window-height) (/ (window-total-size (frame-root-window) left-or-right) - ;; By default use a fourth of the size of the - ;; frame's root window. + ;; By default use a fourth of the size of the frame's + ;; root window. 4)) alist))) ;; Install BUFFER in new window and return NEW. @@ -734,13 +808,13 @@ SIDE. Return the new window, nil if its creation window failed." (delete-window window))) (defun display-buffer-in-side-window (buffer alist) - "Display BUFFER in a window on side SIDE of the selected frame. + "Display BUFFER in a side window of the selected frame. ALIST is an association list of symbols and values. The -following symbols can be used: +following special symbols can be used in ALIST. -`side' denotes the side of the existing window where the new - window shall be located. Valid values are `bottom', `right', - `top' and `left'. The default is `bottom'. +`side' denotes the side of the frame where the new window shall + be located. Valid values are `bottom', `right', `top' and + `left'. The default is `bottom'. `slot' if non-nil, specifies the window slot where to display BUFFER. A value of zero or nil means use the middle slot on @@ -749,8 +823,7 @@ following symbols can be used: A positive value means use a slot following (that is, below or on the right of) the middle slot. The default is zero." (let ((side (or (cdr (assq 'side alist)) 'bottom)) - (slot (or (cdr (assq 'slot alist)) 0)) - new) + (slot (or (cdr (assq 'slot alist)) 0))) (cond ((not (memq side '(top bottom left right))) (error "Invalid side %s specified" side)) @@ -766,7 +839,8 @@ following symbols can be used: (walk-window-tree (lambda (window) (when (eq (window-parameter window 'window-side) side) - (setq windows (cons window windows))))) + (setq windows (cons window windows)))) + nil nil 'nomini) (nreverse windows)))) (slots (when major (max 1 (window-child-count major)))) (max-slots @@ -776,9 +850,8 @@ following symbols can be used: ((eq side 'right) 2) ((eq side 'bottom) 3)) window-sides-slots)) - (selected-window (selected-window)) window this-window this-slot prev-window next-window - best-window best-slot abs-slot new-window) + best-window best-slot abs-slot) (cond ((and (numberp max-slots) (<= max-slots 0)) @@ -924,14 +997,14 @@ of all windows on FRAME to nil." (if bottom (throw 'reset t) (setq bottom t))) (t (throw 'reset t)))) - frame t)) + frame t 'nomini)) ;; If there's a side window, there must be at least one ;; non-side window. (and (or left top right bottom) (not none))) (walk-window-tree (lambda (window) (set-window-parameter window 'window-side nil)) - frame t)))) + frame t 'nomini)))) (defun window--check (&optional frame) "Check atomic and side windows on FRAME. @@ -939,7 +1012,121 @@ FRAME defaults to the selected frame." (window--side-check frame) (window--atom-check frame)) +;; Dumping frame/window contents. +(defun window--dump-window (&optional window erase) + "Dump WINDOW to buffer *window-frame-dump*. +WINDOW must be a valid window and defaults to the selected one. +Optional argument ERASE non-nil means erase *window-frame-dump* +before writing to it." + (setq window (window-normalize-window window)) + (with-current-buffer (get-buffer-create "*window-frame-dump*") + (when erase (erase-buffer)) + (insert + (format "%s parent: %s\n" window (window-parent window)) + (format "pixel left: %s top: %s size: %s x %s new: %s\n" + (window-pixel-left window) (window-pixel-top window) + (window-size window t t) (window-size window nil t) + (window-new-pixel window)) + (format "char left: %s top: %s size: %s x %s new: %s\n" + (window-left-column window) (window-top-line window) + (window-total-size window t) (window-total-size window) + (window-new-total window)) + (format "normal: %s x %s new: %s\n" + (window-normal-size window t) (window-normal-size window) + (window-new-normal window))) + (when (window-live-p window) + (let ((fringes (window-fringes window)) + (margins (window-margins window))) + (insert + (format "body pixel: %s x %s char: %s x %s\n" + (window-body-width window t) (window-body-height window t) + (window-body-width window) (window-body-height window)) + (format "width left fringe: %s left margin: %s right margin: %s\n" + (car fringes) (or (car margins) 0) (or (cdr margins) 0)) + (format "width right fringe: %s scroll-bar: %s divider: %s\n" + (cadr fringes) + (window-scroll-bar-width window) + (window-right-divider-width window)) + (format "height header-line: %s mode-line: %s divider: %s\n" + (window-header-line-height window) + (window-mode-line-height window) + (window-bottom-divider-width window))))) + (insert "\n"))) + +(defun window--dump-frame (&optional window-or-frame) + "Dump WINDOW-OR-FRAME to buffer *window-frame-dump*. +WINDOW-OR-FRAME can be a frame or a window and defaults to the +selected frame. When WINDOW-OR-FRAME is a window, dump that +window's frame. The buffer *window-frame-dump* is erased before +dumping to it." + (interactive) + (let* ((window + (cond + ((or (not window-or-frame) + (frame-live-p window-or-frame)) + (frame-root-window window-or-frame)) + ((or (window-live-p window-or-frame) + (window-child window-or-frame)) + window-or-frame) + (t + (frame-root-window)))) + (frame (window-frame window))) + (with-current-buffer (get-buffer-create "*window-frame-dump*") + (erase-buffer) + (insert + (format "frame pixel: %s x %s cols/lines: %s x %s units: %s x %s\n" + (frame-pixel-width frame) (frame-pixel-height frame) + (frame-total-cols frame) (frame-text-lines frame) ; (frame-total-lines frame) + (frame-char-width frame) (frame-char-height frame)) + (format "frame text pixel: %s x %s cols/lines: %s x %s\n" + (frame-text-width frame) (frame-text-height frame) + (frame-text-cols frame) (frame-text-lines frame)) + (format "tool: %s scroll: %s fringe: %s border: %s right: %s bottom: %s\n\n" + (tool-bar-height frame t) + (frame-scroll-bar-width frame) + (frame-fringe-width frame) + (frame-border-width frame) + (frame-right-divider-width frame) + (frame-bottom-divider-width frame))) + (walk-window-tree 'window--dump-window frame t t)))) + ;;; Window sizes. +(defun window-total-size (&optional window horizontal round) + "Return the total height or width of WINDOW. +WINDOW must be a valid window and defaults to the selected one. + +If HORIZONTAL is omitted or nil, return the total height of +WINDOW, in lines, like `window-total-height'. Otherwise return +the total width, in columns, like `window-total-width'. + +Optional argument ROUND is handled as for `window-total-height' +and `window-total-width'." + (if horizontal + (window-total-width window round) + (window-total-height window round))) + +(defun window-size (&optional window horizontal pixelwise round) + "Return the height or width of WINDOW. +WINDOW must be a valid window and defaults to the selected one. + +If HORIZONTAL is omitted or nil, return the total height of +WINDOW, in lines, like `window-total-height'. Otherwise return +the total width, in columns, like `window-total-width'. + +Optional argument PIXELWISE means return the pixel size of WINDOW +like `window-pixel-height' and `window-pixel-width'. + +Optional argument ROUND is ignored if PIXELWISE is non-nil and +handled as for `window-total-height' and `window-total-width' +otherwise." + (if horizontal + (if pixelwise + (window-pixel-width window) + (window-total-width window round)) + (if pixelwise + (window-pixel-height window) + (window-total-height window round)))) + (defvar window-size-fixed nil "Non-nil in a buffer means windows displaying the buffer are fixed-size. If the value is `height', then only the window's height is fixed. @@ -955,7 +1142,25 @@ window).") "Return non-nil if IGNORE says to ignore size restrictions for WINDOW." (if (window-valid-p ignore) (eq window ignore) ignore)) -(defun window-min-size (&optional window horizontal ignore) +(defun window-safe-min-size (&optional window horizontal pixelwise) + "Return safe minimum size of WINDOW. +WINDOW must be a valid window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return the minimum +number of columns of WINDOW; otherwise return the minimum number +of WINDOW's lines. + +Optional argument PIXELWISE non-nil means return the minimum pixel-size +of WINDOW." + (setq window (window-normalize-window window)) + (if pixelwise + (if horizontal + (* window-safe-min-width + (frame-char-width (window-frame window))) + (* window-safe-min-height + (frame-char-height (window-frame window)))) + (if horizontal window-safe-min-width window-safe-min-height))) + +(defun window-min-size (&optional window horizontal ignore pixelwise) "Return the minimum size of WINDOW. WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return the minimum @@ -968,11 +1173,14 @@ imposed by fixed size windows, `window-min-height' or windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. If IGNORE is a window, ignore restrictions for that window only. Any other non-nil value -means ignore all of the above restrictions for all windows." - (window--min-size-1 - (window-normalize-window window) horizontal ignore)) +means ignore all of the above restrictions for all windows. -(defun window--min-size-1 (window horizontal ignore) +Optional argument PIXELWISE non-nil means return the minimum pixel-size +of WINDOW." + (window--min-size-1 + (window-normalize-window window) horizontal ignore pixelwise)) + +(defun window--min-size-1 (window horizontal ignore pixelwise) "Internal function of `window-min-size'." (let ((sub (window-child window))) (if sub @@ -983,13 +1191,15 @@ means ignore all of the above restrictions for all windows." ;; the minimum sizes of its child windows. (while sub (setq value (+ value - (window--min-size-1 sub horizontal ignore))) + (window--min-size-1 + sub horizontal ignore pixelwise))) (setq sub (window-right sub))) - ;; The minimum size of an ortho-combination is the maximum of - ;; the minimum sizes of its child windows. + ;; The minimum size of an ortho-combination is the maximum + ;; of the minimum sizes of its child windows. (while sub (setq value (max value - (window--min-size-1 sub horizontal ignore))) + (window--min-size-1 + sub horizontal ignore pixelwise))) (setq sub (window-right sub)))) value) (with-current-buffer (window-buffer window) @@ -997,10 +1207,10 @@ means ignore all of the above restrictions for all windows." ((and (not (window--size-ignore-p window ignore)) (window-size-fixed-p window horizontal)) ;; The minimum size of a fixed size window is its size. - (window-total-size window horizontal)) + (window-size window horizontal pixelwise)) ((or (eq ignore 'safe) (eq ignore window)) ;; If IGNORE equals `safe' or WINDOW return the safe values. - (if horizontal window-safe-min-width window-safe-min-height)) + (window-safe-min-size window horizontal pixelwise)) (horizontal ;; For the minimum width of a window take fringes and ;; scroll-bars into account. This is questionable and should @@ -1008,37 +1218,48 @@ means ignore all of the above restrictions for all windows." ;; windows such that the new (or resized) windows can get a ;; size less than the user-specified `window-min-height' and ;; `window-min-width'. - (let ((frame (window-frame window)) - (fringes (window-fringes window)) - (scroll-bars (window-scroll-bars window))) - (max - (+ window-safe-min-width - (ceiling (car fringes) (frame-char-width frame)) - (ceiling (cadr fringes) (frame-char-width frame)) - (cond - ((memq (nth 2 scroll-bars) '(left right)) - (nth 1 scroll-bars)) - ((memq (frame-parameter frame 'vertical-scroll-bars) - '(left right)) - (ceiling (or (frame-parameter frame 'scroll-bar-width) 14) - (frame-char-width))) - (t 0))) - (if (and (not (window--size-ignore-p window ignore)) - (numberp window-min-width)) - window-min-width - 0)))) - (t - ;; For the minimum height of a window take any mode- or - ;; header-line into account. - (max (+ window-safe-min-height - (if header-line-format 1 0) - (if mode-line-format 1 0)) - (if (and (not (window--size-ignore-p window ignore)) - (numberp window-min-height)) - window-min-height - 0)))))))) + (let* ((char-size (frame-char-size window t)) + (fringes (window-fringes window)) + (pixel-width + (+ (window-safe-min-size window t t) + (car fringes) (cadr fringes) + (window-scroll-bar-width window) + (window-right-divider-width window)))) + (if pixelwise + (max + (if window-resize-pixelwise + pixel-width + ;; Round up to next integral of columns. + (* (ceiling pixel-width char-size) char-size)) + (if (window--size-ignore-p window ignore) + 0 + (window-min-pixel-width))) + (max + (ceiling pixel-width char-size) + (if (window--size-ignore-p window ignore) + 0 + window-min-width))))) + ((let ((char-size (frame-char-size window)) + (pixel-height + (+ (window-safe-min-size window nil t) + (window-header-line-height window) + (window-mode-line-height window) + (window-bottom-divider-width window)))) + (if pixelwise + (max + (if window-resize-pixelwise + pixel-height + ;; Round up to next integral of lines. + (* (ceiling pixel-height char-size) char-size)) + (if (window--size-ignore-p window ignore) + 0 + (window-min-pixel-height))) + (max (ceiling pixel-height char-size) + (if (window--size-ignore-p window ignore) + 0 + window-min-height)))))))))) -(defun window-sizable (window delta &optional horizontal ignore) +(defun window-sizable (window delta &optional horizontal ignore pixelwise) "Return DELTA if DELTA lines can be added to WINDOW. WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if DELTA @@ -1065,12 +1286,15 @@ imposed by fixed size windows, `window-min-height' or windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. If IGNORE is a window, ignore restrictions for that window only. Any other non-nil value means -ignore all of the above restrictions for all windows." +ignore all of the above restrictions for all windows. + +Optional argument PIXELWISE non-nil means interpret DELTA as +pixels." (setq window (window-normalize-window window)) (cond ((< delta 0) - (max (- (window-min-size window horizontal ignore) - (window-total-size window horizontal)) + (max (- (window-min-size window horizontal ignore pixelwise) + (window-size window horizontal pixelwise)) delta)) ((window--size-ignore-p window ignore) delta) @@ -1080,15 +1304,17 @@ ignore all of the above restrictions for all windows." delta)) (t 0))) -(defun window-sizable-p (window delta &optional horizontal ignore) +(defun window-sizable-p (window delta &optional horizontal ignore pixelwise) "Return t if WINDOW can be resized by DELTA lines. WINDOW must be a valid window and defaults to the selected one. For the meaning of the arguments of this function see the doc-string of `window-sizable'." (setq window (window-normalize-window window)) (if (> delta 0) - (>= (window-sizable window delta horizontal ignore) delta) - (<= (window-sizable window delta horizontal ignore) delta))) + (>= (window-sizable window delta horizontal ignore pixelwise) + delta) + (<= (window-sizable window delta horizontal ignore pixelwise) + delta))) (defun window--size-fixed-1 (window horizontal) "Internal function for `window-size-fixed-p'." @@ -1135,7 +1361,7 @@ WINDOW can be resized in the desired direction. The function (window--size-fixed-1 (window-normalize-window window) horizontal)) -(defun window--min-delta-1 (window delta &optional horizontal ignore trail noup) +(defun window--min-delta-1 (window delta &optional horizontal ignore trail noup pixelwise) "Internal function for `window-min-delta'." (if (not (window-parent window)) ;; If we can't go up, return zero. @@ -1166,14 +1392,17 @@ WINDOW can be resized in the desired direction. The function (unless (eq sub window) (setq delta (min delta - (- (window-total-size sub horizontal) - (window-min-size sub horizontal ignore))))) + (max (- (window-size sub horizontal pixelwise 'ceiling) + (window-min-size + sub horizontal ignore pixelwise)) + 0)))) (setq sub (window-right sub)))) (if noup delta - (window--min-delta-1 parent delta horizontal ignore trail)))))) + (window--min-delta-1 + parent delta horizontal ignore trail nil pixelwise)))))) -(defun window-min-delta (&optional window horizontal ignore trail noup nodown) +(defun window-min-delta (&optional window horizontal ignore trail noup nodown pixelwise) "Return number of lines by which WINDOW can be shrunk. WINDOW must be a valid window and defaults to the selected one. Return zero if WINDOW cannot be shrunk. @@ -1199,15 +1428,19 @@ tree, but try to enlarge windows within WINDOW's combination only. Optional argument NODOWN non-nil means don't check whether WINDOW itself (and its child windows) can be shrunk; check only whether -at least one other window can be enlarged appropriately." +at least one other window can be enlarged appropriately. + +Optional argument PIXELWISE non-nil means return number of pixels +by which WINDOW can be shrunk." (setq window (window-normalize-window window)) - (let ((size (window-total-size window horizontal)) - (minimum (window-min-size window horizontal ignore))) + (let ((size (window-size window horizontal pixelwise 'floor)) + (minimum (window-min-size window horizontal ignore pixelwise))) (cond (nodown ;; If NODOWN is t, try to recover the entire size of WINDOW. - (window--min-delta-1 window size horizontal ignore trail noup)) - ((= size minimum) + (window--min-delta-1 + window size horizontal ignore trail noup pixelwise)) + ((<= size minimum) ;; If NODOWN is nil and WINDOW's size is already at its minimum, ;; there's nothing to recover. 0) @@ -1215,9 +1448,9 @@ at least one other window can be enlarged appropriately." ;; Otherwise, try to recover whatever WINDOW is larger than its ;; minimum size. (window--min-delta-1 - window (- size minimum) horizontal ignore trail noup))))) + window (- size minimum) horizontal ignore trail noup pixelwise))))) -(defun window--max-delta-1 (window delta &optional horizontal ignore trail noup) +(defun window--max-delta-1 (window delta &optional horizontal ignore trail noup pixelwise) "Internal function of `window-max-delta'." (if (not (window-parent window)) ;; Can't go up. Return DELTA. @@ -1237,8 +1470,11 @@ at least one other window can be enlarged appropriately." (t (setq delta (+ delta - (- (window-total-size sub horizontal) - (window-min-size sub horizontal ignore)))))) + (max + (- (window-size sub horizontal pixelwise 'ceiling) + (window-min-size + sub horizontal ignore pixelwise)) + 0))))) (setq sub (window-right sub)))) ;; For an ortho-combination throw DELTA when at least one ;; child window is fixed-size. @@ -1253,9 +1489,10 @@ at least one other window can be enlarged appropriately." delta ;; Else try with parent of WINDOW, passing the DELTA we ;; recovered so far. - (window--max-delta-1 parent delta horizontal ignore trail)))))) + (window--max-delta-1 + parent delta horizontal ignore trail nil pixelwise)))))) -(defun window-max-delta (&optional window horizontal ignore trail noup nodown) +(defun window-max-delta (&optional window horizontal ignore trail noup nodown pixelwise) "Return maximum number of lines by which WINDOW can be enlarged. WINDOW must be a valid window and defaults to the selected one. The return value is zero if WINDOW cannot be enlarged. @@ -1282,7 +1519,10 @@ WINDOW's combination. Optional argument NODOWN non-nil means do not check whether WINDOW itself (and its child windows) can be enlarged; check -only whether other windows can be shrunk appropriately." +only whether other windows can be shrunk appropriately. + +Optional argument PIXELWISE non-nil means return number of +pixels by which WINDOW can be enlarged." (setq window (window-normalize-window window)) (if (and (not (window--size-ignore-p window ignore)) (not nodown) (window-size-fixed-p window horizontal)) @@ -1290,10 +1530,10 @@ only whether other windows can be shrunk appropriately." ;; size. 0 ;; WINDOW has no fixed size. - (window--max-delta-1 window 0 horizontal ignore trail noup))) + (window--max-delta-1 window 0 horizontal ignore trail noup pixelwise))) ;; Make NOUP also inhibit the min-size check. -(defun window--resizable (window delta &optional horizontal ignore trail noup nodown) +(defun window--resizable (window delta &optional horizontal ignore trail noup nodown pixelwise) "Return DELTA if WINDOW can be resized vertically by DELTA lines. WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if WINDOW @@ -1329,30 +1569,40 @@ to) WINDOW's siblings. Optional argument NODOWN non-nil means don't go down in the window tree. This means do not check whether resizing would -violate size restrictions of WINDOW or its child windows." +violate size restrictions of WINDOW or its child windows. + +Optional argument PIXELWISE non-nil means interpret DELTA as +number of pixels." (setq window (window-normalize-window window)) (cond ((< delta 0) - (max (- (window-min-delta window horizontal ignore trail noup nodown)) + (max (- (window-min-delta + window horizontal ignore trail noup nodown pixelwise)) delta)) ((> delta 0) - (min (window-max-delta window horizontal ignore trail noup nodown) + (min (window-max-delta + window horizontal ignore trail noup nodown pixelwise) delta)) (t 0))) -(defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown) +(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown pixelwise) "Return t if WINDOW can be resized vertically by DELTA lines. WINDOW must be a valid window and defaults to the selected one. For the meaning of the arguments of this function see the -doc-string of `window--resizable'." +doc-string of `window--resizable'. + +Optional argument PIXELWISE non-nil means interpret DELTA as +pixels." (setq window (window-normalize-window window)) (if (> delta 0) - (>= (window--resizable window delta horizontal ignore trail noup nodown) + (>= (window--resizable + window delta horizontal ignore trail noup nodown pixelwise) delta) - (<= (window--resizable window delta horizontal ignore trail noup nodown) + (<= (window--resizable + window delta horizontal ignore trail noup nodown pixelwise) delta))) -(defun window-resizable (window delta &optional horizontal ignore) +(defun window-resizable (window delta &optional horizontal ignore pixelwise) "Return DELTA if WINDOW can be resized vertically by DELTA lines. WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if WINDOW @@ -1375,23 +1625,32 @@ imposed by fixed size windows, `window-min-height' or restrictions for that window only. If IGNORE equals `safe', live windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. Any other non-nil value -means ignore all of the above restrictions for all windows." +means ignore all of the above restrictions for all windows. + +Optional argument PIXELWISE non-nil means interpret DELTA as +pixels." (setq window (window-normalize-window window)) - (window--resizable window delta horizontal ignore)) + (window--resizable window delta horizontal ignore nil nil nil pixelwise)) -(defun window-total-size (&optional window horizontal) - "Return the total height or width of WINDOW. +(defun window-resizable-p (window delta &optional horizontal ignore pixelwise) + "Return t if WINDOW can be resized vertically by DELTA lines. WINDOW must be a valid window and defaults to the selected one. +For the meaning of the arguments of this function see the +doc-string of `window-resizable'." + (setq window (window-normalize-window window)) + (if (> delta 0) + (>= (window--resizable + window delta horizontal ignore nil nil nil pixelwise) + delta) + (<= (window--resizable + window delta horizontal ignore nil nil nil pixelwise) + delta))) -If HORIZONTAL is omitted or nil, return the total height of -WINDOW, in lines, like `window-total-height'. Otherwise return -the total width, in columns, like `window-total-width'." - (if horizontal - (window-total-width window) - (window-total-height window))) - -;; Eventually we should make `window-height' obsolete. +;; Aliases of functions defined in window.c. (defalias 'window-height 'window-total-height) +(defalias 'window-width 'window-body-width) + +;; Eventually the following two should work pixelwise. ;; See discussion in bug#4543. (defun window-full-height-p (&optional window) @@ -1401,8 +1660,8 @@ WINDOW equals the total height of the root window of WINDOW's frame. WINDOW must be a valid window and defaults to the selected one." (setq window (window-normalize-window window)) - (= (window-total-size window) - (window-total-size (frame-root-window window)))) + (= (window-pixel-height window) + (window-pixel-height (frame-root-window window)))) (defun window-full-width-p (&optional window) "Return t if WINDOW is as wide as its containing frame. @@ -1410,8 +1669,8 @@ More precisely, return t if and only if the total width of WINDOW equals the total width of the root window of WINDOW's frame. WINDOW must be a valid window and defaults to the selected one." (setq window (window-normalize-window window)) - (= (window-total-size window t) - (window-total-size (frame-root-window window) t))) + (= (window-pixel-width window) + (window-pixel-width (frame-root-window window)))) (defun window-body-size (&optional window horizontal) "Return the height or width of WINDOW's text area. @@ -1424,9 +1683,6 @@ the text area, like `window-body-width'." (window-body-width window) (window-body-height window))) -;; Eventually we should make `window-height' obsolete. -(defalias 'window-width 'window-body-width) - (defun window-current-scroll-bars (&optional window) "Return the current scroll bar settings for WINDOW. WINDOW must be a live window and defaults to the selected one. @@ -1486,7 +1742,7 @@ This function changes neither the order of recently selected windows nor the buffer list." ;; If we start from the minibuffer window, don't fail to come ;; back to it. - (when (window-minibuffer-p (selected-window)) + (when (window-minibuffer-p) (setq minibuf t)) ;; Make sure to not mess up the order of recently selected ;; windows. Use `save-selected-window' and `select-window' @@ -1509,8 +1765,8 @@ SIDE can be any of the symbols `left', `top', `right' or ((eq side 'top) 1) ((eq side 'right) 2) ((memq side '(bottom nil)) 3)))) - (= (nth edge (window-edges window)) - (nth edge (window-edges (frame-root-window window)))))) + (= (nth edge (window-pixel-edges window)) + (nth edge (window-pixel-edges (frame-root-window window)))))) (defun window-at-side-list (&optional frame side) "Return list of all windows on SIDE of FRAME. @@ -1529,21 +1785,21 @@ SIDE can be any of the symbols `left', `top', `right' or (defun window--in-direction-2 (window posn &optional horizontal) "Support function for `window-in-direction'." (if horizontal - (let ((top (window-top-line window))) + (let ((top (window-pixel-top window))) (if (> top posn) (- top posn) - (- posn top (window-total-height window)))) - (let ((left (window-left-column window))) + (- posn top (window-pixel-height window)))) + (let ((left (window-pixel-left window))) (if (> left posn) (- left posn) - (- posn left (window-total-width window)))))) + (- posn left (window-pixel-width window)))))) ;; Predecessors to the below have been devised by Julian Assange in ;; change-windows-intuitively.el and Hovav Shacham in windmove.el. ;; Neither of these allow to selectively ignore specific windows ;; (windows whose `no-other-window' parameter is non-nil) as targets of ;; the movement. -(defun window-in-direction (direction &optional window ignore) +(defun window-in-direction (direction &optional window ignore sign wrap mini) "Return window in DIRECTION as seen from WINDOW. More precisely, return the nearest window in direction DIRECTION as seen from the position of `window-point' in window WINDOW. @@ -1556,6 +1812,22 @@ non-nil, try to find another window in the indicated direction. If, however, the optional argument IGNORE is non-nil, return that window even if its `no-other-window' parameter is non-nil. +Optional argument SIGN a negative number means to use the right +or bottom edge of WINDOW as reference position instead of +`window-point'. SIGN a positive number means to use the left or +top edge of WINDOW as reference position. + +Optional argument WRAP non-nil means to wrap DIRECTION around +frame borders. This means to return for a WINDOW a the top of +the frame and DIRECTION `above' to return the minibuffer window +if the frame has one, and a window at the bottom of the frame +otherwise. + +Optional argument MINI nil means to return the minibuffer window +if and only if it is currently active. MINI non-nil means to +return the minibuffer window even when it's not active. However, +if WRAP non-nil, always act as if MINI were nil. + Return nil if no suitable window can be found." (setq window (window-normalize-window window t)) (unless (memq direction '(above below left right)) @@ -1563,29 +1835,37 @@ Return nil if no suitable window can be found." (let* ((frame (window-frame window)) (hor (memq direction '(left right))) (first (if hor - (window-left-column window) - (window-top-line window))) - (last (+ first (if hor - (window-total-width window) - (window-total-height window)))) - (posn-cons (nth 6 (posn-at-point (window-point window) window))) + (window-pixel-left window) + (window-pixel-top window))) + (last (+ first (window-size window hor t))) ;; The column / row value of `posn-at-point' can be nil for the ;; mini-window, guard against that. - (posn (if hor - (+ (or (cdr posn-cons) 1) (window-top-line window)) - (+ (or (car posn-cons) 1) (window-left-column window)))) + (posn + (cond + ((and (numberp sign) (< sign 0)) + (if hor + (1- (+ (window-pixel-top window) (window-pixel-height window))) + (1- (+ (window-pixel-left window) (window-pixel-width window))))) + ((and (numberp sign) (> sign 0)) + (if hor + (window-pixel-top window) + (window-pixel-left window))) + ((let ((posn-cons (nth 2 (posn-at-point (window-point window) window)))) + (if hor + (+ (or (cdr posn-cons) 1) (window-pixel-top window)) + (+ (or (car posn-cons) 1) (window-pixel-left window))))))) (best-edge (cond - ((eq direction 'below) (frame-height frame)) - ((eq direction 'right) (frame-width frame)) + ((eq direction 'below) (frame-pixel-height frame)) + ((eq direction 'right) (frame-pixel-width frame)) (t -1))) (best-edge-2 best-edge) - (best-diff-2 (if hor (frame-height frame) (frame-width frame))) + (best-diff-2 (if hor (frame-pixel-height frame) (frame-pixel-width frame))) best best-2 best-diff-2-new) (walk-window-tree (lambda (w) - (let* ((w-top (window-top-line w)) - (w-left (window-left-column w))) + (let* ((w-top (window-pixel-top w)) + (w-left (window-pixel-left w))) (cond ((or (eq window w) ;; Ignore ourselves. @@ -1595,16 +1875,22 @@ Return nil if no suitable window can be found." (hor (cond ((and (<= w-top posn) - (< posn (+ w-top (window-total-height w)))) + (< posn (+ w-top (window-pixel-height w)))) ;; W is to the left or right of WINDOW and covers POSN. (when (or (and (eq direction 'left) - (<= w-left first) (> w-left best-edge)) + (or (and (<= w-left first) (> w-left best-edge)) + (and wrap + (window-at-side-p window 'left) + (window-at-side-p w 'right)))) (and (eq direction 'right) - (>= w-left last) (< w-left best-edge))) + (or (and (>= w-left last) (< w-left best-edge)) + (and wrap + (window-at-side-p window 'right) + (window-at-side-p w 'left))))) (setq best-edge w-left) (setq best w))) ((and (or (and (eq direction 'left) - (<= (+ w-left (window-total-width w)) first)) + (<= (+ w-left (window-pixel-width w)) first)) (and (eq direction 'right) (<= last w-left))) ;; W is to the left or right of WINDOW but does not ;; cover POSN. @@ -1618,32 +1904,40 @@ Return nil if no suitable window can be found." (setq best-edge-2 w-left) (setq best-diff-2 best-diff-2-new) (setq best-2 w)))) - (t - (cond - ((and (<= w-left posn) - (< posn (+ w-left (window-total-width w)))) - ;; W is above or below WINDOW and covers POSN. - (when (or (and (eq direction 'above) - (<= w-top first) (> w-top best-edge)) - (and (eq direction 'below) - (>= w-top first) (< w-top best-edge))) - (setq best-edge w-top) - (setq best w))) - ((and (or (and (eq direction 'above) - (<= (+ w-top (window-total-height w)) first)) - (and (eq direction 'below) (<= last w-top))) - ;; W is above or below WINDOW but does not cover POSN. - (setq best-diff-2-new - (window--in-direction-2 w posn hor)) - (or (< best-diff-2-new best-diff-2) - (and (= best-diff-2-new best-diff-2) - (if (eq direction 'above) - (> w-top best-edge-2) - (< w-top best-edge-2))))) - (setq best-edge-2 w-top) - (setq best-diff-2 best-diff-2-new) - (setq best-2 w))))))) - frame) + ((and (<= w-left posn) + (< posn (+ w-left (window-pixel-width w)))) + ;; W is above or below WINDOW and covers POSN. + (when (or (and (eq direction 'above) + (or (and (<= w-top first) (> w-top best-edge)) + (and wrap + (window-at-side-p window 'top) + (if (active-minibuffer-window) + (minibuffer-window-active-p w) + (window-at-side-p w 'bottom))))) + (and (eq direction 'below) + (or (and (>= w-top first) (< w-top best-edge)) + (and wrap + (if (active-minibuffer-window) + (minibuffer-window-active-p window) + (window-at-side-p window 'bottom)) + (window-at-side-p w 'top))))) + (setq best-edge w-top) + (setq best w))) + ((and (or (and (eq direction 'above) + (<= (+ w-top (window-pixel-height w)) first)) + (and (eq direction 'below) (<= last w-top))) + ;; W is above or below WINDOW but does not cover POSN. + (setq best-diff-2-new + (window--in-direction-2 w posn hor)) + (or (< best-diff-2-new best-diff-2) + (and (= best-diff-2-new best-diff-2) + (if (eq direction 'above) + (> w-top best-edge-2) + (< w-top best-edge-2))))) + (setq best-edge-2 w-top) + (setq best-diff-2 best-diff-2-new) + (setq best-2 w))))) + frame nil (and mini t)) (or best best-2))) (defun get-window-with-predicate (predicate &optional minibuf all-frames default) @@ -1787,8 +2081,8 @@ selected frame and no others." (dolist (window (window-list-1 nil 'nomini all-frames)) (when (and (or dedicated (not (window-dedicated-p window))) (or (not not-selected) (not (eq window (selected-window))))) - (setq size (* (window-total-size window) - (window-total-size window t))) + (setq size (* (window-pixel-height window) + (window-pixel-width window))) (when (> size best-size) (setq best-size size) (setq best-window window)))) @@ -1843,11 +2137,116 @@ meaning of this argument." (length (window-list-1 nil minibuf))) ;;; Resizing windows. +(defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe) + "For WINDOW convert SIZE lines to pixels. +SIZE is supposed to specify a height of WINDOW in terms of text +lines. The return value is the number of pixels specifying that +height. + +WINDOW must be a valid window. Optional argument HORIZONTAL +non-nil means convert SIZE columns to pixels. + +Optional argument PIXELWISE non-nil means SIZE already specifies +pixels but may have to be adjusted to a multiple of the character +size of WINDOW's frame. Optional argument ROUND-MAYBE non-nil +means round to the nearest multiple of the character size of +WINDOW's frame if the option `window-resize-pixelwise' is nil." + (setq window (window-normalize-window window)) + (let ((char-size (frame-char-size window horizontal))) + (if pixelwise + (if (and round-maybe (not window-resize-pixelwise)) + (* (round size char-size) char-size) + size) + (* size char-size)))) + +(defun window--pixel-to-total-1 (window horizontal char-size) + "Subroutine of `window--pixel-to-total'." + (let ((child (window-child window))) + (if (window-combination-p window horizontal) + ;; In an iso-combination distribute sizes proportionally. + (let ((remainder (window-new-total window)) + size best-child rem best-rem) + ;; Initialize total sizes to each child's floor. + (while child + (setq size (max (/ (window-size child horizontal t) char-size) 1)) + (set-window-new-total child size) + (setq remainder (- remainder size)) + (setq child (window-next-sibling child))) + ;; Distribute remainder. + (while (> remainder 0) + (setq child (window-last-child window)) + (setq best-child nil) + (setq best-rem 0) + (while child + (when (and (<= (window-new-total child) + (/ (window-size child horizontal t) char-size)) + (> (setq rem (% (window-size child horizontal t) + char-size)) + best-rem)) + (setq best-child child) + (setq best-rem rem)) + (setq child (window-prev-sibling child))) + ;; We MUST have a best-child here. + (set-window-new-total best-child 1 t) + (setq remainder (1- remainder))) + ;; Recurse. + (setq child (window-child window)) + (while child + (window--pixel-to-total-1 child horizontal char-size) + (setq child (window-next-sibling child)))) + ;; In an ortho-combination assign new sizes directly. + (let ((size (window-new-total window))) + (while child + (set-window-new-total child size) + (window--pixel-to-total-1 child horizontal char-size) + (setq child (window-next-sibling child))))))) + +(defun window--pixel-to-total (&optional frame horizontal) + "On FRAME assign new total window heights from pixel heights. +FRAME must be a live frame and defaults to the selected frame. + +Optional argument HORIZONTAL non-nil means assign new total +window widths from pixel widths." + (setq frame (window-normalize-frame frame)) + (let* ((char-size (frame-char-size frame horizontal)) + (root (frame-root-window)) + (root-size (window-size root horizontal t)) + ;; We have to care about the minibuffer window only if it + ;; appears together with the root window on this frame. + (mini (let ((mini (minibuffer-window frame))) + (and (eq (window-frame mini) frame) + (not (eq mini root)) mini))) + (mini-size (and mini (window-size mini horizontal t)))) + ;; We round the line/column sizes of windows here to the nearest + ;; integer. In some cases this can make windows appear _larger_ + ;; than the containing frame (line/column-wise) because the latter's + ;; sizes are not (yet) rounded. We might eventually fix that. + (if (and mini (not horizontal)) + (let (lines) + (set-window-new-total root (max (/ root-size char-size) 1)) + (set-window-new-total mini (max (/ mini-size char-size) 1)) + (setq lines (- (round (+ root-size mini-size) char-size) + (+ (window-new-total root) (window-new-total mini)))) + (while (> lines 0) + (if (>= (% root-size (window-new-total root)) + (% mini-size (window-new-total mini))) + (set-window-new-total root 1 t) + (set-window-new-total mini 1 t)) + (setq lines (1- lines)))) + (set-window-new-total root (round root-size char-size)) + (when mini + ;; This is taken in the horizontal case only. + (set-window-new-total mini (round mini-size char-size)))) + (unless (window-buffer root) + (window--pixel-to-total-1 root horizontal char-size)) + ;; Apply the new sizes. + (window-resize-apply-total frame horizontal))) + (defun window--resize-reset (&optional frame horizontal) "Reset resize values for all windows on FRAME. FRAME defaults to the selected frame. -This function stores the current value of `window-total-size' applied +This function stores the current value of `window-size' applied with argument HORIZONTAL in the new total size of all windows on FRAME. It also resets the new normal size of each of these windows." @@ -1857,7 +2256,8 @@ windows." (defun window--resize-reset-1 (window horizontal) "Internal function of `window--resize-reset'." ;; Register old size in the new total size. - (set-window-new-total window (window-total-size window horizontal)) + (set-window-new-pixel window (window-size window horizontal t)) + (set-window-new-total window (window-size window horizontal)) ;; Reset new normal size. (set-window-new-normal window) (when (window-child window) @@ -1868,35 +2268,51 @@ windows." ;; The following routine is used to manually resize the minibuffer ;; window and is currently used, for example, by ispell.el. (defun window--resize-mini-window (window delta) - "Resize minibuffer window WINDOW by DELTA lines. -If WINDOW cannot be resized by DELTA lines make it as large (or + "Resize minibuffer window WINDOW by DELTA pixels. +If WINDOW cannot be resized by DELTA pixels make it as large (or as small) as possible, but don't signal an error." (when (window-minibuffer-p window) (let* ((frame (window-frame window)) (root (frame-root-window frame)) - (height (window-total-size window)) + (height (window-pixel-height window)) (min-delta - (- (window-total-size root) - (window-min-size root)))) + (- (window-pixel-height root) + (window-min-size root nil nil t)))) ;; Sanitize DELTA. (cond ((<= (+ height delta) 0) - (setq delta (- (- height 1)))) + (setq delta (- (frame-char-height (window-frame window)) height))) ((> delta min-delta) (setq delta min-delta))) - ;; Resize now. - (window--resize-reset frame) - ;; Ideally we should be able to resize just the last child of root - ;; here. See the comment in `resize-root-window-vertically' for - ;; why we do not do that. - (window--resize-this-window root (- delta) nil nil t) - (set-window-new-total window (+ height delta)) - ;; The following routine catches the case where we want to resize - ;; a minibuffer-only frame. - (resize-mini-window-internal window)))) + (unless (zerop delta) + ;; Resize now. + (window--resize-reset frame) + ;; Ideally we should be able to resize just the last child of root + ;; here. See the comment in `resize-root-window-vertically' for + ;; why we do not do that. + (window--resize-this-window root (- delta) nil nil t) + (set-window-new-pixel window (+ height delta)) + ;; The following routine catches the case where we want to resize + ;; a minibuffer-only frame. + (when (resize-mini-window-internal window) + (window--pixel-to-total frame) + (run-window-configuration-change-hook frame)))))) -(defun window-resize (window delta &optional horizontal ignore) +(defun window--resize-apply-p (frame &optional horizontal) + "Return t when a window on FRAME shall be resized vertically. +Optional argument HORIZONTAL non-nil means return t when a window +shall be resized horizontally." +(catch 'apply + (walk-window-tree + (lambda (window) + (unless (= (window-new-pixel window) + (window-size window horizontal t)) + (throw 'apply t))) + frame t) + nil)) + +(defun window-resize (window delta &optional horizontal ignore pixelwise) "Resize WINDOW vertically by DELTA lines. WINDOW can be an arbitrary window and defaults to the selected one. An attempt to resize the root window of a frame will raise @@ -1919,6 +2335,9 @@ live windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. Any other non-nil value means ignore all of the above restrictions for all windows. +Optional argument PIXELWISE non-nil means resize WINDOW by DELTA +pixels. + This function resizes other windows proportionally and never deletes any windows. If you want to move only the low (right) edge of WINDOW consider using `adjust-window-trailing-edge' @@ -1927,6 +2346,8 @@ instead." (let* ((frame (window-frame window)) (minibuffer-window (minibuffer-window frame)) sibling) + (setq delta (window--size-to-pixel + window delta horizontal pixelwise t)) (cond ((eq window (frame-root-window frame)) (error "Cannot resize the root window of a frame")) @@ -1943,19 +2364,21 @@ instead." ;; nil or the minibuffer window is active, resize the minibuffer ;; window. (window--resize-mini-window minibuffer-window (- delta))) - ((window-resizable-p window delta horizontal ignore) + ((window--resizable-p + window delta horizontal ignore nil nil nil t) (window--resize-reset frame horizontal) (window--resize-this-window window delta horizontal ignore t) (if (and (not window-combination-resize) (window-combined-p window horizontal) (setq sibling (or (window-right window) (window-left window))) - (window-sizable-p sibling (- delta) horizontal ignore)) + (window-sizable-p + sibling (- delta) horizontal ignore t)) ;; If window-combination-resize is nil, WINDOW is part of an ;; iso-combination, and WINDOW's neighboring right or left ;; sibling can be resized as requested, resize that sibling. (let ((normal-delta (/ (float delta) - (window-total-size (window-parent window) horizontal)))) + (window-size (window-parent window) horizontal t)))) (window--resize-this-window sibling (- delta) horizontal nil t) (set-window-new-normal window (+ (window-normal-size window horizontal) @@ -1965,17 +2388,26 @@ instead." normal-delta))) ;; Otherwise, resize all other windows in the same combination. (window--resize-siblings window delta horizontal ignore)) - (window-resize-apply frame horizontal)) + (when (window--resize-apply-p frame horizontal) + (if (window-resize-apply frame horizontal) + (progn + (window--pixel-to-total frame horizontal) + (run-window-configuration-change-hook frame)) + (error "Failed to apply resizing %s" window)))) (t (error "Cannot resize window %s" window))))) -(defun window-resize-no-error (window delta &optional horizontal ignore) +(defun window-resize-no-error (window delta &optional horizontal ignore pixelwise) "Resize WINDOW vertically if it is resizable by DELTA lines. This function is like `window-resize' but does not signal an error when WINDOW cannot be resized. For the meaning of the -optional arguments see the documentation of `window-resize'." - (when (window-resizable-p window delta horizontal ignore) - (window-resize window delta horizontal ignore))) +optional arguments see the documentation of `window-resize'. + +Optional argument PIXELWISE non-nil means interpret DELTA as +pixels." + (when (window--resizable-p + window delta horizontal ignore nil nil nil pixelwise) + (window-resize window delta horizontal ignore pixelwise))) (defun window--resize-child-windows-skip-p (window) "Return non-nil if WINDOW shall be skipped by resizing routines." @@ -1993,7 +2425,8 @@ OTHER-DELTA, a number, specifies that this many lines (columns) have been obtained from (or returned to) an ancestor window of PARENT in order to resize WINDOW." (let* ((delta-normal - (if (and (= (- this-delta) (window-total-size window horizontal)) + (if (and (= (- this-delta) + (window-size window horizontal t)) (zerop other-delta)) ;; When WINDOW gets deleted and we can return its entire ;; space to its siblings, use WINDOW's normal size as the @@ -2001,7 +2434,8 @@ PARENT in order to resize WINDOW." (- (window-normal-size window horizontal)) ;; In any other case calculate the normal delta from the ;; relation of THIS-DELTA to the total size of PARENT. - (/ (float this-delta) (window-total-size parent horizontal)))) + (/ (float this-delta) + (window-size parent horizontal t)))) (sub (window-child parent)) (parent-normal 0.0) (skip (eq trail 'after))) @@ -2043,8 +2477,8 @@ PARENT in order to resize WINDOW." (when (numberp other-delta) ;; Set the new normal size of windows from what they should have ;; contributed for recovering OTHER-DELTA lines (columns). - (setq delta-normal (/ (float (window-total-size parent horizontal)) - (+ (window-total-size parent horizontal) + (setq delta-normal (/ (float (window-size parent horizontal t)) + (+ (window-size parent horizontal t) other-delta))) (setq sub (window-child parent)) (setq skip (eq trail 'after)) @@ -2078,16 +2512,16 @@ PARENT in order to resize WINDOW." ;; Don't get larger than 1 or smaller than 0. (min 1.0 (max (- 1.0 sum) 0.0)))))) -(defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge) - "Resize child windows of window PARENT vertically by DELTA lines. +(defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge char-size) + "Resize child windows of window PARENT vertically by DELTA pixels. PARENT must be a vertically combined internal window. -Optional argument HORIZONTAL non-nil means resize child windows of -PARENT horizontally by DELTA columns. In this case PARENT must +Optional argument HORIZONTAL non-nil means resize child windows +of PARENT horizontally by DELTA pixels. In this case PARENT must be a horizontally combined internal window. WINDOW, if specified, must denote a child window of PARENT that -is resized by DELTA lines. +is resized by DELTA pixels. Optional argument IGNORE non-nil means ignore restrictions imposed by fixed size windows, `window-min-height' or @@ -2103,12 +2537,21 @@ resize only windows on the left or above EDGE. If TRAIL equals `after', resize only windows on the right or below EDGE. Also, preferably only resize windows adjacent to EDGE. +If the optional argument CHAR-SIZE is a positive integer, it specifies +the number of pixels by which windows are incrementally resized. +If CHAR-SIZE is nil, this means to use the value of +`frame-char-height' or `frame-char-width' of WINDOW's frame. + Return the symbol `normalized' if new normal sizes have been already set by this routine." (let* ((first (window-child parent)) (last (window-last-child parent)) - (parent-total (+ (window-total-size parent horizontal) delta)) - sub best-window best-value) + (parent-total (+ (window-size parent horizontal t) + delta)) + (char-size (or char-size + (and window-resize-pixelwise 1) + (frame-char-size window horizontal))) + sub best-window best-value best-delta) (if (and edge (memq trail '(before after)) (progn @@ -2123,16 +2566,14 @@ already set by this routine." sub) (if horizontal (if (eq trail 'before) - (= (+ (window-left-column sub) - (window-total-size sub t)) + (= (+ (window-pixel-left sub) (window-pixel-width sub)) edge) - (= (window-left-column sub) edge)) + (= (window-pixel-left sub) edge)) (if (eq trail 'before) - (= (+ (window-top-line sub) - (window-total-size sub)) + (= (+ (window-pixel-top sub) (window-pixel-height sub)) edge) - (= (window-top-line sub) edge))) - (window-sizable-p sub delta horizontal ignore)) + (= (window-pixel-top sub) edge))) + (window-sizable-p sub delta horizontal ignore t)) ;; Resize only windows adjacent to EDGE. (progn (window--resize-this-window @@ -2141,7 +2582,7 @@ already set by this routine." (progn ;; Assign new normal sizes. (set-window-new-normal - sub (/ (float (window-new-total sub)) parent-total)) + sub (/ (float (window-new-pixel sub)) parent-total)) (set-window-new-normal window (- (window-normal-size window horizontal) (- (window-new-normal sub) @@ -2169,15 +2610,15 @@ already set by this routine." sub (cons ;; We used to call this with NODOWN t, "fixed" 2011-05-11. - (window-min-delta sub horizontal ignore trail t) ; t) - (- (/ (float (window-total-size sub horizontal)) + (window-min-delta sub horizontal ignore trail t nil t) + (- (/ (float (window-size sub horizontal t)) parent-total) (window-normal-size sub horizontal))))) ((> delta 0) ;; When enlarging store the total/normal size factor only (set-window-new-normal sub - (- (/ (float (window-total-size sub horizontal)) + (- (/ (float (window-size sub horizontal t)) parent-total) (window-normal-size sub horizontal))))) @@ -2193,7 +2634,7 @@ already set by this routine." (setq best-value most-negative-fixnum) (while sub (when (and (consp (window-new-normal sub)) - (not (zerop (car (window-new-normal sub)))) + (not (<= (car (window-new-normal sub)) 0)) (> (cdr (window-new-normal sub)) best-value)) (setq best-window sub) (setq best-value (cdr (window-new-normal sub)))) @@ -2201,16 +2642,18 @@ already set by this routine." (setq sub (window-left sub))) (when best-window - (setq delta (1+ delta))) - (set-window-new-total best-window -1 t) - (set-window-new-normal - best-window - (if (= (car (window-new-normal best-window)) 1) - 'skip ; We can't shrink best-window any further. - (cons (1- (car (window-new-normal best-window))) - (- (/ (float (window-new-total best-window)) - parent-total) - (window-normal-size best-window horizontal))))))) + (setq best-delta (min (car (window-new-normal best-window)) + char-size (- delta))) + (setq delta (+ delta best-delta)) + (set-window-new-pixel best-window (- best-delta) t) + (set-window-new-normal + best-window + (if (= (car (window-new-normal best-window)) best-delta) + 'skip ; We can't shrink best-window any further. + (cons (- (car (window-new-normal best-window)) best-delta) + (- (/ (float (window-new-pixel best-window)) + parent-total) + (window-normal-size best-window horizontal)))))))) ((> delta 0) ;; Enlarge windows by delta. (setq best-window t) @@ -2227,13 +2670,14 @@ already set by this routine." (setq sub (window-left sub))) (when best-window - (setq delta (1- delta))) - (set-window-new-total best-window 1 t) - (set-window-new-normal - best-window - (- (/ (float (window-new-total best-window)) - parent-total) - (window-normal-size best-window horizontal)))))) + (setq best-delta (min delta char-size)) + (setq delta (- delta best-delta)) + (set-window-new-pixel best-window best-delta t) + (set-window-new-normal + best-window + (- (/ (float (window-new-pixel best-window)) + parent-total) + (window-normal-size best-window horizontal))))))) (when best-window (setq sub last) @@ -2247,8 +2691,8 @@ already set by this routine." (unless (eq (window-new-normal sub) 'ignore) ;; Resize this window's child windows (back-engineering ;; delta from sub's old and new total sizes). - (let ((delta (- (window-new-total sub) - (window-total-size sub horizontal)))) + (let ((delta (- (window-new-pixel sub) + (window-size sub horizontal t)))) (unless (and (zerop delta) (not trail)) ;; For the TRAIL non-nil case we have to resize SUB ;; recursively even if it's size does not change. @@ -2256,10 +2700,10 @@ already set by this routine." sub delta horizontal ignore nil trail edge)))) (setq sub (window-left sub))))))) -(defun window--resize-siblings (window delta &optional horizontal ignore trail edge) - "Resize other windows when WINDOW is resized vertically by DELTA lines. +(defun window--resize-siblings (window delta &optional horizontal ignore trail edge char-size) + "Resize other windows when WINDOW is resized vertically by DELTA pixels. Optional argument HORIZONTAL non-nil means resize other windows -when WINDOW is resized horizontally by DELTA columns. WINDOW +when WINDOW is resized horizontally by DELTA pixels. WINDOW itself is not resized by this function. Optional argument IGNORE non-nil means ignore restrictions @@ -2304,7 +2748,7 @@ preferably only resize windows adjacent to EDGE." (setq sub (window-right sub))) ;; Set this-delta to what we can get from WINDOW's siblings. - (if (= (- delta) (window-total-size window horizontal)) + (if (= (- delta) (window-size window horizontal t)) ;; A deletion, presumably. We must handle this case ;; specially since `window--resizable' can't be used. (if this-delta @@ -2315,7 +2759,8 @@ preferably only resize windows adjacent to EDGE." (setq this-delta 0)) ;; Any other form of resizing. (setq this-delta - (window--resizable window delta horizontal ignore trail t))) + (window--resizable + window delta horizontal ignore trail t nil t))) ;; Set other-delta to what we still have to get from ;; ancestor windows of parent. @@ -2323,7 +2768,7 @@ preferably only resize windows adjacent to EDGE." (unless (zerop other-delta) ;; Unless we got everything from WINDOW's siblings, PARENT ;; must be resized by other-delta lines or columns. - (set-window-new-total parent other-delta 'add)) + (set-window-new-pixel parent other-delta 'add)) (if (zerop this-delta) ;; We haven't got anything from WINDOW's siblings but we @@ -2334,7 +2779,7 @@ preferably only resize windows adjacent to EDGE." ;; we have to resize their child windows. (unless (eq (window--resize-child-windows parent (- this-delta) horizontal - window ignore trail edge) + window ignore trail edge char-size) ;; If `window--resize-child-windows' returns ;; 'normalized, this means it has set the ;; normal sizes already. @@ -2348,21 +2793,22 @@ preferably only resize windows adjacent to EDGE." ;; In an ortho-combination all siblings of WINDOW must be ;; resized by DELTA. - (set-window-new-total parent delta 'add) + (set-window-new-pixel parent delta 'add) (while sub (unless (eq sub window) - (window--resize-this-window sub delta horizontal ignore t)) + (window--resize-this-window + sub delta horizontal ignore t)) (setq sub (window-right sub)))) (unless (zerop delta) ;; "Go up." (window--resize-siblings - parent delta horizontal ignore trail edge))))) + parent delta horizontal ignore trail edge char-size))))) -(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge) - "Resize WINDOW vertically by DELTA lines. +(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge char-size) + "Resize WINDOW vertically by DELTA pixels. Optional argument HORIZONTAL non-nil means resize WINDOW -horizontally by DELTA columns. +horizontally by DELTA pixels. Optional argument IGNORE non-nil means ignore restrictions imposed by fixed size windows, `window-min-height' or @@ -2381,6 +2827,11 @@ resize only windows on the left or above EDGE. If TRAIL equals `after', resize only windows on the right or below EDGE. Also, preferably only resize windows adjacent to EDGE. +If the optional argument CHAR-SIZE is a positive integer, it specifies +the number of pixels by which windows are incrementally resized. +If CHAR-SIZE is nil, this means to use the value of +`frame-char-height' or `frame-char-width' of WINDOW's frame. + This function recursively resizes WINDOW's child windows to fit the new size. Make sure that WINDOW is `window--resizable' before calling this function. Note that this function does not resize @@ -2389,7 +2840,7 @@ eventually call `window-resize-apply' in order to make resizing actually take effect." (when add ;; Add DELTA to the new total size of WINDOW. - (set-window-new-total window delta t)) + (set-window-new-pixel window delta t)) (let ((sub (window-child window))) (cond @@ -2398,15 +2849,15 @@ actually take effect." ;; In an iso-combination resize child windows according to their ;; normal sizes. (window--resize-child-windows - window delta horizontal nil ignore trail edge)) + window delta horizontal nil ignore trail edge char-size)) ;; In an ortho-combination resize each child window by DELTA. (t (while sub (window--resize-this-window - sub delta horizontal ignore t trail edge) + sub delta horizontal ignore t trail edge char-size) (setq sub (window-right sub))))))) -(defun window--resize-root-window (window delta horizontal ignore) +(defun window--resize-root-window (window delta horizontal ignore pixelwise) "Resize root window WINDOW vertically by DELTA lines. HORIZONTAL non-nil means resize root window WINDOW horizontally by DELTA columns. @@ -2416,57 +2867,74 @@ size windows, `window-min-height' or `window-min-width' settings. This function is only called by the frame resizing routines. It resizes windows proportionally and never deletes any windows." - (when (and (windowp window) (numberp delta) - (window-sizable-p window delta horizontal ignore)) - (window--resize-reset (window-frame window) horizontal) - (window--resize-this-window window delta horizontal ignore t))) + (when (and (windowp window) (numberp delta)) + (let ((pixel-delta + (if pixelwise + delta + (window--size-to-pixel window delta horizontal)))) + (when (window-sizable-p window pixel-delta horizontal ignore t) + (window--resize-reset (window-frame window) horizontal) + (window--resize-this-window + window pixel-delta horizontal ignore t))))) -(defun window--resize-root-window-vertically (window delta) +(defun window--resize-root-window-vertically (window delta pixelwise) "Resize root window WINDOW vertically by DELTA lines. If DELTA is less than zero and we can't shrink WINDOW by DELTA lines, shrink it as much as possible. If DELTA is greater than zero, this function can resize fixed-size windows in order to -recover the necessary lines. +recover the necessary lines. Return the number of lines that +were recovered. -Return the number of lines that were recovered. +Third argument PIXELWISE non-nil means to interpret DELTA as +pixels and return the number of pixels that were recovered. -This function is only called by the minibuffer window resizing -routines. It resizes windows proportionally and never deletes -any windows." - (let ((frame (window-frame window)) - ignore) +This function is called by the minibuffer window resizing +routines." + (let* ((frame (window-frame window)) + (pixel-delta + (cond + (pixelwise + delta) + ((numberp delta) + (* (frame-char-height frame) delta)) + (t 0))) + ignore) (cond - ((not (numberp delta)) - (setq delta 0)) - ((zerop delta)) - ((< delta 0) - (setq delta (window-sizable window delta)) + ((zerop pixel-delta)) + ((< pixel-delta 0) + (setq pixel-delta (window-sizable window pixel-delta nil nil pixelwise)) (window--resize-reset frame) ;; When shrinking the root window, emulate an edge drag in order ;; to not resize other windows if we can avoid it (Bug#12419). (window--resize-this-window - window delta nil ignore t 'before - (+ (window-top-line window) (window-total-size window))) + window pixel-delta nil ignore t 'before + (+ (window-pixel-top window) (window-pixel-height window))) ;; Don't record new normal sizes to make sure that shrinking back ;; proportionally works as intended. (walk-window-tree (lambda (window) (set-window-new-normal window 'ignore)) frame t)) - ((> delta 0) + ((> pixel-delta 0) (window--resize-reset frame) - (unless (window-sizable window delta) + (unless (window-sizable window pixel-delta nil nil pixelwise) (setq ignore t)) ;; When growing the root window, resize proportionally. This ;; should give windows back their original sizes (hopefully). - (window--resize-this-window window delta nil ignore t))) + (window--resize-this-window + window pixel-delta nil ignore t))) ;; Return the possibly adjusted DELTA. - delta)) + (if pixelwise + pixel-delta + (/ pixel-delta (frame-char-height frame))))) -(defun adjust-window-trailing-edge (window delta &optional horizontal) +(defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise) "Move WINDOW's bottom edge by DELTA lines. Optional argument HORIZONTAL non-nil means move WINDOW's right edge by DELTA columns. WINDOW must be a valid window and defaults to the selected one. +Optional argument PIXELWISE non-nil means interpret DELTA as +number of pixels. + If DELTA is greater than zero, move the edge downwards or to the right. If DELTA is less than zero, move the edge upwards or to the left. If the edge can't be moved by DELTA lines or columns, @@ -2476,6 +2944,11 @@ move it as far as possible in the desired direction." (minibuffer-window (minibuffer-window frame)) (right window) left this-delta min-delta max-delta) + + (unless pixelwise + (setq pixelwise t) + (setq delta (* delta (frame-char-size window horizontal)))) + ;; Find the edge we want to move. (while (and (or (not (window-combined-p right horizontal)) (not (window-right right))) @@ -2486,8 +2959,8 @@ move it as far as possible in the desired direction." ;; and immediately below WINDOW and it's either active or ;; `resize-mini-windows' is nil. (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-edges minibuffer-window)) - (nth 3 (window-edges window))) + (= (nth 1 (window-pixel-edges minibuffer-window)) + (nth 3 (window-pixel-edges window))) (or (not resize-mini-windows) (eq minibuffer-window (active-minibuffer-window)))) (window--resize-mini-window minibuffer-window (- delta))) @@ -2528,8 +3001,12 @@ move it as far as possible in the desired direction." ;; two windows we want to resize. (cond ((> delta 0) - (setq max-delta (window--max-delta-1 left 0 horizontal nil 'after)) - (setq min-delta (window--min-delta-1 right (- delta) horizontal nil 'before)) + (setq max-delta + (window--max-delta-1 + left 0 horizontal nil 'after nil pixelwise)) + (setq min-delta + (window--min-delta-1 + right (- delta) horizontal nil 'before nil pixelwise)) (when (or (< max-delta delta) (> min-delta (- delta))) ;; We can't get the whole DELTA - move as far as possible. (setq delta (min max-delta (- min-delta)))) @@ -2537,22 +3014,27 @@ move it as far as possible in the desired direction." ;; Start resizing. (window--resize-reset frame horizontal) ;; Try to enlarge LEFT first. - (setq this-delta (window--resizable left delta horizontal)) + (setq this-delta (window--resizable + left delta horizontal nil 'after nil nil pixelwise)) (unless (zerop this-delta) (window--resize-this-window left this-delta horizontal nil t 'before (if horizontal - (+ (window-left-column left) (window-total-size left t)) - (+ (window-top-line left) (window-total-size left))))) + (+ (window-pixel-left left) (window-pixel-width left)) + (+ (window-pixel-top left) (window-pixel-height left))))) ;; Shrink windows on right of LEFT. (window--resize-siblings left delta horizontal nil 'after (if horizontal - (window-left-column right) - (window-top-line right))))) + (window-pixel-left right) + (window-pixel-top right))))) ((< delta 0) - (setq max-delta (window--max-delta-1 right 0 horizontal nil 'before)) - (setq min-delta (window--min-delta-1 left delta horizontal nil 'after)) + (setq max-delta + (window--max-delta-1 + right 0 horizontal nil 'before nil pixelwise)) + (setq min-delta + (window--min-delta-1 + left delta horizontal nil 'after nil pixelwise)) (when (or (< max-delta (- delta)) (> min-delta delta)) ;; We can't get the whole DELTA - move as far as possible. (setq delta (max (- max-delta) min-delta))) @@ -2560,24 +3042,30 @@ move it as far as possible in the desired direction." ;; Start resizing. (window--resize-reset frame horizontal) ;; Try to enlarge RIGHT. - (setq this-delta (window--resizable right (- delta) horizontal)) + (setq this-delta + (window--resizable + right (- delta) horizontal nil 'before nil nil pixelwise)) (unless (zerop this-delta) (window--resize-this-window right this-delta horizontal nil t 'after (if horizontal - (window-left-column right) - (window-top-line right)))) + (window-pixel-left right) + (window-pixel-top right)))) ;; Shrink windows on left of RIGHT. (window--resize-siblings right (- delta) horizontal nil 'before (if horizontal - (+ (window-left-column left) (window-total-size left t)) - (+ (window-top-line left) (window-total-size left))))))) + (+ (window-pixel-left left) (window-pixel-width left)) + (+ (window-pixel-top left) (window-pixel-height left))))))) (unless (zerop delta) ;; Don't report an error in the standard case. - (unless (window-resize-apply frame horizontal) - ;; But do report an error if applying the changes fails. - (error "Failed adjusting window %s" window))))))) + (when (window--resize-apply-p frame horizontal) + (if (window-resize-apply frame horizontal) + (progn + (window--pixel-to-total frame horizontal) + (run-window-configuration-change-hook frame)) + ;; But do report an error if applying the changes fails. + (error "Failed adjusting window %s" window)))))))) (defun enlarge-window (delta &optional horizontal) "Make the selected window DELTA lines taller. @@ -2602,7 +3090,7 @@ negative, shrink selected window by -DELTA lines or columns." ;; If the selected window is full height and `resize-mini-windows' ;; is nil, resize the minibuffer window. (window--resize-mini-window minibuffer-window (- delta))) - ((window-resizable-p nil delta horizontal) + ((window--resizable-p nil delta horizontal) (window-resize nil delta horizontal)) (t (window-resize @@ -2635,7 +3123,7 @@ Also see the `window-min-height' variable." ;; If the selected window is full height and `resize-mini-windows' ;; is nil, resize the minibuffer window. (window--resize-mini-window minibuffer-window delta)) - ((window-resizable-p nil (- delta) horizontal) + ((window--resizable-p nil (- delta) horizontal) (window-resize nil (- delta) horizontal)) (t (window-resize @@ -2647,20 +3135,36 @@ Also see the `window-min-height' variable." (defun maximize-window (&optional window) "Maximize WINDOW. Make WINDOW as large as possible without deleting any windows. -WINDOW must be a valid window and defaults to the selected one." +WINDOW must be a valid window and defaults to the selected one. + +If the option `window-resize-pixelwise' is non-nil maximize +WINDOW pixelwise." (interactive) (setq window (window-normalize-window window)) - (window-resize window (window-max-delta window)) - (window-resize window (window-max-delta window t) t)) + (window-resize + window (window-max-delta window nil nil nil nil nil window-resize-pixelwise) + nil nil window-resize-pixelwise) + (window-resize + window (window-max-delta window t nil nil nil nil window-resize-pixelwise) + t nil window-resize-pixelwise)) (defun minimize-window (&optional window) "Minimize WINDOW. Make WINDOW as small as possible without deleting any windows. -WINDOW must be a valid window and defaults to the selected one." +WINDOW must be a valid window and defaults to the selected one. + +If the option `window-resize-pixelwise' is non-nil minimize +WINDOW pixelwise." (interactive) (setq window (window-normalize-window window)) - (window-resize window (- (window-min-delta window))) - (window-resize window (- (window-min-delta window t)) t)) + (window-resize + window + (- (window-min-delta window nil nil nil nil nil window-resize-pixelwise)) + nil nil window-resize-pixelwise) + (window-resize + window + (- (window-min-delta window t nil nil nil nil window-resize-pixelwise)) + t nil window-resize-pixelwise)) (defun frame-root-window-p (window) "Return non-nil if WINDOW is the root window of its frame." @@ -2813,10 +3317,11 @@ and no others." (defun window-deletable-p (&optional window) "Return t if WINDOW can be safely deleted from its frame. WINDOW must be a valid window and defaults to the selected one. -Return `frame' if deleting WINDOW should also delete its frame." +Return 'frame if deleting WINDOW should also delete its frame." (setq window (window-normalize-window window)) - (unless ignore-window-parameters + (unless (or ignore-window-parameters + (eq (window-parameter window 'delete-window) t)) ;; Handle atomicity. (when (window-parameter window 'window-atom) (setq window (window-atom-root window)))) @@ -2828,6 +3333,14 @@ Return `frame' if deleting WINDOW should also delete its frame." ;; on the same terminal, and it does not contain the active ;; minibuffer. (unless (or (eq frame (next-frame frame 0)) + ;; We can delete our frame only if no other frame + ;; currently uses our minibuffer window. + (catch 'other + (dolist (other (frame-list)) + (when (and (not (eq other frame)) + (eq (window-frame (minibuffer-window other)) + frame)) + (throw 'other t)))) (let ((minibuf (active-minibuffer-window))) (and minibuf (eq frame (window-frame minibuf))))) 'frame)) @@ -2894,7 +3407,7 @@ that is its frame's root window." (error "Attempt to delete last non-side window"))) (let* ((horizontal (window-left-child parent)) - (size (window-total-size window horizontal)) + (size (window-size window horizontal t)) (frame-selected (window--in-subtree-p (frame-selected-window frame) window)) ;; Emacs 23 preferably gives WINDOW's space to its left @@ -2903,13 +3416,13 @@ that is its frame's root window." (window--resize-reset frame horizontal) (cond ((and (not window-combination-resize) - sibling (window-sizable-p sibling size)) + sibling (window-sizable-p sibling size horizontal nil t)) ;; Resize WINDOW's sibling. (window--resize-this-window sibling size horizontal nil t) (set-window-new-normal sibling (+ (window-normal-size sibling horizontal) (window-normal-size window horizontal)))) - ((window-resizable-p window (- size) horizontal nil nil nil t) + ((window--resizable-p window (- size) horizontal nil nil nil t t) ;; Can do without resizing fixed-size windows. (window--resize-siblings window (- size) horizontal)) (t @@ -2917,6 +3430,7 @@ that is its frame's root window." (window--resize-siblings window (- size) horizontal t))) ;; Actually delete WINDOW. (delete-window-internal window) + (window--pixel-to-total frame horizontal) (when (and frame-selected (window-parameter (frame-selected-window frame) 'no-other-window)) @@ -3065,7 +3579,9 @@ WINDOW must be a live window and defaults to the selected one." ;; (Bug#12588). point window-point-insertion-type))))) (set-window-prev-buffers - window (cons entry (window-prev-buffers window)))))))) + window (cons entry (window-prev-buffers window))))) + + (run-hooks 'buffer-list-update-hook)))) (defun unrecord-window-buffer (&optional window buffer) "Unrecord BUFFER in WINDOW. @@ -3586,11 +4102,11 @@ the buffer of WINDOW. The following values are handled: (eq (nth 3 quit-restore) buffer)) ;; Show another buffer stored in quit-restore parameter. (when (and (integerp (nth 3 quad)) - (/= (nth 3 quad) (window-total-size window))) + (/= (nth 3 quad) (window-total-height window))) ;; Try to resize WINDOW to its old height but don't signal an ;; error. (condition-case nil - (window-resize window (- (nth 3 quad) (window-total-size window))) + (window-resize window (- (nth 3 quad) (window-total-height window))) (error nil))) (set-window-dedicated-p window nil) ;; Restore WINDOW's previous buffer, start and point position. @@ -3668,14 +4184,20 @@ showing BUFFER-OR-NAME." (unrecord-window-buffer window buffer))))) ;;; Splitting windows. -(defun window-split-min-size (&optional horizontal) +(defun window-split-min-size (&optional horizontal pixelwise) "Return minimum height of any window when splitting windows. Optional argument HORIZONTAL non-nil means return minimum width." - (if horizontal - (max window-min-width window-safe-min-width) - (max window-min-height window-safe-min-height))) + (cond + (pixelwise + (if horizontal + (window-min-pixel-width) + (window-min-pixel-height))) + (horizontal + (max window-min-width window-safe-min-width)) + (t + (max window-min-height window-safe-min-height)))) -(defun split-window (&optional window size side) +(defun split-window (&optional window size side pixelwise) "Make a new window adjacent to WINDOW. WINDOW must be a valid window and defaults to the selected one. Return the new window which is always a live window. @@ -3686,7 +4208,7 @@ lines or columns tall. If SIZE is negative, make the new window absolute value can be less than `window-min-height' or `window-min-width'; so this command can make a new window as small as one line or two columns. SIZE defaults to half of -WINDOW's size. Interactively, SIZE is the prefix argument. +WINDOW's size. Optional third argument SIDE nil (or `below') specifies that the new window shall be located below WINDOW. SIDE `above' means the @@ -3703,6 +4225,8 @@ window provided SIZE is negative) including space reserved for fringes and the scrollbar or a divider column. Any other non-nil value for SIDE is currently handled like t (or `right'). +PIXELWISE, if non-nil, means to interpret SIZE pixelwise. + If the variable `ignore-window-parameters' is non-nil or the `split-window' parameter of WINDOW equals t, do not process any parameters of WINDOW. Otherwise, if the `split-window' parameter @@ -3718,7 +4242,6 @@ scrollbars are inherited from WINDOW. If WINDOW is an internal window, these properties as well as the buffer displayed in the new window are inherited from the window selected on WINDOW's frame. The selected window is not changed by this function." - (interactive "i") (setq window (window-normalize-window window)) (let* ((side (cond ((not side) 'below) @@ -3733,8 +4256,11 @@ frame. The selected window is not changed by this function." ;; have to override their value. (window-combination-limit window-combination-limit) (window-combination-resize window-combination-resize) + (char-size (frame-char-size window horizontal)) + (pixel-size + (when (numberp size) + (window--size-to-pixel window size horizontal pixelwise t))) atom-root) - (window--check frame) (catch 'done (cond @@ -3750,7 +4276,7 @@ frame. The selected window is not changed by this function." ((and (window-parameter window 'window-atom) (setq atom-root (window-atom-root window)) (not (eq atom-root window))) - (throw 'done (split-window atom-root size side))) + (throw 'done (split-window atom-root size side pixelwise))) ;; If WINDOW is a side window or its first or last child is a ;; side window, throw an error unless `window-combination-resize' ;; equals 'side. @@ -3775,13 +4301,14 @@ frame. The selected window is not changed by this function." ;; If `window-combination-resize' is t and SIZE is non-negative, ;; bind `window-combination-limit' to t. - (when (and (eq window-combination-resize t) size (> size 0)) + (when (and (eq window-combination-resize t) + pixel-size (> pixel-size 0)) (setq window-combination-limit t)) - (let* ((parent-size - ;; `parent-size' is the size of WINDOW's parent, provided - ;; it has one. - (when parent (window-total-size parent horizontal))) + (let* ((parent-pixel-size + ;; `parent-pixel-size' is the pixel size of WINDOW's + ;; parent, provided it has one. + (when parent (window-size parent horizontal t))) ;; `resize' non-nil means we are supposed to resize other ;; windows in WINDOW's combination. (resize @@ -3791,76 +4318,82 @@ frame. The selected window is not changed by this function." (not (eq window-combination-limit t)) ;; Resize makes sense in iso-combinations only. (window-combined-p window horizontal))) - ;; `old-size' is the current size of WINDOW. - (old-size (window-total-size window horizontal)) + ;; `old-pixel-size' is the current pixel size of WINDOW. + (old-pixel-size (window-size window horizontal t)) ;; `new-size' is the specified or calculated size of the ;; new window. - (new-size - (cond - ((not size) - (max (window-split-min-size horizontal) - (if resize - ;; When resizing try to give the new window the - ;; average size of a window in its combination. - (min (- parent-size - (window-min-size parent horizontal)) - (/ parent-size - (1+ (window-combinations - parent horizontal)))) - ;; Else try to give the new window half the size - ;; of WINDOW (plus an eventual odd line). - (+ (/ old-size 2) (% old-size 2))))) - ((>= size 0) - ;; SIZE non-negative specifies the new size of WINDOW. + new-pixel-size new-parent new-normal) + (cond + ((not pixel-size) + (setq new-pixel-size + (if resize + ;; When resizing try to give the new window the + ;; average size of a window in its combination. + (min (- parent-pixel-size + (window-min-size parent horizontal nil t)) + (/ parent-pixel-size + (1+ (window-combinations parent horizontal)))) + ;; Else try to give the new window half the size + ;; of WINDOW (plus an eventual odd pixel). + (/ old-pixel-size 2))) + (unless window-resize-pixelwise + ;; Round to nearest char-size multiple. + (setq new-pixel-size + (* char-size (round new-pixel-size char-size))))) + ((>= pixel-size 0) + ;; SIZE non-negative specifies the new size of WINDOW. - ;; Note: Specifying a non-negative SIZE is practically - ;; always done as workaround for making the new window - ;; appear above or on the left of the new window (the - ;; ispell window is a typical example of that). In all - ;; these cases the SIDE argument should be set to 'above - ;; or 'left in order to support the 'resize option. - ;; Here we have to nest the windows instead, see above. - (- old-size size)) - (t - ;; SIZE negative specifies the size of the new window. - (- size)))) - new-parent new-normal) + ;; Note: Specifying a non-negative SIZE is practically + ;; always done as workaround for making the new window + ;; appear above or on the left of the new window (the + ;; ispell window is a typical example of that). In all + ;; these cases the SIDE argument should be set to 'above + ;; or 'left in order to support the 'resize option. + ;; Here we have to nest the windows instead, see above. + (setq new-pixel-size (- old-pixel-size pixel-size))) + (t + ;; SIZE negative specifies the size of the new window. + (setq new-pixel-size (- pixel-size)))) ;; Check SIZE. (cond - ((not size) + ((not pixel-size) (cond (resize ;; SIZE unspecified, resizing. - (when (and (not (window-sizable-p parent (- new-size) horizontal)) + (when (and (not (window-sizable-p + parent (- new-pixel-size) horizontal nil t)) ;; Try again with minimum split size. - (setq new-size - (max new-size (window-split-min-size horizontal))) - (not (window-sizable-p parent (- new-size) horizontal))) - (error "Window %s too small for splitting" parent))) - ((> (+ new-size (window-min-size window horizontal)) old-size) + (setq new-pixel-size + (max new-pixel-size + (window-split-min-size horizontal t))) + (not (window-sizable-p + parent (- new-pixel-size) horizontal nil t))) + (error "Window %s too small for splitting 1" parent))) + ((> (+ new-pixel-size (window-min-size window horizontal nil t)) + old-pixel-size) ;; SIZE unspecified, no resizing. - (error "Window %s too small for splitting" window)))) - ((and (>= size 0) - (or (>= size old-size) - (< new-size (if horizontal - window-safe-min-width - window-safe-min-width)))) + (error "Window %s too small for splitting 2" window)))) + ((and (>= pixel-size 0) + (or (>= pixel-size old-pixel-size) + (< new-pixel-size + (window-safe-min-pixel-size window horizontal)))) ;; SIZE specified as new size of old window. If the new size ;; is larger than the old size or the size of the new window ;; would be less than the safe minimum, signal an error. - (error "Window %s too small for splitting" window)) + (error "Window %s too small for splitting 3" window)) (resize ;; SIZE specified, resizing. - (unless (window-sizable-p parent (- new-size) horizontal) + (unless (window-sizable-p + parent (- new-pixel-size) horizontal nil t) ;; If we cannot resize the parent give up. - (error "Window %s too small for splitting" parent))) - ((or (< new-size - (if horizontal window-safe-min-width window-safe-min-height)) - (< (- old-size new-size) - (if horizontal window-safe-min-width window-safe-min-height))) + (error "Window %s too small for splitting 4" parent))) + ((or (< new-pixel-size + (window-safe-min-pixel-size window horizontal)) + (< (- old-pixel-size new-pixel-size) + (window-safe-min-pixel-size window horizontal))) ;; SIZE specification violates minimum size restrictions. - (error "Window %s too small for splitting" window))) + (error "Window %s too small for splitting 5" window))) (window--resize-reset frame horizontal) @@ -3873,7 +4406,8 @@ frame. The selected window is not changed by this function." (setq new-normal ;; Make new-normal the normal size of the new window. (cond - (size (/ (float new-size) (if new-parent old-size parent-size))) + (pixel-size (/ (float new-pixel-size) + (if new-parent old-pixel-size parent-pixel-size))) (new-parent 0.5) (resize (/ 1.0 (1+ (window-combinations parent horizontal)))) (t (/ (window-normal-size window horizontal) 2.0)))) @@ -3884,7 +4418,8 @@ frame. The selected window is not changed by this function." ;; we won't be able to return space to those windows when we ;; delete the one we create here. Hence we do not go up. (progn - (window--resize-child-windows parent (- new-size) horizontal) + (window--resize-child-windows + parent (- new-pixel-size) horizontal) (let* ((normal (- 1.0 new-normal)) (sub (window-child parent))) (while sub @@ -3892,15 +4427,21 @@ frame. The selected window is not changed by this function." sub (* (window-normal-size sub horizontal) normal)) (setq sub (window-right sub))))) ;; Get entire space from WINDOW. - (set-window-new-total window (- old-size new-size)) - (window--resize-this-window window (- new-size) horizontal) + (set-window-new-pixel + window (- old-pixel-size new-pixel-size)) +;; (set-window-new-pixel window (- old-pixel-size new-pixel-size)) +;; (set-window-new-total +;; window (- old-size new-size)) + (window--resize-this-window window (- new-pixel-size) horizontal) (set-window-new-normal window (- (if new-parent 1.0 (window-normal-size window horizontal)) new-normal))) - (let* ((new (split-window-internal window new-size side new-normal))) + (let* ((new (split-window-internal window new-pixel-size side new-normal))) + (window--pixel-to-total frame horizontal) ;; Assign window-side parameters, if any. - (when (eq window-combination-resize 'side) + (cond + ((eq window-combination-resize 'side) (let ((window-side (cond (window-side window-side) @@ -3914,8 +4455,17 @@ frame. The selected window is not changed by this function." ;; new parent the same window-side parameter. (set-window-parameter (window-parent new) 'window-side window-side)))) + ((eq window-combination-resize 'atom) + ;; Make sure `window--check-frame' won't destroy an existing + ;; atomic window in case the new window gets nested inside. + (unless (window-parameter window 'window-atom) + (set-window-parameter window 'window-atom t)) + (when new-parent + (set-window-parameter (window-parent new) 'window-atom t)) + (set-window-parameter new 'window-atom t))) (run-window-configuration-change-hook frame) + (run-window-scroll-functions new) (window--check frame) ;; Always return the new window. new))))) @@ -4026,17 +4576,20 @@ right, if any." "Subroutine of `balance-windows-1'. WINDOW must be a vertical combination (horizontal if HORIZONTAL is non-nil)." - (let* ((first (window-child window)) + (let* ((char-size (if window-resize-pixelwise + 1 + (frame-char-size window horizontal))) + (first (window-child window)) (sub first) (number-of-children 0) - (parent-size (window-new-total window)) + (parent-size (window-new-pixel window)) (total-sum parent-size) failed size sub-total sub-delta sub-amount rest) (while sub (setq number-of-children (1+ number-of-children)) (when (window-size-fixed-p sub horizontal) (setq total-sum - (- total-sum (window-total-size sub horizontal))) + (- total-sum (window-size sub horizontal t))) (set-window-new-normal sub 'ignore)) (setq sub (window-right sub))) @@ -4048,12 +4601,12 @@ is non-nil)." (while (and sub (not failed)) ;; Ignore child windows that should be ignored or are stuck. (unless (window--resize-child-windows-skip-p sub) - (setq sub-total (window-total-size sub horizontal)) + (setq sub-total (window-size sub horizontal t)) (setq sub-delta (- size sub-total)) (setq sub-amount - (window-sizable sub sub-delta horizontal)) + (window-sizable sub sub-delta horizontal nil t)) ;; Register the new total size for this child window. - (set-window-new-total sub (+ sub-total sub-amount)) + (set-window-new-pixel sub (+ sub-total sub-amount)) (unless (= sub-amount sub-delta) (setq total-sum (- total-sum sub-total sub-amount)) (setq number-of-children (1- number-of-children)) @@ -4062,14 +4615,15 @@ is non-nil)." (set-window-new-normal sub 'skip))) (setq sub (window-right sub)))) + ;; How can we be sure that `number-of-children' is NOT zero here ? (setq rest (% total-sum number-of-children)) ;; Fix rounding by trying to enlarge non-stuck windows by one line ;; (column) until `rest' is zero. (setq sub first) (while (and sub (> rest 0)) (unless (window--resize-child-windows-skip-p window) - (set-window-new-total sub 1 t) - (setq rest (1- rest))) + (set-window-new-pixel sub (min rest char-size) t) + (setq rest (- rest char-size))) (setq sub (window-right sub))) ;; Fix rounding by trying to enlarge stuck windows by one line @@ -4077,8 +4631,8 @@ is non-nil)." (setq sub first) (while (and sub (> rest 0)) (unless (eq (window-new-normal sub) 'ignore) - (set-window-new-total sub 1 t) - (setq rest (1- rest))) + (set-window-new-pixel sub (min rest char-size) t) + (setq rest (- rest char-size))) (setq sub (window-right sub))) (setq sub first) @@ -4086,8 +4640,8 @@ is non-nil)." ;; Record new normal sizes. (set-window-new-normal sub (/ (if (eq (window-new-normal sub) 'ignore) - (window-total-size sub horizontal) - (window-new-total sub)) + (window-size sub horizontal t) + (window-new-pixel sub)) (float parent-size))) ;; Recursively balance each window's child windows. (balance-windows-1 sub horizontal) @@ -4099,9 +4653,9 @@ is non-nil)." (let ((sub (window-child window))) (if (window-combined-p sub horizontal) (balance-windows-2 window horizontal) - (let ((size (window-new-total window))) + (let ((size (window-new-pixel window))) (while sub - (set-window-new-total sub size) + (set-window-new-pixel sub size) (balance-windows-1 sub horizontal) (setq sub (window-right sub)))))))) @@ -4127,11 +4681,17 @@ window." ;; Balance vertically. (window--resize-reset (window-frame window)) (balance-windows-1 window) - (window-resize-apply frame) + (when (window--resize-apply-p frame) + (window-resize-apply frame) + (window--pixel-to-total frame) + (run-window-configuration-change-hook frame)) ;; Balance horizontally. (window--resize-reset (window-frame window) t) (balance-windows-1 window t) - (window-resize-apply frame t))) + (when (window--resize-apply-p frame t) + (window-resize-apply frame t) + (window--pixel-to-total frame t) + (run-window-configuration-change-hook frame)))) (defun window-fixed-size-p (&optional window direction) "Return t if WINDOW cannot be resized in DIRECTION. @@ -4150,14 +4710,17 @@ This is used by `balance-windows-area'. Changing this globally has no effect.") (make-variable-buffer-local 'window-area-factor) -(defun balance-windows-area-adjust (window delta horizontal) +(defun balance-windows-area-adjust (window delta horizontal pixelwise) "Wrapper around `window-resize' with error checking. Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function." ;; `window-resize' may fail if delta is too large. (while (>= (abs delta) 1) (condition-case nil (progn - (window-resize window delta horizontal) + ;; It was wrong to use `window-resize' here. Somehow + ;; `balance-windows-area' depends on resizing windows + ;; asymmetrically. + (adjust-window-trailing-edge window delta horizontal pixelwise) (setq delta 0)) (error ;;(message "adjust: %s" (error-message-string err)) @@ -4174,7 +4737,8 @@ specific buffers." (if (not (window-fixed-size-p win)) win)) (window-list nil 'nomini)))) (changelog nil) - next) + (pixelwise window-resize-pixelwise) + next) ;; Resizing a window changes the size of surrounding windows in complex ;; ways, so it's difficult to balance them all. The introduction of ;; `adjust-window-trailing-edge' made it a bit easier, but it is still @@ -4198,11 +4762,13 @@ specific buffers." (window-fixed-size-p next))) ;; (assert (eq next (or (cadr (member win wins)) (car wins)))) (let* ((horiz - (< (car (window-edges win)) (car (window-edges next)))) - (areadiff (/ (- (* (window-height next) (window-width next) + (< (car (window-pixel-edges win)) (car (window-pixel-edges next)))) + (areadiff (/ (- (* (window-size next nil pixelwise) + (window-size next t pixelwise) (buffer-local-value 'window-area-factor (window-buffer next))) - (* (window-height win) (window-width win) + (* (window-size win nil pixelwise) + (window-size win t pixelwise) (buffer-local-value 'window-area-factor (window-buffer win)))) (max (buffer-local-value 'window-area-factor @@ -4210,8 +4776,10 @@ specific buffers." (buffer-local-value 'window-area-factor (window-buffer next))))) (edgesize (if horiz - (+ (window-height win) (window-height next)) - (+ (window-width win) (window-width next)))) + (+ (window-size win nil pixelwise) + (window-size next nil pixelwise)) + (+ (window-size win t pixelwise) + (window-size next t pixelwise)))) (diff (/ areadiff edgesize))) (when (zerop diff) ;; Maybe diff is actually closer to 1 than to 0. @@ -4226,9 +4794,9 @@ specific buffers." (setq carry (+ carry areadiff)) ;; This used `adjust-window-trailing-edge' before and uses ;; `window-resize' now. Error wrapping is still needed. - (balance-windows-area-adjust win diff horiz) + (balance-windows-area-adjust win diff horiz pixelwise) ;; (sit-for 0.5) - (let ((change (cons win (window-edges win)))) + (let ((change (cons win (window-pixel-edges win)))) ;; If the same change has been seen already for this window, ;; we're most likely in an endless loop, so don't count it as ;; a change. @@ -4255,11 +4823,14 @@ specific buffers." (head `(,type ,@(unless (window-next-sibling window) `((last . t))) - (total-height . ,(window-total-size window)) - (total-width . ,(window-total-size window t)) + (pixel-width . ,(window-pixel-width window)) + (pixel-height . ,(window-pixel-height window)) + (total-width . ,(window-total-width window)) + (total-height . ,(window-total-height window)) (normal-height . ,(window-normal-size window)) (normal-width . ,(window-normal-size window t)) - (combination-limit . ,(window-combination-limit window)) + ,@(unless (window-live-p window) + `((combination-limit . ,(window-combination-limit window)))) ,@(let ((parameters (window-parameters window)) list) ;; Make copies of those window parameters whose @@ -4341,13 +4912,22 @@ value can be also stored on disk and read back in a new session." (min-height-ignore . ,(window-min-size window nil t)) (min-width-ignore . ,(window-min-size window t t)) (min-height-safe . ,(window-min-size window nil 'safe)) - (min-width-safe . ,(window-min-size window t 'safe))) + (min-width-safe . ,(window-min-size window t 'safe)) + (min-pixel-height . ,(window-min-size window nil nil t)) + (min-pixel-width . ,(window-min-size window t nil t)) + (min-pixel-height-ignore . ,(window-min-size window nil t t)) + (min-pixel-width-ignore . ,(window-min-size window t t t)) + (min-pixel-height-safe . ,(window-min-size window nil 'safe t)) + (min-pixel-width-safe . ,(window-min-size window t 'safe t))) (window--state-get-1 window writable))) (defvar window-state-put-list nil "Helper variable for `window-state-put'.") -(defun window--state-put-1 (state &optional window ignore totals) +(defvar window-state-put-stale-windows nil + "Helper variable for `window-state-put'.") + +(defun window--state-put-1 (state &optional window ignore totals pixelwise) "Helper function for `window-state-put'." (let ((type (car state))) (setq state (cdr state)) @@ -4358,7 +4938,7 @@ value can be also stored on disk and read back in a new session." (push (cons window state) window-state-put-list)) ((memq type '(vc hc)) (let* ((horizontal (eq type 'hc)) - (total (window-total-size window horizontal)) + (total (window-size window horizontal pixelwise)) (first t) size new) (dolist (item state) @@ -4375,25 +4955,39 @@ value can be also stored on disk and read back in a new session." (setq size (if totals ;; Use total size. - (cdr (assq (if horizontal 'total-width 'total-height) item)) + (if pixelwise + (cdr (assq (if horizontal + 'pixel-width + 'pixel-height) + item)) + (cdr (assq (if horizontal + 'total-width + 'total-height) + item))) ;; Use normalized size and round. - (round (* total - (cdr (assq - (if horizontal 'normal-width 'normal-height) - item)))))) + (round + (* total + (cdr (assq (if horizontal 'normal-width 'normal-height) + item)))))) ;; Use safe sizes, we try to resize later. - (setq size (max size (if horizontal - window-safe-min-height - window-safe-min-width))) - - (if (window-sizable-p window (- size) horizontal 'safe) + (setq size (max size + (if horizontal + (* window-safe-min-width + (if pixelwise + (frame-char-width (window-frame window)) + 1)) + (* window-safe-min-height + (if pixelwise + (frame-char-height (window-frame window)) + 1))))) + (if (window-sizable-p window (- size) horizontal 'safe pixelwise) (let* ((window-combination-limit (assq 'combination-limit item))) ;; We must inherit the combination limit, otherwise ;; we might mess up handling of atomic and side ;; window. - (setq new (split-window window size horizontal))) + (setq new (split-window window size horizontal pixelwise))) ;; Give up if we can't resize window down to safe sizes. (error "Cannot resize window %s" window)) @@ -4411,7 +5005,7 @@ value can be also stored on disk and read back in a new session." ;; Continue with the last window split off. (setq window new)))))))) -(defun window--state-put-2 (ignore) +(defun window--state-put-2 (ignore pixelwise) "Helper function for `window-state-put'." (dolist (item window-state-put-list) (let ((window (car item)) @@ -4429,101 +5023,169 @@ value can be also stored on disk and read back in a new session." (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - ;; We don't want to raise an error here so we create a buffer if - ;; there's none. - (set-window-buffer window (get-buffer-create (car state))) - (with-current-buffer (window-buffer window) - (set-window-hscroll window (cdr (assq 'hscroll state))) - (apply 'set-window-fringes - (cons window (cdr (assq 'fringes state)))) - (let ((margins (cdr (assq 'margins state)))) - (set-window-margins window (car margins) (cdr margins))) - (let ((scroll-bars (cdr (assq 'scroll-bars state)))) - (set-window-scroll-bars - window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars))) - (set-window-vscroll window (cdr (assq 'vscroll state))) - ;; Adjust vertically. - (if (memq window-size-fixed '(t height)) - ;; A fixed height window, try to restore the original size. - (let ((delta (- (cdr (assq 'total-height item)) - (window-total-height window))) - window-size-fixed) - (when (window-resizable-p window delta) - (window-resize window delta))) - ;; Else check whether the window is not high enough. - (let* ((min-size (window-min-size window nil ignore)) - (delta (- min-size (window-total-size window)))) - (when (and (> delta 0) - (window-resizable-p window delta nil ignore)) - (window-resize window delta nil ignore)))) - ;; Adjust horizontally. - (if (memq window-size-fixed '(t width)) - ;; A fixed width window, try to restore the original size. - (let ((delta (- (cdr (assq 'total-width item)) - (window-total-width window))) - window-size-fixed) - (when (window-resizable-p window delta) - (window-resize window delta))) - ;; Else check whether the window is not wide enough. - (let* ((min-size (window-min-size window t ignore)) - (delta (- min-size (window-total-size window t)))) - (when (and (> delta 0) - (window-resizable-p window delta t ignore)) - (window-resize window delta t ignore)))) - ;; Set dedicated status. - (set-window-dedicated-p window (cdr (assq 'dedicated state))) - ;; Install positions (maybe we should do this after all windows - ;; have been created and sized). - (ignore-errors - (set-window-start window (cdr (assq 'start state))) - (set-window-point window (cdr (assq 'point state)))) - ;; Select window if it's the selected one. - (when (cdr (assq 'selected state)) - (select-window window))))))) + (let ((buffer (get-buffer (car state)))) + (if buffer + (with-current-buffer buffer + (set-window-buffer window buffer) + (set-window-hscroll window (cdr (assq 'hscroll state))) + (apply 'set-window-fringes + (cons window (cdr (assq 'fringes state)))) + (let ((margins (cdr (assq 'margins state)))) + (set-window-margins window (car margins) (cdr margins))) + (let ((scroll-bars (cdr (assq 'scroll-bars state)))) + (set-window-scroll-bars + window (car scroll-bars) (nth 2 scroll-bars) + (nth 3 scroll-bars))) + (set-window-vscroll window (cdr (assq 'vscroll state))) + ;; Adjust vertically. + (if (memq window-size-fixed '(t height)) + ;; A fixed height window, try to restore the + ;; original size. + (let ((delta + (- (cdr (assq + (if pixelwise 'pixel-height 'total-height) + item)) + (window-size window nil pixelwise))) + window-size-fixed) + (when (window--resizable-p + window delta nil nil nil nil nil pixelwise) + (window-resize window delta nil nil pixelwise))) + ;; Else check whether the window is not high enough. + (let* ((min-size + (window-min-size window nil ignore pixelwise)) + (delta + (- min-size (window-size window nil pixelwise)))) + (when (and (> delta 0) + (window--resizable-p + window delta nil ignore nil nil nil pixelwise)) + (window-resize window delta nil ignore pixelwise)))) + ;; Adjust horizontally. + (if (memq window-size-fixed '(t width)) + ;; A fixed width window, try to restore the original + ;; size. + (let ((delta + (- (cdr (assq + (if pixelwise 'pixel-width 'total-width) + item)) + (window-size window t pixelwise))) + window-size-fixed) + (when (window--resizable-p + window delta nil nil nil nil nil pixelwise) + (window-resize window delta nil nil pixelwise))) + ;; Else check whether the window is not wide enough. + (let* ((min-size (window-min-size window t ignore pixelwise)) + (delta (- min-size (window-size window t pixelwise)))) + (when (and (> delta 0) + (window--resizable-p + window delta t ignore nil nil nil pixelwise)) + (window-resize window delta t ignore pixelwise)))) + ;; Set dedicated status. + (set-window-dedicated-p window (cdr (assq 'dedicated state))) + ;; Install positions (maybe we should do this after all + ;; windows have been created and sized). + (ignore-errors + (set-window-start window (cdr (assq 'start state))) + (set-window-point window (cdr (assq 'point state)))) + ;; Select window if it's the selected one. + (when (cdr (assq 'selected state)) + (select-window window))) + ;; We don't want to raise an error in case the buffer does + ;; not exist anymore, so we switch to a previous one and + ;; save the window with the intention of deleting it later + ;; if possible. + (switch-to-prev-buffer window) + (push window window-state-put-stale-windows))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. STATE should be the state of a window returned by an earlier invocation of `window-state-get'. Optional argument WINDOW must -specify a live window and defaults to the selected one. +specify a valid window and defaults to the selected one. If +WINDOW is not live, replace WINDOW by a live one before putting +STATE into it. Optional argument IGNORE non-nil means ignore minimum window sizes and fixed size restrictions. IGNORE equal `safe' means windows can get as small as `window-safe-min-height' and `window-safe-min-width'." - (setq window (window-normalize-window window t)) + (setq window-state-put-stale-windows nil) + (setq window (window-normalize-window window)) + + ;; When WINDOW is internal, reduce it to a live one to put STATE into, + ;; see Bug#16793. + (unless (window-live-p window) + (let ((root (frame-root-window window))) + (if (eq window root) + (setq window (frame-first-window root)) + (setq root window) + (setq window (catch 'live + (walk-window-subtree + (lambda (window) + (when (window-live-p window) + (throw 'live window))) + root)))) + (delete-other-windows-internal window root))) + (let* ((frame (window-frame window)) (head (car state)) ;; We check here (1) whether the total sizes of root window of ;; STATE and that of WINDOW are equal so we can avoid ;; calculating new sizes, and (2) if we do have to resize ;; whether we can do so without violating size restrictions. - (totals - (and (= (window-total-size window) - (cdr (assq 'total-height state))) - (= (window-total-size window t) - (cdr (assq 'total-width state))))) - (min-height (cdr (assq 'min-height head))) - (min-width (cdr (assq 'min-width head)))) + (pixelwise (and (cdr (assq 'pixel-width state)) + (cdr (assq 'pixel-height state)))) + (totals (or (and pixelwise + (= (window-pixel-width window) + (cdr (assq 'pixel-width state))) + (= (window-pixel-height window) + (cdr (assq 'pixel-height state)))) + (and (= (window-total-width window) + (cdr (assq 'total-width state))) + (= (window-total-height window) + (cdr (assq 'total-height state)))))) + (min-height (cdr (assq + (if pixelwise 'min-pixel-height 'min-height) + head))) + (min-width (cdr (assq + (if pixelwise 'min-pixel-width 'min-weight) + head)))) (if (and (not totals) - (or (> min-height (window-total-size window)) - (> min-width (window-total-size window t))) + (or (> min-height (window-size window nil pixelwise)) + (> min-width (window-size window t pixelwise))) (or (not ignore) (and (setq min-height - (cdr (assq 'min-height-ignore head))) + (cdr (assq + (if pixelwise + 'min-pixel-height-ignore + 'min-height-ignore) + head))) (setq min-width - (cdr (assq 'min-width-ignore head))) - (or (> min-height (window-total-size window)) - (> min-width (window-total-size window t))) + (cdr (assq + (if pixelwise + 'min-pixel-width-ignore + 'min-width-ignore) + head))) + (or (> min-height + (window-size window nil pixelwise)) + (> min-width + (window-size window t pixelwise))) (or (not (eq ignore 'safe)) (and (setq min-height - (cdr (assq 'min-height-safe head))) + (cdr (assq + (if pixelwise + 'min-pixel-height-safe + 'min-height-safe) + head))) (setq min-width - (cdr (assq 'min-width-safe head))) + (cdr (assq + (if pixelwise + 'min-pixel-width-safe + 'min-width-safe) + head))) (or (> min-height - (window-total-size window)) + (window-size window nil pixelwise)) (> min-width - (window-total-size window t)))))))) + (window-size window t pixelwise)))))))) ;; The check above might not catch all errors due to rounding ;; issues - so IGNORE equal 'safe might not always produce the ;; minimum possible state. But such configurations hardly make @@ -4537,8 +5199,12 @@ windows can get as small as `window-safe-min-height' and ;; all live windows have been set by `window--state-put-2'. (with-temp-buffer (set-window-buffer window (current-buffer)) - (window--state-put-1 state window nil totals) - (window--state-put-2 ignore)) + (window--state-put-1 state window nil totals pixelwise) + (window--state-put-2 ignore pixelwise)) + (while window-state-put-stale-windows + (let ((window (pop window-state-put-stale-windows))) + (when (eq (window-deletable-p window) t) + (delete-window window)))) (window--check frame)))) (defun display-buffer-record-window (type window buffer) @@ -4577,7 +5243,7 @@ element is BUFFER." ;; Preserve window-point-insertion-type (Bug#12588). (copy-marker (window-point window) window-point-insertion-type) - (window-total-size window)) + (window-total-height window)) (selected-window) buffer))))) ((eq type 'window) ;; WINDOW has been created on an existing frame. @@ -5204,10 +5870,31 @@ live." (set-window-prev-buffers window nil))) (let ((parameter (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) - (width (cdr (assq 'window-width alist)))) - (when (or (eq type 'window) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'window))) + (width (cdr (assq 'window-width alist))) + (size (cdr (assq 'window-size alist)))) + (cond + ((or (eq type 'frame) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'frame))) + ;; Adjust size of frame if asked for. + (cond + ((not size)) + ((consp size) + (let ((width (car size)) + (height (cdr size)) + (frame (window-frame window))) + (when (and (numberp width) (numberp height)) + (set-frame-height + frame (+ (frame-height frame) + (- height (window-total-height window)))) + (set-frame-width + frame (+ (frame-width frame) + (- width (window-total-width window))))))) + ((functionp size) + (ignore-errors (funcall size window))))) + ((or (eq type 'window) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'window))) ;; Adjust height of window if asked for. (cond ((not height)) @@ -5216,10 +5903,10 @@ live." (if (integerp height) height (round - (* (window-total-size (frame-root-window window)) + (* (window-total-height (frame-root-window window)) height)))) - (delta (- new-height (window-total-size window)))) - (when (and (window-resizable-p window delta nil 'safe) + (delta (- new-height (window-total-height window)))) + (when (and (window--resizable-p window delta nil 'safe) (window-combined-p window)) (window-resize window delta nil 'safe)))) ((functionp height) @@ -5232,14 +5919,14 @@ live." (if (integerp width) width (round - (* (window-total-size (frame-root-window window) t) + (* (window-total-width (frame-root-window window)) width)))) - (delta (- new-width (window-total-size window t)))) - (when (and (window-resizable-p window delta t 'safe) + (delta (- new-width (window-total-width window)))) + (when (and (window--resizable-p window delta t 'safe) (window-combined-p window t)) (window-resize window delta t 'safe)))) ((functionp width) - (ignore-errors (funcall width window)))))) + (ignore-errors (funcall width window))))))) window)) @@ -5272,6 +5959,7 @@ The actual non-nil value of this variable will be copied to the (const display-buffer-pop-up-window) (const display-buffer-same-window) (const display-buffer-pop-up-frame) + (const display-buffer-in-previous-window) (const display-buffer-use-some-window) (function :tag "Other function")) "Custom type for `display-buffer' action functions.") @@ -5337,6 +6025,7 @@ See `display-buffer' for details." '((display-buffer--maybe-same-window ;FIXME: why isn't this redundant? display-buffer-reuse-window display-buffer--maybe-pop-up-frame-or-window + display-buffer-in-previous-window display-buffer-use-some-window ;; If all else fails, pop up a new frame. display-buffer-pop-up-frame)) @@ -5391,9 +6080,11 @@ where FUNCTION is either a function or a list of functions, and ALIST is an arbitrary association list (alist). Each such FUNCTION should accept two arguments: the buffer to -display and an alist. Based on those arguments, it should either -display the buffer and return the window, or return nil if unable -to display the buffer. +display and an alist. Based on those arguments, it should +display the buffer and return the window. If the caller is +prepared to handle the case of not displaying the buffer +and returning nil from `display-buffer' it should pass +\(allow-no-window . t) as an element of the ALIST. The `display-buffer' function builds a function list and an alist by combining the functions and alists specified in @@ -5412,6 +6103,7 @@ Available action functions include: `display-buffer-reuse-window' `display-buffer-pop-up-frame' `display-buffer-pop-up-window' + `display-buffer-in-previous-window' `display-buffer-use-some-window' Recognized alist entries include: @@ -5447,6 +6139,10 @@ Recognized alist entries include: argument - a new window. The function is supposed to adjust the width of the window; its return value is ignored. + `allow-no-window' -- A non-nil value indicates readiness for the case + of not displaying the buffer and FUNCTION can safely return + a non-window value to suppress displaying. + The ACTION argument to `display-buffer' can also have a non-nil and non-list value. This means to display the buffer in a window other than the selected one, even if it is already displayed in @@ -5457,6 +6153,9 @@ argument, ACTION is t." (let ((buffer (if (bufferp buffer-or-name) buffer-or-name (get-buffer buffer-or-name))) + ;; Make sure that when we split windows the old window keeps + ;; point, bug#14829. + (split-window-keep-point t) ;; Handle the old form of the first argument. (inhibit-same-window (and action (not (listp action))))) (unless (listp action) (setq action nil)) @@ -5491,10 +6190,10 @@ argument, ACTION is t." (while (and functions (not window)) (setq window (funcall (car functions) buffer alist) functions (cdr functions))) - window)))) + (and (windowp window) window))))) (defun display-buffer-other-frame (buffer) - "Display buffer BUFFER in another frame. + "Display buffer BUFFER preferably in another frame. This uses the function `display-buffer' as a subroutine; see its documentation for additional customization information." (interactive "BDisplay buffer in other frame: ") @@ -5594,7 +6293,10 @@ new frame." (fun pop-up-frame-function) frame window) (when (and fun - (setq frame (funcall fun)) + ;; Make BUFFER current so `make-frame' will use it as the + ;; new frame's buffer (Bug#15133). + (with-current-buffer buffer + (setq frame (funcall fun))) (setq window (frame-selected-window frame))) (prog1 (window--display-buffer buffer window 'frame alist display-buffer-mark-dedicated) @@ -5651,7 +6353,9 @@ This either splits the selected window or reuses the window below the selected one." (let (window) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window (selected-window) alist)) + (let ((split-height-threshold 0) + split-width-threshold) + (setq window (window--try-to-split-window (selected-window) alist))) (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window (window-in-direction 'below)) @@ -5665,15 +6369,17 @@ This either splits the window at the bottom of the frame or the frame's root window, or reuses an existing window at the bottom of the selected frame." (let (bottom-window window) - (walk-window-tree (lambda (window) (setq bottom-window window))) + (walk-window-tree + (lambda (window) (setq bottom-window window)) nil nil 'nomini) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window bottom-window alist)) + (let (split-width-threshold) + (setq window (window--try-to-split-window bottom-window alist))) (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)) (and (not (frame-parameter nil 'unsplittable)) (setq window (condition-case nil - (split-window (frame-root-window)) + (split-window (window--major-non-side-window)) (error nil))) (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)) @@ -5714,7 +6420,7 @@ above, even if that window never showed BUFFER before." 0) (display-buffer-reuse-frames 0) (t (last-nonminibuffer-frame)))) - entry best-window second-best-window window) + best-window second-best-window window) ;; Scan windows whether they have shown the buffer recently. (catch 'best (dolist (window (window-list-1 (frame-first-window) 'nomini frames)) @@ -5761,14 +6467,36 @@ that frame." (unless (and not-this-window (eq window (selected-window))) window)) - (get-largest-window 0 not-this-window)))) + (get-largest-window 0 nil not-this-window))) + (quit-restore (and (window-live-p window) + (window-parameter window 'quit-restore))) + (quad (nth 1 quit-restore))) (when (window-live-p window) + ;; If the window was used by `display-buffer' before, try to + ;; resize it to its old height but don't signal an error. + (when (and (listp quad) + (integerp (nth 3 quad)) + (/= (nth 3 quad) (window-total-height window))) + (condition-case nil + (window-resize window (- (nth 3 quad) (window-total-height window))) + (error nil))) + (prog1 (window--display-buffer buffer window 'reuse alist) (window--even-window-heights window) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) +(defun display-buffer-no-window (_buffer alist) + "Display BUFFER in no window. +If ALIST has a non-nil `allow-no-window' entry, then don't display +a window at all. This makes possible to override the default action +and avoid displaying the buffer. It is assumed that when the caller +specifies a non-nil `allow-no-window' then it can handle a nil value +returned from `display-buffer' in this case." + (when (cdr (assq 'allow-no-window alist)) + 'fail)) + ;;; Display + selection commands: (defun pop-to-buffer (buffer &optional action norecord) "Select buffer BUFFER in some window, preferably a different one. @@ -5792,7 +6520,8 @@ at the front of the list of recently selected ones." (interactive (list (read-buffer "Pop to buffer: " (other-buffer)) (if current-prefix-arg t))) (setq buffer (window-normalize-buffer-to-switch-to buffer)) - (set-buffer buffer) + ;; This should be done by `select-window' below. + ;; (set-buffer buffer) (let* ((old-frame (selected-frame)) (window (display-buffer buffer action)) (frame (window-frame window))) @@ -5805,20 +6534,16 @@ at the front of the list of recently selected ones." (defun pop-to-buffer-same-window (buffer &optional norecord) "Select buffer BUFFER in some window, preferably the same one. -This function behaves much like `switch-to-buffer', except it -displays with `special-display-function' if BUFFER has a match in -`special-display-buffer-names' or `special-display-regexps'. - -Unlike `pop-to-buffer', this function prefers using the selected -window over popping up a new window or frame. - BUFFER may be a buffer, a string (a buffer name), or nil. If it is a string not naming an existent buffer, create a buffer with that name. If BUFFER is nil, choose some other buffer. Return the buffer. -NORECORD, if non-nil means do not put this buffer at the front of -the list of recently selected ones." +Optional argument NORECORD, if non-nil means do not put this +buffer at the front of the list of recently selected ones. + +Unlike `pop-to-buffer', this function prefers using the selected +window over popping up a new window or frame." (pop-to-buffer buffer display-buffer--same-window-action norecord)) (defun read-buffer-to-switch (prompt) @@ -6074,211 +6799,496 @@ WINDOW must be a live window and defaults to the selected one." (eobp) window)))) -;;; Resizing buffers to fit their contents exactly. -(defcustom fit-frame-to-buffer nil - "Non-nil means `fit-window-to-buffer' can resize frames. -A frame can be resized if and only if its root window is a live -window. The height of the root window is subject to the values -of `fit-frame-to-buffer-max-height' and `window-min-height'." +;;; Resizing windows and frames to fit their contents exactly. +(defcustom fit-window-to-buffer-horizontally nil + "Non-nil means `fit-window-to-buffer' can resize windows horizontally. +If this is nil, `fit-window-to-buffer' never resizes windows +horizontally. If this is `only', it can resize windows +horizontally only. Any other value means `fit-window-to-buffer' +can resize windows in both dimensions." :type 'boolean - :version "24.3" + :version "24.4" :group 'help) -(defcustom fit-frame-to-buffer-bottom-margin 4 - "Bottom margin for the command `fit-frame-to-buffer'. -This is the number of lines that function leaves free at the bottom of -the display, in order to not obscure any system task bar or panel. -If you do not have one (or if it is vertical) you might want to -reduce this. If it is thicker, you might want to increase this." - ;; If you set this too small, fit-frame-to-buffer can shift the - ;; frame up to avoid the panel. - :type 'integer - :version "24.3" - :group 'windows) +;; `fit-frame-to-buffer' eventually wants to know the real frame sizes +;; counting title bar and outer borders. +(defcustom fit-frame-to-buffer nil + "Non-nil means `fit-frame-to-buffer' can fit a frame to its buffer. +A frame is fit if and only if its root window is a live window +and this option is non-nil. If this is `horizontally', frames +are resized horizontally only. If this is `vertically', frames +are resized vertically only. Any other non-nil value means +frames can be resized in both dimensions. See also +`fit-frame-to-buffer-margins' and `fit-frame-to-buffer-sizes'. -(defun fit-frame-to-buffer (&optional frame max-height min-height) - "Adjust height of FRAME to display its buffer contents exactly. +If this is non-nil and a window is the only window of its frame, +`fit-window-to-buffer' will invoke `fit-frame-to-buffer' to fit +the frame to its buffer." + :type 'boolean + :version "24.4" + :group 'help) + +(defcustom fit-frame-to-buffer-margins '(nil nil nil nil) + "Margins around frame for `fit-frame-to-buffer'. +This list specifies the numbers of pixels to be left free on the +left, above, the right, and below a frame that shall be fit to +its buffer. The value specified here can be overridden for a +specific frame by that frame's `fit-frame-to-buffer-margins' +parameter, if present. + +This variable controls how fitting a frame to the size of its +buffer coordinates with the size of your display. If you don't +specify a value here, the size of the display's workarea is used. + +See also `fit-frame-to-buffer-sizes'." + :version "24.4" + :type '(list + (choice + :tag "Left" + :value nil + :format "%[LeftMargin%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Pixels" :size 5)) + (choice + :tag "Top" + :value nil + :format "%[TopMargin%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Pixels" :size 5)) + (choice + :tag "Right" + :value nil + :format "%[RightMargin%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Pixels" :size 5)) + (choice + :tag "Bottom" + :value nil + :format "%[BottomMargin%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Pixels" :size 5))) + :group 'help) + +(defcustom fit-frame-to-buffer-sizes '(nil nil nil nil) + "Size boundaries of frame for `fit-frame-to-buffer'. +This list specifies the total maximum and minimum lines and +maximum and minimum columns of the root window of any frame that +shall be fit to its buffer. If any of these values is non-nil, +it overrides the corresponding argument of `fit-frame-to-buffer'. + +On window systems where the menubar can wrap, fitting a frame to +its buffer may swallow the last line(s). Specifying an +appropriate minimum width value here can avoid such wrapping. + +See also `fit-frame-to-buffer-margins'." + :version "24.4" + :type '(list + (choice + :tag "Maximum Height" + :value nil + :format "%[MaxHeight%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Lines" :size 5)) + (choice + :tag "Minimum Height" + :value nil + :format "%[MinHeight%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Lines" :size 5)) + (choice + :tag "Maximum Width" + :value nil + :format "%[MaxWidth%] %v " + (const :tag "None" :format "%t" nil) + (integer :tag "Columns" :size 5)) + (choice + :tag "Minimum Width" + :value nil + :format "%[MinWidth%] %v\n" + (const :tag "None" :format "%t" nil) + (integer :tag "Columns" :size 5))) + :group 'help) + +(declare-function x-display-pixel-height "xfns.c" (&optional terminal)) + +(defun window--sanitize-margin (margin left right) + "Return MARGIN if it's a number between LEFT and RIGHT." + (when (and (numberp margin) + (<= left (- right margin)) (<= margin right)) + margin)) + +(defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width) + "Adjust size of FRAME to display the contents of its buffer exactly. FRAME can be any live frame and defaults to the selected one. +Fit only if FRAME's root window is live. MAX-HEIGHT, MIN-HEIGHT, +MAX-WIDTH and MIN-WIDTH specify bounds on the new total size of +FRAME's root window. MIN-HEIGHT and MIN-WIDTH default to the values of +`window-min-height' and `window-min-width' respectively. -Optional argument MAX-HEIGHT specifies the maximum height of FRAME. -It defaults to the height of the display below the current -top line of FRAME, minus `fit-frame-to-buffer-bottom-margin'. -Optional argument MIN-HEIGHT specifies the minimum height of FRAME. -The default corresponds to `window-min-height'." +The option `fit-frame-to-buffer' controls whether this function +has any effect. New position and size of FRAME are additionally +determined by the options `fit-frame-to-buffer-sizes' and +`fit-frame-to-buffer-margins' or the corresponding parameters of +FRAME." (interactive) + (unless (and (fboundp 'x-display-pixel-height) + ;; We need the respective sizes now. + (fboundp 'display-monitor-attributes-list)) + (user-error "Cannot resize frame in non-graphic Emacs")) (setq frame (window-normalize-frame frame)) - (let* ((root (frame-root-window frame)) - (frame-min-height - (+ (- (frame-height frame) (window-total-size root)) - window-min-height)) - (frame-top (frame-parameter frame 'top)) - (top (if (consp frame-top) - (funcall (car frame-top) (cadr frame-top)) - frame-top)) - (frame-max-height - (- (/ (- (x-display-pixel-height frame) top) - (frame-char-height frame)) - fit-frame-to-buffer-bottom-margin)) - (compensate 0) - delta) - (when (and (window-live-p root) (not (window-size-fixed-p root))) - (with-selected-window root + (when (and (window-live-p (frame-root-window frame)) + fit-frame-to-buffer + (or (not window-size-fixed) + (and (eq window-size-fixed 'height) + (not (eq fit-frame-to-buffer 'vertically))) + (and (eq window-size-fixed 'width) + (not (eq fit-frame-to-buffer 'horizontally))))) + (with-selected-window (frame-root-window frame) + (let* ((window (frame-root-window frame)) + (char-width (frame-char-width)) + (char-height (frame-char-height)) + (monitor-attributes (car (display-monitor-attributes-list + (frame-parameter frame 'display)))) + (geometry (cdr (assq 'geometry monitor-attributes))) + (display-width (- (nth 2 geometry) (nth 0 geometry))) + (display-height (- (nth 3 geometry) (nth 1 geometry))) + (workarea (cdr (assq 'workarea monitor-attributes))) + ;; Handle margins. + (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins) + fit-frame-to-buffer-margins)) + (left-margin (if (nth 0 margins) + (or (window--sanitize-margin + (nth 0 margins) 0 display-width) + 0) + (nth 0 workarea))) + (top-margin (if (nth 1 margins) + (or (window--sanitize-margin + (nth 1 margins) 0 display-height) + 0) + (nth 1 workarea))) + (workarea-width (nth 2 workarea)) + (right-margin (if (nth 2 margins) + (- display-width + (or (window--sanitize-margin + (nth 2 margins) left-margin display-width) + 0)) + (nth 2 workarea))) + (workarea-height (nth 3 workarea)) + (bottom-margin (if (nth 3 margins) + (- display-height + (or (window--sanitize-margin + (nth 3 margins) top-margin display-height) + 0)) + (nth 3 workarea))) + ;; The pixel width of FRAME (which does not include the + ;; window manager's decorations). + (frame-width (frame-pixel-width)) + ;; The pixel width of the body of FRAME's root window. + (window-body-width (window-body-width nil t)) + ;; The difference in pixels between total and body width of + ;; FRAME's window. + (window-extra-width (- (window-pixel-width) window-body-width)) + ;; The difference in pixels between the frame's pixel width + ;; and the window's body width. This is the space we can't + ;; use for fitting. + (extra-width (- frame-width window-body-width)) + ;; The maximum width we can use for fitting. + (fit-width (- workarea-width extra-width)) + ;; The pixel position of FRAME's left border. We usually + ;; try to leave this alone. + (left + (let ((left (frame-parameter nil 'left))) + (if (consp left) + (funcall (car left) (cadr left)) + left))) + ;; The pixel height of FRAME (which does not include title + ;; line, decorations, and sometimes neither the menu nor + ;; the toolbar). + (frame-height (frame-pixel-height)) + ;; The pixel height of FRAME's root window (we don't care + ;; about the window's body height since the return value of + ;; `window-text-pixel-size' includes header and mode line). + (window-height (window-pixel-height)) + ;; The difference in pixels between the frame's pixel + ;; height and the window's height. + (extra-height (- frame-height window-height)) + ;; When tool-bar-mode is enabled and we just created a new + ;; frame, reserve lines for toolbar resizing. Needed + ;; because for reasons unknown to me Emacs (1) reserves one + ;; line for the toolbar when making the initial frame and + ;; toolbars are enabled, and (2) later adds the remaining + ;; lines needed. Our code runs IN BETWEEN (1) and (2). + ;; YMMV when you're on a system that behaves differently. + (toolbar-extra-height + (let ((quit-restore (window-parameter window 'quit-restore)) + ;; This may have to change when we allow arbitrary + ;; pixel height toolbars. + (lines (tool-bar-height))) + (* char-height + (if (and quit-restore (eq (car quit-restore) 'frame) + (not (zerop lines))) + (1- lines) + 0)))) + ;; The pixel position of FRAME's top border. + (top + (let ((top (frame-parameter nil 'top))) + (if (consp top) + (funcall (car top) (cadr top)) + top))) + ;; Sanitize minimum and maximum sizes. + (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes) + fit-frame-to-buffer-sizes)) + (max-height + (cond + ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height)) + ((numberp max-height) (* max-height char-height)) + (t display-height))) + (min-height + (cond + ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height)) + ((numberp min-height) (* min-height char-height)) + (t (* window-min-height char-height)))) + (max-width + (cond + ((numberp (nth 2 sizes)) + (- (* (nth 2 sizes) char-width) window-extra-width)) + ((numberp max-width) + (- (* max-width char-width) window-extra-width)) + (t display-height))) + (min-width + (cond + ((numberp (nth 3 sizes)) + (- (* (nth 3 sizes) char-width) window-extra-width)) + ((numberp min-width) + (- (* min-width char-width) window-extra-width)) + (t (* window-min-width char-width)))) + ;; Note: Currently, for a new frame the sizes of the header + ;; and mode line may be estimated incorrectly + (value (window-text-pixel-size + nil t t workarea-width workarea-height t)) + (width (+ (car value) (window-right-divider-width))) + (height (+ (cdr value) (window-bottom-divider-width)))) + ;; Don't change height or width when the window's size is fixed + ;; in either direction. (cond - ((not max-height) - (setq max-height frame-max-height)) - ((numberp max-height) - (setq max-height (min max-height frame-max-height))) - (t - (error "%s is an invalid maximum height" max-height))) - (cond - ((not min-height) - (setq min-height frame-min-height)) - ((numberp min-height) - (setq min-height (min min-height frame-min-height))) - (t - (error "%s is an invalid minimum height" min-height))) - ;; When tool-bar-mode is enabled and we have just created a new - ;; frame, reserve lines for toolbar resizing. This is needed - ;; because for reasons unknown to me Emacs (1) reserves one line - ;; for the toolbar when making the initial frame and toolbars - ;; are enabled, and (2) later adds the remaining lines needed. - ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a - ;; system that behaves differently. - (let ((quit-restore (window-parameter root 'quit-restore)) - (lines (tool-bar-lines-needed frame))) - (when (and quit-restore (eq (car quit-restore) 'frame) - (not (zerop lines))) - (setq compensate (1- lines)))) - (message "%s" compensate) - (setq delta - ;; Always count a final newline - we don't do any - ;; post-processing, so let's play safe. - (+ (count-screen-lines nil nil t) - (- (window-body-size)) - compensate))) - ;; Move away from final newline. - (when (and (eobp) (bolp) (not (bobp))) - (set-window-point root (line-beginning-position 0))) - (set-window-start root (point-min)) - (set-window-vscroll root 0) - (condition-case nil - (set-frame-height - frame - (min (max (+ (frame-height frame) delta) - min-height) - max-height)) - (error (setq delta nil)))) - delta)) + ((eq window-size-fixed 'width) + (setq width nil)) + ((eq window-size-fixed 'height) + (setq height nil))) + ;; Fit width to constraints. + (when width + (unless frame-resize-pixelwise + ;; Round to character sizes. + (setq width (* (/ (+ width char-width -1) char-width) + char-width))) + ;; Fit to maximum and minimum widths. + (setq width (max (min width max-width) min-width)) + ;; Add extra width. + (setq width (+ width extra-width)) + ;; Preserve margins. + (let ((right (+ left width))) + (cond + ((> right right-margin) + ;; Move frame to left (we don't know its real width). + (setq left (max left-margin (- left (- right right-margin))))) + ((< left left-margin) + ;; Move frame to right. + (setq left left-margin))))) + ;; Fit height to constraints. + (when height + (unless frame-resize-pixelwise + (setq height (* (/ (+ height char-height -1) char-height) + char-height))) + ;; Fit to maximum and minimum heights. + (setq height (max (min height max-height) min-height)) + ;; Add extra height. + (setq height (+ height extra-height)) + ;; Preserve margins. + (let ((bottom (+ top height))) + (cond + ((> bottom bottom-margin) + ;; Move frame up (we don't know its real height). + (setq top (max top-margin (- top (- bottom bottom-margin))))) + ((< top top-margin) + ;; Move frame down. + (setq top top-margin))))) + ;; Apply changes. + (set-frame-position frame left top) + ;; Clumsily try to translate our calculations to what + ;; `set-frame-size' wants. + (when width + (setq width (- (+ (frame-text-width) width) + extra-width window-body-width))) + (when height + (setq height (- (+ (frame-text-height) height) + extra-height window-height))) + (set-frame-size + frame + (if width + (if frame-resize-pixelwise + width + (/ width char-width)) + (frame-text-width)) + (if height + (if frame-resize-pixelwise + height + (/ height char-height)) + (frame-text-height)) + frame-resize-pixelwise))))) -(defun fit-window-to-buffer (&optional window max-height min-height) - "Adjust height of WINDOW to display its buffer's contents exactly. +(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width) + "Adjust size of WINDOW to display its buffer's contents exactly. WINDOW must be a live window and defaults to the selected one. -Optional argument MAX-HEIGHT specifies the maximum height of -WINDOW and defaults to the height of WINDOW's frame. Optional -argument MIN-HEIGHT specifies the minimum height of WINDOW and -defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT -are specified in lines and include the mode line and header line, -if any. +If WINDOW is part of a vertical combination, adjust WINDOW's +height. The new height is calculated from the number of lines of +the accessible portion of its buffer. The optional argument +MAX-HEIGHT specifies a maximum height and defaults to the height +of WINDOW's frame. The optional argument MIN-HEIGHT specifies a +minimum height and defaults to `window-min-height'. Both +MAX-HEIGHT and MIN-HEIGHT are specified in lines and include the +mode line and header line, if any. -If WINDOW is a full height window, then if the option -`fit-frame-to-buffer' is non-nil, this calls the function -`fit-frame-to-buffer' to adjust the frame height. +If WINDOW is part of a horizontal combination and the value of +the option `fit-window-to-buffer-horizontally' is non-nil, adjust +WINDOW's height. The new width of WINDOW is calculated from the +maximum length of its buffer's lines that follow the current +start position of WINDOW. The optional argument MAX-WIDTH +specifies a maximum width and defaults to the width of WINDOW's +frame. The optional argument MIN-WIDTH specifies a minimum width +and defaults to `window-min-width'. Both MAX-WIDTH and MIN-WIDTH +are specified in columns and include fringes, margins and +scrollbars, if any. -Return the number of lines by which WINDOW was enlarged or -shrunk. If an error occurs during resizing, return nil but don't -signal an error. +Fit pixelwise if the option `window-resize-pixelwise' is non-nil. +If WINDOW is its frame's root window, then if the option +`fit-frame-to-buffer' is non-nil, call `fit-frame-to-buffer' to +adjust the frame's size. Note that even if this function makes WINDOW large enough to show -_all_ lines of its buffer you might not see the first lines when -WINDOW was scrolled." +_all_ parts of its buffer you might not see the first part when +WINDOW was scrolled. If WINDOW is resized horizontally, you will +not see the top of its buffer unless WINDOW starts at its minimum +accessible position." (interactive) (setq window (window-normalize-window window t)) - (cond - ((window-size-fixed-p window)) - ((window-full-height-p window) - (when fit-frame-to-buffer - (fit-frame-to-buffer (window-frame window)))) - (t + (if (eq window (frame-root-window window)) + (when fit-frame-to-buffer + ;; Fit WINDOW's frame to buffer. + (fit-frame-to-buffer + (window-frame window) + max-height min-height max-width min-width)) (with-selected-window window - (let* ((height (window-total-size)) + (let* ((pixelwise window-resize-pixelwise) + (char-height (frame-char-height)) + (char-width (frame-char-width)) + (total-height (window-size window nil pixelwise)) + (body-height (window-body-height window pixelwise)) + (body-width (window-body-width window pixelwise)) (min-height - ;; Adjust MIN-HEIGHT. + ;; Sanitize MIN-HEIGHT. (if (numberp min-height) ;; Can't get smaller than `window-safe-min-height'. - (max min-height window-safe-min-height) + (max (if pixelwise + (* char-height min-height) + min-height) + (if pixelwise + (window-safe-min-pixel-height window) + window-safe-min-height)) ;; Preserve header and mode line if present. - (window-min-size nil nil t))) + (max (if pixelwise + (* char-height window-min-height) + window-min-height) + (window-min-size nil nil t pixelwise)))) (max-height - ;; Adjust MAX-HEIGHT. + ;; Sanitize MAX-HEIGHT. (if (numberp max-height) - ;; Can't get larger than height of frame. - (min max-height - (window-total-size (frame-root-window window))) - ;; Don't delete other windows. - (+ height (window-max-delta nil nil window)))) - ;; Make `desired-height' the height necessary to show - ;; all of WINDOW's buffer, constrained by MIN-HEIGHT - ;; and MAX-HEIGHT. - (desired-height - (max - (min - (+ (count-screen-lines) - ;; For non-minibuffers count the mode line, if any. - (if (and (not (window-minibuffer-p window)) - mode-line-format) - 1 - 0) - ;; Count the header line, if any. - (if header-line-format 1 0)) - max-height) - min-height)) - (desired-delta - (- desired-height (window-total-size window))) - (delta - (if (> desired-delta 0) - (min desired-delta - (window-max-delta window nil window)) - (max desired-delta - (- (window-min-delta window nil window)))))) - (condition-case nil - (if (zerop delta) - ;; Return zero if DELTA became zero in the process. - 0 - ;; Don't try to redisplay with the cursor at the end on its - ;; own line--that would force a scroll and spoil things. - (when (and (eobp) (bolp) (not (bobp))) - ;; It's silly to put `point' at the end of the previous - ;; line and so maybe force horizontal scrolling. - (set-window-point window (line-beginning-position 0))) - ;; Call `window-resize' with OVERRIDE argument equal WINDOW. - (window-resize window delta nil window) - ;; Check if the last line is surely fully visible. If - ;; not, enlarge the window. - (let ((end (save-excursion - (goto-char (point-max)) - (when (and (bolp) (not (bobp))) - ;; Don't include final newline. - (backward-char 1)) - (when truncate-lines - ;; If line-wrapping is turned off, test the - ;; beginning of the last line for - ;; visibility instead of the end, as the - ;; end of the line could be invisible by - ;; virtue of extending past the edge of the - ;; window. - (forward-line 0)) - (point)))) - (set-window-vscroll window 0) - ;; This loop might in some rare pathological cases raise - ;; an error - another reason for the `condition-case'. - (while (and (< desired-height max-height) - (= desired-height (window-total-size)) - (not (pos-visible-in-window-p end))) - (window-resize window 1 nil window) - (setq desired-height (1+ desired-height))))) - (error (setq delta nil))) - delta))))) + (min + (+ total-height + (window-max-delta + window nil nil nil nil nil pixelwise)) + (if pixelwise + (* char-height max-height) + max-height)) + (+ total-height (window-max-delta + window nil nil nil nil nil pixelwise)))) + height) + (cond + ;; If WINDOW is vertically combined, try to resize it + ;; vertically. + ((and (not (eq fit-window-to-buffer-horizontally 'only)) + (not (window-size-fixed-p window)) + (window-combined-p)) + ;; Vertically we always want to fit the entire buffer. + ;; WINDOW'S height can't get larger than its frame's pixel + ;; height. Its width remains fixed. + (setq height (+ (cdr (window-text-pixel-size + nil nil t nil (frame-pixel-height) t)) + (window-bottom-divider-width))) + ;; Round height. + (unless pixelwise + (setq height (/ (+ height char-height -1) char-height))) + (unless (= height total-height) + (window-resize-no-error + window + (- (max min-height (min max-height height)) total-height) + nil window pixelwise))) + ;; If WINDOW is horizontally combined, try to resize it + ;; horizontally. + ((and fit-window-to-buffer-horizontally + (not (window-size-fixed-p window t)) + (window-combined-p nil t)) + (let* ((total-width (window-size window nil pixelwise)) + (min-width + ;; Sanitize MIN-WIDTH. + (if (numberp min-width) + ;; Can't get smaller than `window-safe-min-width'. + (max (if pixelwise + (* char-width min-width) + min-width) + (if pixelwise + (window-safe-min-pixel-width) + window-safe-min-width)) + ;; Preserve fringes, margins, scrollbars if present. + (max (if pixelwise + (* char-width window-min-width) + window-min-width) + (window-min-size nil nil t pixelwise)))) + (max-width + ;; Sanitize MAX-WIDTH. + (if (numberp max-width) + (min (+ total-width + (window-max-delta + nil t nil nil nil nil pixelwise)) + (if pixelwise + (* char-width max-width) + max-width)) + (+ total-width (window-max-delta + nil t nil nil nil nil pixelwise)))) + ;; When fitting vertically, assume that WINDOW's start + ;; position remains unaltered. WINDOW can't get wider + ;; than its frame's pixel width, its height remains + ;; unaltered. + (width (+ (car (window-text-pixel-size + nil (window-start) (point-max) + (frame-pixel-width) + ;; Add one char-height to assure that + ;; we're on the safe side. This + ;; overshoots when the first line below + ;; the bottom is wider than the window. + (* body-height + (if pixelwise char-height 1)))) + (window-right-divider-width)))) + (unless pixelwise + (setq width (/ (+ width char-width -1) char-width))) + (unless (= width body-width) + (window-resize-no-error + window + (- (max min-width + (min max-width + (+ total-width (- width body-width)))) + total-width) + t window pixelwise))))))))) (defun window-safely-shrinkable-p (&optional window) "Return t if WINDOW can be shrunk without shrinking other windows. @@ -6308,7 +7318,7 @@ Return non-nil if the window was shrunk, nil otherwise." ;; should be taken care of by `fit-window-to-buffer'. (when (and (window-combined-p window) (pos-visible-in-window-p (point-min) window)) - (fit-window-to-buffer window (window-total-size window)))) + (fit-window-to-buffer window (window-total-height window)))) (defun kill-buffer-and-window () "Kill the current buffer and delete the selected window." @@ -6628,11 +7638,14 @@ is active. This function is run by `mouse-autoselect-window-timer'." (window-at (cadr mouse-position) (cddr mouse-position) (car mouse-position))))) (cond - ((or (menu-or-popup-active-p) + ((or (and (fboundp 'menu-or-popup-active-p) (menu-or-popup-active-p)) (and window - (not (coordinates-in-window-p (cdr mouse-position) window)))) - ;; A menu / popup dialog is active or the mouse is on the scroll-bar - ;; of WINDOW, temporarily suspend delayed autoselection. + (let ((coords (coordinates-in-window-p + (cdr mouse-position) window))) + (and (not (consp coords)) + (not (memq coords '(left-margin right-margin))))))) + ;; A menu / popup dialog is active or the mouse is not on the + ;; text region of WINDOW: Suspend autoselection temporarily. (mouse-autoselect-window-start mouse-position nil t)) ((eq mouse-autoselect-window-state 'suspend) ;; Delayed autoselection was temporarily suspended, reenable it. @@ -6660,7 +7673,7 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; minibuffer. Use `unread-command-events' in order to execute pre- ;; and post-command hooks and trigger idle timers. To avoid delaying ;; autoselection again, set `mouse-autoselect-window-state'." - (unless (window-minibuffer-p (selected-window)) + (unless (window-minibuffer-p) (setq mouse-autoselect-window-state 'select) (setq unread-command-events (cons (list 'select-window (list window)) @@ -6686,7 +7699,7 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; minibuffer gets unselected unexpectedly, and where ;; you then have to move your mouse all the way down to ;; the minibuffer to select it. - (window-minibuffer-p (selected-window)) + (window-minibuffer-p) ;; Don't switch to minibuffer window unless it's active. (and (window-minibuffer-p window) (not (minibuffer-window-active-p window))) diff --git a/lisp/winner.el b/lisp/winner.el index dfbd15b6676..1e32a7f4085 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,6 +1,6 @@ ;;; winner.el --- Restore old window configurations -;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2001-2014 Free Software Foundation, Inc. ;; Author: Ivar Rummelhoff ;; Created: 27 Feb 1997 @@ -45,10 +45,8 @@ (if (featurep 'xemacs) `(if ,store (zmacs-activate-region) (zmacs-deactivate-region)) - `(setq mark-active ,store))))) - (if (boundp 'mark-active) - mark-active - (region-active-p))) + `(if ,store (activate-mark) (deactivate-mark)))))) + (region-active-p)) (defalias 'winner-edges (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) @@ -229,8 +227,7 @@ You may want to include buffer names such as *Help*, *Apropos*, (set-window-configuration winconf)) (cond ((window-live-p chosen) (select-window chosen)) - ((window-minibuffer-p (selected-window)) - (other-window 1))) + ((window-minibuffer-p) (other-window 1))) (when (/= minisize (window-height miniwin)) (with-selected-window miniwin (setf (window-height) minisize))))) @@ -344,31 +341,18 @@ You may want to include buffer names such as *Help*, *Apropos*, map) "Keymap for Winner mode.") -;; Check if `window-configuration-change-hook' is working. -(defun winner-hook-installed-p () - (save-window-excursion - (let ((winner-var nil) - (window-configuration-change-hook - '((lambda () (setq winner-var t))))) - (split-window) - winner-var))) - ;;;###autoload (define-minor-mode winner-mode nil :global t ; let d-m-m make the doc (if winner-mode (progn - (if (winner-hook-installed-p) - (progn - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-old-configurations)) - (add-hook 'post-command-hook 'winner-save-conditionally)) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations) (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) (setq winner-modified-list (frame-list)) (winner-save-old-configurations)) (remove-hook 'window-configuration-change-hook 'winner-change-fun) (remove-hook 'post-command-hook 'winner-save-old-configurations) - (remove-hook 'post-command-hook 'winner-save-conditionally) (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally))) ;; Inspired by undo (simple.el) @@ -396,7 +380,7 @@ In other words, \"undo\" changes in window configuration." (setq winner-undone-data (list (winner-win-data)))) (cl-incf winner-undo-counter) ; starting at 1 (when (and (winner-undo-this) - (not (window-minibuffer-p (selected-window)))) + (not (window-minibuffer-p))) (message "Winner undo (%d / %d)" winner-undo-counter (1- (ring-length winner-pending-undo-ring))))))) diff --git a/lisp/woman.el b/lisp/woman.el index 1cead32ab2f..88510517b25 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1,9 +1,9 @@ ;;; woman.el --- browse UN*X manual pages `wo (without) man' -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Francis J. Wright -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: help, unix ;; Adapted-By: Eli Zaretskii ;; Version: 0.551 @@ -438,7 +438,7 @@ As a special case, if PATHS is nil then replace it by calling (if (memq system-type '(windows-nt ms-dos)) (cond ((null paths) (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))) - ((string-match ";" paths) + ((string-match-p ";" paths) ;; Assume DOS-style path-list... (woman-mapcan ; splice list into list (lambda (x) @@ -446,7 +446,7 @@ As a special case, if PATHS is nil then replace it by calling (list x) (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))) (parse-colon-path paths))) - ((string-match "\\`[a-zA-Z]:" paths) + ((string-match-p "\\`[a-zA-Z]:" paths) ;; Assume single DOS-style path... (list paths)) (t @@ -495,6 +495,8 @@ As a special case, if PATHS is nil then replace it by calling (defgroup woman nil "Browse UNIX manual pages `wo (without) man'." :tag "WoMan" + :link '(custom-manual "(woman) Top") + :link '(emacs-commentary-link :tag "Commentary" "woman.el") :group 'help) (defcustom woman-show-log nil @@ -949,7 +951,7 @@ or different fonts." (defun woman-default-faces () "Set foreground colors of italic and bold faces to their default values." - (declare (obsolete choose-completion-guess-base-position "23.2")) + (declare (obsolete "customize the woman-* faces instead." "24.4")) (interactive) (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) @@ -957,7 +959,7 @@ or different fonts." (defun woman-monochrome-faces () "Set foreground colors of italic and bold faces to that of the default face. This is usually either black or white." - (declare (obsolete choose-completion-guess-base-position "23.2")) + (declare (obsolete "customize the woman-* faces instead." "24.4")) (interactive) (set-face-foreground 'woman-italic 'unspecified) (set-face-foreground 'woman-bold 'unspecified)) @@ -974,7 +976,7 @@ This is usually either black or white." ;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does ;; not seem to work and fonts may be repeated, so ... (dolist (font fonts) - (and (string-match "-Symbol-" font) + (and (string-match-p "-Symbol-" font) (not (member font symbol-fonts)) (setq symbol-fonts (cons font symbol-fonts)))) symbol-fonts)) @@ -1173,7 +1175,7 @@ Used non-interactively, arguments are optional: if given then TOPIC should be a topic string and non-nil RE-CACHE forces re-caching." (interactive (list nil current-prefix-arg)) ;; The following test is for non-interactive calls via gnudoit etc. - (if (or (not (stringp topic)) (string-match "\\S " topic)) + (if (or (not (stringp topic)) (string-match-p "\\S " topic)) (let ((file-name (woman-file-name topic re-cache))) (if file-name (woman-find-file file-name) @@ -1614,7 +1616,7 @@ decompress the file if appropriate. See the documentation for the (let* ((bufname (file-name-nondirectory file-name)) (case-fold-search t) (compressed - (not (not (string-match woman-file-compression-regexp bufname))))) + (and (string-match-p woman-file-compression-regexp bufname) t))) (if compressed (setq bufname (file-name-sans-extension bufname))) (setq bufname (if exists @@ -1756,7 +1758,7 @@ Leave point at end of new text. Return length of inserted text." ;; Co-operate with auto-compression mode: (if (and compressed (or (eq compressed t) - (string-match woman-file-compression-regexp filename)) + (string-match-p woman-file-compression-regexp filename)) ;; (not auto-compression-mode) (not (rassq 'jka-compr-handler file-name-handler-alist)) ) ;; (error "Compressed file requires Auto File Decompression turned on") @@ -2192,7 +2194,7 @@ To be called on original buffer and any .so insertions." (let ((face-list (face-list))) (dolist (face face-list) (let ((face-name (symbol-name face))) - (if (and (string-match "\\`woman-" face-name) + (if (and (string-match-p "\\`woman-" face-name) (face-underline-p face)) (let ((face-no-ul (intern (concat face-name "-no-ul")))) (copy-face face face-no-ul) @@ -2300,7 +2302,7 @@ Currently set only from '\" t in the first line of the source file.") ;; Process \k escapes BEFORE changing tab width (?): (goto-char from) - (woman-mark-horizonal-position) + (woman-mark-horizontal-position) ;; Set buffer-local variables: (setq fill-column woman-fill-column @@ -3029,6 +3031,8 @@ Leave point at TO (which should be a marker)." "Delete any double-quote characters up to the end of the line." (woman-unquote (save-excursion (end-of-line) (point-marker)))) +(defvar woman1-unquote) ; bound locally by woman1-roff-buffer + (defun woman1-roff-buffer () "Process non-breaking requests." (let ((case-fold-search t) @@ -3069,8 +3073,6 @@ Leave point at TO (which should be a marker)." ".I -- Set words of current line in italic font." (woman1-B-or-I ".ft I\n")) -(defvar woman1-unquote) ; bound locally by woman1-roff-buffer - (defun woman1-B-or-I (B-or-I) ".B/I -- Set words of current line in bold/italic font. B-OR-I is the appropriate complete control line." @@ -3452,7 +3454,7 @@ Format paragraphs upto TO. Supports special chars. Each element has the form (KEY VALUE . INC) -- inc may be nil. Also bound locally in `woman2-roff-buffer'.") -(defun woman-mark-horizonal-position () +(defun woman-mark-horizontal-position () "\\kx -- Store current horizontal position in INPUT LINE in register x." (while (re-search-forward "\\\\k\\(.\\)" nil t) (goto-char (match-beginning 0)) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 43e9f376d08..a5e3a16ef74 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1,9 +1,9 @@ ;;; x-dnd.el --- drag and drop support for X -*- coding: utf-8 -*- -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: Jan Djärv -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: window, drag, drop ;; Package: emacs diff --git a/lisp/xml.el b/lisp/xml.el index a3d34670bfb..ca8ddce586c 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1,6 +1,6 @@ ;;; xml.el --- XML parser -;; Copyright (C) 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 2000-2014 Free Software Foundation, Inc. ;; Author: Emmanuel Briot ;; Maintainer: Mark A. Hershberger @@ -479,7 +479,7 @@ Return one of: xml-default-ns)))) (cond ;; Processing instructions, like . - ((looking-at "<\\?") + ((looking-at-p "<\\?") (search-forward "?>") (skip-syntax-forward " ") (xml-parse-tag-1 parse-dtd xml-ns)) @@ -492,14 +492,14 @@ Return one of: (buffer-substring-no-properties pos (match-beginning 0)) (xml-parse-string)))) ;; DTD for the document - ((looking-at "") ;; FIXME: This loses the skipped-over spaces. (skip-syntax-forward " ") @@ -507,7 +507,7 @@ Return one of: (let ((xml-sub-parser t)) (xml-parse-tag-1 parse-dtd xml-ns)))) ;; end tag - ((looking-at "") + ((looking-at-p "/>") (forward-char 2) (nreverse children)) ;; is this a valid start tag ? @@ -543,7 +543,7 @@ Return one of: ((eobp) (error "XML: (Not Well-Formed) End of document while reading element `%s'" node-name)) - ((looking-at "") + (if (and (looking-at-p ">") xml-validating-parser) (error "XML: (Validity) Invalid DTD (expecting name of the document)")) @@ -755,7 +755,7 @@ This follows the rule [28] in the XML specifications." ;; Parse the rest of the DTD ;; Fixme: Deal with NOTATION, PIs. - (while (not (looking-at "\\s-*\\]")) + (while (not (looking-at-p "\\s-*\\]")) (skip-syntax-forward " ") (cond ((eobp) @@ -771,14 +771,14 @@ This follows the rule [28] in the XML specifications." (end-pos (match-end 0))) ;; Translation of rule [46] of XML specifications (cond - ((string-match "\\`EMPTY\\s-*\\'" type) ; empty declaration + ((string-match-p "\\`EMPTY\\s-*\\'" type) ; empty declaration (setq type 'empty)) - ((string-match "\\`ANY\\s-*$" type) ; any type of contents + ((string-match-p "\\`ANY\\s-*$" type) ; any type of contents (setq type 'any)) ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47]) (setq type (xml-parse-elem-type (match-string-no-properties 1 type)))) - ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution + ((string-match-p "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution nil) (xml-validating-parser (error "XML: (Validity) Invalid element type in the DTD"))) @@ -803,7 +803,7 @@ This follows the rule [28] in the XML specifications." (goto-char (match-end 0))) ;; Comments (skip to end, ignoring parameter entity): - ((looking-at "") (and next-parameter-entity (> (point) next-parameter-entity) @@ -856,7 +856,6 @@ This follows the rule [28] in the XML specifications." (unless (looking-at xml-pe-reference-re) (error "XML: Internal error")) (let* ((entity (match-string 1)) - (beg (point-marker)) (elt (assoc entity xml-parameter-entity-alist))) (if elt (progn @@ -916,11 +915,11 @@ references and parameter-entity references." (progn (setq elem (match-string-no-properties 1 string) modifier (match-string-no-properties 2 string)) - (if (string-match "|" elem) + (if (string-match-p "|" elem) (setq elem (cons 'choice (mapcar 'xml-parse-elem-type (split-string elem "|")))) - (if (string-match "," elem) + (if (string-match-p "," elem) (setq elem (cons 'seq (mapcar 'xml-parse-elem-type (split-string elem ","))))))) @@ -987,13 +986,12 @@ by \"*\"." (if (and string (stringp string)) (let ((start 0)) (while (string-match "&#\\([0-9]+\\);" string start) - (condition-case nil - (setq string (replace-match - (string (read (substring string - (match-beginning 1) - (match-end 1)))) - nil nil string)) - (error nil)) + (ignore-errors + (setq string (replace-match + (string (read (substring string + (match-beginning 1) + (match-end 1)))) + nil nil string))) (setq start (1+ (match-beginning 0)))) string) nil)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 9ee6c51c07c..26a07b46840 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -1,6 +1,6 @@ ;;; xt-mouse.el --- support the mouse when emacs run in an xterm -;; Copyright (C) 1994, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2000-2014 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: mouse, terminals @@ -135,20 +135,6 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (terminal-parameter nil 'xterm-mouse-y)))) pos) -;; Read XTerm sequences above ASCII 127 (#x7f) -(defun xterm-mouse-event-read () - ;; We get the characters decoded by the keyboard coding system. Try - ;; to recover the raw character. - (let ((c (read-event))) - (cond ;; If meta-flag is t we get a meta character - ((>= c ?\M-\^@) - (- c (- ?\M-\^@ 128))) - ;; Reencode the character in the keyboard coding system, if - ;; this is a non-ASCII character. - ((>= c #x80) - (aref (encode-coding-string (string c) (keyboard-coding-system)) 0)) - (t c)))) - (defun xterm-mouse-truncate-wrap (f) "Truncate with wrap-around." (condition-case nil @@ -167,7 +153,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." ;; Normal terminal mouse click reporting: expect three bytes, of the ;; form . Return a list (EVENT-TYPE X Y). (defun xterm-mouse--read-event-sequence-1000 () - (list (let ((code (- (xterm-mouse-event-read) 32))) + (list (let ((code (- (read-event) 32))) (intern ;; For buttons > 3, the release-event looks differently ;; (see xc/programs/xterm/button.c, function EditorButton), @@ -188,19 +174,19 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (setq xterm-mouse-last code) (format "down-mouse-%d" (+ 1 code)))))) ;; x and y coordinates - (- (xterm-mouse-event-read) 33) - (- (xterm-mouse-event-read) 33))) + (- (read-event) 33) + (- (read-event) 33))) ;; XTerm's 1006-mode terminal mouse click reporting has the form ;;