commit e1f09607e02eb507b229285ed48b85a3c6a50259 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Mon Aug 3 09:14:52 2020 +0200 Make `n'/`p' in image-mode also find externally converted images * lisp/image-file.el (image-file-name-regexp): Use it to make `n'/`p' in image mode work (bug#39994). * lisp/image/image-converter.el (image-converter-file-name-extensions): New variable to keep track of all suffixes. (image-convert-p): Update. (image-converter--find-converter): Set. diff --git a/lisp/image-file.el b/lisp/image-file.el index 89cd75d50d..22366c89e6 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -32,6 +32,7 @@ ;;; Code: (require 'image) +(require 'image-converter) ;;;###autoload @@ -80,10 +81,13 @@ the variable is set using \\[customize]." (let ((exts-regexp (and image-file-name-extensions (concat "\\." - (regexp-opt (nconc (mapcar #'upcase - image-file-name-extensions) - image-file-name-extensions) - t) + (regexp-opt + (append (mapcar #'upcase image-file-name-extensions) + image-file-name-extensions + (mapcar #'upcase + image-converter-file-name-extensions) + image-converter-file-name-extensions) + t) "\\'")))) (mapconcat 'identity diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index b694052f5b..ee1dc845fb 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -42,6 +42,9 @@ installed on the system." (defvar image-converter-regexp nil "A regexp that matches the file name suffixes that can be converted.") +(defvar image-converter-file-name-extensions nil + "A list of file name suffixes that can be converted.") + (defvar image-converter--converters '((graphicsmagick :command ("gm" "convert") :probe ("-list" "format")) (ffmpeg :command "ffmpeg" :probe "-decoders") @@ -58,9 +61,11 @@ is a string, it should be a MIME format string like (unless image-converter (image-converter--find-converter)) ;; When image-converter was customized - (if (and image-converter (not image-converter-regexp)) - (when-let ((formats (image-converter--probe image-converter))) - (setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")))) + (when (and image-converter (not image-converter-regexp)) + (when-let ((formats (image-converter--probe image-converter))) + (setq image-converter-regexp + (concat "\\." (regexp-opt formats) "\\'")) + (setq image-converter-file-name-extensions formats))) (and image-converter (or (and (not data-p) (string-match image-converter-regexp source)) @@ -183,7 +188,8 @@ data is returned as a string." (dolist (elem image-converter--converters) (when-let ((formats (image-converter--probe (car elem)))) (setq image-converter (car elem) - image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")) + image-converter-regexp (concat "\\." (regexp-opt formats) "\\'") + image-converter-file-name-extensions formats) (throw 'done image-converter))))) (cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source commit 79527cd56e9e3f8b5b1630fe18b92f7ea95e87fd Author: Lars Ingebrigtsen Date: Mon Aug 3 09:00:53 2020 +0200 Fix problem with viewing .webp files from .zip buffers * lisp/image-mode.el (image-toggle-display-image): Make it possible to view images (via external formatters, like webp) from zip files (and other archive modes) (bug#39994). diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 129529542a..c417be43da 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -818,13 +818,21 @@ was inserted." (- (nth 2 edges) (nth 0 edges)))) (max-height (when edges (- (nth 3 edges) (nth 1 edges)))) - (type (if (image--imagemagick-wanted-p filename) - 'imagemagick - (image-type file-or-data nil data-p))) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)) - props image) + props image type) + + ;; If the data in the current buffer isn't from an existing file, + ;; but we have a file name (this happens when visiting images from + ;; a zip file, for instance), provide a type hint based on the + ;; suffix. + (when (and data-p filename) + (setq data-p (intern (format "image/%s" + (file-name-extension filename))))) + (setq type (if (image--imagemagick-wanted-p filename) + 'imagemagick + (image-type file-or-data nil data-p))) ;; Get the rotation data from the file, if any. (when (zerop image-transform-rotation) ; don't reset modified value @@ -841,10 +849,13 @@ was inserted." ;; :scale 1: If we do not set this, create-image will apply ;; default scaling based on font size. (setq image (if (not edges) - (create-image file-or-data type data-p :scale 1) + (create-image file-or-data type data-p :scale 1 + :format (and filename data-p)) (create-image file-or-data type data-p :scale 1 :max-width max-width - :max-height max-height))) + :max-height max-height + ;; Type hint. + :format (and filename data-p)))) ;; Discard any stale image data before looking it up again. (image-flush image) commit 26b9a1da63bab8c8ee00a484df46db6ed57e2317 Author: Lars Ingebrigtsen Date: Mon Aug 3 08:18:39 2020 +0200 Adjust error message in image-mode * lisp/image-mode.el (image-mode): Even when `image-user-external-converter' is on, we may get `unknown-image-type' (bug#39994). Adjust the error message in that case. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 1bb213c248..129529542a 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -614,21 +614,23 @@ Key bindings: (if (not (image-get-display-property)) (progn (when (condition-case err - (progn - (image-toggle-display-image) - t) - (unknown-image-type - (image-mode-as-text) - (funcall - (if (called-interactively-p 'any) 'error 'message) - "Unknown image type; consider switching `image-use-external-converter' on") - nil) - (error - (image-mode-as-text) - (funcall - (if (called-interactively-p 'any) 'error 'message) - "Cannot display image: %s" (cdr err)) - nil)) + (progn + (image-toggle-display-image) + t) + (unknown-image-type + (image-mode-as-text) + (funcall + (if (called-interactively-p 'any) 'error 'message) + (if image-use-external-converter + "Unknown image type" + "Unknown image type; consider switching `image-use-external-converter' on")) + nil) + (error + (image-mode-as-text) + (funcall + (if (called-interactively-p 'any) 'error 'message) + "Cannot display image: %s" (cdr err)) + nil)) ;; If attempt to display the image fails. (if (not (image-get-display-property)) (error "Invalid image")) commit f921feceb8cd8c52f281447c984d0b67a738a33c Author: Derek Zhou Date: Mon Aug 3 07:56:22 2020 +0200 Fix problem where TLS connections would sometimes hang * src/process.c (wait_reading_process_output): Before the select, check every interesting gnutls stream for available data in the buffer. If some of them hit, and either there is no wait_proc or the wait_proc is one of the gnutls streams with new data, set the select timeout to 0 after the select, and merge the gnutls buffer status into the select returns (bug#40665). This fixes a problem where TLS connections would sometimes hang. diff --git a/src/process.c b/src/process.c index 6e5bcf307a..15634e4a8b 100644 --- a/src/process.c +++ b/src/process.c @@ -5491,6 +5491,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, } else { +#ifdef HAVE_GNUTLS + int tls_nfds; + fd_set tls_available; +#endif /* Set the timeout for adaptive read buffering if any process has non-zero read_output_skip and non-zero read_output_delay, and we are not reading output for a @@ -5560,7 +5564,36 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, } #endif -/* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ +#ifdef HAVE_GNUTLS + /* GnuTLS buffers data internally. We need to check if some + data is available in the buffers manually before the select. + And if so, we need to skip the select which could block. */ + FD_ZERO (&tls_available); + tls_nfds = 0; + for (channel = 0; channel < FD_SETSIZE; ++channel) + if (! NILP (chan_process[channel]) + && FD_ISSET (channel, &Available)) + { + struct Lisp_Process *p = XPROCESS (chan_process[channel]); + if (p + && p->gnutls_p && p->gnutls_state + && emacs_gnutls_record_check_pending (p->gnutls_state) > 0) + { + tls_nfds++; + eassert (p->infd == channel); + FD_SET (p->infd, &tls_available); + } + } + /* If wait_proc is somebody else, we have to wait in select + as usual. Otherwise, clobber the timeout. */ + if (tls_nfds > 0 + && (!wait_proc || + (wait_proc->infd >= 0 + && FD_ISSET (wait_proc->infd, &tls_available)))) + timeout = make_timespec (0, 0); +#endif + + /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ #if defined HAVE_GLIB && !defined HAVE_NS nfds = xg_select (max_desc + 1, &Available, (check_write ? &Writeok : 0), @@ -5578,59 +5611,21 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #endif /* !HAVE_GLIB */ #ifdef HAVE_GNUTLS - /* GnuTLS buffers data internally. In lowat mode it leaves - some data in the TCP buffers so that select works, but - with custom pull/push functions we need to check if some - data is available in the buffers manually. */ - if (nfds == 0) + /* Merge tls_available into Available. */ + if (tls_nfds > 0) { - fd_set tls_available; - int set = 0; - - FD_ZERO (&tls_available); - if (! wait_proc) + if (nfds == 0 || (nfds < 0 && errno == EINTR)) { - /* We're not waiting on a specific process, so loop - through all the channels and check for data. - This is a workaround needed for some versions of - the gnutls library -- 2.12.14 has been confirmed - to need it. */ - for (channel = 0; channel < FD_SETSIZE; ++channel) - if (! NILP (chan_process[channel])) - { - struct Lisp_Process *p = - XPROCESS (chan_process[channel]); - if (p && p->gnutls_p && p->gnutls_state - && ((emacs_gnutls_record_check_pending - (p->gnutls_state)) - > 0)) - { - nfds++; - eassert (p->infd == channel); - FD_SET (p->infd, &tls_available); - set++; - } - } - } - else - { - /* Check this specific channel. */ - if (wait_proc->gnutls_p /* Check for valid process. */ - && wait_proc->gnutls_state - /* Do we have pending data? */ - && ((emacs_gnutls_record_check_pending - (wait_proc->gnutls_state)) - > 0)) - { - nfds = 1; - eassert (0 <= wait_proc->infd); - /* Set to Available. */ - FD_SET (wait_proc->infd, &tls_available); - set++; - } + /* Fast path, just copy. */ + nfds = tls_nfds; + Available = tls_available; } - if (set) - Available = tls_available; + else if (nfds > 0) + /* Slow path, merge one by one. Note: nfds does not need + to be accurate, just positive is enough. */ + for (channel = 0; channel < FD_SETSIZE; ++channel) + if (FD_ISSET(channel, &tls_available)) + FD_SET(channel, &Available); } #endif } commit a325584281c4d8552917fcb97caed449acb7ee65 Author: Philipp Stephani Date: Sun Aug 2 22:07:27 2020 +0200 Improve Edebug symbols for inlined secondary methods (Bug#42671) * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Include qualifiers in Edebug symbol name. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method): Adapt unit test. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 640eb6b06d..02da07daaf 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -220,7 +220,7 @@ DEFAULT-BODY, if present, is used as the body of a default method. ;; requires larger changes to ;; Edebug. :unique "cl-generic-:method@" - [&rest atom] + [&rest cl-generic-method-qualifier] cl-generic-method-args lambda-doc def-body)]] def-body))) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index fc39e34952..5aa58782f3 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -256,7 +256,8 @@ Edebug symbols (Bug#42672)." (with-temp-buffer (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_) (:method ((_ number)) 1) - (:method ((_ string)) 2)) + (:method ((_ string)) 2) + (:method :around ((_ number)) 3)) (cl-defgeneric cl-defgeneric/edebug/method/2 (_) (:method ((_ number)) 3)))) (print form (current-buffer))) @@ -272,18 +273,19 @@ Edebug symbols (Bug#42672)." ;; Make generated symbols reproducible. (gensym-counter 10000)) (eval-buffer) - (should (equal (reverse instrumented-names) - ;; The generic function definitions come after - ;; the method definitions because their body ends - ;; later. - ;; FIXME: We'd rather have names such as - ;; `cl-defgeneric/edebug/method/1 ((_ number))', - ;; but that requires further changes to Edebug. - (list (intern "cl-generic-:method@10000 ((_ number))") - (intern "cl-generic-:method@10001 ((_ string))") - 'cl-defgeneric/edebug/method/1 - (intern "cl-generic-:method@10002 ((_ number))") - 'cl-defgeneric/edebug/method/2)))))) + (should (equal + (reverse instrumented-names) + ;; The generic function definitions come after the + ;; method definitions because their body ends later. + ;; FIXME: We'd rather have names such as + ;; `cl-defgeneric/edebug/method/1 ((_ number))', but + ;; that requires further changes to Edebug. + (list (intern "cl-generic-:method@10000 ((_ number))") + (intern "cl-generic-:method@10001 ((_ string))") + (intern "cl-generic-:method@10002 :around ((_ number))") + 'cl-defgeneric/edebug/method/1 + (intern "cl-generic-:method@10003 ((_ number))") + 'cl-defgeneric/edebug/method/2)))))) (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here commit 2ad38b4745bf0203ca9ca0fe2eeb376943d384c6 Author: Lars Ingebrigtsen Date: Sun Aug 2 19:44:30 2020 +0200 If gnus-visual is nil, don't fontify patches and the like * doc/misc/emacs-mime.texi (Display Customization): Document it. * lisp/gnus/gnus-art.el (gnus-mime-display-single): Bind it. * lisp/gnus/mm-view.el (mm-inline-font-lock): New variable (bug#38421). (mm-display-inline-fontify): Use it. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 2f38dcd495..974cc10458 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -472,6 +472,13 @@ the case if you save it to disk and launch it in a different way to launch any external programs, set this variable to @code{nil} or @code{ask}. +@item mm-inline-font-lock +@vindex mm-inline-font-lock +If non-@code{nil}, inlined parts that support font locking (for +instance, patches or code snippets) will be font-locked. This may be +overriden by callers that have their own ways of enabling/inhibiting +font locking. + @end table @node Files and Directories diff --git a/etc/NEWS b/etc/NEWS index aeba96e381..7221c9cf9e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -231,6 +231,12 @@ was sent. To restore the original behavior of dating a message from when it is first saved or delayed, add the symbol 'Date' back to this user option. ++++ +*** New variable 'mm-inline-font-lock'. +This variable is supposed to be bound by callers to determine whether +inline MIME parts (that support it) are supposed to be font-locked or +not. + ** Help +++ diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cb20d7102b..d33539bc7f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6018,6 +6018,7 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-single (handle) (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) + (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) display text) (catch 'ignored diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 828ac633dc..bd5960c18b 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -59,11 +59,16 @@ "The attributes of renderer types for text/html.") (defcustom mm-fill-flowed t - "If non-nil a format=flowed article will be displayed flowed." + "If non-nil, format=flowed articles will be displayed flowed." :type 'boolean :version "22.1" :group 'mime-display) +;; Not a defcustom, since it's usually overridden by the callers of +;; the mm functions. +(defvar mm-inline-font-lock t + "If non-nil, do font locking of inline media types that support it.") + (defcustom mm-inline-large-images-proportion 0.9 "Maximum proportion large images can occupy in the buffer. This is only used if `mm-inline-large-images' is set to @@ -502,7 +507,8 @@ If MODE is not set, try to find mode automatically." (delay-mode-hooks (set-auto-mode)) (setq mode major-mode))) ;; Do not fontify if the guess mode is fundamental. - (unless (eq major-mode 'fundamental-mode) + (when (and (not (eq major-mode 'fundamental-mode)) + mm-inline-font-lock) (font-lock-ensure)))) (setq text (buffer-string)) (when (eq mode 'diff-mode) commit 94b6eb807c8991897796fd18ccd414c7d9b9ad3b Author: Lars Ingebrigtsen Date: Sun Aug 2 19:03:07 2020 +0200 Document that :width/:height in XBM images are peculiar * doc/lispref/display.texi (XBM Images): Note the peculiarities of :width/:height in XBM images (bug#39735). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 25eabd6c3f..d3adb62c1b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5572,6 +5572,15 @@ The value, @var{width}, specifies the width of the image, in pixels. @item :height @var{height} The value, @var{height}, specifies the height of the image, in pixels. +Note that @code{:width} and @code{:height} can only be used if passing +in data that doesn't specify the width and height (e.g., a string or a +vector containing the bits of the image). @acronym{XBM} files usually +specify this themselves, and it's an error to use these two properties +on these files. Also note that @code{:width} and @code{:height} are +used by most other image formats to specify what the displayed image +is supposed to be, which usually means performing some sort of +scaling. This isn't supported for @acronym{XBM} images. + @item :stride @var{stride} The number of bool vector entries stored for each row; the smallest multiple of 8 greater than or equal to @var{width}. commit 3e0c3479b24e1978d30bbcc00faac7bdd6bdd170 Author: Philipp Stephani Date: Sun Aug 2 18:05:36 2020 +0200 Add a workaround for Bug#42672 * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Work around Bug#42672 by uniquifying inline method names. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method): New regression test. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c67681b096..640eb6b06d 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method. [&rest [&or ("declare" &rest sexp) (":argument-precedence-order" &rest sexp) - (&define ":method" [&rest atom] + (&define ":method" + ;; FIXME: The `:unique' + ;; construct works around + ;; Bug#42672. We'd rather want + ;; names like those generated by + ;; `cl-defmethod', but that + ;; requires larger changes to + ;; Edebug. + :unique "cl-generic-:method@" + [&rest atom] cl-generic-method-args lambda-doc def-body)]] def-body))) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 51c9884ddc..fc39e34952 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -24,6 +24,7 @@ ;;; Code: (require 'cl-generic) +(require 'edebug) ;; Don't indirectly require `cl-lib' at run-time. (eval-when-compile (require 'ert)) @@ -249,5 +250,40 @@ (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) +(ert-deftest cl-defgeneric/edebug/method () + "Check that `:method' forms in `cl-defgeneric' create unique +Edebug symbols (Bug#42672)." + (with-temp-buffer + (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_) + (:method ((_ number)) 1) + (:method ((_ string)) 2)) + (cl-defgeneric cl-defgeneric/edebug/method/2 (_) + (:method ((_ number)) 3)))) + (print form (current-buffer))) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name))) + ;; Make generated symbols reproducible. + (gensym-counter 10000)) + (eval-buffer) + (should (equal (reverse instrumented-names) + ;; The generic function definitions come after + ;; the method definitions because their body ends + ;; later. + ;; FIXME: We'd rather have names such as + ;; `cl-defgeneric/edebug/method/1 ((_ number))', + ;; but that requires further changes to Edebug. + (list (intern "cl-generic-:method@10000 ((_ number))") + (intern "cl-generic-:method@10001 ((_ string))") + 'cl-defgeneric/edebug/method/1 + (intern "cl-generic-:method@10002 ((_ number))") + 'cl-defgeneric/edebug/method/2)))))) + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here commit 0a65e060207def5d31fb7d96b8d3bb1441fd13c9 Author: Philipp Stephani Date: Sun Aug 2 18:04:18 2020 +0200 ; * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-flet): Fix typo. diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index be9f150379..1be68f6ff4 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -961,7 +961,7 @@ primary ones (Bug#42671)." (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) (ert-deftest edebug-tests-cl-flet () - "Check what Edebug can instrument `cl-flet' forms without name + "Check that Edebug can instrument `cl-flet' forms without name clashes (Bug#41853)." (with-temp-buffer (dolist (form '((defun edebug-tests-cl-flet-1 () commit d8ab98843edccd233c2354d3c518c7a4b18023bd Author: Philipp Stephani Date: Sun Aug 2 17:17:00 2020 +0200 Avoid duplicate Edebug symbols when using ‘cl-flet’ (Bug#41989) * lisp/emacs-lisp/edebug.el (edebug-match-:unique): Add a new ‘:unique’ specifier to generate unique names. * lisp/emacs-lisp/cl-macs.el (cl-flet): Use it. This requires inlining the ‘cl-defun’ specification. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-flet): New unit test. * doc/lispref/edebug.texi (Specification List): Document new ‘:unique’ construct. diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index d879f3dcad..6404e068da 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1438,6 +1438,16 @@ name component for the definition. You can use this to add a unique, static component to the name of the definition. It may be used more than once. +@item :unique +This construct is like @code{:name}, but generates unique names. It +does not match an argument. The element following @code{:unique} +should be a string; it is used as the prefix for an additional name +component for the definition. You can use this to add a unique, +dynamic component to the name of the definition. This is useful for +macros that can define the same symbol multiple times in different +scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may +be used more than once. + @item arg The argument, a symbol, is the name of an argument of the defining form. However, lambda-list keywords (symbols starting with @samp{&}) diff --git a/etc/NEWS b/etc/NEWS index 492d01feed..aeba96e381 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -260,6 +260,10 @@ To revert to the previous behaviour, unconditionally aborts the current edebug instrumentation with the supplied error message. +*** Edebug specification lists can use the new keyword ':unique', +which appends a unique suffix to the Edebug name of the current +definition. + +++ ** ElDoc diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 6c1426ce5c..c38019d4a7 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2016,7 +2016,12 @@ info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) - (debug ((&rest [&or (&define name function-form) (cl-defun)]) + (debug ((&rest [&or (&define name :unique "cl-flet@" function-form) + (&define name :unique "cl-flet@" + cl-lambda-list + cl-declarations-or-string + [&optional ("interactive" interactive)] + def-body)]) cl-declarations body))) (let ((binds ()) (newenv macroexpand-all-environment)) (dolist (binding bindings) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7627829e03..cef97e0fb4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1725,6 +1725,7 @@ contains a circular object." (&define . edebug-match-&define) (name . edebug-match-name) (:name . edebug-match-colon-name) + (:unique . edebug-match-:unique) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) @@ -2037,6 +2038,17 @@ contains a circular object." spec)) nil) +(defun edebug-match-:unique (_cursor spec) + "Match a `:unique PREFIX' specifier. +SPEC is the symbol name prefix for `gensym'." + (let ((suffix (gensym spec))) + (setq edebug-def-name + (if edebug-def-name + ;; Construct a new name by appending to previous name. + (intern (format "%s@%s" edebug-def-name suffix)) + suffix))) + nil) + (defun edebug-match-cl-generic-method-qualifier (cursor) "Match a QUALIFIER for `cl-defmethod' at CURSOR." (let ((args (edebug-top-element-required cursor "Expected qualifier"))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 89b1f29374..be9f150379 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -960,5 +960,45 @@ primary ones (Bug#42671)." (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) +(ert-deftest edebug-tests-cl-flet () + "Check what Edebug can instrument `cl-flet' forms without name +clashes (Bug#41853)." + (with-temp-buffer + (dolist (form '((defun edebug-tests-cl-flet-1 () + (cl-flet ((inner () 0)) (message "Hi")) + (cl-flet ((inner () 1)) (inner))) + (defun edebug-tests-cl-flet-2 () + (cl-flet ((inner () 2)) (inner))))) + (print form (current-buffer))) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name))) + ;; Make generated symbols reproducible. + (gensym-counter 10000)) + (eval-buffer) + (should (equal (reverse instrumented-names) + ;; The outer definitions come after the inner + ;; ones because their body ends later. + ;; FIXME: There are twice as many inner + ;; definitions as expected due to Bug#41988. + ;; Once that bug is fixed, remove the duplicates. + ;; FIXME: We'd rather have names such as + ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000', + ;; but that requires further changes to Edebug. + '(inner@cl-flet@10000 + inner@cl-flet@10001 + inner@cl-flet@10002 + inner@cl-flet@10003 + edebug-tests-cl-flet-1 + inner@cl-flet@10004 + inner@cl-flet@10005 + edebug-tests-cl-flet-2)))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here commit a07ec21bf24b8d1dc41808f997dd0fb78cad3870 Author: Eli Zaretskii Date: Sun Aug 2 18:27:33 2020 +0300 Re-enable scroll-margin when cursor-motion optimization is disabled * src/xdisp.c (try_window): Fix logic of disabling margins when cursor is close to BOB or EOB. Account for header-line, if any, when computing the scroll margin in pixels. (Bug#42653) diff --git a/src/xdisp.c b/src/xdisp.c index fc17014c02..a8cd4dc853 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19223,18 +19223,20 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) && !MINI_WINDOW_P (w)) { int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + if (window_wants_header_line (w)) + this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); start_display (&it, w, pos); if ((w->cursor.y >= 0 /* not vscrolled */ && w->cursor.y < this_scroll_margin - && CHARPOS (pos) > BEGV - && it_charpos < ZV) + && CHARPOS (pos) > BEGV) /* rms: considering make_cursor_line_fully_visible_p here seems to give wrong results. We don't want to recenter when the last line is partly visible, we want to allow that case to be handled in the usual way. */ - || w->cursor.y > (it.last_visible_y - partial_line_height (&it) - - this_scroll_margin - 1)) + || (it_charpos < ZV /* if EOB is visible, disable bottom margin */ + && w->cursor.y > (it.last_visible_y - partial_line_height (&it) + - this_scroll_margin - 1))) { w->cursor.vpos = -1; clear_glyph_matrix (w->desired_matrix); commit 2e9d1f4d44036e7c0605cfeac091368e013e3ed9 Author: Philipp Stephani Date: Sun Aug 2 16:05:44 2020 +0200 * src/alloc.c (mark_maybe_object): Avoid signed integer overflow diff --git a/src/alloc.c b/src/alloc.c index da11426075..5220ef8478 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4652,7 +4652,8 @@ mark_maybe_object (Lisp_Object obj) #else (void) overflow; #endif - void *po = (char *) ((intptr_t) (char *) XLP (obj) + offset); + INT_ADD_WRAPV (offset, (intptr_t) (char *) XLP (obj), &offset); + void *po = (char *) offset; /* If the pointer is in the dump image and the dump has a record of the object starting at the place where the pointer points, we commit e6eb554b95327549992c3684910921db9181ffb6 Author: Philipp Stephani Date: Sun Aug 2 16:01:47 2020 +0200 Don’t generate duplicate symbols for secondary CL methods (Bug#42671) * lisp/emacs-lisp/edebug.el (edebug-match-cl-generic-method-qualifier): Add matcher for ‘cl-defmethod’ qualifier. * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Use it. * test/lisp/emacs-lisp/edebug-tests.el (edebug-cl-defmethod-qualifier): New unit test. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 4e8423eb5b..c67681b096 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -432,9 +432,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (&define ; this means we are defining something [&or name ("setf" name :name setf)] ;; ^^ This is the methods symbol - [ &rest atom ] ; Multiple qualifiers are allowed. - ; Like in CLOS spec, we support - ; any non-list values. + [ &rest cl-generic-method-qualifier ] + ;; Multiple qualifiers are allowed. cl-generic-method-args ; arguments lambda-doc ; documentation string def-body))) ; part to be debugged diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a565e8f6dc..7627829e03 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1731,6 +1731,8 @@ contains a circular object." ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) + (cl-generic-method-qualifier + . edebug-match-cl-generic-method-qualifier) (cl-generic-method-args . edebug-match-cl-generic-method-args) (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) @@ -2035,6 +2037,16 @@ contains a circular object." spec)) nil) +(defun edebug-match-cl-generic-method-qualifier (cursor) + "Match a QUALIFIER for `cl-defmethod' at CURSOR." + (let ((args (edebug-top-element-required cursor "Expected qualifier"))) + ;; Like in CLOS spec, we support any non-list values. + (unless (atom args) (edebug-no-match cursor "Atom expected")) + ;; Append the arguments to `edebug-def-name' (Bug#42671). + (setq edebug-def-name (intern (format "%s %s" edebug-def-name args))) + (edebug-move-cursor cursor) + (list args))) + (defun edebug-match-cl-generic-method-args (cursor) (let ((args (edebug-top-element-required cursor "Expected arguments"))) (if (not (consp args)) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 41811c9dc0..89b1f29374 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -938,5 +938,27 @@ test and possibly others should be updated." "g" (should (equal edebug-tests-@-result '(0 1)))))) +(ert-deftest edebug-cl-defmethod-qualifier () + "Check that secondary `cl-defmethod' forms don't stomp over +primary ones (Bug#42671)." + (with-temp-buffer + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (defined-symbols ()) + (edebug-new-definition-function + (lambda (def-name) + (push def-name defined-symbols) + (edebug-new-definition def-name)))) + (dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number))) + (cl-defmethod edebug-cl-defmethod-qualifier + :around ((_ number))))) + (print form (current-buffer))) + (eval-buffer) + (should + (equal + defined-symbols + (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") + (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here commit 418ea25bbf306c448516ea79c9eaf25b904e62e4 Author: Eli Zaretskii Date: Sun Aug 2 17:05:00 2020 +0300 Fix last change in alloc.c. * src/alloc.c (mark_maybe_object) [WIDE_EMACS_INT]: Avoid compiler warning about 'overflow' being unused. diff --git a/src/alloc.c b/src/alloc.c index be293cca54..da11426075 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4649,6 +4649,8 @@ mark_maybe_object (Lisp_Object obj) significant bits as tag bits, the tag is small enough to not overflow either. */ eassert (!overflow); +#else + (void) overflow; #endif void *po = (char *) ((intptr_t) (char *) XLP (obj) + offset); commit 99d1a66646b7450ad0be3e4471341b50fee7bdb5 Author: Lars Ingebrigtsen Date: Sun Aug 2 14:32:19 2020 +0200 Make the "All" setting for large-newsgroup-initial in Gnus work * lisp/gnus/gnus-sum.el (gnus-articles-to-read): Use it. (gnus-summary-insert-old-articles): Ditto. * lisp/gnus/gnus.el (large-newsgroup-initial): Make the "All" setting work by using a special symbol, instead of nil which is indistinguishable from not being present (bug#38466). diff --git a/etc/NEWS b/etc/NEWS index fab2d85e8d..492d01feed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -207,6 +207,12 @@ Bookmark locations can refer to VC directory buffers. ** Gnus +--- +*** The value of "all" in the 'large-newsgroup-initial' group parameter changes. +It was previously nil, which didn't work, because nil is +indistinguishable from not being present. The new value for "all" is +the symbol 'all'. + +++ *** The name of dependent Gnus sessions has changed from "slave" to "child". The names of the commands 'gnus-slave', 'gnus-slave-no-server' and diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index c1216a0cc2..719498a033 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5938,7 +5938,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) (default (if only-read-p - (or initial gnus-large-newsgroup) + (if (eq initial 'all) + nil + (or initial gnus-large-newsgroup)) number)) (input (read-string @@ -13165,10 +13167,13 @@ If ALL is a number, fetch this number of articles." (t (when (and (numberp gnus-large-newsgroup) (> len gnus-large-newsgroup)) - (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial - gnus-newsgroup-name)) - (input + (let ((cursor-in-echo-area nil) + (initial (gnus-parameter-large-newsgroup-initial + gnus-newsgroup-name)) + input) + (when (eq initial 'all) + (setq initial len)) + (setq input (read-string (format "How many articles from %s (%s %d): " @@ -13177,7 +13182,7 @@ If ALL is a number, fetch this number of articles." len) nil nil (and initial - (number-to-string initial))))) + (number-to-string initial)))) (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 69f2bb2799..68e2ce772c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1591,7 +1591,7 @@ posting an article." "Alist of group regexps and its initial input of the number of articles." :variable-group gnus-group-parameter :parameter-type '(choice :tag "Initial Input for Large Newsgroup" - (const :tag "All" nil) + (const :tag "All" 'all) (integer)) :parameter-document "\ commit dc8aa15472dc5df5f903e6a3b150e2f03eeb2dd1 Author: Michael Albinus Date: Sun Aug 2 13:26:00 2020 +0200 Fix Tramp portability issues * lisp/net/tramp-sh.el (tramp-set-remote-path): Replace "echo -n" by "printf", it isn't portable. * test/lisp/net/tramp-tests.el (tramp-test33-environment-variables) (tramp-test33-environment-variables-and-port-numbers): Do not use "echo -n", it isn't portable. (tramp--test-utf8): Filter out not displayable characters. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9f37207def..f9f0cbcc02 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4079,7 +4079,7 @@ variable PATH." chunk (substring command 0 chunksize) command (substring command chunksize)) (tramp-send-command vec (format - "echo -n %s >>%s" + "printf \"%%b\" \"$*\" %s >>%s" (tramp-shell-quote-argument chunk) (tramp-shell-quote-argument tmpfile)))) (tramp-send-command vec (format ". %s" tmpfile)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 19da15acaf..ac24fcf280 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4933,16 +4933,16 @@ INPUT, if non-nil, is a string sent to the process." (setenv "INSIDE_EMACS") (should (string-equal - (format "%s,tramp:%s" emacs-version tramp-version) - (funcall this-shell-command-to-string "echo -n ${INSIDE_EMACS:-bla}"))) + (format "%s,tramp:%s\n" emacs-version tramp-version) + (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))) (let ((process-environment (cons (format "INSIDE_EMACS=%s,foo" emacs-version) process-environment))) (should (string-equal - (format "%s,foo,tramp:%s" emacs-version tramp-version) + (format "%s,foo,tramp:%s\n" emacs-version tramp-version) (funcall - this-shell-command-to-string "echo -n ${INSIDE_EMACS:-bla}")))) + this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))) ;; Set a value. (let ((process-environment @@ -4952,7 +4952,7 @@ INPUT, if non-nil, is a string sent to the process." (string-match "foo" (funcall - this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar))))) + this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))) ;; Set the empty value. (let ((process-environment @@ -4962,7 +4962,7 @@ INPUT, if non-nil, is a string sent to the process." (string-match "bla" (funcall - this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar)))) + this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) ;; Variable is set. (should (string-match @@ -4979,15 +4979,14 @@ INPUT, if non-nil, is a string sent to the process." (string-match "foo" (funcall - this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar)))) + this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) (let ((process-environment (cons envvar process-environment))) ;; Variable is unset. (should (string-match "bla" (funcall - this-shell-command-to-string - (format "echo -n ${%s:-bla}" envvar)))) + this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) ;; Variable is unset. (should-not (string-match @@ -5026,7 +5025,7 @@ INPUT, if non-nil, is a string sent to the process." (should (string-match (number-to-string port) - (shell-command-to-string (format "echo -n $%s" envvar)))))) + (shell-command-to-string (format "echo $%s" envvar)))))) ;; Cleanup. (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:")) @@ -6051,6 +6050,12 @@ Use the `ls' command." (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) (unencodable-char-position 0 (length x) file-name-coding-system nil x))) + ;; Filter out not displayable characters. + (setq x (mapconcat + (lambda (y) + (and (char-displayable-p y) (char-to-string y))) + x "")) + (not (string-empty-p x)) ;; ?\n and ?/ shouldn't be part of any file name. ?\t, ;; ?. and ?? do not work for "smb" method. (replace-regexp-in-string "[\t\n/.?]" "" x))) commit 069b58b7c852b59f8ef7642e21db339626045671 Author: Philipp Stephani Date: Sun Aug 2 12:58:44 2020 +0200 * src/alloc.c (mark_memory): Avoid signed integer overflow diff --git a/src/alloc.c b/src/alloc.c index e139d8cf26..be293cca54 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4861,7 +4861,7 @@ mark_memory (void const *start, void const *end) On a host with 32-bit pointers and 64-bit Lisp_Objects, a Lisp_Object might be split into registers saved into non-adjacent words and P might be the low-order word's value. */ - p = (char *) ((intptr_t) p + (intptr_t) lispsym); + p = (char *) ((uintptr_t) p + (uintptr_t) lispsym); mark_maybe_pointer (p); verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); commit 929e7e141c5780e51173fda7d7fc5b73411e4465 Author: Lars Ingebrigtsen Date: Sun Aug 2 11:32:35 2020 +0200 Signal an error in the user clicks "cancel" when signing in epg * lisp/epg.el (epg-sign-string): If the user clicks "cancel" on the pinentry, then we don't have an error from gpg(sm), but instead nothing (bug#39058). Signal an error in that case. diff --git a/lisp/epg.el b/lisp/epg.el index 222fd913e1..5b90bc290a 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1683,7 +1683,8 @@ Otherwise, it makes a cleartext signature." (if (epg-context-result-for context 'error) (let ((errors (epg-context-result-for context 'error))) (signal 'epg-error - (list "Sign failed" (epg-errors-to-string errors)))))) + (list "Sign failed" (epg-errors-to-string errors)))) + (signal 'epg-error '("Signing failed (unknown reason)")))) (epg-read-output context)) (epg-delete-output-file context) (if input-file