commit b83f274869e60342d978ad7e12c5167f0dc8f2a6 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Fri Aug 7 09:30:07 2020 +0200 Add missing "this is documented" marker to previous checkin diff --git a/etc/NEWS b/etc/NEWS index ff3aa8445a..64b77feb11 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -453,6 +453,7 @@ The new default value is 2000000 (2 megabytes). ** Whitespace mode ++++ *** A new style has been added: 'missing-newline-at-eof' If present in 'whitespace-style' (and it is now by default), the final character in the buffer will be highlighted unless it's a newline commit 2a35e54bd5644c52dad99dc2597aff2c4165e1e0 Author: Lars Ingebrigtsen Date: Fri Aug 7 09:28:14 2020 +0200 Make whitespace-mode highlight missing newlines at the end of buffers * lisp/whitespace.el (whitespace-missing-newline-at-eof): New face (bug#34952). (whitespace-report-region): Add a test for end-of-buffer-without-newline. (whitespace-color-on): Ditto. * doc/emacs/display.texi (Useless Whitespace): Document it. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index e96e43b377..5778d95b4d 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1334,6 +1334,10 @@ customize the variable @code{whitespace-line-column}. @item newline Highlight newlines. +@item missing-newline-at-eof +Highlight the final character in a buffer unless it's a newline +character. + @item empty Highlight empty lines at the beginning and/or end of the buffer. diff --git a/etc/NEWS b/etc/NEWS index 81d07c9f32..ff3aa8445a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -451,6 +451,13 @@ to substitute spaces in regexp search. *** The default value of 'hi-lock-highlight-range' was enlarged. The new default value is 2000000 (2 megabytes). +** Whitespace mode + +*** A new style has been added: 'missing-newline-at-eof' +If present in 'whitespace-style' (and it is now by default), the final +character in the buffer will be highlighted unless it's a newline +character. + ** Texinfo --- diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 47434bf3d2..fb5f28c002 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -283,7 +283,8 @@ '(face tabs spaces trailing lines space-before-tab newline indentation empty space-after-tab - space-mark tab-mark newline-mark) + space-mark tab-mark newline-mark + missing-newline-at-eof) "Specify which kind of blank is visualized. It's a list containing some or all of the following values: @@ -326,6 +327,11 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. + missing-newline-at-eof Missing newline at the end of the file is + visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. + empty empty lines at beginning and/or end of buffer are visualized via faces. It has effect only if `face' (see above) @@ -586,6 +592,10 @@ line. Used when `whitespace-style' includes the value `indentation'.") "Face used to visualize big indentation." :group 'whitespace) +(defface whitespace-missing-newline-at-eof + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "red" :foreground "firebrick")) + "Face used to visualize missing newline at the end of the file.") (defvar whitespace-empty 'whitespace-empty "Symbol face used to visualize empty lines at beginning and/or end of buffer. @@ -1700,6 +1710,8 @@ cleaning up these problems." (whitespace-space-after-tab-regexp 'tab)) ((eq (car option) 'space-after-tab::space) (whitespace-space-after-tab-regexp 'space)) + ((eq (car option) 'missing-newline-at-eof) + "[^\n]\\'") (t (cdr option))))) (when (re-search-forward regexp rend t) @@ -2122,7 +2134,10 @@ resultant list will be returned." ((memq 'space-after-tab::space whitespace-active-style) ;; Show SPACEs after TAB (TABs). (whitespace-space-after-tab-regexp 'space))) - 1 whitespace-space-after-tab t))))) + 1 whitespace-space-after-tab t))) + ,@(when (memq 'missing-newline-at-eof whitespace-active-style) + ;; Show missing newline. + `(("[^\n]\\'" 0 'whitespace-missing-newline-at-eof t))))) (font-lock-add-keywords nil whitespace-font-lock-keywords t) (font-lock-flush))) commit 74606481c2859b843ebf3f744c215447458becc2 Author: Paul Eggert Date: Thu Aug 6 19:11:58 2020 -0700 Pacify gcc -Wunused-variable * src/frame.c (Fset_mouse_position, Fset_mouse_pixel_position) (Fset_frame_position): Always use xval, yval. Simplify #if nesting. diff --git a/src/frame.c b/src/frame.c index c21d4708f7..c4dfc35a0c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2565,21 +2565,18 @@ before calling this function on it, like this. if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ frame_set_mouse_position (XFRAME (frame), xval, yval); -#else -#if defined (MSDOS) +#elif defined MSDOS if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); mouse_moveto (xval, yval); } +#elif defined HAVE_GPM + Fselect_frame (frame, Qnil); + term_mouse_moveto (xval, yval); #else -#ifdef HAVE_GPM - { - Fselect_frame (frame, Qnil); - term_mouse_moveto (xval, yval); - } -#endif -#endif + (void) xval; + (void) yval; #endif return Qnil; @@ -2606,21 +2603,18 @@ before calling this function on it, like this. if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); -#else -#if defined (MSDOS) +#elif defined MSDOS if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); mouse_moveto (xval, yval); } +#elif defined HAVE_GPM + Fselect_frame (frame, Qnil); + term_mouse_moveto (xval, yval); #else -#ifdef HAVE_GPM - { - Fselect_frame (frame, Qnil); - term_mouse_moveto (xval, yval); - } -#endif -#endif + (void) xval; + (void) yval; #endif return Qnil; @@ -3657,6 +3651,9 @@ bottom edge of FRAME's display. */) #ifdef HAVE_WINDOW_SYSTEM if (FRAME_TERMINAL (f)->set_frame_offset_hook) FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); +#else + (void) xval; + (void) yval; #endif } commit 874e0e7323631a5da61fa5a7fd35d7a3d9c4af61 Author: Juri Linkov Date: Fri Aug 7 02:55:00 2020 +0300 * lisp/hi-lock.el (hi-lock-set-pattern): Display warning on narrow (bug#42609) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a18310322a..33ca40f8de 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -812,7 +812,9 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (setq hi-lock-interactive-patterns (cdr hi-lock-interactive-patterns) hi-lock-interactive-lighters - (cdr hi-lock-interactive-lighters))))))))) + (cdr hi-lock-interactive-lighters)))) + (when (or (> search-start (point-min)) (< search-end (point-max))) + (message "Hi-lock added only in range %d-%d" search-start search-end))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." commit e038a7571ddb9ec2110533fdd1b359150939c58c Author: Stefan Monnier Date: Thu Aug 6 18:45:33 2020 -0400 * lisp/skeleton.el: Use lexical-binding (skeleton-proxy-new): Use `use-region`. diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 3609d6ba6a..ea4e5dbc22 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -1,4 +1,4 @@ -;;; skeleton.el --- Lisp language extension for writing statement skeletons +;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc. @@ -155,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored." (prefix-numeric-value (or arg current-prefix-arg)) (and skeleton-autowrap - (or (eq last-command 'mouse-drag-region) - (and transient-mark-mode mark-active)) + (use-region-p) ;; Deactivate the mark, in case one of the ;; elements of the skeleton is sensitive ;; to such situations (e.g. it is itself a @@ -259,23 +258,25 @@ available: (goto-char (car skeleton-regions)) (setq skeleton-regions (cdr skeleton-regions))) (let ((beg (point)) - skeleton-modified skeleton-point resume: help input v1 v2) - (setq skeleton-positions nil) - (unwind-protect - (cl-progv - (mapcar #'car skeleton-further-elements) - (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) - (skeleton-internal-list skeleton str)) - (or (eolp) (not skeleton-end-newline) (newline-and-indent)) - (run-hooks 'skeleton-end-hook) - (sit-for 0) - (or (not (eq (window-buffer) (current-buffer))) - (pos-visible-in-window-p beg) - (progn - (goto-char beg) - (recenter 0))) - (if skeleton-point - (goto-char skeleton-point)))))) + skeleton-modified skeleton-point) ;; resume: + (with-suppressed-warnings ((lexical help input v1 v2)) + (dlet (help input v1 v2) + (setq skeleton-positions nil) + (unwind-protect + (cl-progv + (mapcar #'car skeleton-further-elements) + (mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements) + (skeleton-internal-list skeleton str)) + (or (eolp) (not skeleton-end-newline) (newline-and-indent)) + (run-hooks 'skeleton-end-hook) + (sit-for 0) + (or (not (eq (window-buffer) (current-buffer))) + (pos-visible-in-window-p beg) + (progn + (goto-char beg) + (recenter 0))) + (if skeleton-point + (goto-char skeleton-point)))))))) (defun skeleton-read (prompt &optional initial-input recursive) "Function for reading a string from the minibuffer within skeletons. @@ -328,36 +329,39 @@ automatically, and you are prompted to fill in the variable parts."))) (signal 'quit t) prompt)) -(defun skeleton-internal-list (skeleton-il &optional str recursive) +(defun skeleton-internal-list (skeleton &optional str recursive) (let* ((start (line-beginning-position)) (column (current-column)) (line (buffer-substring start (line-end-position))) - opoint) - (or str - (setq str `(setq str - (skeleton-read ',(car skeleton-il) nil ,recursive)))) - (when (and (eq (cadr skeleton-il) '\n) (not recursive) - (save-excursion (skip-chars-backward " \t") (bolp))) - (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) - (while (setq skeleton-modified (eq opoint (point)) - opoint (point) - skeleton-il (cdr skeleton-il)) - (condition-case quit - (skeleton-internal-1 (car skeleton-il) nil recursive) - (quit - (if (eq (cdr quit) 'recursive) - (setq recursive 'quit - skeleton-il (memq 'resume: skeleton-il)) - ;; Remove the subskeleton as far as it has been shown - ;; the subskeleton shouldn't have deleted outside current line. - (end-of-line) - (delete-region start (point)) - (insert line) - (move-to-column column) - (if (cdr quit) - (setq skeleton-il () - recursive nil) - (signal 'quit 'recursive))))))) + (skeleton-il skeleton) + opoint) + (with-suppressed-warnings ((lexical str)) + (dlet ((str (or str + `(setq str + (skeleton-read ',(car skeleton-il) + nil ,recursive))))) + (when (and (eq (cadr skeleton-il) '\n) (not recursive) + (save-excursion (skip-chars-backward " \t") (bolp))) + (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) + (while (setq skeleton-modified (eq opoint (point)) + opoint (point) + skeleton-il (cdr skeleton-il)) + (condition-case quit + (skeleton-internal-1 (car skeleton-il) nil recursive) + (quit + (if (eq (cdr quit) 'recursive) + (setq recursive 'quit + skeleton-il (memq 'resume: skeleton-il)) + ;; Remove the subskeleton as far as it has been shown + ;; the subskeleton shouldn't have deleted outside current line. + (end-of-line) + (delete-region start (point)) + (insert line) + (move-to-column column) + (if (cdr quit) + (setq skeleton-il () + recursive nil) + (signal 'quit 'recursive))))))))) ;; maybe continue loop or go on to next outer resume: section (if (eq recursive 'quit) (signal 'quit 'recursive) commit 33b293b41b2cc64aa085bad9051507922434ceda Author: Paul Eggert Date: Thu Aug 6 15:24:47 2020 -0700 Update from Gnulib This incorporates: 2020-08-06 libgmp: add support 2020-08-06 Consider that clang defines __OPTIMIZE__ like GCC does 2020-08-06 Use __builtin_expect with clang everywhere 2020-08-05 Use __builtin_clz{,l,ll} with clang, also on Windows 2020-08-05 Use __builtin_ctz{,l,ll} and __builtin_ffs{,l,ll} with clang 2020-07-31 _GL_CMP: Improve documentation 2020-07-30 alloca, largefile: sync with Autoconf master * lib/c++defs.h, lib/cdefs.h, lib/count-leading-zeros.h: * lib/count-trailing-zeros.h, m4/alloca.m4, m4/gnulib-common.m4: * m4/largefile.m4, m4/libgmp.m4: Copy from Gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. diff --git a/lib/c++defs.h b/lib/c++defs.h index 3e6aaabc9c..182c2b3a88 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h @@ -268,7 +268,7 @@ _GL_CXXALIASWARN_2 (func, namespace) /* To work around GCC bug , we enable the warning only when not optimizing. */ -# if !__OPTIMIZE__ +# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN_2(func,namespace) \ _GL_WARN_ON_USE (func, \ "The symbol ::" #func " refers to the system function. " \ @@ -296,7 +296,7 @@ _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) /* To work around GCC bug , we enable the warning only when not optimizing. */ -# if !__OPTIMIZE__ +# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \ "The symbol ::" #func " refers to the system function. " \ diff --git a/lib/cdefs.h b/lib/cdefs.h index d8e4a00033..f6c447ad37 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -401,7 +401,7 @@ # endif #endif -#if __GNUC__ >= 3 +#if (__GNUC__ >= 3) || (__clang_major__ >= 4) # define __glibc_unlikely(cond) __builtin_expect ((cond), 0) # define __glibc_likely(cond) __builtin_expect ((cond), 1) #else diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 7e88c8cb9d..7cf605a5f6 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -38,7 +38,8 @@ extern "C" { expand to code that computes the number of leading zeros of the local variable 'x' of type TYPE (an unsigned integer type) and return it from the current function. */ -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ + || (__clang_major__ >= 4) # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 1eb5fb919f..727b21dcc5 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -38,7 +38,8 @@ extern "C" { expand to code that computes the number of trailing zeros of the local variable 'x' of type TYPE (an unsigned integer type) and return it from the current function. */ -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ + || (__clang_major__ >= 4) # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 4dc180d2e3..92d0621c61 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -246,9 +246,10 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ -GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@ +GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@ GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ +GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ @@ -1085,7 +1086,6 @@ gamedir = @gamedir@ gamegroup = @gamegroup@ gameuser = @gameuser@ gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ -gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@ gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ @@ -2021,15 +2021,22 @@ ifeq (,$(OMIT_GNULIB_MODULE_libgmp)) BUILT_SOURCES += $(GMP_H) +ifneq (,$(GL_GENERATE_MINI_GMP_H)) # Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. -ifneq (,$(GL_GENERATE_GMP_H)) gmp.h: $(top_builddir)/config.status echo '#include "mini-gmp.h"' >$@-t mv $@-t $@ else +ifneq (,$(GL_GENERATE_GMP_GMP_H)) +# Build gmp.h as a wrapper for gmp/gmp.h. +gmp.h: $(top_builddir)/config.status + echo '#include ' >$@-t + mv $@-t $@ +else gmp.h: $(top_builddir)/config.status rm -f $@ endif +endif MOSTLYCLEANFILES += gmp.h gmp.h-t EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h diff --git a/m4/alloca.m4 b/m4/alloca.m4 index d3e98c51bf..b777f8450c 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,4 +1,4 @@ -# alloca.m4 serial 16 +# alloca.m4 serial 17 dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -50,10 +50,13 @@ AC_DEFUN([gl_FUNC_ALLOCA], # STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. AC_DEFUN([gl_PREREQ_ALLOCA], [:]) -# This works around a bug in autoconf <= 2.68. -# See and -# . -# Also it has a simplification that is not yet in Autoconf. +m4_version_prereq([2.70], [], [ + +# This works around a bug in autoconf <= 2.68 and has simplifications +# from 2.70. See: +# https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html +# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 +# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=15edf7fd8094fd14a89d9891dd72a9624762597a # _AC_LIBOBJ_ALLOCA # ----------------- @@ -102,3 +105,4 @@ AH_VERBATIM([STACK_DIRECTION], @%:@undef STACK_DIRECTION])dnl AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) ]) +]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 57f3a78011..50acc0a474 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 52 +# gnulib-common.m4 serial 53 dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -300,7 +300,9 @@ AC_DEFUN([gl_COMMON_BODY], [ #define _GL_ASYNC_SAFE ]) AH_VERBATIM([micro_optimizations], -[/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2. +[/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where + n1 and n2 are expressions without side effects, that evaluate to real + numbers (excluding NaN). It returns 1 if n1 > n2 0 if n1 == n2 diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 4472af81b7..5bfa1473ed 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -346,7 +346,7 @@ AC_DEFUN([gl_INIT], AC_REQUIRE([gl_LARGEFILE]) gl___INLINE gl_LIBGMP - if test -n "$GMP_H"; then + if test $HAVE_LIBGMP != yes; then AC_LIBOBJ([mini-gmp-gnulib]) fi gl_LIMITS_H diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 8017ca70eb..f7140dd0a3 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -35,7 +35,7 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -@%:@define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +@%:@define LARGE_OFF_T (((off_t) 1 << 31 << 31) - 1 + ((off_t) 1 << 31 << 31)) int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]];[]dnl diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 index 82c065e2c2..1025f06a77 100644 --- a/m4/libgmp.m4 +++ b/m4/libgmp.m4 @@ -1,4 +1,4 @@ -# libgmp.m4 serial 4 +# libgmp.m4 serial 5 # Configure the GMP library or a replacement. dnl Copyright 2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -18,50 +18,54 @@ AC_DEFUN([gl_LIBGMP], [AS_HELP_STRING([--without-libgmp], [do not use the GNU Multiple Precision (GMP) library; this is the default on systems lacking libgmp.])]) - case "$with_libgmp" in - no) - HAVE_LIBGMP=no - LIBGMP= - LTLIBGMP= - ;; - *) - dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. - m4_ifdef([gl_HAVE_MODULE_HAVELIB], - [AC_LIB_HAVE_LINKFLAGS([gmp], [], - [#include ], - [static const mp_limb_t x[2] = { 0x73, 0x55 }; - mpz_t tmp; - mpz_roinit_n (tmp, x, 2); - ], - [no])], - [gl_saved_LIBS=$LIBS - AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) - LIBS=$gl_saved_LIBS - case $ac_cv_search___gmpz_roinit_n in - 'none needed') - HAVE_LIBGMP=yes LIBGMP=;; - -*) - HAVE_LIBGMP=yes LIBGMP=$ac_cv_search___gmpz_roinit_n;; - *) - HAVE_LIBGMP=no LIBGMP=;; - esac - LTLIBGMP=$LIBGMP - AC_SUBST([HAVE_LIBGMP]) - AC_SUBST([LIBGMP]) - AC_SUBST([LTLIBGMP])]) - if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then - AC_MSG_ERROR( - [GMP not found, although --with-libgmp was specified.m4_ifdef( - [AC_LIB_HAVE_LINKFLAGS], - [ Try specifying --with-libgmp-prefix=DIR.])]) - fi - ;; - esac - if test $HAVE_LIBGMP = yes; then + HAVE_LIBGMP=no + LIBGMP= + LTLIBGMP= + AS_IF([test "$with_libgmp" != no], + [AC_CHECK_HEADERS([gmp.h gmp/gmp.h], [break]) + dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. + AS_IF([test "$ac_cv_header_gmp_h" = yes || + test "$ac_cv_header_gmp_gmp_h" = yes], + [m4_ifdef([gl_HAVE_MODULE_HAVELIB], + [AC_LIB_HAVE_LINKFLAGS([gmp], [], + [#if HAVE_GMP_H + # include + #else + # include + #endif], + [static const mp_limb_t x[2] = { 0x73, 0x55 }; + mpz_t tmp; + mpz_roinit_n (tmp, x, 2); + ], + [no])], + [gl_saved_LIBS=$LIBS + AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) + LIBS=$gl_saved_LIBS + case $ac_cv_search___gmpz_roinit_n in + 'none needed') + HAVE_LIBGMP=yes;; + -*) + HAVE_LIBGMP=yes + LIBGMP=$ac_cv_search___gmpz_roinit_n + LTLIBGMP=$LIBGMP;; + esac + AC_SUBST([HAVE_LIBGMP]) + AC_SUBST([LIBGMP]) + AC_SUBST([LTLIBGMP])])]) + if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then + AC_MSG_ERROR( + [GMP not found, although --with-libgmp was specified.m4_ifdef( + [AC_LIB_HAVE_LINKFLAGS], + [ Try specifying --with-libgmp-prefix=DIR.])]) + fi]) + if test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" = yes; then GMP_H= else GMP_H=gmp.h fi AC_SUBST([GMP_H]) - AM_CONDITIONAL([GL_GENERATE_GMP_H], [test -n "$GMP_H"]) + AM_CONDITIONAL([GL_GENERATE_MINI_GMP_H], + [test $HAVE_LIBGMP != yes]) + AM_CONDITIONAL([GL_GENERATE_GMP_GMP_H], + [test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" != yes]) ]) commit 6cb6215cbe65a183e16adf9122280f8a0155ae10 Author: Tassilo Horn Date: Thu Aug 6 21:52:18 2020 +0200 Show A C hint only if partial fetches are enabled. * lisp/gnus/gnus-art.el (gnus-insert-mime-button): Show A C hint for downloading the complete message only if partial fetches are enabled. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 09dfb826eb..e0339cc1f3 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5851,6 +5851,7 @@ all parts." (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) (when (and (zerop gnus-tmp-length) ;; Only nnimap supports partial fetches so far. + nnimap-fetch-partial-articles (string-match "^nnimap\\+" gnus-newsgroup-name)) (setq gnus-tmp-type-long (concat commit 33b50e2fc9d43802e71e708e10605a0b1d04ad83 Author: Tassilo Horn Date: Thu Aug 6 21:47:48 2020 +0200 Show A C hint for loading complete message only in nnimap groups. * lisp/gnus/gnus-art.el (gnus-insert-mime-button): Show A C hint for loading complete message only in nnimap groups. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1be8c48bcf..09dfb826eb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5849,7 +5849,9 @@ all parts." (concat "; " gnus-tmp-name)))) (unless (equal gnus-tmp-description "") (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) - (when (zerop gnus-tmp-length) + (when (and (zerop gnus-tmp-length) + ;; Only nnimap supports partial fetches so far. + (string-match "^nnimap\\+" gnus-newsgroup-name)) (setq gnus-tmp-type-long (concat gnus-tmp-type-long commit 0aede2d8bfbf04b6c2be12c124f0feda998c2e53 Author: Kévin Le Gouguec Date: Thu Aug 6 18:33:54 2020 +0200 Fix the mailto: examples in the manual and in NEWS * doc/misc/message.texi (System Mailer Setup): Fix mailto: examples. diff --git a/doc/misc/message.texi b/doc/misc/message.texi index c9a466eae9..d8a889e29f 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -547,7 +547,7 @@ This will start Emacs, and then run the @code{message-mailto} command. It will parse the given @acronym{URL}, and set up a Message buffer with the given parameters. -For instance, @samp{mailto:larsi@@gnus.org;subject=This+is+a+test} +For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test} will open a Message buffer with the @samp{To:} header filled in with @samp{"larsi@@gnus.org"} and the @samp{Subject:} header with @samp{"This is a test"}. diff --git a/etc/NEWS b/etc/NEWS index 185c649186..81d07c9f32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -254,7 +254,7 @@ An emacs-mail.desktop file has been included, suitable for installing in desktop directories like /usr/share/applications. Clicking on a mailto: link in other applications will then open Emacs with headers filled out according to the link, e.g. -"mailto:larsi@gnus.org;subject=This+is+a+test". +"mailto:larsi@gnus.org?subject=This+is+a+test". --- *** Change to default value of 'message-draft-headers' user option. commit c8b0005bad4779ef4d3a89aabd2011a7e187d8ff Author: Lars Ingebrigtsen Date: Thu Aug 6 17:45:09 2020 +0200 Fix broken desktop file Looks like I pasted in the data twice... diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop index dec6cdb345..3a96b9ec8c 100644 --- a/etc/emacs-mail.desktop +++ b/etc/emacs-mail.desktop @@ -1,14 +1,4 @@ -Desktop Entry] -Categories=Network;Email; -Comment=GNU Emacs is an extensible, customizable text editor - and more -Exec=/home/larsi/src/emacs/trunk/src/emacs -f message-mailto %u -Icon=emacs -Name=Emacs (Mail) -MimeType=x-scheme-handler/mailto; -NoDisplay=false -Terminal=false -Type=Application -Desktop Entry] +[Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more Exec=emacs -f message-mailto %u commit cc365ca6d8ce24b882a39a062ce64f796693f974 Author: Philip K Date: Wed Aug 5 22:57:01 2020 +0200 Remove usages of assoc-delete-all in project.el assoc-delete-all is not available for users who have installed project.el via ELPA on older Emacs versions (bug#42668). * lisp/progmodes/project.el (project-remember-project, project--remove-from-project-list): Replace assoc-delete-all with equivalent alternatives. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 51b9347bb9..b6161351f0 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1166,7 +1166,9 @@ Save the result in `project-list-file' if the list of projects has changed." (project--ensure-read-project-list) (let ((dir (project-root pr))) (unless (equal (caar project--list) dir) - (setq project--list (assoc-delete-all dir project--list)) + (dolist (ent project--list) + (when (equal dir (car ent)) + (setq project--list (delq ent project--list)))) (push (list dir) project--list) (project--write-project-list)))) @@ -1176,8 +1178,8 @@ If the directory was in the list before the removal, save the result in `project-list-file'. Announce the project's removal from the list." (project--ensure-read-project-list) - (when (assoc pr-dir project--list) - (setq project--list (assoc-delete-all pr-dir project--list)) + (when-let ((ent (assoc pr-dir project--list))) + (setq project--list (delq ent project--list)) (message "Project `%s' not found; removed from list" pr-dir) (project--write-project-list))) commit c05f1020cecb4ef7d516e6575c86bf009c2e6f00 Author: Lars Ingebrigtsen Date: Thu Aug 6 16:47:21 2020 +0200 Tweat how MML specifies the encoding of binary data * lisp/gnus/mml.el (mml-parse-1): Use `data-encoding' to be slightly less confusing than `content-transfer-encoding'. * doc/misc/emacs-mime.texi (MML Definition): Document it. * lisp/gnus/message.el (message-insert-screenshot): Adjust usage. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 974cc10458..9180b4ec20 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -693,8 +693,17 @@ Valid values are @samp{inline} and @samp{attachment} @item encoding Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and -@samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset -Translation}. +@samp{base64}. @xref{Charset +Translation}. This parameter says what +@code{Content-Transfer-Encoding} to use when sending the part, and is +normally computed automatically. + +@item data-encoding +This parameter says what encoding has been used on the data, and the +data will be decoded before use. Valid values are +@samp{quoted-printable} and @samp{base64}. This is useful when you +have a part with binary data (for instance an image) inserted directly +into the Message buffer inside the @samp{"<#part>...<#/part>"} tags. @item description A description of the part (@code{Content-Description}). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 6c0f9b5c9b..819f3e41d3 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8709,7 +8709,7 @@ used to take the screenshot." :max-width (truncate (* (frame-pixel-width) 0.8)) :max-height (truncate (* (frame-pixel-height) 0.8)) :scale 1) - (format "<#part type=\"image/png\" disposition=inline content-transfer-encoding=base64 raw=t>\n%s\n<#/part>" + (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" ;; Get a base64 version of the image -- this avoids later ;; complications if we're auto-saving the buffer and ;; restoring from a file. diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 1d348f3a6f..ef8aa6ac01 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -298,12 +298,12 @@ part. This is for the internal use, you should never modify the value.") ;; We have a part that already has a transfer encoding. Undo ;; that so that we don't double-encode later. (when (and raw - (cdr (assq 'content-transfer-encoding tag))) + (cdr (assq 'data-encoding tag))) (with-temp-buffer (set-buffer-multibyte nil) (insert contents) (mm-decode-content-transfer-encoding - (intern (cdr (assq 'content-transfer-encoding tag))) + (intern (cdr (assq 'data-encoding tag))) (cdr (assq 'type tag))) (setq contents (buffer-string)))) (when (and (not raw) (memq nil charsets)) commit d3fabff99d4aa74f752956ea5b02be7a977efb94 Author: Lars Ingebrigtsen Date: Thu Aug 6 15:53:24 2020 +0200 Change how Mail-Copies-To: never is handled in Message * lisp/gnus/message.el (message-get-reply-headers): Change how Mail-Copies-To: never is handled (bug#37591). When that header is present, put all the remaining recipients in the To header, instead of picking an arbitrary recipient to have in the To header, and the rest in the Cc header. diff --git a/etc/NEWS b/etc/NEWS index c57773922e..185c649186 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,6 +236,16 @@ not. ** Message +--- +*** A change to how Mail-Copies-To: never is handled. +If a user has specified Mail-Copies-To: never, and Message was asked +to do a "wide reply", some other arbitrary recipient would end up in +the resulting To header, while the remaining recipients would be put +in the Cc header. This is somewhat misleading, as it looks like +you're responding to a specific person in particular. This has been +changed so that all the recipients are put in the To header in these +instances. + +++ *** New function to start Emacs in Message mode to send an email. Emacs can be defined as a handler for the "x-scheme-handler/mailto" diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 71ab63de39..6c0f9b5c9b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6998,15 +6998,28 @@ want to get rid of this query permanently."))) ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. - (setq follow-to (list (cons 'To (cdr (pop recipients))))) - (when (and recipients - (or (not message-wide-reply-confirm-recipients) - (y-or-n-p "Reply to all recipients? "))) - (setq recipients (mapconcat - (lambda (addr) (cdr addr)) recipients ", ")) - (if (string-match "^ +" recipients) - (setq recipients (substring recipients (match-end 0)))) - (push (cons 'Cc recipients) follow-to))) + (when (or (< (length recipients) 2) + (not message-wide-reply-confirm-recipients) + (y-or-n-p "Reply to all recipients? ")) + (if never-mct + ;; The author has requested never to get a (wide) + ;; response, so put everybody else into the To header. + ;; This avoids looking as if we're To-in somebody else in + ;; specific, and just Cc-in the rest. + (setq follow-to (list + (cons 'To + (mapconcat + (lambda (addr) + (cdr addr)) recipients ", ")))) + ;; Put the first recipient in the To header. + (setq follow-to (list (cons 'To (cdr (pop recipients))))) + ;; Put the rest of the recipients in Cc. + (when recipients + (setq recipients (mapconcat + (lambda (addr) (cdr addr)) recipients ", ")) + (if (string-match "^ +" recipients) + (setq recipients (substring recipients (match-end 0)))) + (push (cons 'Cc recipients) follow-to))))) follow-to)) (defun message-prune-recipients (recipients) commit 51d063e484c185b7e1d9cb4c6bf56d67b9af4781 Author: Lars Ingebrigtsen Date: Thu Aug 6 15:11:48 2020 +0200 Add a new HTML skeleton for relative (file) URLs * lisp/textmodes/sgml-mode.el (html-href-anchor-file): New skeleton and keystroke (bug#37644). diff --git a/etc/NEWS b/etc/NEWS index 2df7bac9d7..c57773922e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -659,6 +659,13 @@ custom rules, see the variables 'bug-reference-setup-from-vc-alist', 'bug-reference-setup-from-mail-alist', and 'bug-reference-setup-from-irc-alist'. +** HTML Mode + +--- +*** A new skeleton for adding relative URLs has been added. +It's bound to the 'C-c C-c f' keystroke, and prompts for a local file +name. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index b5ff6a6967..1672dce4f2 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1806,6 +1806,7 @@ This takes effect when first loading the library.") (define-key map "\C-c\C-cc" 'html-checkboxes) (define-key map "\C-c\C-cl" 'html-list-item) (define-key map "\C-c\C-ch" 'html-href-anchor) + (define-key map "\C-c\C-cf" 'html-href-anchor-file) (define-key map "\C-c\C-cn" 'html-name-anchor) (define-key map "\C-c\C-c#" 'html-id-anchor) (define-key map "\C-c\C-ci" 'html-image) @@ -1818,6 +1819,7 @@ This takes effect when first loading the library.") (define-key map "\C-cc" 'html-checkboxes) (define-key map "\C-cl" 'html-list-item) (define-key map "\C-ch" 'html-href-anchor) + (define-key map "\C-cf" 'html-href-anchor-file) (define-key map "\C-cn" 'html-name-anchor) (define-key map "\C-c#" 'html-id-anchor) (define-key map "\C-ci" 'html-image) @@ -1845,7 +1847,8 @@ This takes effect when first loading the library.") (define-key menu-map "\n" '("Line Break" . html-line)) (define-key menu-map "\r" '("Paragraph" . html-paragraph)) (define-key menu-map "i" '("Image" . html-image)) - (define-key menu-map "h" '("Href Anchor" . html-href-anchor)) + (define-key menu-map "h" '("Href Anchor URL" . html-href-anchor)) + (define-key menu-map "f" '("Href Anchor File" . html-href-anchor-file)) (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) (define-key menu-map "#" '("ID Anchor" . html-id-anchor)) map) @@ -2453,6 +2456,11 @@ HTML Autoview mode is a buffer-local minor mode for use with ;; '(setq input "http:") "" _ "") +(define-skeleton html-href-anchor-file + "HTML anchor tag with href attribute (from a local file)." + (file-relative-name (read-file-name "File name: ") default-directory) + "" _ "") + (define-skeleton html-name-anchor "HTML anchor tag with name attribute." "Name: " commit b5ea24cb44a34ee433a6212d9791fe7aff711d3d Author: Lars Ingebrigtsen Date: Thu Aug 6 14:50:40 2020 +0200 Make it possible to use Message as a mailto: desktop handler * doc/misc/message.texi (System Mailer Setup): Document the usage. * lisp/gnus/gnus-art.el (gnus-url-mailto): Move most of the code here to 'message-mailto-1' (bug#38314). * lisp/gnus/message.el (message-parse-mailto-url): Mark as obsolete. (message-parse-mailto-url): Rewritten slightly from the above. (message-mailto): New command. (message-mailto-1): New function. diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 7a66422b17..c9a466eae9 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -99,6 +99,7 @@ sending it. * Resending:: Resending a mail message. * Bouncing:: Bouncing a mail message. * Mailing Lists:: Send mail to mailing lists. +* System Mailer Setup:: Using Message as the system mailer. @end menu You can customize the Message Mode tool bar, see @kbd{M-x @@ -529,6 +530,29 @@ It is considered good netiquette to honor MFT, as it is assumed the fellow who posted a message knows where the followups need to go better than you do. + +@node System Mailer Setup +@section System Mailer Setup +@cindex mailto: + +Emacs can be set up as the system mailer, so that Emacs is opened when +you click on @samp{mailto:} links in other programs. + +How this is done varies from system to system, but commonly there's a +way to set the default application for a @acronym{MIME} type, and the +relevant type here is @samp{x-scheme-handler/mailto;}. + +The application to start should be @samp{"emacs -f message-mailto %u"}. +This will start Emacs, and then run the @code{message-mailto} +command. It will parse the given @acronym{URL}, and set up a Message +buffer with the given parameters. + +For instance, @samp{mailto:larsi@@gnus.org;subject=This+is+a+test} +will open a Message buffer with the @samp{To:} header filled in with +@samp{"larsi@@gnus.org"} and the @samp{Subject:} header with +@samp{"This is a test"}. + + @node Commands @chapter Commands diff --git a/etc/NEWS b/etc/NEWS index cbb1842e13..2df7bac9d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -236,6 +236,16 @@ not. ** Message ++++ +*** New function to start Emacs in Message mode to send an email. +Emacs can be defined as a handler for the "x-scheme-handler/mailto" +MIME type with the following command: "emacs -f message-mailto %u". +An emacs-mail.desktop file has been included, suitable for installing +in desktop directories like /usr/share/applications. Clicking on a +mailto: link in other applications will then open Emacs with headers +filled out according to the link, e.g. +"mailto:larsi@gnus.org;subject=This+is+a+test". + --- *** Change to default value of 'message-draft-headers' user option. The 'Date' symbol has been removed from the default value, meaning that diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop new file mode 100644 index 0000000000..dec6cdb345 --- /dev/null +++ b/etc/emacs-mail.desktop @@ -0,0 +1,20 @@ +Desktop Entry] +Categories=Network;Email; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=/home/larsi/src/emacs/trunk/src/emacs -f message-mailto %u +Icon=emacs +Name=Emacs (Mail) +MimeType=x-scheme-handler/mailto; +NoDisplay=false +Terminal=false +Type=Application +Desktop Entry] +Categories=Network;Email; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=emacs -f message-mailto %u +Icon=emacs +Name=Emacs (Mail) +MimeType=x-scheme-handler/mailto; +NoDisplay=false +Terminal=false +Type=Application diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d33539bc7f..1be8c48bcf 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -8341,6 +8341,7 @@ url is put as the `gnus-button-url' overlay property on the button." (and (match-end 6) (list (string-to-number (match-string 6 address)))))))) (defun gnus-url-parse-query-string (query &optional downcase) + (declare (obsolete message-parse-mailto-url "28.1")) (let (retval pairs cur key val) (setq pairs (split-string query "&")) (while pairs @@ -8360,31 +8361,8 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-url-mailto (url) ;; Send mail to someone - (setq url (replace-regexp-in-string "\n" " " url)) - (when (string-match "mailto:/*\\(.*\\)" url) - (setq url (substring url (match-beginning 1) nil))) - (let* ((args (gnus-url-parse-query-string - (if (string-match "^\\?" url) - (substring url 1) - (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) - (concat "to=" (match-string 1 url) "&" - (match-string 2 url)) - (concat "to=" url))))) - (subject (cdr-safe (assoc "subject" args))) - func) - (gnus-msg-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (replace-regexp-in-string - "\r\n" "\n" - (mapconcat #'identity (reverse (cdar args)) ", ") nil t)) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) + (gnus-msg-mail) + (message-mailto-1 url)) (defun gnus-button-embedded-url (address) "Activate ADDRESS with `browse-url'." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index cf2b8eebc3..71ab63de39 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8708,6 +8708,63 @@ used to take the screenshot." (insert "\n\n") (message ""))) +(declare-function gnus-url-unhex-string "gnus-util") + +(defun message-parse-mailto-url (url) + "Parse a mailto: url." + (setq url (replace-regexp-in-string "\n" " " url)) + (when (string-match "mailto:/*\\(.*\\)" url) + (setq url (substring url (match-beginning 1) nil))) + (setq url (if (string-match "^\\?" url) + (substring url 1) + (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) + (concat "to=" (match-string 1 url) "&" + (match-string 2 url)) + (concat "to=" url)))) + (let (retval pairs cur key val) + (setq pairs (split-string url "&")) + (while pairs + (setq cur (car pairs) + pairs (cdr pairs)) + (if (not (string-match "=" cur)) + nil ; Grace + (setq key (downcase (gnus-url-unhex-string + (substring cur 0 (match-beginning 0)))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) + (setq cur (assoc key retval)) + (if cur + (setcdr cur (cons val (cdr cur))) + (setq retval (cons (list key val) retval))))) + retval)) + +;;;###autoload +(defun message-mailto () + "Function to be run to parse command line mailto: links. +This is meant to be used for MIME handlers: Setting the handler +for \"x-scheme-handler/mailto;\" to \"emacs -fn message-mailto %u\" +will then start up Emacs ready to compose mail." + (interactive) + ;; Send email + (message-mail) + (message-mailto-1 (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left))) + +(defun message-mailto-1 (url) + (let ((args (message-parse-mailto-url url))) + (dolist (arg args) + (unless (equal (car arg) "body") + (message-position-on-field (capitalize (car arg))) + (insert (replace-regexp-in-string + "\r\n" "\n" + (mapconcat #'identity (reverse (cdr arg)) ", ") nil t)))) + (when (assoc "body" args) + (message-goto-body) + (dolist (body (cdr (assoc "body" args))) + (insert body "\n"))) + (if (assoc "subject" args) + (message-goto-body) + (message-goto-subject)))) + (provide 'message) (run-hooks 'message-load-hook) commit 66bdf77adfa115ad16ec8557c250f0e5683262b0 Author: Nick Helm Date: Thu Aug 6 12:11:57 2020 +0200 Signal an error in dired when moving to a directory that doesn't exist * lisp/dired-aux.el (dired-do-create-files): Give an error when apparently moving to a directory name, and that directory doesn't exist (bug#38707). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 777df79a6e..6587d039b7 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1978,6 +1978,10 @@ Optional arg HOW-TO determines how to treat the target. (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir)) (if (not (or dired-one-file into-dir)) (error "Marked %s: target must be a directory: %s" operation target)) + (if (and (not (file-directory-p (car fn-list))) + (not (file-directory-p target)) + (directory-name-p target)) + (error "%s: Target directory does not exist: %s" operation target)) ;; rename-file bombs when moving directories unless we do this: (or into-dir (setq target (directory-file-name target))) (dired-create-files commit 361baa451adac7333e1037c3bc73bd95afa9b769 Author: Lars Ingebrigtsen Date: Thu Aug 6 11:51:22 2020 +0200 Make 'n'/'p' in image mode buffers respect dired sorting The commands now also now work on archive and tar mode parent buffers. * doc/emacs/files.texi (Image Mode): Document it. * lisp/arc-mode.el (archive-goto-file): New function (bug#38647). (archive-next-file-displayer): Ditto. * lisp/image-mode.el (image-next-file): Reimplement to work on displayed dired buffers and the like. This means that `n' and `p' now works on the displayed ordering in the dired buffer, so if you've reversed the sorting, `n' picks the right "next" file. (image-mode--directory-buffers): New function. (image-mode--next-file): Ditto. * lisp/tar-mode.el (tar-goto-file): New function. (tar-next-file-displayer): Ditto. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 5998326ffe..2fa1ecc003 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2149,7 +2149,12 @@ To reset all transformations to the initial state, use @findex image-previous-file You can press @kbd{n} (@code{image-next-file}) and @kbd{p} (@code{image-previous-file}) to visit the next image file and the -previous image file in the same directory, respectively. +previous image file in the same directory, respectively. These +commands will consult the ``parent'' dired buffer to determine what +the next/previous image file is. These commands also work when +opening a file from archive files (like zip or tar files), and will +then instead consult the archive mode buffer. If neither an archive +nor a dired ``parent'' buffer can be found, a dired buffer is opened. @findex image-mode-mark-file @findex image-mode-unmark-file diff --git a/etc/NEWS b/etc/NEWS index 8c6e3e7813..cbb1842e13 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -538,6 +538,15 @@ took more than two seconds to display. The new algorithm maintains a decaying average of delays, and if this number gets too high, the animation is stopped. ++++ +*** The 'n' and 'p' commands (next/previous image) now respects dired order. +These commands would previously display the next/previous image in +alphabetical order, but will now find the "parent" dired buffer and +select the next/previous image file according to how the files are +sorted there. The commands have also been extended to work when the +"parent" buffer is an archive mode (i.e., zip file or the like) or tar +mode buffer. + ** EWW +++ diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6781c292d8..901f09302e 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -989,6 +989,53 @@ using `make-temp-file', and the generated name is returned." (kill-local-variable 'buffer-file-coding-system) (after-insert-file-set-coding (- (point-max) (point-min)))))) +(defun archive-goto-file (file) + "Go to FILE in the current buffer. +FILE should be a relative file name. If FILE can't be found, +return nil. Otherwise point is returned." + (let ((start (point)) + found) + (goto-char (point-min)) + (while (and (not found) + (not (eobp))) + (forward-line 1) + (when-let ((descr (archive-get-descr t))) + (when (equal (archive--file-desc-ext-file-name descr) file) + (setq found t)))) + (if (not found) + (progn + (goto-char start) + nil) + (point)))) + +(defun archive-next-file-displayer (file regexp n) + "Return a closure to display the next file after FILE that matches REGEXP." + (let ((short (replace-regexp-in-string "\\`.*:" "" file)) + next) + (archive-goto-file short) + (while (and (not next) + ;; Stop if we reach the end/start of the buffer. + (if (> n 0) + (not (eobp)) + (not (save-excursion + (beginning-of-line) + (bobp))))) + (archive-next-line n) + (when-let ((descr (archive-get-descr t))) + (let ((candidate (archive--file-desc-ext-file-name descr)) + (buffer (current-buffer))) + (when (and candidate + (string-match-p regexp candidate)) + (setq next (lambda () + (kill-buffer (current-buffer)) + (switch-to-buffer buffer) + (archive-extract))))))) + (unless next + ;; If we didn't find a next/prev file, then restore + ;; point. + (archive-goto-file short)) + next)) + (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." (interactive (list nil last-input-event)) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index c417be43da..948e62e10d 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -40,6 +40,7 @@ (require 'image) (require 'exif) +(require 'dired) (eval-when-compile (require 'cl-lib)) ;;; Image mode window-info management. @@ -1085,28 +1086,87 @@ replacing the current Image mode buffer." (error "The buffer is not in Image mode")) (unless buffer-file-name (error "The current image is not associated with a file")) - (let* ((file (file-name-nondirectory buffer-file-name)) - (images (image-mode--images-in-directory file)) - (idx 0)) - (catch 'image-visit-next-file - (dolist (f images) - (if (string= f file) - (throw 'image-visit-next-file (1+ idx))) - (setq idx (1+ idx)))) - (setq idx (mod (+ idx (or n 1)) (length images))) - (let ((image (nth idx images)) - (dir (file-name-directory buffer-file-name))) - (find-alternate-file image) - ;; If we have dired buffer(s) open to where this image is, then - ;; place point on it. + (let ((next (image-mode--next-file buffer-file-name n))) + (unless next + (user-error "No %s file in this directory" + (if (> n 0) + "next" + "prev"))) + (if (stringp next) + (find-alternate-file next) + (funcall next)))) + +(defun image-mode--directory-buffers (file) + "Return a alist of type/buffer for all \"parent\" buffers to image FILE. +This is normally a list of dired buffers, but can also be archive and +tar mode buffers." + (let ((buffers nil) + (dir (file-name-directory file))) + (cond + ((and (boundp 'tar-superior-buffer) + tar-superior-buffer) + (when (buffer-live-p tar-superior-buffer) + (push (cons 'tar tar-superior-buffer) buffers))) + ((and (boundp 'archive-superior-buffer) + archive-superior-buffer) + (when (buffer-live-p archive-superior-buffer) + (push (cons 'archive archive-superior-buffer) buffers))) + (t + ;; Find a dired buffer. (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (and (derived-mode-p 'dired-mode) + (with-current-buffer buffer + (when (and (derived-mode-p 'dired-mode) (equal (file-truename dir) (file-truename default-directory))) - (save-window-excursion - (switch-to-buffer (current-buffer) t t) - (dired-goto-file (expand-file-name image dir))))))))) + (push (cons 'dired (current-buffer)) buffers)))) + ;; If we can't find any buffers to navigate in, we open a dired + ;; buffer. + (unless buffers + (push (cons 'dired (find-file-noselect dir)) buffers) + (message "Opened a dired buffer on %s" dir)))) + buffers)) + +(declare-function archive-next-file-displayer "arc-mode") +(declare-function tar-next-file-displayer "tar-mode") + +(defun image-mode--next-file (file n) + "Go to the next image file in the parent buffer of FILE. +This is typically a dired buffer, but may also be a tar/archive buffer. +Return the next image file from that buffer. +If N is negative, go to the previous file." + (let ((regexp (image-file-name-regexp)) + (buffers (image-mode--directory-buffers file)) + next) + (dolist (buffer buffers) + ;; We do this traversal for all the dired buffers open on this + ;; directory. There probably is just one, but we want to move + ;; point in all of them. + (save-window-excursion + (switch-to-buffer (cdr buffer) t t) + (cl-case (car buffer) + ('dired + (dired-goto-file file) + (let (found) + (while (and (not found) + ;; Stop if we reach the end/start of the buffer. + (if (> n 0) + (not (eobp)) + (not (bobp)))) + (dired-next-line n) + (let ((candidate (dired-get-filename nil t))) + (when (and candidate + (string-match-p regexp candidate)) + (setq found candidate)))) + (if found + (setq next found) + ;; If we didn't find a next/prev file, then restore + ;; point. + (dired-goto-file file)))) + ('archive + (setq next (archive-next-file-displayer file regexp n))) + ('tar + (setq next (tar-next-file-displayer file regexp n)))))) + next)) (defun image-previous-file (&optional n) "Visit the preceding image in the same directory as the current file. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 73978ffc4a..5cf09f9055 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -922,6 +922,56 @@ actually appear on disk when you save the tar-file's buffer." (setq buffer-undo-list nil)))) buffer)) +(defun tar-goto-file (file) + "Go to FILE in the current buffer. +FILE should be a relative file name. If FILE can't be found, +return nil. Otherwise point is returned." + (let ((start (point)) + found) + (goto-char (point-min)) + (while (and (not found) + (not (eobp))) + (forward-line 1) + (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) + (when (equal (tar-header-name descriptor) file) + (setq found t)))) + (if (not found) + (progn + (goto-char start) + nil) + (point)))) + +(defun tar-next-file-displayer (file regexp n) + "Return a closure to display the next file after FILE that matches REGEXP." + (let ((short (replace-regexp-in-string "\\`.*!" "" file)) + next) + ;; The tar buffer chops off leading "./", so do the same + ;; here. + (setq short (replace-regexp-in-string "\\`\\./" "" file)) + (tar-goto-file short) + (while (and (not next) + ;; Stop if we reach the end/start of the buffer. + (if (> n 0) + (not (eobp)) + (not (save-excursion + (beginning-of-line) + (bobp))))) + (tar-next-line n) + (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) + (let ((candidate (tar-header-name descriptor)) + (buffer (current-buffer))) + (when (and candidate + (string-match-p regexp candidate)) + (setq next (lambda () + (kill-buffer (current-buffer)) + (switch-to-buffer buffer) + (tar-extract))))))) + (unless next + ;; If we didn't find a next/prev file, then restore + ;; point. + (tar-goto-file short)) + next)) + (defun tar-extract (&optional other-window-p) "In Tar mode, extract this entry of the tar file into its own buffer." (interactive)