commit 8e5a769965313a7a1c42b5992ed24e8b0ea71ead (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Tue Dec 6 23:41:45 2016 -0800 Clean out some IRIX cruft * etc/MACHINES: Remove obsolete discussion of IRIX. * src/process.c (allocate_pty) [__sgi]: Remove SGI-specific code. (create_process) [HAVE_PTYS]: Don't worry about IRIX. * src/syntax.c (scan_sexps_forward): Remove obsolete comment. * src/unexelf.c [__sgi]: Don't include . (unexec) [__sgi]: Remove SGI-specific code. diff --git a/etc/MACHINES b/etc/MACHINES index 15ac917..7f3c979 100644 --- a/etc/MACHINES +++ b/etc/MACHINES @@ -101,15 +101,6 @@ the list at the end of this file. ./configure CC='/usr/sfw/bin/gcc -m64' # GCC ./configure CC='cc -m64' # Solaris Studio -** Irix 6.5 - - Emacs versions later than 24.4 will not compile on Irix by default. - (Note that SGI stopped supporting Irix in December 2013.) - Older versions of Emacs 24 (and 23?) also had problems on Irix. - It *may* be possible to build Emacs <= 24.4 on Irix 6.5 with an old - version (3.1) of gcc. Newer versions of gcc may not work. - See . - * Obsolete platforms diff --git a/src/process.c b/src/process.c index 49340b1..8ab73bd 100644 --- a/src/process.c +++ b/src/process.c @@ -690,11 +690,7 @@ allocate_pty (char pty_name[PTY_NAME_SIZE]) if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0) { emacs_close (fd); -# ifndef __sgi continue; -# else - return -1; -# endif /* __sgi */ } setup_pty (fd); return fd; @@ -1886,9 +1882,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS /* First, disconnect its current controlling terminal. */ - /* We tried doing setsid only if pty_flag, but it caused - process_set_signal to fail on SGI when using a pipe. */ - setsid (); + if (pty_flag) + setsid (); /* Make the pty's terminal the controlling terminal. */ if (pty_flag && forkin >= 0) { diff --git a/src/syntax.c b/src/syntax.c index d463f7e..338dd85 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3196,8 +3196,6 @@ do { prev_from = from; \ && (c1 = FETCH_CHAR (from_byte), syntax = SYNTAX_WITH_FLAGS (c1), SYNTAX_FLAGS_COMSTART_SECOND (syntax))) - /* Duplicate code to avoid a complex if-expression - which causes trouble for the SGI compiler. */ { /* Record the comment style we have entered so that only the comment-end sequence of the same style actually diff --git a/src/unexelf.c b/src/unexelf.c index 748e7a4..58c9244 100644 --- a/src/unexelf.c +++ b/src/unexelf.c @@ -66,9 +66,6 @@ what you give them. Help stamp out software-hoarding! */ #include #include #endif /* _SYSTYPE_SYSV */ -#if __sgi -#include /* for HDRR declaration */ -#endif /* __sgi */ #ifndef MAP_ANON #ifdef MAP_ANONYMOUS @@ -498,53 +495,6 @@ unexec (const char *new_name, const char *old_name) phdr->cbExtOffset += diff; } #endif /* __alpha__ || _SYSTYPE_SYSV */ - -#if __sgi - /* Adjust the HDRR offsets in .mdebug and copy the - line data if it's in its usual 'hole' in the object. - Makes the new file debuggable with dbx. - patches up two problems: the absolute file offsets - in the HDRR record of .mdebug (see /usr/include/syms.h), and - the ld bug that gets the line table in a hole in the - elf file rather than in the .mdebug section proper. - David Anderson. davea@sgi.com Jan 16,1994. */ - if (strcmp (old_section_names + new_shdr->sh_name, ".mdebug") == 0 - && new_shdr->sh_offset - old_shdr->sh_offset != 0) - { -#define MDEBUGADJUST(__ct,__fileaddr) \ - if (n_phdrr->__ct > 0) \ - { \ - n_phdrr->__fileaddr += movement; \ - } - - HDRR *o_phdrr = (HDRR *) ((byte *) old_base + old_shdr->sh_offset); - HDRR *n_phdrr = (HDRR *) ((byte *) new_base + new_shdr->sh_offset); - ptrdiff_t movement = new_shdr->sh_offset - old_shdr->sh_offset; - - MDEBUGADJUST (idnMax, cbDnOffset); - MDEBUGADJUST (ipdMax, cbPdOffset); - MDEBUGADJUST (isymMax, cbSymOffset); - MDEBUGADJUST (ioptMax, cbOptOffset); - MDEBUGADJUST (iauxMax, cbAuxOffset); - MDEBUGADJUST (issMax, cbSsOffset); - MDEBUGADJUST (issExtMax, cbSsExtOffset); - MDEBUGADJUST (ifdMax, cbFdOffset); - MDEBUGADJUST (crfd, cbRfdOffset); - MDEBUGADJUST (iextMax, cbExtOffset); - /* The Line Section, being possible off in a hole of the object, - requires special handling. */ - if (n_phdrr->cbLine > 0) - { - n_phdrr->cbLineOffset += movement; - - if (o_phdrr->cbLineOffset > (old_shdr->sh_offset - + old_shdr->sh_size)) - /* If not covered by section, it hasn't yet been copied. */ - memcpy (n_phdrr->cbLineOffset + new_base, - o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); - } - } -#endif /* __sgi */ } /* Update the symbol values of _edata and _end. */ commit f0870da2bb5eee848a5561fb58b2ec3a63861052 Author: Paul Eggert Date: Tue Dec 6 21:38:32 2016 -0800 Simplify FUNCTIONP implementation * src/bytecode.c (exec_byte_code): * src/image.c (parse_image_spec): Prefer FUNCTIONP (x) to !NILP (Ffunctionp (x)). * src/eval.c (FUNCTIONP): Move here ... * src/lisp.h: ... from here. No longer inline, as that bloats the text and does not help speed (at least on my platform). (functionp): Remove this name, since callers use FUNCTIONP. diff --git a/src/bytecode.c b/src/bytecode.c index 868c014..71ecdbf 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -809,8 +809,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object handler = POP; /* Support for a function here is new in 24.4. */ - record_unwind_protect ((NILP (Ffunctionp (handler)) - ? unwind_body : bcall0), + record_unwind_protect (FUNCTIONP (handler) ? bcall0 : unwind_body, handler); NEXT; } diff --git a/src/dbusbind.c b/src/dbusbind.c index a0146a3..23392d8 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1309,7 +1309,7 @@ usage: (dbus-message-internal &rest REST) */) XD_DBUS_VALIDATE_PATH (path); XD_DBUS_VALIDATE_INTERFACE (interface); XD_DBUS_VALIDATE_MEMBER (member); - if (!NILP (handler) && (!FUNCTIONP (handler))) + if (!NILP (handler) && !FUNCTIONP (handler)) wrong_type_argument (Qinvalid_function, handler); } diff --git a/src/eval.c b/src/eval.c index 724f001..8ad06dd 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2638,6 +2638,37 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, return Qnil; } +bool +FUNCTIONP (Lisp_Object object) +{ + if (SYMBOLP (object) && !NILP (Ffboundp (object))) + { + object = Findirect_function (object, Qt); + + if (CONSP (object) && EQ (XCAR (object), Qautoload)) + { + /* Autoloaded symbols are functions, except if they load + macros or keymaps. */ + for (int i = 0; i < 4 && CONSP (object); i++) + object = XCDR (object); + + return ! (CONSP (object) && !NILP (XCAR (object))); + } + } + + if (SUBRP (object)) + return XSUBR (object)->max_args != UNEVALLED; + else if (COMPILEDP (object)) + return true; + else if (CONSP (object)) + { + Lisp_Object car = XCAR (object); + return EQ (car, Qlambda) || EQ (car, Qclosure); + } + else + return false; +} + DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, doc: /* Call first argument as a function, passing remaining arguments to it. Return the value that function returns. diff --git a/src/image.c b/src/image.c index a87dc4d..89572b8 100644 --- a/src/image.c +++ b/src/image.c @@ -793,7 +793,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, case IMAGE_FUNCTION_VALUE: value = indirect_function (value); - if (!NILP (Ffunctionp (value))) + if (FUNCTIONP (value)) break; return 0; diff --git a/src/lisp.h b/src/lisp.h index 3d39dc4..b9c6289 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -564,7 +564,6 @@ INLINE bool CHAR_TABLE_P (Lisp_Object); INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); INLINE bool (CONSP) (Lisp_Object); INLINE bool (FLOATP) (Lisp_Object); -INLINE bool functionp (Lisp_Object); INLINE bool (INTEGERP) (Lisp_Object); INLINE bool (MARKERP) (Lisp_Object); INLINE bool (MISCP) (Lisp_Object); @@ -2994,13 +2993,6 @@ CHECK_NUMBER_CDR (Lisp_Object x) Lisp_Object fnname #endif -/* True if OBJ is a Lisp function. */ -INLINE bool -FUNCTIONP (Lisp_Object obj) -{ - return functionp (obj); -} - /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ extern void defsubr (struct Lisp_Subr *); @@ -3915,6 +3907,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); +extern bool FUNCTIONP (Lisp_Object); extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); @@ -4722,38 +4715,6 @@ maybe_gc (void) Fgarbage_collect (); } -INLINE bool -functionp (Lisp_Object object) -{ - if (SYMBOLP (object) && !NILP (Ffboundp (object))) - { - object = Findirect_function (object, Qt); - - if (CONSP (object) && EQ (XCAR (object), Qautoload)) - { - /* Autoloaded symbols are functions, except if they load - macros or keymaps. */ - int i; - for (i = 0; i < 4 && CONSP (object); i++) - object = XCDR (object); - - return ! (CONSP (object) && !NILP (XCAR (object))); - } - } - - if (SUBRP (object)) - return XSUBR (object)->max_args != UNEVALLED; - else if (COMPILEDP (object)) - return true; - else if (CONSP (object)) - { - Lisp_Object car = XCAR (object); - return EQ (car, Qlambda) || EQ (car, Qclosure); - } - else - return false; -} - INLINE_HEADER_END #endif /* EMACS_LISP_H */ diff --git a/src/xwidget.c b/src/xwidget.c index d1f9540..62df665 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -711,7 +711,7 @@ argument procedure FUN.*/) { WEBKIT_FN_INIT (); CHECK_STRING (script); - if (!NILP (fun) && (!FUNCTIONP (fun))) + if (!NILP (fun) && !FUNCTIONP (fun)) wrong_type_argument (Qinvalid_function, fun); void *callback = (FUNCTIONP (fun)) ? commit 2a3420d94206a97f094580e06c25af91d5949516 Author: Noam Postavsky Date: Sun Nov 27 14:41:02 2016 -0500 Give test-completion's PREDICATE the hashtable key For hashtable entries with symbol keys, `test-completion' would convert the key to a string before calling PREDICATE, unlike `try-completion' and `all-completions'. * src/minibuf.c (Ftest_completion): Pass original key from hashtable. diff --git a/src/minibuf.c b/src/minibuf.c index 6c694cb..7c5af34 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1736,26 +1736,27 @@ the values STRING, PREDICATE and `lambda'. */) else if (HASH_TABLE_P (collection)) { struct Lisp_Hash_Table *h = XHASH_TABLE (collection); - Lisp_Object key = Qnil; i = hash_lookup (h, string, NULL); if (i >= 0) - tem = HASH_KEY (h, i); + { + tem = HASH_KEY (h, i); + goto found_matching_key; + } else for (i = 0; i < HASH_TABLE_SIZE (h); ++i) - if (!NILP (HASH_HASH (h, i)) - && (key = HASH_KEY (h, i), - SYMBOLP (key) ? key = Fsymbol_name (key) : key, - STRINGP (key)) - && EQ (Fcompare_strings (string, make_number (0), Qnil, - key, make_number (0) , Qnil, - completion_ignore_case ? Qt : Qnil), - Qt)) - { - tem = key; - break; - } - if (!STRINGP (tem)) - return Qnil; + { + if (NILP (HASH_HASH (h, i))) continue; + tem = HASH_KEY (h, i); + Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem); + if (!STRINGP (strkey)) continue; + if (EQ (Fcompare_strings (string, Qnil, Qnil, + strkey, Qnil, Qnil, + completion_ignore_case ? Qt : Qnil), + Qt)) + goto found_matching_key; + } + return Qnil; + found_matching_key: ; } else return call3 (collection, string, predicate, Qlambda); diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 98b8614..82ac037 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -394,10 +394,7 @@ (ert-deftest test-completion-symbol-hashtable-predicate () (minibuf-tests--test-completion-pred #'minibuf-tests--strings-to-symbol-hashtable - ;; The predicate recieves a string as the key in this case. - (lambda (table) - (let ((in-table (minibuf-tests--part-of-hashtable table))) - (lambda (k v) (funcall in-table (intern k) v)))))) + #'minibuf-tests--part-of-hashtable)) (ert-deftest test-completion-symbol-hashtable-completion-regexp () (minibuf-tests--test-completion-regexp #'minibuf-tests--strings-to-symbol-hashtable)) commit 60fe63015165a03a765852f60367e548c1617f89 Author: Noam Postavsky Date: Sun Nov 27 10:04:48 2016 -0500 Give test-completion's PREDICATE full alist entry Since 2016-06-26 "Fix test-completion with completion-regexp-list", when calling test-completion with an alist collection, the predicate was recieving the string value instead of the alist entry (Bug#24966). * src/minibuf.c (Ftest_completion): Don't modify the found element, just test STRING against `completion-regexp-list'. * test/src/minibuf-tests.el: New tests for `try-completion', `all-completions', and `test-completion'. diff --git a/src/minibuf.c b/src/minibuf.c index 57eea05..6c694cb 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1686,8 +1686,6 @@ the values STRING, PREDICATE and `lambda'. */) tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil); if (NILP (tem)) return Qnil; - else if (CONSP (tem)) - tem = XCAR (tem); } else if (VECTORP (collection)) { @@ -1770,9 +1768,9 @@ the values STRING, PREDICATE and `lambda'. */) for (regexps = Vcompletion_regexp_list; CONSP (regexps); regexps = XCDR (regexps)) { - if (NILP (Fstring_match (XCAR (regexps), - SYMBOLP (tem) ? string : tem, - Qnil))) + /* We can test against STRING, because if we got here, then + the element is equivalent to it. */ + if (NILP (Fstring_match (XCAR (regexps), string, Qnil))) return unbind_to (count, Qnil); } unbind_to (count, Qnil); diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el new file mode 100644 index 0000000..98b8614 --- /dev/null +++ b/test/src/minibuf-tests.el @@ -0,0 +1,406 @@ +;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + + +;;; Support functions for `try-completion', `all-completion', and +;;; `test-completion' tests. + +(defun minibuf-tests--strings-to-symbol-list (list) + (mapcar #'intern list)) +(defun minibuf-tests--strings-to-symbol-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons (intern str) (cl-incf num))) list))) +(defun minibuf-tests--strings-to-string-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons str (cl-incf num))) list))) +(defun minibuf-tests--strings-to-obarray (list) + (let ((ob (make-vector 7 0))) + (mapc (lambda (str) (intern str ob)) list) + ob)) +(defun minibuf-tests--strings-to-string-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash str (cl-incf num) ht)) list) + ht)) +(defun minibuf-tests--strings-to-symbol-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash (intern str) (cl-incf num) ht)) list) + ht)) + +;;; Functions that produce a predicate (for *-completion functions) +;;; which always returns non-nil for a given collection. + +(defun minibuf-tests--memq-of-collection (collection) + (lambda (elt) (memq elt collection))) +(defun minibuf-tests--part-of-obarray (ob) + (lambda (sym) (eq (intern-soft (symbol-name sym) ob) sym))) +(defun minibuf-tests--part-of-hashtable (table) + (lambda (k v) (equal (gethash k table) v))) + + +;;; Testing functions that are agnostic to type of COLLECTION. + +(defun minibuf-tests--try-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil)))) + +(defun minibuf-tests--try-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (try-completion "a" abcdef abcdef-member) "abc")) + (should (equal (try-completion "a" +abba +abba-member) "ab")) + (should (equal (try-completion "abc" +abba +abba-member) t)) + (should (equal (try-completion "abcd" +abba +abba-member) nil)) + (should-not (try-completion "a" abcdef #'ignore)) + (should-not (try-completion "a" +abba #'ignore)) + (should-not (try-completion "abc" +abba #'ignore)) + (should-not (try-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--try-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (try-completion "a" abcdef)) + (should-not (try-completion "a" +abba)) + (should-not (try-completion "abc" +abba)) + (should-not (try-completion "abcd" +abba))))) + +(defun minibuf-tests--all-completions (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil)))) + +(defun minibuf-tests--all-completions-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) + (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) + (should (equal (all-completions "abcd" +abba +abba-member) nil)) + (should-not (all-completions "a" abcdef #'ignore)) + (should-not (all-completions "a" +abba #'ignore)) + (should-not (all-completions "abc" +abba #'ignore)) + (should-not (all-completions "abcd" +abba #'ignore)))) + +(defun minibuf-tests--all-completions-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (all-completions "a" abcdef)) + (should-not (all-completions "a" +abba)) + (should-not (all-completions "abc" +abba)) + (should-not (all-completions "abcd" +abba))))) + +(defun minibuf-tests--test-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba)))) + +(defun minibuf-tests--test-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (test-completion "abc" abcdef abcdef-member)) + (should (test-completion "def" +abba +abba-member)) + (should (test-completion "abba" +abba +abba-member)) + (should-not (test-completion "abcd" +abba +abba-member)) + (should-not (test-completion "abc" abcdef #'ignore)) + (should-not (test-completion "def" +abba #'ignore)) + (should-not (test-completion "abba" +abba #'ignore)) + (should-not (test-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--test-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))) + (let ((completion-regexp-list '("X"))) + (should-not (test-completion "abc" abcdef)) + (should-not (test-completion "def" +abba)) + (should-not (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))))) + + +;;; Tests for `try-completion'. +(ert-deftest try-completion-string-list () + (minibuf-tests--try-completion #'identity)) +(ert-deftest try-completion-string-list-predicate () + (minibuf-tests--try-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-list-completion-regexp () + (minibuf-tests--try-completion-regexp #'identity)) + +(ert-deftest try-completion-symbol-list () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest try-completion-symbol-list-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-list-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest try-completion-symbol-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest try-completion-symbol-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest try-completion-string-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest try-completion-string-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest try-completion-obarray () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest try-completion-obarray-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest try-completion-obarray-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest try-completion-string-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest try-completion-string-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-string-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest try-completion-symbol-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest try-completion-symbol-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `all-completions'. + +(ert-deftest all-completions-string-list () + (minibuf-tests--all-completions #'identity)) +(ert-deftest all-completions-string-list-predicate () + (minibuf-tests--all-completions-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-list-completion-regexp () + (minibuf-tests--all-completions-regexp #'identity)) + +(ert-deftest all-completions-symbol-list () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest all-completions-symbol-list-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-list-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest all-completions-symbol-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest all-completions-symbol-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest all-completions-string-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest all-completions-string-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest all-completions-obarray () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-obarray)) +(ert-deftest all-completions-obarray-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest all-completions-obarray-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest all-completions-string-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest all-completions-string-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-string-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest all-completions-symbol-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest all-completions-symbol-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-symbol-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `test-completion'. + +(ert-deftest test-completion-string-list () + (minibuf-tests--test-completion #'identity)) +(ert-deftest test-completion-string-list-predicate () + (minibuf-tests--test-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-list-completion-regexp () + (minibuf-tests--test-completion-regexp #'identity)) + +(ert-deftest test-completion-symbol-list () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest test-completion-symbol-list-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-list-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest test-completion-symbol-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest test-completion-symbol-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest test-completion-string-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest test-completion-string-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest test-completion-obarray () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest test-completion-obarray-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest test-completion-obarray-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest test-completion-string-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest test-completion-string-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest test-completion-string-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest test-completion-symbol-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest test-completion-symbol-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + ;; The predicate recieves a string as the key in this case. + (lambda (table) + (let ((in-table (minibuf-tests--part-of-hashtable table))) + (lambda (k v) (funcall in-table (intern k) v)))))) +(ert-deftest test-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; minibuf-tests.el ends here commit 58e418d2ceb82501f03d9c3316fd0a46faf7f0eb Author: Noam Postavsky Date: Sun Aug 21 22:58:37 2016 -0400 Fix ert-tests when running compiled * test/lisp/emacs-lisp/ert-tests.el (ert-test-deftest): Don't test for specific macroexpansion, just check result of evaluation. (ert-test-record-backtrace): Don't hardcode representation of closure in expected backtrace, this lets the test succeed even when the test code is compiled. * lisp/emacs-lisp/ert.el (ert--expand-should-1): Also pass `byte-compile-macro-environment' to `macroexpand', this allows the `should' macro to properly handle macroexpansion of macros that were defined in the same file when it's being compiled (Bug #17851). diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 0308c9c..89f83dd 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -276,11 +276,12 @@ DATA is displayed to the user and should state the reason for skipping." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - (macroexpand form (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment))))) + (macroexpand form (append byte-compile-macro-environment + (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (cl-gensym "value-"))) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 5d36755..83fddd1 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -344,53 +344,35 @@ This macro is used to test if macroexpansion in `should' works." ((error) (should (equal actual-condition expected-condition))))))) +(defun ert-test--which-file () + "Dummy function to help test `symbol-file' for tests.") + (ert-deftest ert-test-deftest () - ;; FIXME: These tests don't look very good. What is their intent, i.e. what - ;; are they really testing? The precise generated code shouldn't matter, so - ;; we should either test the behavior of the code, or else try to express the - ;; kind of efficiency guarantees we're looking for. - (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) - '(progn - (ert-set-test 'abc - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'abc "foo" - #'(lambda nil) - nil ':passed - '(bar)))) - (setq current-load-list - (cons - '(ert-deftest . abc) - current-load-list)) - 'abc))) - (should (equal (macroexpand '(ert-deftest def () - :expected-result ':passed)) - '(progn - (ert-set-test 'def - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'def nil - #'(lambda nil) - nil ':passed 'nil))) - (setq current-load-list - (cons - '(ert-deftest . def) - current-load-list)) - 'def))) + (ert-deftest ert-test-abc () "foo" :tags '(bar)) + (let ((abc (ert-get-test 'ert-test-abc))) + (should (equal (ert-test-tags abc) '(bar))) + (should (equal (ert-test-documentation abc) "foo"))) + (should (equal (symbol-file 'ert-test-deftest 'ert-deftest) + (symbol-file 'ert-test--which-file 'defun))) + + (ert-deftest ert-test-def () :expected-result ':passed) + (let ((def (ert-get-test 'ert-test-def))) + (should (equal (ert-test-expected-result-type def) :passed))) ;; :documentation keyword is forbidden (should-error (macroexpand '(ert-deftest ghi () :documentation "foo")))) (ert-deftest ert-test-record-backtrace () - (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (with-temp-buffer - (ert--print-backtrace (ert-test-failed-backtrace result)) - (goto-char (point-min)) - (end-of-line) - (let ((first-line (buffer-substring-no-properties (point-min) (point)))) - (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()"))))))) + (let* ((test-body (lambda () (ert-fail "foo"))) + (test (make-ert-test :body test-body)) + (result (ert-run-test test))) + (should (ert-test-failed-p result)) + (with-temp-buffer + (ert--print-backtrace (ert-test-failed-backtrace result)) + (goto-char (point-min)) + (end-of-line) + (let ((first-line (buffer-substring-no-properties (point-min) (point)))) + (should (equal first-line (format " %S()" test-body))))))) (ert-deftest ert-test-messages () :tags '(:causes-redisplay) @@ -837,7 +819,3 @@ This macro is used to test if macroexpansion in `should' works." (provide 'ert-tests) ;;; ert-tests.el ends here - -;; Local Variables: -;; no-byte-compile: t -;; End: commit 5202cb56add070eb7d9fe8015f2a4edd57a628f9 Author: Glenn Morris Date: Tue Dec 6 20:31:54 2016 -0500 Make "g" in vc push/pull buffers re-push/pull * lisp/vc/vc-bzr.el (vc-bzr--pushpull): * lisp/vc/vc-git.el (vc-git--pushpull): * lisp/vc/vc-hg.el (vc-hg--pushpull): Set compile-command so that "g" works. (Bug#11446) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 4bcab66..0fee6df 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -372,7 +372,12 @@ If PROMPT is non-nil, prompt for the Bzr command to run." 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))) + (with-current-buffer buf + (vc-run-delayed + (vc-compilation-mode 'bzr) + (setq-local compile-command + (concat vc-bzr-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buf)))) (defun vc-bzr-pull (prompt) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ec0e081..514b97c 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -792,7 +792,12 @@ If PROMPT is non-nil, prompt for the Git command to run." 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))) + (with-current-buffer buffer + (vc-run-delayed + (vc-compilation-mode 'git) + (setq-local compile-command + (concat git-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buffer))) (defun vc-git-pull (prompt) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index cee01ee..29f8df0 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1347,7 +1347,11 @@ commands, which only operated on marked files." args (cddr args))) (apply 'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer - (vc-run-delayed (vc-compilation-mode 'hg))) + (vc-run-delayed + (vc-compilation-mode 'hg) + (setq-local compile-command + (concat hg-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buffer))))) (defun vc-hg-pull (prompt) commit c95270ad4b48204880ae10ec730eb121ffa14abe Author: Paul Eggert Date: Tue Dec 6 15:25:54 2016 -0800 Change two _Noreturn functions to return void This is a bit clearer than _Noreturn functions that (do not) return a non-void type. * src/callproc.c (call_process) [MSDOS]: Use 'status' local to record status. (child_setup): Return CHILD_SETUP_TYPE. * src/data.c, src/lisp.h (wrong_type_argument): Return void. All callers changed. * src/lisp.h (CHILD_SETUP_TYPE): New macro. diff --git a/src/callproc.c b/src/callproc.c index dc3ca4a..02db348 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -293,7 +293,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, Lisp_Object output_file = Qnil; #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ char *tempfile = NULL; - int pid; #else sigset_t oldset; pid_t pid; @@ -538,11 +537,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, } #ifdef MSDOS /* MW, July 1993 */ - /* Note that on MSDOS `child_setup' actually returns the child process - exit status, not its PID, so assign it to status below. */ - pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); - if (pid < 0) + if (status < 0) { child_errno = errno; unbind_to (count, Qnil); @@ -551,7 +548,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, code_convert_string_norecord (build_string (strerror (child_errno)), Vlocale_coding_system, 0); } - status = pid; for (i = 0; i < CALLPROC_FDS; i++) if (0 <= callproc_fd[i]) @@ -1163,9 +1159,13 @@ exec_failed (char const *name, int err) CURRENT_DIR is an elisp string giving the path of the current directory the subprocess should have. Since we can't really signal a decent error from within the child, this should be verified as an - executable directory by the parent. */ + executable directory by the parent. + + On GNUish hosts, either exec or return an error number. + On MS-Windows, either return a pid or signal an error. + On MS-DOS, either return an exit status or signal an error. */ -int +CHILD_SETUP_TYPE child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, Lisp_Object current_dir) { diff --git a/src/data.c b/src/data.c index eee2a52..64cd8b2 100644 --- a/src/data.c +++ b/src/data.c @@ -138,7 +138,7 @@ wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) make_number (bool_vector_size (a3))); } -Lisp_Object +_Noreturn void wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) { /* If VALUE is not even a valid Lisp object, we'd want to abort here @@ -2924,7 +2924,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, case Alogand: case Alogior: case Alogxor: - return wrong_type_argument (Qinteger_or_marker_p, val); + wrong_type_argument (Qinteger_or_marker_p, val); case Amax: if (!argnum || isnan (next) || next > accum) accum = next; diff --git a/src/lisp.h b/src/lisp.h index 7dd9145..3d39dc4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -309,7 +309,7 @@ error !; #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ - ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x)) + ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) @@ -599,7 +599,7 @@ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ -extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); +extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object); extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); extern void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval, Lisp_Object operation, Lisp_Object where); @@ -1270,16 +1270,20 @@ XSETCDR (Lisp_Object c, Lisp_Object n) INLINE Lisp_Object CAR (Lisp_Object c) { - return (CONSP (c) ? XCAR (c) - : NILP (c) ? Qnil - : wrong_type_argument (Qlistp, c)); + if (CONSP (c)) + return XCAR (c); + if (!NILP (c)) + wrong_type_argument (Qlistp, c); + return Qnil; } INLINE Lisp_Object CDR (Lisp_Object c) { - return (CONSP (c) ? XCDR (c) - : NILP (c) ? Qnil - : wrong_type_argument (Qlistp, c)); + if (CONSP (c)) + return XCDR (c); + if (!NILP (c)) + wrong_type_argument (Qlistp, c); + return Qnil; } /* Take the car or cdr of something whose type is not known. */ @@ -4223,9 +4227,11 @@ extern void setup_process_coding_systems (Lisp_Object); /* Defined in callproc.c. */ #ifndef DOS_NT - _Noreturn +# define CHILD_SETUP_TYPE _Noreturn void +#else +# define CHILD_SETUP_TYPE int #endif -extern int child_setup (int, int, int, char **, bool, Lisp_Object); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); commit 38d0276ad122d1a7663ecca965506f85b4e29b7f Author: Paul Eggert Date: Mon Dec 5 22:40:36 2016 -0800 Fix GPG bug introduced by Oct file-missing change Problem with visiting nonexistent .gpg file reported by Herbert J Skuhra. * lisp/epa-file.el (epa-file--find-file-not-found-function): (epa-file-insert-file-contents, epa-file-write-region): Signal file-missing or file-error instead of epa-error. diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 2303a08..4b0d9b3 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -120,7 +120,7 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (signal (car error) + (signal 'file-missing (cons "Opening input file" (cdr error))))) (defvar last-coding-system-used) @@ -165,18 +165,19 @@ encryption is used." (equal (cadr error) "Searching for program")) (error "Decryption program `%s' not found" (nth 3 error))) - (when (file-exists-p local-file) - ;; Hack to prevent find-file from opening empty buffer - ;; when decryption failed (bug#6568). See the place - ;; where `find-file-not-found-functions' are called in - ;; `find-file-noselect-1'. - (setq-local epa-file-error error) - (add-hook 'find-file-not-found-functions - 'epa-file--find-file-not-found-function - nil t) - (epa-display-error context)) - (signal (car error) - (cons "Opening input file" (cdr error))))) + (let ((exists (file-exists-p local-file))) + (when exists + ;; Hack to prevent find-file from opening empty buffer + ;; when decryption failed (bug#6568). See the place + ;; where `find-file-not-found-functions' are called in + ;; `find-file-noselect-1'. + (setq-local epa-file-error error) + (add-hook 'find-file-not-found-functions + 'epa-file--find-file-not-found-function + nil t) + (epa-display-error context)) + (signal (if exists 'file-error 'file-missing) + (cons "Opening input file" (cdr error)))))) (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! (setq-local epa-file-encrypt-to (mapcar #'car (epg-context-result-for @@ -272,7 +273,7 @@ If no one is selected, symmetric encryption will be performed. " (epa-display-error context) (if (setq entry (assoc file epa-file-passphrase-alist)) (setcdr entry nil)) - (signal (car error) (cons "Opening output file" (cdr error))))) + (signal 'file-error (cons "Opening output file" (cdr error))))) (epa-file-run-real-handler #'write-region (list string nil file append visit lockname mustbenew)) commit 13d4dd1add0f13c0b1462f27f9fab55a1ff67a66 Author: Glenn Morris Date: Mon Dec 5 20:11:01 2016 -0500 Tweak recent flymake change * lisp/progmodes/flymake.el (flymake-report-fatal-status): Avoid double message when flymake-log-level >= 0. * doc/misc/flymake.texi (Customizable variables): No longer mention flymake-gui-warnings-enabled. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 998f1b3..6cece30 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -323,12 +323,6 @@ file cannot be run simultaneously. If any changes are made to the buffer, syntax check is automatically started after @code{flymake-no-changes-timeout} seconds. -@item flymake-gui-warnings-enabled -A boolean flag indicating whether Flymake will show message boxes for -non-recoverable errors. If @code{flymake-gui-warnings-enabled} is -@code{nil}, these errors will only be logged to the @file{*Messages*} -buffer. - @item flymake-start-syntax-check-on-newline A boolean flag indicating whether to start syntax check after a newline character is added to the buffer. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index cb9f7b6..846ec22 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1198,10 +1198,11 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-report-fatal-status (status warning) "Display a warning and switch flymake mode off." - ;; This should really by flymake-log 0, but that is not shown by default. - ;; flymake-mode already uses message if no file name. + ;; This first message was always shown by default, and flymake-log + ;; does nothing by default, hence the use of message. ;; Another option is display-warning. - (message "Flymake: %s. Flymake will be switched OFF" warning) + (if (< flymake-log-level 0) + (message "Flymake: %s. Flymake will be switched OFF" warning)) (flymake-mode 0) (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" (buffer-name) status warning)) commit 81059cb970f95362eb52d6f53bbf02c70172048b Author: Katsumi Yamaoka Date: Mon Dec 5 23:32:36 2016 +0000 Make TAB and M-TAB run widget-forward and widget-backward (bug#25091) * lisp/gnus/mm-decode (mm-convert-shr-links): Avoid `shr-next-link' and `shr-previous-link' so TAB and M-TAB run `widget-forward' and `widget-backward' instead (bug#25091). diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 4b3f10c..3127a22 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1859,6 +1859,10 @@ If RECURSIVE, search recursively." (dolist (key (where-is-internal #'widget-button-click widget-keymap)) (unless (lookup-key keymap key) (define-key keymap key #'ignore))) + ;; Avoid `shr-next-link' and `shr-previous-link' in `keymap' so + ;; TAB and M-TAB run `widget-forward' and `widget-backward' instead. + (substitute-key-definition 'shr-next-link nil keymap) + (substitute-key-definition 'shr-previous-link nil keymap) (dolist (overlay (overlays-at start)) (overlay-put overlay 'face nil)) (setq start end))))) commit 1b762de16642cd08a7fbc47e2e0c058af2e09a11 Author: Michael Albinus Date: Mon Dec 5 16:06:04 2016 +0100 Remove compat code in Tramp * lisp/net/tramp.el (tramp-parse-time-months): Remove. * lisp/net/tramp-compat.el (top): Require parse-time. * lisp/net/tramp-smb.el (tramp-smb-read-file-entry): Use `parse-time-months'. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4ebae79..a079b67 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -37,6 +37,7 @@ (require 'advice) (require 'custom) (require 'format-spec) +(require 'parse-time) (require 'password-cache) (require 'shell) (require 'timer) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 61796a2..e52296f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1724,7 +1724,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (if (and sec min hour day month year) (encode-time sec min hour day - (cdr (assoc (downcase month) tramp-parse-time-months)) + (cdr (assoc (downcase month) parse-time-months)) year) '(0 0))) (list localname mode size mtime)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a92b602..1eb66cf 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4292,18 +4292,11 @@ Invokes `password-read' if available, `read-passwd' else." 'auth-source-forget-user-or-password "password" host method)) (password-cache-remove (tramp-make-tramp-file-name method user host "")))) -;; Snarfed code from time-date.el and parse-time.el +;; Snarfed code from time-date.el. (defconst tramp-half-a-year '(241 17024) "Evaluated by \"(days-to-time 183)\".") -(defconst tramp-parse-time-months - '(("jan" . 1) ("feb" . 2) ("mar" . 3) - ("apr" . 4) ("may" . 5) ("jun" . 6) - ("jul" . 7) ("aug" . 8) ("sep" . 9) - ("oct" . 10) ("nov" . 11) ("dec" . 12)) - "Alist mapping month names to integers.") - ;;;###tramp-autoload (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. commit d75e9881fdf648fcb6c25e344353450a7806feee Author: Martin Rudalics Date: Mon Dec 5 11:06:55 2016 +0100 Don't try to split side windows in ibuffer (Bug#25115) * lisp/ibuffer.el (ibuffer-confirm-operation-on): Don't try to split a side window (Bug#25115). diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 51d7cb9..16fbf57 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1197,7 +1197,11 @@ a new window in the current frame, splitting vertically." (ibuffer-columnize-and-insert-list names) (goto-char (point-min)) (setq buffer-read-only t)) - (let ((lastwin (car (last (window-list nil 'nomini))))) + (let ((windows (nreverse (window-list nil 'nomini))) + lastwin) + (while (window-parameter (car windows) 'window-side) + (setq windows (cdr windows))) + (setq lastwin (car windows)) ;; Now attempt to display the buffer... (save-window-excursion (select-window lastwin)