commit 5a3e96b17c2a948ac952295962dc6e281ec5cad5 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Nov 23 15:47:28 2019 -0800 Add eassert check for bad default face * src/xdisp.c (append_space_for_newline): Add an eassert check that default_face is not null, by calling FACE_FROM_ID instead of FACE_FROM_ID_OR_NULL. Initialize a local only if needed. diff --git a/src/xdisp.c b/src/xdisp.c index 593aaa73ac..2b4dda2715 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21395,12 +21395,12 @@ append_space_for_newline (struct it *it, bool default_face_p) { const int local_default_face_id = lookup_basic_face (it->w, it->f, DEFAULT_FACE_ID); - struct face* default_face = - FACE_FROM_ID_OR_NULL (it->f, local_default_face_id); #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (it->f)) { + struct face *default_face + = FACE_FROM_ID (it->f, local_default_face_id); struct font *font = (default_face->font ? default_face->font : FRAME_FONT (it->f)); commit 603a7c8a84a282e8610b5a5a842e5ba235d3b546 Author: Paul Eggert Date: Sat Nov 23 15:28:45 2019 -0800 Port gnutls.c to --enable-gcc-warnings --without-gnutls * src/gnutls.c: Move the "#ifdef HAVE_GNUTLS" earlier, so that "./configure --enable-gcc-warnings --without-gnutls" does not complain about macros being defined but never used. Indent "#" directives more consistently. diff --git a/src/gnutls.c b/src/gnutls.c index 5f412b5004..ae7a5f27c0 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -27,40 +27,42 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "pdumper.h" -#if GNUTLS_VERSION_NUMBER >= 0x030014 -# define HAVE_GNUTLS_X509_SYSTEM_TRUST -#endif +#ifdef HAVE_GNUTLS -#if GNUTLS_VERSION_NUMBER >= 0x030200 -# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030014 +# define HAVE_GNUTLS_X509_SYSTEM_TRUST +# endif -#if GNUTLS_VERSION_NUMBER >= 0x030202 -# define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE -# define HAVE_GNUTLS_DIGEST_LIST /* also gnutls_digest_get_name */ -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030200 +# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE +# endif -#if GNUTLS_VERSION_NUMBER >= 0x030205 -# define HAVE_GNUTLS_EXT__DUMBFW -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030202 +# define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE +# define HAVE_GNUTLS_DIGEST_LIST /* also gnutls_digest_get_name */ +# endif -#if GNUTLS_VERSION_NUMBER >= 0x030400 -# define HAVE_GNUTLS_ETM_STATUS -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030205 +# define HAVE_GNUTLS_EXT__DUMBFW +# endif -#if GNUTLS_VERSION_NUMBER < 0x030600 -# define HAVE_GNUTLS_COMPRESSION_GET -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030400 +# define HAVE_GNUTLS_ETM_STATUS +# endif + +# if GNUTLS_VERSION_NUMBER < 0x030600 +# define HAVE_GNUTLS_COMPRESSION_GET +# endif /* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was exported only since 3.3.0. */ -#if GNUTLS_VERSION_NUMBER >= 0x030300 -# define HAVE_GNUTLS_MAC_GET_NONCE_SIZE -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030300 +# define HAVE_GNUTLS_MAC_GET_NONCE_SIZE +# endif -#if GNUTLS_VERSION_NUMBER >= 0x030501 -# define HAVE_GNUTLS_EXT_GET_NAME -#endif +# if GNUTLS_VERSION_NUMBER >= 0x030501 +# define HAVE_GNUTLS_EXT_GET_NAME +# endif /* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, it was broken through at least GnuTLS 3.4.10; see: @@ -68,11 +70,9 @@ along with GNU Emacs. If not, see . */ The relevant fix seems to have been made in GnuTLS 3.5.1; see: https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d So, require 3.5.1. */ -#if GNUTLS_VERSION_NUMBER >= 0x030501 -# define HAVE_GNUTLS_AEAD -#endif - -#ifdef HAVE_GNUTLS +# if GNUTLS_VERSION_NUMBER >= 0x030501 +# define HAVE_GNUTLS_AEAD +# endif # ifdef WINDOWSNT # include @@ -221,12 +221,12 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); -#ifdef HAVE_GNUTLS_COMPRESSION_GET +# ifdef HAVE_GNUTLS_COMPRESSION_GET DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_compression_get_name, (gnutls_compression_method_t)); -#endif +# endif DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t)); # ifdef HAVE_GNUTLS3 @@ -1408,11 +1408,11 @@ returned as the :certificate entry. */) if (verification & GNUTLS_CERT_EXPIRED) warnings = Fcons (intern (":expired"), warnings); -#if GNUTLS_VERSION_NUMBER >= 0x030100 +# if GNUTLS_VERSION_NUMBER >= 0x030100 if (verification & GNUTLS_CERT_SIGNATURE_FAILURE) warnings = Fcons (intern (":signature-failure"), warnings); -# if GNUTLS_VERSION_NUMBER >= 0x030114 +# if GNUTLS_VERSION_NUMBER >= 0x030114 if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED) warnings = Fcons (intern (":revocation-data-superseded"), warnings); @@ -1422,20 +1422,20 @@ returned as the :certificate entry. */) if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE) warnings = Fcons (intern (":signer-constraints-failure"), warnings); -# if GNUTLS_VERSION_NUMBER >= 0x030400 +# if GNUTLS_VERSION_NUMBER >= 0x030400 if (verification & GNUTLS_CERT_PURPOSE_MISMATCH) warnings = Fcons (intern (":purpose-mismatch"), warnings); -# if GNUTLS_VERSION_NUMBER >= 0x030501 +# if GNUTLS_VERSION_NUMBER >= 0x030501 if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS) warnings = Fcons (intern (":missing-ocsp-status"), warnings); if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS) warnings = Fcons (intern (":invalid-ocsp-status"), warnings); +# endif # endif # endif # endif -#endif if (XPROCESS (proc)->gnutls_extra_peer_verification & CERTIFICATE_NOT_MATCHING) @@ -1505,19 +1505,19 @@ returned as the :certificate entry. */) (gnutls_mac_get (state))))); /* Compression name. */ -#ifdef HAVE_GNUTLS_COMPRESSION_GET +# ifdef HAVE_GNUTLS_COMPRESSION_GET result = nconc2 (result, list2 (intern (":compression"), build_string (gnutls_compression_get_name (gnutls_compression_get (state))))); -#endif +# endif /* Encrypt-then-MAC. */ -#ifdef HAVE_GNUTLS_ETM_STATUS +# ifdef HAVE_GNUTLS_ETM_STATUS result = nconc2 (result, list2 (intern (":encrypt-then-mac"), gnutls_session_etm_status (state) ? Qt : Qnil)); -#endif +# endif /* Renegotiation Indication */ if (proto <= GNUTLS_TLS1_2) commit c2bd42833f7f9881f52fe9a29d66ac64bc71f776 Author: Juanma Barranquero Date: Sat Nov 23 23:32:33 2019 +0100 Rework previous fix to bug#38222 * lisp/help.el (help--doc-without-fn): Remove. (describe-mode): Use help-split-fundoc instead. diff --git a/lisp/help.el b/lisp/help.el index 06264ae2f3..c4402ece4e 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -878,10 +878,6 @@ current buffer." (princ ", which is ") (describe-function-1 defn))))))) -(defun help--doc-without-fn (mode) - ;; Remove the (fn...) thingy at the end of the docstring - (replace-regexp-in-string "\n\n(fn[^)]*?)\\'" "" (documentation mode))) - (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. A brief summary of the minor modes comes first, followed by the @@ -955,7 +951,8 @@ documentation for the major and minor modes of that buffer." "no indicator" (format "indicator%s" indicator)))) - (princ (help--doc-without-fn mode-function))) + (princ (help-split-fundoc (documentation mode-function) + nil 'doc))) (insert-button pretty-minor-mode 'action (car help-button-cache) 'follow-link t @@ -985,7 +982,7 @@ documentation for the major and minor modes of that buffer." nil t) (help-xref-button 1 'help-function-def mode file-name))))) (princ ":\n") - (princ (help--doc-without-fn major-mode))))) + (princ (help-split-fundoc (documentation major-mode) nil 'doc))))) ;; For the sake of IELM and maybe others nil) commit 6f3ff47c521a41f3eab3efd1f6126f06f4171478 Author: Juanma Barranquero Date: Sat Nov 23 23:29:53 2019 +0100 Make help-split-fundoc more flexible about what returns * lisp/help.el (help-split-fundoc): New arg SECTION to return only the usage or doc parts of the docstring, or both even if there is no usage. * test/lisp/help-tests.el: New file. diff --git a/lisp/help.el b/lisp/help.el index 22f35df1de..06264ae2f3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1380,27 +1380,39 @@ The result, when formatted by `substitute-command-keys', should equal STRING." ;; But for various reasons, they are more widely needed, so they were ;; moved to this file, which is preloaded. https://debbugs.gnu.org/17001 -(defun help-split-fundoc (docstring def) +(defun help-split-fundoc (docstring def &optional section) "Split a function DOCSTRING into the actual doc and the usage info. -Return (USAGE . DOC) or nil if there's no usage info, where USAGE info -is a string describing the argument list of DEF, such as -\"(apply FUNCTION &rest ARGUMENTS)\". -DEF is the function whose usage we're looking for in DOCSTRING." +Return (USAGE . DOC), where USAGE is a string describing the argument +list of DEF, such as \"(apply FUNCTION &rest ARGUMENTS)\". +DEF is the function whose usage we're looking for in DOCSTRING. +With SECTION nil, return nil if there is no usage info; conversely, +SECTION t means to return (USAGE . DOC) even if there's no usage info. +When SECTION is \\='usage or \\='doc, return only that part." ;; Functions can get the calling sequence at the end of the doc string. ;; In cases where `function' has been fset to a subr we can't search for ;; function's name in the doc string so we use `fn' as the anonymous ;; function name instead. - (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)) - (let ((doc (unless (zerop (match-beginning 0)) - (substring docstring 0 (match-beginning 0)))) - (usage-tail (match-string 1 docstring))) - (cons (format "(%s%s" - ;; Replace `fn' with the actual function name. - (if (symbolp def) - (help--docstring-quote (format "%S" def)) - 'anonymous) - usage-tail) - doc)))) + (let* ((found (and docstring + (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))) + (doc (if found + (and (memq section '(t nil doc)) + (not (zerop (match-beginning 0))) + (substring docstring 0 (match-beginning 0))) + docstring)) + (usage (and found + (memq section '(t nil usage)) + (let ((tail (match-string 1 docstring))) + (format "(%s%s" + ;; Replace `fn' with the actual function name. + (if (and (symbolp def) def) + (help--docstring-quote (format "%S" def)) + 'anonymous) + tail))))) + (pcase section + (`nil (and usage (cons usage doc))) + (`t (cons usage doc)) + (`usage usage) + (`doc doc)))) (defun help-add-fundoc-usage (docstring arglist) "Add the usage info to DOCSTRING. diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el new file mode 100644 index 0000000000..28dd8830e4 --- /dev/null +++ b/test/lisp/help-tests.el @@ -0,0 +1,56 @@ +;;; help-tests.el --- Tests for help.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; Author: Juanma Barranquero +;; Keywords: help, internal + +;; 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) + +(ert-deftest help-split-fundoc-SECTION () + "Test new optional arg SECTION." + (let* ((doc "Doc first line.\nDoc second line.") + (usg "\n\n(fn ARG1 &optional ARG2)") + (full (concat doc usg)) + (usage "(t ARG1 &optional ARG2)")) + ;; Docstring has both usage and doc + (should (equal (help-split-fundoc full t nil) `(,usage . ,doc))) + (should (equal (help-split-fundoc full t t) `(,usage . ,doc))) + (should (equal (help-split-fundoc full t 'usage) usage)) + (should (equal (help-split-fundoc full t 'doc) doc)) + ;; Docstring has no usage, only doc + (should (equal (help-split-fundoc doc t nil) nil)) + (should (equal (help-split-fundoc doc t t) `(nil . ,doc))) + (should (equal (help-split-fundoc doc t 'usage) nil)) + (should (equal (help-split-fundoc doc t 'doc) doc)) + ;; Docstring is only usage, no doc + (should (equal (help-split-fundoc usg t nil) `(,usage . nil))) + (should (equal (help-split-fundoc usg t t) `(,usage . nil))) + (should (equal (help-split-fundoc usg t 'usage) usage)) + (should (equal (help-split-fundoc usg t 'doc) nil)) + ;; Docstring is null + (should (equal (help-split-fundoc nil t nil) nil)) + (should (equal (help-split-fundoc nil t t) '(nil))) + (should (equal (help-split-fundoc nil t 'usage) nil)) + (should (equal (help-split-fundoc nil t 'doc) nil)))) + +(provide 'help-tests) + +;;; help-tests.el ends here commit 4b5d04be44af36cb2faccd368de063cf376282ca Author: Juri Linkov Date: Sun Nov 24 00:22:46 2019 +0200 Use new macro debounce-reduce to make mouse scaling of images more responsive * lisp/emacs-lisp/timer.el (debounce, debounce-reduce): New macros. * lisp/image.el (image-increase-size, image-decrease-size): Use funcall to call image--change-size-function. (image--change-size-function): Move code from defun of image--change-size to defvar that has the value of lambda returned from debounce-reduce. (Bug#38187) diff --git a/etc/NEWS b/etc/NEWS index 3bf4c81014..819637b79f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2796,6 +2796,11 @@ doing computations on a decoded time structure), 'make-decoded-time' filled out), and 'encoded-time-set-defaults' (which fills in nil elements as if it's midnight January 1st, 1970) have been added. +** New macros 'debounce' and 'debounce-reduce' postpone function call +until after specified time have elapsed since the last time it was invoked. +This improves performance of processing events occurring rapidly +in quick succession. + ** 'define-minor-mode' automatically documents the meaning of ARG. +++ diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 561cc70078..5fdf9a426a 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -488,6 +488,50 @@ The argument should be a value previously returned by `with-timeout-suspend'." If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." (with-timeout (seconds default-value) (y-or-n-p prompt))) + +(defmacro debounce (secs function) + "Call FUNCTION after SECS seconds have elapsed. +Postpone FUNCTION call until after SECS seconds have elapsed since the +last time it was invoked. On consecutive calls within the interval of +SECS seconds, cancel all previous calls that occur rapidly in quick succession, +and execute only the last call. This improves performance of event processing." + (declare (indent 1) (debug t)) + (let ((timer-sym (make-symbol "timer"))) + `(let (,timer-sym) + (lambda (&rest args) + (when (timerp ,timer-sym) + (cancel-timer ,timer-sym)) + (setq ,timer-sym + (run-with-timer + ,secs nil (lambda () + (apply ,function args)))))))) + +(defmacro debounce-reduce (secs initial-state state-function function) + "Call FUNCTION after SECS seconds have elapsed. +Postpone FUNCTION call until after SECS seconds have elapsed since the +last time it was invoked. On consecutive calls within the interval of +SECS seconds, cancel all previous calls that occur rapidly in quick succession, +and execute only the last call. This improves performance of event processing. + +STATE-FUNCTION can be used to accumulate the state on consecutive calls +starting with the value of INITIAL-STATE, and then execute the last call +with the collected state value." + (declare (indent 1) (debug t)) + (let ((timer-sym (make-symbol "timer")) + (state-sym (make-symbol "state"))) + `(let (,timer-sym (,state-sym ,initial-state)) + (lambda (&rest args) + (setq ,state-sym (apply ,state-function ,state-sym args)) + (when (timerp ,timer-sym) + (cancel-timer ,timer-sym)) + (setq ,timer-sym + (run-with-timer + ,secs nil (lambda () + (apply ,function (if (listp ,state-sym) + ,state-sym + (list ,state-sym))) + (setq ,state-sym ,initial-state)))))))) + (defconst timer-duration-words (list (cons "microsec" 0.000001) diff --git a/lisp/image.el b/lisp/image.el index 6e19f17fd2..c430478232 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1017,18 +1017,20 @@ has no effect." If N is 3, then the image size will be increased by 30%. The default is 20%." (interactive "P") - (image--change-size (if n - (1+ (/ (prefix-numeric-value n) 10.0)) - 1.2))) + (funcall image--change-size-function + (if n + (1+ (/ (prefix-numeric-value n) 10.0)) + 1.2))) (defun image-decrease-size (&optional n) "Decrease the image size by a factor of N. If N is 3, then the image size will be decreased by 30%. The default is 20%." (interactive "P") - (image--change-size (if n - (- 1 (/ (prefix-numeric-value n) 10.0)) - 0.8))) + (funcall image--change-size-function + (if n + (- 1 (/ (prefix-numeric-value n) 10.0)) + 0.8))) (defun image-mouse-increase-size (&optional event) "Increase the image size using the mouse." @@ -1063,12 +1065,16 @@ default is 20%." (plist-put (cdr image) :type 'imagemagick)) image)) -(defun image--change-size (factor) - (let* ((image (image--get-imagemagick-and-warn)) - (new-image (image--image-without-parameters image)) - (scale (image--current-scaling image new-image))) - (setcdr image (cdr new-image)) - (plist-put (cdr image) :scale (* scale factor)))) +(defvar image--change-size-function + (debounce-reduce 0.3 1 + (lambda (state factor) + (* state factor)) + (lambda (factor) + (let* ((image (image--get-imagemagick-and-warn)) + (new-image (image--image-without-parameters image)) + (scale (image--current-scaling image new-image))) + (setcdr image (cdr new-image)) + (plist-put (cdr image) :scale (* scale factor)))))) (defun image--image-without-parameters (image) (cons (pop image) commit 8934762bb37273e6606097de92dcc2556456acd2 Author: Robert Pluim Date: Mon Nov 18 10:48:29 2019 +0100 Default network-stream-use-client-certificates to nil * lisp/net/network-stream.el (network-stream-use-client-certificates): Default to nil. (open-network-stream): Adapt description to new default of network-stream-use-client-certificates. * etc/NEWS: network-stream-use-client-certificates defaults to nil now. * doc/lispref/processes.texi (Network): Flip network-stream-use-client-certificates description. * doc/misc/auth.texi (Help for users): Mention network-stream-use-client-certificates. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 5caf0a2426..fc5832253f 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2521,11 +2521,11 @@ expect the network traffic to be encrypted. Either a list of the form @code{(@var{key-file} @var{cert-file})}, naming the certificate key file and certificate file itself, or @code{t}, meaning to query @code{auth-source} for this information -(@pxref{Help for users,,auth-source, auth, Emacs auth-source Library}). -Only used for @acronym{TLS} or @acronym{STARTTLS}. If -@code{:client-certificate} is not specified, behave as if it were t, -customize @code{network-stream-use-client-certificates} to change -this. +(@pxref{Help for users,,auth-source, auth, Emacs auth-source +Library}). Only used for @acronym{TLS} or @acronym{STARTTLS}. To +enable automatic queries of @code{auth-source} when +@code{:client-certificate} is not specified customize +@code{network-stream-use-client-certificates} to t. @item :return-list @var{cons-or-nil} The return value of this function. If omitted or @code{nil}, return a diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 93a301dcb1..415a64f021 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -92,6 +92,7 @@ backends and you can write your own if you want. @chapter Help for users ``Netrc'' files are a de facto standard. They look like this: + @example machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} @end example @@ -108,12 +109,16 @@ The @code{user} is the user name. It's known as @var{:user} in You can also use this file to specify client certificates to use when setting up TLS connections. The format is: + @example machine @var{mymachine} port @var{myport} key @var{key} cert @var{cert} @end example @var{key} and @var{cert} are filenames containing the key and -certificate to use respectively. +certificate to use respectively. In order to make network connections +use them automatically, either pass @code{:client-certificate t} to +@code{open-network-stream}, or customize +@code{network-stream-use-client-certificates} to @code{t}. You can use spaces inside a password or other token by surrounding the token with either single or double quotes. diff --git a/etc/NEWS b/etc/NEWS index a872a8f6b5..3bf4c81014 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -341,7 +341,8 @@ certificates via 'auth-source'. ** New user option 'network-stream-use-client-certificates'. When non-nil, 'open-network-stream' performs lookups of client certificates using 'auth-source' as if ':client-certificate t' were -specified. Defaults to t. +specified iff there is no explicit ':client-certificate' parameter. +Defaults to nil. +++ ** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1571c76189..9a796d93ab 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -58,7 +58,7 @@ (defvar starttls-gnutls-program) (defvar starttls-program) -(defcustom network-stream-use-client-certificates t +(defcustom network-stream-use-client-certificates nil "Whether to use client certificates for network connections. When non-nil, `open-network-stream' will automatically look for @@ -144,12 +144,12 @@ values: :client-certificate should either be a list where the first element is the certificate key file name, and the second - element is the certificate file name itself, or t, which - means that `auth-source' will be queried for the key and the + element is the certificate file name itself, or t, which means + that `auth-source' will be queried for the key and the certificate. This parameter will only be used when doing TLS - or STARTTLS connections. If :client-certificate is not - specified, behave as if it were t, customize - `network-stream-use-client-certificates' to change this. + or STARTTLS connections. To enable automatic queries of + `auth-source' when `:client-certificate' is not specified + customize `network-stream-use-client-certificates' to t. :use-starttls-if-possible is a boolean that says to do opportunistic STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. commit a27c8929f2ab26dc0d27c8969857d3bc108747f5 Author: Robert Pluim Date: Tue Nov 19 11:33:10 2019 +0100 Have what-cursor-position optionally show character name * lisp/simple.el (what-cursor-show-names): New defcustom, default nil. (what-cursor-position): Show character names if what-cursor-show-names is non-nil. * doc/emacs/basic.texi (Position Info): Add what-cursor-show-names description. * etc/NEWS: Announce what-cursor-show-names. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index d0bd46c35f..5939d45f43 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -696,6 +696,15 @@ position as a percentage of the total. After @samp{column=} is the horizontal position of point, in columns counting from the left edge of the window. +@vindex what-cursor-show-names + If the user option @code{what-cursor-show-names} is non-@code{nil}, +the name of the character, as defined by the Unicode Character +Database, is shown as well. The part in parentheses would then become: + +@smallexample +(99, #o143, #x63, LATIN SMALL LETTER C) +@end smallexample + If the buffer has been narrowed, making some of the text at the beginning and the end temporarily inaccessible, @kbd{C-x =} displays additional text describing the currently accessible range. For diff --git a/etc/NEWS b/etc/NEWS index ad349b1613..a872a8f6b5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -231,6 +231,11 @@ To get the old, less-secure behavior, you can set the *** When run by root, emacsclient no longer connects to non-root sockets. (Instead you can use Tramp methods to run root commands in a non-root Emacs.) ++++ +** New user option 'what-cursor-show-names'. +When non-nil, 'what-cursor-position' will show the name of the character +in addition to the decimal/hex/octal representation. Default nil. + +++ ** New function 'network-lookup-address-info'. This does IPv4 and/or IPv6 address lookups on hostnames. diff --git a/lisp/simple.el b/lisp/simple.el index c61ccd511c..2aac557154 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1389,10 +1389,17 @@ absolute line number." (forward-line 0) (1+ (count-lines start (point))))))) +(defcustom what-cursor-show-names nil + "Whether to show character names in `what-cursor-position'." + :type 'boolean + :version "27.1" + :group 'editing-basics) + (defun what-cursor-position (&optional detail) "Print info on cursor position (on screen and within buffer). -Also describe the character after point, and give its character code -in octal, decimal and hex. +Also describe the character after point, and give its character +code in octal, decimal and hex. If `what-cursor-show-names' is +non-nil, additionally show the name of the character. For a non-ASCII multibyte character, also give its encoding in the buffer's selected coding system if the coding system encodes the @@ -1404,6 +1411,12 @@ In addition, with prefix argument, show details about that character in *Help* buffer. See also the command `describe-char'." (interactive "P") (let* ((char (following-char)) + (char-name (and what-cursor-show-names + (or (get-char-code-property char 'name) + (get-char-code-property char 'old-name)))) + (char-name-fmt (if char-name + (format ", %s" char-name) + "")) (bidi-fixer ;; If the character is one of LRE, LRO, RLE, RLO, it will ;; start a directional embedding, which could completely @@ -1449,7 +1462,7 @@ in *Help* buffer. See also the command `describe-char'." (setq coding (default-value 'buffer-file-coding-system))) (if (eq (char-charset char) 'eight-bit) (setq encoding-msg - (format "(%d, #o%o, #x%x, raw-byte)" char char char)) + (format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt)) ;; Check if the character is displayed with some `display' ;; text property. In that case, set under-display to the ;; buffer substring covered by that property. @@ -1468,17 +1481,17 @@ in *Help* buffer. See also the command `describe-char'." (setq encoding-msg (if display-prop (if (not (stringp display-prop)) - (format "(%d, #o%o, #x%x, part of display \"%s\")" - char char char under-display) - (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")" - char char char under-display display-prop)) + (format "(%d, #o%o, #x%x%s, part of display \"%s\")" + char char char char-name-fmt under-display) + (format "(%d, #o%o, #x%x%s, part of display \"%s\"->\"%s\")" + char char char char-name-fmt under-display display-prop)) (if encoded - (format "(%d, #o%o, #x%x, file %s)" - char char char + (format "(%d, #o%o, #x%x%s, file %s)" + char char char char-name-fmt (if (> (length encoded) 1) "..." (encoded-string-description encoded coding))) - (format "(%d, #o%o, #x%x)" char char char))))) + (format "(%d, #o%o, #x%x%s)" char char char char-name-fmt))))) (if detail ;; We show the detailed information about CHAR. (describe-char (point))) commit b9e99ab5ac49f8cb03fc1c27eb830a24e9bdf83c Author: Christopher Schmidt Date: Sat Nov 23 15:45:56 2019 +0100 Always expand "total" in dired * lisp/files.el (insert-directory): Always replace "total" with "total used in directory", even when we don't have free disk space (bug#13191). This makes the display more consistent. diff --git a/lisp/files.el b/lisp/files.el index 2c45a8b107..a384e7136e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7153,10 +7153,11 @@ normally equivalent short `-D' option is just passed on to (goto-char beg) ;; First find the line to put it on. (when (re-search-forward "^ *\\(total\\)" nil t) + ;; Replace "total" with "total used in directory" to + ;; avoid confusion. + (replace-match "total used in directory" nil nil nil 1) (let ((available (get-free-disk-space "."))) (when available - ;; Replace "total" with "used", to avoid confusion. - (replace-match "total used in directory" nil nil nil 1) (end-of-line) (insert " available " available)))))))))) commit 311ca036f4f6d366747072b518e1026347368f8c Author: Michael Heerdegen Date: Thu Nov 14 17:47:51 2019 +0100 Fix edebug instrumentation removing from advised functions * lisp/emacs-lisp/edebug.el (edebug-remove-instrumentation): Handle advised functions correctly. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5d52704410..d68ed966f8 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4571,6 +4571,21 @@ With prefix argument, make it a temporary breakpoint." ;; Continue standard unloading. nil) +(defun edebug--unwrap*-symbol-function (symbol) + ;; Try to unwrap SYMBOL's `symbol-function'. The result is suitable + ;; to be fbound back to SYMBOL with `defalias'. When no unwrapping + ;; could be done return nil. + (pcase (symbol-function symbol) + ((or (and `(macro . ,f) (let was-macro t)) + (and f (let was-macro nil))) + ;; `defalias' takes care of advises so we must strip them + (let* ((orig-f (advice--cd*r f)) + (unwrapped (edebug-unwrap* orig-f))) + (cond + ((equal unwrapped orig-f) nil) + (was-macro `(macro . ,unwrapped)) + (t unwrapped)))))) + (defun edebug-remove-instrumentation (functions) "Remove Edebug instrumentation from FUNCTIONS. Interactively, the user is prompted for the function to remove @@ -4582,10 +4597,10 @@ instrumentation for, defaulting to all functions." (lambda (symbol) (when (and (get symbol 'edebug) (or (functionp symbol) - (macrop symbol))) - (let ((unwrapped (edebug-unwrap* (symbol-function symbol)))) - (unless (equal unwrapped (symbol-function symbol)) - (push symbol functions))))) + (macrop symbol)) + (edebug--unwrap*-symbol-function + symbol)) + (push symbol functions))) obarray) (unless functions (error "Found no functions to remove instrumentation from")) @@ -4599,8 +4614,9 @@ instrumentation for, defaulting to all functions." functions))))) ;; Remove instrumentation. (dolist (symbol functions) - (setf (symbol-function symbol) - (edebug-unwrap* (symbol-function symbol)))) + (when-let ((unwrapped + (edebug--unwrap*-symbol-function symbol))) + (defalias symbol unwrapped))) (message "Removed edebug instrumentation from %s" (mapconcat #'symbol-name functions ", "))) commit be779cf7b4e513709cef94d7e04d40887b6bdfb2 Author: Eli Zaretskii Date: Sat Nov 23 13:37:28 2019 +0200 Improve indexing of modifier keys * doc/emacs/commands.texi (User Input): Add index entry for the Alt key serving as Meta. * doc/emacs/custom.texi (Modifier Keys): Add index entries for Alt, Super, and Hyper modifier keys. (Bug#38315) diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi index 5eb3b30417..a107b8958b 100644 --- a/doc/emacs/commands.texi +++ b/doc/emacs/commands.texi @@ -42,6 +42,7 @@ are certain characters found on non-English keyboards @cindex C- @cindex META @cindex M- +@cindex Alt key, serving as Meta Emacs also recognizes control characters that are entered using @dfn{modifier keys}. Two commonly-used modifier keys are @key{Control} (usually labeled @key{Ctrl}), and @key{Meta} (usually @@ -64,6 +65,8 @@ next character; instead, press @key{ESC} and release it, then enter the next character. This feature is useful on certain text terminals where the @key{Meta} key does not function reliably. + Emacs supports 3 additional modifier keys, see @ref{Modifier Keys}. + @cindex keys stolen by window manager @cindex window manager, keys stolen by On graphical displays, the window manager might block some keyboard diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 492e15c249..d1cbb299c2 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1919,6 +1919,12 @@ characters case-sensitive (even on non-graphical frames) when you customize Emacs. For instance, you could make @kbd{M-a} and @kbd{M-A} run different commands. +@cindex Alt, modifier key +@cindex Super, modifier key +@cindex Hyper, modifier key +@cindex s- +@cindex H- +@cindex A- Although only the @key{Control} and @key{Meta} modifier keys are commonly used, Emacs supports three other modifier keys. These are called @key{Super}, @key{Hyper}, and @key{Alt}. Few terminals provide commit 1265e947113efe335139038c89c280db480994af Author: Eli Zaretskii Date: Sat Nov 23 12:43:49 2019 +0200 Fix cursor display at EOL before extended face * src/xdisp.c (extend_face_to_end_of_line): Make sure the character position of the stretch glyph inserted to extend the face is zero, as various other parts of the display code rely on that. (Bug#38330) diff --git a/src/xdisp.c b/src/xdisp.c index c5676b3e17..593aaa73ac 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21726,9 +21726,12 @@ extend_face_to_end_of_line (struct it *it) const int stretch_width = it->last_visible_x - it->current_x; if (stretch_width > 0) - append_stretch_glyph (it, Qnil, stretch_width, - it->ascent + it->descent, - stretch_ascent); + { + memset (&it->position, 0, sizeof it->position); + append_stretch_glyph (it, Qnil, stretch_width, + it->ascent + it->descent, + stretch_ascent); + } } it->char_to_display = saved_char; commit c26556bd18f8ca1e891bd1750c9f95b21ea457b0 Author: Eli Zaretskii Date: Sat Nov 23 11:27:43 2019 +0200 Fix and speed up en/decoding of UTF-8 strings * src/coding.c (get_char_bytes, encode_string_utf_8) (decode_string_utf_8): Fix commentary. (encode_string_utf_8): Return the original ASCII string only if NOCOPY is non-zero. (decode_string_utf_8): Accept 2 additional arguments STR and STR_LEN, which allow to pass the input text as a C string. (make_string_from_utf8): Delegate the job to decode_string_utf_8. * src/coding.h: Update the prototype of decode_string_utf_8. * src/json.c (json_encode): Call encode_string_utf_8. diff --git a/src/coding.c b/src/coding.c index 560ec0883f..5f477cf947 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6353,11 +6353,15 @@ utf8_string_p (Lisp_Object string) } /* Like make_string, but always returns a multibyte Lisp string, and - avoids decoding if TEXT encoded in UTF-8. */ - + avoids decoding if TEXT is encoded in UTF-8. */ Lisp_Object make_string_from_utf8 (const char *text, ptrdiff_t nbytes) { +#if 0 + /* This method is on average 2 times slower than if we use + decode_string_utf_8. However, please leave the slower + implementation in the code for now, in case it needs to be reused + in some situations. */ ptrdiff_t chars, bytes; parse_str_as_multibyte ((const unsigned char *) text, nbytes, &chars, &bytes); @@ -6374,6 +6378,9 @@ make_string_from_utf8 (const char *text, ptrdiff_t nbytes) decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qt); return coding.dst_object; } +#else + return decode_string_utf_8 (Qnil, text, nbytes, Qnil, false, Qt, Qt); +#endif } /* Detect how end-of-line of a text of length SRC_BYTES pointed by @@ -9537,7 +9544,7 @@ get_buffer_gap_address (Lisp_Object buffer, ptrdiff_t nbytes) return BUF_GPT_ADDR (buf); } -/* Return a pointer to the byte sequence for C, and set the length in +/* Return a pointer to the byte sequence for C, and its byte length in LEN. This function is used to get a byte sequence for HANDLE_8_BIT and HANDLE_OVER_UNI arguments of encode_string_utf_8 and decode_string_utf_8 when those arguments are given by @@ -9572,11 +9579,16 @@ get_char_bytes (int c, int *len) /* Encode STRING by the coding system utf-8-unix. + This function is optimized for speed when the input string is + already a valid sequence of Unicode codepoints in the internal + representation, i.e. there are neither 8-bit raw bytes nor + characters beyond the Unicode range in the string's contents. + Ignore any :pre-write-conversion and :encode-translation-table - properties of that coding system. + properties. Assume that arguments have values as described below. - The validity must be assured by callers. + The validity must be enforced and ensured by the caller. STRING is a multibyte string or an ASCII-only unibyte string. @@ -9587,17 +9599,24 @@ get_char_bytes (int c, int *len) inserted characters. The caller should have made BUFFER ready for modifying in advance (e.g., by calling invalidate_buffer_caches). - If BUFFER is Qnil, return a unibyte string from the encoded result. - If NOCOPY, and if STRING contains only Unicode characters (i.e., - the encoding does not change the byte sequence), return STRING even - if it is multibyte. + If BUFFER is nil, return a unibyte string from the encoded result. + + If NOCOPY is non-zero, and if STRING contains only Unicode + characters (i.e., the encoding does not change the byte sequence), + return STRING even if it is multibyte. WARNING: This will return a + _multibyte_ string, something that callers might not expect, especially + if STRING is not pure-ASCII; only use NOCOPY non-zero if the caller + will only use the byte sequence of the encoded result accessed by + SDATA or SSDATA, and the original STRING will _not_ be modified after + the encoding. When in doubt, always pass NOCOPY as zero. You _have_ + been warned! HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a non-Unicode - character. The former is for an eight-bit character (represented + character in STRING. The former is for an eight-bit character (represented by a 2-byte overlong sequence in a multibyte STRING). The latter is - for an over-Unicode character (a character whose code is greater - than the maximum Unicode character 0x10FFFF, represented by a 4 or - 5-byte sequence in a multibyte STRING). + for a codepoint beyond the end of the Unicode range (a character whose + code is greater than the maximum Unicode character 0x10FFFF, represented + by a 4 or 5-byte sequence in a multibyte STRING). If these two arguments are unibyte strings (typically "\357\277\275", the UTF-8 sequence for the Unicode REPLACEMENT @@ -9605,18 +9624,20 @@ get_char_bytes (int c, int *len) unibyte sequence. If the two arguments are characters, encode a non-Unicode - character as if it was the argument. + character as the respective argument characters. If they are Qignored, skip a non-Unicode character. - If HANDLE-8-BIT is Qt, encode an eight-bit character into one - byte of the same value. + If HANDLE-8-BIT is Qt, encode eight-bit characters into single bytes + of the same value, like the usual Emacs encoding does. - If HANDLE-OVER-UNI is Qt, encode an over-unicode character - into the same 4 or 5-byte sequence. + If HANDLE-OVER-UNI is Qt, encode characters beyond the Unicode + range into the same 4 or 5-byte sequence as used by Emacs + internally, like the usual Emacs encoding does. If the two arguments are Qnil, return Qnil if STRING has a - non-Unicode character. */ + non-Unicode character. This allows the caller to signal an error + if such input strings are not allowed. */ Lisp_Object encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, @@ -9624,15 +9645,15 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, Lisp_Object handle_over_uni) { ptrdiff_t nchars = SCHARS (string), nbytes = SBYTES (string); - if (NILP (buffer) && nchars == nbytes) - /* STRING contains only ASCII characters. */ + if (NILP (buffer) && nchars == nbytes && nocopy) + /* STRING contains only ASCII characters. */ return string; ptrdiff_t num_8_bit = 0; /* number of eight-bit chars in STRING */ /* The following two vars are counted only if handle_over_uni is not Qt. */ ptrdiff_t num_over_4 = 0; /* number of 4-byte non-Unicode chars in STRING */ ptrdiff_t num_over_5 = 0; /* number of 5-byte non-Unicode chars in STRING */ - ptrdiff_t outbytes; /* number of bytes of decoding result. */ + ptrdiff_t outbytes; /* number of bytes of decoding result */ unsigned char *p = SDATA (string); unsigned char *pend = p + nbytes; unsigned char *src = NULL, *dst = NULL; @@ -9668,10 +9689,10 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } /* A character to change the byte sequence on encoding was - found. A rare case. */ + found. A rare case. */ if (len == 2) { - /* Handle an eight-bit character by handle_8_bit. */ + /* Handle an eight-bit character by handle_8_bit. */ if (scan_count == 0) { if (NILP (handle_8_bit)) @@ -9699,7 +9720,7 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } else /* len == 4 or 5 */ { - /* Handle an over-unicode character by handle_over_uni. */ + /* Handle an over-unicode character by handle_over_uni. */ if (scan_count == 0) { if (NILP (handle_over_uni)) @@ -9729,19 +9750,20 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, if (scan_count == 0) { - /* End of the first scane */ + /* End of the first scan. */ outbytes = nbytes; if (num_8_bit == 0 && (num_over_4 + num_over_5 == 0 || EQ (handle_over_uni, Qt))) { /* We can break the loop because there is no need of changing the byte sequence. This is the typical - case. */ + case. */ scan_count = 1; } else { - /* Prepare for the next scan to handle non-Unicode characters. */ + /* Prepare for handling non-Unicode characters during + the next scan. */ if (num_8_bit > 0) { if (CHARACTERP (handle_8_bit)) @@ -9792,7 +9814,7 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } } - /* Prepare a return value and a space to store the encoded bytes. */ + /* Prepare return value and space to store the encoded bytes. */ if (BUFFERP (buffer)) { val = make_fixnum (outbytes); @@ -9822,38 +9844,51 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, return val; } -/* Decode STRING by the coding system utf-8-unix. +/* Decode input string by the coding system utf-8-unix. - Ignore any :pre-write-conversion and :encode-translation-table - properties of that coding system. + This function is optimized for speed when the input string is + already a valid UTF-8 sequence, i.e. there are neither 8-bit raw + bytes nor any UTF-8 sequences longer than 4 bytes in the string's + contents. - Assumes that arguments have values as described below. - The validity must be assured by callers. + Ignore any :post-read-conversion and :decode-translation-table + properties. - STRING is a unibyte string or an ASCII-only multibyte string. + Assume that arguments have values as described below. + The validity must be enforced and ensured by the caller. - BUFFER is a multibyte buffer or Qnil. + STRING is a unibyte string, an ASCII-only multibyte string, or Qnil. + If STRING is Qnil, the input is a C string pointed by STR whose + length in bytes is in STR_LEN. + BUFFER is a multibyte buffer or Qnil. If BUFFER is a multibyte buffer, insert the decoding result of Unicode characters after point of the buffer, and return the number of inserted characters. The caller should have made BUFFER ready for modifying in advance (e.g., by calling invalidate_buffer_caches). If BUFFER is Qnil, return a multibyte string from the decoded result. - As a special case, return STRING itself in the following cases: - 1. STRING contains only ASCII characters. - 2. NOCOPY is true, and STRING contains only valid UTF-8 sequences. - For maximum speed, always specify NOCOPY true when STRING is - guaranteed to contain only valid UTF-8 sequences. + NOCOPY non-zero means it is OK to return the input STRING if it + contains only ASCII characters or only valid UTF-8 sequences of 2 + to 4 bytes. WARNING: This will return a _unibyte_ string, something + that callers might not expect, especially if STRING is not + pure-ASCII; only use NOCOPY non-zero if the caller will only use + the byte sequence of the decoded result accessed via SDATA or + SSDATA, and if the original STRING will _not_ be modified after the + decoding. When in dount, always pass NOCOPY as zero. You _have_ + been warned! + + If STRING is Qnil, and the original string is passed via STR, NOCOPY + is ignored. HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid - byte sequence. The former is for an 1-byte invalid sequence that - violates the fundamental UTF-8 encoding rule. The latter is for a - 4 or 5-byte invalid sequence that Emacs internally uses to - represent an over-unicode character (a character of code greater - than #x10FFFF). Note that this function does not treat an overlong - UTF-8 sequence as invalid. + byte sequence. The former is for a 1-byte invalid sequence that + violates the fundamental UTF-8 encoding rules. The latter is for a + 4 or 5-byte overlong sequences that Emacs internally uses to + represent characters beyond the Unicode range (characters whose + codepoints are greater than #x10FFFF). Note that this function does + not in general treat such overlong UTF-8 sequences as invalid. If these two arguments are strings (typically a 1-char string of the Unicode REPLACEMENT CHARACTER #xFFFD), decode an invalid byte @@ -9862,24 +9897,28 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, If the two arguments are characters, decode an invalid byte sequence into the corresponding multibyte representation of the - characters. + respective character. - If they are Qignored, skip an invalid byte sequence. + If they are Qignored, skip an invalid byte sequence without + producing anything in the decoded string. - If HANDLE-8-BIT is Qt, decode a 1-byte invalid sequence into - the corresponding eight-bit character. + If HANDLE-8-BIT is Qt, decode a 1-byte invalid sequence into the + corresponding eight-bit multibyte representation, like the usual + Emacs decoding does. - If HANDLE-OVER-UNI is Qt, decode a 4 or 5-byte invalid sequence - that follows Emacs' representation for an over-unicode character - into the corresponding character. + If HANDLE-OVER-UNI is Qt, decode a 4 or 5-byte overlong sequence + that follows Emacs' internal representation for a character beyond + Unicode range into the corresponding character, like the usual + Emacs decoding does. - If the two arguments are Qnil, return Qnil if STRING has an invalid - sequence. */ + If the two arguments are Qnil, return Qnil if the input string has + raw bytes or overlong sequences. This allows the caller to signal + an error if such inputs are not allowed. */ Lisp_Object -decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, - bool nocopy, Lisp_Object handle_8_bit, - Lisp_Object handle_over_uni) +decode_string_utf_8 (Lisp_Object string, const char *str, ptrdiff_t str_len, + Lisp_Object buffer, bool nocopy, + Lisp_Object handle_8_bit, Lisp_Object handle_over_uni) { /* This is like BYTES_BY_CHAR_HEAD, but it is assured that C >= 0x80 and it returns 0 for an invalid sequence. */ @@ -9891,24 +9930,26 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, : (c) == 0xF8 ? 5 \ : 0) - ptrdiff_t nbytes = SBYTES (string); - unsigned char *p = SDATA (string), *pend = p + nbytes; - ptrdiff_t num_8_bit = 0; /* number of invalid 1-byte sequences. */ - ptrdiff_t num_over_4 = 0; /* number of invalid 4-byte sequences. */ - ptrdiff_t num_over_5 = 0; /* number of invalid 5-byte sequences. */ - ptrdiff_t outbytes = nbytes; /* number of decoded bytes. */ - ptrdiff_t outchars = 0; /* number of decoded characters. */ + ptrdiff_t nbytes = STRINGP (string) ? SBYTES (string) : str_len; + unsigned char *p = STRINGP (string) ? SDATA (string) : (unsigned char *) str; + unsigned char *str_orig = p; + unsigned char *pend = p + nbytes; + ptrdiff_t num_8_bit = 0; /* number of invalid 1-byte sequences */ + ptrdiff_t num_over_4 = 0; /* number of invalid 4-byte sequences */ + ptrdiff_t num_over_5 = 0; /* number of invalid 5-byte sequences */ + ptrdiff_t outbytes = nbytes; /* number of decoded bytes */ + ptrdiff_t outchars = 0; /* number of decoded characters */ unsigned char *src = NULL, *dst = NULL; bool change_byte_sequence = false; - /* Scan bytes in STRING twice. The first scan is to count invalid - sequences, and the second scan is to decode STRING. If the + /* Scan input bytes twice. The first scan is to count invalid + sequences, and the second scan is to decode input. If the decoding is trivial (no need of changing the byte sequence), the second scan is avoided. */ while (p < pend) { src = p; - /* Try short cut for an ASCII-only case. */ + /* Try short cut for an ASCII-only case. */ while (p < pend && *p < 0x80) p++; outchars += (p - src); if (p == pend) @@ -9916,7 +9957,7 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, int c = *p; outchars++; int len = UTF_8_SEQUENCE_LENGTH (c); - /* len == 0, 2, 3, 4, 5 */ + /* len == 0, 2, 3, 4, 5. */ if (UTF_8_EXTRA_OCTET_P (p[1]) && (len == 2 || (UTF_8_EXTRA_OCTET_P (p[2]) @@ -9930,7 +9971,7 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, continue; } - /* A sequence to change on decoding was found. A rare case. */ + /* A sequence to change on decoding was found. A rare case. */ if (len == 0) { if (NILP (handle_8_bit)) @@ -9951,19 +9992,19 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, p += len; } - Lisp_Object val; /* the return value. */ + Lisp_Object val; /* the return value */ if (! change_byte_sequence && NILP (buffer)) { - if (nocopy) + if (nocopy && STRINGP (string)) return string; val = make_uninit_multibyte_string (outchars, outbytes); - memcpy (SDATA (val), SDATA (string), pend - SDATA (string)); + memcpy (SDATA (val), str_orig, pend - str_orig); return val; } - /* Count the number of resulting chars and bytes. */ + /* Count the number of resulting chars and bytes. */ unsigned char *replace_8_bit = NULL, *replace_over_uni = NULL; int replace_8_bit_len = 0, replace_over_uni_len = 0; @@ -10022,7 +10063,7 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } } - /* Prepare a return value and a space to store the decoded bytes. */ + /* Prepare return value and space to store the decoded bytes. */ if (BUFFERP (buffer)) { val = make_fixnum (outchars); @@ -10030,19 +10071,20 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } else { - if (nocopy && (num_8_bit + num_over_4 + num_over_5) == 0) + if (nocopy && (num_8_bit + num_over_4 + num_over_5) == 0 + && STRINGP (string)) return string; val = make_uninit_multibyte_string (outchars, outbytes); dst = SDATA (val); } - src = SDATA (string); + src = str_orig; if (change_byte_sequence) { p = src; while (p < pend) { - /* Try short cut for an ASCII-only case. */ + /* Try short cut for an ASCII-only case. */ /* while (p < pend && *p < 0x80) p++; */ /* if (p == pend) */ /* break; */ @@ -10089,7 +10131,7 @@ decode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, } else /* len == 4 or 5 */ { - /* Handle p[0]... by handle_over_uni */ + /* Handle p[0]... by handle_over_uni. */ if (replace_over_uni) { memcpy (dst, replace_over_uni, replace_over_uni_len); diff --git a/src/coding.h b/src/coding.h index 8efddbf55c..d552e7b4c8 100644 --- a/src/coding.h +++ b/src/coding.h @@ -691,7 +691,8 @@ extern Lisp_Object code_convert_string_norecord (Lisp_Object, Lisp_Object, bool); extern Lisp_Object encode_string_utf_8 (Lisp_Object, Lisp_Object, bool, Lisp_Object, Lisp_Object); -extern Lisp_Object decode_string_utf_8 (Lisp_Object, Lisp_Object, bool, +extern Lisp_Object decode_string_utf_8 (Lisp_Object, const char *, ptrdiff_t, + Lisp_Object, bool, Lisp_Object, Lisp_Object); extern Lisp_Object encode_file_name (Lisp_Object); extern Lisp_Object decode_file_name (Lisp_Object); diff --git a/src/json.c b/src/json.c index 5a3d0012f0..cd3b9cc023 100644 --- a/src/json.c +++ b/src/json.c @@ -228,7 +228,7 @@ json_encode (Lisp_Object string) { /* FIXME: Raise an error if STRING is not a scalar value sequence. */ - return code_convert_string (string, Qutf_8_unix, Qt, true, true, true); + return encode_string_utf_8 (string, Qnil, false, Qt, Qt); } static AVOID commit 6d4d00c63417e3479e978a373f252b9f2709ce39 Author: João Távora Date: Sat Nov 23 00:30:49 2019 +0000 * lisp/minibuffer.el (completion-flex-nospace): Default to t. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 399c4fe8bb..b9e5d5a3a2 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3496,8 +3496,8 @@ that is non-nil." ;;; "flex" completion, also known as flx/fuzzy/scatter completion ;; Completes "foo" to "frodo" and "farfromsober" -(defcustom completion-flex-nospace nil - "Make flex style fail when a space is found in pattern." +(defcustom completion-flex-nospace t + "Non-nil if `flex' completion rejects spaces in search pattern." :version "27.1" :type 'boolean) commit b7d4c5d1d1b55fea8382663f18263e2000678be5 Author: Juanma Barranquero Date: Fri Nov 22 21:10:49 2019 +0100 help-follow-symbol now complains if no symbol found (bug#38248) * lisp/help-mode.el (help-follow-symbol): Signal 'user-error' if there's no symbol at POS. * etc/NEWS: Document it. diff --git a/etc/NEWS b/etc/NEWS index b92fdeb675..ad349b1613 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2588,6 +2588,10 @@ pointer is over. To change this behaviour, you can customize the user option 'mouse-wheel-follow-mouse'. Note that this will also affect scrolling. +--- +** help-follow-symbol now signals 'user-error' if point (or the +position pointed to by the argument POS) is not in a symbol. + * Lisp Changes in Emacs 27.1 diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 054a1ef8c2..e70570c3ee 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -749,10 +749,11 @@ Show all docs for that symbol as either a variable, function or face." (buffer-substring (point) (progn (skip-syntax-forward "w_") (point))))))) - (when (or (boundp sym) - (get sym 'variable-documentation) - (fboundp sym) (facep sym)) - (help-do-xref pos #'describe-symbol (list sym))))) + (if (or (boundp sym) + (get sym 'variable-documentation) + (fboundp sym) (facep sym)) + (help-do-xref pos #'describe-symbol (list sym)) + (user-error "No symbol here")))) (defun help-mode-revert-buffer (_ignore-auto noconfirm) (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) commit 0b4eec3169690dab5ffa5027770893fff87f505f Author: Filipp Gunbin Date: Fri Nov 22 20:49:02 2019 +0300 Check gnus-mailing-list-groups in turn-on-gnus-mailing-list-mode * lisp/gnus/gnus-ml.el (turn-on-gnus-mailing-list-mode): Check also gnus-mailing-list-groups variable. diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index d68d0771ad..ce04a15d67 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -58,7 +58,9 @@ ;;;###autoload (defun turn-on-gnus-mailing-list-mode () - (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list) + (when (or (gnus-group-find-parameter gnus-newsgroup-name 'to-list) + (and gnus-mailing-list-groups + (string-match gnus-mailing-list-groups gnus-newsgroup-name))) (gnus-mailing-list-mode 1))) ;;;###autoload commit 6df8900af625f5375e6970eaf86d5d296f15022a Author: Filipp Gunbin Date: Fri Nov 22 20:37:27 2019 +0300 Make gnus-mailing-list-archive recognize https * /lisp/gnus/gnus-ml.el (gnus-mailing-list-archive): Accept https in regexp. diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 488c01c21c..d68d0771ad 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -150,7 +150,7 @@ If FORCE is non-nil, replace the old ones." (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-archive")))) (cond (list-archive - (if (string-match "<\\(http:[^>]*\\)>" list-archive) + (if (string-match "<\\(https?:[^>]*\\)>" list-archive) (browse-url (match-string 1 list-archive)) (browse-url list-archive))) (t (gnus-message 1 "no list-archive in this group"))))) commit d3f0cf7404064ecb937036254b4cca3141e7095b Author: Filipp Gunbin Date: Fri Nov 22 19:23:51 2019 +0300 Unify docstrings of Gnus summary's copy/move/crosspost article functions * lisp/gnus/gnus-sum.el (gnus-summary-copy-article) (gnus-summary-crosspost-article): Make docstrings refer to gnus-summary-move-article. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 6680254c8d..4a51d2c80b 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10419,17 +10419,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to. -When called interactively, if TO-NEWSGROUP is nil, use the value of -the variable `gnus-move-split-methods' for finding a default target -newsgroup. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method." +Arguments have the same meanings as in `gnus-summary-move-article'." (interactive "P") (gnus-summary-move-article n to-newsgroup select-method 'copy)) (defun gnus-summary-crosspost-article (&optional n) - "Crosspost the current article to some other group." + "Crosspost the current article to some other group. +Arguments have the same meanings as in `gnus-summary-move-article'." (interactive "P") (gnus-summary-move-article n nil nil 'crosspost)) commit 045cfbef09a67c334e4772cb045181cf2203d839 Author: dickmao Date: Fri Nov 22 15:53:58 2019 +0100 Refix conditional step clauses in cl-loop * lisp/emacs-lisp/cl-macs.el (cl--loop-bindings, cl--loop-symbol-macs, cl-loop): Add cl--loop-conditions, remove cl--loop-guard-cond. (cl--push-clause-loop-body): Apply clause to both cl--loop-conditions and cl--loop-body (cl--parse-loop-clause): Use cl--push-clause-loop-body. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-and-assignment): Use docstring. (cl-macs-loop-for-as-arith): Removed expected failure. (cl-macs-loop-conditional-step-clauses): Add some tests (bug#29799). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 80e218884a..a5ecf33203 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -889,7 +889,7 @@ This is compatible with Common Lisp, but note that `defun' and ;;; The "cl-loop" macro. (defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars) -(defvar cl--loop-bindings) (defvar cl--loop-body) +(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-conditions) (defvar cl--loop-finally) (defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop? (defvar cl--loop-first-flag) @@ -897,7 +897,7 @@ This is compatible with Common Lisp, but note that `defun' and (defvar cl--loop-name) (defvar cl--loop-result) (defvar cl--loop-result-explicit) (defvar cl--loop-result-var) (defvar cl--loop-steps) -(defvar cl--loop-symbol-macs) (defvar cl--loop-guard-cond) +(defvar cl--loop-symbol-macs) (defun cl--loop-set-iterator-function (kind iterator) (if cl--loop-iterator-function @@ -966,7 +966,8 @@ For more details, see Info node `(cl)Loop Facility'. (cl--loop-accum-var nil) (cl--loop-accum-vars nil) (cl--loop-initially nil) (cl--loop-finally nil) (cl--loop-iterator-function nil) (cl--loop-first-flag nil) - (cl--loop-symbol-macs nil) (cl--loop-guard-cond nil)) + (cl--loop-symbol-macs nil) + (cl--loop-conditions nil)) ;; Here is more or less how those dynbind vars are used after looping ;; over cl--parse-loop-clause: ;; @@ -1001,24 +1002,7 @@ For more details, see Info node `(cl)Loop Facility'. (list (or cl--loop-result-explicit cl--loop-result)))) (ands (cl--loop-build-ands (nreverse cl--loop-body))) - (while-body - (nconc - (cadr ands) - (if (or (not cl--loop-guard-cond) (not cl--loop-first-flag)) - (nreverse cl--loop-steps) - ;; Right after update the loop variable ensure that the loop - ;; condition, i.e. (car ands), is still satisfied; otherwise, - ;; set `cl--loop-first-flag' nil and skip the remaining - ;; body forms (#Bug#29799). - ;; - ;; (last cl--loop-steps) updates the loop var - ;; (car (butlast cl--loop-steps)) sets `cl--loop-first-flag' nil - ;; (nreverse (cdr (butlast cl--loop-steps))) are the - ;; remaining body forms. - (append (last cl--loop-steps) - `((and ,(car ands) - ,@(nreverse (cdr (butlast cl--loop-steps))))) - `(,(car (butlast cl--loop-steps))))))) + (while-body (nconc (cadr ands) (nreverse cl--loop-steps))) (body (append (nreverse cl--loop-initially) (list (if cl--loop-iterator-function @@ -1051,6 +1035,12 @@ For more details, see Info node `(cl)Loop Facility'. (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body)))) `(cl-block ,cl--loop-name ,@body))))) +(defmacro cl--push-clause-loop-body (clause) + "Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'." + `(progn + (push ,clause cl--loop-conditions) + (push ,clause cl--loop-body))) + ;; Below is a complete spec for cl-loop, in several parts that correspond ;; to the syntax given in CLtL2. The specs do more than specify where ;; the forms are; it also specifies, as much as Edebug allows, all the @@ -1201,8 +1191,6 @@ For more details, see Info node `(cl)Loop Facility'. ;; (def-edebug-spec loop-d-type-spec ;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) - - (defun cl--parse-loop-clause () ; uses loop-* (let ((word (pop cl--loop-args)) (hash-types '(hash-key hash-keys hash-value hash-values)) @@ -1281,11 +1269,11 @@ For more details, see Info node `(cl)Loop Facility'. (if end-var (push (list end-var end) loop-for-bindings)) (if step-var (push (list step-var step) loop-for-bindings)) - (if end - (push (list - (if down (if excl '> '>=) (if excl '< '<=)) - var (or end-var end)) - cl--loop-body)) + (when end + (cl--push-clause-loop-body + (list + (if down (if excl '> '>=) (if excl '< '<=)) + var (or end-var end)))) (push (list var (list (if down '- '+) var (or step-var step 1))) loop-for-steps))) @@ -1295,7 +1283,7 @@ For more details, see Info node `(cl)Loop Facility'. (temp (if (and on (symbolp var)) var (make-symbol "--cl-var--")))) (push (list temp (pop cl--loop-args)) loop-for-bindings) - (push `(consp ,temp) cl--loop-body) + (cl--push-clause-loop-body `(consp ,temp)) (if (eq word 'in-ref) (push (list var `(car ,temp)) cl--loop-symbol-macs) (or (eq temp var) @@ -1318,24 +1306,19 @@ For more details, see Info node `(cl)Loop Facility'. ((eq word '=) (let* ((start (pop cl--loop-args)) (then (if (eq (car cl--loop-args) 'then) - (cl--pop2 cl--loop-args) start))) + (cl--pop2 cl--loop-args) start)) + (first-assign (or cl--loop-first-flag + (setq cl--loop-first-flag + (make-symbol "--cl-var--"))))) (push (list var nil) loop-for-bindings) (if (or ands (eq (car cl--loop-args) 'and)) (progn - (push `(,var - (if ,(or cl--loop-first-flag - (setq cl--loop-first-flag - (make-symbol "--cl-var--"))) - ,start ,var)) - loop-for-sets) - (push (list var then) loop-for-steps)) - (push (list var - (if (eq start then) start - `(if ,(or cl--loop-first-flag - (setq cl--loop-first-flag - (make-symbol "--cl-var--"))) - ,start ,then))) - loop-for-sets)))) + (push `(,var (if ,first-assign ,start ,var)) loop-for-sets) + (push `(,var (if ,(car (cl--loop-build-ands + (nreverse cl--loop-conditions))) + ,then ,var)) + loop-for-steps)) + (push `(,var (if ,first-assign ,start ,then)) loop-for-sets)))) ((memq word '(across across-ref)) (let ((temp-vec (make-symbol "--cl-vec--")) @@ -1344,9 +1327,8 @@ For more details, see Info node `(cl)Loop Facility'. (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) (push (list temp-len `(length ,temp-vec)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) - (push `(< (setq ,temp-idx (1+ ,temp-idx)) - ,temp-len) - cl--loop-body) + (cl--push-clause-loop-body + `(< (setq ,temp-idx (1+ ,temp-idx)) ,temp-len)) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) cl--loop-symbol-macs) @@ -1376,15 +1358,14 @@ For more details, see Info node `(cl)Loop Facility'. loop-for-bindings) (push (list var `(elt ,temp-seq ,temp-idx)) cl--loop-symbol-macs) - (push `(< ,temp-idx ,temp-len) cl--loop-body)) + (cl--push-clause-loop-body `(< ,temp-idx ,temp-len))) ;; Evaluate seq length just if needed, that is, when seq is not a cons. (push (list temp-len (or (consp seq) `(length ,temp-seq))) loop-for-bindings) (push (list var nil) loop-for-bindings) - (push `(and ,temp-seq - (or (consp ,temp-seq) - (< ,temp-idx ,temp-len))) - cl--loop-body) + (cl--push-clause-loop-body `(and ,temp-seq + (or (consp ,temp-seq) + (< ,temp-idx ,temp-len)))) (push (list var `(if (consp ,temp-seq) (pop ,temp-seq) (aref ,temp-seq ,temp-idx))) @@ -1480,9 +1461,8 @@ For more details, see Info node `(cl)Loop Facility'. (push (list var '(selected-frame)) loop-for-bindings) (push (list temp nil) loop-for-bindings) - (push `(prog1 (not (eq ,var ,temp)) - (or ,temp (setq ,temp ,var))) - cl--loop-body) + (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp)) + (or ,temp (setq ,temp ,var)))) (push (list var `(next-frame ,var)) loop-for-steps))) @@ -1503,9 +1483,8 @@ For more details, see Info node `(cl)Loop Facility'. (push (list minip `(minibufferp (window-buffer ,var))) loop-for-bindings) (push (list temp nil) loop-for-bindings) - (push `(prog1 (not (eq ,var ,temp)) - (or ,temp (setq ,temp ,var))) - cl--loop-body) + (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp)) + (or ,temp (setq ,temp ,var)))) (push (list var `(next-window ,var ,minip)) loop-for-steps))) @@ -1529,7 +1508,6 @@ For more details, see Info node `(cl)Loop Facility'. t) cl--loop-body)) (when loop-for-steps - (setq cl--loop-guard-cond t) (push (cons (if ands 'cl-psetq 'setq) (apply 'append (nreverse loop-for-steps))) cl--loop-steps)))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 09ce660a2f..8523044714 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -30,7 +30,7 @@ ;;; ANSI 6.1.1.7 Destructuring (ert-deftest cl-macs-loop-and-assignment () - ;; Bug#6583 + "Bug#6583" :expected-result :failed (should (equal (cl-loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) for a = (cl-first numlist) @@ -61,7 +61,6 @@ ;;; 6.1.2.1.1 The for-as-arithmetic subclause (ert-deftest cl-macs-loop-for-as-arith () "Test various for-as-arithmetic subclauses." - :expected-result :failed (should (equal (cl-loop for i to 10 by 3 collect i) '(0 3 6 9))) (should (equal (cl-loop for i upto 3 collect i) @@ -74,9 +73,9 @@ '(10 8 6))) (should (equal (cl-loop for i from 10 downto 1 by 3 collect i) '(10 7 4 1))) - (should (equal (cl-loop for i above 0 by 2 downfrom 10 collect i) + (should (equal (cl-loop for i downfrom 10 above 0 by 2 collect i) '(10 8 6 4 2))) - (should (equal (cl-loop for i downto 10 from 15 collect i) + (should (equal (cl-loop for i from 15 downto 10 collect i) '(15 14 13 12 11 10)))) (ert-deftest cl-macs-loop-for-as-arith-order-side-effects () @@ -530,4 +529,65 @@ collection clause." l) '(1)))) +(ert-deftest cl-macs-loop-conditional-step-clauses () + "These tests failed under the initial fixes in #bug#29799." + (should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j) + if (not (= i j)) + return nil + end + until (> j 10) + finally return t)) + + (should (equal (let* ((size 7) + (arr (make-vector size 0))) + (cl-loop for k below size + for x = (* 2 k) and y = (1+ (elt arr k)) + collect (list k x y))) + '((0 0 1) (1 2 1) (2 4 1) (3 6 1) (4 8 1) (5 10 1) (6 12 1)))) + + (should (equal (cl-loop for x below 3 + for y below 2 and z = 1 + collect x) + '(0 1))) + + (should (equal (cl-loop for x below 3 + and y below 2 + collect x) + '(0 1))) + + ;; this is actually disallowed in clisp, but is semantically consistent + (should (equal (cl-loop with result + for x below 3 + for y = (progn (push x result) x) and z = 1 + append (list x y) into result1 + finally return (append result result1)) + '(2 1 0 0 0 1 1 2 2))) + + (should (equal (cl-loop with result + for x below 3 + for _y = (progn (push x result)) + finally return result) + '(2 1 0))) + + ;; this nonintuitive result is replicated by clisp + (should (equal (cl-loop with result + for x below 3 + and y = (progn (push x result)) + finally return result) + '(2 1 0 0))) + + ;; this nonintuitive result is replicated by clisp + (should (equal (cl-loop with result + for x below 3 + and y = (progn (push x result)) then (progn (push (1+ x) result)) + finally return result) + '(3 2 1 0))) + + (should (cl-loop with result + for x below 3 + for y = (progn (push x result) x) then (progn (push (1+ x) result) (1+ x)) + and z = 1 + collect y into result1 + finally return (equal (nreverse result) result1)))) + ;;; cl-macs-tests.el ends here commit f373cec7f51653130bff0844262d356c2bf7c649 Author: Eli Zaretskii Date: Fri Nov 22 16:36:25 2019 +0200 Fix uses of inhibit-message in package.el * lisp/emacs-lisp/package.el (package-generate-autoloads) (package--compile, package--save-selected-packages): Don't use 'inhibit-message' to bind 'noninteractive' and 'save-silently', since 'inhibit-message' already disables all messages. (Bug#38264) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 26207e03c4..56e160232d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1002,8 +1002,6 @@ untar into a directory named DIR; otherwise, signal an error." (generated-autoload-file (expand-file-name auto-name pkg-dir)) ;; We don't need 'em, and this makes the output reproducible. (autoload-timestamps nil) - ;; Silence `autoload-generate-file-autoloads'. - (noninteractive inhibit-message) (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) @@ -1029,7 +1027,6 @@ untar into a directory named DIR; otherwise, signal an error." This assumes that `pkg-desc' has already been activated with `package-activate-1'." (let ((warning-minimum-level :error) - (save-silently inhibit-message) (load-path load-path)) (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) @@ -1840,8 +1837,7 @@ Used to populate `package-selected-packages'." (when value (setq package-selected-packages value)) (if after-init-time - (let ((save-silently inhibit-message)) - (customize-save-variable 'package-selected-packages package-selected-packages)) + (customize-save-variable 'package-selected-packages package-selected-packages) (add-hook 'after-init-hook #'package--save-selected-packages))) (defun package--user-selected-p (pkg) commit f9b8c74af1817add9ff5b5b73da574b81d91f68a Author: Hong Xu Date: Fri Nov 22 14:34:59 2019 +0100 font-lock special attributes in python-mode * lisp/progmodes/python.el (python-font-lock-keywords-level-2): Add special attributes (bug#38318). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 37e0ccf719..e720c6eb6a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -567,8 +567,14 @@ class declarations.") "intern" ;; Python 3: "ascii" "breakpoint" "bytearray" "bytes" "exec" - ;; Extra: - "__all__" "__doc__" "__name__" "__package__") + ;; Special attributes: + ;; https://docs.python.org/3/reference/datamodel.html + "__annotations__" "__closure__" "__code__" + "__defaults__" "__dict__" "__doc__" "__globals__" + "__kwdefaults__" "__name__" "__module__" "__package__" + "__qualname__" + ;; Extras: + "__all__") symbol-end) . font-lock-builtin-face)) "Font lock keywords to use in python-mode for level 2 decoration. commit f5667953f73b557b4461677df9a1a0017ff46f60 Author: Lars Ingebrigtsen Date: Fri Nov 22 13:15:41 2019 +0100 Give better error messages in image-convert * lisp/image/image-converter.el (image-convert): Make image-convert bug out earlier on a wrong IMAGE-FORMAT value (bug#38310). diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index b4d10c861b..1230b6b9cb 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -87,6 +87,9 @@ data is returned as a string." (image-converter--find-converter)) (unless image-converter (error "No external image converters available")) + (when (and image-format + (not (= (length (split-string (symbol-name image-format) "/")) 2))) + (error "IMAGE-FORMAT should be a symbol like `image/png'")) (with-temp-buffer (set-buffer-multibyte nil) (when-let ((err (image-converter--convert commit 92fda5a7f92162d610d57df14372bcfcee1f01b6 Author: João Távora Date: Wed Nov 20 00:11:00 2019 +0000 Make auth-source-pass-search understand port lists For cases such as a typical IMAP Gnus setup, auto-source-pass-search is passed a list of "port aliases" like (993 "imaps" "imap" "993" "143") in hopes of finding a matching ~/.password-store entry. This modification makes this library understand and unroll the port list so that, i.e. "domain:993", "domain:imaps"", "domain:imap", etc. are computed as potential suffixes. Previously a nonsensical string "domain:(993 imaps imap ...)" was returned. * lisp/auth-source-pass.el (auth-source-pass--generate-entry-suffixes): Allow PORT to be a list of ports. diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 524a72792c..dfdb7596fa 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -269,10 +269,15 @@ If ENTRIES is nil, use the result of calling `auth-source-pass-entries' instead. Based on the supported pathname patterns for HOSTNAME, USER, & PORT, return a list of possible suffixes for matching entries in -the password-store." +the password-store. + +PORT may be a list of ports." (let ((domains (auth-source-pass--domains (split-string hostname "\\.")))) - (seq-mapcat (lambda (n) - (auth-source-pass--name-port-user-suffixes n user port)) + (seq-mapcat (lambda (domain) + (seq-mapcat + (lambda (p) + (auth-source-pass--name-port-user-suffixes domain user p)) + (if (listp port) port (list port)))) domains))) (defun auth-source-pass--domains (name-components) commit c5de861af1da697b4481133e4f5f966e6a3fc859 Author: Stefan Monnier Date: Thu Nov 21 18:24:37 2019 -0500 * lisp/emacs-lisp/smie.el (smie-next-sexp): Fix bug#38255 Handle the case where the token is not in `smie-grammar`, either because the caller is making an error, or because it's a paren-like token that's not handled in the grammar but directly via the syntax tables. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index f2163b243e..2c2898ae71 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -702,7 +702,11 @@ Possible return values: (catch 'return (let ((levels (if (stringp halfsexp) - (prog1 (list (cdr (assoc halfsexp smie-grammar))) + (prog1 (list (or (cdr (assoc halfsexp smie-grammar)) + (when (string-match "\\`\\s(\\|\\s)\\(\\)\\'" + halfsexp) + (if (match-end 1) '(0 nil) '(nil 0))) + (error "Unknown token: %S" halfsexp))) (setq halfsexp nil))))) (while (let* ((pos (point)) commit 04208780262faaee772c96567069ceb9184c864f Author: Lars Ingebrigtsen Date: Fri Nov 22 00:19:43 2019 +0100 Make `C-c C-w' insert a signature even when overridden * lisp/gnus/message.el (message-insert-signature): When called interactively, look harder for a signature to insert (bug#38289). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 83ec211a7d..54ab86a970 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3538,50 +3538,61 @@ Message buffers and is not meant to be called directly." (defun message-insert-signature (&optional force) "Insert a signature. See documentation for variable `message-signature'." (interactive (list 0)) - (let* ((signature - (cond - ((and (null message-signature) - (eq force 0)) - (save-excursion - (goto-char (point-max)) - (not (re-search-backward message-signature-separator nil t)))) - ((and (null message-signature) - force) - t) - ((functionp message-signature) - (funcall message-signature)) - ((listp message-signature) - (eval message-signature)) - (t message-signature))) - signature-file) - (setq signature - (cond ((stringp signature) - signature) - ((and (eq t signature) message-signature-file) - (setq signature-file - (if (and message-signature-directory - ;; don't actually use the signature directory - ;; if message-signature-file contains a path. - (not (file-name-directory - message-signature-file))) - (expand-file-name message-signature-file - message-signature-directory) - message-signature-file)) - (file-exists-p signature-file)))) - (when signature - (goto-char (point-max)) - ;; Insert the signature. - (unless (bolp) - (newline)) - (when message-signature-insert-empty-line - (newline)) - (insert "-- ") - (newline) - (if (eq signature t) - (insert-file-contents signature-file) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (newline))))) + (let ((message-signature message-signature) + (message-signature-file message-signature-file)) + ;; If called interactively and there's no signature to insert, + ;; consult the global values to see whether there's anything they + ;; have to say for themselves. This can happen when using + ;; `gnus-posting-styles', for instance. + (when (and (null message-signature) + (null message-signature-file) + (eq force 0)) + (setq message-signature (default-value 'message-signature) + message-signature-file (default-value 'message-signature-file))) + (let* ((signature + (cond + ((and (null message-signature) + (eq force 0)) + (save-excursion + (goto-char (point-max)) + (not (re-search-backward message-signature-separator nil t)))) + ((and (null message-signature) + force) + t) + ((functionp message-signature) + (funcall message-signature)) + ((listp message-signature) + (eval message-signature)) + (t message-signature))) + signature-file) + (setq signature + (cond ((stringp signature) + signature) + ((and (eq t signature) message-signature-file) + (setq signature-file + (if (and message-signature-directory + ;; don't actually use the signature directory + ;; if message-signature-file contains a path. + (not (file-name-directory + message-signature-file))) + (expand-file-name message-signature-file + message-signature-directory) + message-signature-file)) + (file-exists-p signature-file)))) + (when signature + (goto-char (point-max)) + ;; Insert the signature. + (unless (bolp) + (newline)) + (when message-signature-insert-empty-line + (newline)) + (insert "-- ") + (newline) + (if (eq signature t) + (insert-file-contents signature-file) + (insert signature)) + (goto-char (point-max)) + (or (bolp) (newline)))))) (defun message-insert-importance-high () "Insert header to mark message as important." commit 20b1e959e077492817bea34392ba2dda745c4641 Author: Stefan Monnier Date: Thu Nov 21 17:53:02 2019 -0500 * lisp/minibuffer.el (completions-common-part): Make it blue when possible diff --git a/etc/NEWS b/etc/NEWS index 7a51106add..b92fdeb675 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -409,6 +409,8 @@ matches strings where the pattern appears as a subsequence. Put simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex' to 'completion-styles' or 'completion-category-overrides' to use it. +** The 'completion-common-part' face is now visible by default. + +++ ** New face attribute ':extend' to control face extension at EOL. The new face attribute ':extend' controls whether to use the face for diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ee3d0095a9..399c4fe8bb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1692,7 +1692,9 @@ See also `display-completion-list'.") "Face for the first character after point in completions. See also the face `completions-common-part'.") -(defface completions-common-part '((t nil)) +(defface completions-common-part + '((((class color) (min-colors 16) (background light)) :foreground "blue3") + (((class color) (min-colors 16) (background dark)) :foreground "lightblue")) "Face for the parts of completions which matched the pattern. See also the face `completions-first-difference'.") commit 81ab458aae931e01a940424eeea55777004f9c55 Author: Stefan Monnier Date: Thu Nov 21 17:39:38 2019 -0500 * lisp/files.el (locate-file-completion-table): Fix typo diff --git a/lisp/files.el b/lisp/files.el index bb77dcb3c7..2c45a8b107 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -958,7 +958,7 @@ one or more of those symbols." ;; M-x load-library RET t/x.e TAB finds some files. Also remove elements ;; from `names' that matched `string' only when they still had ;; their suffix. - (setq names (all-completions string names)) + (setq names (all-completions string-file names)) ;; Remove duplicates of the first element, so that we can easily check ;; if `names' really contains only a single element. (when (cdr names) (setcdr names (delete (car names) (cdr names)))) commit 86d8d9589370e8786c2cb245dad8527494009ac2 Merge: 5a62c4b49c 6c9c45bfab Author: Thierry Volpiatto Date: Thu Nov 21 21:01:53 2019 +0100 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 5a62c4b49ca1ac45d576f55d266750b7d1d6668a Author: Thierry Volpiatto Date: Thu Nov 21 20:41:19 2019 +0100 Add new variable to prevent flex completion style matching spaces. This allows flex style working smoothly with other styles like helm using spaces. * lisp/minibuffer.el (completion-flex-nospace): New user var. (completion-flex-try-completion): Use it. (completion-flex-all-completions): Same. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6e72eb73f9..ee3d0095a9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3494,6 +3494,11 @@ that is non-nil." ;;; "flex" completion, also known as flx/fuzzy/scatter completion ;; Completes "foo" to "frodo" and "farfromsober" +(defcustom completion-flex-nospace nil + "Make flex style fail when a space is found in pattern." + :version "27.1" + :type 'boolean) + (put 'flex 'completion--adjust-metadata 'completion--flex-adjust-metadata) (defun completion--flex-adjust-metadata (metadata) @@ -3539,29 +3544,31 @@ which is at the core of flex logic. The extra (defun completion-flex-try-completion (string table pred point) "Try to flex-complete STRING in TABLE given PRED and POINT." - (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds) - (completion-substring--all-completions - string table pred point - #'completion-flex--make-flex-pattern))) - (if minibuffer-completing-file-name - (setq all (completion-pcm--filename-try-filter all))) - ;; Try some "merging", meaning add as much as possible to the - ;; user's pattern without losing any possible matches in `all'. - ;; i.e this will augment "cfi" to "config" if all candidates - ;; contain the substring "config". FIXME: this still won't - ;; augment "foo" to "froo" when matching "frodo" and - ;; "farfromsober". - (completion-pcm--merge-try pattern all prefix suffix))) + (unless (and completion-flex-nospace (string-match-p " " string)) + (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds) + (completion-substring--all-completions + string table pred point + #'completion-flex--make-flex-pattern))) + (if minibuffer-completing-file-name + (setq all (completion-pcm--filename-try-filter all))) + ;; Try some "merging", meaning add as much as possible to the + ;; user's pattern without losing any possible matches in `all'. + ;; i.e this will augment "cfi" to "config" if all candidates + ;; contain the substring "config". FIXME: this still won't + ;; augment "foo" to "froo" when matching "frodo" and + ;; "farfromsober". + (completion-pcm--merge-try pattern all prefix suffix)))) (defun completion-flex-all-completions (string table pred point) "Get flex-completions of STRING in TABLE, given PRED and POINT." - (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds) - (completion-substring--all-completions - string table pred point - #'completion-flex--make-flex-pattern))) - (when all - (nconc (completion-pcm--hilit-commonality pattern all) - (length prefix))))) + (unless (and completion-flex-nospace (string-match-p " " string)) + (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds) + (completion-substring--all-completions + string table pred point + #'completion-flex--make-flex-pattern))) + (when all + (nconc (completion-pcm--hilit-commonality pattern all) + (length prefix)))))) ;; Initials completion ;; Complete /ums to /usr/monnier/src or lch to list-command-history. commit 6c9c45bfabaa06bd604c95e194102143b87f700e Author: Wilson Snyder Date: Thu Nov 21 14:38:09 2019 -0500 When verilog-auto-ignore-concat is true, also ignore parenthesized signals. * lisp/progmodes/verilog-mode.el (verilog-auto-ignore-concat): When `verilog-auto-ignore-concat' is true, also ignore parenthesized signals. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 85657b385d..0afbdc3dd1 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2019.11.11.038630457 +;; Version: 2019.11.21.248091482 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2019-11-11-24d7439-vpo-GNU" +(defconst verilog-mode-version "2019-11-21-ec9935a-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -809,9 +809,7 @@ The name of the function or case will be set between the braces." (defcustom verilog-auto-ignore-concat nil "Non-nil means ignore signals in {...} concatenations for AUTOWIRE etc. This will exclude signals referenced as pin connections in {...} -from AUTOWIRE, AUTOOUTPUT and friends. This flag should be set -for backward compatibility only and not set in new designs; it -may be removed in future versions." +or (...) from AUTOWIRE, AUTOOUTPUT and friends." :group 'verilog-mode-actions :type 'boolean) (put 'verilog-auto-ignore-concat 'safe-local-variable 'verilog-booleanp) @@ -8862,11 +8860,10 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;; {..., a, b} requires us to recurse on a,b ;; To support {#{},{#{a,b}} we'll just split everything on [{},] ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr) - (unless verilog-auto-ignore-concat - (let ((mlst (split-string (match-string 1 expr) "[{},]")) - mstr) - (while (setq mstr (pop mlst)) - (verilog-read-sub-decls-expr submoddecls par-values comment port mstr))))) + (let ((mlst (split-string (match-string 1 expr) "[{},]")) + mstr) + (while (setq mstr (pop mlst)) + (verilog-read-sub-decls-expr submoddecls par-values comment port mstr)))) (t (let (sig vec multidim mem) ;; Remove leading reduction operators, etc @@ -8942,7 +8939,10 @@ Inserts the list of signals found, using submodi to look up each port." ;; We intentionally ignore (non-escaped) signals with .s in them ;; this prevents AUTOWIRE etc from noticing hierarchical sigs. (when port - (cond ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") + (cond ((and verilog-auto-ignore-concat + (looking-at "[({]")) + nil) ; {...} or (...) historically ignored with auto-ignore-concat + ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls par-values comment port (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig commit 03938ba381a25ae53c9d39478c020849d09c3656 Author: Eric Abrahamsen Date: Thu Nov 21 10:08:41 2019 -0800 Fix Gnus summary backtab keybindings to use button-based functions * lisp/gnus/gnus-sum.el (gnus-summary-mode-map, gnus-summary-article-map): Backtab should call gnus-summary-button-backward, not gnus-summary-widget-backward. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b8859528d0..6680254c8d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1992,7 +1992,7 @@ increase the score of each group you read." "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article "\t" gnus-summary-button-forward - [backtab] gnus-summary-widget-backward + [backtab] gnus-summary-button-backward "w" gnus-summary-browse-url "t" gnus-summary-toggle-header "g" gnus-summary-show-article @@ -2161,7 +2161,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article "\t" gnus-summary-button-forward - [backtab] gnus-summary-widget-backward + [backtab] gnus-summary-button-backward "w" gnus-summary-browse-url "P" gnus-summary-print-article "S" gnus-sticky-article commit 4f6980ad6bbe130f72904d443e66cf60ff1d71a4 Author: Eli Zaretskii Date: Thu Nov 21 16:39:15 2019 +0200 Fix file notifications on macOS * src/kqueue.c (Fkqueue_add_watch): Don't use encoded file names in objects and APIs that expect decoded multibyte strings. (Bug#38287) diff --git a/src/kqueue.c b/src/kqueue.c index 76d7fc1ecb..1383d7d365 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -414,7 +414,7 @@ only when the upper directory of the renamed file is watched. */) } /* Open file. */ - file = ENCODE_FILE (file); + Lisp_Object encoded_file = ENCODE_FILE (file); oflags = O_NONBLOCK; #if O_EVTONLY oflags |= O_EVTONLY; @@ -426,7 +426,7 @@ only when the upper directory of the renamed file is watched. */) #else oflags |= O_NOFOLLOW; #endif - fd = emacs_open (SSDATA (file), oflags, 0); + fd = emacs_open (SSDATA (encoded_file), oflags, 0); if (fd == -1) report_file_error ("File cannot be opened", file); commit 80b8a6093b6b7657da135bec506eb55a700688d4 Author: Eli Zaretskii Date: Thu Nov 21 16:35:58 2019 +0200 Fix a recent change in ELisp manual * doc/lispref/objects.texi (Special Read Syntax): Fix wording of the last change: don't document #' twice. (Bug#38278) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 2a2a476e9a..d9971f6839 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -124,9 +124,7 @@ The printed representation of an interned symbol whose name is an empty string (@pxref{Symbol Type}). @item #' -Expands to @code{function} and is commonly used to quote function -symbols (as opposed to @samp{'} which is used to quote non-function -symbols (@pxref{Anonymous Functions})). +This is a shortcut for @code{function}, see @ref{Anonymous Functions}. @item #: The printed representation of an uninterned symbol whose name is commit 1110d1422863b8e9abb757db3fe9fbe6c8884862 Author: Eli Zaretskii Date: Thu Nov 21 16:07:19 2019 +0200 Support 'vc-region-history' for Mercurial * lisp/vc/vc-hg.el (vc-hg-region-history) (vc-hg-region-history-font-lock, vc-hg-region-history-mode): New functions. (vc-hg-region-history-mode-map) (vc-hg--log-view-long-font-lock-keywords) (vc-hg-region-history-font-lock-keywords): New variables. * lisp/vc/vc-git.el (vc-git-region-history): Update commentary. * doc/emacs/maintaining.texi (VC Change Log): Add 'vc-region-history' to the table at beginning of node. Update the VCSes that support 'vc-region-history'. * etc/NEWS: Mention the new feature of vc-hg.el. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index ef448dd595..33a1ec0be0 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -963,6 +963,10 @@ Display the changes that a ``pull'' operation will retrieve @item C-x v O Display the changes that will be sent by the next ``push'' operation (@code{vc-log-outgoing}). + +@item C-x v h +Display the history of changes made in the region of file visited by +the current buffer (@code{vc-region-history}). @end table @kindex C-x v l @@ -1068,20 +1072,20 @@ buffer. However, RCS, SCCS, CVS, and SRC do not support this feature. @kindex C-x v h @findex vc-region-history -A useful variant of examining changes is provided by the command +A useful variant of examining history of changes is provided by the command @kbd{vc-region-history} (by default bound to @kbd{C-x v h}), which shows -a @file{*VC-history*} buffer with the history of changes to the region -of the current file between point and the mark (@pxref{Mark}). The +a @file{*VC-history*} buffer with the history of changes made in the region +of the current buffer's file between point and the mark (@pxref{Mark}). The history of changes includes the commit log messages and also the changes themselves in the Diff format. -Invoke this command after marking the region of the current file in +Invoke this command after marking in the current buffer the region in whose changes you are interested. In the @file{*VC-history*} buffer it pops up, you can use all of the commands available in the @file{*vc-change-log*} buffer described above, and also the commands defined by Diff mode (@pxref{Diff Mode}). -This command is currently available only with Git. +This command is currently available only with Git and Mercurial (hg). @node VC Undo @subsection Undoing Version Control Actions diff --git a/etc/NEWS b/etc/NEWS index e25df98243..7a51106add 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -926,6 +926,11 @@ with conflicts existed in earlier versions of Emacs, but incorrectly never detected a conflict due to invalid assumptions about cached values. ++++ +*** The Hg (Mercurial) back-end now supports 'vc-region-history'. +The 'C-x v h' command now works in buffers that visit files controlled +by Hg. + +++ *** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions and compares their entire trees. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 5ab8e7ec53..ca4c66a06d 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1295,9 +1295,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." ;; to the HEAD version of the file, not to the current state of the file. ;; So we need to look at all the local changes and adjust lfrom/lto ;; accordingly. - ;; FIXME: Maybe this should be done in vc.el (i.e. for all backends), but - ;; since Git is the only backend to support this operation so far, it's hard - ;; to tell. + ;; FIXME: Maybe this should be done in vc.el (i.e. for other backends), + ;; but since Git is one of the two backends that support this operation + ;; so far, it's hard to tell; hg doesn't need this. (with-temp-buffer (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer)) (goto-char (point-min)) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 6ecf9fb41d..17d38fa400 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -483,6 +483,55 @@ If LIMIT is non-nil, show no more than this many entries." (autoload 'vc-switches "vc") +(defun vc-hg-region-history (file buffer lfrom lto) + "Insert into BUFFER the history of FILE for lines LFROM to LTO. +This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"." + (vc-hg-command buffer 'async nil "log" "-f" "-p" "-L" + (format "%s,%d:%d" (file-relative-name file) lfrom lto))) + +(require 'diff-mode) + +(defvar vc-hg-region-history-mode-map + (let ((map (make-composed-keymap + nil (make-composed-keymap + (list diff-mode-map vc-hg-log-view-mode-map))))) + map)) + +(defvar vc-hg--log-view-long-font-lock-keywords nil) +(defvar font-lock-keywords) +(defvar vc-hg-region-history-font-lock-keywords + '((vc-hg-region-history-font-lock))) + +(defun vc-hg-region-history-font-lock (limit) + (let ((in-diff (save-excursion + (beginning-of-line) + (or (looking-at "^\\(?:diff\\|changeset\\)\\>") + (re-search-backward "^\\(?:diff\\|changeset\\)\\>" + nil t)) + (eq ?d (char-after (match-beginning 0)))))) + (while + (let ((end (save-excursion + (if (re-search-forward "\n\\(diff\\|changeset\\)\\>" + limit t) + (match-beginning 1) + limit)))) + (let ((font-lock-keywords (if in-diff diff-font-lock-keywords + vc-hg--log-view-long-font-lock-keywords))) + (font-lock-fontify-keywords-region (point) end)) + (goto-char end) + (prog1 (< (point) limit) + (setq in-diff (eq ?d (char-after)))))) + nil)) + +(define-derived-mode vc-hg-region-history-mode + vc-hg-log-view-mode "Hg-Region-History" + "Major mode to browse Hg's \"log -p\" output." + (setq-local vc-hg--log-view-long-font-lock-keywords + log-view-font-lock-keywords) + (setq-local font-lock-defaults + (cons 'vc-hg-region-history-font-lock-keywords + (cdr font-lock-defaults)))) + (defun vc-hg-diff (files &optional oldvers newvers buffer _async) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) commit 4ba880e53bd8cbf31fde8ef37b6290a33d8f6e71 Author: Lars Ingebrigtsen Date: Thu Nov 21 14:58:45 2019 +0100 Fix up previous #' documentation addition * doc/lispref/objects.texi (Special Read Syntax): Add an xref for the #' (bug#38278). diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 716d7c920b..2a2a476e9a 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -126,7 +126,7 @@ empty string (@pxref{Symbol Type}). @item #' Expands to @code{function} and is commonly used to quote function symbols (as opposed to @samp{'} which is used to quote non-function -symbols). +symbols (@pxref{Anonymous Functions})). @item #: The printed representation of an uninterned symbol whose name is commit 7ceb22e3e1597eb85641d1f75b071fc1f1bff94e Author: Lars Ingebrigtsen Date: Thu Nov 21 14:55:34 2019 +0100 Document the #' syntax * doc/lispref/objects.texi (Special Read Syntax): Document the #' syntax (bug#38278). diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index e07dc2ed06..716d7c920b 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -123,6 +123,11 @@ Objects that have no read syntax are presented like this The printed representation of an interned symbol whose name is an empty string (@pxref{Symbol Type}). +@item #' +Expands to @code{function} and is commonly used to quote function +symbols (as opposed to @samp{'} which is used to quote non-function +symbols). + @item #: The printed representation of an uninterned symbol whose name is @var{foo} is @samp{#:@var{foo}} (@pxref{Symbol Type}). commit 37999b2eecd11536ebdad7d9527b45be93813a0a Author: Lars Ingebrigtsen Date: Thu Nov 21 14:32:56 2019 +0100 Restore point after sending a message * lisp/gnus/message.el (message-send-and-exit): Restore point after sending (bug#38303). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 9de35bd44c..83ec211a7d 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4123,6 +4123,7 @@ The usage of ARG is defined by the instance that called Message. It should typically alter the sending method in some way or other." (interactive "P") (let ((buf (current-buffer)) + (position (point-marker)) (actions message-exit-actions)) (when (and (message-send arg) (buffer-live-p buf)) @@ -4130,7 +4131,13 @@ It should typically alter the sending method in some way or other." (if message-kill-buffer-on-exit (kill-buffer buf)) (message-do-actions actions) - t))) + t) + ;; Restore the point in the message buffer. + (when (buffer-live-p buf) + (save-window-excursion + (switch-to-buffer buf) + (set-window-point nil position) + (set-marker position nil))))) (defun message-dont-send () "Don't send the message you have been editing. commit bc4190b3f4c3b47bb2f5a955236a6d7195d8a748 Author: Lars Ingebrigtsen Date: Thu Nov 21 14:09:32 2019 +0100 Make pp-buffer into a command * lisp/emacs-lisp/pp.el (pp-buffer): Make into a command (bug#38306). diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index de4cbfc0e1..ca5114eddf 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -53,6 +53,7 @@ to make output that `read' can handle, whenever this is possible." ;;;###autoload (defun pp-buffer () "Prettify the current buffer with printed representation of a Lisp object." + (interactive) (goto-char (point-min)) (while (not (eobp)) ;; (message "%06d" (- (point-max) (point))) commit 4a13c2af9b98176f2e51061c525313e8af1a0231 Author: Lars Ingebrigtsen Date: Thu Nov 21 14:02:00 2019 +0100 Fix loading image-converter in the case where the type is passed in * lisp/image.el (create-image): Load image-converter when converting images (bug#38310). diff --git a/lisp/image.el b/lisp/image.el index e0965c1091..6e19f17fd2 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -480,6 +480,7 @@ Image file names that are not absolute are searched for in the ;; If we have external image conversion switched on (for exotic, ;; non-native image formats), then we convert the file. (when (eq type 'image-convert) + (require 'image-converter) (setq file-or-data (image-convert file-or-data data-format) type 'png data-p t))) commit 832bdaf6e5ea8a27784099a60f8e401dbe85d6f8 Author: Lars Ingebrigtsen Date: Thu Nov 21 13:59:37 2019 +0100 Rewrite the image-convert doc string * lisp/image/image-converter.el (image-convert): Clarify the calling convention (bug#38310). diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index dedccadcf4..b4d10c861b 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -70,14 +70,18 @@ is a string, it should be a MIME format string like (defun image-convert (image &optional image-format) "Convert IMAGE file to the PNG format. -IMAGE can either be a file name, which will make the return value -a string with the image data. +IMAGE can either be a file name or image data. -If IMAGE-FORMAT is non-nil, IMAGE is a string containing the -image data, and IMAGE-FORMAT is a symbol with a MIME format name -like \"image/webp\". +To pass in image data, IMAGE should a string containing the image +data, and IMAGE-FORMAT should be a symbol with a MIME format name +like \"image/webp\". For instance: -IMAGE can also be an image object as returned by `create-image'." + (image-convert data-string 'image/bmp) + +IMAGE can also be an image object as returned by `create-image'. + +This function converts the image to PNG, and the converted image +data is returned as a string." ;; Find an installed image converter. (unless image-converter (image-converter--find-converter)) commit f13a4afde747756c4c02fadf49ea6c617cfd42c6 Author: Dario Gjorgjevski Date: Thu Nov 21 13:51:55 2019 +0100 Hide quoted passwords with spaces in Authinfo * lisp/auth-source.el (auth-source-netrc-looking-at-one): New function, extracted from auth-source-netrc-parse-one. (auth-source-netrc-parse-one, authinfo--hide-passwords): Use auth-source-netrc-looking-at-one (bug#38311). diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 4926f67f0a..89a468570a 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1000,13 +1000,18 @@ Note that the MAX parameter is used so we can exit the parse early." (forward-line 1) (skip-chars-forward "\t "))) +(defun auth-source-netrc-looking-at-token () + "Say whether the next think in the buffer is a token (password, etc). +Match data is altered to reflect the token." + (or (looking-at "'\\([^']*\\)'") + (looking-at "\"\\([^\"]*\\)\"") + (looking-at "\\([^ \t\n]+\\)"))) + (defun auth-source-netrc-parse-one () "Read one thing from the current buffer." (auth-source-netrc-parse-next-interesting) - (when (or (looking-at "'\\([^']*\\)'") - (looking-at "\"\\([^\"]*\\)\"") - (looking-at "\\([^ \t\n]+\\)")) + (when (auth-source-netrc-looking-at-token) (forward-char (length (match-string 0))) (prog1 (match-string-no-properties 1) @@ -2427,7 +2432,7 @@ passwords are revealed when point moved into the password. (while (re-search-forward (format "\\(\\s-\\|^\\)\\(%s\\)\\s-+" authinfo-hidden) nil t) - (when (looking-at "[^\n\t ]+") + (when (auth-source-netrc-looking-at-token) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'display (propertize "****" 'face 'warning))