diff --git a/ChangeLog b/ChangeLog index 560f60a1819..4fc4e065e92 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +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. diff --git a/Makefile.in b/Makefile.in index 204099cc202..c6254fd6098 100644 --- a/Makefile.in +++ b/Makefile.in @@ -259,8 +259,6 @@ 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 ============================== @@ -662,7 +660,7 @@ install-info: info 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 ; \ + [ -n "${GZIP_PROG}" ] || continue ; \ rm -f $(DESTDIR)${infodir}/$$f.gz; \ ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \ done; \ @@ -684,7 +682,7 @@ install-man: 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 ; \ + [ -n "${GZIP_PROG}" ] || continue ; \ rm -f $(DESTDIR)${man1dir}/$${dest}.gz; \ ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${dest} || true; \ done @@ -754,12 +752,12 @@ uninstall: uninstall-$(NTDIR) uninstall-doc 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 \ + 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 \ diff --git a/autogen/Makefile.in b/autogen/Makefile.in index f26d3dce212..19904e8631e 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -677,7 +677,6 @@ 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@ diff --git a/autogen/configure b/autogen/configure index 4be101ce418..a0f302b4ac0 100755 --- a/autogen/configure +++ b/autogen/configure @@ -1442,7 +1442,6 @@ build_vendor build_cpu build PROFILING_CFLAGS -GZIP_INFO cache_file am__untar am__tar @@ -1545,7 +1544,7 @@ with_gnutls with_zlib with_file_notification with_makeinfo -with_compress_info +with_compress_install with_pkg_config_prog with_gameuser with_gnustep_conf @@ -2278,7 +2277,9 @@ Optional Packages: use a file notification library (LIB one of: yes, gfile, inotify, w32, no) --without-makeinfo don't require makeinfo for building manuals - --without-compress-info don't compress the installed Info pages + --without-compress-install + don't compress some files (.el, .info, etc.) when + installing. Equivalent to: make GZIP_PROG= install --with-pkg-config-prog=FILENAME file name of pkg-config for finding GTK and librsvg --with-gameuser=USER user for shared game score files @@ -4429,17 +4430,11 @@ fi ## 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; +# Check whether --with-compress-install was given. +if test "${with_compress_install+set}" = set; then : + withval=$with_compress_install; else - with_compress_info=$with_features -fi - -if test $with_compress_info = yes; then - GZIP_INFO=yes -else - GZIP_INFO= + with_compress_install=$with_features fi @@ -8618,6 +8613,9 @@ fi +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 # Extract the first word of "paxctl", so it can be a program name with args. set dummy paxctl; ac_word=$2 @@ -8781,13 +8779,15 @@ else fi -late_LDFLAGS=$LDFLAGS +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" + { $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 @@ -8805,13 +8805,14 @@ 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 + LDFLAGS_NOCOMBRELOC= { $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 +LDFLAGS="$late_LDFLAGS" test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no case "$opsys" in @@ -29051,6 +29052,8 @@ if test x$ac_enable_profiling != x ; then esac fi +LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS" + ## MinGW-specific post-link processing of temacs. diff --git a/configure.ac b/configure.ac index c7cdc01e3e7..ab2e48b6f0f 100644 --- a/configure.ac +++ b/configure.ac @@ -266,13 +266,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], @@ -950,6 +946,9 @@ AC_PATH_PROG(INSTALL_INFO, install-info, :, 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]) @@ -1027,19 +1026,30 @@ 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" dnl The function dump-emacs will not be defined and temacs will do dnl (load "loadup") automatically unless told otherwise. @@ -4741,6 +4751,8 @@ if test x$ac_enable_profiling != x ; then 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. diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 7ff13a70718..b263ca7671a 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,7 @@ +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. diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index e5743b064fb..b2cb5ee3d3b 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -2086,6 +2086,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}) @@ -2294,13 +2295,13 @@ commands do nothing on text with this setting. You can, however, still indent the left margin. @end table -@c FIXME: We should explain the effect of these symbols. --xfq @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}. +@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 0d5ce6820c7..34783796899 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -1140,6 +1140,7 @@ 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 diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 8b5aa65ff96..ed073456e7e 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,17 @@ +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, diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 39a9ff6b62c..f1d8c54f49c 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1135,6 +1135,7 @@ examining or altering the structure of closure objects. @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 diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index 5520bbbd1df..a2526f383aa 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi @@ -191,8 +191,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/nonascii.texi b/doc/lispref/nonascii.texi index f351829e4cf..e8e810ce61f 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -478,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}. @@ -549,6 +549,8 @@ is @code{nil}, which means the character itself. @defun get-char-code-property char propname This function returns the value of @var{char}'s @var{propname} property. +@c FIXME: Use ‘?\s’ instead of ‘? ’ for the space character in the +@c first example? --xfq @example @group (get-char-code-property ? 'general-category) @@ -684,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 @@ -849,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 diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 85143fc2692..aa1e69891a2 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,13 @@ +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. diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 740dfee41ed..b1c4c13c5ff 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -25,7 +25,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 diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi index 623fb4bfa79..64885179259 100644 --- a/doc/misc/ido.texi +++ b/doc/misc/ido.texi @@ -258,7 +258,7 @@ Buffer: 23@{123456 | 123@} At this point, you still have two matching buffers. If you want the first buffer in the list, you can simply press @key{RET}. If you want the second in the list, you can press @kbd{C-s} to move it to the top -of the list and then press @kbd{RET} to select it. +of the list and then press @key{RET} to select it. However, if you type @kbd{4}, you'll only have one match left: @@ -366,6 +366,7 @@ users Ido offers in addition to the default substring matching method the only difference to the description of the substring matching above. +@cindex toggle prefix matching You can toggle prefix matching with @kbd{C-p} (@code{ido-toggle-prefix}). diff --git a/etc/ChangeLog b/etc/ChangeLog index c1cb67a6a67..bd5534d9446 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,9 @@ +2013-09-09 Glenn Morris + + * refcards/Makefile (PS_ENGLISH, PS_CZECH, PS_FRENCH, PS_GERMAN) + (PS_POLISH, PS_PORTUGUESE, PS_RUSSIAN, PS_SLOVAKIAN, PS_TARGETS): + Use substitution refs. + 2013-08-15 Glenn Morris * refcards/calccard.pdf, refcards/cs-dired-ref.pdf: diff --git a/etc/NEWS b/etc/NEWS index cd69a8e09a0..a5da8eaa893 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -34,6 +34,10 @@ build time. To prevent this, use the configure option `--with-file-notification-no'. See below for file-notify features. FIXME? This feature is not available for the Nextstep port. (?) +** The configure option `without-compress-info' has been generalized, +and renamed to `without-compress-install'. It now prevents compression +of _any_ files during installation. + ** The configure option --with-crt-dir has been removed. It is no longer needed, as the crt*.o files are no longer linked specially. @@ -610,9 +614,20 @@ file using `set-file-extended-attributes'. ** `visited-file-modtime' now returns -1 for nonexistent files. Formerly it returned a list (-1 LOW USEC PSEC), but this was ambiguous in the presence of files with negative time stamps. + +** The cars of the elements in `interpreter-mode-alist' are now treated +as regexps rather than literal strings. Technically this is an +incompatible change, but unless you are using interpreter-mode-alist +for something (not just adding elements to it), it ought not to affect you. + * Lisp Changes in Emacs 24.4 +** Comparison functions =, <, >, <=, >= now take many arguments. + +** The second argument of `eval' can now be a lexical-environment. + +** `with-demoted-errors' takes an additional argument `format'. +++ ** New function `define-error'. diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index 36abf67d594..0931540e4d8 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -58,42 +58,16 @@ PDF_SLOVAKIAN = \ PDF_TARGETS = $(PDF_ENGLISH) $(PDF_CZECH) $(PDF_FRENCH) $(PDF_GERMAN) \ $(PDF_POLISH) $(PDF_PORTUGUESE) $(PDF_RUSSIAN) $(PDF_SLOVAKIAN) -PS_ENGLISH = \ - calccard.ps \ - dired-ref.ps \ - gnus-booklet.ps \ - gnus-refcard.ps \ - orgcard.ps \ - refcard.ps \ - survival.ps \ - vipcard.ps \ - viperCard.ps +PS_ENGLISH = $(PDF_ENGLISH:.pdf=.ps) +PS_CZECH = $(PDF_CZECH:.pdf=.ps) +PS_FRENCH = $(PDF_FRENCH:.pdf=.ps) +PS_GERMAN = $(PDF_GERMAN:.pdf=.ps) +PS_POLISH = $(PDF_POLISH:.pdf=.ps) +PS_PORTUGUESE = $(PDF_PORTUGUESE:.pdf=.ps) +PS_RUSSIAN = $(PDF_RUSSIAN:.pdf=.ps) +PS_SLOVAKIAN = $(PDF_SLOVAKIAN:.pdf=.ps) -PS_CZECH = \ - cs-dired-ref.ps \ - cs-refcard.ps \ - cs-survival.ps - -PS_FRENCH = \ - fr-dired-ref.ps \ - fr-refcard.ps \ - fr-survival.ps \ - -PS_GERMAN = de-refcard.ps - -PS_POLISH = pl-refcard.ps - -PS_PORTUGUESE = pt-br-refcard.ps - -PS_RUSSIAN = ru-refcard.ps - -PS_SLOVAKIAN = \ - sk-dired-ref.ps \ - sk-refcard.ps \ - sk-survival.ps - -PS_TARGETS = $(PS_ENGLISH) $(PS_CZECH) $(PS_FRENCH) $(PS_GERMAN) \ - $(PS_POLISH) $(PS_PORTUGUESE) $(PS_RUSSIAN) $(PS_SLOVAKIAN) +PS_TARGETS = $(PDF_TARGETS:.pdf=.ps) ## For emacsver.tex. diff --git a/info/dir b/info/dir index b6ec2845c3d..f6ccbda30ff 100644 --- a/info/dir +++ b/info/dir @@ -41,7 +41,7 @@ Emacs editing modes Emacs network features * EUDC: (eudc). Emacs client for directory servers (LDAP, PH). * Gnus: (gnus). The newsreader Gnus. -* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration. +* Emacs GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration. * Mairix: (mairix-el). Emacs interface to the Mairix mail indexer. * MH-E: (mh-e). Emacs interface to the MH mail system. * Message: (message). Mail and news composition mode that diff --git a/leim/ChangeLog b/leim/ChangeLog index 3e25c0edbe1..11186603df8 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,9 @@ +2013-09-05 Jean Haidouk (tiny change) + + * quail/latin-alt.el ("french-alt-postfix", "latin-alt-postfix"): + * quail/latin-pre.el ("french-prefix"): + * quail/latin-post.el ("french-postfix"): Add `œ' and `Œ'. + 2013-08-28 Paul Eggert * Makefile.in (SHELL): Now @SHELL@, not /bin/sh, diff --git a/leim/quail/latin-alt.el b/leim/quail/latin-alt.el index fdfc89f4eca..6841947524f 100644 --- a/leim/quail/latin-alt.el +++ b/leim/quail/latin-alt.el @@ -938,7 +938,7 @@ Par exemple: a` -> à e' -> é. En doublant la frappe des diacritiques, ils s'isoleront de la lettre. Par exemple: e'' -> e' - n'est pas disponible." +Œ est produit par O/." nil t nil nil nil nil nil nil nil nil t) (quail-define-rules @@ -959,7 +959,9 @@ Par exemple: e'' -> e' ("i^" ?î) ("i\"" ?ï) ("O^" ?Ô) + ("O/" ?Œ) ("o^" ?ô) + ("o/" ?œ) ("U`" ?Ù) ("U^" ?Û) ("U\"" ?Ü) @@ -988,7 +990,9 @@ Par exemple: e'' -> e' ("i^^" ["i^"]) ("i\"\"" ["i\""]) ("O^^" ["O^"]) + ("O//" ["O/"]) ("o^^" ["o^"]) + ("o//" ["o/"]) ("U``" ["U`"]) ("U^^" ["U^"]) ("U\"\"" ["U\""]) @@ -1423,6 +1427,7 @@ Doubling the postfix separates the letter and postfix: e.g. a'' -> a' ("O'" ?Ó) ("O-" ?Ō) ("O/" ?Ø) + ("O/" ?Œ) ("O:" ?Ő) ("O\"" ?Ö) ("O^" ?Ô) @@ -1515,6 +1520,7 @@ Doubling the postfix separates the letter and postfix: e.g. a'' -> a' ("o'" ?ó) ("o-" ?ō) ("o/" ?ø) + ("o/" ?œ) ("o:" ?ő) ("o\"" ?ö) ("o^" ?ô) diff --git a/leim/quail/latin-post.el b/leim/quail/latin-post.el index 67cd0648951..7fa3d88e8c6 100644 --- a/leim/quail/latin-post.el +++ b/leim/quail/latin-post.el @@ -1013,7 +1013,7 @@ Par exemple: a` -> à e' -> é. En doublant la frappe des diacritiques, ils s'isoleront de la lettre. Par exemple: e'' -> e' - n'est pas disponible." +Œ est produit par O/." nil t nil nil nil nil nil nil nil nil t) (quail-define-rules @@ -1034,7 +1034,9 @@ Par exemple: e'' -> e' ("i^" ?î) ("i\"" ?ï) ("O^" ?Ô) + ("O/" ?Œ) ("o^" ?ô) + ("o/" ?œ) ("U`" ?Ù) ("U^" ?Û) ("U\"" ?Ü) @@ -1063,7 +1065,9 @@ Par exemple: e'' -> e' ("i^^" ["i^"]) ("i\"\"" ["i\""]) ("O^^" ["O^"]) + ("O//" ["O/"]) ("o^^" ["o^"]) + ("o//" ["o/"]) ("U``" ["U`"]) ("U^^" ["U^"]) ("U\"\"" ["U\""]) @@ -2099,7 +2103,7 @@ of characters from a single Latin-N charset. dot | . | z. -> ż stroke | / | d/ -> đ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø - others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> ° + others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> ° o/ -> œ | various | << -> « >> -> » o_ -> º a_ -> ª Doubling the postfix separates the letter and postfix: e.g. a'' -> a' diff --git a/leim/quail/latin-pre.el b/leim/quail/latin-pre.el index 4b4179ebf82..c6085f34290 100644 --- a/leim/quail/latin-pre.el +++ b/leim/quail/latin-pre.el @@ -264,6 +264,7 @@ Key translation rules are: diaeresis | \" | \"i -> ï cedilla | ~ or , | ~c -> ç ,c -> ç symbol | ~ | ~> -> » ~< -> « + misc | / | /o -> œ " nil t nil nil nil nil nil nil nil nil t) (quail-define-rules @@ -295,6 +296,9 @@ Key translation rules are: ("\"e" ?ë) ("\"i" ?ï) ("\" " ?\") + ("/o" ?œ) + ("/O" ?Œ) + ("/ " ?/) ("~<" ?\«) ("~>" ?\») ("~C" ?Ç) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 324cefe7ed6..5cae5873f92 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -3,6 +3,287 @@ * composite.el (compose-gstring-for-graphic): Handle enclosing mark. +2013-09-12 Glenn Morris + + * vc/vc-svn.el (vc-svn-dir-status-files, vc-svn-dir-extra-headers) + (vc-svn-ignore, vc-svn-retrieve-tag): Mark unused arguments. + + * subr.el (do-after-load-evaluation): Also give compiler warnings + when obsolete files are used (except by obsolete files). + + * vc/vc-svn.el (vc-svn-parse-status): If there are multiple files + in the status output, assume `filename' is the first. (Bug#15322) + + * vc/vc.el (vc-deduce-fileset): Doc fix. + + * calc/calc-help.el (Info-goto-node): + * progmodes/cperl-mode.el (Info-find-node): + * vc/ediff.el (Info-goto-node): Update declarations. + + * vc/vc-dispatcher.el (vc-dir-refresh): Declare. + + * vc/vc-bzr.el (vc-compilation-mode): Declare. + (vc-bzr-pull): Require vc-dispatcher. + * vc/vc-git.el (vc-compilation-mode): Declare. + (vc-git-pull): Require vc-dispatcher. + + * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Declare. + + * progmodes/octave.el (help-button-action): Declare. + + * shell.el (shell-directory-tracker): Output error as a message + rather than just returning it as a string. + (shell-process-pushd): Remove useless use of message. + + * dframe.el (dframe-timer-fn): + * files.el (dir-locals-read-from-file): + * mpc.el (mpc--status-timer-run, mpc--status-idle-timer-run) + (mpc-format): + * reveal.el (reveal-post-command): + * saveplace.el (load-save-place-alist-from-file): + * shell.el (shell-resync-dirs): + * w32-common-fns.el (x-get-selection-value): + * emacs-lisp/copyright.el (copyright-find-copyright): + * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info): + * emulation/tpu-edt.el (tpu-copy-keyfile): + * play/bubbles.el (bubbles--mark-neighbourhood): + * progmodes/executable.el + (executable-make-buffer-file-executable-if-script-p): + * term/pc-win.el (x-get-selection-value): Use with-demoted-errors. + +2013-09-12 Stefan Monnier + + Cleanup Eshell to rely less on dynamic scoping. + * eshell/esh-opt.el (eshell-eval-using-options): Don't bind usage-msg, + last-value, and ext-command here. Bind `args' closer to `body'. + (temp-args, last-value, usage-msg, ext-command, args): Don't defvar. + (eshell--args): Declare new dynamic var. + (eshell-do-opt): Add argument `args'. Bind our own usage-msg, + last-value, and ext-command. Pass `args' to `body'. + (eshell-process-args): Bind eshell--args. + (eshell-set-option): Use eshell--args. + * eshell/eshell.el (eshell): Use derived-mode-p. + * eshell/esh-var.el (eshell-parse-variable): Use backquote. + (eshell-parse-variable-ref): Remove unused vars `end' and `err'. + (eshell-glob-function): Declare. + * eshell/esh-util.el: Require cl-lib. + (eshell-read-hosts-file): Avoid add-to-list. + * eshell/esh-cmd.el (eshell-parse-lisp-argument): Remove unused var + `err'. + * eshell/em-unix.el (compilation-scroll-output, locate-history-list): + Declare. + (eshell/diff): Remove unused var `err'. + * eshell/em-rebind.el (eshell-delete-backward-char): Remove unused arg + `killflag'. + * eshell/em-pred.el (eshell-parse-modifiers): Remove unused var `err'. + * eshell/em-ls.el (eshell-ls-highlight-alist): Move defvars before + first use. + * eshell/em-glob.el (eshell-glob-matches, message-shown): + Move declaration before first use. + * eshell/em-alias.el (eshell-maybe-replace-by-alias): Use backquotes. + * autorevert.el (auto-revert-notify-handler): Use `cl-dolist' since we + rely on cl-return. + +2013-09-12 Glenn Morris + + * term/ns-win.el (global-map): Remove binding for ispell-next, + deleted 1999-05-29. (Bug#15357) + +2013-09-11 Glenn Morris + + * echistory.el (electric-command-history): Remove call to deleted func. + + * play/landmark.el (landmark-mode): Fix typos. + + * vc/vc-cvs.el (cvs-append-to-ignore): Fix arg spec. + Check cvs-sort-ignore-file is bound. + + * savehist.el: No need for cl when compiling on Emacs. + +2013-09-11 Stefan Monnier + + * eshell/esh-mode.el (eshell-mode-syntax-table): Fix up initialization + (bug#15338). + (eshell-self-insert-command, eshell-send-invisible): + Remove unused argument. + (eshell-handle-control-codes): Remove unused var `orig'. + Avoid delete-backward-char. + + * files.el (set-auto-mode): Simplify a bit further. + +2013-09-11 Glenn Morris + + * files.el (interpreter-mode-alist): Remove \\` \\' parts. + (set-auto-mode): Don't regexp-quote elements. + * progmodes/python.el (interpreter-mode-alist): Remove \\` \\'. + * progmodes/cc-mode.el (interpreter-mode-alist): + * progmodes/ruby-mode.el (interpreter-mode-alist): + Revert previous change. + +2013-09-11 Stefan Monnier + + * play/snake.el (snake-mode): + * play/mpuz.el (mpuz-mode): + * play/landmark.el (lm-mode): + * play/blackbox.el (blackbox-mode): + * play/5x5.el (5x5-mode): + * obsolete/options.el (Edit-options-mode): + * net/quickurl.el (quickurl-list-mode): + * net/newst-treeview.el (newsticker-treeview-mode): + * mail/rmailsum.el (rmail-summary-mode): + * mail/mspools.el (mspools-mode): + * locate.el (locate-mode): + * ibuffer.el (ibuffer-mode): + * emulation/ws-mode.el (wordstar-mode): + * emacs-lisp/debug.el (debugger-mode): + * array.el (array-mode): + * net/eudc.el (eudc-mode): Use define-derived-mode. + * net/mairix.el (mairix-searches-mode-font-lock-keywords): + Move initialization into declaration. + (mairix-searches-mode): Use define-derived-mode. + * net/eudc-hotlist.el (eudc-hotlist-mode): Use define-derived-mode. + (eudc-edit-hotlist): Use dolist. + * man.el (Man-mode-syntax-table): Rename from man-mode-syntax-table. + (Man-mode): Use define-derived-mode. + * info.el (Info-edit-mode-map): Rename from Info-edit-map. + (Info-edit-mode): Use define-derived-mode. + (Info-cease-edit): Use Info-mode. + * eshell/esh-mode.el (eshell-mode-syntax-table): Move initialization + into declaration. + (eshell-mode): Use define-derived-mode. + * chistory.el (command-history-mode-map): Rename from + command-history-map. + (command-history-mode): Use define-derived-mode. + (Command-history-setup): Remove function. + * calc/calc.el (calc-trail-mode-map): New var. + (calc-trail-mode): Use define-derived-mode. + (calc-trail-buffer): Set calc-main-buffer manually. + * bookmark.el (bookmark-insert-annotation): New function. + (bookmark-edit-annotation): Use it. + (bookmark-edit-annotation-mode): Make it a proper major mode. + (bookmark-send-edited-annotation): Use derived-mode-p. + * arc-mode.el (archive-mode): Move kill-all-local-variables a tiny bit + closer to its ideal place. Use \' to match EOS. + + * profiler.el (profiler-calltree-find): Use function-equal. + +2013-09-10 Glenn Morris + + * files.el (interpreter-mode-alist): Convert to regexps. + (set-auto-mode): Adapt for this. (Bug#15306) + * progmodes/cperl-mode.el (cperl-clobber-mode-lists): + Comment out unused variable. + * progmodes/cc-mode.el (interpreter-mode-alist): + * progmodes/python.el (interpreter-mode-alist): + * progmodes/ruby-mode.el (interpreter-mode-alist): Convert to regexps. + * progmodes/sh-script.el (sh-set-shell): + No longer use interpreter-mode-alist to get list of shells. + + * progmodes/cc-mode.el (awk-mode): Remove duplicate autoload. + +2013-09-10 Stefan Monnier + + * simple.el: Use set-temporary-overlay-map for universal-argument. + (universal-argument-map): Don't use default-bindings (bug#15317). + Bind switch-frame explicitly. Replace universal-argument-minus with + a conditional binding. + (universal-argument-num-events, saved-overriding-map): Remove. + (restore-overriding-map): Remove. + (universal-argument--mode): Rename from save&set-overriding-map, + and rewrite. + (universal-argument, universal-argument-more, negative-argument) + (digit-argument): Adjust accordingly. + (universal-argument-minus): Remove. + (universal-argument-other-key): Remove. + + * subr.el (with-demoted-errors): Add `format' argument. + +2013-09-10 Michael Albinus + + * net/tramp.el (tramp-cleanup): Remove. Functionality added to + `tramp-cleanup-connection'. + + * net/tramp-cmds.el (tramp-cleanup-connection): Add optional + parameters KEEP-DEBUG and KEEP-PASSWORD. + + * net/tramp.el (tramp-file-name-handler): + * net/tramp-adb.el (tramp-adb-maybe-open-connection): + * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell) + (tramp-maybe-open-connection): + * net/tramp-smb.el (tramp-smb-maybe-open-connection): + Use `tramp-cleanup-connection'. + + * net/tramp-sh.el (tramp-maybe-open-connection): + Catch 'uname-changed inside the progress reporter. + +2013-09-10 Glenn Morris + + * simple.el (read-minibuffer): Unbreak it. (Bug#15318) + + * dired-x.el (dired-mark-sexp): Unbreak for systems where ls + returns "alternate access method" in mode (eg "-rw-r--r--."). + +2013-09-08 Glenn Morris + + * saveplace.el (load-save-place-alist-from-file): + Demote errors. (Bug#15305) + +2013-09-08 Michael Albinus + + Improve compatibility with older Emacsen, and XEmacs. + + * net/tramp.el (tramp-find-method, tramp-find-user): Call `propertize' + only if it is bound. It isn't for XEmacs. + (with-tramp-progress-reporter): Do not let-bind `result'. + This yields to scoping errors in XEmacs. + (tramp-handle-make-auto-save-file-name): New function, moved from + tramp-sh.el. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Add handler + for `make-auto-save-file-name'. + (tramp-adb--gnu-switches-to-ash): + Use `tramp-compat-replace-regexp-in-string'. + + * net/tramp-cache.el (tramp-cache-print): Call + `substring-no-properties' only if it is bound. It isn't for XEmacs. + + * net/tramp-cmds.el (tramp-bug): Call `propertize' only if it is + bound. It isn't for XEmacs. + + * net/tramp-compat.el (tramp-compat-copy-file): + Catch `wrong-number-of-arguments' error. + (tramp-compat-replace-regexp-in-string): New defun. + + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add handler + for `make-auto-save-file-name'. + (tramp-gvfs-handle-copy-file): Use `tramp-compat-funcall' for + `copy-file'. + (tramp-gvfs-file-gvfs-monitor-file-process-filter) + (tramp-gvfs-file-name): Use `tramp-compat-replace-regexp-in-string'. + (tramp-synce-list-devices): Use `push' instead of `pushnew'. + + * net/tramp-gw.el (tramp-gw-open-network-stream): + Use `tramp-compat-replace-regexp-in-string'. + + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): + Call `tramp-handle-make-auto-save-file-name'. + (tramp-sh-handle-make-auto-save-file-name): Move to tramp.el. + (tramp-sh-file-gvfs-monitor-dir-process-filter) + (tramp-sh-file-inotifywait-process-filter): + Use `tramp-compat-replace-regexp-in-string'. + (tramp-compute-multi-hops): Use `push' instead of `pushnew'. + + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add handler + for `make-auto-save-file-name'. + (tramp-smb-handle-copy-directory): + Call `tramp-compat-replace-regexp-in-string'. + (tramp-smb-get-file-entries): Use `push' instead of `pushnew'. + (tramp-smb-handle-copy-file): Improve error message. + (tramp-smb-handle-rename-file): Rename directly only in case + `newname' does not exist yet. This is a restriction of smbclient. + (tramp-smb-maybe-open-connection): Rerun the function only when + `auth-sources' is non-nil. + 2013-09-08 Kenichi Handa * international/characters.el: Set category "^" (Combining) for @@ -14,8 +295,8 @@ * progmodes/cc-langs.el (c-type-decl-suffix-key): Now matches ")" in Java Mode. (c-recognize-typeless-decls): Set the Java value to t. - * progmodes/cc-engine.el (c-forward-decl-or-cast-1): While - handling a "(", add a check for, effectively, Java, and handle a + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): + While handling a "(", add a check for, effectively, Java, and handle a "typeless" declaration there. 2013-09-07 Roland Winkler diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index a4f7015c844..c22205d5634 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -683,9 +683,9 @@ archive. ;; At present we cannot create archives from scratch (funcall (or (default-value 'major-mode) 'fundamental-mode)) (if (and (not force) archive-files) nil + (kill-all-local-variables) (let* ((type (archive-find-type)) (typename (capitalize (symbol-name type)))) - (kill-all-local-variables) (make-local-variable 'archive-subtype) (setq archive-subtype type) @@ -761,7 +761,7 @@ archive. ((looking-at "..-l[hz][0-9ds]-") 'lzh) ((looking-at "....................[\334]\247\304\375") 'zoo) ((and (looking-at "\C-z") ; signature too simple, IMHO - (string-match "\\.[aA][rR][cC]$" + (string-match "\\.[aA][rR][cC]\\'" (or buffer-file-name (buffer-name)))) 'arc) ;; This pattern modeled on the BSD/GNU+Linux `file' command. diff --git a/lisp/array.el b/lisp/array.el index e60cbdfffc1..8c4f609e626 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -800,7 +800,7 @@ Return COLUMN." (put 'array-mode 'mode-class 'special) ;;;###autoload -(defun array-mode () +(define-derived-mode array-mode fundamental-mode "Array" "Major mode for editing arrays. Array mode is a specialized mode for editing arrays. An array is @@ -863,9 +863,6 @@ take a numeric prefix argument): \\[array-display-local-variables] Display the current values of local variables. Entering array mode calls the function `array-mode-hook'." - - (interactive) - (kill-all-local-variables) (make-local-variable 'array-buffer-line) (make-local-variable 'array-buffer-column) (make-local-variable 'array-row) @@ -888,13 +885,9 @@ Entering array mode calls the function `array-mode-hook'." (+ (floor (1- array-max-column) array-columns-per-line) (if array-rows-numbered 2 1))) (message "") - (setq major-mode 'array-mode) - (setq mode-name "Array") (force-mode-line-update) (set (make-local-variable 'truncate-lines) t) - (setq overwrite-mode 'overwrite-mode-textual) - (use-local-map array-mode-map) - (run-mode-hooks 'array-mode-hook)) + (setq overwrite-mode 'overwrite-mode-textual)) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 0e2b6f32cf3..65526f07e1b 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -548,7 +548,7 @@ will use an up-to-date value of `auto-revert-interval'" (cl-assert (stringp file)) (when (eq action 'renamed) (cl-assert (stringp file1))) ;; Loop over all buffers, in order to find the intended one. - (dolist (buffer buffers) + (cl-dolist (buffer buffers) (when (buffer-live-p buffer) (with-current-buffer buffer (when (and (stringp buffer-file-name) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 9514317809b..ce0d6831a3a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -862,31 +862,25 @@ It takes one argument, the name of the bookmark, as a string.") map) "Keymap for editing an annotation of a bookmark.") - -(defun bookmark-edit-annotation-mode (bookmark-name-or-record) - "Mode for editing the annotation of bookmark BOOKMARK-NAME-OR-RECORD. -When you have finished composing, type \\[bookmark-send-annotation]. - -\\{bookmark-edit-annotation-mode-map}" - (interactive) - (kill-all-local-variables) - (make-local-variable 'bookmark-annotation-name) - (setq bookmark-annotation-name bookmark-name-or-record) - (use-local-map bookmark-edit-annotation-mode-map) - (setq major-mode 'bookmark-edit-annotation-mode - mode-name "Edit Bookmark Annotation") +(defun bookmark-insert-annotation (bookmark-name-or-record) (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record)) (let ((annotation (bookmark-get-annotation bookmark-name-or-record))) (if (and annotation (not (string-equal annotation ""))) - (insert annotation))) - (run-mode-hooks 'text-mode-hook)) + (insert annotation)))) + +(define-derived-mode bookmark-edit-annotation-mode + text-mode "Edit Bookmark Annotation" + "Mode for editing the annotation of bookmarks. +When you have finished composing, type \\[bookmark-send-annotation]. + +\\{bookmark-edit-annotation-mode-map}") (defun bookmark-send-edited-annotation () "Use buffer contents as annotation for a bookmark. Lines beginning with `#' are ignored." (interactive) - (if (not (eq major-mode 'bookmark-edit-annotation-mode)) + (if (not (derived-mode-p 'bookmark-edit-annotation-mode)) (error "Not in bookmark-edit-annotation-mode")) (goto-char (point-min)) (while (< (point) (point-max)) @@ -906,7 +900,10 @@ Lines beginning with `#' are ignored." (defun bookmark-edit-annotation (bookmark-name-or-record) "Pop up a buffer for editing bookmark BOOKMARK-NAME-OR-RECORD's annotation." (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) - (bookmark-edit-annotation-mode bookmark-name-or-record)) + (bookmark-insert-annotation bookmark-name-or-record) + (bookmark-edit-annotation-mode) + (set (make-local-variable 'bookmark-annotation-name) + bookmark-name-or-record)) (defun bookmark-buffer-name () diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 2b7b56c3f89..641453568ca 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -30,7 +30,7 @@ (require 'calc-macs) ;; Declare functions which are defined elsewhere. -(declare-function Info-goto-node "info" (nodename &optional fork)) +(declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function Info-last "info" ()) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 2eeb880c34d..2795a177a41 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1387,7 +1387,12 @@ Notations: 3.14e6 3.14 * 10^6 (calc-check-defines)) (setplist 'calc-define nil))))) -(defun calc-trail-mode (&optional buf) +(defvar calc-trail-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map calc-mode-map) + map)) + +(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail" "Calc Trail mode. This mode is used by the *Calc Trail* buffer, which records all results obtained by the GNU Emacs Calculator. @@ -1397,26 +1402,18 @@ the Trail. This buffer uses the same key map as the *Calculator* buffer; calculator commands given here will actually operate on the *Calculator* stack." - (interactive) - (fundamental-mode) - (use-local-map calc-mode-map) - (setq major-mode 'calc-trail-mode) - (setq mode-name "Calc Trail") (setq truncate-lines t) (setq buffer-read-only t) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (when buf - (set (make-local-variable 'calc-main-buffer) buf)) (when (= (buffer-size) 0) (let ((buffer-read-only nil)) - (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))) - (run-mode-hooks 'calc-trail-mode-hook)) + (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))) (defun calc-create-buffer () "Create and initialize a buffer for the Calculator." (set-buffer (get-buffer-create "*Calculator*")) - (or (eq major-mode 'calc-mode) + (or (derived-mode-p 'calc-mode) (calc-mode)) (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) (when calc-always-load-extensions @@ -1439,7 +1436,7 @@ commands given here will actually operate on the *Calculator* stack." (when (get-buffer-window "*Calc Keypad*") (calc-keypad) (set-buffer (window-buffer))) - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (calc-quit) (let ((oldbuf (current-buffer))) (calc-create-buffer) @@ -1490,7 +1487,7 @@ commands given here will actually operate on the *Calculator* stack." (if (and (equal (buffer-name) "*Gnuplot Trail*") (> (recursion-depth) 0)) (exit-recursive-edit) - (if (eq major-mode 'calc-edit-mode) + (if (derived-mode-p 'calc-edit-mode) (calc-edit-finish arg) (if calc-was-keypad-mode (calc-keypad) @@ -1504,13 +1501,13 @@ commands given here will actually operate on the *Calculator* stack." (if (and (equal (buffer-name) "*Gnuplot Trail*") (> (recursion-depth) 0)) (exit-recursive-edit)) - (if (eq major-mode 'calc-edit-mode) + (if (derived-mode-p 'calc-edit-mode) (calc-edit-cancel) (if (and interactive calc-embedded-info (eq (current-buffer) (aref calc-embedded-info 0))) (calc-embedded nil) - (unless (eq major-mode 'calc-mode) + (unless (derived-mode-p 'calc-mode) (calc-create-buffer)) (run-hooks 'calc-end-hook) (if (integerp calc-undo-length) @@ -1631,10 +1628,10 @@ See calc-keypad for details." (if (math-lessp 1 time) (calc-record time "(t)")))) (or (memq 'no-align calc-command-flags) - (eq major-mode 'calc-trail-mode) + (derived-mode-p 'calc-trail-mode) (calc-align-stack-window)) (and (memq 'position-point calc-command-flags) - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (progn (goto-char (point-min)) (forward-line (1- calc-final-point-line)) @@ -1664,7 +1661,7 @@ See calc-keypad for details." (setq calc-command-flags (cons f calc-command-flags)))) (defun calc-select-buffer () - (or (eq major-mode 'calc-mode) + (or (derived-mode-p 'calc-mode) (if calc-main-buffer (set-buffer calc-main-buffer) (let ((buf (get-buffer "*Calculator*"))) @@ -1801,7 +1798,7 @@ See calc-keypad for details." (and calc-embedded-info (calc-embedded-mode-line-change)))))) (defun calc-align-stack-window () - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (progn (let ((win (get-buffer-window (current-buffer)))) (if win @@ -1988,7 +1985,7 @@ See calc-keypad for details." (defvar calc-any-evaltos nil) (defun calc-refresh (&optional align) (interactive) - (and (eq major-mode 'calc-mode) + (and (derived-mode-p 'calc-mode) (not calc-executing-macro) (let* ((buffer-read-only nil) (save-point (point)) @@ -2016,7 +2013,7 @@ See calc-keypad for details." (calc-align-stack-window) (goto-char save-point)) (if save-mark (set-mark save-mark)))) - (and calc-embedded-info (not (eq major-mode 'calc-mode)) + (and calc-embedded-info (not (derived-mode-p 'calc-mode)) (with-current-buffer (aref calc-embedded-info 1) (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) @@ -2078,12 +2075,13 @@ the United States." (null (buffer-name calc-trail-buffer))) (save-excursion (setq calc-trail-buffer (get-buffer-create "*Calc Trail*")) - (let ((buf (or (and (not (eq major-mode 'calc-mode)) + (let ((buf (or (and (not (derived-mode-p 'calc-mode)) (get-buffer "*Calculator*")) (current-buffer)))) (set-buffer calc-trail-buffer) - (or (eq major-mode 'calc-trail-mode) - (calc-trail-mode buf))))) + (unless (derived-mode-p 'calc-trail-mode) + (calc-trail-mode) + (set (make-local-variable 'calc-main-buffer) buf))))) (or (and calc-trail-pointer (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) (with-current-buffer calc-trail-buffer @@ -2152,7 +2150,7 @@ the United States." (defun calc-trail-here () (interactive) - (if (eq major-mode 'calc-trail-mode) + (if (derived-mode-p 'calc-trail-mode) (progn (beginning-of-line) (if (bobp) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 50467fa6e37..f5528202bb4 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,12 @@ +2013-09-11 Stefan Monnier + + * semantic/grammar.el (semantic-grammar-mode): Use define-derived-mode. + (semantic-grammar-mode-syntax-table): Rename from + semantic-grammar-syntax-table. + (semantic-grammar-mode-map): Rename from semantic-grammar-map. + * data-debug.el (data-debug-mode-map): Rename from data-debug-map. + (data-debug-mode): Use define-derived-mode. + 2013-09-05 Glenn Morris * semantic/fw.el (semantic-make-local-hook): @@ -15,15 +24,15 @@ * semantic/decorate/mode.el (semantic-decoration-on-includes-p-default) - (semantic-decoration-on-includes-highlight-default): Declare for + (semantic-decoration-on-includes-highlight-default): Declare for byte compiler. * semantic/wisent/python.el (semantic/format): New require. 2013-07-27 Eric Ludlam - * lisp/cedet/semantic/edit.el (semantic-edits-splice-remove): Wrap - debug message removing middle tag in semantic-edits-verbose-flag + * lisp/cedet/semantic/edit.el (semantic-edits-splice-remove): + Wrap debug message removing middle tag in semantic-edits-verbose-flag check. 2013-07-27 David Engster @@ -69,8 +78,8 @@ `semantic/decorate/include' anymore. (semantic-toggle-decoration-style): Error if an unknown decoration style is toggled. - (define-semantic-decoration-style): Add new :load option. When - :load is specified, add autoload tokens for the definition + (define-semantic-decoration-style): Add new :load option. + When :load is specified, add autoload tokens for the definition functions so that code is loaded when the mode is used. (semantic-decoration-on-includes): New autoload definition for highlighting includes. @@ -94,8 +103,8 @@ * semantic/ctxt.el (semantic-ctxt-end-of-symbol): New. (semantic-ctxt-current-symbol-default): New. - * semantic/bovine/el.el (semantic-default-elisp-setup): Add - autoload cookie. Explain existence. + * semantic/bovine/el.el (semantic-default-elisp-setup): + Add autoload cookie. Explain existence. (footer): Add local variable for loaddefs. * semantic/db.el (semanticdb-file-table-object): Add new filter, @@ -120,7 +129,7 @@ * ede/cpp-root.el (ede-preprocessor-map): Protect against init problems. - * ede/proj.el (ede-proj-target): Added a new "custom" option for + * ede/proj.el (ede-proj-target): Add a new "custom" option for custom symbols representing a compiler or linker instead of restricting things to only the predefined compilers and linkers. @@ -198,15 +207,15 @@ 2013-04-27 David Engster * semantic/complete.el - (semantic-collector-calculate-completions-raw): If - `completionslist' is not set, refresh the cache if necessary and + (semantic-collector-calculate-completions-raw): + If `completionslist' is not set, refresh the cache if necessary and use it for completions. This fixes the `semantic-collector-buffer-deep' collector (bug#14265). 2013-03-26 Leo Liu - * semantic/senator.el (senator-copy-tag-to-register): Move - register handling logic from register.el. (Bug#14052) + * semantic/senator.el (senator-copy-tag-to-register): + Move register handling logic from register.el. (Bug#14052) 2013-03-21 Eric Ludlam @@ -223,17 +232,17 @@ * semantic/find.el (semantic-filter-tags-by-class): New function. - * semantic/tag-ls.el (semantic-tag-similar-p-default): Add - short-circuit in case tag1 and 2 are identical. + * semantic/tag-ls.el (semantic-tag-similar-p-default): + Add short-circuit in case tag1 and 2 are identical. * semantic/analyze/fcn.el - (semantic-analyze-dereference-metatype-stack): Use - `semantic-tag-similar-p' instead of 'eq' when comparing two tags + (semantic-analyze-dereference-metatype-stack): + Use `semantic-tag-similar-p' instead of 'eq' when comparing two tags during metatype evaluation in case they are the same, but not the same node. (Tweaked patch from Tomasz Gajewski) (Tiny change) - * semantic/db-find.el (semanticdb-partial-synchronize): Fix - require to semantic/db-typecache to be correct. + * semantic/db-find.el (semanticdb-partial-synchronize): + Fix require to semantic/db-typecache to be correct. (semanticdb-find-tags-external-children-of-type): Make this a brutish search by default. @@ -243,19 +252,19 @@ input tag as the place to start searching for externally defined methods. - * semantic/db-file.el (semanticdb-default-save-directory): Doc - fix: Add ref to default value. + * semantic/db-file.el (semanticdb-default-save-directory): + Doc fix: Add ref to default value. - * semantic/complete.el (semantic-complete-post-command-hook): When - detecting if cursor is outside completion area, do so if cursor + * semantic/complete.el (semantic-complete-post-command-hook): + When detecting if cursor is outside completion area, do so if cursor moves before start of overlay, or the original starting location of the overlay (i.e., if user deletes past beginning of the overlay region). (semantic-complete-inline-tag-engine): Initialize original start of `semantic-complete-inline-overlay'. - * semantic/bovine/c.el (semantic-c-describe-environment): Update - some section titles. Test semanticdb table before printing it. + * semantic/bovine/c.el (semantic-c-describe-environment): + Update some section titles. Test semanticdb table before printing it. (semantic-c-reset-preprocessor-symbol-map): Update `semantic-lex-spp-macro-symbol-obarray' outside the loop over all the files contributing to its value. @@ -271,8 +280,8 @@ * srecode/cpp.el (srecode-semantic-handle-:c): Replace all characters in FILENAME_SYMBOL that aren't valid CPP symbol chars. - * srecode/map.el (srecode-map-validate-file-for-mode): Force - semantic to load if it is not active in the template being added + * srecode/map.el (srecode-map-validate-file-for-mode): + Force semantic to load if it is not active in the template being added to the map. * srecode/srt.el: Add local variables for setting the autoload @@ -287,7 +296,7 @@ has both a version variable and a Version: comment, always use `call-next-method'. - * ede/cpp-root.el (ede-set-project-variables): Deleted. + * ede/cpp-root.el (ede-set-project-variables): Delete. `ede-preprocessor-map' does the job this function was attempting to do with :spp-table. (ede-preprocessor-map): Update file tests to provide better @@ -302,8 +311,8 @@ 2013-03-21 David Engster * semantic/bovine/c.el (semantic-get-local-variables): Also add a - new variable 'this' if we are in an inline member function. For - detecting this, we check overlays at point if there is a class + new variable 'this' if we are in an inline member function. + For detecting this, we check overlays at point if there is a class spanning the current function. Also, the variable 'this' has to be a pointer. @@ -350,14 +359,14 @@ 2013-03-21 Tomasz Gajewski (tiny change) - * ede/cpp-root.el (ede-project-autoload, initialize-instance): Fix - EDE file symbol to match rename. Fix ede-cpp-root symbol to + * ede/cpp-root.el (ede-project-autoload, initialize-instance): + Fix EDE file symbol to match rename. Fix ede-cpp-root symbol to include -project in name. 2013-03-21 Alex Ott - * cedet-files.el (cedet-files-list-recursively): New. Recursively - find files whose names are matching to given regex. + * cedet-files.el (cedet-files-list-recursively): New. + Recursively find files whose names are matching to given regex. * ede.el (ede-current-project): Rewrite to avoid imperative style. diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index c468ec1046a..4658c604211 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -869,7 +869,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing." table) "Syntax table used in data-debug macro buffers.") -(defvar data-debug-map +(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1") +(defvar data-debug-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) (define-key km [mouse-2] 'data-debug-expand-or-contract-mouse) @@ -887,22 +888,15 @@ If PARENT is non-nil, it is somehow related as a parent to thing." :group 'data-debug :type 'hook) -(defun data-debug-mode () +(define-derived-mode data-debug-mode fundamental-mode "DATA-DEBUG" "Major-mode for the Analyzer debugger. -\\{data-debug-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'data-debug-mode - mode-name "DATA-DEBUG" - comment-start ";;" +\\{data-debug-mode-map}" + (setq comment-start ";;" comment-end "" buffer-read-only t) - (set (make-local-variable 'comment-start-skip) + (setq-local comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") - (set-syntax-table data-debug-mode-syntax-table) - (use-local-map data-debug-map) - (run-hooks 'data-debug-hook) (buffer-disable-undo) (set (make-local-variable 'font-lock-global-modes) nil) (font-lock-mode -1) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index ce658cd5d54..60c4ccadf65 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -860,7 +860,7 @@ Lisp code." ;; Use Unix EOLs, so that the file is portable to all platforms. (setq buffer-file-coding-system 'raw-text-unix) (erase-buffer) - (unless (eq major-mode 'emacs-lisp-mode) + (unless (derived-mode-p 'emacs-lisp-mode) (emacs-lisp-mode)) ;;;; Header + Prologue @@ -1102,7 +1102,9 @@ END is the limit of the search." ;;;; Define major mode ;;;; -(defvar semantic-grammar-syntax-table +(define-obsolete-variable-alias 'semantic-grammar-syntax-table + 'semantic-grammar-mode-syntax-table "24.1") +(defvar semantic-grammar-mode-syntax-table (let ((table (make-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?\: "." table) ;; COLON (modify-syntax-entry ?\> "." table) ;; GT @@ -1170,7 +1172,9 @@ END is the limit of the search." semantic-grammar-mode-keywords-1 "Font Lock keywords used to highlight Semantic grammar buffers.") -(defvar semantic-grammar-map +(define-obsolete-variable-alias 'semantic-grammar-map + 'semantic-grammar-mode-map "24.1") +(defvar semantic-grammar-mode-map (let ((km (make-sparse-keymap))) (define-key km "|" 'semantic-grammar-electric-punctuation) @@ -1271,22 +1275,17 @@ the change bounds to encompass the whole nonterminal tag." (semantic-tag-start outer) (semantic-tag-end outer))))) -(defun semantic-grammar-mode () +(define-derived-mode semantic-grammar-mode + fundamental-mode "Semantic Grammar Framework" "Initialize a buffer for editing Semantic grammars. -\\{semantic-grammar-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'semantic-grammar-mode - mode-name "Semantic Grammar Framework") +\\{semantic-grammar-mode-map}" (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start) ";;") ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. (set (make-local-variable 'comment-start-skip) "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") - (set-syntax-table semantic-grammar-syntax-table) - (use-local-map semantic-grammar-map) (set (make-local-variable 'indent-line-function) 'semantic-grammar-indent) (set (make-local-variable 'fill-paragraph-function) @@ -1335,15 +1334,14 @@ the change bounds to encompass the whole nonterminal tag." (semantic-make-local-hook 'semantic-edits-new-change-functions) (add-hook 'semantic-edits-new-change-functions 'semantic-grammar-edits-new-change-hook-fcn - nil t) - (semantic-run-mode-hooks 'semantic-grammar-mode-hook)) + nil t)) ;;;; ;;;; Useful commands ;;;; (defvar semantic-grammar-skip-quoted-syntax-table - (let ((st (copy-syntax-table semantic-grammar-syntax-table))) + (let ((st (copy-syntax-table semantic-grammar-mode-syntax-table))) (modify-syntax-entry ?\' "$" st) st) "Syntax table to skip a whole quoted expression in grammar code. diff --git a/lisp/chistory.el b/lisp/chistory.el index 509324ade88..9a77793b1e1 100644 --- a/lisp/chistory.el +++ b/lisp/chistory.el @@ -121,7 +121,9 @@ The buffer is left in Command History mode." (error "No command history") (command-history-mode))))) -(defvar command-history-map +(define-obsolete-variable-alias 'command-history-map + 'command-history-mode-map "24.1") +(defvar command-history-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map lisp-mode-shared-map) (suppress-keymap map) @@ -132,21 +134,11 @@ The buffer is left in Command History mode." map) "Keymap for `command-history-mode'.") -(defun command-history-mode () +(define-derived-mode command-history-mode fundamental-mode "Command History" "Major mode for listing and repeating recent commands. Keybindings: -\\{command-history-map}" - (interactive) - (Command-history-setup) - (setq major-mode 'command-history-mode) - (setq mode-name "Command History") - (use-local-map command-history-map) - (run-mode-hooks 'command-history-mode-hook)) - -(defun Command-history-setup () - (kill-all-local-variables) - (use-local-map command-history-map) +\\{command-history-mode-map}" (lisp-mode-variables nil) (set-syntax-table emacs-lisp-mode-syntax-table) (setq buffer-read-only t)) diff --git a/lisp/comint.el b/lisp/comint.el index 0ce7053c031..7572e8baabc 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3793,25 +3793,21 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; comint-mode will take care of it. The following example, from shell.el, ;; is typical: ;; -;; (defvar shell-mode-map '()) -;; (cond ((not shell-mode-map) -;; (setq shell-mode-map (copy-keymap comint-mode-map)) -;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) -;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) -;; (define-key shell-mode-map "\t" 'completion-at-point) -;; (define-key shell-mode-map "\M-?" -;; 'comint-dynamic-list-filename-completions))) +;; (defvar shell-mode-map +;; (let ((map (make-sparse-keymap))) +;; (set-keymap-parent map comint-mode-map) +;; (define-key map "\C-c\C-f" 'shell-forward-command) +;; (define-key map "\C-c\C-b" 'shell-backward-command) +;; (define-key map "\t" 'completion-at-point) +;; (define-key map "\M-?" +;; 'comint-dynamic-list-filename-completions) +;; map)) ;; -;; (defun shell-mode () -;; (interactive) -;; (comint-mode) +;; (define-derived-mode shell-mode comint-mode "Shell" +;; "Doc." ;; (setq comint-prompt-regexp shell-prompt-pattern) -;; (setq major-mode 'shell-mode) -;; (setq mode-name "Shell") -;; (use-local-map shell-mode-map) ;; (setq-local shell-directory-stack nil) -;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker) -;; (run-mode-hooks 'shell-mode-hook)) +;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker)) ;; ;; ;; Completion for comint-mode users diff --git a/lisp/dframe.el b/lisp/dframe.el index 66967075e34..3ef30d055b6 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -758,9 +758,8 @@ who requested the timer. NULL-ON-ERROR is ignored." Evaluates all cached timer functions in sequence." (let ((l dframe-client-functions)) (while (and l (sit-for 0)) - (condition-case er - (funcall (car l)) - (error (message "DFRAME TIMER ERROR: %S" er))) + (with-demoted-errors "DFRAME TIMER ERROR: %S" + (funcall (car l))) (setq l (cdr l))))) ;;; Menu hacking for mouse-3 diff --git a/lisp/dired-x.el b/lisp/dired-x.el index c6ecbf1e718..c15f3b5b121 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1459,6 +1459,9 @@ to mark all zero length files." s nil)) (setq mode (buffer-substring (point) (+ mode-len (point)))) (forward-char mode-len) + ;; Skip any extended attributes marker ("." or "+"). + (or (looking-at " ") + (forward-char 1)) (setq nlink (read (current-buffer))) ;; Karsten Wenger fixed uid. (setq uid (buffer-substring (1+ (point)) diff --git a/lisp/dired.el b/lisp/dired.el index f873aea9bf0..345e8d57113 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4352,7 +4352,7 @@ instead. ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "1bf4009b81e55bf51947bc87b2c82994") +;;;### (autoloads nil "dired-x" "dired-x.el" "11fd4a8afa32507cc32d4a04d852587f") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/echistory.el b/lisp/echistory.el index fc576aa6484..5989c9b8445 100644 --- a/lisp/echistory.el +++ b/lisp/echistory.el @@ -117,7 +117,6 @@ The Command History listing is recomputed each time this mode is invoked." (save-window-excursion (list-command-history) (set-buffer "*Command History*") - (Command-history-setup) (setq major-mode 'electric-command-history) (setq mode-name "Electric History") (use-local-map electric-history-map)) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index b3fc6fb887a..2b2189e70e3 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,7 +1,6 @@ ;;; copyright.el --- update the copyright notice in current buffer -;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer ;; Keywords: maint, tools @@ -145,18 +144,17 @@ The header must match `copyright-regexp' and `copyright-names-regexp', if set. This function sets the match-data that `copyright-update-year' uses." (widen) (goto-char (copyright-start-point)) - (condition-case err - ;; (1) Need the extra \\( \\) around copyright-regexp because we - ;; goto (match-end 1) below. See note (2) below. - (copyright-re-search (concat "\\(" copyright-regexp - "\\)\\([ \t]*\n\\)?.*\\(?:" - copyright-names-regexp "\\)") - (copyright-limit) - t) - ;; In case the regexp is rejected. This is useful because - ;; copyright-update is typically called from before-save-hook where - ;; such an error is very inconvenient for the user. - (error (message "Can't update copyright: %s" err) nil))) + ;; In case the regexp is rejected. This is useful because + ;; copyright-update is typically called from before-save-hook where + ;; such an error is very inconvenient for the user. + (with-demoted-errors "Can't update copyright: %s" + ;; (1) Need the extra \\( \\) around copyright-regexp because we + ;; goto (match-end 1) below. See note (2) below. + (copyright-re-search (concat "\\(" copyright-regexp + "\\)\\([ \t]*\n\\)?.*\\(?:" + copyright-names-regexp "\\)") + (copyright-limit) + t))) (defun copyright-find-end () "Possibly adjust the search performed by `copyright-find-copyright'. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 709a094e73b..6c7a0d2db1d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -626,7 +626,7 @@ The environment used is the one when entering the activation frame at point." (put 'debugger-mode 'mode-class 'special) -(defun debugger-mode () +(define-derived-mode debugger-mode fundamental-mode "Debugger" "Mode for backtrace buffers, selected in debugger. \\ A line starts with `*' if exiting that frame will call the debugger. @@ -641,13 +641,9 @@ which functions will enter the debugger when called. Complete list of commands: \\{debugger-mode-map}" - (kill-all-local-variables) - (setq major-mode 'debugger-mode) - (setq mode-name "Debugger") (setq truncate-lines t) (set-syntax-table emacs-lisp-mode-syntax-table) - (use-local-map debugger-mode-map) - (run-mode-hooks 'debugger-mode-hook)) + (use-local-map debugger-mode-map)) (defcustom debugger-record-buffer "*Debugger-record*" "Buffer name for expression values, for \\[debugger-record-expression]." diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 9b9fd325941..250f93800ec 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -309,27 +309,26 @@ This variable is expected to be made buffer-local by modes (other than Emacs Lisp mode) that support ElDoc.") (defun eldoc-print-current-symbol-info () - (condition-case err - (and (or (eldoc-display-message-p) eldoc-post-insert-mode) - (if eldoc-documentation-function - (eldoc-message (funcall eldoc-documentation-function)) - (let* ((current-symbol (eldoc-current-symbol)) - (current-fnsym (eldoc-fnsym-in-current-sexp)) - (doc (cond - ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply 'eldoc-get-fnsym-args-string - current-fnsym) - (eldoc-get-var-docstring current-symbol))) - (t - (or (eldoc-get-var-docstring current-symbol) - (apply 'eldoc-get-fnsym-args-string - current-fnsym)))))) - (eldoc-message doc)))) - ;; This is run from post-command-hook or some idle timer thing, - ;; so we need to be careful that errors aren't ignored. - (error (message "eldoc error: %s" err)))) + ;; This is run from post-command-hook or some idle timer thing, + ;; so we need to be careful that errors aren't ignored. + (with-demoted-errors "eldoc error: %s" + (and (or (eldoc-display-message-p) eldoc-post-insert-mode) + (if eldoc-documentation-function + (eldoc-message (funcall eldoc-documentation-function)) + (let* ((current-symbol (eldoc-current-symbol)) + (current-fnsym (eldoc-fnsym-in-current-sexp)) + (doc (cond + ((null current-fnsym) + nil) + ((eq current-symbol (car current-fnsym)) + (or (apply 'eldoc-get-fnsym-args-string + current-fnsym) + (eldoc-get-var-docstring current-symbol))) + (t + (or (eldoc-get-var-docstring current-symbol) + (apply 'eldoc-get-fnsym-args-string + current-fnsym)))))) + (eldoc-message doc)))))) (defun eldoc-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 1ec0ecc943c..e2fcf2eae41 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -2374,9 +2374,8 @@ If FILE is nil, try to load a default file. The default file names are (goto-char (point-min)) (beep) (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") - (condition-case conditions - (copy-file oldname newname) - (error (message "Sorry, couldn't copy - %s." (cdr conditions))))) + (with-demoted-errors "Sorry, couldn't copy - %s." + (copy-file oldname newname))) (kill-buffer "*TPU-Notice*"))) (defvar tpu-edt-old-global-values nil) diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el index 03d7076195e..dfb81b3829c 100644 --- a/lisp/emulation/ws-mode.el +++ b/lisp/emulation/ws-mode.el @@ -73,8 +73,7 @@ (define-key map "\C-x" 'save-buffers-kill-emacs) (define-key map "y" 'ws-delete-block) (define-key map "\C-y" 'ws-delete-block) - map) - "") + map)) (defvar wordstar-C-o-map (let ((map (make-keymap))) @@ -140,8 +139,7 @@ (define-key map "y" 'ws-kill-eol) (define-key map "\C-y" 'ws-kill-eol) (define-key map "\177" 'ws-kill-bol) - map) - "") + map)) (defvar wordstar-mode-map (let ((map (make-keymap))) @@ -170,17 +168,16 @@ (define-key map "\C-x" 'next-line) (define-key map "\C-y" 'kill-complete-line) (define-key map "\C-z" 'scroll-up-line) - map) - "") + map)) ;; wordstar-C-j-map not yet implemented -(defvar wordstar-C-j-map nil "") +(defvar wordstar-C-j-map nil) (put 'wordstar-mode 'mode-class 'special) ;;;###autoload -(defun wordstar-mode () +(define-derived-mode wordstar-mode fundamental-mode "WordStar" "Major mode with WordStar-like key bindings. BUGS: @@ -191,106 +188,7 @@ BUGS: - Search and replace (C-q a) is only available in forward direction No key bindings beginning with ESC are installed, they will work -Emacs-like. - -The key bindings are: - - C-a backward-word - C-b fill-paragraph - C-c scroll-up-line - C-d forward-char - C-e previous-line - C-f forward-word - C-g delete-char - C-h backward-char - C-i indent-for-tab-command - C-j help-for-help - C-k ordstar-C-k-map - C-l ws-repeat-search - C-n open-line - C-p quoted-insert - C-r scroll-down-line - C-s backward-char - C-t kill-word - C-u keyboard-quit - C-v overwrite-mode - C-w scroll-down - C-x next-line - C-y kill-complete-line - C-z scroll-up - - C-k 0 ws-set-marker-0 - C-k 1 ws-set-marker-1 - C-k 2 ws-set-marker-2 - C-k 3 ws-set-marker-3 - C-k 4 ws-set-marker-4 - C-k 5 ws-set-marker-5 - C-k 6 ws-set-marker-6 - C-k 7 ws-set-marker-7 - C-k 8 ws-set-marker-8 - C-k 9 ws-set-marker-9 - C-k b ws-begin-block - C-k c ws-copy-block - C-k d save-buffers-kill-emacs - C-k f find-file - C-k h ws-show-markers - C-k i ws-indent-block - C-k k ws-end-block - C-k p ws-print-block - C-k q kill-emacs - C-k r insert-file - C-k s save-some-buffers - C-k t ws-mark-word - C-k u ws-exdent-block - C-k C-u keyboard-quit - C-k v ws-move-block - C-k w ws-write-block - C-k x kill-emacs - C-k y ws-delete-block - - C-o c wordstar-center-line - C-o b switch-to-buffer - C-o j justify-current-line - C-o k kill-buffer - C-o l list-buffers - C-o m auto-fill-mode - C-o r set-fill-column - C-o C-u keyboard-quit - C-o wd delete-other-windows - C-o wh split-window-right - C-o wo other-window - C-o wv split-window-below - - C-q 0 ws-find-marker-0 - C-q 1 ws-find-marker-1 - C-q 2 ws-find-marker-2 - C-q 3 ws-find-marker-3 - C-q 4 ws-find-marker-4 - C-q 5 ws-find-marker-5 - C-q 6 ws-find-marker-6 - C-q 7 ws-find-marker-7 - C-q 8 ws-find-marker-8 - C-q 9 ws-find-marker-9 - C-q a ws-query-replace - C-q b ws-to-block-begin - C-q c end-of-buffer - C-q d end-of-line - C-q f ws-search - C-q k ws-to-block-end - C-q l ws-undo - C-q p ws-last-cursorp - C-q r beginning-of-buffer - C-q C-u keyboard-quit - C-q w ws-last-error - C-q y ws-kill-eol - C-q DEL ws-kill-bol -" - (interactive) - (kill-all-local-variables) - (use-local-map wordstar-mode-map) - (setq mode-name "WordStar") - (setq major-mode 'wordstar-mode) - (run-mode-hooks 'wordstar-mode-hook)) +Emacs-like.") (defun wordstar-center-paragraph () diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index a46b48c01b3..9a9cc4cd567 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -221,18 +221,11 @@ file named by `eshell-aliases-file'.") (let ((alias (eshell-lookup-alias command))) (if alias (throw 'eshell-replace-command - (list - 'let - (list - (list 'eshell-command-name - (list 'quote eshell-last-command-name)) - (list 'eshell-command-arguments - (list 'quote eshell-last-arguments)) - (list 'eshell-prevent-alias-expansion - (list 'quote - (cons command - eshell-prevent-alias-expansion)))) - (eshell-parse-command (nth 1 alias)))))))) + `(let ((eshell-command-name ',eshell-last-command-name) + (eshell-command-arguments ',eshell-last-arguments) + (eshell-prevent-alias-expansion + ',(cons command eshell-prevent-alias-expansion))) + ,(eshell-parse-command (nth 1 alias)))))))) (defun eshell-alias-completions (name) "Find all possible completions for NAME. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index a58c7730ded..b5ca8119470 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -180,6 +180,8 @@ interpretation." (goto-char (1+ end)))))))))) (defvar eshell-glob-chars-regexp nil) +(defvar eshell-glob-matches) +(defvar message-shown) (defun eshell-glob-regexp (pattern) "Convert glob-pattern PATTERN to a regular expression. @@ -262,9 +264,6 @@ the form: (error "No matches found: %s" glob) glob)))) -(defvar eshell-glob-matches) -(defvar message-shown) - ;; FIXME does this really need to abuse eshell-glob-matches, message-shown? (defun eshell-glob-entries (path globs &optional recurse-p) "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil." diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 41db4cd03d1..3dee1adb58a 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -268,6 +268,25 @@ scope during the evaluation of TEST-SEXP." :type '(repeat (cons function face)) :group 'eshell-ls) +(defvar block-size) +(defvar dereference-links) +(defvar dir-literal) +(defvar error-func) +(defvar flush-func) +(defvar human-readable) +(defvar ignore-pattern) +(defvar insert-func) +(defvar listing-style) +(defvar numeric-uid-gid) +(defvar reverse-list) +(defvar show-all) +(defvar show-almost-all) +(defvar show-recursive) +(defvar show-size) +(defvar sort-method) +(defvar ange-cache) +(defvar dired-flag) + ;;; Functions: (defun eshell-ls-insert-directory @@ -315,25 +334,6 @@ instead." (put 'eshell/ls 'eshell-no-numeric-conversions t) -(defvar block-size) -(defvar dereference-links) -(defvar dir-literal) -(defvar error-func) -(defvar flush-func) -(defvar human-readable) -(defvar ignore-pattern) -(defvar insert-func) -(defvar listing-style) -(defvar numeric-uid-gid) -(defvar reverse-list) -(defvar show-all) -(defvar show-almost-all) -(defvar show-recursive) -(defvar show-size) -(defvar sort-method) -(defvar ange-cache) -(defvar dired-flag) - (declare-function eshell-glob-regexp "em-glob" (pattern)) (defun eshell-do-ls (&rest args) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 3a7f46ebe83..14d3020530f 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -307,7 +307,7 @@ functions. PRED-FUNCS take a filename and return t if the test succeeds; MOD-FUNCS take any string and preform a modification, returning the resultant string." (let (result negate follow preds mods) - (condition-case err + (condition-case nil (while (not (eobp)) (let ((char (char-after))) (cond diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 341191fc62f..a526d590307 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -218,7 +218,7 @@ lock it at that." (cdar bindings)) (setq bindings (cdr bindings))))) -(defun eshell-delete-backward-char (n &optional killflag) +(defun eshell-delete-backward-char (n) "Delete the last character, unless it's part of the output." (interactive "P") (let ((count (prefix-numeric-value n))) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index af54d875cb0..b9b1c1635a5 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -714,6 +714,8 @@ available..." (goto-char (point-min)) (resize-temp-buffer-window)))))) +(defvar compilation-scroll-output) + (defun eshell-grep (command args &optional maybe-use-occur) "Generic service function for the various grep aliases. It calls Emacs's grep utility if the command is not redirecting output, @@ -989,7 +991,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (setq args nil) (setcdr (last args 3) nil)) (with-current-buffer - (condition-case err + (condition-case nil (diff-no-select old new (nil-blank-string (eshell-flatten-and-stringify args))) @@ -1014,6 +1016,8 @@ Show wall-clock time elapsed during execution of COMMAND.") (put 'eshell/diff 'eshell-no-numeric-conversions t) +(defvar locate-history-list) + (defun eshell/locate (&rest args) "Alias \"locate\" to call Emacs `locate' function." (if (or eshell-plain-locate-behavior diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index d7dfd27d8d3..e3a12d5ece5 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -278,7 +278,7 @@ Point is left at the end of the arguments." (eshell-resolve-current-argument) eshell-current-argument)) -(defsubst eshell-operator (&rest args) +(defsubst eshell-operator (&rest _args) "A stub function that generates an error if a floating operator is found." (error "Unhandled operator in input text")) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index ef8a53f3c0b..c2922983ae2 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -650,7 +650,7 @@ For an external command, it means an exit code of 0." (looking-at eshell-lisp-regexp)) (let* ((here (point)) (obj - (condition-case err + (condition-case nil (read (current-buffer)) (end-of-file (throw 'eshell-incomplete ?\())))) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ed5fecf09ff..54a36428d58 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -220,74 +220,67 @@ This is used by `eshell-watch-for-password-prompt'." (defvar eshell-last-output-end nil) (defvar eshell-currently-handling-window nil) -(defvar eshell-mode-syntax-table nil) -(defvar eshell-mode-abbrev-table nil) (define-abbrev-table 'eshell-mode-abbrev-table ()) -(if (not eshell-mode-syntax-table) - (let ((i 0)) - (setq eshell-mode-syntax-table (make-syntax-table)) - (while (< i ?0) - (modify-syntax-entry i "_ " eshell-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?9)) - (while (< i ?A) - (modify-syntax-entry i "_ " eshell-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?Z)) - (while (< i ?a) - (modify-syntax-entry i "_ " eshell-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?z)) - (while (< i 128) - (modify-syntax-entry i "_ " eshell-mode-syntax-table) - (setq i (1+ i))) - (modify-syntax-entry ? " " eshell-mode-syntax-table) - (modify-syntax-entry ?\t " " eshell-mode-syntax-table) - (modify-syntax-entry ?\f " " eshell-mode-syntax-table) - (modify-syntax-entry ?\n "> " eshell-mode-syntax-table) - ;; Give CR the same syntax as newline, for selective-display. - (modify-syntax-entry ?\^m "> " eshell-mode-syntax-table) -;;; (modify-syntax-entry ?\; "< " eshell-mode-syntax-table) - (modify-syntax-entry ?` "' " eshell-mode-syntax-table) - (modify-syntax-entry ?' "' " eshell-mode-syntax-table) - (modify-syntax-entry ?, "' " eshell-mode-syntax-table) - ;; Used to be singlequote; changed for flonums. - (modify-syntax-entry ?. "_ " eshell-mode-syntax-table) - (modify-syntax-entry ?- "_ " eshell-mode-syntax-table) - (modify-syntax-entry ?| ". " eshell-mode-syntax-table) - (modify-syntax-entry ?# "' " eshell-mode-syntax-table) - (modify-syntax-entry ?\" "\" " eshell-mode-syntax-table) - (modify-syntax-entry ?\\ "/ " eshell-mode-syntax-table) - (modify-syntax-entry ?\( "() " eshell-mode-syntax-table) - (modify-syntax-entry ?\) ")( " eshell-mode-syntax-table) - (modify-syntax-entry ?\{ "(} " eshell-mode-syntax-table) - (modify-syntax-entry ?\} "){ " eshell-mode-syntax-table) - (modify-syntax-entry ?\[ "(] " eshell-mode-syntax-table) - (modify-syntax-entry ?\] ")[ " eshell-mode-syntax-table) - ;; All non-word multibyte characters should be `symbol'. - (if (featurep 'xemacs) - (map-char-table - (function - (lambda (key val) - (and (characterp key) - (>= (char-int key) 256) - (/= (char-syntax key) ?w) - (modify-syntax-entry key "_ " - eshell-mode-syntax-table)))) - (standard-syntax-table)) - (map-char-table - (function - (lambda (key val) - (and (if (consp key) - (and (>= (car key) 128) - (/= (char-syntax (car key)) ?w)) - (and (>= key 256) - (/= (char-syntax key) ?w))) - (modify-syntax-entry key "_ " - eshell-mode-syntax-table)))) - (standard-syntax-table))))) +(defvar eshell-mode-syntax-table + (let ((st (make-syntax-table)) + (i 0)) + (while (< i ?0) + (modify-syntax-entry i "_ " st) + (setq i (1+ i))) + (setq i (1+ ?9)) + (while (< i ?A) + (modify-syntax-entry i "_ " st) + (setq i (1+ i))) + (setq i (1+ ?Z)) + (while (< i ?a) + (modify-syntax-entry i "_ " st) + (setq i (1+ i))) + (setq i (1+ ?z)) + (while (< i 128) + (modify-syntax-entry i "_ " st) + (setq i (1+ i))) + (modify-syntax-entry ? " " st) + (modify-syntax-entry ?\t " " st) + (modify-syntax-entry ?\f " " st) + (modify-syntax-entry ?\n "> " st) + ;; Give CR the same syntax as newline, for selective-display. + (modify-syntax-entry ?\^m "> " st) + ;; (modify-syntax-entry ?\; "< " st) + (modify-syntax-entry ?` "' " st) + (modify-syntax-entry ?' "' " st) + (modify-syntax-entry ?, "' " st) + ;; Used to be singlequote; changed for flonums. + (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) + ;; All non-word multibyte characters should be `symbol'. + (map-char-table + (if (featurep 'xemacs) + (lambda (key _val) + (and (characterp key) + (>= (char-int key) 256) + (/= (char-syntax key) ?w) + (modify-syntax-entry key "_ " st))) + (lambda (key _val) + (and (if (consp key) + (and (>= (car key) 128) + (/= (char-syntax (car key)) ?w)) + (and (>= key 256) + (/= (char-syntax key) ?w))) + (modify-syntax-entry key "_ " st)))) + (standard-syntax-table)) + st)) ;;; User Functions: @@ -303,25 +296,18 @@ and the hook `eshell-exit-hook'." (run-hooks 'eshell-exit-hook)) ;;;###autoload -(defun eshell-mode () - "Emacs shell interactive mode. +(define-derived-mode eshell-mode fundamental-mode "EShell" + "Emacs shell interactive mode." + (setq-local eshell-mode t) -\\{eshell-mode-map}" - (kill-all-local-variables) - - (setq major-mode 'eshell-mode) - (setq mode-name "EShell") - (set (make-local-variable 'eshell-mode) t) - - (make-local-variable 'eshell-mode-map) - (setq eshell-mode-map (make-sparse-keymap)) + ;; FIXME: What the hell!? + (setq-local eshell-mode-map (make-sparse-keymap)) (use-local-map eshell-mode-map) (when eshell-status-in-mode-line (make-local-variable 'eshell-command-running-string) (let ((fmt (copy-sequence mode-line-format))) - (make-local-variable 'mode-line-format) - (setq mode-line-format fmt)) + (setq-local mode-line-format fmt)) (let ((mode-line-elt (memq 'mode-line-modified mode-line-format))) (if mode-line-elt (setcar mode-line-elt 'eshell-command-running-string)))) @@ -331,11 +317,9 @@ and the hook `eshell-exit-hook'." (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output) (define-key eshell-mode-map [(control ?a)] 'eshell-bol) - (set (make-local-variable 'eshell-command-prefix) - (make-symbol "eshell-command-prefix")) + (setq-local eshell-command-prefix (make-symbol "eshell-command-prefix")) (fset eshell-command-prefix (make-sparse-keymap)) - (set (make-local-variable 'eshell-command-map) - (symbol-function eshell-command-prefix)) + (setq-local eshell-command-map (symbol-function eshell-command-prefix)) (define-key eshell-mode-map [(control ?c)] eshell-command-prefix) ;; without this, find-tag complains about read-only text being @@ -359,7 +343,6 @@ and the hook `eshell-exit-hook'." (define-key eshell-command-map [(control ?y)] 'eshell-repeat-argument) (setq local-abbrev-table eshell-mode-abbrev-table) - (set-syntax-table eshell-mode-syntax-table) (set (make-local-variable 'dired-directory) default-directory) (set (make-local-variable 'list-buffers-directory) @@ -442,7 +425,6 @@ and the hook `eshell-exit-hook'." (if eshell-first-time-p (run-hooks 'eshell-first-time-mode-hook)) - (run-mode-hooks 'eshell-mode-hook) (run-hooks 'eshell-post-command-hook)) (put 'eshell-mode 'mode-class 'special) @@ -470,8 +452,8 @@ and the hook `eshell-exit-hook'." (add-hook 'pre-command-hook 'eshell-intercept-commands t t) (message "Sending subprocess input directly"))) -(defun eshell-self-insert-command (N) - (interactive "i") +(defun eshell-self-insert-command () + (interactive) (process-send-string (eshell-interactive-process) (char-to-string (if (symbolp last-command-event) @@ -944,10 +926,10 @@ a key." (custom-add-option 'eshell-output-filter-functions 'eshell-truncate-buffer) -(defun eshell-send-invisible (str) +(defun eshell-send-invisible () "Read a string without echoing. Then send it to the process running in the current buffer." - (interactive "P") ; Defeat snooping via C-x ESC ESC + (interactive) ; Don't pass str as argument, to avoid snooping via C-x ESC ESC (let ((str (read-passwd (format "%s Password: " (process-name (eshell-interactive-process)))))) @@ -969,7 +951,7 @@ This function could be in the list `eshell-output-filter-functions'." (beginning-of-line) (if (re-search-forward eshell-password-prompt-regexp eshell-last-output-end t) - (eshell-send-invisible nil))))) + (eshell-send-invisible))))) (custom-add-option 'eshell-output-filter-functions 'eshell-watch-for-password-prompt) @@ -977,32 +959,30 @@ This function could be in the list `eshell-output-filter-functions'." (defun eshell-handle-control-codes () "Act properly when certain control codes are seen." (save-excursion - (let ((orig (point))) - (goto-char eshell-last-output-block-begin) - (unless (eolp) - (beginning-of-line)) - (while (< (point) eshell-last-output-end) - (let ((char (char-after))) - (cond - ((eq char ?\r) - (if (< (1+ (point)) eshell-last-output-end) - (if (memq (char-after (1+ (point))) - '(?\n ?\r)) - (delete-char 1) - (let ((end (1+ (point)))) - (beginning-of-line) - (delete-region (point) end))) - (add-text-properties (point) (1+ (point)) - '(invisible t)) - (forward-char))) - ((eq char ?\a) - (delete-char 1) - (beep)) - ((eq char ?\C-h) - (delete-backward-char 1) - (delete-char 1)) - (t - (forward-char)))))))) + (goto-char eshell-last-output-block-begin) + (unless (eolp) + (beginning-of-line)) + (while (< (point) eshell-last-output-end) + (let ((char (char-after))) + (cond + ((eq char ?\r) + (if (< (1+ (point)) eshell-last-output-end) + (if (memq (char-after (1+ (point))) + '(?\n ?\r)) + (delete-char 1) + (let ((end (1+ (point)))) + (beginning-of-line) + (delete-region (point) end))) + (add-text-properties (point) (1+ (point)) + '(invisible t)) + (forward-char))) + ((eq char ?\a) + (delete-char 1) + (beep)) + ((eq char ?\C-h) + (delete-region (1- (point)) (1+ (point)))) + (t + (forward-char))))))) (custom-add-option 'eshell-output-filter-functions 'eshell-handle-control-codes) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 33625433022..c62cbc7e1dc 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -28,11 +28,11 @@ (require 'esh-ext) ;; Unused. -;;; (defgroup eshell-opt nil -;;; "The options processing code handles command argument parsing for -;;; Eshell commands implemented in Lisp." -;;; :tag "Command options processing" -;;; :group 'eshell) +;; (defgroup eshell-opt nil +;; "The options processing code handles command argument parsing for +;; Eshell commands implemented in Lisp." +;; :tag "Command options processing" +;; :group 'eshell) ;;; User Functions: @@ -103,32 +103,25 @@ interned variable `args' (created using a `let' form)." macro-args (list 'eshell-stringify-list (list 'eshell-flatten-list macro-args))))) - (let ,(append (delq nil (mapcar (lambda (opt) + (let ,(delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt))) (cadr options))) - '(usage-msg last-value ext-command args)) ;; FIXME: `options' ends up hiding some variable names under `quote', ;; which is incompatible with lexical scoping!! - (eshell-do-opt ,name ,options (lambda () ,@body-forms))))) + (eshell-do-opt ,name ,options (lambda (args) ,@body-forms) temp-args)))) ;;; Internal Functions: -(defvar temp-args) -(defvar last-value) -(defvar usage-msg) -(defvar ext-command) ;; Documented part of the interface; see eshell-eval-using-options. -(defvar args) +(defvar eshell--args) -(defun eshell-do-opt (name options body-fun) +(defun eshell-do-opt (name options body-fun args) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." - (setq args temp-args) - (if (setq - ext-command + (let* (last-value + (ext-command (catch 'eshell-ext-command - (when (setq - usage-msg + (let ((usage-msg (catch 'eshell-usage (setq last-value nil) (if (and (= (length args) 0) @@ -136,12 +129,14 @@ This code doesn't really need to be macro expanded everywhere." (throw 'eshell-usage (eshell-show-usage name options))) (setq args (eshell-process-args name args options) - last-value (funcall body-fun)) - nil)) - (error "%s" usage-msg)))) + last-value (funcall body-fun args)) + nil))) + (when usage-msg + (error "%s" usage-msg)))))) + (if ext-command (throw 'eshell-external (eshell-external-command ext-command args)) - last-value)) + last-value))) (defun eshell-show-usage (name options) "Display the usage message for NAME, using OPTIONS." @@ -197,12 +192,13 @@ will be modified." (if (not (nth 3 opt)) (eshell-show-usage name options) (if (eq (nth 2 opt) t) - (if (> ai (length args)) + (if (> ai (length eshell--args)) (error "%s: missing option argument" name) - (set (nth 3 opt) (nth ai args)) + (set (nth 3 opt) (nth ai eshell--args)) (if (> ai 0) - (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)) - (setq args (cdr args)))) + (setcdr (nthcdr (1- ai) eshell--args) + (nthcdr (1+ ai) eshell--args)) + (setq eshell--args (cdr eshell--args)))) (set (nth 3 opt) (or (nth 2 opt) t))))) (defun eshell-process-option (name switch kind ai options) @@ -232,14 +228,15 @@ switch is unrecognized." (setq extcmd (eshell-search-path (cadr extcmd))) (if extcmd (throw 'eshell-ext-command extcmd) - (if (characterp switch) - (error "%s: unrecognized option -%c" name switch) - (error "%s: unrecognized option --%s" name switch)))))))) + (error (if (characterp switch) "%s: unrecognized option -%c" + "%s: unrecognized option --%s") + name switch))))))) (defun eshell-process-args (name args options) "Process the given ARGS using OPTIONS. This assumes that symbols have been intern'd by `eshell-eval-using-options'." - (let ((ai 0) arg) + (let ((ai 0) arg + (eshell--args args)) (while (< ai (length args)) (setq arg (nth ai args)) (if (not (and (stringp arg) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index dd344eb50a2..968d1ebad79 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -23,6 +23,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup eshell-util nil "This is general utility code, meant for use by Eshell itself." :tag "General utilities" @@ -484,12 +486,12 @@ list." (while (re-search-forward "^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t) (if (match-string 1) - (add-to-list 'hosts (match-string 1))) + (cl-pushnew (match-string 1) hosts :test #'equal)) (if (match-string 2) - (add-to-list 'hosts (match-string 2))) + (cl-pushnew (match-string 2) hosts :test #'equal)) (if (match-string 4) - (add-to-list 'hosts (match-string 4))))) - (sort hosts 'string-lessp))) + (cl-pushnew (match-string 4) hosts :test #'equal)))) + (sort hosts #'string-lessp))) (defun eshell-read-hosts (file result-var timestamp-var) "Read the contents of /etc/passwd for user names." diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 188b8165248..75c36a68544 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -395,12 +395,9 @@ process any indices that come after the variable reference." indices (and (not (eobp)) (eq (char-after) ?\[) (eshell-parse-indices)) - value (list 'let - (list (list 'indices - (list 'quote indices))) - value)) + value `(let ((indices ',indices)) ,value)) (if get-len - (list 'length value) + `(length ,value) value))) (defun eshell-parse-variable-ref () @@ -414,67 +411,68 @@ Possible options are: disambiguates the length of the name {COMMAND} result of command is variable's value (LISP-FORM) result of Lisp form is variable's value" - (let (end) - (cond - ((eq (char-after) ?{) - (let ((end (eshell-find-delimiter ?\{ ?\}))) - (if (not end) - (throw 'eshell-incomplete ?\{) - (prog1 - (list 'eshell-convert - (list 'eshell-command-to-value - (list 'eshell-as-subcommand - (eshell-parse-command - (cons (1+ (point)) end))))) - (goto-char (1+ end)))))) - ((memq (char-after) '(?\' ?\")) - (let ((name (if (eq (char-after) ?\') - (eshell-parse-literal-quote) - (eshell-parse-double-quote)))) - (if name + (cond + ((eq (char-after) ?{) + (let ((end (eshell-find-delimiter ?\{ ?\}))) + (if (not end) + (throw 'eshell-incomplete ?\{) + (prog1 + (list 'eshell-convert + (list 'eshell-command-to-value + (list 'eshell-as-subcommand + (eshell-parse-command + (cons (1+ (point)) end))))) + (goto-char (1+ end)))))) + ((memq (char-after) '(?\' ?\")) + (let ((name (if (eq (char-after) ?\') + (eshell-parse-literal-quote) + (eshell-parse-double-quote)))) + (if name (list 'eshell-get-variable (eval name) 'indices)))) - ((eq (char-after) ?\<) - (let ((end (eshell-find-delimiter ?\< ?\>))) - (if (not end) - (throw 'eshell-incomplete ?\<) - (let* ((temp (make-temp-file temporary-file-directory)) - (cmd (concat (buffer-substring (1+ (point)) end) - " > " temp))) - (prog1 - (list - 'let (list (list 'eshell-current-handles - (list 'eshell-create-handles temp - (list 'quote 'overwrite)))) - (list - 'progn - (list 'eshell-as-subcommand - (eshell-parse-command cmd)) - (list 'ignore - (list 'nconc 'eshell-this-command-hook - (list 'list - (list 'function - (list 'lambda nil - (list 'delete-file temp)))))) - (list 'quote temp))) - (goto-char (1+ end))))))) - ((eq (char-after) ?\() - (condition-case err - (list 'eshell-command-to-value - (list 'eshell-lisp-command - (list 'quote (read (current-buffer))))) - (end-of-file - (throw 'eshell-incomplete ?\()))) - ((assoc (char-to-string (char-after)) - eshell-variable-aliases-list) - (forward-char) - (list 'eshell-get-variable - (char-to-string (char-before)) 'indices)) - ((looking-at eshell-variable-name-regexp) - (prog1 - (list 'eshell-get-variable (match-string 0) 'indices) - (goto-char (match-end 0)))) - (t - (error "Invalid variable reference"))))) + ((eq (char-after) ?\<) + (let ((end (eshell-find-delimiter ?\< ?\>))) + (if (not end) + (throw 'eshell-incomplete ?\<) + (let* ((temp (make-temp-file temporary-file-directory)) + (cmd (concat (buffer-substring (1+ (point)) end) + " > " temp))) + (prog1 + (list + 'let (list (list 'eshell-current-handles + (list 'eshell-create-handles temp + (list 'quote 'overwrite)))) + (list + 'progn + (list 'eshell-as-subcommand + (eshell-parse-command cmd)) + (list 'ignore + (list 'nconc 'eshell-this-command-hook + (list 'list + (list 'function + (list 'lambda nil + (list 'delete-file temp)))))) + (list 'quote temp))) + (goto-char (1+ end))))))) + ((eq (char-after) ?\() + (condition-case nil + (list 'eshell-command-to-value + (list 'eshell-lisp-command + (list 'quote (read (current-buffer))))) + (end-of-file + (throw 'eshell-incomplete ?\()))) + ((assoc (char-to-string (char-after)) + eshell-variable-aliases-list) + (forward-char) + (list 'eshell-get-variable + (char-to-string (char-before)) 'indices)) + ((looking-at eshell-variable-name-regexp) + (prog1 + (list 'eshell-get-variable (match-string 0) 'indices) + (goto-char (match-end 0)))) + (t + (error "Invalid variable reference")))) + +(defvar eshell-glob-function) (defun eshell-parse-indices () "Parse and return a list of list of indices." diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 9bdf8b3eb68..e3f8f0d11bc 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -300,7 +300,7 @@ buffer selected (or created)." (get-buffer-create eshell-buffer-name))))) (cl-assert (and buf (buffer-live-p buf))) (pop-to-buffer-same-window buf) - (unless (eq major-mode 'eshell-mode) + (unless (derived-mode-p 'eshell-mode) (eshell-mode)) buf)) diff --git a/lisp/files.el b/lisp/files.el index f9ff3c936bd..ca55c646699 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2447,35 +2447,20 @@ and `magic-mode-alist', which determines modes based on file contents.") (mapcar (lambda (l) (cons (purecopy (car l)) (cdr l))) - '(("perl" . perl-mode) - ("perl5" . perl-mode) - ("miniperl" . perl-mode) - ("wish" . tcl-mode) - ("wishx" . tcl-mode) - ("tcl" . tcl-mode) - ("tclsh" . tcl-mode) + '(("\\(mini\\)?perl5?" . perl-mode) + ("wishx?" . tcl-mode) + ("tcl\\(sh\\)?" . tcl-mode) ("expect" . tcl-mode) ("scm" . scheme-mode) - ("ash" . sh-mode) - ("bash" . sh-mode) - ("bash2" . sh-mode) - ("csh" . sh-mode) - ("dtksh" . sh-mode) + ("[acjkwz]sh" . sh-mode) + ("r?bash2?" . sh-mode) + ("\\(dt\\|pd\\|w\\)ksh" . sh-mode) ("es" . sh-mode) - ("itcsh" . sh-mode) - ("jsh" . sh-mode) - ("ksh" . sh-mode) + ("i?tcsh" . sh-mode) ("oash" . sh-mode) - ("pdksh" . sh-mode) - ("rbash" . sh-mode) ("rc" . sh-mode) ("rpm" . sh-mode) - ("sh" . sh-mode) - ("sh5" . sh-mode) - ("tcsh" . sh-mode) - ("wksh" . sh-mode) - ("wsh" . sh-mode) - ("zsh" . sh-mode) + ("sh5?" . sh-mode) ("tail" . text-mode) ("more" . text-mode) ("less" . text-mode) @@ -2486,9 +2471,10 @@ and `magic-mode-alist', which determines modes based on file contents.") ("emacs" . emacs-lisp-mode))) "Alist mapping interpreter names to major modes. This is used for files whose first lines match `auto-mode-interpreter-regexp'. -Each element looks like (INTERPRETER . MODE). -If INTERPRETER matches the name of the interpreter specified in the first line -of a script, mode MODE is enabled. +Each element looks like (REGEXP . MODE). +If \\\\`REGEXP\\\\' matches the name (minus any directory part) of +the interpreter specified in the first line of a script, enable +major mode MODE. See also `auto-mode-alist'.") @@ -2683,19 +2669,23 @@ we don't actually set it to the same mode the buffer already has." ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which ;; finds the interpreter anywhere in $PATH. - (unless done - (setq mode (save-excursion - (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2) - "")) - ;; Map interpreter name to a mode, signaling we're done at the - ;; same time. - done (assoc (file-name-nondirectory mode) - interpreter-mode-alist)) - ;; If we found an interpreter mode to use, invoke it now. - (if done - (set-auto-mode-0 (cdr done) keep-mode-if-same))) + (and (not done) + (setq mode (save-excursion + (goto-char (point-min)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2)))) + ;; Map interpreter name to a mode, signaling we're done at the + ;; same time. + (setq done (assoc-default + (file-name-nondirectory mode) + (mapcar (lambda (e) + (cons + (format "\\`%s\\'" (car e)) + (cdr e))) + interpreter-mode-alist) + #'string-match-p)) + ;; If we found an interpreter mode to use, invoke it now. + (set-auto-mode-0 done keep-mode-if-same)) ;; Next try matching the buffer beginning against magic-mode-alist. (unless done (if (setq done (save-excursion @@ -3647,21 +3637,17 @@ FILE is the name of the file holding the variables to apply. The new class name is the same as the directory in which FILE is found. Returns the new class name." (with-temp-buffer - ;; This is with-demoted-errors, but we want to mention dir-locals - ;; in any error message. - (condition-case err - (progn - (insert-file-contents file) - (unless (zerop (buffer-size)) - (let* ((dir-name (file-name-directory file)) - (class-name (intern dir-name)) - (variables (let ((read-circle nil)) - (read (current-buffer))))) - (dir-locals-set-class-variables class-name variables) - (dir-locals-set-directory-class dir-name class-name - (nth 5 (file-attributes file))) - class-name))) - (error (message "Error reading dir-locals: %S" err) nil)))) + (with-demoted-errors "Error reading dir-locals: %S" + (insert-file-contents file) + (unless (zerop (buffer-size)) + (let* ((dir-name (file-name-directory file)) + (class-name (intern dir-name)) + (variables (let ((read-circle nil)) + (read (current-buffer))))) + (dir-locals-set-class-variables class-name variables) + (dir-locals-set-directory-class dir-name class-name + (nth 5 (file-attributes file))) + class-name))))) (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index c75588536a4..2eea1fb833e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,34 @@ +2013-09-12 Glenn Morris + + * gnus-icalendar.el (gnus-icalendar-event--build-reply-event-body): + Avoid using `find', which i) might not be defined at runtime; + ii) does not work, since its default test is eql, not equal. + (gnus-mime-action-alist): Declare. + +2013-09-11 Stefan Monnier + + * score-mode.el (gnus-score-mode-map): Move initialization + into declaration. + (gnus-score-mode): Use define-derived-mode. + * gnus-srvr.el (gnus-browse-mode): Use define-derived-mode. + * gnus-kill.el (gnus-kill-file-mode-map): Move initialization + into declaration. + (gnus-kill-file-mode): Use define-derived-mode. + (gnus-kill-file-edit-file, gnus-kill-file-enter-kill, gnus-kill): + Use derived-mode-p. + * gnus-group.el (gnus-group-mode): Use define-derived-mode. + (gnus-group-setup-buffer, gnus-group-name-at-point) + (gnus-group-make-web-group, gnus-group-enter-directory) + (gnus-group-suspend): Use derived-mode-p. + * gnus-cus.el (gnus-custom-mode): Use define-derived-mode. + * gnus-bookmark.el (gnus-bookmark-bmenu-mode): Use define-derived-mode. + * gnus-art.el (gnus-article-mode): Use define-derived-mode. + (gnus-article-setup-buffer, gnus-article-prepare) + (gnus-article-prepare-display, gnus-sticky-article) + (gnus-kill-sticky-article-buffer, gnus-kill-sticky-article-buffers) + (gnus-bind-safe-url-regexp, gnus-article-check-buffer) + (gnus-article-read-summary-keys): Use derived-mode-p. + 2013-08-28 Katsumi Yamaoka * mm-decode.el (mm-temp-files-delete): Fix file deletion logic. @@ -177,15 +208,15 @@ 2013-07-10 David Engster * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks - if `gnus-newsrc-file-version' does not match `gnus-version'. This - fixes a bug in Emacs trunk where the 'unexist' marks were always + if `gnus-newsrc-file-version' does not match `gnus-version'. + This fixes a bug in Emacs trunk where the 'unexist' marks were always removed at startup because "Gnus v5.13" was considered smaller than "Ma Gnus v0.03". 2013-07-10 Tassilo Horn - * gnus.el (gnus-summary-line-format): Reference - `gnus-user-date-format-alist' for the &user-date; format, not + * gnus.el (gnus-summary-line-format): + Reference `gnus-user-date-format-alist' for the &user-date; format, not `gnus-summary-user-date-format-alist'. 2013-07-08 Lars Magne Ingebrigtsen @@ -467,7 +498,7 @@ * shr.el (shr-render-td): Support horizontal alignment. - * eww.el (eww-put-color): Removed. + * eww.el (eww-put-color): Remove. (eww-colorize-region): Use `add-face-text-property'. * shr.el (shr-add-font): Append face data, so that we get the correct @@ -522,7 +553,7 @@ 2013-06-16 Rüdiger Sonderfeld - * shr.el (shr-dom-to-xml): Fixed function call. + * shr.el (shr-dom-to-xml): Fix function call. * eww.el (eww): New group. (eww-header-line-format): New custom variable. @@ -558,8 +589,8 @@ (auth-source-netrc-parse): Refactor and improve netrc parser to support single-quoted strings and multiline entries. (auth-source-netrc-parse-next-interesting) - (auth-source-netrc-parse-one, auth-source-netrc-parse-entries): New - functions to support parser. + (auth-source-netrc-parse-one, auth-source-netrc-parse-entries): + New functions to support parser. 2013-06-14 Lars Magne Ingebrigtsen @@ -707,8 +738,8 @@ * registry.el (initialize-instance, registry-lookup) (registry-lookup-breaks-before-lexbind, registry-lookup-secondary) (registry-lookup-secondary-value, registry-search, registry-delete) - (registry-insert, registry-reindex, registry-size, registry-prune): Do - not wrap methods in `eval-and-compile'. This breaks due to latest + (registry-insert, registry-reindex, registry-size, registry-prune): + Do not wrap methods in `eval-and-compile'. This breaks due to latest changes in EIEIO (introduction of eieio-core.el). 2013-05-30 Glenn Morris @@ -988,8 +1019,8 @@ 2013-03-26 Andrew Cohen * nnir.el: Major rewrite. Cleaner separation between searches and group - management. Marks are now shown in nnir summary buffers. Rudimentary - support for real (i.e. not ephemeral) nnir groups. + management. Marks are now shown in nnir summary buffers. + Rudimentary support for real (i.e. not ephemeral) nnir groups. (gnus-summary-make-nnir-group): New function for initiating searches from a summary buffer. @@ -1018,8 +1049,8 @@ 2013-02-22 David Engster * gnus-registry.el (gnus-registry-save): Provide class name when - calling `eieio-persistent-read' to avoid "unsafe call" warning. Use - `condition-case' to stay compatible with older EIEIO versions which + calling `eieio-persistent-read' to avoid "unsafe call" warning. + Use `condition-case' to stay compatible with older EIEIO versions which only accept one argument. 2013-02-17 Daiki Ueno @@ -5295,7 +5326,7 @@ a creation default, pass the whole port list down. It will be completed. - * auth-source.el (auth-source-search): Updated docs to talk about + * auth-source.el (auth-source-search): Update docs to talk about multiple creation choices. (auth-source-netrc-create): Accept a list as a value (from the search parameters) and do completion on that list. Keep a separate netrc line @@ -5362,7 +5393,7 @@ (gnus-summary-exit): Kill the correct article buffer on exit from a `C-d' group. - * gnus-start.el (gnus-use-backend-marks): Removed, since it duplicates + * gnus-start.el (gnus-use-backend-marks): Remove, since it duplicates gnus-propagate-marks. * gnus-sum.el (gnus-summary-exit-no-update): Restore the group conf @@ -18399,7 +18430,7 @@ 2005-11-19 Kevin Greiner - * gnus-sum.el (gnus-fetch-old-headers): Updated docs to warn that + * gnus-sum.el (gnus-fetch-old-headers): Update docs to warn that it can seriously impact performance as it bypasses the agent's local caches. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e65b9fb99e4..b80aa3a24e9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3683,7 +3683,7 @@ function and want to see what the date was before converting." (walk-windows (lambda (w) (set-buffer (window-buffer w)) - (when (eq major-mode 'gnus-article-mode) + (when (derived-mode-p 'gnus-article-mode) (let ((old-line (count-lines (point-min) (point))) (old-column (- (point) (line-beginning-position))) (window-start (window-start w)) @@ -4455,7 +4455,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defvar bookmark-make-record-function) (defvar shr-put-image-function) -(defun gnus-article-mode () +(define-derived-mode gnus-article-mode fundamental-mode "Article" "Major mode for displaying an article. All normal editing commands are switched off. @@ -4470,13 +4470,8 @@ commands: \\[gnus-article-mail]\t Send a reply to the address near point \\[gnus-article-describe-briefly]\t Describe the current mode briefly \\[gnus-info-find-node]\t Go to the Gnus info node" - (interactive) - (kill-all-local-variables) (gnus-simplify-mode-line) - (setq mode-name "Article") - (setq major-mode 'gnus-article-mode) (make-local-variable 'minor-mode-alist) - (use-local-map gnus-article-mode-map) (when (gnus-visual-p 'article-menu 'menu) (gnus-article-make-menu-bar) (when gnus-summary-tool-bar-map @@ -4504,9 +4499,7 @@ commands: (buffer-disable-undo) (setq buffer-read-only t show-trailing-whitespace nil) - (set-syntax-table gnus-article-mode-syntax-table) - (mm-enable-multibyte) - (gnus-run-mode-hooks 'gnus-article-mode-hook)) + (mm-enable-multibyte)) (defun gnus-article-setup-buffer () "Initialize the article buffer." @@ -4554,7 +4547,7 @@ commands: (setq gnus-article-mime-handle-alist nil) (buffer-disable-undo) (setq buffer-read-only t) - (unless (eq major-mode 'gnus-article-mode) + (unless (derived-mode-p 'gnus-article-mode) (gnus-article-mode)) (setq truncate-lines gnus-article-truncate-lines) (current-buffer)) @@ -4603,7 +4596,7 @@ If ARTICLE is an id, HEADER should be the article headers. If ALL-HEADERS is non-nil, no headers are hidden." (save-excursion ;; Make sure we start in a summary buffer. - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) (let* ((gnus-article (if header (mail-header-number header) article)) @@ -4714,7 +4707,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((gnus-article-buffer (current-buffer)) buffer-read-only (inhibit-read-only t)) - (unless (eq major-mode 'gnus-article-mode) + (unless (derived-mode-p 'gnus-article-mode) (gnus-article-mode)) (setq buffer-read-only nil gnus-article-wash-types nil @@ -4776,7 +4769,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer." "*")) (if (and (gnus-buffer-live-p new-art-buf-name) (with-current-buffer new-art-buf-name - (eq major-mode 'gnus-sticky-article-mode))) + (derived-mode-p 'gnus-sticky-article-mode))) (switch-to-buffer new-art-buf-name) (setq new-art-buf-name (rename-buffer new-art-buf-name t))) (gnus-sticky-article-mode)) @@ -4792,7 +4785,7 @@ If none is given, assume the current buffer and kill it if it has (unless buffer (setq buffer (current-buffer))) (with-current-buffer buffer - (when (eq major-mode 'gnus-sticky-article-mode) + (when (derived-mode-p 'gnus-sticky-article-mode) (gnus-kill-buffer buffer)))) (defun gnus-kill-sticky-article-buffers (arg) @@ -4801,11 +4794,11 @@ If a prefix ARG is given, ask for confirmation." (interactive "P") (dolist (buf (gnus-buffers)) (with-current-buffer buf - (when (eq major-mode 'gnus-sticky-article-mode) - (if (not arg) - (gnus-kill-buffer buf) - (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? ")) - (gnus-kill-buffer buf))))))) + (when (derived-mode-p 'gnus-sticky-article-mode) + (if (not arg) + (gnus-kill-buffer buf) + (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? ")) + (gnus-kill-buffer buf))))))) ;;; ;;; Gnus MIME viewing functions @@ -4893,7 +4886,7 @@ General format specifiers can also be used. See Info node (defmacro gnus-bind-safe-url-regexp (&rest body) "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." `(let ((mm-w3m-safe-url-regexp - (let ((group (if (and (eq major-mode 'gnus-article-mode) + (let ((group (if (and (derived-mode-p 'gnus-article-mode) (gnus-buffer-live-p gnus-article-current-summary)) (with-current-buffer gnus-article-current-summary @@ -6477,7 +6470,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-check-buffer () "Beep if not in an article buffer." - (unless (equal major-mode 'gnus-article-mode) + (unless (derived-mode-p 'gnus-article-mode) (error "Command invoked outside of a Gnus article buffer"))) (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) @@ -6592,7 +6585,7 @@ not have a face in `gnus-article-boring-faces'." new-sum-point (window-live-p win) (with-current-buffer (window-buffer win) - (eq major-mode 'gnus-summary-mode))) + (derived-mode-p 'gnus-summary-mode))) (set-window-point win new-sum-point) (set-window-start win new-sum-start) (set-window-hscroll win new-sum-hscroll)))) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 7a3d273622a..c31cb1aef36 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -190,7 +190,7 @@ So the cdr of each bookmark is an alist too.") "Set a bookmark for this article." (interactive) (gnus-bookmark-maybe-load-default-file) - (if (or (not (eq major-mode 'gnus-summary-mode)) + (if (or (not (derived-mode-p 'gnus-summary-mode)) (not gnus-article-current)) (error "Please select an article in the Gnus summary buffer") (let* ((group (car gnus-article-current)) @@ -473,7 +473,7 @@ That is, all information but the name." ;; Been to lazy to use gnus-bookmark-save... (defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file) -(defun gnus-bookmark-bmenu-mode () +(define-derived-mode gnus-bookmark-bmenu-mode fundamental-mode "Bookmark Menu" "Major mode for editing a list of Gnus bookmarks. Each line describes one of the bookmarks in Gnus. Letters do not insert themselves; instead, they are commands. @@ -497,13 +497,8 @@ Gnus bookmarks names preceded by a \"*\" have annotations. in another buffer. \\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." - (kill-all-local-variables) - (use-local-map gnus-bookmark-bmenu-mode-map) (setq truncate-lines t) - (setq buffer-read-only t) - (setq major-mode 'gnus-bookmark-bmenu-mode) - (setq mode-name "Bookmark Menu") - (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook)) + (setq buffer-read-only t)) ;; avoid compilation warnings (defvar gnus-bookmark-bmenu-toggle-infos nil) diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index c8fb5b5dc73..247c081a20f 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -33,7 +33,7 @@ ;;; Widgets: -(defun gnus-custom-mode () +(define-derived-mode gnus-custom-mode fundamental-mode "Gnus Customize" "Major mode for editing Gnus customization buffers. The following commands are available: @@ -45,9 +45,6 @@ The following commands are available: Entry to this mode calls the value of `gnus-custom-mode-hook' if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'gnus-custom-mode - mode-name "Gnus Customize") (use-local-map widget-keymap) ;; Emacs stuff: (when (and (facep 'custom-button-face) @@ -63,8 +60,7 @@ if that value is non-nil." (set (make-local-variable 'widget-push-button-prefix) "") (set (make-local-variable 'widget-push-button-suffix) "") (set (make-local-variable 'widget-link-prefix) "") - (set (make-local-variable 'widget-link-suffix) "")) - (gnus-run-mode-hooks 'gnus-custom-mode-hook)) + (set (make-local-variable 'widget-link-suffix) ""))) ;;; Group Customization: diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9533f5819a4..c8945e57531 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1105,7 +1105,7 @@ When FORCE, rebuild the tool bar." (set (make-local-variable 'tool-bar-map) map)))) gnus-group-tool-bar-map) -(defun gnus-group-mode () +(define-derived-mode gnus-group-mode fundamental-mode "Group" "Major mode for reading news. All normal editing commands are switched off. @@ -1122,17 +1122,12 @@ For more in-depth information on this mode, read the manual (`\\[gnus-info-find- The following commands are available: \\{gnus-group-mode-map}" - (interactive) - (kill-all-local-variables) (when (gnus-visual-p 'group-menu 'menu) (gnus-group-make-menu-bar) (gnus-group-make-tool-bar)) (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") (gnus-group-set-mode-line) (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) (buffer-disable-undo) (setq truncate-lines t) (setq buffer-read-only t @@ -1143,8 +1138,7 @@ The following commands are available: (when gnus-use-undo (gnus-undo-mode 1)) (when gnus-slave - (gnus-slave-mode)) - (gnus-run-mode-hooks 'gnus-group-mode-hook)) + (gnus-slave-mode))) (defun gnus-update-group-mark-positions () (save-excursion @@ -1193,7 +1187,7 @@ The following commands are available: (defun gnus-group-setup-buffer () (set-buffer (gnus-get-buffer-create gnus-group-buffer)) - (unless (eq major-mode 'gnus-group-mode) + (unless (derived-mode-p 'gnus-group-mode) (gnus-group-mode))) (defun gnus-group-name-charset (method group) @@ -2147,7 +2141,7 @@ be permanent." (defun gnus-group-name-at-point () "Return a group name from around point if it exists, or nil." - (if (eq major-mode 'gnus-group-mode) + (if (derived-mode-p 'gnus-group-mode) (let ((group (gnus-group-group-name))) (when group (gnus-group-decoded-name group))) @@ -3114,7 +3108,7 @@ If SOLID (the prefix), create a solid group." (gnus-group-read-ephemeral-group group method t (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) + (if (derived-mode-p 'gnus-summary-mode) 'summary 'group)))))) (defvar nnrss-group-alist) (eval-when-compile @@ -3229,7 +3223,7 @@ mail messages or news articles in files that have numeric names." (unless (gnus-group-read-ephemeral-group name method t (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) + (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))) (error "Couldn't enter %s" dir)))) @@ -4319,7 +4313,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (unless (or (eq buf group-buf) (eq buf gnus-dribble-buffer) (with-current-buffer buf - (eq major-mode 'message-mode))) + (derived-mode-p 'message-mode))) (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index a946a586033..e4e1ec29ae9 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -257,9 +257,9 @@ status will be retrieved from the first matching attendee record." ((string= key "ATTENDEE") (update-attendee-status line)) ((string= key "SUMMARY") (update-summary line)) ((string= key "DTSTAMP") (update-dtstamp)) - ((find key '("ORGANIZER" "DTSTART" "DTEND" - "LOCATION" "DURATION" "SEQUENCE" - "RECURRENCE-ID" "UID")) line) + ((member key '("ORGANIZER" "DTSTART" "DTEND" + "LOCATION" "DURATION" "SEQUENCE" + "RECURRENCE-ID" "UID")) line) (t nil)))) (when new-line (push new-line reply-event-lines)))))) @@ -816,6 +816,8 @@ is searched." (gnus-icalendar-show-org-agenda (with-current-buffer gnus-article-buffer gnus-icalendar-event))) +(defvar gnus-mime-action-alist) ; gnus-art + (defun gnus-icalendar-setup () (add-to-list 'mm-inlined-types "text/calendar") (add-to-list 'mm-automatic-display "text/calendar") diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index b3f06de0868..011288e280b 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -75,20 +75,20 @@ of time." ;;; Gnus Kill File Mode ;;; -(defvar gnus-kill-file-mode-map nil) +(defvar gnus-kill-file-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map emacs-lisp-mode-map) + (gnus-define-keymap map + "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject + "\C-c\C-k\C-a" gnus-kill-file-kill-by-author + "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread + "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref + "\C-c\C-a" gnus-kill-file-apply-buffer + "\C-c\C-e" gnus-kill-file-apply-last-sexp + "\C-c\C-c" gnus-kill-file-exit) + map)) -(unless gnus-kill-file-mode-map - (gnus-define-keymap (setq gnus-kill-file-mode-map - (copy-keymap emacs-lisp-mode-map)) - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit)) - -(defun gnus-kill-file-mode () +(define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill" "Major mode for editing kill files. If you are using this mode - you probably shouldn't. Kill files @@ -151,15 +151,7 @@ which are marked as read in the previous Gnus sessions. Marks other than `D' should be used for articles which should really be deleted. Entry to this mode calls emacs-lisp-mode-hook and -gnus-kill-file-mode-hook with no arguments, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map gnus-kill-file-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-kill-file-mode) - (setq mode-name "Kill") - (lisp-mode-variables nil) - (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) +gnus-kill-file-mode-hook with no arguments, if that value is non-nil.") (defun gnus-kill-file-edit-file (newsgroup) "Begin editing a kill file for NEWSGROUP. @@ -175,10 +167,10 @@ If NEWSGROUP is nil, the global kill file is selected." (let ((buffer (find-file-noselect file))) (cond ((get-buffer-window buffer) (pop-to-buffer buffer)) - ((eq major-mode 'gnus-group-mode) + ((derived-mode-p 'gnus-group-mode) (gnus-configure-windows 'group) ;Take all windows. (pop-to-buffer buffer)) - ((eq major-mode 'gnus-summary-mode) + ((derived-mode-p 'gnus-summary-mode) (gnus-configure-windows 'article) (pop-to-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer) @@ -201,7 +193,7 @@ If NEWSGROUP is nil, the global kill file is selected." ;; REGEXP: The string to kill. (save-excursion (let (string) - (unless (eq major-mode 'gnus-kill-file-mode) + (unless (derived-mode-p 'gnus-kill-file-mode) (gnus-kill-set-kill-buffer)) (unless dont-move (goto-char (point-max))) @@ -520,7 +512,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence." (setq kill-list (cdr kill-list)))) (gnus-execute field kill-list command nil (not all)))))) (switch-to-buffer old-buffer) - (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) + (when (and (derived-mode-p 'gnus-kill-file-mode) regexp (not silent)) (gnus-pp-gnus-kill (nconc (list 'gnus-kill field (if (consp regexp) (list 'quote regexp) regexp)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 69774587d80..2f151e570d7 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -244,6 +244,7 @@ For more in-depth information on this mode, read the manual The following commands are available: \\{gnus-server-mode-map}" + ;; FIXME: Use define-derived-mode. (interactive) (when (gnus-visual-p 'server-menu 'menu) (gnus-server-make-menu-bar)) @@ -869,7 +870,7 @@ claim them." (gnus-message 5 "Connecting to %s...done" (nth 1 method)) t)))) -(defun gnus-browse-mode () +(define-derived-mode gnus-browse-mode fundamental-mode "Browse Server" "Major mode for browsing a foreign server. All normal editing commands are switched off. @@ -884,20 +885,14 @@ buffer. 2) `\\[gnus-browse-read-group]' to read a group ephemerally. 3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) (when (gnus-visual-p 'browse-menu 'menu) (gnus-browse-make-menu-bar)) (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) (buffer-disable-undo) (setq truncate-lines t) (gnus-set-default-directory) - (setq buffer-read-only t) - (gnus-run-mode-hooks 'gnus-browse-mode-hook)) + (setq buffer-read-only t)) (defun gnus-browse-read-group (&optional no-article number) "Enter the group at the current line. @@ -1022,7 +1017,7 @@ doing the deletion." (defun gnus-browse-exit () "Quit browsing and return to the group buffer." (interactive) - (when (eq major-mode 'gnus-browse-mode) + (when (derived-mode-p 'gnus-browse-mode) (gnus-kill-buffer (current-buffer))) ;; Insert the newly subscribed groups in the group buffer. (with-current-buffer gnus-group-buffer diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index ec24f1f9670..58767cfcc7a 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -40,13 +40,13 @@ (defvar gnus-score-edit-exit-function nil "Function run on exit from the score buffer.") -(defvar gnus-score-mode-map nil) -(unless gnus-score-mode-map - (setq gnus-score-mode-map (make-sparse-keymap)) - (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map) - (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) - (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) - (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) +(defvar gnus-score-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map emacs-lisp-mode-map) + (define-key map "\C-c\C-c" 'gnus-score-edit-exit) + (define-key map "\C-c\C-d" 'gnus-score-edit-insert-date) + (define-key map "\C-c\C-p" 'gnus-score-pretty-print) + map)) (defvar score-mode-syntax-table (let ((table (copy-syntax-table lisp-mode-syntax-table))) @@ -58,21 +58,13 @@ (defvar score-mode-coding-system mm-universal-coding-system) ;;;###autoload -(defun gnus-score-mode () +(define-derived-mode gnus-score-mode emacs-lisp-mode "Score" "Mode for editing Gnus score files. This mode is an extended emacs-lisp mode. \\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) (gnus-score-make-menu-bar) - (set-syntax-table score-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (make-local-variable 'gnus-score-edit-exit-function) - (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) + (make-local-variable 'gnus-score-edit-exit-function)) (defun gnus-score-make-menu-bar () (unless (boundp 'gnus-score-menu) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index ce29505d6f2..8356a186f13 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -156,7 +156,7 @@ elisp byte-compiler." (null buffer-file-name)) italic) (30 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face) - (35 (eq major-mode 'dired-mode) font-lock-function-name-face)) + (35 (derived-mode-p 'dired-mode) font-lock-function-name-face)) "An alist describing how to fontify buffers. Each element should be of the form (PRIORITY FORM FACE), where PRIORITY is an integer, FORM is an arbitrary form to evaluate in the @@ -2358,7 +2358,7 @@ FORMATS is the value to use for `ibuffer-formats'. ;; We switch to the buffer's window in order to be able ;; to modify the value of point (select-window (get-buffer-window buf 0)) - (or (eq major-mode 'ibuffer-mode) + (or (derived-mode-p 'ibuffer-mode) (ibuffer-mode)) (setq ibuffer-restore-window-config-on-quit other-window-p) (when shrink @@ -2383,7 +2383,7 @@ FORMATS is the value to use for `ibuffer-formats'. (message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for help")))))) (put 'ibuffer-mode 'mode-class 'special) -(defun ibuffer-mode () +(define-derived-mode ibuffer-mode special-mode "IBuffer" "A major mode for viewing a list of buffers. In Ibuffer, you can conveniently perform many operations on the currently open buffers, in addition to filtering your view to a @@ -2564,10 +2564,6 @@ filter groups are displayed in this order of precedence. You may rearrange filter groups by using the regular '\\[ibuffer-kill-line]' and '\\[ibuffer-yank]' pair. Yanked groups will be inserted before the group at point." - (kill-all-local-variables) - (use-local-map ibuffer-mode-map) - (setq major-mode 'ibuffer-mode) - (setq mode-name "Ibuffer") ;; Include state info next to the mode name. (set (make-local-variable 'mode-line-process) '(" by " @@ -2627,13 +2623,12 @@ will be inserted before the group at point." (ibuffer-update-format) (when ibuffer-default-directory (setq default-directory ibuffer-default-directory)) - (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) - (run-mode-hooks 'ibuffer-mode-hook)) + (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)) ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "d06b2735a74954e0c6922a811de7608c") +;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "85795a4045d20654599b73b88e8e1bc9") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/info.el b/lisp/info.el index 65cd7eddcfd..93442689319 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -790,7 +790,7 @@ See a list of available Info commands in `Info-mode'." (defun info-setup (file-or-node buffer) "Display Info node FILE-OR-NODE in BUFFER." - (if (and buffer (not (eq major-mode 'Info-mode))) + (if (and buffer (not (derived-mode-p 'Info-mode))) (Info-mode)) (if file-or-node ;; If argument already contains parentheses, don't add another set @@ -931,7 +931,7 @@ STRICT-CASE is non-nil)." (info-initialize) (setq filename (Info-find-file filename)) ;; Go into Info buffer. - (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) ;; Record the node we are leaving, if we were in one. (and (not no-going-back) Info-current-file @@ -961,7 +961,7 @@ otherwise, that defaults to `Top'." "Go to an Info node FILENAME and NODENAME, re-reading disk contents. When *info* is already displaying FILENAME and NODENAME, the window position is preserved, if possible." - (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) (let ((old-filename Info-current-file) (old-nodename Info-current-node) (window-selected (eq (selected-window) (get-buffer-window))) @@ -1065,7 +1065,7 @@ is non-nil)." (defun Info-find-node-2 (filename nodename &optional no-going-back strict-case) (buffer-disable-undo (current-buffer)) - (or (eq major-mode 'Info-mode) + (or (derived-mode-p 'Info-mode) (Info-mode)) (widen) (setq Info-current-node nil) @@ -2212,7 +2212,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat." (interactive) ;; In case another window is currently selected (save-window-excursion - (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) (Info-goto-node (Info-extract-pointer "next")))) (defun Info-prev () @@ -2220,7 +2220,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat." (interactive) ;; In case another window is currently selected (save-window-excursion - (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))) (defun Info-up (&optional same-file) @@ -2229,7 +2229,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (interactive) ;; In case another window is currently selected (save-window-excursion - (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) (let ((old-node Info-current-node) (old-file Info-current-file) (node (Info-extract-pointer "up")) p) @@ -4082,7 +4082,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (defun Info-menu-update () "Update the Info menu for the current node." (condition-case nil - (if (or (not (eq major-mode 'Info-mode)) + (if (or (not (derived-mode-p 'Info-mode)) (equal (list Info-current-file Info-current-node) Info-menu-last-node)) () @@ -4285,7 +4285,7 @@ Advanced commands: ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too. (defun Info-kill-buffer () - (and (eq major-mode 'Info-mode) + (and (derived-mode-p 'Info-mode) Info-tag-table-buffer (kill-buffer Info-tag-table-buffer))) @@ -4302,10 +4302,11 @@ Advanced commands: (copy-marker (marker-position m))) (make-marker)))))) -(defvar Info-edit-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map "\C-c\C-c" 'Info-cease-edit) - map) +(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1") +(defvar Info-edit-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map "\C-c\C-c" 'Info-cease-edit) + map) "Local keymap used within `e' command of Info.") (make-obsolete-variable 'Info-edit-map @@ -4315,19 +4316,14 @@ Advanced commands: ;; Info-edit mode is suitable only for specially formatted data. (put 'Info-edit-mode 'mode-class 'special) -(defun Info-edit-mode () +(define-derived-mode Info-edit-mode text-mode "Info Edit" "Major mode for editing the contents of an Info node. Like text mode with the addition of `Info-cease-edit' which returns to Info mode for browsing. \\{Info-edit-map}" - (use-local-map Info-edit-map) - (setq major-mode 'Info-edit-mode) - (setq mode-name "Info Edit") - (kill-local-variable 'mode-line-buffer-identification) (setq buffer-read-only nil) (force-mode-line-update) - (buffer-enable-undo (current-buffer)) - (run-mode-hooks 'Info-edit-mode-hook)) + (buffer-enable-undo (current-buffer))) (make-obsolete 'Info-edit-mode "editing Info nodes by hand is not recommended." "24.4") @@ -4352,11 +4348,7 @@ This feature will be removed in future.") (and (buffer-modified-p) (y-or-n-p "Save the file? ") (save-buffer)) - (use-local-map Info-mode-map) - (setq major-mode 'Info-mode) - (setq mode-name "Info") - (Info-set-mode-line) - (setq buffer-read-only t) + (Info-mode) (force-mode-line-update) (and (marker-position Info-tag-table-marker) (buffer-modified-p) @@ -4469,7 +4461,7 @@ COMMAND must be a symbol or string." ;; Get Info running, and pop to it in another window. (save-window-excursion (info)) - (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*")) + (or (derived-mode-p 'Info-mode) (pop-to-buffer "*info*")) ;; Bind Info-history to nil, to prevent the last Index node ;; visited by Info-find-emacs-command-nodes from being ;; pushed onto the history. @@ -5133,7 +5125,7 @@ INDENT is the current indentation depth." NODESPEC is a string of the form: (file)node." ;; Set up a buffer we can use to fake-out Info. (with-current-buffer (get-buffer-create " *info-browse-tmp*") - (if (not (equal major-mode 'Info-mode)) + (if (not (derived-mode-p 'Info-mode)) (Info-mode)) ;; Get the node into this buffer (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec)) diff --git a/lisp/locate.el b/lisp/locate.el index ab0417070e7..99a99853da9 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -95,7 +95,7 @@ ;; ;; (defadvice dired-make-relative (before set-no-error activate) ;; "For locate mode and Windows, don't return errors" -;; (if (and (eq major-mode 'locate-mode) +;; (if (and (derived-mode-p 'locate-mode) ;; (memq system-type '(windows-nt ms-dos))) ;; (ad-set-arg 2 t) ;; )) @@ -448,7 +448,7 @@ file name or is inside a subdirectory." ;; Define a mode for locate ;; Default directory is set to "/" so that dired commands, which ;; expect to be in a tree, will work properly -(defun locate-mode () +(define-derived-mode locate-mode special-mode "Locate" "Major mode for the `*Locate*' buffer made by \\[locate]. \\\ In that buffer, you can use almost all the usual dired bindings. @@ -463,39 +463,31 @@ Specific `locate-mode' commands, such as \\[locate-find-directory], do not work in subdirectories. \\{locate-mode-map}" - ;; Not to be called interactively. - (kill-all-local-variables) ;; Avoid clobbering this variable (make-local-variable 'dired-subdir-alist) - (use-local-map locate-mode-map) - (setq major-mode 'locate-mode - mode-name "Locate" - default-directory "/" + (setq default-directory "/" buffer-read-only t selective-display t) (dired-alist-add-1 default-directory (point-min-marker)) (set (make-local-variable 'dired-directory) "/") (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches) (setq dired-switches-alist nil) - (make-local-variable 'directory-listing-before-filename-regexp) ;; This should support both Unix and Windoze style names - (setq directory-listing-before-filename-regexp - (concat "^.\\(" - (make-string (1- locate-filename-indentation) ?\s) - "\\)\\|" - (default-value 'directory-listing-before-filename-regexp))) - (make-local-variable 'dired-actual-switches) - (setq dired-actual-switches "") - (make-local-variable 'dired-permission-flags-regexp) - (setq dired-permission-flags-regexp - (concat "^.\\(" - (make-string (1- locate-filename-indentation) ?\s) - "\\)\\|" - (default-value 'dired-permission-flags-regexp))) - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'locate-update) - (set (make-local-variable 'page-delimiter) "\n\n") - (run-mode-hooks 'locate-mode-hook)) + (setq-local directory-listing-before-filename-regexp + (concat "^.\\(" + (make-string (1- locate-filename-indentation) ?\s) + "\\)\\|" + (default-value + 'directory-listing-before-filename-regexp))) + (setq-local dired-actual-switches "") + (setq-local dired-permission-flags-regexp + (concat "^.\\(" + (make-string (1- locate-filename-indentation) ?\s) + "\\)\\|" + (default-value 'dired-permission-flags-regexp))) + + (setq-local revert-buffer-function #'locate-update) + (setq-local page-delimiter "\n\n")) (put 'locate-mode 'derived-mode-parent 'dired-mode) (defun locate-do-setup (search-string) diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 5e01a7149a8..b2618ef42db 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -344,19 +344,13 @@ nil." (interactive) (kill-buffer mspools-buffer)) -(defun mspools-mode () +(define-derived-mode mspools-mode special-mode "MSpools" "Major mode for output from mspools-show. \\Move point to one of the items in this buffer, then use \\[mspools-visit-spool] to go to the spool that the current line refers to. \\[revert-buffer] to regenerate the list of spools. \\{mspools-mode-map}" - (kill-all-local-variables) - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'mspools-revert-buffer) - (use-local-map mspools-mode-map) - (setq major-mode 'mspools-mode) - (setq mode-name "MSpools") - (run-mode-hooks 'mspools-mode-hook)) + (setq-local revert-buffer-function 'mspools-revert-buffer)) (defun mspools-get-spool-files () "Find the list of spool files and display them in *spools* buffer." diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index aa244ddae81..bb4801a523d 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4768,7 +4768,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;*** -;;;### (autoloads nil "rmailsum" "rmailsum.el" "a9b3bbd9b82dd566524a1209b5cdb7dd") +;;;### (autoloads nil "rmailsum" "rmailsum.el" "9005bd5da3e21d1cc173e86fd9fec3c9") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 3a0a7824ad8..cced2231522 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -408,7 +408,7 @@ If FUNCTION is nil, includes all messages." (unless rmail-buffer (error "No RMAIL buffer found")) (let (mesg was-in-summary sumbuf) - (if (eq major-mode 'rmail-summary-mode) + (if (derived-mode-p 'rmail-summary-mode) (setq was-in-summary t)) (with-current-buffer rmail-buffer (setq rmail-summary-buffer (rmail-new-summary-1 desc redo function args) @@ -1035,7 +1035,7 @@ Optional prefix ARG means undelete ARG previous messages." ;; Rmail Summary mode is suitable only for specially formatted data. (put 'rmail-summary-mode 'mode-class 'special) -(defun rmail-summary-mode () +(define-derived-mode rmail-summary-mode special-mode "RMAIL Summary" "Rmail Summary Mode is invoked from Rmail Mode by using \\\\[rmail-summary]. As commands are issued in the summary buffer, they are applied to the corresponding mail messages in the rmail buffer. @@ -1058,10 +1058,6 @@ Commands for sorting the summary: \\[rmail-summary-sort-by-correspondent] Sort by correspondent. \\[rmail-summary-sort-by-lines] Sort by lines. \\[rmail-summary-sort-by-labels] Sort by labels." - (interactive) - (kill-all-local-variables) - (setq major-mode 'rmail-summary-mode) - (setq mode-name "RMAIL Summary") (setq truncate-lines t) (setq buffer-read-only t) (set-syntax-table text-mode-syntax-table) @@ -1074,8 +1070,7 @@ Commands for sorting the summary: (make-local-variable 'revert-buffer-function) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(rmail-summary-font-lock-keywords t)) - (rmail-summary-enable) - (run-mode-hooks 'rmail-summary-mode-hook)) + (rmail-summary-enable)) ;; Summary features need to be disabled during edit mode. (defun rmail-summary-disable () diff --git a/lisp/man.el b/lisp/man.el index 34131f43692..9eb0ccd719a 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -413,7 +413,7 @@ Otherwise, the value is whatever the function (defvar Man-topic-history nil "Topic read history.") -(defvar man-mode-syntax-table +(defvar Man-mode-syntax-table (let ((table (copy-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?. "w" table) (modify-syntax-entry ?_ "w" table) @@ -1350,7 +1350,7 @@ manpage command." (put 'Man-mode 'mode-class 'special) -(defun Man-mode () +(define-derived-mode Man-mode fundamental-mode "Man" "A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try @@ -1387,11 +1387,7 @@ The following variables may be of some use. Try The following key bindings are currently in effect in the buffer: \\{Man-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'Man-mode - mode-name "Man" - buffer-auto-save-file-name nil + (setq buffer-auto-save-file-name nil mode-line-buffer-identification (list (default-value 'mode-line-buffer-identification) " {" 'Man-page-mode-string "}") @@ -1399,8 +1395,6 @@ The following key bindings are currently in effect in the buffer: buffer-read-only t) (buffer-disable-undo) (auto-fill-mode -1) - (use-local-map Man-mode-map) - (set-syntax-table man-mode-syntax-table) (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) (set (make-local-variable 'outline-regexp) Man-heading-regexp) (set (make-local-variable 'outline-level) (lambda () 1)) @@ -1409,8 +1403,7 @@ The following key bindings are currently in effect in the buffer: (Man-build-page-list) (Man-strip-page-headers) (Man-unindent) - (Man-goto-page 1 t) - (run-mode-hooks 'Man-mode-hook)) + (Man-goto-page 1 t)) (defsubst Man-build-section-alist () "Build the list of manpage sections." diff --git a/lisp/mpc.el b/lisp/mpc.el index 825eb3c05d4..bd61c261246 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -491,10 +491,9 @@ to call FUN for any change whatsoever.") (cancel-timer mpc--status-timer) (setq mpc--status-timer nil))) (defun mpc--status-timer-run () - (condition-case err - (when (process-get (mpc-proc) 'ready) - (with-local-quit (mpc-status-refresh))) - (error (message "MPC: %s" err)))) + (with-demoted-errors "MPC: %s" + (when (process-get (mpc-proc) 'ready) + (with-local-quit (mpc-status-refresh))))) (defvar mpc--status-idle-timer nil) (defun mpc--status-idle-timer-start () @@ -520,9 +519,8 @@ to call FUN for any change whatsoever.") (run-with-idle-timer 10 t 'mpc--status-idle-timer-run)))) (defun mpc--status-idle-timer-run () (when (process-get (mpc-proc) 'ready) - (condition-case err - (with-local-quit (mpc-status-refresh)) - (error (message "MPC: %s" err)))) + (with-demoted-errors "MPC: %s" + (with-local-quit (mpc-status-refresh)))) (mpc--status-timer-start)) (defun mpc--status-timers-refresh () @@ -999,9 +997,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (`Cover (let* ((dir (file-name-directory (cdr (assq 'file info)))) (cover (concat dir "cover.jpg")) - (file (condition-case err - (mpc-file-local-copy cover) - (error (message "MPC: %s" err)))) + (file (with-demoted-errors "MPC: %s" + (mpc-file-local-copy cover))) image) ;; (debug) (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index a8a51b7d61b..57675a483b2 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -44,7 +44,7 @@ (define-key map "x" 'kill-this-buffer) map)) -(defun eudc-hotlist-mode () +(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers" "Major mode used to edit the hotlist of servers. These are the special commands of this mode: @@ -54,18 +54,12 @@ These are the special commands of this mode: t -- Transpose the server at point and the previous one q -- Commit the changes and quit. x -- Quit without committing the changes." - (interactive) - (kill-all-local-variables) - (setq major-mode 'eudc-hotlist-mode) - (setq mode-name "EUDC-Servers") - (use-local-map eudc-hotlist-mode-map) (when (featurep 'xemacs) (setq mode-popup-menu eudc-hotlist-menu) (when (featurep 'menubar) (set-buffer-menubar current-menubar) (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))) - (setq buffer-read-only t) - (run-mode-hooks 'eudc-hotlist-mode-hook)) + (setq buffer-read-only t)) ;;;###autoload (defun eudc-edit-hotlist () @@ -76,10 +70,8 @@ These are the special commands of this mode: (switch-to-buffer (get-buffer-create "*EUDC Servers*")) (setq buffer-read-only nil) (erase-buffer) - (mapc (function - (lambda (entry) - (setq proto-col (max (length (car entry)) proto-col)))) - eudc-server-hotlist) + (dolist (entry eudc-server-hotlist) + (setq proto-col (max (length (car entry)) proto-col))) (setq proto-col (+ 3 proto-col)) (setq gap (make-string (- proto-col 6) ?\ )) (insert " EUDC Servers\n" @@ -89,17 +81,16 @@ These are the special commands of this mode: "------" gap "--------\n" "\n") (setq eudc-hotlist-list-beginning (point)) - (mapc (lambda (entry) - (insert (car entry)) - (indent-to proto-col) - (insert (symbol-name (cdr entry)) "\n")) - eudc-server-hotlist) - (eudc-hotlist-mode))) + (dolist (entry eudc-server-hotlist) + (insert (car entry)) + (indent-to proto-col) + (insert (symbol-name (cdr entry)) "\n")) + (eudc-hotlist-mode))) (defun eudc-hotlist-add-server () "Add a new server to the list after current one." (interactive) - (if (not (eq major-mode 'eudc-hotlist-mode)) + (if (not (derived-mode-p 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((server (read-from-minibuffer "Server: ")) (protocol (completing-read "Protocol: " @@ -117,7 +108,7 @@ These are the special commands of this mode: (defun eudc-hotlist-delete-server () "Delete the server at point from the list." (interactive) - (if (not (eq major-mode 'eudc-hotlist-mode)) + (if (not (derived-mode-p 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((buffer-read-only nil)) (save-excursion @@ -130,7 +121,7 @@ These are the special commands of this mode: (defun eudc-hotlist-quit-edit () "Quit the hotlist editing mode and save changes to the hotlist." (interactive) - (if (not (eq major-mode 'eudc-hotlist-mode)) + (if (not (derived-mode-p 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let (hotlist) (goto-char eudc-hotlist-list-beginning) @@ -149,7 +140,7 @@ These are the special commands of this mode: (defun eudc-hotlist-select-server () "Select the server at point as the current server." (interactive) - (if (not (eq major-mode 'eudc-hotlist-mode)) + (if (not (derived-mode-p 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (save-excursion (beginning-of-line) @@ -163,7 +154,7 @@ These are the special commands of this mode: (defun eudc-hotlist-transpose-servers () "Swap the order of the server with the previous one in the list." (interactive) - (if (not (eq major-mode 'eudc-hotlist-mode)) + (if (not (derived-mode-p 'eudc-hotlist-mode)) (error "Not in a EUDC hotlist edit buffer")) (let ((buffer-read-only nil)) (save-excursion diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index c474ac9380d..453c19b27f9 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -652,7 +652,7 @@ Each copy is added a new field containing one of the values of FIELD." result)) -(defun eudc-mode () +(define-derived-mode eudc-mode special-mode "EUDC" "Major mode used in buffers displaying the results of directory queries. There is no sense in calling this command from a buffer other than one containing the results of a directory query. @@ -663,15 +663,9 @@ These are the special commands of EUDC mode: n -- Move to next record. p -- Move to previous record. b -- Insert record at point into the BBDB database." - (interactive) - (kill-all-local-variables) - (setq major-mode 'eudc-mode) - (setq mode-name "EUDC") - (use-local-map eudc-mode-map) (if (not (featurep 'xemacs)) (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu)) - (setq mode-popup-menu (eudc-menu))) - (run-mode-hooks 'eudc-mode-hook)) + (setq mode-popup-menu (eudc-menu)))) ;;}}} @@ -1084,7 +1078,7 @@ queries the server for the existing fields and displays a corresponding form." (defun eudc-move-to-next-record () "Move to next record, in a buffer displaying directory query results." (interactive) - (if (not (eq major-mode 'eudc-mode)) + (if (not (derived-mode-p 'eudc-mode)) (error "Not in a EUDC buffer") (let ((pt (next-overlay-change (point)))) (if (< pt (point-max)) @@ -1094,7 +1088,7 @@ queries the server for the existing fields and displays a corresponding form." (defun eudc-move-to-previous-record () "Move to previous record, in a buffer displaying directory query results." (interactive) - (if (not (eq major-mode 'eudc-mode)) + (if (not (derived-mode-p 'eudc-mode)) (error "Not in a EUDC buffer") (let ((pt (previous-overlay-change (point)))) (if (> pt (point-min)) @@ -1122,7 +1116,7 @@ queries the server for the existing fields and displays a corresponding form." (overlay-get (car (overlays-at (point))) 'eudc-record)) :help "Insert record at point into the BBDB database"] ["Insert All Records into BBDB" eudc-batch-export-records-to-bbdb - (and (eq major-mode 'eudc-mode) + (and (derived-mode-p 'eudc-mode) (or (featurep 'bbdb) (prog1 (locate-library "bbdb") (message "")))) :help "Insert all the records returned by a directory query into BBDB"] diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index e6a5f8299ac..f2d404afa58 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -757,31 +757,24 @@ VALUES may contain values for editable fields from current article." map) "'mairix-searches-mode' keymap.") -(defvar mairix-searches-mode-font-lock-keywords) +(defvar mairix-searches-mode-font-lock-keywords + '(("^\\([0-9]+\\)" + (1 font-lock-constant-face)) + ("^[0-9 ]+\\(Name:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-string-face)) + ("^[ ]+\\(Query:\\) \\(.*\\) , " + (1 font-lock-keyword-face) (2 font-lock-string-face)) + (", \\(Threads:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-constant-face)) + ("^\\([A-Z].*\\)$" + (1 font-lock-comment-face)) + ("^[ ]+\\(Folder:\\) \\(.*\\)" + (1 font-lock-keyword-face) (2 font-lock-string-face)))) -(defun mairix-searches-mode () +(define-derived-mode mairix-searches-mode fundamental-mode "mairix-searches" "Major mode for editing mairix searches." - (interactive) - (kill-all-local-variables) - (setq major-mode 'mairix-searches-mode) - (setq mode-name "mairix-searches") - (set-syntax-table text-mode-syntax-table) - (use-local-map mairix-searches-mode-map) - (make-local-variable 'font-lock-defaults) - (setq mairix-searches-mode-font-lock-keywords - (list (list "^\\([0-9]+\\)" - '(1 font-lock-constant-face)) - (list "^[0-9 ]+\\(Name:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-string-face)) - (list "^[ ]+\\(Query:\\) \\(.*\\) , " - '(1 font-lock-keyword-face) '(2 font-lock-string-face)) - (list ", \\(Threads:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-constant-face)) - (list "^\\([A-Z].*\\)$" - '(1 font-lock-comment-face)) - (list "^[ ]+\\(Folder:\\) \\(.*\\)" - '(1 font-lock-keyword-face) '(2 font-lock-string-face)))) - (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) + :syntax-table text-mode-syntax-table + (setq-local font-lock-defaults '(mairix-searches-mode-font-lock-keywords))) (defun mairix-build-search-list () "Display saved searches in current buffer." diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index d6c8f6f557d..411d4dfdb43 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1909,13 +1909,9 @@ Return t if groups have changed, nil otherwise." map) "Mode map for newsticker treeview.") -(defun newsticker-treeview-mode () +(define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV" "Major mode for Newsticker Treeview. \\{newsticker-treeview-mode-map}" - (kill-all-local-variables) - (use-local-map newsticker-treeview-mode-map) - (setq major-mode 'newsticker-treeview-mode) - (setq mode-name "Newsticker TV") (if (boundp 'tool-bar-map) (set (make-local-variable 'tool-bar-map) newsticker-treeview-tool-bar-map)) diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 1e05d8db336..08ae9574a33 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -429,18 +429,12 @@ current buffer, this default action can be modified via (put 'quickurl-list-mode 'mode-class 'special) ;;;###autoload -(defun quickurl-list-mode () +(define-derived-mode quickurl-list-mode fundamental-mode "quickurl list" "A mode for browsing the quickurl URL list. The key bindings for `quickurl-list-mode' are: \\{quickurl-list-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map quickurl-list-mode-map) - (setq major-mode 'quickurl-list-mode - mode-name "quickurl list") - (run-mode-hooks 'quickurl-list-mode-hook) (setq buffer-read-only t truncate-lines t)) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a5f59227ef7..595037ab943 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -137,7 +137,7 @@ (insert-directory . tramp-adb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) - ;; `make-auto-save-file-name' performed by default handler. + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) (make-symbolic-link . ignore) @@ -407,9 +407,9 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." (split-string (apply 'concat (mapcar (lambda (s) - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string "\\(.\\)" " -\\1" - (replace-regexp-in-string "^-" "" s))) + (tramp-compat-replace-regexp-in-string "^-" "" s))) ;; FIXME: Warning about removed switches (long and non-dash). (delq nil (mapcar @@ -1153,11 +1153,11 @@ connection if a previous connection has died for some reason." (read (current-buffer)))))) (when (and (stringp old-getprop) (not (string-equal old-getprop new-getprop))) - (tramp-cleanup vec) (tramp-message vec 3 "Connection reset, because remote host changed from `%s' to `%s'" old-getprop new-getprop) + (tramp-cleanup-connection vec t) (tramp-adb-maybe-open-connection vec))) ;; Change user if indicated. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b89c5124721..b4e5e4ffd0f 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -289,7 +289,12 @@ KEY identifies the connection, it is either a process or a vector." (when (vectorp key) (dotimes (i (length key)) (when (stringp (aref key i)) - (aset key i (substring-no-properties (aref key i)))))) + (aset key i + (funcall + ;; `substring-no-properties' does not exist in XEmacs. + (if (functionp 'substring-no-properties) + 'substring-no-properties 'identity) + (aref key i)))))) (let ((tmp (format "(%s %s)" (if (processp key) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 937db34a346..5015929534d 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -55,9 +55,11 @@ (buffer-list)))) ;;;###tramp-autoload -(defun tramp-cleanup-connection (vec) +(defun tramp-cleanup-connection (vec &optional keep-debug keep-password) "Flush all connection related objects. -This includes password cache, file cache, connection cache, buffers. +This includes password cache, file cache, connection cache, +buffers. KEEP-DEBUG non-nil preserves the debug buffer. +KEEP-PASSWORD non-nil preserves the password cache. When called interactively, a Tramp connection has to be selected." (interactive ;; When interactive, select the Tramp remote identification. @@ -80,14 +82,15 @@ When called interactively, a Tramp connection has to be selected." "Enter Tramp connection: " connections nil t (try-completion "" connections))) (when (and name (file-remote-p name)) - (with-parsed-tramp-file-name name nil v)))))) + (with-parsed-tramp-file-name name nil v)))) + nil nil)) (if (not vec) ;; Nothing to do. (message "No Tramp connection found.") ;; Flush password cache. - (tramp-clear-passwd vec) + (unless keep-password (tramp-clear-passwd vec)) ;; Flush file cache. (tramp-flush-directory-property vec "") @@ -101,7 +104,8 @@ When called interactively, a Tramp connection has to be selected." ;; Remove buffers. (dolist (buf (list (get-buffer (tramp-buffer-name vec)) - (get-buffer (tramp-debug-buffer-name vec)) + (unless keep-debug + (get-buffer (tramp-debug-buffer-name vec))) (tramp-get-connection-property vec "process-buffer" nil))) (when (bufferp buf) (kill-buffer buf))))) @@ -190,7 +194,9 @@ This includes password cache, file cache, connection cache, buffers." 'tramp-load-report-modules ; pre-hook 'tramp-append-tramp-buffers ; post-hook - (propertize "\n" 'display "\ + (funcall + (if (functionp 'propertize) 'propertize 'progn) + "\n" 'display "\ Enter your bug report in this message, including as much detail as you possibly can about the problem, what you did to cause it and what the local and remote machines are. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 8f9d9d8fee5..ca70c1384cb 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -313,13 +313,21 @@ Not actually used. Use `(format \"%o\" i)' instead?" "Like `copy-file' for Tramp files (compat function)." (cond (preserve-extended-attributes - (tramp-compat-funcall - 'copy-file filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes)) + (condition-case nil + (tramp-compat-funcall + 'copy-file filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + (wrong-number-of-arguments + (tramp-compat-copy-file + filename newname ok-if-already-exists keep-date preserve-uid-gid)))) (preserve-uid-gid - (tramp-compat-funcall - 'copy-file filename newname ok-if-already-exists keep-date - preserve-uid-gid)) + (condition-case nil + (tramp-compat-funcall + 'copy-file filename newname ok-if-already-exists keep-date + preserve-uid-gid) + (wrong-number-of-arguments + (tramp-compat-copy-file + filename newname ok-if-already-exists keep-date)))) (t (copy-file filename newname ok-if-already-exists keep-date)))) @@ -518,6 +526,58 @@ EOL-TYPE can be one of `dos', `unix', or `mac'." "`dos', `unix', or `mac'"))))) (t (error "Can't change EOL conversion -- is MULE missing?")))) +;; `replace-regexp-in-string' does not exist in XEmacs. +;; Implementation is taken from Emacs 24. +(if (fboundp 'replace-regexp-in-string) + (defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string) + (defun tramp-compat-replace-regexp-in-string + (regexp rep string &optional fixedcase literal subexp start) + "Replace all matches for REGEXP with REP in STRING. + +Return a new string containing the replacements. + +Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the +arguments with the same names of function `replace-match'. If START +is non-nil, start replacements at that index in STRING. + +REP is either a string used as the NEWTEXT arg of `replace-match' or a +function. If it is a function, it is called with the actual text of each +match, and its value is used as the replacement text. When REP is called, +the match data are the result of matching REGEXP against a substring +of STRING. + +To replace only the first match (if any), make REGEXP match up to \\' +and replace a sub-expression, e.g. + (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) + => \" bar foo\"" + + (let ((l (length string)) + (start (or start 0)) + matches str mb me) + (save-match-data + (while (and (< start l) (string-match regexp string start)) + (setq mb (match-beginning 0) + me (match-end 0)) + ;; If we matched the empty string, make sure we advance by one char + (when (= me mb) (setq me (min l (1+ mb)))) + ;; Generate a replacement for the matched substring. + ;; Operate only on the substring to minimize string consing. + ;; Set up match data for the substring for replacement; + ;; presumably this is likely to be faster than munging the + ;; match data directly in Lisp. + (string-match regexp (setq str (substring string mb me))) + (setq matches + (cons (replace-match (if (stringp rep) + rep + (funcall rep (match-string 0 str))) + fixedcase literal str subexp) + (cons (substring string start mb) ; unmatched prefix + matches))) + (setq start me)) + ;; Reconstruct a string from the pieces. + (setq matches (cons (substring string start l) matches)) ; leftover + (apply #'concat (nreverse matches)))))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-compat 'force))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a1ead96eaea..e764e4767dd 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -453,7 +453,7 @@ Every entry is a list (NAME ADDRESS).") (insert-directory . tramp-gvfs-handle-insert-directory) (insert-file-contents . tramp-gvfs-handle-insert-file-contents) (load . tramp-handle-load) - ;; `make-auto-save-file-name' performed by default handler. + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) (make-symbolic-link . ignore) @@ -594,15 +594,19 @@ is no information where to trace the message.") (and (tramp-tramp-file-p newname) (not (tramp-gvfs-file-name-p newname)))) - ;; We cannot copy directly. + ;; We cannot call `copy-file' directly. Use + ;; `tramp-compat-funcall' for backward compatibility (number + ;; of arguments). (let ((tmpfile (tramp-compat-make-temp-file filename))) (cond (preserve-extended-attributes - (copy-file + (tramp-compat-funcall + 'copy-file filename tmpfile t keep-date preserve-uid-gid preserve-extended-attributes)) (preserve-uid-gid - (copy-file filename tmpfile t keep-date preserve-uid-gid)) + (tramp-compat-funcall + 'copy-file filename tmpfile t keep-date preserve-uid-gid)) (t (copy-file filename tmpfile t keep-date))) (rename-file tmpfile newname ok-if-already-exists)) @@ -950,7 +954,7 @@ is no information where to trace the message.") (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (replace-regexp-in-string + string (tramp-compat-replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (while (string-match @@ -960,7 +964,7 @@ is no information where to trace the message.") "Event = \\([^[:blank:]]+\\)[\n\r]+") string) (let ((action (intern-soft - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string "_" "-" (downcase (match-string 2 string))))) (file (match-string 1 string))) (setq string (replace-match "" nil nil string)) @@ -1158,7 +1162,8 @@ is no information where to trace the message.") (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) + (tramp-compat-replace-regexp-in-string + "^.*/\\([^/]+\\)$" "\\1" object-path))) (defun tramp-bluez-address (device) "Return bluetooth device address from a given bluetooth DEVICE name." @@ -1709,11 +1714,13 @@ They are retrieved from the hal daemon." (when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t :system tramp-hal-service device tramp-hal-interface-device "PropertyExists" "sync.plugin") - (pushnew - (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t - :system tramp-hal-service device tramp-hal-interface-device - "GetPropertyString" "pda.pocketpc.name") - tramp-synce-devices :test #'equal))) + (let ((prop + (with-tramp-dbus-call-method + tramp-gvfs-dbus-event-vector t + :system tramp-hal-service device tramp-hal-interface-device + "GetPropertyString" "pda.pocketpc.name"))) + (unless (member prop tramp-synce-devices) + (push prop tramp-synce-devices))))) (tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices) tramp-synce-devices)) diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index 53dbdbc45d4..e2c7461228f 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -238,7 +238,7 @@ authentication is requested from proxy server, provide it." tramp-gw-vector 6 "\n%s" (format "%s%s\r\n" command - (replace-regexp-in-string ;; no password in trace! + (tramp-compat-replace-regexp-in-string ;; no password in trace! "Basic [^\r\n]+" "Basic xxxxx" authentication t))) (with-current-buffer buffer ;; Trap errors to be traced in the right trace buffer. Often, diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8ca94122af1..f91cbb29a1d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -850,7 +850,7 @@ of command line.") (insert-file-contents-literally . tramp-sh-handle-insert-file-contents-literally) (load . tramp-handle-load) - (make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) (process-file . tramp-sh-handle-process-file) @@ -2978,48 +2978,6 @@ the result will be a local, non-Tramp, filename." (fset 'find-buffer-file-type find-buffer-file-type-function) (fmakunbound 'find-buffer-file-type))))) -(defun tramp-sh-handle-make-auto-save-file-name () - "Like `make-auto-save-file-name' for Tramp files. -Returns a file name in `tramp-auto-save-directory' for autosaving this file." - (let ((tramp-auto-save-directory tramp-auto-save-directory) - (buffer-file-name - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - (buffer-file-name)))) - ;; File name must be unique. This is ensured with Emacs 22 (see - ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for - ;; all other cases we must do it ourselves. - (when (boundp 'auto-save-file-name-transforms) - (mapc - (lambda (x) - (when (and (string-match (car x) buffer-file-name) - (not (car (cddr x)))) - (setq tramp-auto-save-directory - (or tramp-auto-save-directory - (tramp-compat-temporary-file-directory))))) - (symbol-value 'auto-save-file-name-transforms))) - ;; Create directory. - (when tramp-auto-save-directory - (setq buffer-file-name - (expand-file-name buffer-file-name tramp-auto-save-directory)) - (unless (file-exists-p tramp-auto-save-directory) - (make-directory tramp-auto-save-directory t))) - ;; Run plain `make-auto-save-file-name'. There might be an advice when - ;; it is not a magic file name operation (since Emacs 22). - ;; We must deactivate it temporarily. - (if (not (ad-is-active 'make-auto-save-file-name)) - (tramp-run-real-handler 'make-auto-save-file-name nil) - ;; else - (ad-deactivate 'make-auto-save-file-name) - (prog1 - (tramp-run-real-handler 'make-auto-save-file-name nil) - (ad-activate 'make-auto-save-file-name))))) - ;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname confirm) @@ -3425,7 +3383,7 @@ Fall back to normal file name handler if no Tramp handler exists." (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (replace-regexp-in-string + string (tramp-compat-replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (while (string-match @@ -3439,7 +3397,7 @@ Fall back to normal file name handler if no Tramp handler exists." (list proc (intern-soft - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string "_" "-" (downcase (match-string 4 string)))) ;; File names are returned as absolute paths. We must ;; add the remote prefix. @@ -3475,7 +3433,8 @@ Fall back to normal file name handler if no Tramp handler exists." proc (mapcar (lambda (x) - (intern-soft (replace-regexp-in-string "_" "-" (downcase x)))) + (intern-soft + (tramp-compat-replace-regexp-in-string "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit-nulls)) (match-string 3 line)))) ;; Usually, we would add an Emacs event now. Unfortunately, @@ -3846,11 +3805,12 @@ process to set up. VEC specifies the connection." vec "uname" (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) - (tramp-cleanup vec) (tramp-message vec 3 "Connection reset, because remote host changed from `%s' to `%s'" old-uname new-uname) + ;; We want to keep the password. + (tramp-cleanup-connection vec t t) (throw 'uname-changed (tramp-maybe-open-connection vec)))) ;; Check whether the remote host suffers from buggy @@ -4252,7 +4212,7 @@ Gateway hops are already opened." ?h (or (tramp-file-name-host (car target-alist)) "")))) (with-parsed-tramp-file-name proxy l ;; Add the hop. - (pushnew l target-alist :test #'equal) + (push l target-alist) ;; Start next search. (setq choices tramp-default-proxies-alist))))) @@ -4270,11 +4230,11 @@ Gateway hops are already opened." vec 'file-error "Connection `%s' is not supported for gateway access." hop)) ;; Open the gateway connection. - (pushnew + (push (vector (tramp-file-name-method hop) (tramp-file-name-user hop) (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil) - target-alist :test #'equal) + target-alist) ;; For the password prompt, we need the correct values. ;; Therefore, we must remember the gateway vector. But we ;; cannot do it as connection property, because it shouldn't @@ -4328,68 +4288,68 @@ Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." (tramp-check-proper-host vec) - (catch 'uname-changed - (let ((p (tramp-get-connection-process vec)) - (process-name (tramp-get-connection-property vec "process-name" nil)) - (process-environment (copy-sequence process-environment)) - (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) + (let ((p (tramp-get-connection-process vec)) + (process-name (tramp-get-connection-property vec "process-name" nil)) + (process-environment (copy-sequence process-environment)) + (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) - ;; If Tramp opens the same connection within a short time frame, - ;; there is a problem. We shall signal this. - (unless (or (and p (processp p) (memq (process-status p) '(run open))) - (not (equal (butlast (append vec nil) 2) - (car tramp-current-connection))) - (> (tramp-time-diff - (current-time) (cdr tramp-current-connection)) - (or tramp-connection-min-time-diff 0))) - (throw 'suppress 'suppress)) + ;; If Tramp opens the same connection within a short time frame, + ;; there is a problem. We shall signal this. + (unless (or (and p (processp p) (memq (process-status p) '(run open))) + (not (equal (butlast (append vec nil) 2) + (car tramp-current-connection))) + (> (tramp-time-diff + (current-time) (cdr tramp-current-connection)) + (or tramp-connection-min-time-diff 0))) + (throw 'suppress 'suppress)) - ;; If too much time has passed since last command was sent, look - ;; whether process is still alive. If it isn't, kill it. When - ;; using ssh, it can sometimes happen that the remote end has - ;; hung up but the local ssh client doesn't recognize this until - ;; it tries to send some data to the remote end. So that's why - ;; we try to send a command from time to time, then look again - ;; whether the process is really alive. - (condition-case nil - (when (and (> (tramp-time-diff - (current-time) - (tramp-get-connection-property - p "last-cmd-time" '(0 0 0))) - 60) - p (processp p) (memq (process-status p) '(run open))) - (tramp-send-command vec "echo are you awake" t t) - (unless (and (memq (process-status p) '(run open)) - (tramp-wait-for-output p 10)) - ;; The error will be caught locally. - (tramp-error vec 'file-error "Awake did fail"))) - (file-error - (tramp-cleanup vec) - (setq p nil))) + ;; If too much time has passed since last command was sent, look + ;; whether process is still alive. If it isn't, kill it. When + ;; using ssh, it can sometimes happen that the remote end has hung + ;; up but the local ssh client doesn't recognize this until it + ;; tries to send some data to the remote end. So that's why we + ;; try to send a command from time to time, then look again + ;; whether the process is really alive. + (condition-case nil + (when (and (> (tramp-time-diff + (current-time) + (tramp-get-connection-property + p "last-cmd-time" '(0 0 0))) + 60) + p (processp p) (memq (process-status p) '(run open))) + (tramp-send-command vec "echo are you awake" t t) + (unless (and (memq (process-status p) '(run open)) + (tramp-wait-for-output p 10)) + ;; The error will be caught locally. + (tramp-error vec 'file-error "Awake did fail"))) + (file-error + (tramp-cleanup-connection vec t) + (setq p nil))) - ;; New connection must be opened. - (condition-case err - (unless (and p (processp p) (memq (process-status p) '(run open))) + ;; New connection must be opened. + (condition-case err + (unless (and p (processp p) (memq (process-status p) '(run open))) - ;; We call `tramp-get-buffer' in order to get a debug - ;; buffer for messages from the beginning. - (tramp-get-buffer vec) + ;; We call `tramp-get-buffer' in order to get a debug buffer + ;; for messages from the beginning. + (tramp-get-buffer vec) - ;; If `non-essential' is non-nil, don't reopen a new connection. - (when (and (boundp 'non-essential) (symbol-value 'non-essential)) - (throw 'non-essential 'non-essential)) + ;; If `non-essential' is non-nil, don't reopen a new connection. + (when (and (boundp 'non-essential) (symbol-value 'non-essential)) + (throw 'non-essential 'non-essential)) - (with-tramp-progress-reporter - vec 3 - (if (zerop (length (tramp-file-name-user vec))) - (format "Opening connection for %s using %s" - (tramp-file-name-host vec) - (tramp-file-name-method vec)) - (format "Opening connection for %s@%s using %s" - (tramp-file-name-user vec) + (with-tramp-progress-reporter + vec 3 + (if (zerop (length (tramp-file-name-user vec))) + (format "Opening connection for %s using %s" (tramp-file-name-host vec) - (tramp-file-name-method vec))) + (tramp-file-name-method vec)) + (format "Opening connection for %s@%s using %s" + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + (catch 'uname-changed ;; Start new process. (when (and p (processp p)) (delete-process p)) @@ -4544,13 +4504,13 @@ connection if a previous connection has died for some reason." target-alist (cdr target-alist))) ;; Make initial shell settings. - (tramp-open-connection-setup-interactive-shell p vec)))) + (tramp-open-connection-setup-interactive-shell p vec))))) - ;; When the user did interrupt, we must cleanup. - (quit - (tramp-cleanup vec) - ;; Propagate the quit signal. - (signal (car err) (cdr err))))))) + ;; When the user did interrupt, we must cleanup. + (quit + (tramp-cleanup-connection vec t) + ;; Propagate the quit signal. + (signal (car err) (cdr err)))))) (defun tramp-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f05a54f46f7..27f3bd41e9c 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -229,7 +229,7 @@ See `tramp-actions-before-shell' for more info.") (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) - ;; `make-auto-save-file-name' performed by default handler. + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) @@ -403,7 +403,7 @@ pass to the OPERATION." (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) (localname (file-name-as-directory - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v)))) (tmpdir (make-temp-name (expand-file-name @@ -537,7 +537,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (unless (tramp-smb-send-command v (format "put \"%s\" \"%s\"" filename (tramp-smb-get-localname v))) - (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) + (tramp-error + v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))) ;; KEEP-DATE handling. (when keep-date @@ -1151,7 +1152,8 @@ target of the symlink differ." (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Renaming %s to %s" filename newname) - (if (and (tramp-equal-remote filename newname) + (if (and (not (file-exists-p newname)) + (tramp-equal-remote filename newname) (string-equal (tramp-smb-get-share (tramp-dissect-file-name filename)) (tramp-smb-get-share (tramp-dissect-file-name newname)))) @@ -1364,14 +1366,14 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (while (not (eobp)) (setq entry (tramp-smb-read-file-entry share)) (forward-line) - (when entry (pushnew entry res :test #'equal)))) + (when entry (push entry res)))) ;; Cache share entries. (unless share (tramp-set-connection-property v "share-cache" res))) ;; Add directory itself. - (pushnew '("" "drwxrwxrwx" 0 (0 0)) res :test #'equal) + (push '("" "drwxrwxrwx" 0 (0 0)) res) ;; There's a very strange error (debugged with XEmacs 21.4.14) ;; If there's no short delay, it returns nil. No idea about. @@ -1719,11 +1721,15 @@ If ARGUMENT is non-nil, use it as argument for (error (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (if (search-forward-regexp - tramp-smb-wrong-passwd-regexp nil t) + (if (and (boundp 'auth-sources) + (symbol-value 'auth-sources) + (search-forward-regexp + tramp-smb-wrong-passwd-regexp nil t)) ;; Disable `auth-source' and `password-cache'. + (tramp-message + vec 3 "Retry connection with new password") (let (auth-sources) - (tramp-cleanup vec) + (tramp-cleanup-connection vec t) (tramp-smb-maybe-open-connection vec argument)) ;; Propagate the error. (signal (car err) (cdr err))))))))))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 727536b2e10..fe4f7b8bb54 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1222,10 +1222,11 @@ their replacement." ;; This works with the current set of `tramp-obsolete-methods'. ;; Must be improved, if their are more sophisticated replacements. (setq result (substring result 0 -1))) - ;; We must mark, whether a default value has been used. - (if (or method (null result)) + ;; We must mark, whether a default value has been used. Not + ;; applicable for XEmacs. + (if (or method (null result) (null (functionp 'propertize))) result - (propertize result 'tramp-default t)))) + (tramp-compat-funcall 'propertize result 'tramp-default t)))) (defun tramp-find-user (method user host) "Return the right user string to use. @@ -1243,10 +1244,11 @@ This is USER, if non-nil. Otherwise, do a lookup in (setq choices nil))) luser) tramp-default-user))) - ;; We must mark, whether a default value has been used. - (if (or user (null result)) + ;; We must mark, whether a default value has been used. Not + ;; applicable for XEmacs. + (if (or user (null result) (null (functionp 'propertize))) result - (propertize result 'tramp-default t)))) + (tramp-compat-funcall 'propertize result 'tramp-default t)))) (defun tramp-find-host (method user host) "Return the right host string to use. @@ -1641,7 +1643,7 @@ without a visible progress reporter." (declare (indent 3) (debug t)) `(progn (tramp-message ,vec ,level "%s..." ,message) - (let ((result "failed") + (let ((cookie "failed") (tm ;; We start a pulsing progress reporter after 3 seconds. Feature ;; introduced in Emacs 24.1. @@ -1656,10 +1658,10 @@ without a visible progress reporter." #'tramp-progress-reporter-update pr))))))) (unwind-protect ;; Execute the body. - (prog1 (progn ,@body) (setq result "done")) + (prog1 (progn ,@body) (setq cookie "done")) ;; Stop progress reporter. (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...%s" ,message result))))) + (tramp-message ,vec ,level "%s...%s" ,message cookie))))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\")) @@ -1710,19 +1712,6 @@ letter into the file name. This function removes it." (replace-match "/" nil t name) name))) -(defun tramp-cleanup (vec) - "Cleanup connection VEC, but keep the debug buffer." - (with-current-buffer (tramp-get-debug-buffer vec) - ;; Keep the debug buffer. - (rename-buffer - (generate-new-buffer-name tramp-temp-buffer-name) 'unique) - (tramp-cleanup-connection vec) - (if (= (point-min) (point-max)) - (kill-buffer nil) - (rename-buffer (tramp-debug-buffer-name vec) 'unique)) - ;; We call `tramp-get-buffer' in order to keep the debug buffer. - (tramp-get-buffer vec))) - ;;; Config Manipulation Functions: ;;;###tramp-autoload @@ -2145,7 +2134,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (tramp-message v 1 "Suppress received in operation %s" (append (list operation) args)) - (tramp-cleanup v) + (tramp-cleanup-connection v t) (tramp-run-real-handler operation args))) (t result))) @@ -3920,6 +3909,48 @@ Return the local name of the temporary file." ;;; Auto saving to a special directory: +(defun tramp-handle-make-auto-save-file-name () + "Like `make-auto-save-file-name' for Tramp files. +Returns a file name in `tramp-auto-save-directory' for autosaving this file." + (let ((tramp-auto-save-directory tramp-auto-save-directory) + (buffer-file-name + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (buffer-file-name)))) + ;; File name must be unique. This is ensured with Emacs 22 (see + ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for + ;; all other cases we must do it ourselves. + (when (boundp 'auto-save-file-name-transforms) + (mapc + (lambda (x) + (when (and (string-match (car x) buffer-file-name) + (not (car (cddr x)))) + (setq tramp-auto-save-directory + (or tramp-auto-save-directory + (tramp-compat-temporary-file-directory))))) + (symbol-value 'auto-save-file-name-transforms))) + ;; Create directory. + (when tramp-auto-save-directory + (setq buffer-file-name + (expand-file-name buffer-file-name tramp-auto-save-directory)) + (unless (file-exists-p tramp-auto-save-directory) + (make-directory tramp-auto-save-directory t))) + ;; Run plain `make-auto-save-file-name'. There might be an advice when + ;; it is not a magic file name operation (since Emacs 22). + ;; We must deactivate it temporarily. + (if (not (ad-is-active 'make-auto-save-file-name)) + (tramp-run-real-handler 'make-auto-save-file-name nil) + ;; else + (ad-deactivate 'make-auto-save-file-name) + (prog1 + (tramp-run-real-handler 'make-auto-save-file-name nil) + (ad-activate 'make-auto-save-file-name))))) + (unless (tramp-exists-file-name-handler 'make-auto-save-file-name) (defadvice make-auto-save-file-name (around tramp-advice-make-auto-save-file-name () activate) diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index f25003e5652..16941167fb6 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -88,7 +88,7 @@ The Custom feature is intended to make this obsolete." ;; Edit Options mode is suitable only for specially formatted data. (put 'Edit-options-mode 'mode-class 'special) -(defun Edit-options-mode () +(define-derived-mode Edit-options-mode emacs-lisp-mode "Options" "\\\ Major mode for editing Emacs user option settings. Special commands are: @@ -100,17 +100,9 @@ Changed values made by these commands take effect immediately. Each variable description is a paragraph. For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs." - (kill-all-local-variables) - (set-syntax-table emacs-lisp-mode-syntax-table) - (use-local-map Edit-options-mode-map) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate "[^\^@-\^?]") - (make-local-variable 'paragraph-start) - (setq paragraph-start "\t") - (setq truncate-lines t) - (setq major-mode 'Edit-options-mode) - (setq mode-name "Options") - (run-mode-hooks 'Edit-options-mode-hook)) + (setq-local paragraph-separate "[^\^@-\^?]") + (setq-local paragraph-start "\t") + (setq-local truncate-lines t)) (defun Edit-options-set () (interactive) (Edit-options-modify diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 2e3f500766f..4bd0c4ddcf4 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -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/blackbox.el b/lisp/play/blackbox.el index d38f799756b..ce2c928db0d 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -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 665e98a69b2..ca7a4013796 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1108,25 +1108,24 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." 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-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))))) (defun bubbles--neighbourhood-available () "Return t if another valid neighborhood is available." diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index cf86d7a9de5..8ee633e3917 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -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. diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index e4e627a5293..f4c26bfc6c4 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -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/snake.el b/lisp/play/snake.el index 85acfb116d2..4c110914298 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -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/spook.el b/lisp/play/spook.el index 08c31d3878b..d2ecd3a62cc 100644 --- a/lisp/play/spook.el +++ b/lisp/play/spook.el @@ -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/profiler.el b/lisp/profiler.el index 609a0308cf0..93ab10015ea 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -256,10 +256,9 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." (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)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 1e8d6cba8c4..e977a415d62 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1594,10 +1594,6 @@ 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) - (c-define-abbrev-table 'awk-mode-abbrev-table '(("else" "else" c-electric-continued-statement 0) ("while" "while" c-electric-continued-statement 0)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 770e78bb3b1..8a7d1e77bd2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -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. @@ -6535,7 +6535,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (eval '(mode-compile)))) ; Avoid a warning (declare-function Info-find-node "info" - (filename nodename &optional no-going-back)) + (filename nodename &optional no-going-back strict-case)) (defun cperl-info-buffer (type) ;; Returns buffer with documentation. Creates if missing. diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index a305393c7d8..7b08df8b85f 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -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/octave.el b/lisp/progmodes/octave.el index de1c26a7fa7..f20a57940be 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1581,6 +1581,9 @@ code line." :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 diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index be151bf8114..5f919bf495f 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -225,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." @@ -2140,7 +2140,7 @@ 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 whitelines so tracebacks are correct. + 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)) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 0f868255589..902616e3023 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1377,6 +1377,7 @@ If the result is do-end block, it will always be multiline." ;; Unusual code layout confuses the byte-compiler. (declare-function ruby-syntax-propertize-expansion "ruby-mode" ()) (declare-function ruby-syntax-expansion-allowed-p "ruby-mode" (parse-state)) +(declare-function ruby-syntax-propertize-function "ruby-mode" (start end)) (if (eval-when-compile (fboundp #'syntax-propertize-rules)) ;; New code that works independently from font-lock. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 292bc2369a6..3ea2afb6fc3 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2170,11 +2170,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) diff --git a/lisp/reveal.el b/lisp/reveal.el index 92c1178041c..6740f7e923f 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -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/savehist.el b/lisp/savehist.el index 374e57feb1f..379818b2707 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -49,7 +49,7 @@ (require 'custom) (eval-when-compile - (require 'cl)) + (if (featurep 'xemacs) (require 'cl))) ;; User variables diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 2ddac6d6c43..e070a7da489 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -255,8 +255,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: diff --git a/lisp/shell.el b/lisp/shell.el index 3ca2564b65c..2047543f288 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,7 +1,6 @@ ;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Simon Marshall @@ -792,7 +791,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 @@ -825,8 +824,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." @@ -908,7 +906,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) @@ -1015,12 +1013,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: diff --git a/lisp/simple.el b/lisp/simple.el index c5e5b313b7b..593f36d1ee1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1231,7 +1231,7 @@ is a string to insert in the minibuffer before reading. 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)) + t 'minibuffer-history)) (defun eval-minibuffer (prompt &optional initial-contents) "Return value of Lisp expression read using the minibuffer. @@ -3180,12 +3180,18 @@ see other processes running on the system, use `list-system-processes'." 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) @@ -3206,30 +3212,12 @@ see other processes running on the system, use `list-system-processes'." (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-temporary-overlay-map universal-argument-map)) (defun universal-argument () "Begin a numeric argument for the following command. @@ -3243,33 +3231,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. @@ -3279,37 +3261,15 @@ 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 diff --git a/lisp/subr.el b/lisp/subr.el index 0a28d4778d4..7df1e86b5bf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3350,16 +3350,22 @@ 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. 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. @@ -3901,12 +3907,27 @@ This function is called directly from the C code." (mapc #'funcall (cdr a-l-element)))) ;; 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))) + ;; 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)) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index b92ca1244fb..b4693a5451a 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -104,7 +104,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) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 96831cea9a6..e5229bd3f0a 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,7 +1,7 @@ ;;; pc-win.el --- setup support for `PC windows' (whatever that is) -;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 Free Software -;; Foundation, Inc. +;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 +;; Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Maintainer: FSF @@ -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) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 9ab592587c9..fc47bf0fc10 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -1481,7 +1481,7 @@ When called interactively, displays the 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) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 5f5416dc2ff..00604088c17 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -320,11 +320,10 @@ 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.") -;; Follows vc-bzr-(async-)command, which uses vc-do-(async-)command -;; from vc-dispatcher. +;; To be called via vc-pull from vc.el, which requires vc-dispatcher. (declare-function vc-exec-after "vc-dispatcher" (code)) -;; Follows vc-exec-after. (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. @@ -354,6 +353,7 @@ 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-run-delayed (vc-compilation-mode 'bzr))) (vc-set-async-update buf)))) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 931193c46e0..11a30991391 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1226,10 +1226,11 @@ is non-nil." table (lambda () (vc-cvs-revision-table (car files)))))) table)) -(defun vc-cvs-ignore (file) +(defun vc-cvs-ignore (file &optional _directory _remove) "Ignore FILE under CVS." (cvs-append-to-ignore (file-name-directory file) file)) +;; FIXME This should be in the vc-cvs- namespace if it is to live here. (defun 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 @@ -1245,7 +1246,9 @@ to hear about anymore." (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))) + ;; 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-dispatcher.el b/lisp/vc/vc-dispatcher.el index 7888752553e..62fb72d0fbc 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -398,6 +398,8 @@ Display the buffer in some window, but don't select it." (set (make-local-variable '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. This action will update the current buffer after the current diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index a4ce3a2c46c..e730db17526 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -706,6 +706,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 @@ -725,6 +728,7 @@ 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-run-delayed (vc-compilation-mode 'git))) (vc-set-async-update buffer))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index afc76c09742..36f27548123 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -234,12 +234,12 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (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-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")) @@ -352,7 +352,7 @@ 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) +(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")) @@ -593,7 +593,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. @@ -674,19 +674,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 39e3fbdc29a..fa5c87d44e3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -965,7 +965,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 diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el index 9f3501a01d7..5d8d7171860 100644 --- a/lisp/w32-common-fns.el +++ b/lisp/w32-common-fns.el @@ -107,9 +107,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/src/ChangeLog b/src/ChangeLog index 7f4c3f731f4..b4d1c2b67df 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,156 @@ +2013-09-12 Xue Fuqiao + + * charset.c (char_charset): Document an exception for char-charset. + +2013-09-12 Dmitry Antipov + + * xterm.h (x_display_info): New field last_user_time... + * xterm.c (toplevel): ...to replace static last_user_time. + (handle_one_xevent, x_ewmh_activate_frame): Adjust users. + +2013-09-12 Dmitry Antipov + + * xterm.c (x_set_scroll_bar_thumb) [USE_LUCID && !HAVE_XAW3D]: Clip + scroll bar values to prevent thumb from disappear and update comment. + +2013-09-11 Glenn Morris + + * emacs.c (usage_message): Possessive apostrophe tweak. + +2013-09-11 Dmitry Antipov + + * nsterm.m (syms_of_nsterm): Use Qns. + * w32fns.c (Fx_open_connection): Remove old '#if 0' code. + * w32term.c (w32_create_terminal, syms_of_w32term): Use Qw32. + * xfns.c (x_display_info_for_name, Fx_open_connection): + Remove old '#if 0' code. + (syms_of_xfns): Use Qx. + * termhooks.h (fullscreen_hook): Remove the leftover. + (struct terminal): Fix typo in comment. + +2013-09-11 Dmitry Antipov + + Cleaning up a few X scroll bar bits. + * termhooks.h (enum scroll_bar_part): Add scroll_bar_nowhere member. + * xterm.h (struct scroll_bar) [USE_TOOLKIT_SCROLL_BARS && USE_LUCID]: + New member last_seen_part, going to replace... + * xterm.c [USE_TOOLKIT_SCROLL_BARS]: ...global last_scroll_bar_part. + (xt_action_hook) [USE_LUCID]: Adjust user. + (xm_scroll_callback, xg_scroll_callback): Do not bloat with + Lucid-specific scroll bar support. + (xaw_jump_callback, xaw_scroll_callback): Prefer enum scroll_par_part + to int and adjust to use last_seen_part member. + (x_set_toolkit_scroll_bar_thumb) [USE_LUCID]: Adjust user. + (x_scroll_bar_create) [USE_TOOLKIT_SCROLL_BARS && USE_LUCID]: + Initialize last_seen_part. + +2013-09-11 Stefan Monnier + + * insdel.c (insert_from_buffer_1): Don't mark buffer as modified when + insert-buffer-substring an empty string. + +2013-09-11 Paul Eggert + + * xdisp.c (Ftool_bar_lines_needed): Declare as 'const' if ifdeffed out, + avoiding a GCC warning. + +2013-09-11 Dmitry Antipov + + Ifdef away frame tool bar code when it is not really used. + * frame.h (struct frame) [HAVE_WINDOW_SYSTEM && !USE_GTK && !HAVE_NS]: + Move tool_bar_window, desired_tool_bar_string, current_tool_bar_string + and minimize_tool_bar_window_p under the above. + (fset_current_tool_bar_string, fset_desired_tool_bar_string) + (fset_tool_bar_window): Likewise. + * dispnew.c (clear_current_matrices, clear_desired_matrices) + (adjust_frame_glyphs_for_window_redisplay, free_glyphs, update_frame) + (change_frame_size_1): + * window.c (window_from_coordinates, Frecenter): Adjust users. + * window.h (WINDOW_TOOL_BAR_P): Define to zero when frame tool bar + code is not really used. + * xdisp.c (build_desired_tool_bar_string, display_tool_bar_line) + (tool_bar_lines_needed, MAX_FRAME_TOOL_BAR_HEIGHT, tool_bar_item_info) + (get_tool_bar_item, handle_tool_bar_click, note_tool_bar_highlight) + [!USE_GTK && !HAVE_NS]: Define as such. + (Ftool_bar_lines_needed, redisplay_tool_bar, show_mouse_face) + (note_mouse_highlight, expose_frame): + * xfns.c (x_set_tool_bar_lines): + * xterm.c (handle_one_xevent): Adjust users. + +2013-09-11 Paul Eggert + + Fix corruption with multiple emacsclient -t instances (Bug#15222). + This bug was introduced by my 2013-08-26 patch, which incorrectly + assumed that the terminfo implementation doesn't use termcap buffers. + * term.c (init_tty) [TERMINFO]: Remove optimization, as + these buffers apparently are used after all. + * termchar.h (TERMCAP_BUFFER_SIZE) [TERMINFO]: Define here too. + (struct tty_display_info): Define members termcap_term_buffer and + termcap_strings_buffer even if TERMINFO. + +2013-09-11 Dmitry Antipov + + Fix last change. + * data.c (Feqlsign, Flss, Fgtr, Fleq, Fgeq): Add convenient + 'usage' docstring entry to pacify make-docfile. + +2013-09-11 Barry O'Reilly + + Change comparison functions =, <, >, <=, >= to take many arguments. + * data.c: Change comparison functions' interface and implementation. + * lisp.h: Make arithcompare available for efficient two arg + comparisons. + * bytecode.c: Use arithcompare. + * fileio.c: Use new interface. + +2013-09-11 Stefan Monnier + + * keyboard.c (read_char): Don't break immediate_echo (bug#15332). + +2013-09-10 Stefan Monnier + + * eval.c (Feval): Document the new use of `lexical'. + +2013-09-09 Dmitry Antipov + + Review and drop old frame resize hack. + * frame.h (struct frame): Remove force_flush_display_p. + * dispnew.c (update_frame): Adjust user and don't call + flush_frame here. The comment has said that there was an issues + with redisplaying fringes, but I don't see any differences with + and without this hack. Hopefully we can continue without it. + * xdisp.c (clear_garbaged_frames): Adjust user and do not clear + current frame matrices twice if resized_p is set. + +2013-09-09 Dmitry Antipov + + Do not populate pure Xism x_sync to other ports. + * frame.h (x_sync): Move under HAVE_X_WINDOWS. + * frame.c (other_visible_frames) [HAVE_X_WINDOWS]: Use as such. + * nsfns.m, w32xfns.c (x_sync): Remove no-op. + * w32term.h (x_sync): Remove prototype. + +2013-09-09 Dmitry Antipov + + Cleanup frame flushing. + * dispextern.h (struct redisplay_interface): + Drop flush_display_optional because flush_display is enough + for X and flushing via RIF is just a no-op for others. + * frame.h (flush_frame): New function. + * dispnew.c (update_frame): + * minibuf.c (read_minibuf): + * xdisp.c (echo_area_display, redisplay_preserve_echo_area): + Use it. + * keyboard.c (detect_input_pending_run_timers): Do not flush + all frames but selected one in redisplay_preserve_echo_area. + * nsterm.m (ns_flush): Remove no-op. + (ns_redisplay_interface): Adjust user. + * w32term.h (x_flush): Remove no-op. + (w32_redisplay_interface): Adjust user. + * xterm.c (x_flush): Simplify because we do not flush all + frames at once any more. Adjust comment. + (x_redisplay_interface): Adjust user. + 2013-09-07 Paul Eggert Port --without-x --enable-gcc-warnings to Fedora 19. diff --git a/src/bytecode.c b/src/bytecode.c index e0e7b22ea13..3ac8b452fbe 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1367,7 +1367,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = Fgtr (TOP, v1); + TOP = arithcompare (TOP, v1, ARITH_GRTR); AFTER_POTENTIAL_GC (); NEXT; } @@ -1377,7 +1377,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = Flss (TOP, v1); + TOP = arithcompare (TOP, v1, ARITH_LESS); AFTER_POTENTIAL_GC (); NEXT; } @@ -1387,7 +1387,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = Fleq (TOP, v1); + TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); AFTER_POTENTIAL_GC (); NEXT; } @@ -1397,7 +1397,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = Fgeq (TOP, v1); + TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); AFTER_POTENTIAL_GC (); NEXT; } diff --git a/src/charset.c b/src/charset.c index eedf65faa6c..d46cb445f85 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2053,6 +2053,8 @@ CH in the charset. */) DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 2, 0, doc: /* Return the charset of highest priority that contains CH. +ASCII characters are an exception: for them, this function always +returns `ascii'. If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets from which to find the charset. It may also be a coding system. In that case, find the charset from what supported by that coding system. */) diff --git a/src/data.c b/src/data.c index 9f4bd1f1c02..51b0266eca1 100644 --- a/src/data.c +++ b/src/data.c @@ -2255,10 +2255,8 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ -enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; - -static Lisp_Object -arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) +Lisp_Object +arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) { double f1 = 0, f2 = 0; bool floatp = 0; @@ -2275,32 +2273,32 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) switch (comparison) { - case equal: + case ARITH_EQUAL: if (floatp ? f1 == f2 : XINT (num1) == XINT (num2)) return Qt; return Qnil; - case notequal: + case ARITH_NOTEQUAL: if (floatp ? f1 != f2 : XINT (num1) != XINT (num2)) return Qt; return Qnil; - case less: + case ARITH_LESS: if (floatp ? f1 < f2 : XINT (num1) < XINT (num2)) return Qt; return Qnil; - case less_or_equal: + case ARITH_LESS_OR_EQUAL: if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2)) return Qt; return Qnil; - case grtr: + case ARITH_GRTR: if (floatp ? f1 > f2 : XINT (num1) > XINT (num2)) return Qt; return Qnil; - case grtr_or_equal: + case ARITH_GRTR_OR_EQUAL: if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2)) return Qt; return Qnil; @@ -2310,48 +2308,65 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) } } -DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, - doc: /* Return t if two args, both numbers or markers, are equal. */) - (register Lisp_Object num1, Lisp_Object num2) +static Lisp_Object +arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args, + enum Arith_Comparison comparison) { - return arithcompare (num1, num2, equal); + for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum) + { + if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison))) + return Qnil; + } + return Qt; } -DEFUN ("<", Flss, Slss, 2, 2, 0, - doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */) - (register Lisp_Object num1, Lisp_Object num2) +DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0, + doc: /* Return t if args, all numbers or markers, are equal. +usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (ptrdiff_t nargs, Lisp_Object *args) { - return arithcompare (num1, num2, less); + return arithcompare_driver (nargs, args, ARITH_EQUAL); } -DEFUN (">", Fgtr, Sgtr, 2, 2, 0, - doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */) - (register Lisp_Object num1, Lisp_Object num2) +DEFUN ("<", Flss, Slss, 1, MANY, 0, + doc: /* Return t if each arg is less than the next arg. All must be numbers or markers. +usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (ptrdiff_t nargs, Lisp_Object *args) { - return arithcompare (num1, num2, grtr); + return arithcompare_driver (nargs, args, ARITH_LESS); } -DEFUN ("<=", Fleq, Sleq, 2, 2, 0, - doc: /* Return t if first arg is less than or equal to second arg. -Both must be numbers or markers. */) - (register Lisp_Object num1, Lisp_Object num2) +DEFUN (">", Fgtr, Sgtr, 1, MANY, 0, + doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers. +usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (ptrdiff_t nargs, Lisp_Object *args) { - return arithcompare (num1, num2, less_or_equal); + return arithcompare_driver (nargs, args, ARITH_GRTR); } -DEFUN (">=", Fgeq, Sgeq, 2, 2, 0, - doc: /* Return t if first arg is greater than or equal to second arg. -Both must be numbers or markers. */) - (register Lisp_Object num1, Lisp_Object num2) +DEFUN ("<=", Fleq, Sleq, 1, MANY, 0, + doc: /* Return t if each arg is less than or equal to the next arg. +All must be numbers or markers. +usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (ptrdiff_t nargs, Lisp_Object *args) { - return arithcompare (num1, num2, grtr_or_equal); + return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL); +} + +DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0, + doc: /* Return t if each arg is greater than or equal to the next arg. +All must be numbers or markers. +usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL); } DEFUN ("/=", Fneq, Sneq, 2, 2, 0, doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) (register Lisp_Object num1, Lisp_Object num2) { - return arithcompare (num1, num2, notequal); + return arithcompare (num1, num2, ARITH_NOTEQUAL); } DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, diff --git a/src/dispextern.h b/src/dispextern.h index f15da1e6564..67de6bffabf 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2796,11 +2796,6 @@ struct redisplay_interface /* Flush the display of frame F. For X, this is XFlush. */ void (*flush_display) (struct frame *f); - /* Flush the display of frame F if non-NULL. This is called - during redisplay, and should be NULL on systems which flush - automatically before reading input. */ - void (*flush_display_optional) (struct frame *f); - /* Clear the mouse highlight in window W, if there is any. */ void (*clear_window_mouse_face) (struct window *w); diff --git a/src/dispnew.c b/src/dispnew.c index 00abf65248c..2b16e881c80 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -783,9 +783,11 @@ clear_current_matrices (register struct frame *f) clear_glyph_matrix (XWINDOW (f->menu_bar_window)->current_matrix); #endif +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* Clear the matrix of the tool-bar window, if any. */ if (WINDOWP (f->tool_bar_window)) clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); +#endif /* Clear current window matrices. */ eassert (WINDOWP (FRAME_ROOT_WINDOW (f))); @@ -806,8 +808,10 @@ clear_desired_matrices (register struct frame *f) clear_glyph_matrix (XWINDOW (f->menu_bar_window)->desired_matrix); #endif +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) if (WINDOWP (f->tool_bar_window)) clear_glyph_matrix (XWINDOW (f->tool_bar_window)->desired_matrix); +#endif /* Do it for window matrices. */ eassert (WINDOWP (FRAME_ROOT_WINDOW (f))); @@ -2041,10 +2045,9 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f) /* Allocate/reallocate window matrices. */ allocate_matrices_for_window_redisplay (XWINDOW (FRAME_ROOT_WINDOW (f))); -#ifdef HAVE_X_WINDOWS +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) /* Allocate/ reallocate matrices of the dummy window used to display the menu bar under X when no X toolkit support is available. */ -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) { /* Allocate a dummy window if not already done. */ struct window *w; @@ -2068,10 +2071,9 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f) w->total_cols = FRAME_TOTAL_COLS (f); allocate_matrices_for_window_redisplay (w); } -#endif /* not USE_X_TOOLKIT && not USE_GTK */ -#endif /* HAVE_X_WINDOWS */ +#endif -#ifndef USE_GTK +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) { /* Allocate/ reallocate matrices of the tool bar window. If we don't have a tool bar window yet, make one. */ @@ -2145,6 +2147,7 @@ free_glyphs (struct frame *f) } #endif +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* Free the tool bar window and its glyph matrices. */ if (!NILP (f->tool_bar_window)) { @@ -2154,6 +2157,7 @@ free_glyphs (struct frame *f) w->desired_matrix = w->current_matrix = NULL; fset_tool_bar_window (f, Qnil); } +#endif /* Release frame glyph matrices. Reset fields to zero in case we are called a second time. */ @@ -3036,6 +3040,7 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p) update_window (XWINDOW (f->menu_bar_window), 1); #endif +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* Update the tool-bar window, if present. */ if (WINDOWP (f->tool_bar_window)) { @@ -3056,21 +3061,11 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p) fset_desired_tool_bar_string (f, tem); } } - +#endif /* Update windows. */ paused_p = update_window_tree (root_window, force_p); update_end (f); - - /* This flush is a performance bottleneck under X, - and it doesn't seem to be necessary anyway (in general). - It is necessary when resizing the window with the mouse, or - at least the fringes are not redrawn in a timely manner. ++kfs */ - if (f->force_flush_display_p) - { - FRAME_RIF (f)->flush_display (f); - f->force_flush_display_p = 0; - } } else { @@ -5498,8 +5493,10 @@ change_frame_size_1 (struct frame *f, int newheight, int newwidth, if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) FrameCols (FRAME_TTY (f)) = newwidth; +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) if (WINDOWP (f->tool_bar_window)) XWINDOW (f->tool_bar_window)->total_cols = newwidth; +#endif } FRAME_LINES (f) = newheight; diff --git a/src/emacs.c b/src/emacs.c index 05384145330..dc4c23b3991 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1,7 +1,7 @@ /* Fully extensible Emacs, running on Unix, intended for GNU. -Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2013 Free Software -Foundation, Inc. +Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2013 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -310,7 +310,7 @@ example, -batch as well as --batch. You can use any unambiguous\n\ abbreviation for a --option.\n\ \n\ Various environment variables and window system resources also affect\n\ -Emacs' operation. See the main documentation.\n\ +the operation of Emacs. See the main documentation.\n\ \n\ Report bugs to bug-gnu-emacs@gnu.org. First, please see the Bugs\n\ section of the Emacs manual or the file BUGS.\n" diff --git a/src/eval.c b/src/eval.c index 9db4d1fd81b..6e964f6604b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2033,7 +2033,9 @@ it is defines a macro. */) DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. -If LEXICAL is t, evaluate using lexical scoping. */) +If LEXICAL is t, evaluate using lexical scoping. +LEXICAL can also be an actual lexical environment, in the form of an +alist mapping symbols to their value. */) (Lisp_Object form, Lisp_Object lexical) { ptrdiff_t count = SPECPDL_INDEX (); diff --git a/src/fileio.c b/src/fileio.c index 0e6113f349d..1a2bdfa237c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5121,7 +5121,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, doc: /* Return t if (car A) is numerically less than (car B). */) (Lisp_Object a, Lisp_Object b) { - return Flss (Fcar (a), Fcar (b)); + Lisp_Object args[2] = { Fcar (a), Fcar (b), }; + return Flss (2, args); } /* Build the complete list of annotations appropriate for writing out diff --git a/src/frame.c b/src/frame.c index 0f1560df157..692d224866c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1108,7 +1108,7 @@ other_visible_frames (struct frame *f) /* Verify that we can still talk to the frame's X window, and note any recent change in visibility. */ -#ifdef HAVE_WINDOW_SYSTEM +#ifdef HAVE_X_WINDOWS if (FRAME_WINDOW_P (XFRAME (this))) x_sync (XFRAME (this)); #endif diff --git a/src/frame.h b/src/frame.h index 3dfbac15709..3aea0cfa27c 100644 --- a/src/frame.h +++ b/src/frame.h @@ -145,9 +145,15 @@ struct frame Lisp_Object menu_bar_window; #endif +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* A window used to display the tool-bar of a frame. */ Lisp_Object tool_bar_window; + /* Desired and current contents displayed in that window. */ + Lisp_Object desired_tool_bar_string; + Lisp_Object current_tool_bar_string; +#endif + /* Desired and current tool-bar items. */ Lisp_Object tool_bar_items; @@ -155,10 +161,6 @@ struct frame tool bar only supports top. */ Lisp_Object tool_bar_position; - /* Desired and current contents displayed in tool_bar_window. */ - Lisp_Object desired_tool_bar_string; - Lisp_Object current_tool_bar_string; - /* Beyond here, there should be no more Lisp_Object components. */ /* Cache of realized faces. */ @@ -185,10 +187,6 @@ struct frame Clear the frame in clear_garbaged_frames if set. */ unsigned resized_p : 1; - /* Set to non-zero in when we want for force a flush_display in - update_frame, usually after resizing the frame. */ - unsigned force_flush_display_p : 1; - /* Set to non-zero if the default face for the frame has been realized. Reset to zero whenever the default face changes. Used to see the difference between a font change and face change. */ @@ -201,9 +199,11 @@ struct frame /* Set to non-zero when current redisplay has updated frame. */ unsigned updated_p : 1; +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* Set to non-zero to minimize tool-bar height even when auto-resize-tool-bar is set to grow-only. */ unsigned minimize_tool_bar_window_p : 1; +#endif #if defined (USE_GTK) || defined (HAVE_NS) /* Nonzero means using a tool bar that comes from the toolkit. */ @@ -459,16 +459,6 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val) f->condemned_scroll_bars = val; } FRAME_INLINE void -fset_current_tool_bar_string (struct frame *f, Lisp_Object val) -{ - f->current_tool_bar_string = val; -} -FRAME_INLINE void -fset_desired_tool_bar_string (struct frame *f, Lisp_Object val) -{ - f->desired_tool_bar_string = val; -} -FRAME_INLINE void fset_face_alist (struct frame *f, Lisp_Object val) { f->face_alist = val; @@ -540,11 +530,23 @@ fset_tool_bar_position (struct frame *f, Lisp_Object val) { f->tool_bar_position = val; } +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) FRAME_INLINE void fset_tool_bar_window (struct frame *f, Lisp_Object val) { f->tool_bar_window = val; } +FRAME_INLINE void +fset_current_tool_bar_string (struct frame *f, Lisp_Object val) +{ + f->current_tool_bar_string = val; +} +FRAME_INLINE void +fset_desired_tool_bar_string (struct frame *f, Lisp_Object val) +{ + f->desired_tool_bar_string = val; +} +#endif /* HAVE_WINDOW_SYSTEM && !USE_GTK && !HAVE_NS */ #define NUMVAL(X) ((INTEGERP (X) || FLOATP (X)) ? XFLOATINT (X) : -1) @@ -1243,7 +1245,6 @@ extern Lisp_Object display_x_get_resource (Display_Info *, extern void set_frame_menubar (struct frame *f, bool first_time, bool deep_p); extern void x_set_window_size (struct frame *f, int change_grav, int cols, int rows); -extern void x_sync (struct frame *); extern Lisp_Object x_get_focus_frame (struct frame *); extern void x_set_mouse_position (struct frame *f, int h, int v); extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y); @@ -1269,13 +1270,24 @@ extern void x_wm_set_icon_position (struct frame *, int, int); #if !defined USE_X_TOOLKIT extern char *x_get_resource_string (const char *, const char *); #endif -#endif +extern void x_sync (struct frame *); +#endif /* HAVE_X_WINDOWS */ extern void x_query_colors (struct frame *f, XColor *, int); extern void x_query_color (struct frame *f, XColor *); #endif /* HAVE_WINDOW_SYSTEM */ + +FRAME_INLINE void +flush_frame (struct frame *f) +{ + struct redisplay_interface *rif = FRAME_RIF (f); + + if (rif && rif->flush_display) + rif->flush_display (f); +} + /*********************************************************************** Multimonitor data ***********************************************************************/ diff --git a/src/insdel.c b/src/insdel.c index f746fd34330..ebd096a2927 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1057,6 +1057,9 @@ insert_from_buffer_1 (struct buffer *buf, ptrdiff_t outgoing_nbytes = incoming_nbytes; INTERVAL intervals; + if (nchars == 0) + return; + /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ diff --git a/src/keyboard.c b/src/keyboard.c index ed70e288c84..020c8859941 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2596,10 +2596,8 @@ read_char (int commandflag, Lisp_Object map, if (/* There currently is something in the echo area. */ !NILP (echo_area_buffer[0]) - && (/* And it's either not from echoing. */ - !EQ (echo_area_buffer[0], echo_message_buffer) - /* Or it's an echo from a different kboard. */ - || echo_kboard != current_kboard + && (/* It's an echo from a different kboard. */ + echo_kboard != current_kboard /* Or we explicitly allow overwriting whatever there is. */ || ok_to_echo_at_next_pause == NULL)) cancel_echoing (); @@ -9873,20 +9871,7 @@ detect_input_pending_run_timers (bool do_display) get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW); if (old_timers_run != timers_run && do_display) - { - redisplay_preserve_echo_area (8); - /* The following fixes a bug when using lazy-lock with - lazy-lock-defer-on-the-fly set to t, i.e. when fontifying - from an idle timer function. The symptom of the bug is that - the cursor sometimes doesn't become visible until the next X - event is processed. --gerd. */ - { - Lisp_Object tail, frame; - FOR_EACH_FRAME (tail, frame) - if (FRAME_RIF (XFRAME (frame))) - FRAME_RIF (XFRAME (frame))->flush_display (XFRAME (frame)); - } - } + redisplay_preserve_echo_area (8); return input_pending; } diff --git a/src/lisp.h b/src/lisp.h index 38b538d9bc2..2b1af1faa19 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3160,6 +3160,16 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; /* Defined in data.c. */ extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); +enum Arith_Comparison { + ARITH_EQUAL, + ARITH_NOTEQUAL, + ARITH_LESS, + ARITH_GRTR, + ARITH_LESS_OR_EQUAL, + ARITH_GRTR_OR_EQUAL +}; +extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, + enum Arith_Comparison comparison); /* Convert the integer I to an Emacs representation, either the integer itself, or a cons of two or three integers, or if all else fails a float. diff --git a/src/minibuf.c b/src/minibuf.c index 7403fc6c32d..cc6f234f7da 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -672,12 +672,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, XWINDOW (minibuf_window)->cursor.x = 0; XWINDOW (minibuf_window)->must_be_updated_p = 1; update_frame (XFRAME (selected_frame), 1, 1); - { - struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame); - struct redisplay_interface *rif = FRAME_RIF (f); - if (rif && rif->flush_display) - rif->flush_display (f); - } + flush_frame (XFRAME (XWINDOW (minibuf_window)->frame)); } /* Make minibuffer contents into a string. */ diff --git a/src/nsfns.m b/src/nsfns.m index fc276c2b12d..f021e834d59 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2231,15 +2231,6 @@ and GNUstep implementations ("distributor-specific release return nsfocus; } -void -x_sync (struct frame *f) -{ - /* XXX Not implemented XXX */ - return; -} - - - /* ========================================================================== Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'. diff --git a/src/nsterm.m b/src/nsterm.m index 31053ca7a0d..59627a38087 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -801,18 +801,6 @@ Free a pool and temporary objects it refers to (callable from C) NSTRACE (ns_update_end); } - -static void -ns_flush (struct frame *f) -/* -------------------------------------------------------------------------- - external (RIF) call - NS impl is no-op since currently we flush in ns_update_end and elsewhere - -------------------------------------------------------------------------- */ -{ - NSTRACE (ns_flush); -} - - static void ns_focus (struct frame *f, NSRect *r, int n) /* -------------------------------------------------------------------------- @@ -3963,8 +3951,7 @@ static Lisp_Object ns_string_to_lispmod (const char *s) ns_after_update_window_line, ns_update_window_begin, ns_update_window_end, - ns_flush, - 0, /* flush_display_optional */ + 0, /* flush_display */ x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, @@ -7446,6 +7433,6 @@ Nil means use fullscreen the old (< 10.7) way. The old way works better with baseline level. The default value is nil. */); x_underline_at_descent_line = 0; - /* Tell emacs about this window system. */ - Fprovide (intern ("ns"), Qnil); + /* Tell Emacs about this window system. */ + Fprovide (Qns, Qnil); } diff --git a/src/term.c b/src/term.c index 0270c1eefa6..fd5ea5a1b8d 100644 --- a/src/term.c +++ b/src/term.c @@ -2917,12 +2917,8 @@ dissociate_if_controlling_tty (int fd) struct terminal * init_tty (const char *name, const char *terminal_type, bool must_succeed) { -#ifdef TERMINFO - char **address = 0; -#else char *area; char **address = &area; -#endif int status; struct tty_display_info *tty = NULL; struct terminal *terminal = NULL; @@ -3013,13 +3009,9 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed) /* On some systems, tgetent tries to access the controlling terminal. */ block_tty_out_signal (); -#ifdef TERMINFO - status = tgetent (0, terminal_type); -#else status = tgetent (tty->termcap_term_buffer, terminal_type); if (tty->termcap_term_buffer[TERMCAP_BUFFER_SIZE - 1]) emacs_abort (); -#endif unblock_tty_out_signal (); if (status < 0) @@ -3050,9 +3042,7 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ terminal_type); } -#ifndef TERMINFO area = tty->termcap_strings_buffer; -#endif tty->TS_ins_line = tgetstr ("al", address); tty->TS_ins_multi_lines = tgetstr ("AL", address); tty->TS_bell = tgetstr ("bl", address); diff --git a/src/termchar.h b/src/termchar.h index 687f7fbd119..11cea34df23 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -30,9 +30,7 @@ struct tty_output /* There is nothing else here at the moment... */ }; -#ifndef TERMINFO enum { TERMCAP_BUFFER_SIZE = 4096 }; -#endif /* Parameters that are shared between frames on the same tty device. */ @@ -78,7 +76,6 @@ struct tty_display_info mouse-face. */ Mouse_HLInfo mouse_highlight; -#ifndef TERMINFO /* Buffer used internally by termcap (see tgetent in the Termcap manual). Only init_tty should use this. */ char termcap_term_buffer[TERMCAP_BUFFER_SIZE]; @@ -86,7 +83,6 @@ struct tty_display_info /* Buffer storing terminal description strings (see tgetstr in the Termcap manual). Only init_tty should use this. */ char termcap_strings_buffer[TERMCAP_BUFFER_SIZE]; -#endif /* Strings, numbers and flags taken from the termcap entry. */ diff --git a/src/termhooks.h b/src/termhooks.h index 77f98938edb..a050c3292c2 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -31,6 +31,7 @@ INLINE_HEADER_BEGIN #endif enum scroll_bar_part { + scroll_bar_nowhere = -1, scroll_bar_above_handle, scroll_bar_handle, scroll_bar_below_handle, @@ -42,11 +43,6 @@ enum scroll_bar_part { scroll_bar_move_ratio }; -/* If the value of the frame parameter changed, whis hook is called. - For example, if going from fullscreen to not fullscreen this hook - may do something OS dependent, like extended window manager hints on X11. */ -extern void (*fullscreen_hook) (struct frame *f); - /* Output method of a terminal (and frames on this terminal, respectively). */ enum output_method @@ -498,7 +494,7 @@ struct terminal windows. */ void (*frame_raise_lower_hook) (struct frame *f, int raise_flag); - /* If the value of the frame parameter changed, whis hook is called. + /* If the value of the frame parameter changed, this hook is called. For example, if going from fullscreen to not fullscreen this hook may do something OS dependent, like extended window manager hints on X11. */ void (*fullscreen_hook) (struct frame *f); diff --git a/src/w32fns.c b/src/w32fns.c index 58c63d959ef..a8b444e0409 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -5201,11 +5201,6 @@ terminate Emacs if we can't open the connection. if (! NILP (xrm_string)) CHECK_STRING (xrm_string); -#if 0 - if (! EQ (Vwindow_system, intern ("w32"))) - error ("Not using Microsoft Windows"); -#endif - /* Allow color mapping to be defined externally; first look in user's HOME directory, then in Emacs etc dir for a file called rgb.txt. */ { diff --git a/src/w32proc.c b/src/w32proc.c index dabaa62f71c..221b42fb7b2 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1144,7 +1144,7 @@ create_child (char *exe, char *cmdline, char *env, int is_gui_app, return FALSE; } -/* create_child doesn't know what emacs' file handle will be for waiting +/* create_child doesn't know what emacs's file handle will be for waiting on output from the child, so we need to make this additional call to register the handle with the process This way the select emulator knows how to match file handles with diff --git a/src/w32term.c b/src/w32term.c index 532ded7cdad..d47509e4ece 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6258,11 +6258,6 @@ w32_make_rdb (char *xrm_option) return buffer; } -void -x_flush (struct frame * f) -{ /* Nothing to do */ } - - extern frame_parm_handler w32_frame_parm_handlers[]; static struct redisplay_interface w32_redisplay_interface = @@ -6276,8 +6271,7 @@ static struct redisplay_interface w32_redisplay_interface = x_after_update_window_line, x_update_window_begin, x_update_window_end, - x_flush, - 0, /* flush_display_optional */ + 0, /* flush_display */ x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, @@ -6344,7 +6338,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) terminal like X does. */ terminal->kboard = xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - kset_window_system (terminal->kboard, intern ("w32")); + kset_window_system (terminal->kboard, Qw32); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. @@ -6697,5 +6691,6 @@ With MS Windows or Nextstep, the value is t. */); staticpro (&last_mouse_motion_frame); last_mouse_motion_frame = Qnil; - Fprovide (intern_c_string ("w32"), Qnil); + /* Tell Emacs about this window system. */ + Fprovide (Qw32, Qnil); } diff --git a/src/w32term.h b/src/w32term.h index 41c5c71832a..b4818f69aee 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -211,7 +211,6 @@ extern void x_set_window_size (struct frame *f, int change_grav, int cols, int rows); extern int x_display_pixel_height (struct w32_display_info *); extern int x_display_pixel_width (struct w32_display_info *); -extern void x_sync (struct frame *); extern Lisp_Object x_get_focus_frame (struct frame *); extern void x_set_mouse_position (struct frame *f, int h, int v); extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y); diff --git a/src/w32xfns.c b/src/w32xfns.c index 19c6b72bf89..7629e49caf8 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -333,9 +333,3 @@ drain_message_queue (void) } return retval; } - -/* x_sync is a no-op on W32. */ -void -x_sync (struct frame *f) -{ -} diff --git a/src/window.c b/src/window.c index 6a52ed7e166..677cb991025 100644 --- a/src/window.c +++ b/src/window.c @@ -1379,6 +1379,7 @@ window_from_coordinates (struct frame *f, int x, int y, cw.window = &window, cw.x = x, cw.y = y; cw.part = part; foreach_window (f, check_window_containing, &cw); +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* If not found above, see if it's in the tool bar window, if a tool bar exists. */ if (NILP (window) @@ -1391,6 +1392,7 @@ window_from_coordinates (struct frame *f, int x, int y, *part = ON_TEXT; window = f->tool_bar_window; } +#endif return window; } @@ -5112,9 +5114,9 @@ and redisplay normally--don't erase and redraw the frame. */) /* Invalidate pixel data calculated for all compositions. */ for (i = 0; i < n_compositions; i++) composition_table[i]->font = NULL; - +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) WINDOW_XFRAME (w)->minimize_tool_bar_window_p = 1; - +#endif Fredraw_frame (WINDOW_FRAME (w)); SET_FRAME_GARBAGED (WINDOW_XFRAME (w)); } diff --git a/src/window.h b/src/window.h index f5ae81149b3..a419bf7e7f0 100644 --- a/src/window.h +++ b/src/window.h @@ -525,10 +525,13 @@ wset_next_buffers (struct window *w, Lisp_Object val) #endif /* 1 if W is a tool bar window. */ - +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) #define WINDOW_TOOL_BAR_P(W) \ (WINDOWP (WINDOW_XFRAME (W)->tool_bar_window) \ && (W) == XWINDOW (WINDOW_XFRAME (W)->tool_bar_window)) +#else +#define WINDOW_TOOL_BAR_P(W) (0) +#endif /* Return the frame y-position at which window W starts. This includes a header line, if any. */ diff --git a/src/xdisp.c b/src/xdisp.c index d5def065936..58316a0667f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -913,11 +913,8 @@ static int in_ellipses_for_invisible_text_p (struct display_pos *, #ifdef HAVE_WINDOW_SYSTEM static void x_consider_frame_title (Lisp_Object); -static int tool_bar_lines_needed (struct frame *, int *); static void update_tool_bar (struct frame *, int); -static void build_desired_tool_bar_string (struct frame *f); static int redisplay_tool_bar (struct frame *); -static void display_tool_bar_line (struct it *, int); static void notice_overwritten_cursor (struct window *, enum glyph_row_area, int, int, int, int); @@ -10767,11 +10764,9 @@ clear_garbaged_frames (void) if (FRAME_VISIBLE_P (f) && FRAME_GARBAGED_P (f)) { if (f->resized_p) - { - redraw_frame (f); - f->force_flush_display_p = 1; - } - clear_current_matrices (f); + redraw_frame (f); + else + clear_current_matrices (f); changed_count++; f->garbaged = 0; f->resized_p = 0; @@ -10859,7 +10854,7 @@ echo_area_display (int update_frame_p) Can do with a display update of the echo area, unless we displayed some mode lines. */ update_single_window (w, 1); - FRAME_RIF (f)->flush_display (f); + flush_frame (f); } else update_frame (f, 1, 1); @@ -11568,6 +11563,7 @@ update_tool_bar (struct frame *f, int save_match_data) } } +#if ! defined (USE_GTK) && ! defined (HAVE_NS) /* Set F->desired_tool_bar_string to a Lisp string representing frame F's desired tool-bar contents. F->tool_bar_items must have @@ -11905,6 +11901,11 @@ tool_bar_lines_needed (struct frame *f, int *n_rows) return (it.current_y + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f); } +#endif /* !USE_GTK && !HAVE_NS */ + +#if defined USE_GTK || defined HAVE_NS +EXFUN (Ftool_bar_lines_needed, 1) ATTRIBUTE_CONST; +#endif DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed, 0, 1, 0, @@ -11912,9 +11913,10 @@ DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed, If FRAME is nil or omitted, use the selected frame. */) (Lisp_Object frame) { + int nlines = 0; +#if ! defined (USE_GTK) && ! defined (HAVE_NS) struct frame *f = decode_any_frame (frame); struct window *w; - int nlines = 0; if (WINDOWP (f->tool_bar_window) && (w = XWINDOW (f->tool_bar_window), @@ -11927,7 +11929,7 @@ If FRAME is nil or omitted, use the selected frame. */) nlines = tool_bar_lines_needed (f, NULL); } } - +#endif return make_number (nlines); } @@ -11938,15 +11940,17 @@ If FRAME is nil or omitted, use the selected frame. */) static int redisplay_tool_bar (struct frame *f) { - struct window *w; - struct it it; - struct glyph_row *row; - #if defined (USE_GTK) || defined (HAVE_NS) + if (FRAME_EXTERNAL_TOOL_BAR (f)) update_frame_tool_bar (f); return 0; -#endif + +#else /* !USE_GTK && !HAVE_NS */ + + struct window *w; + struct it it; + struct glyph_row *row; /* If frame hasn't a tool-bar window or if it is zero-height, don't do anything. This means you must start with tool-bar-lines @@ -12102,8 +12106,11 @@ redisplay_tool_bar (struct frame *f) f->minimize_tool_bar_window_p = 0; return 0; + +#endif /* USE_GTK || HAVE_NS */ } +#if ! defined (USE_GTK) && ! defined (HAVE_NS) /* Get information about the tool-bar item which is displayed in GLYPH on frame F. Return in *PROP_IDX the index where tool-bar item @@ -12347,6 +12354,8 @@ note_tool_bar_highlight (struct frame *f, int x, int y) help_echo_string = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_CAPTION); } +#endif /* !USE_GTK && !HAVE_NS */ + #endif /* HAVE_WINDOW_SYSTEM */ @@ -13645,9 +13654,7 @@ redisplay_preserve_echo_area (int from_where) else redisplay_internal (); - if (FRAME_RIF (SELECTED_FRAME ()) != NULL - && FRAME_RIF (SELECTED_FRAME ())->flush_display_optional) - FRAME_RIF (SELECTED_FRAME ())->flush_display_optional (NULL); + flush_frame (SELECTED_FRAME ()); } @@ -26695,10 +26702,13 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) /* Change the mouse cursor. */ if (FRAME_WINDOW_P (f)) { +#if ! defined (USE_GTK) && ! defined (HAVE_NS) if (draw == DRAW_NORMAL_TEXT && !EQ (hlinfo->mouse_face_window, f->tool_bar_window)) FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->text_cursor); - else if (draw == DRAW_MOUSE_FACE) + else +#endif + if (draw == DRAW_MOUSE_FACE) FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->hand_cursor); else FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->nontext_cursor); @@ -28036,7 +28046,7 @@ note_mouse_highlight (struct frame *f, int x, int y) w = XWINDOW (window); frame_to_window_pixel_xy (w, &x, &y); -#ifdef HAVE_WINDOW_SYSTEM +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* Handle tool-bar window differently since it doesn't display a buffer. */ if (EQ (window, f->tool_bar_window)) @@ -28949,9 +28959,11 @@ expose_frame (struct frame *f, int x, int y, int w, int h) TRACE ((stderr, "(%d, %d, %d, %d)\n", r.x, r.y, r.width, r.height)); mouse_face_overwritten_p = expose_window_tree (XWINDOW (f->root_window), &r); +#if ! defined (USE_GTK) && ! defined (HAVE_NS) if (WINDOWP (f->tool_bar_window)) mouse_face_overwritten_p |= expose_window (XWINDOW (f->tool_bar_window), &r); +#endif #ifdef HAVE_X_WINDOWS #ifndef MSDOS diff --git a/src/xfns.c b/src/xfns.c index 4e8442dd3a3..74bc7a8b1d0 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1031,7 +1031,7 @@ x_set_border_pixel (struct frame *f, int pix) Note: this is done in two routines because of the way X10 works. Note: under X11, this is normally the province of the window manager, - and so emacs' border colors may be overridden. */ + and so emacs's border colors may be overridden. */ static void x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) @@ -1215,8 +1215,11 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) void x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { - int delta, nlines, root_height; + int nlines; +#if ! defined (USE_GTK) + int delta, root_height; Lisp_Object root_window; +#endif /* Treat tool bars like menu bars. */ if (FRAME_MINIBUF_ONLY_P (f)) @@ -1229,6 +1232,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) nlines = 0; #ifdef USE_GTK + FRAME_TOOL_BAR_LINES (f) = 0; if (nlines) { @@ -1245,8 +1249,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) FRAME_EXTERNAL_TOOL_BAR (f) = 0; } - return; -#endif +#else /* !USE_GTK */ /* Make sure we redisplay all windows in this frame. */ ++windows_or_buffers_changed; @@ -1301,7 +1304,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } run_window_configuration_change_hook (f); - +#endif /* USE_GTK */ } @@ -4431,11 +4434,6 @@ x_display_info_for_name (Lisp_Object name) CHECK_STRING (name); -#if 0 - if (! EQ (Vinitial_window_system, intern ("x"))) - error ("Not using X Windows"); /* That doesn't stop us anymore. */ -#endif - for (dpyinfo = x_display_list, names = x_display_name_list; dpyinfo; dpyinfo = dpyinfo->next, names = XCDR (names)) @@ -4479,11 +4477,6 @@ terminate Emacs if we can't open the connection. if (! NILP (xrm_string)) CHECK_STRING (xrm_string); -#if 0 - if (! EQ (Vinitial_window_system, intern ("x"))) - error ("Not using X Windows"); /* That doesn't stop us anymore. */ -#endif - xrm_option = NILP (xrm_string) ? 0 : SSDATA (xrm_string); validate_x_resource_name (); @@ -6296,7 +6289,8 @@ Otherwise use Emacs own tooltip implementation. When using Gtk+ tooltips, the tooltip face is not used. */); x_gtk_use_system_tooltips = 1; - Fprovide (intern_c_string ("x"), Qnil); + /* Tell Emacs about this window system. */ + Fprovide (Qx, Qnil); #ifdef USE_X_TOOLKIT Fprovide (intern_c_string ("x-toolkit"), Qnil); diff --git a/src/xterm.c b/src/xterm.c index 2f3d5ca7a01..c28ca824063 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -230,10 +230,6 @@ static Lisp_Object last_mouse_scroll_bar; static Time last_mouse_movement_time; -/* Time for last user interaction as returned in X events. */ - -static Time last_user_time; - /* Incremented by XTread_socket whenever it really tries to read events. */ @@ -334,29 +330,19 @@ static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t); static void x_initialize (void); -/* Flush display of frame F, or of all frames if F is null. */ +/* Flush display of frame F. */ static void x_flush (struct frame *f) { + eassert (f && FRAME_X_P (f)); /* Don't call XFlush when it is not safe to redisplay; the X connection may be broken. */ if (!NILP (Vinhibit_redisplay)) return; block_input (); - if (f) - { - eassert (FRAME_X_P (f)); - XFlush (FRAME_X_DISPLAY (f)); - } - else - { - /* Flush all displays and so all frames on them. */ - struct x_display_info *xdi; - for (xdi = x_display_list; xdi; xdi = xdi->next) - XFlush (xdi->display); - } + XFlush (FRAME_X_DISPLAY (f)); unblock_input (); } @@ -4091,10 +4077,6 @@ static void x_set_toolkit_scroll_bar_thumb (struct scroll_bar *, static Lisp_Object window_being_scrolled; -/* Last scroll bar part sent in xm_scroll_callback. */ - -static int last_scroll_bar_part; - /* Whether this is an Xaw with arrow-scrollbars. This should imply that movements of 1/20 of the screen size are mapped to up/down. */ @@ -4136,20 +4118,23 @@ xt_action_hook (Widget widget, XtPointer client_data, String action_name, && WINDOWP (window_being_scrolled)) { struct window *w; + struct scroll_bar *bar; x_send_scroll_bar_event (window_being_scrolled, scroll_bar_end_scroll, 0, 0); w = XWINDOW (window_being_scrolled); + bar = XSCROLL_BAR (w->vertical_scroll_bar); - if (XSCROLL_BAR (w->vertical_scroll_bar)->dragging != -1) + if (bar->dragging != -1) { - XSCROLL_BAR (w->vertical_scroll_bar)->dragging = -1; + bar->dragging = -1; /* The thumb size is incorrect while dragging: fix it. */ set_vertical_scroll_bar (w); } window_being_scrolled = Qnil; - last_scroll_bar_part = -1; - +#if defined (USE_LUCID) + bar->last_seen_part = scroll_bar_nowhere; +#endif /* Xt timeouts no longer needed. */ toolkit_scroll_bar_interaction = 0; } @@ -4333,7 +4318,6 @@ xm_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) if (part >= 0) { window_being_scrolled = bar->window; - last_scroll_bar_part = part; x_send_scroll_bar_event (bar->window, part, portion, whole); } } @@ -4394,7 +4378,6 @@ xg_scroll_callback (GtkRange *range, if (part >= 0) { window_being_scrolled = bar->window; - last_scroll_bar_part = part; x_send_scroll_bar_event (bar->window, part, portion, whole); } @@ -4436,7 +4419,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) float top = *top_addr; float shown; int whole, portion, height; - int part; + enum scroll_bar_part part; /* Get the size of the thumb, a value between 0 and 1. */ block_input (); @@ -4458,7 +4441,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) window_being_scrolled = bar->window; bar->dragging = portion; - last_scroll_bar_part = part; + bar->last_seen_part = part; x_send_scroll_bar_event (bar->window, part, portion, whole); } @@ -4478,7 +4461,7 @@ xaw_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) /* The position really is stored cast to a pointer. */ int position = (intptr_t) call_data; Dimension height; - int part; + enum scroll_bar_part part; /* Get the height of the scroll bar. */ block_input (); @@ -4497,7 +4480,7 @@ xaw_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) window_being_scrolled = bar->window; bar->dragging = -1; - last_scroll_bar_part = part; + bar->last_seen_part = part; x_send_scroll_bar_event (bar->window, part, position, height); } @@ -4807,16 +4790,25 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio NULL); /* Massage the top+shown values. */ - if (bar->dragging == -1 || last_scroll_bar_part == scroll_bar_down_arrow) + if (bar->dragging == -1 || bar->last_seen_part == scroll_bar_down_arrow) top = max (0, min (1, top)); else top = old_top; +#if ! defined (HAVE_XAW3D) + /* With Xaw, 'top' values too closer to 1.0 may + cause the thumb to disappear. Fix that. */ + top = min (top, 0.99f); +#endif /* Keep two pixels available for moving the thumb down. */ shown = max (0, min (1 - top - (2.0f / height), shown)); +#if ! defined (HAVE_XAW3D) + /* Likewise with too small 'shown'. */ + shown = max (shown, 0.01f); +#endif - /* If the call to XawScrollbarSetThumb below doesn't seem to work, - check that your system's configuration file contains a define - for `NARROWPROTO'. See s/freebsd.h for an example. */ + /* If the call to XawScrollbarSetThumb below doesn't seem to + work, check that 'NARROWPROTO' is defined in src/config.h. + If this is not so, most likely you need to fix configure. */ if (top != old_top || shown != old_shown) { if (bar->dragging == -1) @@ -4912,6 +4904,9 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) bar->end = 0; bar->dragging = -1; bar->fringe_extended_p = 0; +#if defined (USE_TOOLKIT_SCROLL_BARS) && defined (USE_LUCID) + bar->last_seen_part = scroll_bar_nowhere; +#endif /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (f); @@ -5980,7 +5975,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, break; case SelectionNotify: - last_user_time = event.xselection.time; + dpyinfo->last_user_time = event.xselection.time; #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event.xselection.requestor)) goto OTHER; @@ -5989,7 +5984,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, break; case SelectionClear: /* Someone has grabbed ownership. */ - last_user_time = event.xselectionclear.time; + dpyinfo->last_user_time = event.xselectionclear.time; #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event.xselectionclear.window)) goto OTHER; @@ -6005,7 +6000,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, break; case SelectionRequest: /* Someone wants our selection. */ - last_user_time = event.xselectionrequest.time; + dpyinfo->last_user_time = event.xselectionrequest.time; #ifdef USE_X_TOOLKIT if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner)) goto OTHER; @@ -6024,7 +6019,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, break; case PropertyNotify: - last_user_time = event.xproperty.time; + dpyinfo->last_user_time = event.xproperty.time; f = x_top_window_to_frame (dpyinfo, event.xproperty.window); if (f && event.xproperty.atom == dpyinfo->Xatom_net_wm_state) if (x_handle_net_wm_state (f, &event.xproperty) @@ -6224,7 +6219,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, case KeyPress: - last_user_time = event.xkey.time; + dpyinfo->last_user_time = event.xkey.time; ignore_next_mouse_click_timeout = 0; #if defined (USE_X_TOOLKIT) || defined (USE_GTK) @@ -6235,6 +6230,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, f = x_any_window_to_frame (dpyinfo, event.xkey.window); +#if ! defined (USE_GTK) /* If mouse-highlight is an integer, input clears out mouse highlighting. */ if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) @@ -6244,6 +6240,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; } +#endif #if defined USE_MOTIF && defined USE_TOOLKIT_SCROLL_BARS if (f == 0) @@ -6553,7 +6550,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, #endif case KeyRelease: - last_user_time = event.xkey.time; + dpyinfo->last_user_time = event.xkey.time; #ifdef HAVE_X_I18N /* Don't dispatch this event since XtDispatchEvent calls XFilterEvent, and two calls in a row may freeze the @@ -6564,7 +6561,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, #endif case EnterNotify: - last_user_time = event.xcrossing.time; + dpyinfo->last_user_time = event.xcrossing.time; x_detect_focus_change (dpyinfo, &event, &inev.ie); f = x_any_window_to_frame (dpyinfo, event.xcrossing.window); @@ -6589,7 +6586,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, goto OTHER; case LeaveNotify: - last_user_time = event.xcrossing.time; + dpyinfo->last_user_time = event.xcrossing.time; x_detect_focus_change (dpyinfo, &event, &inev.ie); f = x_top_window_to_frame (dpyinfo, event.xcrossing.window); @@ -6623,7 +6620,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, case MotionNotify: { - last_user_time = event.xmotion.time; + dpyinfo->last_user_time = event.xmotion.time; previous_help_echo_string = help_echo_string; help_echo_string = Qnil; @@ -6766,9 +6763,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, by the rest of Emacs, we put it here. */ bool tool_bar_p = 0; - memset (&compose_status, 0, sizeof (compose_status)); + memset (&compose_status, 0, sizeof (compose_status)); last_mouse_glyph_frame = 0; - last_user_time = event.xbutton.time; + dpyinfo->last_user_time = event.xbutton.time; if (dpyinfo->grabbed && last_mouse_frame @@ -6783,6 +6780,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, #endif if (f) { +#if ! defined (USE_GTK) /* Is this in the tool-bar? */ if (WINDOWP (f->tool_bar_window) && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) @@ -6795,13 +6793,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, tool_bar_p = EQ (window, f->tool_bar_window); if (tool_bar_p && event.xbutton.button < 4) - { - handle_tool_bar_click (f, x, y, - event.xbutton.type == ButtonPress, - x_x_to_emacs_modifiers (dpyinfo, - event.xbutton.state)); - } + handle_tool_bar_click + (f, x, y, event.xbutton.type == ButtonPress, + x_x_to_emacs_modifiers (dpyinfo, event.xbutton.state)); } +#endif /* !USE_GTK */ if (!tool_bar_p) #if defined (USE_X_TOOLKIT) || defined (USE_GTK) @@ -7361,9 +7357,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, #endif } -#ifndef XFlush XFlush (FRAME_X_DISPLAY (f)); -#endif } @@ -8861,8 +8855,9 @@ x_ewmh_activate_frame (struct frame *f) Lisp_Object frame; XSETFRAME (frame, f); x_send_client_event (frame, make_number (0), frame, - dpyinfo->Xatom_net_active_window, - make_number (32), list2i (1, last_user_time)); + dpyinfo->Xatom_net_active_window, + make_number (32), + list2i (1, dpyinfo->last_user_time)); } } @@ -10384,11 +10379,6 @@ static struct redisplay_interface x_redisplay_interface = x_update_window_begin, x_update_window_end, x_flush, -#ifdef XFlush - x_flush, -#else - 0, /* flush_display_optional */ -#endif x_clear_window_mouse_face, x_get_glyph_overhangs, x_fix_overlapping_area, diff --git a/src/xterm.h b/src/xterm.h index 883a249629d..bdc8523009a 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -301,6 +301,9 @@ struct x_display_info minibuffer. */ struct frame *x_highlight_frame; + /* Time of last user interaction as returned in X events on this display. */ + Time last_user_time; + /* The gray pixmap. */ Pixmap gray; @@ -801,6 +804,11 @@ struct scroll_bar being dragged, this is -1. */ int dragging; +#if defined (USE_TOOLKIT_SCROLL_BARS) && defined (USE_LUCID) + /* Last scroll bar part seen in xaw_jump_callback and xaw_scroll_callback. */ + enum scroll_bar_part last_seen_part; +#endif + /* 1 if the background of the fringe that is adjacent to a scroll bar is extended to the gap between the fringe and the bar. */ unsigned fringe_extended_p : 1; diff --git a/test/automated/data-tests.el b/test/automated/data-tests.el new file mode 100644 index 00000000000..2298fa3fe71 --- /dev/null +++ b/test/automated/data-tests.el @@ -0,0 +1,75 @@ +;;; data-tests.el --- tests for src/data.c + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;;; Code: + +(ert-deftest data-tests-= () + (should-error (=)) + (should (= 1)) + (should (= 2 2)) + (should (= 9 9 9 9 9 9 9 9 9)) + (should-not (apply #'= '(3 8 3))) + (should-error (= 9 9 'foo)) + ;; Short circuits before getting to bad arg + (should-not (= 9 8 'foo))) + +(ert-deftest data-tests-< () + (should-error (<)) + (should (< 1)) + (should (< 2 3)) + (should (< -6 -1 0 2 3 4 8 9 999)) + (should-not (apply #'< '(3 8 3))) + (should-error (< 9 10 'foo)) + ;; Short circuits before getting to bad arg + (should-not (< 9 8 'foo))) + +(ert-deftest data-tests-> () + (should-error (>)) + (should (> 1)) + (should (> 3 2)) + (should (> 6 1 0 -2 -3 -4 -8 -9 -999)) + (should-not (apply #'> '(3 8 3))) + (should-error (> 9 8 'foo)) + ;; Short circuits before getting to bad arg + (should-not (> 8 9 'foo))) + +(ert-deftest data-tests-<= () + (should-error (<=)) + (should (<= 1)) + (should (<= 2 3)) + (should (<= -6 -1 -1 0 0 0 2 3 4 8 999)) + (should-not (apply #'<= '(3 8 3 3))) + (should-error (<= 9 10 'foo)) + ;; Short circuits before getting to bad arg + (should-not (<= 9 8 'foo))) + +(ert-deftest data-tests->= () + (should-error (>=)) + (should (>= 1)) + (should (>= 3 2)) + (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999)) + (should-not (apply #'>= '(3 8 3))) + (should-error (>= 9 8 'foo)) + ;; Short circuits before getting to bad arg + (should-not (>= 8 9 'foo))) + +;;; data-tests.el ends here +