commit 25813b697cc910ba196ff03a911dbbc0f85c716a (HEAD, refs/remotes/origin/master) Author: Gerd Möllmann Date: Wed Sep 7 06:54:49 2022 +0200 ; TODO for writing to the bottom-right corner of a TTY (bug#57607) diff --git a/etc/TODO b/etc/TODO index 772fbf7191..a086470ef5 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1732,7 +1732,11 @@ https://lists.gnu.org/r/emacs-devel/2012-06/msg00354.html ** Maybe replace lib-src/rcs2log with a Lisp implementation It wouldn't have to be a complete replacement, just enough for vc-rcs-update-changelog. - +** Allow Emacs to use the bottom-right corner of a TTY +Emacs doesn't use the bottom-right corner of a TTY when terminfo +capability "am" (auto_right_margin) is defined. It could use the +bottom-right corner nonetheless when certain other capabilities are +defined. See bug#57607. * Other known bugs ** 'make-frame' forgets unhandled parameters, at least for X11 frames commit 473313d2a85a7ae73daf5cc7c205f6285286eecf Author: Po Lu Date: Wed Sep 7 09:52:01 2022 +0800 Fix nsfont breakage since 6b1ed2f2c99a1c2da56c5f434570c438cad6576d * nsfont.m (ns_spec_to_descriptor): Fix coding style, also handle `monospace' special family. (ns_descriptor_to_entity): Fix reporting of spacing on fonts. (ns_findfonts): Fix coding style. diff --git a/src/nsfont.m b/src/nsfont.m index b54118afe5..d072b5ce77 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -324,106 +324,98 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, static NSFontDescriptor * ns_spec_to_descriptor (Lisp_Object font_spec) { - NSFontDescriptor *fdesc; - NSMutableDictionary *fdAttrs = [NSMutableDictionary new]; - NSString *family = ns_get_family (font_spec); - NSMutableDictionary *tdict = [NSMutableDictionary new]; + NSFontDescriptor *fdesc; + NSMutableDictionary *fdAttrs = [NSMutableDictionary new]; + NSString *family = ns_get_family (font_spec); + NSMutableDictionary *tdict = [NSMutableDictionary new]; - Lisp_Object tem; + Lisp_Object tem; - tem = FONT_SLANT_SYMBOLIC (font_spec); - if (!NILP (tem)) - { - if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) - [tdict setObject: [NSNumber numberWithFloat: 1.0] - forKey: NSFontSlantTrait]; - else if (EQ (tem, intern ("reverse-italic")) || - EQ (tem, intern ("reverse-oblique"))) - [tdict setObject: [NSNumber numberWithFloat: -1.0] - forKey: NSFontSlantTrait]; - else - [tdict setObject: [NSNumber numberWithFloat: 0.0] - forKey: NSFontSlantTrait]; - } + tem = FONT_SLANT_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontSlantTrait]; + else if (EQ (tem, intern ("reverse-italic")) + || EQ (tem, intern ("reverse-oblique"))) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontSlantTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontSlantTrait]; + } - tem = FONT_WIDTH_SYMBOLIC (font_spec); - if (!NILP (tem)) - { - if (EQ (tem, Qcondensed)) - [tdict setObject: [NSNumber numberWithFloat: -1.0] - forKey: NSFontWidthTrait]; - else if (EQ (tem, Qexpanded)) - [tdict setObject: [NSNumber numberWithFloat: 1.0] - forKey: NSFontWidthTrait]; - else - [tdict setObject: [NSNumber numberWithFloat: 0.0] - forKey: NSFontWidthTrait]; - } + tem = FONT_WIDTH_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qcondensed)) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWidthTrait]; + else if (EQ (tem, Qexpanded)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWidthTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWidthTrait]; + } - tem = FONT_WEIGHT_SYMBOLIC (font_spec); + tem = FONT_WEIGHT_SYMBOLIC (font_spec); - if (!NILP (tem)) - { - if (EQ (tem, Qbold)) - { - [tdict setObject: [NSNumber numberWithFloat: 1.0] - forKey: NSFontWeightTrait]; - } - else if (EQ (tem, Qlight)) - { - [tdict setObject: [NSNumber numberWithFloat: -1.0] - forKey: NSFontWeightTrait]; - } - else - { - [tdict setObject: [NSNumber numberWithFloat: 0.0] - forKey: NSFontWeightTrait]; - } - } + if (!NILP (tem)) + { + if (EQ (tem, Qbold)) + { + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWeightTrait]; + } + else if (EQ (tem, Qlight)) + { + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWeightTrait]; + } + else + { + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWeightTrait]; + } + } - tem = AREF (font_spec, FONT_SPACING_INDEX); + tem = AREF (font_spec, FONT_SPACING_INDEX); - if (family != nil) - { - [fdAttrs setObject: family - forKey: NSFontFamilyAttribute]; - } + if (family != nil) + [fdAttrs setObject: family + forKey: NSFontFamilyAttribute]; - if (FIXNUMP (tem)) - { - if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL) - { - [fdAttrs setObject: [NSNumber numberWithBool:YES] - forKey: NSFontFixedAdvanceAttribute]; - } - else - { - [fdAttrs setObject: [NSNumber numberWithBool:NO] - forKey: NSFontFixedAdvanceAttribute]; - } - } + if (FIXNUMP (tem)) + { + if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL) + [fdAttrs setObject: [NSNumber numberWithBool: YES] + forKey: NSFontFixedAdvanceAttribute]; + else + [fdAttrs setObject: [NSNumber numberWithBool: NO] + forKey: NSFontFixedAdvanceAttribute]; + } - /* Handle special families such as ``fixed'' or ``Sans Serif''. */ + /* Handle special families such as ``fixed'', ``monospace'' or + ``Sans Serif''. */ - if ([family isEqualToString: @"fixed"]) - { - [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName] - forKey: NSFontFamilyAttribute]; - } - else if ([family isEqualToString: @"Sans Serif"]) - { - [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName] - forKey: NSFontFamilyAttribute]; - } + if ([family isEqualToString: @"fixed"] + || [family isEqualToString: @"monospace"]) + [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + else if ([family isEqualToString: @"Sans Serif"]) + [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; - [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; - fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] - retain] autorelease]; + fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] + retain] autorelease]; - [tdict release]; - [fdAttrs release]; - return fdesc; + [tdict release]; + [fdAttrs release]; + return fdesc; } @@ -477,7 +469,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (font_entity, FONT_SPACING_INDEX, - make_fixnum ((data.specified & GS_SPECIFIED_WIDTH && data.monospace_p) + make_fixnum ((data.specified & GS_SPECIFIED_SPACING && data.monospace_p) ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); ASET (font_entity, FONT_EXTRA_INDEX, extra); @@ -792,53 +784,53 @@ but also for ascii (which causes unnecessary font substitution). */ static Lisp_Object ns_findfonts (Lisp_Object font_spec, BOOL isMatch) { - Lisp_Object tem, list = Qnil; - NSFontDescriptor *fdesc; - NSArray *all_descs; - GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator]; + Lisp_Object tem, list = Qnil; + NSFontDescriptor *fdesc; + NSArray *all_descs; + GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator]; - NSSet *cFamilies; + NSSet *cFamilies; - block_input (); - if (NSFONT_TRACE) - { - fprintf (stderr, "nsfont: %s for fontspec:\n ", - (isMatch ? "match" : "list")); - debug_print (font_spec); - } + block_input (); + if (NSFONT_TRACE) + { + fprintf (stderr, "nsfont: %s for fontspec:\n ", + (isMatch ? "match" : "list")); + debug_print (font_spec); + } - cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90); + cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90); - fdesc = ns_spec_to_descriptor (font_spec); - all_descs = [enumerator availableFontDescriptors]; + fdesc = ns_spec_to_descriptor (font_spec); + all_descs = [enumerator availableFontDescriptors]; - for (NSFontDescriptor *desc in all_descs) - { - if (![cFamilies containsObject: - [desc objectForKey: NSFontFamilyAttribute]]) - continue; - if (!ns_font_descs_match_p (fdesc, desc)) - continue; - - tem = ns_descriptor_to_entity (desc, - AREF (font_spec, FONT_EXTRA_INDEX), - NULL); - if (isMatch) - return tem; - list = Fcons (tem, list); - } + for (NSFontDescriptor *desc in all_descs) + { + if (![cFamilies containsObject: + [desc objectForKey: NSFontFamilyAttribute]]) + continue; + if (!ns_font_descs_match_p (fdesc, desc)) + continue; + + tem = ns_descriptor_to_entity (desc, + AREF (font_spec, FONT_EXTRA_INDEX), + NULL); + if (isMatch) + return tem; + list = Fcons (tem, list); + } - unblock_input (); + unblock_input (); - /* Return something if was a match and nothing found. */ - if (isMatch) - return ns_fallback_entity (); + /* Return something if was a match and nothing found. */ + if (isMatch) + return ns_fallback_entity (); - if (NSFONT_TRACE) - fprintf (stderr, " Returning %"pD"d entities.\n", - list_length (list)); + if (NSFONT_TRACE) + fprintf (stderr, " Returning %"pD"d entities.\n", + list_length (list)); - return list; + return list; } commit 976965eb5ed00ddc8806b2adcbd5761189823f2c Author: Po Lu Date: Wed Sep 7 09:07:59 2022 +0800 Reenable reporting of frame movement on NS * src/nsterm.m ([EmacsView windowDidMove:]): Restore code to generate MOVE_FRAME_EVENTS, and use kbd_buffer_store_event instead. diff --git a/src/nsterm.m b/src/nsterm.m index 6c6151701b..d6290449b4 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7912,22 +7912,28 @@ - (void)windowDidMove: sender NSRect r = [win frame]; NSArray *screens = [NSScreen screens]; NSScreen *screen = [screens objectAtIndex: 0]; + struct input_event ie; NSTRACE ("[EmacsView windowDidMove:]"); if (!emacsframe->output_data.ns) return; + if (screen != nil) { - emacsframe->left_pos = NSMinX (r) - NS_PARENT_WINDOW_LEFT_POS (emacsframe); - emacsframe->top_pos = NS_PARENT_WINDOW_TOP_POS (emacsframe) - NSMaxY (r); + emacsframe->left_pos = (NSMinX (r) + - NS_PARENT_WINDOW_LEFT_POS (emacsframe)); + emacsframe->top_pos = (NS_PARENT_WINDOW_TOP_POS (emacsframe) + - NSMaxY (r)); - // FIXME: after event part below didExitFullScreen is not received - // if (emacs_event) - // { - // emacs_event->kind = MOVE_FRAME_EVENT; - // EV_TRAILER ((id)nil); - // } + if (emacs_event) + { + ie.kind = MOVE_FRAME_EVENT; + XSETFRAME (ie.frame_or_window, emacsframe); + XSETINT (ie.x, emacsframe->left_pos); + XSETINT (ie.y, emacsframe->top_pos); + kbd_buffer_store_event (&ie); + } } } commit 5308a4e11e72804d6cae56b8ea13c51b3f523c51 Author: Stefan Kangas Date: Wed Sep 7 03:22:15 2022 +0200 Improve image-tests.el Commentary * test/src/image-tests.el: Doc fix; explain how to run from command line. diff --git a/test/src/image-tests.el b/test/src/image-tests.el index 0a13db67d4..0b2d42ab9f 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -22,8 +22,11 @@ ;;; Commentary: ;; Most of these tests will only run in a GUI session, and not with -;; "make check". Run them manually in an interactive session with -;; `M-x eval-buffer' followed by `M-x ert'. +;; "make check". You must run them manually in an interactive session +;; with, for example, `M-x eval-buffer' followed by `M-x ert'. +;; +;; To run these tests from the command line, try: +;; ./src/emacs -Q -l test/src/image-tests.el -eval "(ert t)" ;;; Code: commit ca0a8b554a6e56dc988fcafc0778de373ff53489 Author: Stefan Kangas Date: Wed Sep 7 02:59:50 2022 +0200 ; * lib-src/emacsclient.c (main): Fix previous change. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 2e5d8d0cc2..9529b34725 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -2149,9 +2149,9 @@ main (int argc, char **argv) act_on_signals (emacs_socket); rl = recv (emacs_socket, string, BUFSIZ, 0); retry = check_socket_timeout (rl); - if (retry) + if (retry && !saw_response) { - if (timeout > 0 && !saw_response) + if (timeout > 0) { /* Don't retry if we were given a --timeout flag. */ fprintf (stderr, "\nServer not responding; timed out after %lu seconds", commit e09872ccb3c4d190ba668b47512abf1c28c992d7 Author: Stefan Monnier Date: Tue Sep 6 17:29:25 2022 -0400 * lisp/jit-lock.el (jit-lock-function): Update comment diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index e28d6ec924..6ef46ad60b 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -384,7 +384,7 @@ is active." ;; No deferral. (let* ((cend (min (point-max) (+ start jit-lock-chunk-size))) (vend (next-single-property-change start 'invisible nil cend))) - ;; FIXME: Presumably if we're called it means `start' is + ;; Presumably if we're called it means `start' is ;; not at EOB (nor invisible) and hence (> vend start). (jit-lock-fontify-now start vend)) ;; Record the buffer for later fontification. commit 91a79eedf6c15af7868480a478d0a43acff75215 Author: Stefan Monnier Date: Tue Sep 6 17:24:11 2022 -0400 * lisp/jit-lock.el (jit-lock-function): Don't fontify invisible text See bug#57447. This can speed up fontification significantly when using things like outline-mode. diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 9543253cf2..e28d6ec924 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -382,7 +382,11 @@ is active." (or (not (eq jit-lock-defer-time 0)) (input-pending-p)))) ;; No deferral. - (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) + (let* ((cend (min (point-max) (+ start jit-lock-chunk-size))) + (vend (next-single-property-change start 'invisible nil cend))) + ;; FIXME: Presumably if we're called it means `start' is + ;; not at EOB (nor invisible) and hence (> vend start). + (jit-lock-fontify-now start vend)) ;; Record the buffer for later fontification. (unless (memq (current-buffer) jit-lock-defer-buffers) (push (current-buffer) jit-lock-defer-buffers)) commit be342f73bd8680a8113a41954ae303388a18a1f7 Author: Stefan Monnier Date: Tue Sep 6 17:20:16 2022 -0400 * etc/NEWS.28: Mention `make-closure` diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 01e8ac112f..5b7d054fd3 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -3605,6 +3605,13 @@ pairs. ** New function 'mail-header-parse-address-lax'. Parse a string as a mail address-like string. +** New function 'make-closure'. +This function is used internally by the byte-compiler: calls to it are +inserted into the generated bytecode to handle closures more +efficiently than the old code which relied on +'make-byte-code' instead. +It also makes the disassembly more readable. + ** New function 'make-separator-line'. Make a string appropriate for usage as a visual separator line. commit 8b2ac68e9ff6e886f4ee9d2fe4ca244cdb004c80 Author: Stefan Kangas Date: Tue Sep 6 22:40:19 2022 +0200 * doc/misc/mh-e.texi (Getting MH-E): Update. diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index b20edce4c2..ee68c71779 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -8654,28 +8654,11 @@ question, file a ticket and your question will become a new FAQ! @cindex getting MH-E @cindex obtaining MH-E -Because MH-E is undergoing a phase of sustained growth, the version of -MH-E in your Emacs is likely to be out of date although it is most -likely to be more up to date than the copy that comes with the MH -distribution in @file{miscellany/mh-e}. - -@cindex change log -@cindex release notes - -New MH-E releases are always available for downloading at -@uref{https://sourceforge.net/projects/mh-e/files/, SourceForge} -before they appear in an Emacs release. You can read the release notes -on that page to determine if the given release of MH-E is already -installed in your version of Emacs. You can also read the change log -to see if you are interested in what the given release of MH-E has to -offer (although we have no doubt that you will be extremely interested -in all new releases). - -@cindex Debian - -If you use Debian, you can install the Debian -@uref{https://packages.debian.org/unstable/mail/mh-e, mh-e package} -instead. +Since MH-E 8.6 was released in 2016, its development migrated to the +Emacs repository. MH-E is now only supported in the version of Emacs +in which it appears. Old releases of MH-E are still available for +download at @uref{https://sourceforge.net/projects/mh-e/files/, +SourceForge}. @cindex files, @samp{MH-E-NEWS} @cindex files, @samp{README} commit 0907e8a3c9cefe8edb0888454eabde872faa728f Author: Stefan Kangas Date: Tue Sep 6 22:44:49 2022 +0200 ; Fix deleting XEmacs references from MH-E manual * doc/misc/mh-e.texi (Incorporating Mail): Also remove index entries for gnuclient. diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 459100f575..b20edce4c2 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -1479,11 +1479,9 @@ and click on the @samp{INS} button. Enter a @samp{Spool File} of Binding} of @samp{m}. @cindex @command{emacsclient} -@cindex @command{gnuclient} @cindex @command{xbuffy} @cindex @samp{gnuserv} @cindex Unix commands, @command{emacsclient} -@cindex Unix commands, @command{gnuclient} @cindex Unix commands, @command{xbuffy} You can use @command{xbuffy} to automate the incorporation of this commit 19cc17b4930d406cd59b24a6e02686f87a524ed9 Author: Stefan Kangas Date: Tue Sep 6 22:43:26 2022 +0200 Don't mention ancient Gnus versions in MH-E manual * doc/misc/mh-e.texi (Preface, Reading PGP, Procmail): Don't mention pre-2000 versions of Gnus. diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 2106c674f3..459100f575 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -213,13 +213,12 @@ more niceties about GNU Emacs and MH@. Now I'm fully hooked on both of them. The MH-E package is distributed with Emacs@footnote{Version -@value{VERSION} of MH-E appeared in Emacs 24.4. -It is compatible with MH versions 6.8.4 and -higher, all versions of nmh, and GNU mailutils 1.0 and higher}, so you -shouldn't have to do anything special to use it. Gnus is also -required; version 5.10 or higher is recommended. This manual covers -MH-E version @value{VERSION}. To help you decide which version you -have, see @ref{Getting Started}. +@value{VERSION} of MH-E appeared in Emacs 24.4. It is compatible with +MH versions 6.8.4 and higher, all versions of nmh, and GNU mailutils +1.0 and higher}, so you shouldn't have to do anything special to use +it. Gnus is also required; it is bundled with Emacs. This manual +covers MH-E version @value{VERSION}. To help you decide which version +you have, see @ref{Getting Started}. @findex help-with-tutorial @kindex C-h t @@ -2712,8 +2711,7 @@ Drafts}). @cindex signed messages You can read encrypted or signed PGP or GPG messages with -MH-E@footnote{This feature depends on post-5.10 versions of Gnus. -@cite{MIME Security with OpenPGP} is documented in +MH-E@footnote{@cite{MIME Security with OpenPGP} is documented in @uref{https://www.rfc-editor.org/rfc/rfc3156.txt, RFC 3156}. However, MH-E can also decrypt old-style PGP messages that are not in MIME format.}. This section assumes that you already have a good @@ -8538,9 +8536,7 @@ If you're on a mailing list that is so voluminous that it is impossible to read every message, it usually better to read the mailing list like a newsgroup in a news reader. Emacs has a built-in newsreader called Gnus. The remainder of this appendix talks about how -to use Gnus with an MH message store. The version of Gnus that was -used to prepare this manual was 5.10. Versions 5.8 through 5.10 should -work but versions prior to 5.8 use different options. +to use Gnus with an MH message store. This table contains a list of Gnus options that you will have to modify. Note that for them to become accessible, you'll have to load commit 088b81031b8873f898cc611d73d1d2d55eb3c942 Author: Eli Zaretskii Date: Tue Sep 6 15:09:09 2022 +0300 Fix the MS-Windows build * lib-src/emacsclient.c (DEFAULT_TIMEOUT): Move out of the !WINDOWSNT condition, to fix the MS-Windows compilation. (set_socket_timeout) [WINDOWSNT]: Protect against too-large values of timeout. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 15acb4589a..2e5d8d0cc2 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -55,8 +55,6 @@ char *w32_getenv (const char *); # include # include -# define DEFAULT_TIMEOUT (30) - # define SOCKETS_IN_FILE_SYSTEM # define INVALID_SOCKET (-1) @@ -68,6 +66,8 @@ char *w32_getenv (const char *); #endif /* !WINDOWSNT */ +#define DEFAULT_TIMEOUT (30) + #include #include #include @@ -1898,7 +1898,12 @@ set_socket_timeout (HSOCKET socket, int seconds) timeout.tv_usec = 0; setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, &timeout, sizeof timeout); #else - DWORD timeout = seconds * 1000; + DWORD timeout; + + if (seconds > INT_MAX / 1000) + timeout = INT_MAX; + else + timeout = seconds * 1000; setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, (char *) &timeout, sizeof timeout); #endif } commit a99665cf38b0a237d6d0afed09a061ee0080cb19 Author: Stefan Kangas Date: Tue Sep 6 13:48:49 2022 +0200 * doc/misc/semantic.texi: Delete unused macro. diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi index eb5c7e0e67..25ba30d13c 100644 --- a/doc/misc/semantic.texi +++ b/doc/misc/semantic.texi @@ -25,8 +25,7 @@ @copying This manual documents the Semantic library and utilities. -Copyright @copyright{} 1999--2005, 2007, 2009--2022 Free Software -Foundation, Inc. +Copyright @copyright{} 1999--2022 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -65,13 +64,6 @@ modify this GNU manual.'' @b{\kw\} @end macro -@macro obsolete{old,new} -@sp 1 -@strong{Compatibility}: -@code{\new\} introduced in @semantic{} version 2.0 supersedes -@code{\old\} which is now obsolete. -@end macro - @c ************************************************************************* @c @ Document @c ************************************************************************* commit c016014af4e204c2ceca36d91c4f27290d1337aa Author: Stefan Kangas Date: Tue Sep 6 13:44:21 2022 +0200 ; Minor doc fix in gnus.texi * doc/misc/gnus.texi (Writing New Back Ends): Delete now obsolete version variable. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 738ff94b9f..b1331e79bf 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -30580,7 +30580,6 @@ Below is a slightly shortened version of the @code{nndir} back end. (defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) (defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") ;;; @r{Interface functions.} commit a3d7332d758aca4583a0a6b953a4b383679a6f20 Author: Po Lu Date: Tue Sep 6 19:39:05 2022 +0800 Correctly handle frame synchronization on fullscreen KWin * src/xfns.c (x_set_use_frame_synchronization): Announce that we do not want the compositor to unredirect the frame while fullscreen. * src/xterm.c (x_atom_refs): New atom `_NET_WM_BYPASS_COMPOSITOR'. * src/xterm.h (struct x_display_info): Likewise. diff --git a/src/xfns.c b/src/xfns.c index 2da1e7bcf8..fc8b30a9d6 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2423,14 +2423,33 @@ x_set_use_frame_synchronization (struct frame *f, Lisp_Object arg, { #if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME struct x_display_info *dpyinfo; + unsigned long bypass_compositor; dpyinfo = FRAME_DISPLAY_INFO (f); if (!NILP (arg) && FRAME_X_EXTENDED_COUNTER (f)) - FRAME_X_OUTPUT (f)->use_vsync_p - = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn); + { + FRAME_X_OUTPUT (f)->use_vsync_p + = x_wm_supports (f, dpyinfo->Xatom_net_wm_frame_drawn); + + /* At the same time, write the bypass compositor property to the + outer window. 2 means to never bypass the compositor, as we + need its cooperation for frame synchronization. */ + bypass_compositor = 2; + XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_bypass_compositor, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &bypass_compositor, 1); + } else - FRAME_X_OUTPUT (f)->use_vsync_p = false; + { + FRAME_X_OUTPUT (f)->use_vsync_p = false; + + /* Remove the compositor bypass property from the outer + window. */ + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_bypass_compositor); + } store_frame_param (f, Quse_frame_synchronization, FRAME_X_OUTPUT (f)->use_vsync_p ? Qt : Qnil); diff --git a/src/xterm.c b/src/xterm.c index c58f2d15da..6f76622bfe 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -998,6 +998,7 @@ static const struct x_atom_ref x_atom_refs[] = ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request) ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER", Xatom_net_wm_sync_request_counter) ATOM_REFS_INIT ("_NET_WM_SYNC_FENCES", Xatom_net_wm_sync_fences) + ATOM_REFS_INIT ("_NET_WM_BYPASS_COMPOSITOR", Xatom_net_wm_bypass_compositor) ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn) ATOM_REFS_INIT ("_NET_WM_FRAME_TIMINGS", Xatom_net_wm_frame_timings) ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time) diff --git a/src/xterm.h b/src/xterm.h index 7c5a889af3..d6ff15e40f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -656,7 +656,8 @@ struct x_display_info Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter, Xatom_net_wm_sync_fences, Xatom_net_wm_frame_drawn, Xatom_net_wm_frame_timings, Xatom_net_wm_user_time, Xatom_net_wm_user_time_window, - Xatom_net_client_list_stacking, Xatom_net_wm_pid; + Xatom_net_client_list_stacking, Xatom_net_wm_pid, + Xatom_net_wm_bypass_compositor; /* XSettings atoms and windows. */ Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr; commit ae963e80a79f5a9184daabfc8197f211a39b136d Author: Kai Tetzlaff Date: Mon Feb 28 11:08:07 2022 +0100 Fix (mostly multibyte) issues in sieve-manage.el (Bug#54154) The managesieve protocol (s. RFC5804) requires support for (a sightly restricted variant of) UTF-8 in script content and script names. This commit fixes/improves the handling of multibyte characters. In addition, `sieve-manage-getscript' now properly handles NO responses from the server instead of inflooping. There are also some logging improvements. * lisp/net/sieve-manage.el (sieve-manage--append-to-log): (sieve-manage--message): (sieve-manage--error): (sieve-manage-encode): (sieve-manage-decode): (sieve-manage-no-p): New functions. (sieve-manage-make-process-buffer): Switch process buffer to unibyte. (sieve-manage-open-server): Add `:coding 'raw-text-unix` to `open-network-stream' call. Use unix EOLs in order to keep matching CRLF (aka "\r\n") intact. (sieve-manage-send): Make sure that UTF-8 multibyte characters are properly encoded before sending data to the server. (sieve-manage-getscript): (sieve-manage-putscript): Use the changes above to fix down/uploading scripts containing UTF-8 multibyte characters. (sieve-manage-listscripts): (sieve-manage-havespace) (sieve-manage-getscript) (sieve-manage-putscript): (sieve-manage-deletescript): (sieve-manage-setactive): Use the changes above to fix handling of script names which contain UTF-8 multibyte characters. (sieve-manage-parse-string): (sieve-manage-getscript): Add handling of server responses with type NO. Abort `sieve-manage-getscript' and show error message in message area. (sieve-manage-erase): (sieve-manage-drop-next-answer): (sieve-manage-parse-crlf): Return erased/dropped data (instead of nil). (sieve-sasl-auth): (sieve-manage-getscript): (sieve-manage-erase): (sieve-manage-open-server): (sieve-manage-open): (sieve-manage-send): Improve logging. diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index a39e35a53a..381e1fcd4f 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -167,7 +167,52 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") (defvar sieve-manage-capability nil) ;; Internal utility functions -(autoload 'mm-enable-multibyte "mm-util") +(defun sieve-manage--append-to-log (&rest args) + "Append ARGS to sieve-manage log buffer. + +ARGS can be a string or a list of strings. +The buffer to use for logging is specifified via +`sieve-manage-log'. If it is nil, logging is disabled." + (when sieve-manage-log + (with-current-buffer (or (get-buffer sieve-manage-log) + (with-current-buffer + (get-buffer-create sieve-manage-log) + (set-buffer-multibyte nil) + (buffer-disable-undo))) + (goto-char (point-max)) + (apply #'insert args)))) + +(defun sieve-manage--message (format-string &rest args) + "Wrapper around `message' which also logs to sieve manage log. + +See `sieve-manage--append-to-log'." + (let ((ret (apply #'message + (concat "sieve-manage: " format-string) + args))) + (sieve-manage--append-to-log ret "\n") + ret)) + +(defun sieve-manage--error (format-string &rest args) + "Wrapper around `error' which also logs to sieve manage log. + +See `sieve-manage--append-to-log'." + (let ((msg (apply #'format + (concat "sieve-manage/ERROR: " format-string) + args))) + (sieve-manage--append-to-log msg "\n") + (error msg))) + +(defun sieve-manage-encode (utf8-string) + "Convert UTF8-STRING to managesieve protocol octets." + (encode-coding-string utf8-string 'raw-text t)) + +(defun sieve-manage-decode (octets &optional buffer) + "Convert managesieve protocol OCTETS to utf-8 string. + +If optional BUFFER is non-nil, insert decoded string into BUFFER." + (when octets + ;; eol type unix is required to preserve "\r\n" + (decode-coding-string octets 'utf-8-unix t buffer))) (defun sieve-manage-make-process-buffer () (with-current-buffer @@ -175,22 +220,19 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") sieve-manage-server sieve-manage-port)) (mapc #'make-local-variable sieve-manage-local-variables) - (mm-enable-multibyte) + (set-buffer-multibyte nil) + (setq-local after-change-functions nil) (buffer-disable-undo) (current-buffer))) (defun sieve-manage-erase (&optional p buffer) - (let ((buffer (or buffer (current-buffer)))) - (and sieve-manage-log - (with-current-buffer (get-buffer-create sieve-manage-log) - (mm-enable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer (with-current-buffer buffer - (point-min)) - (or p (with-current-buffer buffer - (point-max))))))) - (delete-region (point-min) (or p (point-max)))) + (with-current-buffer (or buffer (current-buffer)) + (let* ((start (point-min)) + (end (or p (point-max))) + (logdata (buffer-substring-no-properties start end))) + (sieve-manage--append-to-log logdata) + (delete-region start end) + logdata))) (defun sieve-manage-open-server (server port &optional stream buffer) "Open network connection to SERVER on PORT. @@ -202,6 +244,8 @@ Return the buffer associated with the connection." (open-network-stream "SIEVE" buffer server port :type stream + ;; eol type unix is required to preserve "\r\n" + :coding 'raw-text-unix :capability-command "CAPABILITY\r\n" :end-of-command "^\\(OK\\|NO\\).*\n" :success "^OK.*\n" @@ -224,7 +268,7 @@ Return the buffer associated with the connection." ;; Authenticators (defun sieve-sasl-auth (buffer mech) "Login to server using the SASL MECH method." - (message "sieve: Authenticating using %s..." mech) + (sieve-manage--message "Authenticating using %s..." mech) (with-current-buffer buffer (let* ((auth-info (auth-source-search :host sieve-manage-server :port "sieve" @@ -275,11 +319,15 @@ Return the buffer associated with the connection." (if (and (setq step (sasl-next-step client step)) (setq data (sasl-step-data step))) ;; We got data for server but it's finished - (error "Server not ready for SASL data: %s" data) + (sieve-manage--error + "Server not ready for SASL data: %s" data) ;; The authentication process is finished. + (sieve-manage--message "Logged in as %s using %s" + user-name mech) (throw 'done t))) (unless (stringp rsp) - (error "Server aborted SASL authentication: %s" (caddr rsp))) + (sieve-manage--error + "Server aborted SASL authentication: %s" (caddr rsp))) (sasl-step-set-data step (base64-decode-string rsp)) (setq step (sasl-next-step client step)) (sieve-manage-send @@ -288,8 +336,7 @@ Return the buffer associated with the connection." (base64-encode-string (sasl-step-data step) 'no-line-break) "\"") - "")))) - (message "sieve: Login using %s...done" mech)))) + ""))))))) (defun sieve-manage-cram-md5-p (buffer) (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) @@ -353,7 +400,7 @@ to work in." sieve-manage-default-stream) sieve-manage-auth (or auth sieve-manage-auth)) - (message "sieve: Connecting to %s..." sieve-manage-server) + (sieve-manage--message "Connecting to %s..." sieve-manage-server) (sieve-manage-open-server sieve-manage-server sieve-manage-port sieve-manage-stream @@ -368,7 +415,8 @@ to work in." (setq sieve-manage-auth auth) (cl-return))) (unless sieve-manage-auth - (error "Couldn't figure out authenticator for server"))) + (sieve-manage--error + "Couldn't figure out authenticator for server"))) (sieve-manage-erase) (current-buffer)))) @@ -433,11 +481,7 @@ If NAME is nil, return the full server list of capabilities." (defun sieve-manage-putscript (name content &optional buffer) (with-current-buffer (or buffer (current-buffer)) (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name - ;; Here we assume that the coding-system will - ;; replace each char with a single byte. - ;; This is always the case if `content' is - ;; a unibyte string. - (length content) + (length (sieve-manage-encode content)) sieve-manage-client-eol content)) (sieve-manage-parse-okno))) @@ -449,11 +493,10 @@ If NAME is nil, return the full server list of capabilities." (defun sieve-manage-getscript (name output-buffer &optional buffer) (with-current-buffer (or buffer (current-buffer)) (sieve-manage-send (format "GETSCRIPT \"%s\"" name)) - (let ((script (sieve-manage-parse-string))) - (sieve-manage-parse-crlf) - (with-current-buffer output-buffer - (insert script)) - (sieve-manage-parse-okno)))) + (sieve-manage-decode (sieve-manage-parse-string) + output-buffer) + (sieve-manage-parse-crlf) + (sieve-manage-parse-okno))) (defun sieve-manage-setactive (name &optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -478,6 +521,9 @@ If NAME is nil, return the full server list of capabilities." (defun sieve-manage-ok-p (rsp) (string= (downcase (or (car-safe rsp) "")) "ok")) +(defun sieve-manage-no-p (rsp) + (string= (downcase (or (car-safe rsp) "")) "no")) + (defun sieve-manage-is-okno () (when (looking-at (concat "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" @@ -528,7 +574,11 @@ to local variable `sieve-manage-capability'." (while (null rsp) (accept-process-output (get-buffer-process (current-buffer)) 1) (goto-char (point-min)) - (setq rsp (sieve-manage-is-string))) + (unless (setq rsp (sieve-manage-is-string)) + (when (sieve-manage-no-p (sieve-manage-is-okno)) + ;; simple `error' is enough since `sieve-manage-erase' + ;; already adds the server response to the log + (error (sieve-manage-erase))))) (sieve-manage-erase (point)) rsp)) @@ -540,7 +590,8 @@ to local variable `sieve-manage-capability'." (let (tmp rsp data) (while (null rsp) (while (null (or (setq rsp (sieve-manage-is-okno)) - (setq tmp (sieve-manage-is-string)))) + (setq tmp (sieve-manage-decode + (sieve-manage-is-string))))) (accept-process-output (get-buffer-process (current-buffer)) 1) (goto-char (point-min))) (when tmp @@ -559,13 +610,9 @@ to local variable `sieve-manage-capability'." rsp))) (defun sieve-manage-send (cmdstr) - (setq cmdstr (concat cmdstr sieve-manage-client-eol)) - (and sieve-manage-log - (with-current-buffer (get-buffer-create sieve-manage-log) - (mm-enable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert cmdstr))) + (setq cmdstr (sieve-manage-encode + (concat cmdstr sieve-manage-client-eol))) + (sieve-manage--append-to-log cmdstr) (process-send-string sieve-manage-process cmdstr)) (provide 'sieve-manage) commit 46963d0bc9058caeb8241abe34b1552bd83e097d Author: Kai Tetzlaff Date: Mon Feb 28 11:33:56 2022 +0100 Improve robustnes of `sieve-manage-quit' in case of errors * lisp/net/sieve.el (sieve-manage-quit): Avoid killing buffers it's not supposed to touch (bug#54154). diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 3a6067ee10..c2faeaef54 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -152,7 +152,8 @@ require \"fileinto\"; (interactive) (sieve-manage-close sieve-manage-buffer) (kill-buffer sieve-manage-buffer) - (kill-buffer (current-buffer))) + (when-let ((buffer (get-buffer sieve-buffer))) + (kill-buffer buffer))) (defun sieve-bury-buffer () "Bury the Manage Sieve buffer without closing the connection." commit 015fb4ac1c84485c563934087884f8a7dfe51955 Author: Stefan Kangas Date: Tue Sep 6 13:03:40 2022 +0200 Add tests for opening different image formats * test/src/image-tests.el (image-tests-make-load-image-test): New macro. (image-tests-load-image/gif) (image-tests-load-image/jpeg) (image-tests-load-image/pbm) (image-tests-load-image/png) (image-tests-load-image/svg) (image-tests-load-image/tiff) (image-tests-load-image/webp) (image-tests-load-image/xbm) (image-tests-load-image/xpm): New tests. diff --git a/test/src/image-tests.el b/test/src/image-tests.el index c05582ada7..0a13db67d4 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -33,11 +33,12 @@ `(skip-unless (and (display-images-p) (image-type-available-p ,format)))) -;;;; Images + +;;;; Image data (defconst image-tests--images `((gif . ,(expand-file-name "test/data/image/black.gif" - source-directory)) + source-directory)) (jpeg . ,(expand-file-name "test/data/image/black.jpg" source-directory)) (pbm . ,(find-image '((:file "splash.svg" :type svg)))) @@ -51,6 +52,34 @@ (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm)))) (xpm . ,(find-image '((:file "splash.xpm" :type xpm)))))) + +;;;; Load image + +(defmacro image-tests-make-load-image-test (type) + `(ert-deftest ,(intern (format "image-tests-load-image/%s" + (eval type t))) + () + (image-skip-unless ,type) + (let* ((img (cdr (assq ,type image-tests--images))) + (file (if (listp img) + (plist-get (cdr img) :file) + img))) + (find-file file)) + (should (equal major-mode 'image-mode)) + ;; Cleanup + (kill-buffer (current-buffer)))) + +(image-tests-make-load-image-test 'gif) +(image-tests-make-load-image-test 'jpeg) +(image-tests-make-load-image-test 'pbm) +(image-tests-make-load-image-test 'png) +(image-tests-make-load-image-test 'svg) +(image-tests-make-load-image-test 'tiff) +(image-tests-make-load-image-test 'webp) +(image-tests-make-load-image-test 'xbm) +(image-tests-make-load-image-test 'xpm) + + ;;;; image-test-size (declare-function image-size "image.c" (spec &optional pixels frame)) @@ -126,6 +155,7 @@ (skip-unless (not (display-images-p))) (should-error (image-size 'invalid-spec))) + ;;;; image-mask-p (declare-function image-mask-p "image.c" (spec &optional frame)) @@ -178,6 +208,7 @@ (skip-unless (not (display-images-p))) (should-error (image-mask-p (cdr (assq 'xpm image-tests--images))))) + ;;;; image-metadata (declare-function image-metadata "image.c" (spec &optional frame)) @@ -235,6 +266,7 @@ (skip-unless (not (display-images-p))) (should-error (image-metadata (cdr (assq 'xpm image-tests--images))))) + ;;;; ImageMagick (ert-deftest image-tests-imagemagick-types () @@ -242,6 +274,7 @@ (when (fboundp 'imagemagick-types) (should (listp (imagemagick-types))))) + ;;;; Initialization (ert-deftest image-tests-init-image-library () commit 2d29ee5ddedaf43ee1ee2e476810bbba06bf177e Author: Stefan Kangas Date: Tue Sep 6 12:56:51 2022 +0200 Fix interactive image.c tests * test/src/image-tests.el (image-tests-image-metadata/gif) (image-tests-image-metadata/webp): Fix tests. diff --git a/test/src/image-tests.el b/test/src/image-tests.el index 36278f4b9f..c05582ada7 100644 --- a/test/src/image-tests.el +++ b/test/src/image-tests.el @@ -187,8 +187,9 @@ (ert-deftest image-tests-image-metadata/gif () (image-skip-unless 'gif) - (should-not (image-metadata - (create-image (cdr (assq 'gif image-tests--images)))))) + (should (memq 'delay + (image-metadata + (create-image (cdr (assq 'gif image-tests--images))))))) (ert-deftest image-tests-image-metadata/jpeg () (image-skip-unless 'jpeg) @@ -214,8 +215,9 @@ (ert-deftest image-tests-image-metadata/webp () (image-skip-unless 'webp) - (should-not (image-metadata - (create-image (cdr (assq 'webp image-tests--images)))))) + (should (memq 'delay + (image-metadata + (create-image (cdr (assq 'webp image-tests--images))))))) (ert-deftest image-tests-image-metadata/xbm () (image-skip-unless 'xbm) commit 653bc3943482783b646a00aa90f5e0e3c2d4c58a Author: Drew Adams Date: Tue Sep 6 12:53:50 2022 +0200 Add some new find-lisp commands * lisp/find-lisp.el (find-lisp-find-dired-other-window): New command. (find-lisp-find-dired): Improve the doc string. (find-lisp-find-dired-subdirectories): Clarify doc string. (find-lisp-find-dired-subdirs-other-window): New command. (find-lisp-find-dired-internal): Adjust to allow being called by the new command. (find-lisp-format): Make symlink output more regular. diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index e825d9cba0..62b4ef625d 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -166,7 +166,8 @@ It is a function which takes two arguments, the directory and its parent." ;;;###autoload (defun find-lisp-find-dired (dir regexp) - "Find files in DIR, matching REGEXP." + "Find the files within DIR whose names match REGEXP. +A Dired buffer with the results will be opened." (interactive "DFind files in directory: \nsMatching regexp: ") (let ((find-lisp-regexp regexp)) (find-lisp-find-dired-internal @@ -175,34 +176,54 @@ It is a function which takes two arguments, the directory and its parent." 'find-lisp-default-directory-predicate "*Find Lisp Dired*"))) +(defun find-lisp-find-dired-other-window (dir regexp) + "Same as `find-lisp-find-dired', but use another window." + (interactive "DFind files in directory: \nsMatching regexp: ") + (let ((find-lisp-regexp regexp)) + (find-lisp-find-dired-internal + dir + 'find-lisp-default-file-predicate + 'find-lisp-default-directory-predicate + "*Find Lisp Dired*" + 'OTHER-WINDOW))) + ;; Just the subdirectories ;;;###autoload (defun find-lisp-find-dired-subdirectories (dir) "Find all subdirectories of DIR." - (interactive "DFind subdirectories of directory: ") + (interactive "DFind dired subdirectories of directory: ") (find-lisp-find-dired-internal dir 'find-lisp-file-predicate-is-directory 'find-lisp-default-directory-predicate "*Find Lisp Dired Subdirectories*")) +;;;###autoload +(defun find-lisp-find-dired-subdirs-other-window (dir) + "Same as `find-lisp-find-dired-subdirectories', but use another window." + (interactive "DDired descendent dirs of directory: ") + (find-lisp-find-dired-internal dir + 'find-lisp-file-predicate-is-directory + 'find-lisp-default-directory-predicate + "*Find Lisp Dired Subdirectories*" + 'OTHER-WINDOW)) + ;; Most of this is lifted from find-dired.el ;; (defun find-lisp-find-dired-internal (dir file-predicate - directory-predicate buffer-name) + directory-predicate buffer-name + &optional other-window) "Run find (Lisp version) and go into Dired mode on a buffer of the output." - (let ((dired-buffers dired-buffers) - (regexp find-lisp-regexp)) - ;; Expand DIR ("" means default-directory), and make sure it has a - ;; trailing slash. + (let ((dired-buffers dired-buffers) + (regexp find-lisp-regexp)) + ;; Expand DIR ("" means `default-directory'), ensuring a trailing slash. (setq dir (file-name-as-directory (expand-file-name dir))) ;; Check that it's really a directory. (or (file-directory-p dir) (error "find-dired needs a directory: %s" dir)) - (or - (and (buffer-name) - (string= buffer-name (buffer-name))) - (switch-to-buffer (get-buffer-create buffer-name))) + (unless (and (buffer-name) (string= buffer-name (buffer-name))) + (let ((buf (get-buffer-create buffer-name))) + (if other-window (pop-to-buffer buf) (switch-to-buffer buf)))) (widen) (kill-all-local-variables) (setq buffer-read-only nil) @@ -278,10 +299,19 @@ It is a function which takes two arguments, the directory and its parent." (revert-buffer)) (defun find-lisp-find-dired-insert-file (file buffer) + "Insert line for FILE in BUFFER. +FILE is a file or a directory name. + +This function heeds `dired-actual-switches'." (set-buffer buffer) (insert find-lisp-line-indent - (find-lisp-format file (file-attributes file 'string) (list "") - nil))) + (find-lisp-format + (propertize file 'dired-filename t) + (file-attributes file 'string) + (or (and dired-actual-switches + (split-string-and-unquote dired-actual-switches)) + (list "")) + nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Lifted from ls-lisp. We don't want to require it, because that @@ -289,15 +319,14 @@ It is a function which takes two arguments, the directory and its parent." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun find-lisp-format (file-name file-attr switches now) - "Format one line of long ls output for file FILE-NAME. + "Format one line of long `ls' output for file or directory FILE-NAME. FILE-ATTR and FILE-SIZE give the file's attributes and size. SWITCHES and TIME-INDEX give the full switch list and time data." (let ((file-type (file-attribute-type file-attr))) - (concat (if (memq ?i switches) ; inode number - (format "%6d " (file-attribute-inode-number file-attr))) - ;; nil is treated like "" in concat - (if (memq ?s switches) ; size in K - (format "%4d " (1+ (/ (file-attribute-size file-attr) 1024)))) + (concat (and (memq ?i switches) ; inode number + (format "%6d " (file-attribute-inode-number file-attr))) + (and (memq ?s switches) ; size in K + (format "%4d " (1+ (/ (file-attribute-size file-attr) 1024)))) (file-attribute-modes file-attr) (format " %3d %-8s %-8s %8d " (file-attribute-link-number file-attr) @@ -309,14 +338,14 @@ SWITCHES and TIME-INDEX give the full switch list and time data." (if (numberp (file-attribute-group-id file-attr)) (int-to-string (file-attribute-group-id file-attr)) (file-attribute-group-id file-attr))) - (file-attribute-size file-attr) - ) + (file-attribute-size file-attr)) (find-lisp-format-time file-attr switches now) " " file-name - (if (stringp file-type) ; is a symbolic link - (concat " -> " file-type) - "") + (and (eq t file-type) (memq ?F switches) + "/") ; Add `/' for dir if `F' switch + (and (stringp file-type) + (concat " -> " file-type)) ; Add " -> " for symbolic link "\n"))) (defun find-lisp-time-index (switches) commit 969983ea1fe4ecca6c714c84b033fa5d0195b753 Author: Laurence Warne Date: Tue Sep 6 12:28:12 2022 +0200 Apply syntax highlighting for all python f-strings * lisp/progmodes/python.el (python--f-string-p) (python--font-lock-f-strings): Edit functions to use a regular expression matching all f-strings (bug#56757). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 147c5f248d..3247d7ad50 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -546,11 +546,22 @@ The type returned can be `comment', `string' or `paren'." font-lock-string-face) font-lock-comment-face)) +(defconst python--f-string-start-regexp + (rx bow + (or "f" "F" "fr" "Fr" "fR" "FR" "rf" "rF" "Rf" "RF") + (or "\"" "\"\"\"" "'" "'''")) + "A regular expression matching the beginning of an f-string. + +See URL `https://docs.python.org/3/reference/lexical_analysis.html#string-and-bytes-literals'.") + (defun python--f-string-p (ppss) "Return non-nil if the pos where PPSS was found is inside an f-string." (and (nth 3 ppss) - (let ((spos (1- (nth 8 ppss)))) - (and (memq (char-after spos) '(?f ?F)) + (let* ((spos (1- (nth 8 ppss))) + (before-quote + (buffer-substring-no-properties (max (- spos 4) (point-min)) + (min (+ spos 2) (point-max))))) + (and (string-match-p python--f-string-start-regexp before-quote) (or (< (point-min) spos) (not (memq (char-syntax (char-before spos)) '(?w ?_)))))))) @@ -569,7 +580,7 @@ the {...} holes that appear within f-strings." (while (progn (while (and (not (python--f-string-p ppss)) - (re-search-forward "\\ Date: Tue Sep 6 12:33:45 2022 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 106456d01bd9b9ffe82c00c4b09a9094a603438e Author: Michael Albinus Date: Tue Sep 6 12:33:19 2022 +0200 Use secondary groups when checking permissions in Tramp (Bug#57044) * lisp/net/tramp.el (tramp-check-cached-permissions): Check also for secondary groups. (Bug#57044) (tramp-get-remote-groups): * lisp/net/tramp-adb.el (tramp-adb-handle-get-remote-groups): * lisp/net/tramp-sh.el (tramp-sh-handle-get-remote-groups): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-get-remote-groups): New defuns. * lisp/net/tramp.el (tramp-file-name-for-operation): * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add `tramp-get-remote-groups'. * lisp/net/tramp.el: * lisp/net/tramp-adb.el: * lisp/net/tramp-cache.el: * lisp/net/tramp-crypt.el: * lisp/net/tramp-fuse.el: * lisp/net/tramp-gvfs.el: * lisp/net/tramp-integration.el: * lisp/net/tramp-rclone.el: * lisp/net/tramp-sh.el: * lisp/net/tramp-smb.el: * lisp/net/tramp-sudoedit.el: Use `blank' in `rx' forms. * test/lisp/net/tramp-archive-tests.el: * test/lisp/net/tramp-tests.el: Use `blank' in `rx' forms. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index ab38ffa0cf..3fb28d91ea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") space) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -71,20 +71,20 @@ It is used for TCP/IP devices." "Regexp for date time format in ls output.")) (defconst tramp-adb-ls-date-regexp - (rx space (regexp tramp-adb-ls-date-year-regexp) - space (regexp tramp-adb-ls-date-time-regexp) - space) + (rx blank (regexp tramp-adb-ls-date-year-regexp) + blank (regexp tramp-adb-ls-date-time-regexp) + blank) "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp - (rx bol (* space) (group (+ (any ".-" alpha))) ; \1 permissions - (? (+ space) (+ digit)) ; links (Android 7/toybox) - (* space) (group (+ (not space))) ; \2 username - (+ space) (group (+ (not space))) ; \3 group - (+ space) (group (+ digit)) ; \4 size - (+ space) (group (regexp tramp-adb-ls-date-year-regexp) - space (regexp tramp-adb-ls-date-time-regexp)) ; \5 date - space (group (* nonl)) eol) ; \6 filename + (rx bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions + (? (+ blank) (+ digit)) ; links (Android 7/toybox) + (* blank) (group (+ (not blank))) ; \2 username + (+ blank) (group (+ (not blank))) ; \3 group + (+ blank) (group (+ digit)) ; \4 size + (+ blank) (group (regexp tramp-adb-ls-date-year-regexp) + blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date + blank (group (* nonl)) eol) ; \6 filename "Regexp for ls output.") ;;;###tramp-autoload @@ -180,6 +180,7 @@ It is used for TCP/IP devices." (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . ignore) (tramp-get-remote-gid . tramp-adb-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-adb-handle-get-remote-groups) (tramp-get-remote-uid . tramp-adb-handle-get-remote-uid) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) @@ -218,7 +219,7 @@ arguments to pass to the OPERATION." (mapcar (lambda (line) (when (string-match - (rx bol (group (+ (not space))) (+ space) "device" eol) line) + (rx bol (group (+ (not blank))) (+ blank) "device" eol) line) ;; Replace ":" by "#". `(nil ,(tramp-compat-string-replace ":" tramp-prefix-port-format (match-string 1 line))))) @@ -235,10 +236,10 @@ arguments to pass to the OPERATION." (goto-char (point-min)) (forward-line) (when (looking-at - (rx (* space) (+ (not space)) - (+ space) (group (+ digit)) - (+ space) (group (+ digit)) - (+ space) (group (+ digit)))) + (rx (* blank) (+ (not blank)) + (+ blank) (group (+ digit)) + (+ blank) (group (+ digit)) + (+ blank) (group (+ digit)))) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. (list (* 1024 (string-to-number (match-string 1))) @@ -362,12 +363,12 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - (rx space (group space (regexp tramp-adb-ls-date-year-regexp) space)) + (rx blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank)) nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". (when (looking-at-p - (rx (regexp tramp-adb-ls-date-time-regexp) (+ space) eol)) + (rx (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol)) (end-of-line) (insert "/"))) ;; Sort entries. @@ -466,7 +467,7 @@ Emacs dired can't find files." nil (mapcar (lambda (l) - (and (not (string-match-p (rx bol (* space) eol) l)) l)) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) (split-string (buffer-string) "\n"))))))))))) (defun tramp-adb-handle-file-local-copy (filename) @@ -717,9 +718,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar result 0) (dolist (line signals) (when (string-match - (rx bol (* space) (group (+ digit)) - (+ space) (+ (not space)) - (+ space) (group alpha (* nonl)) eol) + (rx bol (* blank) (group (+ digit)) + (+ blank) (+ (not blank)) + (+ blank) (group alpha (* nonl)) eol) line) (setcar (nthcdr (string-to-number (match-string 1 line)) result) @@ -1066,6 +1067,31 @@ ID-FORMAT valid values are `string' and `integer'." (goto-char (point-min)) (read (current-buffer)))) +(defun tramp-adb-handle-get-remote-groups (vec id-format) + "Like `tramp-get-remote-groups' for Tramp files. +ID-FORMAT valid values are `string' and `integer'." + ;; The result is cached in `tramp-get-remote-groups'. + (tramp-adb-send-command vec "id") + (with-current-buffer (tramp-get-connection-buffer vec) + (let (groups-integer groups-string) + ;; Read the expression. + (goto-char (point-min)) + (when (re-search-forward (rx bol (+ nonl) "groups=") nil 'noerror) + (while (looking-at + (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")")) + (setq groups-integer (cons (string-to-number (match-string 1)) + groups-integer) + groups-string (cons (match-string 2) groups-string)) + (goto-char (match-end 0)) + (skip-chars-forward ","))) + (tramp-set-connection-property + vec "groups-integer" + (setq groups-integer (nreverse groups-integer))) + (tramp-set-connection-property + vec "groups-string" + (setq groups-string (nreverse groups-string))) + (if (eq id-format 'integer) groups-integer groups-string)))) + (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" @@ -1142,7 +1168,7 @@ error and non-nil on success." ;; We can't use stty to disable echo of command. stty is said ;; to be added to toybox 0.7.6. busybox shall have it, but this ;; isn't used any longer for Android. - (delete-matching-lines (rx (literal command))) + (delete-matching-lines (rx bol (literal command) eol)) ;; When the local machine is W32, there are still trailing ^M. ;; There must be a better solution by setting the correct coding ;; system, but this requires changes in core Tramp. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index c25d509671..21a1e94e41 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -297,6 +297,7 @@ It must be supported by libarchive(3).") (temporary-file-directory . tramp-archive-handle-temporary-file-directory) (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) + (tramp-get-remote-groups . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4c745092a3..b9abcd3842 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -278,7 +278,7 @@ Remove also properties of all files in subdirectories." This is suppressed for temporary buffers." (save-match-data (unless (or (null (buffer-name)) - (string-match-p (rx bos (| space "*")) (buffer-name))) + (string-match-p (rx bos (| blank "*")) (buffer-name))) (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory)) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index e7bb1ebe33..3f5275624f 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -233,6 +233,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (temporary-file-directory . tramp-handle-temporary-file-directory) ;; `tramp-get-home-directory' performed by default-handler. ;; `tramp-get-remote-gid' performed by default handler. + ;; `tramp-get-remote-groups' performed by default handler. ;; `tramp-get-remote-uid' performed by default handler. (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 4b51af070a..8761dd1c07 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -179,7 +179,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (tramp-set-file-property vec "/" "mounted" (when (string-match - (rx bol (group (literal (tramp-fuse-mount-spec vec))) space) + (rx bol (group (literal (tramp-fuse-mount-spec vec))) blank) mount) (match-string 1 mount))))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 9c81bccffc..817246fcec 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -823,6 +823,7 @@ It has been changed in GVFS 1.14.") (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory) (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid) + (tramp-get-remote-groups . ignore) (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) @@ -1496,9 +1497,9 @@ If FILE-SYSTEM is non-nil, return file system attributes." (while (string-match (rx bol (+ nonl) ":" - space (group (+ nonl)) ":" - space (group (regexp (regexp-opt tramp-gio-events))) - (? (group space (group (+ nonl)))) eol) + blank (group (+ nonl)) ":" + blank (group (regexp (regexp-opt tramp-gio-events))) + (? (group blank (group (+ nonl)))) eol) string) (let ((file (match-string 1 string)) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index afc3e94580..61b2c2ecb7 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -218,11 +218,11 @@ NAME must be equal to `tramp-current-connection'." :mode 'tramp-info-lookup-mode :topic 'symbol :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’")))) :doc-spec '(("(tramp)Function Index" nil - (rx bol space (+ "-") space (* nonl) ": ") - (rx (| space eol))) + (rx bol blank (+ "-") blank (* nonl) ": ") + (rx (| blank eol))) ("(tramp)Variable Index" nil - (rx bol space (+ "-") space (* nonl) ": ") - (rx (| space eol))))) + (rx bol blank (+ "-") blank (* nonl) ": ") + (rx (| blank eol))))) (add-hook 'tramp-integration-unload-hook diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 435faf8329..b40755bc0e 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -147,6 +147,7 @@ (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) + (tramp-get-remote-groups . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) @@ -186,7 +187,7 @@ arguments to pass to the OPERATION." (delq nil (mapcar (lambda (line) - (when (string-match (rx bol (group (+ (not space))) ":" eol) line) + (when (string-match (rx bol (group (+ (not blank))) ":" eol) line) `(nil ,(match-string 1 line)))) (tramp-process-lines nil tramp-rclone-program "listremotes"))))) @@ -300,11 +301,11 @@ file names." (let (total used free) (goto-char (point-min)) (while (not (eobp)) - (when (looking-at (rx "Total: " (+ space) (group (+ digit)))) + (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) (setq total (string-to-number (match-string 1)))) - (when (looking-at (rx "Used: " (+ space) (group (+ digit)))) + (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) (setq used (string-to-number (match-string 1)))) - (when (looking-at (rx "Free: " (+ space) (group (+ digit)))) + (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) (setq free (string-to-number (match-string 1)))) (forward-line)) (when used diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index dfb87059bd..ff153d955b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1082,6 +1082,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . tramp-sh-handle-get-home-directory) (tramp-get-remote-gid . tramp-sh-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-sh-handle-get-remote-groups) (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) @@ -1539,6 +1540,32 @@ ID-FORMAT valid values are `string' and `integer'." ((tramp-get-remote-python vec) (tramp-get-remote-gid-with-python vec id-format))))) +(defun tramp-sh-handle-get-remote-groups (vec id-format) + "Like `tramp-get-remote-groups' for Tramp files. +ID-FORMAT valid values are `string' and `integer'." + ;; The result is cached in `tramp-get-remote-groups'. + (when (tramp-get-remote-id vec) + (tramp-send-command vec (tramp-get-remote-id vec))) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (groups-integer groups-string) + ;; Read the expression. + (goto-char (point-min)) + (when (re-search-forward (rx bol (+ nonl) "groups=") nil 'noerror) + (while (looking-at + (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")")) + (setq groups-integer (cons (string-to-number (match-string 1)) + groups-integer) + groups-string (cons (match-string 2) groups-string)) + (goto-char (match-end 0)) + (skip-chars-forward ","))) + (tramp-set-connection-property + vec "groups-integer" + (setq groups-integer (nreverse groups-integer))) + (tramp-set-connection-property + vec "groups-string" + (setq groups-string (nreverse groups-string))) + (if (eq id-format 'integer) groups-integer groups-string)))) + (defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid) "Like `tramp-set-file-uid-gid' for Tramp files." ;; Modern Unices allow chown only for root. So we might need @@ -2660,7 +2687,7 @@ The method used must be an out-of-band method." (narrow-to-region beg-marker end-marker) ;; Check for "--dired" output. (when (re-search-backward - (rx bol "//DIRED//" (+ space) (group (+ nonl)) eol) + (rx bol "//DIRED//" (+ blank) (group (+ nonl)) eol) nil 'noerror) (let ((beg (match-beginning 1)) (end (match-end 0))) @@ -2733,7 +2760,7 @@ The method used must be an out-of-band method." ;; Try to insert the amount of free space. (goto-char (point-min)) ;; First find the line to put it on. - (when (and (re-search-forward (rx bol (group (* space) "total")) nil t) + (when (and (re-search-forward (rx bol (group (* blank) "total")) nil t) ;; Emacs 29.1 or later. (not (fboundp 'dired--insert-disk-space))) (when-let ((available (get-free-disk-space "."))) @@ -3837,7 +3864,7 @@ Fall back to normal file name handler if no Tramp handler exists." ((string-match (rx "Supported arguments for " "GIO_USE_FILE_MONITOR environment variable:\n" - (* space) (group (+ alpha)) " - 20") + (* blank) (group (+ alpha)) " - 20") string) (setq pos (match-end 0)) (intern @@ -3849,10 +3876,10 @@ Fall back to normal file name handler if no Tramp handler exists." (setq string (tramp-compat-string-replace "\n\n" "\n" string)) (while (string-match - (rx bol (+ (not (any ":"))) ":" space - (group (+ (not (any ":")))) ":" space + (rx bol (+ (not (any ":"))) ":" blank + (group (+ (not (any ":")))) ":" blank (group (regexp (regexp-opt tramp-gio-events))) - (? space (group (+ (not (any ":"))))) eol) + (? blank (group (+ (not (any ":"))))) eol) string) (let* ((file (match-string 1 string)) @@ -3926,9 +3953,9 @@ Fall back to normal file name handler if no Tramp handler exists." (goto-char (point-min)) (forward-line) (when (looking-at - (rx (? bol "/" (* (not space)) space) (* space) - (group (+ digit)) (+ space) - (group (+ digit)) (+ space) + (rx (? bol "/" (* (not blank)) blank) (* blank) + (group (+ digit)) (+ blank) + (group (+ digit)) (+ blank) (group (+ digit)))) (mapcar (lambda (d) @@ -4068,7 +4095,7 @@ This function expects to be in the right *tramp* buffer." (unless (or ignore-path (tramp-check-remote-uname vec tramp-sunos-unames)) (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) - (if (looking-at-p (rx bol (* space) "1" eol)) + (if (looking-at-p (rx bol (* blank) "1" eol)) (setq result (concat "\\" progname)))) (unless result (when ignore-tilde @@ -4976,9 +5003,9 @@ Goes through the list `tramp-inline-compress-commands'." string (and (string-match - (rx bol (+ (not (any space "#"))) space - (+ (not space)) space - (group (+ (not space))) eol) + (rx bol (+ (not (any blank "#"))) blank + (+ (not blank)) blank + (group (+ (not blank))) eol) string) (match-string 1 string)) found @@ -5393,7 +5420,7 @@ raises an error." (unless noerror signal-hook-function))) (read (current-buffer))) ;; Error handling. - (when (re-search-forward (rx (not space)) (line-end-position) t) + (when (re-search-forward (rx (not blank)) (line-end-position) t) (error nil))) (error (unless noerror (tramp-error diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 3d65520282..930f4f707b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -98,9 +98,9 @@ this variable \"client min protocol=NT1\"." "Regexp of SMB server identification.") (defconst tramp-smb-prompt - (rx bol (| (: (| "smb:" "PS") space (+ nonl) "> ") - (: (+ space) "Server" - (+ space) "Comment" eol))) + (rx bol (| (: (| "smb:" "PS") blank (+ nonl) "> ") + (: (+ blank) "Server" + (+ blank) "Comment" eol))) "Regexp used as prompt in smbclient or powershell.") (defconst tramp-smb-wrong-passwd-regexp @@ -110,10 +110,10 @@ this variable \"client min protocol=NT1\"." (defconst tramp-smb-errors (rx (| ;; Connection error / timeout / unknown command. - (: "Connection" (? " to " (+ (not space))) " failed") + (: "Connection" (? " to " (+ (not blank))) " failed") "Read from server failed, maybe it closed the connection" "Call timed out: server did not respond" - (: (+ (not space)) ": command not found") + (: (+ (not blank)) ": command not found") "Server doesn't support UNIX CIFS calls" (| ;; Samba. "ERRDOS" @@ -298,6 +298,7 @@ See `tramp-actions-before-shell' for more info.") (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . tramp-smb-handle-get-home-directory) (tramp-get-remote-gid . ignore) + (tramp-get-remote-groups . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) @@ -884,28 +885,28 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (while (not (eobp)) (cond ((looking-at - (rx "Size:" (+ space) (group (+ digit)) (+ space) - "Blocks:" (+ space) (+ digit) (+ space) (group (+ wordchar)))) + (rx "Size:" (+ blank) (group (+ digit)) (+ blank) + "Blocks:" (+ blank) (+ digit) (+ blank) (group (+ wordchar)))) (setq size (string-to-number (match-string 1)) id (if (string-equal "directory" (match-string 2)) t (if (string-equal "symbolic" (match-string 2)) "")))) ((looking-at - (rx "Inode:" (+ space) (group (+ digit)) (+ space) - "Links:" (+ space) (group (+ digit)))) + (rx "Inode:" (+ blank) (group (+ digit)) (+ blank) + "Links:" (+ blank) (group (+ digit)))) (setq inode (string-to-number (match-string 1)) link (string-to-number (match-string 2)))) ((looking-at - (rx "Access:" (+ space) - "(" (+ digit) "/" (group (+ (not space))) ")" (+ space) - "Uid:" (+ space) (group (+ digit)) (+ whitespace) - "Gid:" (+ space) (group (+ digit)))) + (rx "Access:" (+ blank) + "(" (+ digit) "/" (group (+ (not blank))) ")" (+ blank) + "Uid:" (+ blank) (group (+ digit)) (+ blank) + "Gid:" (+ blank) (group (+ digit)))) (setq mode (match-string 1) uid (match-string 2) gid (match-string 3))) ((looking-at - (rx "Access:" (+ space) + (rx "Access:" (+ blank) (group (+ digit)) "-" (group (+ digit)) "-" - (group (+ digit)) (+ space) + (group (+ digit)) (+ blank) (group (+ digit)) ":" (group (+ digit)) ":" (group (+ digit)))) (setq atime @@ -917,9 +918,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (rx "Modify:" (+ space) + (rx "Modify:" (+ blank) (group (+ digit)) "-" (group (+ digit)) "-" - (group (+ digit)) (+ space) + (group (+ digit)) (+ blank) (group (+ digit)) ":" (group (+ digit)) ":" (group (+ digit)))) (setq mtime @@ -931,9 +932,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (rx "Change:" (+ space) + (rx "Change:" (+ blank) (group (+ digit)) "-" (group (+ digit)) "-" - (group (+ digit)) (+ space) + (group (+ digit)) (+ blank) (group (+ digit)) ":" (group (+ digit)) ":" (group (+ digit)))) (setq ctime @@ -1008,7 +1009,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (forward-line) (when (looking-at - (rx (* space) (group (+ digit)) + (rx (* blank) (group (+ digit)) " blocks of size " (group (+ digit)) ". " (group (+ digit)) " blocks available")) (setq blocksize (string-to-number (match-string 2)) @@ -1660,7 +1661,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (replace-match "$" nil nil localname 1))) ;; A trailing space is not supported. - (when (string-match-p (rx space eol) localname) + (when (string-match-p (rx blank eol) localname) (tramp-error vec 'file-error "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) @@ -1853,9 +1854,9 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; localname. (if (string-match - (rx bol (+ space) - (group (not space) (? (* nonl) (not space))) - (* space) eol) + (rx bol (+ blank) + (group (not blank) (? (* nonl) (not blank))) + (* blank) eol) line) (setq localname (match-string 1 line)) (cl-return)))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 31720a605e..b89e1282d2 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -150,6 +150,7 @@ (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) + (tramp-get-remote-groups . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) (unhandled-file-name-directory . ignore) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 893afcdbbe..ef0954ab83 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -143,6 +143,7 @@ See `tramp-actions-before-shell' for more info.") (temporary-file-directory . tramp-handle-temporary-file-directory) (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory) (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-sudoedit-handle-get-remote-groups) (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) @@ -473,7 +474,7 @@ the result will be a local, non-Tramp, file name." (delq nil (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* space) eol) l)) l)) + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) (split-string (tramp-get-buffer-string (tramp-get-connection-buffer v)) "\n" 'omit)))))))) @@ -535,9 +536,9 @@ the result will be a local, non-Tramp, file name." (goto-char (point-min)) (forward-line) (when (looking-at - (rx (* space) (group (+ digit)) - (+ space) (group (+ digit)) - (+ space) (group (+ digit)))) + (rx (* blank) (group (+ digit)) + (+ blank) (group (+ digit)) + (+ blank) (group (+ digit)))) (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. @@ -732,6 +733,31 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-sudoedit-send-command-and-read vec "id" "-g") (tramp-sudoedit-send-command-string vec "id" "-gn"))) +(defun tramp-sudoedit-handle-get-remote-groups (vec id-format) + "Like `tramp-get-remote-groups' for Tramp files. +ID-FORMAT valid values are `string' and `integer'." + ;; The result is cached in `tramp-get-remote-groups'. + (tramp-sudoedit-send-command vec "id") + (with-current-buffer (tramp-get-connection-buffer vec) + (let (groups-integer groups-string) + ;; Read the expression. + (goto-char (point-min)) + (when (re-search-forward (rx bol (+ nonl) "groups=") nil 'noerror) + (while (looking-at + (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")")) + (setq groups-integer (cons (string-to-number (match-string 1)) + groups-integer) + groups-string (cons (match-string 2) groups-string)) + (goto-char (match-end 0)) + (skip-chars-forward ","))) + (tramp-set-connection-property + vec "groups-integer" + (setq groups-integer (nreverse groups-integer))) + (tramp-set-connection-property + vec "groups-string" + (setq groups-string (nreverse groups-string))) + (if (eq id-format 'integer) groups-integer groups-string)))) + (defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid) "Like `tramp-set-file-uid-gid' for Tramp files." (tramp-skeleton-set-file-modes-times-uid-gid filename @@ -846,7 +872,7 @@ In case there is no valid Lisp expression, it raises an error." (condition-case nil (prog1 (read (current-buffer)) ;; Error handling. - (when (re-search-forward (rx (not space)) (line-end-position) t) + (when (re-search-forward (rx (not blank)) (line-end-position) t) (error nil))) (error (tramp-error vec 'file-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b24525de3a..cfc005d270 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -598,7 +598,7 @@ if you need to change this." :type 'string) (defcustom tramp-login-prompt-regexp - (rx (* nonl) (| "user" "login") (? space (* nonl)) ":" (* space)) + (rx (* nonl) (| "user" "login") (? blank (* nonl)) ":" (* blank)) "Regexp matching login-like prompts. The regexp should match at end of buffer. @@ -612,9 +612,9 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; connection initialization; Tramp redefines the prompt afterwards. (rx (| bol "\r") (* (not (any "\n#$%>]"))) - (? "#") (any "#$%>]") (* space) + (? "#") (any "#$%>]") (* blank) ;; Escape characters. - (* "[" (* (any ";" digit)) alpha (* space))) + (* "[" (* (any ";" digit)) alpha (* blank))) "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -631,7 +631,7 @@ This regexp must match both `tramp-initial-end-of-output' and (defcustom tramp-password-prompt-regexp (rx bol (* nonl) (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) ":" (? "\^@") (* space)) + (* nonl) ":" (? "\^@") (* blank)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -664,7 +664,7 @@ The regexp should match at end of buffer." (defcustom tramp-yesno-prompt-regexp (rx "Are you sure you want to continue connecting (yes/no" (? "/[fingerprint]") ")?" - (* space)) + (* blank)) "Regular expression matching all yes/no queries which need to be confirmed. The confirmation should be done with yes or no. The regexp should match at end of buffer. @@ -674,7 +674,7 @@ See also `tramp-yn-prompt-regexp'." (defcustom tramp-yn-prompt-regexp (rx (| "Store key in cache? (y/n)" "Update cached key? (y/n, Return cancels connection)") - (* space)) + (* blank)) "Regular expression matching all y/n queries which need to be confirmed. The confirmation should be done with y or n. The regexp should match at end of buffer. @@ -693,7 +693,7 @@ files conditionalize this setup based on the TERM environment variable." (defcustom tramp-terminal-prompt-regexp (rx (| (: "TERM = (" (* nonl) ")") (: "Terminal type? [" (* nonl) "]")) - (* space)) + (* blank)) "Regular expression matching all terminal setting prompts. The regexp should match at end of buffer. The answer will be provided by `tramp-action-terminal', which see." @@ -736,7 +736,7 @@ The regexp should match at end of buffer." :type 'regexp) (defcustom tramp-operation-not-permitted-regexp - (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* space) + (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") "Regular expression matching keep-date problems in (s)cp operations. Copying has been performed successfully already, so this message can @@ -749,7 +749,7 @@ be ignored safely." "Permission denied" "is a directory" "not a regular file") - (* space)) + (* blank)) "Regular expression matching copy problems in (s)cp operations." :type 'regexp) @@ -931,7 +931,7 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp (rx (+ (not (any "/:|" space)))) +(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank)))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" @@ -1945,9 +1945,9 @@ of `current-buffer'." (defconst tramp-debug-outline-regexp (rx ;; Timestamp. - (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) space + (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank ;; Thread. - (? (group "#") space) + (? (group "#") blank) ;; Function name, verbosity. (+ (any "-" alnum)) " (" (group (+ digit)) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2636,8 +2636,8 @@ Must be handled by the callers." (tramp-get-default-directory (process-buffer (nth 0 args))))) ;; VEC. ((member operation - '(tramp-get-home-directory - tramp-get-remote-gid tramp-get-remote-uid)) + '(tramp-get-home-directory tramp-get-remote-gid + tramp-get-remote-groups tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) ;; Unknown file primitive. (t (error "Unknown file I/O primitive: %s" operation)))) @@ -3218,7 +3218,7 @@ Either user or host may be nil." (let (result (regexp (rx bol (group (regexp tramp-host-regexp)) - (? (+ space) (group (regexp tramp-user-regexp)))))) + (? (+ blank) (group (regexp tramp-user-regexp)))))) (when (re-search-forward regexp (line-end-position) t) (setq result (append (list (match-string 2) (match-string 1))))) (forward-line 1) @@ -3243,10 +3243,10 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (rx (| (: bol (* space) "Host") + (rx (| (: bol (* blank) "Host") (: bol (+ nonl)) ;; ??? (group (regexp tramp-host-regexp)))) - 1 (rx space))) + 1 (rx blank))) ;; Generic function. (defun tramp-parse-shostkeys-sknownhosts (dirname regexp) @@ -3287,7 +3287,7 @@ User is always nil." User is always nil." (tramp-parse-group (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) - 1 (rx space))) + 1 (rx blank))) (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. @@ -4266,7 +4266,7 @@ Let-bind it when necessary.") (defun tramp-ps-time () "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\". Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." - (search-forward-regexp (rx (+ space))) + (search-forward-regexp (rx (+ blank))) (search-forward-regexp (rx (? (? (group (+ digit)) "-") (group (+ digit)) ":") (group (+ digit)) ":" @@ -4386,17 +4386,17 @@ It is not guaranteed, that all process attributes as described in (cond ((eq (cdr elt) 'number) (read (current-buffer))) ((eq (cdr elt) 'string) - (search-forward-regexp (rx (+ (not space)))) + (search-forward-regexp (rx (+ (not blank)))) (match-string 0)) ((numberp (cdr elt)) - (search-forward-regexp (rx (+ space))) + (search-forward-regexp (rx (+ blank))) (search-forward-regexp (rx (+ nonl)) (+ (point) (cdr elt))) (string-trim (match-string 0))) ((fboundp (cdr elt)) (funcall (cdr elt))) ((null (cdr elt)) - (search-forward-regexp (rx (+ whitespace))) + (search-forward-regexp (rx (+ blank))) (buffer-substring (point) (line-end-position))))) res)) ;; `nice' could be `-'. @@ -4840,7 +4840,7 @@ support symbolic links." (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match-p (rx (* space) "&" (* space) eos) command)) + (let* ((asynchronous (string-match-p (rx (* blank) "&" (* blank) eos) command)) (command (substring command 0 asynchronous)) current-buffer-p (output-buffer-p output-buffer) @@ -5838,7 +5838,8 @@ be granted." ((eq ?s access) 3))) (file-attr (file-attributes (tramp-make-tramp-file-name vec))) (remote-uid (tramp-get-remote-uid vec 'integer)) - (remote-gid (tramp-get-remote-gid vec 'integer))) + (remote-gid (tramp-get-remote-gid vec 'integer)) + (remote-groups (tramp-get-remote-groups vec 'integer))) (or ;; Not a symlink. (eq t (file-attribute-type file-attr)) @@ -5861,7 +5862,12 @@ be granted." (equal remote-gid tramp-unknown-id-integer) (equal remote-gid (file-attribute-group-id file-attr)) (equal tramp-unknown-id-integer - (file-attribute-group-id file-attr))))))) + (file-attribute-group-id file-attr)))) + ;; Group accessible and owned by user's secondary group. + (and + (eq access + (aref (file-attribute-modes file-attr) (+ offset 3))) + (member (file-attribute-group-id file-attr) remote-groups))))) (defmacro tramp-convert-file-attributes (vec localname id-format attr) "Convert `file-attributes' ATTR generated Tramp backend functions. @@ -5999,6 +6005,16 @@ ID-FORMAT valid values are `string' and `integer'." (and (equal id-format 'integer) tramp-unknown-id-integer) (and (equal id-format 'string) tramp-unknown-id-string))) +(defun tramp-get-remote-groups (vec id-format) + "The list of groups of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." + (or (and (tramp-file-name-p vec) + (with-tramp-connection-property vec (format "groups-%s" id-format) + (tramp-file-name-handler #'tramp-get-remote-groups vec id-format))) + ;; Ensure there is a valid result. + (and (equal id-format 'integer) (list tramp-unknown-id-integer)) + (and (equal id-format 'string) (list tramp-unknown-id-string)))) + (defun tramp-local-host-p (vec) "Return t if this points to the local host, nil otherwise. This handles also chrooted environments, which are not regarded as local." diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index aa5d1cc496..d0892bf708 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -622,7 +622,7 @@ This checks also `file-name-as-directory', `file-name-directory', (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) space (literal tramp-archive-test-archive) eol)))) + (rx bol (+ nonl) blank (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -633,11 +633,11 @@ This checks also `file-name-as-directory', `file-name-directory', (rx-to-string `(: ;; There might be a summary line. - (? "total" (+ nonl) (+ digit) (? space) + (? "total" (+ nonl) (+ digit) (? blank) (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order the files appear. (= ,(length (directory-files tramp-archive-test-archive)) - (+ nonl) space + (+ nonl) blank (regexp ,(regexp-opt (directory-files tramp-archive-test-archive))) (? " ->" (+ nonl)) "\n")))))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index fed1d881c5..f42f6838c8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3222,13 +3222,13 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p (rx bol (+ nonl) space (literal tmp-name1) eol)))) + (looking-at-p (rx bol (+ nonl) blank (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) space (literal tmp-name1) "/" eol)))) + (rx bol (+ nonl) blank (literal tmp-name1) "/" eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) @@ -3238,11 +3238,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (rx-to-string `(: ;; There might be a summary line. - (? "total" (+ nonl) (+ digit) (? space) + (? "total" (+ nonl) (+ digit) (? blank) (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order ".", ".." and "foo" appear. (= ,(length (directory-files tmp-name1)) - (+ nonl) space + (+ nonl) blank (regexp ,(regexp-opt (directory-files tmp-name1))) (? " ->" (+ nonl)) "\n")))))) commit 9f3f7f1ec4fdb7152ec5edd5313924fb3575d44f Author: Lars Ingebrigtsen Date: Tue Sep 6 12:24:32 2022 +0200 Make ffap-file-finder work again * lisp/ffap.el (find-file-at-point): Allow people to set ffap-file-finder again (bug#50279). * lisp/ido.el (ido-everywhere): Add an interstitial to fulfil ffap-file-handler semantics. diff --git a/lisp/ffap.el b/lisp/ffap.el index 88b4bce9fd..7ea05dccbd 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1623,9 +1623,9 @@ and `ffap-url-at-point'." ((or (not ffap-newfile-prompt) (file-exists-p filename) (y-or-n-p "File does not exist, create buffer? ")) - (find-file - ;; expand-file-name fixes "~/~/.emacs" bug - (expand-file-name filename))) + (funcall ffap-file-finder + ;; expand-file-name fixes "~/~/.emacs" bug + (expand-file-name filename))) ;; User does not want to find a non-existent file: ((signal 'file-missing (list "Opening file buffer" "No such file or directory" diff --git a/lisp/ido.el b/lisp/ido.el index 520513b1d2..1d0082da97 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1507,15 +1507,18 @@ Removes badly formatted data and ignored directories." (add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup) (add-hook 'choose-completion-string-functions #'ido-choose-completion-string)) +(defun ido--ffap-find-file (file) + (find-file file)) + (define-minor-mode ido-everywhere "Toggle use of Ido for all buffer/file reading." :global t (remove-function read-file-name-function #'ido-read-file-name) (remove-function read-buffer-function #'ido-read-buffer) (when (boundp 'ffap-file-finder) - (remove-function ffap-file-finder #'ido-find-file) + (remove-function ffap-file-finder #'ido--ffap-find-file) (when ido-mode - (add-function :override ffap-file-finder #'ido-find-file))) + (add-function :override ffap-file-finder #'ido--ffap-find-file))) (when ido-everywhere (if (not ido-mode) (ido-mode 'both)