commit 4da7aaa3a8dafe39df95eef1e3a0b5ea8942a431 (HEAD, refs/remotes/origin/master) Author: Katsumi Yamaoka Date: Thu Mar 2 07:56:31 2017 +0000 gnus-summary-select-article-buffer: Don't re-render existing article * lisp/gnus/gnus-sum.el (gnus-summary-select-article-buffer): Don't re-render existing article. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 2631514e42..ae13e7157d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7045,8 +7045,9 @@ buffer." (interactive) (if (not (gnus-buffer-live-p gnus-article-buffer)) (error "There is no article buffer for this summary buffer") - (unless (get-buffer-window gnus-article-buffer) - (gnus-summary-show-article)) + (or (get-buffer-window gnus-article-buffer) + (eq gnus-current-article (gnus-summary-article-number)) + (gnus-summary-show-article)) (gnus-configure-windows (if gnus-widen-article-window 'only-article commit 300f72f3a36b8af2e477bc9930725a48da6b0a0d Author: Katsumi Yamaoka Date: Thu Mar 2 07:55:57 2017 +0000 Don't add debbugs address to message body (bug#25896) * lisp/gnus/gnus-group.el (gnus-read-ephemeral-bug-group): Don't add debbugs address to message body (bug#25896), and don't add it to message header either if it already exists. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2488cdb706..8a061b70bf 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2464,14 +2464,33 @@ the bug number, and browsing the URL must return mbox output." (file-exists-p file)) (insert-file-contents file) (url-insert-file-contents (format mbox-url id))))) - (goto-char (point-min)) ;; Add the debbugs address so that we can respond to reports easily. - (while (re-search-forward "^To: " nil t) - (end-of-line) - (insert (format ", %s@%s" (car ids) - (replace-regexp-in-string - "/.*$" "" - (replace-regexp-in-string "^http://" "" mbox-url))))))) + (let ((address + (format "%s@%s" (car ids) + (replace-regexp-in-string + "/.*$" "" + (replace-regexp-in-string "^http://" "" mbox-url))))) + (goto-char (point-min)) + (while (re-search-forward (concat "^" message-unix-mail-delimiter) + nil t) + (narrow-to-region (point) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (unless (string-match (concat "\\(?:\\`\\|[ ,<]\\)" + (regexp-quote address) + "\\(?:\\'\\|[ ,>]\\)") + (concat (message-fetch-field "to") " " + (message-fetch-field "cc"))) + (goto-char (point-min)) + (if (re-search-forward "^To:" nil t) + (progn + (message-next-header) + (skip-chars-backward "\t\n ") + (insert ", " address)) + (insert "To: " address "\n"))) + (goto-char (point-max)) + (widen))))) (gnus-group-read-ephemeral-group (format "nndoc+ephemeral:bug#%s" (mapconcat 'number-to-string ids ",")) commit 94a50646751566b397b5454bcd423361755a9e1c Author: Stefan Monnier Date: Thu Mar 2 02:23:45 2017 -0500 * lisp/cedet/semantic/db-global.el: Make dynbind use explicit (semanticdb--ih): Declare. (semanticdb-enable-gnu-global-databases): Use it instead of `ih'. (semanticdb-enable-gnu-global-in-buffer, semanticdb-get-database-tables) (semanticdb-find-tags-for-completion-method): Silence compiler warning. diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el index 61af619b29..0afa6619d2 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -39,6 +39,8 @@ ;;; Code: +(defvar semanticdb--ih) + ;;;###autoload (defun semanticdb-enable-gnu-global-databases (mode &optional noerror) "Enable the use of the GNU Global SemanticDB back end for all files of MODE. @@ -64,10 +66,10 @@ values." (when (stringp mode) (setq mode (intern mode))) - (let ((ih (mode-local-value mode 'semantic-init-mode-hook))) + (let ((semanticdb--ih (mode-local-value mode 'semantic-init-mode-hook))) (eval `(setq-mode-local ,mode semantic-init-mode-hook - (cons 'semanticdb-enable-gnu-global-hook ih)))) + (cons 'semanticdb-enable-gnu-global-hook semanticdb--ih)))) t ) ) @@ -94,7 +96,7 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error." (setq ;; Add to the system database list. semanticdb-project-system-databases - (cons (semanticdb-project-database-global "global") + (cons (make-instance 'semanticdb-project-database-global) semanticdb-project-system-databases) ;; Apply the throttle. semanticdb-find-default-throttle @@ -132,7 +134,7 @@ For each file hit, get the traditional semantic table from that file." ;; We need to return something since there is always the "master table" ;; The table can then answer file name type questions. (when (not (slot-boundp obj 'tables)) - (let ((newtable (semanticdb-table-global "GNU Global Search Table"))) + (let ((newtable (make-instance 'semanticdb-table-global))) (oset obj tables (list newtable)) (oset newtable parent-db obj) (oset newtable tags nil) @@ -191,7 +193,7 @@ Returns a table of all matching tags." (faketags nil) ) (when result - (dolist (T (oref result :hit-text)) + (dolist (T (oref result hit-text)) ;; We should look up each tag one at a time, but I'm lazy! ;; Doing this may be good enough. (setq faketags (cons commit 2c18969c810f338d73beda592ee5af7103132e97 Author: Stefan Monnier Date: Thu Mar 2 02:08:08 2017 -0500 * lisp/help-fns.el (describe-variable): Use cl-print for the value Use `pp-buffer' rather than `pp' so as to avoid calling prin1 twice. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 21f76e100a..69a6113eda 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -391,12 +391,12 @@ suitable file is found, return nil." ;; If lots of ordinary text characters run this command, ;; don't mention them one by one. (if (< (length non-modified-keys) 10) - (princ (mapconcat 'key-description keys ", ")) + (princ (mapconcat #'key-description keys ", ")) (dolist (key non-modified-keys) (setq keys (delq key keys))) (if keys (progn - (princ (mapconcat 'key-description keys ", ")) + (princ (mapconcat #'key-description keys ", ")) (princ ", and many ordinary text characters")) (princ "many ordinary text characters")))) (when (or remapped keys non-modified-keys) @@ -842,15 +842,22 @@ it is displayed along with the global value." (let ((line-beg (line-beginning-position)) (print-rep (let ((rep - (let ((print-quoted t)) - (prin1-to-string val)))) + (let ((print-quoted t) + (print-circle t)) + (cl-prin1-to-string val)))) (if (and (symbolp val) (not (booleanp val))) (format-message "`%s'" rep) rep)))) (if (< (+ (length print-rep) (point) (- line-beg)) 68) (insert " " print-rep) (terpri) - (pp val) + (let ((buf (current-buffer))) + (with-temp-buffer + (insert print-rep) + (pp-buffer) + (let ((pp-buffer (current-buffer))) + (with-current-buffer buf + (insert-buffer-substring pp-buffer))))) ;; Remove trailing newline. (and (= (char-before) ?\n) (delete-char -1))) (let* ((sv (get variable 'standard-value)) commit 41f91d367ac2ecac253057ff38589e8393cbeffd Author: Glenn Morris Date: Wed Mar 1 20:36:19 2017 -0500 * test/lisp/net/puny.el: New file. diff --git a/test/lisp/net/puny.el b/test/lisp/net/puny.el new file mode 100644 index 0000000000..b119e45d65 --- /dev/null +++ b/test/lisp/net/puny.el @@ -0,0 +1,41 @@ +;;; puny.el --- tests for net/puny.el -*- coding: utf-8; -*- + +;; Copyright (C) 2017 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) +(require 'puny) + +(ert-deftest puny-test-encode () + "Test puny encoding." + (should (string= (puny-encode-string "bücher") "xn--bcher-kva"))) + +(ert-deftest puny-test-decode () + "Test puny decoding." + (should (string= (puny-decode-string "xn--bcher-kva") "bücher"))) + +(ert-deftest puny-test-encode2 () + "Test puny encoding." + (should (string= (puny-encode-string "חנוך") "xn--9dbdkw"))) + +(ert-deftest puny-test-decode2 () + "Test puny decoding." + (should (string= (puny-decode-string "xn--9dbdkw") "חנוך"))) + +;;; puny.el ends here commit 8c1e16bee492f7f8776805cfc051801e3da5cd20 Author: Glenn Morris Date: Wed Mar 1 20:35:41 2017 -0500 Small puny.el fix * lisp/net/puny.el (puny-decode-string-internal): Handle strings with no ascii parts. (Bug#23688) diff --git a/lisp/net/puny.el b/lisp/net/puny.el index c718d958be..bdd59be070 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -150,10 +150,12 @@ For instance \"xn--bcher-kva\" => \"bücher\"." (defun puny-decode-string-internal (string) (with-temp-buffer (insert string) - (goto-char (point-max)) - (search-backward "-" nil (point-min)) - ;; The encoded chars are after the final dash. - (let ((encoded (buffer-substring (1+ (point)) (point-max))) + ;; The encoded chars are after any final dash, else the whole string. + (let ((encoded (buffer-substring + (if (search-backward "-" nil 'move) + (1+ (point)) + (point)) + (point-max))) (ic 0) (i 0) (bias puny-initial-bias) commit 8244357283b740adacaa4526c0ea60349b0a93bb Author: Glenn Morris Date: Wed Mar 1 18:29:48 2017 -0500 Small recover-this-file improvement * lisp/files.el (recover-this-file): Explicit error if not visiting a file. (Bug#23671) diff --git a/lisp/files.el b/lisp/files.el index 7c9271e2f4..c7de4453d7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5838,6 +5838,8 @@ an auto-save file." (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) + (or buffer-file-name + (user-error "This buffer is not visiting a file")) (recover-file buffer-file-name)) (defun recover-file (file) commit 79abec2feefa6169b8073cacde98a02d8087c19b Author: Glenn Morris Date: Wed Mar 1 16:53:08 2017 -0500 Fix for coding-system completion (bug#23670) * lisp/international/mule.el (read-buffer-file-coding-system): Ensure that completion-pcm--delim-wild-regex is enclosed in parens, so that completion-pcm--pattern->regex can append "*?". diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 8754f7f27d..fa3ad80e2f 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1311,8 +1311,8 @@ Internal use only.") preferred)))))) (completion-ignore-case t) (completion-pcm--delim-wild-regex ; Let "u8" complete to "utf-8". - (concat completion-pcm--delim-wild-regex - "\\|\\([[:alpha:]]\\)[[:digit:]]")) + (concat "\\(?:" completion-pcm--delim-wild-regex + "\\|\\([[:alpha:]]\\)[[:digit:]]\\)")) (cs (completing-read (format "Coding system for saving file (default %s): " default) combined-table commit 207ee94b1d1f3cbe5ddd87a4cdfae17e5ad8419d Author: Paul Eggert Date: Wed Mar 1 12:29:37 2017 -0800 Fix rounding error in ‘ceiling’ etc. Without this fix, (ceiling most-negative-fixnum -1.0) returns most-negative-fixnum instead of correctly signaling range-error, and similarly for floor, round, and truncate. * configure.ac (trunc): Add a check, since Gnulib’s doc says ‘trunc’ is missing from MSVC 9. The Gnulib doc says ‘trunc’ is also missing from some other older operating systems like Solaris 9 which I know we don’t care about any more, so MSVC is the only reason to worry about ‘trunc’ here. * src/editfns.c (styled_format): Formatting a float with %c is now an error. The old code did not work in general, because FIXNUM_OVERFLOW_P had rounding errors. Besides, the "if (FLOATP (...))" was in there only as a result of my misunderstanding old code that I introduced 2011. Although %d etc. is sometimes used on floats that represent huge UIDs or PIDs etc. that do not fit in fixnums, this cannot happen with characters. * src/floatfns.c (rounding_driver): Rework to do the right thing when the intermediate result equals 2.305843009213694e+18, i.e., is exactly 1 greater than MOST_POSITIVE_FIXNUM on a 64-bit host. Simplify so that only one section of code checks for overflow, rather than two. (double_identity): Remove. All uses changed to ... (emacs_trunc): ... this new function. Add replacement for platforms that lack ‘trunc’. * src/lisp.h (FIXNUM_OVERFLOW_P, make_fixnum_or_float): Make it clear that the arg cannot be floating point. * test/src/editfns-tests.el (format-c-float): New test. * test/src/floatfns-tests.el: New file, to test for this bug. diff --git a/configure.ac b/configure.ac index dcba7eb2c2..6926076fad 100644 --- a/configure.ac +++ b/configure.ac @@ -3881,7 +3881,7 @@ OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ getrusage get_current_dir_name \ -lrand48 random rint \ +lrand48 random rint trunc \ select getpagesize setlocale newlocale \ getrlimit setrlimit shutdown \ pthread_sigmask strsignal setitimer \ diff --git a/src/editfns.c b/src/editfns.c index 4618164d00..e3c8548b5a 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4119,12 +4119,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } else if (conversion == 'c') { - if (FLOATP (args[n])) - { - double d = XFLOAT_DATA (args[n]); - args[n] = make_number (FIXNUM_OVERFLOW_P (d) ? -1 : d); - } - if (INTEGERP (args[n]) && ! ASCII_CHAR_P (XINT (args[n]))) { if (!multibyte) @@ -4241,7 +4235,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) || conversion == 'X')) error ("Invalid format operation %%%c", STRING_CHAR ((unsigned char *) format - 1)); - else if (! NUMBERP (args[n])) + else if (! (INTEGERP (args[n]) + || (FLOATP (args[n]) && conversion != 'c'))) error ("Format specifier doesn't match argument type"); else { diff --git a/src/floatfns.c b/src/floatfns.c index c476627b33..96711faff6 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -36,7 +36,7 @@ along with GNU Emacs. If not, see . */ isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb (approximately), lrint/llrint, lround/llround, nan, nearbyint, nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, - scalbn, signbit, tgamma, trunc. + scalbn, signbit, tgamma, *trunc. */ #include @@ -333,47 +333,42 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, { CHECK_NUMBER_OR_FLOAT (arg); - if (! NILP (divisor)) + double d; + if (NILP (divisor)) + { + if (! FLOATP (arg)) + return arg; + d = XFLOAT_DATA (arg); + } + else { - EMACS_INT i1, i2; - CHECK_NUMBER_OR_FLOAT (divisor); - - if (FLOATP (arg) || FLOATP (divisor)) + if (!FLOATP (arg) && !FLOATP (divisor)) { - double f1, f2; - - f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); - f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); - if (! IEEE_FLOATING_POINT && f2 == 0) + if (XINT (divisor) == 0) xsignal0 (Qarith_error); - - f1 = (*double_round) (f1 / f2); - if (FIXNUM_OVERFLOW_P (f1)) - xsignal3 (Qrange_error, build_string (name), arg, divisor); - arg = make_number (f1); - return arg; + return make_number (int_round2 (XINT (arg), XINT (divisor))); } - i1 = XINT (arg); - i2 = XINT (divisor); - - if (i2 == 0) + double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); + double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor); + if (! IEEE_FLOATING_POINT && f2 == 0) xsignal0 (Qarith_error); - - XSETINT (arg, (*int_round2) (i1, i2)); - return arg; + d = f1 / f2; } - if (FLOATP (arg)) + /* Round, coarsely test for fixnum overflow before converting to + EMACS_INT (to avoid undefined C behavior), and then exactly test + for overflow after converting (as FIXNUM_OVERFLOW_P is inaccurate + on floats). */ + double dr = double_round (d); + if (fabs (dr) < 2 * (MOST_POSITIVE_FIXNUM + 1)) { - double d = (*double_round) (XFLOAT_DATA (arg)); - if (FIXNUM_OVERFLOW_P (d)) - xsignal2 (Qrange_error, build_string (name), arg); - arg = make_number (d); + EMACS_INT ir = dr; + if (! FIXNUM_OVERFLOW_P (ir)) + return make_number (ir); } - - return arg; + xsignal2 (Qrange_error, build_string (name), arg); } static EMACS_INT @@ -423,11 +418,15 @@ emacs_rint (double d) } #endif +#ifdef HAVE_TRUNC +#define emacs_trunc trunc +#else static double -double_identity (double d) +emacs_trunc (double d) { - return d; + return (d < 0 ? ceil : floor) (d); } +#endif DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, doc: /* Return the smallest integer no less than ARG. @@ -466,7 +465,7 @@ Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR. */) (Lisp_Object arg, Lisp_Object divisor) { - return rounding_driver (arg, divisor, double_identity, truncate2, + return rounding_driver (arg, divisor, emacs_trunc, truncate2, "truncate"); } diff --git a/src/lisp.h b/src/lisp.h index 238c20bc18..a757dfdbb3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1031,9 +1031,7 @@ INLINE bool return lisp_h_EQ (x, y); } -/* Value is true if I doesn't fit into a Lisp fixnum. It is - written this way so that it also works if I is of unsigned - type or if I is a NaN. */ +/* True if the possibly-unsigned integer I doesn't fit in a Lisp fixnum. */ #define FIXNUM_OVERFLOW_P(i) \ (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM)) @@ -4374,8 +4372,8 @@ extern void init_system_name (void); because 'abs' is reserved by the C standard. */ #define eabs(x) ((x) < 0 ? -(x) : (x)) -/* Return a fixnum or float, depending on whether VAL fits in a Lisp - fixnum. */ +/* Return a fixnum or float, depending on whether the integer VAL fits + in a Lisp fixnum. */ #define make_fixnum_or_float(val) \ (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 7b4f41aab5..14124ef85f 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -133,4 +133,7 @@ (should (string= (buffer-string) "éä\"ba÷")) (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10))))) +(ert-deftest format-c-float () + (should-error (format "%c" 0.5))) + ;;; editfns-tests.el ends here diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el new file mode 100644 index 0000000000..a2116a5945 --- /dev/null +++ b/test/src/floatfns-tests.el @@ -0,0 +1,28 @@ +;;; floatfn-tests.el --- tests for floating point operations + +;; Copyright 2017 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 . + +(require 'ert) + +(ert-deftest divide-extreme-sign () + (should-error (ceiling most-negative-fixnum -1.0)) + (should-error (floor most-negative-fixnum -1.0)) + (should-error (round most-negative-fixnum -1.0)) + (should-error (truncate most-negative-fixnum -1.0))) + +(provide 'floatfns-tests) commit ebb105054a421faff17ee11f0cbcbed87661dd11 Author: Glenn Morris Date: Wed Mar 1 14:35:29 2017 -0500 Small help--loaded-p fix * lisp/help-fns.el (help--loaded-p): Handle entry in load-history with nil file name. (Bug#25847) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 742c66919a..21f76e100a 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -73,7 +73,7 @@ The functions will receive the function name as argument.") (let* ((re (load-history-regexp file)) (done nil)) (dolist (x load-history) - (if (string-match-p re (car x)) (setq done t))) + (and (car x) (string-match-p re (car x)) (setq done t))) done))) (defun help--load-prefixes (prefixes)