commit a3d3fef2bc60f05f30350ef1cc0bb66e8f7010c7 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Wed Jun 1 14:13:57 2022 +0800 Fix hangs when explicitly moving frames with input blocked * src/xterm.c (x_check_expected_move): Fix indent. (x_sync_with_move): Use pselect to wait the 0.5 seconds instead of wait_reading_process_output if input is blocked. diff --git a/src/xterm.c b/src/xterm.c index 2421108a41..8533961993 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -550,6 +550,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "blockinput.h" @@ -22851,7 +22852,7 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) int adjusted_left; int adjusted_top; - FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_A; + FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_A; FRAME_X_OUTPUT (f)->move_offset_left = expected_left - current_left; FRAME_X_OUTPUT (f)->move_offset_top = expected_top - current_top; @@ -22868,7 +22869,6 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) else /* It's a "Type B" window manager. We don't have to adjust the frame's position. */ - FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_B; } @@ -22882,11 +22882,17 @@ x_check_expected_move (struct frame *f, int expected_left, int expected_top) static void x_sync_with_move (struct frame *f, int left, int top, bool fuzzy) { - int count = 0; + sigset_t emptyset; + int count, current_left, current_top; + struct timespec fallback; + + sigemptyset (&emptyset); + count = 0; while (count++ < 50) { - int current_left = 0, current_top = 0; + current_left = 0; + current_top = 0; /* In theory, this call to XSync only needs to happen once, but in practice, it doesn't seem to work, hence the need for the surrounding @@ -22911,7 +22917,14 @@ x_sync_with_move (struct frame *f, int left, int top, bool fuzzy) /* As a last resort, just wait 0.5 seconds and hope that XGetGeometry will then return up-to-date position info. */ - wait_reading_process_output (0, 500000000, 0, false, Qnil, NULL, 0); + fallback = dtotimespec (0.5); + + /* This will hang if input is blocked, so use pselect to wait + instead. */ + if (input_blocked_p ()) + pselect (0, NULL, NULL, NULL, &fallback, &emptyset); + else + wait_reading_process_output (0, 500000000, 0, false, Qnil, NULL, 0); } commit 76850b26b92ab0f23d56180d000063d4ad6e08ca Author: Po Lu Date: Wed Jun 1 13:50:40 2022 +0800 Implement `allow-same-frame' for NS drag-and-drop * lisp/term/ns-win.el (x-begin-drag): Implement `allow-same-frame'. * src/nsselect.m (Fns_begin_drag): New parameter `allow-same-frame'. * src/nsterm.h (@interface EmacsWindow): Update prototypes. * src/nsterm.m ([EmacsView draggingEntered:]): ([EmacsView prepareForDragOperation:]): ([EmacsView performDragOperation:]): Respect new parameter. ([EmacsWindow beginDrag:forPasteboard:withMode:returnFrameTo:]): Likewise. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 65abdcf0fb..a36d5d11e7 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -895,7 +895,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") &context (window-system ns)) (ns-get-selection selection-symbol target-type)) -(defun x-begin-drag (targets &optional action frame return-frame _allow-current-frame) +(defun x-begin-drag (targets &optional action frame return-frame allow-current-frame) "SKIP: real doc in xfns.c." (unless ns-dnd-selection-value (error "No local value for XdndSelection")) @@ -910,7 +910,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (expand-file-name ns-dnd-selection-value)))) pasteboard)) - (ns-begin-drag frame pasteboard action return-frame))) + (ns-begin-drag frame pasteboard action return-frame allow-current-frame))) (defun ns-handle-drag-motion (frame x y) "Handle mouse movement on FRAME at X and Y during drag-and-drop. diff --git a/src/nsselect.m b/src/nsselect.m index 63cea365e2..a4129b12f0 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -662,7 +662,7 @@ Updated by Christian Limpach (chris@nice.ch) } } -DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 4, 0, +DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 5, 0, doc: /* Begin a drag-and-drop operation on FRAME. FRAME must be a window system frame. PBOARD is an alist of (TYPE @@ -680,13 +680,16 @@ Updated by Christian Limpach (chris@nice.ch) Return the action that the drop target actually chose to perform, or nil if no action was performed (either because there was no drop -target, or the drop was rejected). If RETURN_FRAME is the symbol +target, or the drop was rejected). If RETURN-FRAME is the symbol `now', also return any frame that mouse moves into during the drag-and-drop operation, whilst simultaneously cancelling it. Any other non-nil value means to do the same, but to wait for the mouse to -leave FRAME first. */) +leave FRAME first. + +If ALLOW-SAME-FRAME is nil, dropping on FRAME will result in the drop +being ignored. */) (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action, - Lisp_Object return_frame) + Lisp_Object return_frame, Lisp_Object allow_same_frame) { struct frame *f, *return_to; NSPasteboard *pasteboard; @@ -715,7 +718,8 @@ nil if no action was performed (either because there was no drop operation = [window beginDrag: operation forPasteboard: pasteboard withMode: mode - returnFrameTo: &return_to]; + returnFrameTo: &return_to + prohibitSame: (BOOL) NILP (allow_same_frame)]; if (return_to) { diff --git a/src/nsterm.h b/src/nsterm.h index c39b66534f..37bff6260a 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -425,6 +425,7 @@ enum ns_return_frame_mode struct frame *dnd_return_frame; enum ns_return_frame_mode dnd_mode; + BOOL dnd_allow_same_frame; } #ifdef NS_IMPL_GNUSTEP @@ -444,7 +445,9 @@ enum ns_return_frame_mode - (NSDragOperation) beginDrag: (NSDragOperation) op forPasteboard: (NSPasteboard *) pasteboard withMode: (enum ns_return_frame_mode) mode - returnFrameTo: (struct frame **) frame_return; + returnFrameTo: (struct frame **) frame_return + prohibitSame: (BOOL) prohibit_same_frame; +- (BOOL) mustNotDropOn: (NSView *) receiver; @end diff --git a/src/nsterm.m b/src/nsterm.m index f4fde9bd12..46ce2cc5e4 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8608,13 +8608,30 @@ - (void)drawRect: (NSRect)rect -(NSDragOperation) draggingEntered: (id ) sender { + id source; + NSTRACE ("[EmacsView draggingEntered:]"); + + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) + return NSDragOperationNone; + return NSDragOperationGeneric; } --(BOOL)prepareForDragOperation: (id ) sender +-(BOOL) prepareForDragOperation: (id ) sender { + id source; + + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) + return NO; + return YES; } @@ -8675,25 +8692,29 @@ - (NSDragOperation) draggingUpdated: (id ) sender return NSDragOperationGeneric; } --(BOOL)performDragOperation: (id ) sender +- (BOOL) performDragOperation: (id ) sender { - id pb; + id pb, source; int x, y; NSString *type; - NSEvent *theEvent = [[self window] currentEvent]; NSPoint position; NSDragOperation op = [sender draggingSourceOperationMask]; Lisp_Object operations = Qnil; Lisp_Object strings = Qnil; Lisp_Object type_sym; + struct input_event ie; NSTRACE ("[EmacsView performDragOperation:]"); - if (!emacs_event) + source = [sender draggingSource]; + + if (source && [source respondsToSelector: @selector(mustNotDropOn:)] + && [source mustNotDropOn: self]) return NO; position = [self convertPoint: [sender draggingLocation] fromView: nil]; - x = lrint (position.x); y = lrint (position.y); + x = lrint (position.x); + y = lrint (position.y); pb = [sender draggingPasteboard]; type = [pb availableTypeFromArray: ns_drag_types]; @@ -8709,10 +8730,8 @@ -(BOOL)performDragOperation: (id ) sender if (op & NSDragOperationGeneric || NILP (operations)) operations = Fcons (Qns_drag_operation_generic, operations); - if (type == 0) - { - return NO; - } + if (!type) + return NO; #if NS_USE_NSPasteboardTypeFileURL != 0 else if ([type isEqualToString: NSPasteboardTypeFileURL]) { @@ -8764,21 +8783,16 @@ -(BOOL)performDragOperation: (id ) sender strings = list1 ([data lispString]); } else - { - fputs ("Invalid data type in dragging pasteboard\n", stderr); - return NO; - } - - emacs_event->kind = DRAG_N_DROP_EVENT; - XSETINT (emacs_event->x, x); - XSETINT (emacs_event->y, y); - emacs_event->modifiers = 0; + return NO; - emacs_event->arg = Fcons (type_sym, - Fcons (operations, - strings)); - EV_TRAILER (theEvent); + EVENT_INIT (ie); + ie.kind = DRAG_N_DROP_EVENT; + ie.arg = Fcons (type_sym, Fcons (operations, strings)); + XSETINT (ie.x, x); + XSETINT (ie.y, y); + XSETFRAME (ie.frame_or_window, emacsframe); + kbd_buffer_store_event (&ie); return YES; } @@ -9611,10 +9625,17 @@ - (void) draggedImage: (NSImage *) dragged_image } #endif +- (BOOL) mustNotDropOn: (NSView *) receiver +{ + return ([receiver window] == self + ? !dnd_allow_same_frame : NO); +} + - (NSDragOperation) beginDrag: (NSDragOperation) op forPasteboard: (NSPasteboard *) pasteboard withMode: (enum ns_return_frame_mode) mode returnFrameTo: (struct frame **) frame_return + prohibitSame: (BOOL) prohibit_same_frame { NSImage *image; #ifdef NS_IMPL_COCOA @@ -9627,6 +9648,7 @@ - (NSDragOperation) beginDrag: (NSDragOperation) op image = [[NSImage alloc] initWithSize: NSMakeSize (1.0, 1.0)]; dnd_mode = mode; dnd_return_frame = NULL; + dnd_allow_same_frame = !prohibit_same_frame; /* Now draw transparency onto the image. */ [image lockFocus]; commit f610b4b509013a6c9ef448385575ade01733559c Author: Po Lu Date: Wed Jun 1 05:05:42 2022 +0000 Fix creation of menu items without help text on Haiku * src/haiku_support.cc (EmacsMenuItem): Don't mistakenly assume help is non-NULL. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 2411a7b539..3b1a2cfcb3 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2403,7 +2403,8 @@ class EmacsMenuItem : public BMenuItem if (key_label) key = strdup (key_label); - this->help = strdup (help); + if (help) + this->help = strdup (help); } ~EmacsMenuItem () commit a3cba47416ebc78e775d01a01955a03aa06df3b0 Author: Lars Ingebrigtsen Date: Wed Jun 1 06:55:18 2022 +0200 Tweak MAIN_FIRST/ja-dic compilation * lisp/Makefile.in (MAIN_FIRST): ja-dic-utl isn't used in the conversion process, to don't compile it early. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d326e1a924..5f9ca01694 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -94,11 +94,11 @@ COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc # Files to compile early in compile-main. Works around bug#25556. -# Also compile the ja-dic files used to convert the Japanese -# dictionary to speed things up. +# Also compile the ja-dic file used to convert the Japanese dictionary +# to speed things up. MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \ ./cedet/semantic/db.el ./emacs-lisp/cconv.el \ - ./international/ja-dic-cnv.el ./international/ja-dic-utl.el + ./international/ja-dic-cnv.el # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH commit 8a2dbf9f86f0c79c0e5c5c528ddcb6a5e3d89c00 Author: Po Lu Date: Wed Jun 1 12:50:16 2022 +0800 Fix pselect usage mistakes * src/xterm.c (x_next_event_from_any_display): (x_wait_for_cell_change): Fix calls to pselect and tests against return value. diff --git a/src/xterm.c b/src/xterm.c index f062e6485d..2421108a41 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10322,7 +10322,7 @@ x_next_event_from_any_display (XEvent *event) /* We don't have to check the return of pselect, because if an error occurs XPending will call the IO error handler, which then brings us out of this loop. */ - pselect (maxfd, &fds, NULL, NULL, NULL, NULL); + pselect (maxfd + 1, &fds, NULL, NULL, NULL, NULL); } } @@ -14945,12 +14945,12 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) timeout = timespec_sub (at, current); #ifndef USE_GTK - rc = pselect (maxfd, &fds, NULL, NULL, &timeout, NULL); + rc = pselect (maxfd + 1, &fds, NULL, NULL, &timeout, NULL); - if (rc > 0) + if (rc >= 0) rfds = fds; #else - pselect (maxfd, &fds, NULL, NULL, &timeout, NULL); + pselect (maxfd + 1, &fds, NULL, NULL, &timeout, NULL); #endif } } commit 3d354b1fba1a9fa96a1d5c1c627e113840db3255 Author: Lars Ingebrigtsen Date: Wed Jun 1 06:33:07 2022 +0200 Don't do OKURI-NASI until the conversion files have been compiled * lisp/Makefile.in (generate-ja-dic): Byte-compile the ja-dic.el file, too. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index c0e2099e6b..d326e1a924 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -157,7 +157,7 @@ $(lisp)/finder-inf.el: -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER} # This is the OKURO-NASI compilation trigger. -generate-ja-dic: +generate-ja-dic: main-first $(AM_V_at)$(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)" $(AM_V_at)$(MAKE) compile-targets TARGETS="./leim/ja-dic/ja-dic.elc" commit bf6852d69bbc9523304de363d78d0e62322be0aa Author: Lars Ingebrigtsen Date: Wed Jun 1 06:22:29 2022 +0200 Compile ja-dic files to speed OKURI-NASI up * lisp/Makefile.in (MAIN_FIRST): Also compile ja-dic utils to speed generation up. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index f8e31eb819..c0e2099e6b 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -94,8 +94,11 @@ COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc # Files to compile early in compile-main. Works around bug#25556. +# Also compile the ja-dic files used to convert the Japanese +# dictionary to speed things up. MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \ - ./cedet/semantic/db.el ./emacs-lisp/cconv.el + ./cedet/semantic/db.el ./emacs-lisp/cconv.el \ + ./international/ja-dic-cnv.el ./international/ja-dic-utl.el # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH commit 7b65bd35888f84e487f8ee0c4222698c59b7470f Author: Stefan Kangas Date: Wed Jun 1 06:01:33 2022 +0200 Update publicsuffix.txt from upstream * etc/publicsuffix.txt: Update from https://publicsuffix.org/list/public_suffix_list.dat dated 2022-05-18 19:45:52 UTC. diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index 220ad30e48..f52169116e 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -7130,7 +7130,7 @@ org.zw // newGTLDs -// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2022-04-30T15:14:46Z +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2022-05-18T15:16:02Z // This list is auto-generated, don't edit it manually. // aaa : 2015-02-26 American Automobile Association, Inc. aaa @@ -8851,7 +8851,7 @@ lincoln // linde : 2014-12-04 Linde Aktiengesellschaft linde -// link : 2013-11-14 UNR Corp. +// link : 2013-11-14 Nova Registry Ltd link // lipsy : 2015-06-25 Lipsy Ltd @@ -12281,6 +12281,10 @@ blogspot.vn // Submitted by Niels Martignene goupile.fr +// Government of the Netherlands: https://www.government.nl +// Submitted by +gov.nl + // Group 53, LLC : https://www.group53.com // Submitted by Tyler Todd awsmppl.com @@ -12357,7 +12361,6 @@ ltd.ng ngo.ng edu.scot sch.so -org.yt // HostyHosting (hostyhosting.com) hostyhosting.io @@ -13389,6 +13392,12 @@ rocky.page спб.рус я.рус +// Salesforce.com, Inc. https://salesforce.com/ +// Submitted by Michael Biven +builder.code.com +dev-builder.code.com +stg-builder.code.com + // Sandstorm Development Group, Inc. : https://sandcats.io/ // Submitted by Asheesh Laroia sandcats.io @@ -13812,6 +13821,15 @@ hk.org ltd.hk inc.hk +// UNIVERSAL DOMAIN REGISTRY : https://www.udr.org.yt/ +// see also: whois -h whois.udr.org.yt help +// Submitted by Atanunu Igbunuroghene +name.pm +sch.tf +biz.wf +sch.wf +org.yt + // United Gameserver GmbH : https://united-gameserver.de // Submitted by Stefan Schwarz virtualuser.de commit b1ef37e81c75b5517ceceef0330a3463514631e0 Author: Lars Ingebrigtsen Date: Wed Jun 1 05:29:33 2022 +0200 Ensure byte compilation of the ja-dic.el file * lisp/Makefile.in (generate-ja-dic): Byte-compile the ja-dic.el file, too. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ada791751f..f8e31eb819 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -153,8 +153,10 @@ $(lisp)/finder-inf.el: --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \ -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER} +# This is the OKURO-NASI compilation trigger. generate-ja-dic: - $(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)" + $(AM_V_at)$(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)" + $(AM_V_at)$(MAKE) compile-targets TARGETS="./leim/ja-dic/ja-dic.elc" ## Comments on loaddefs generation: commit 3e312d11ce3bb402e6162ba9eaceee418a25d4d1 Author: Lars Ingebrigtsen Date: Wed Jun 1 04:49:57 2022 +0200 Reshuffle the generation of the OKURO-NASI entries to speed up build * leim/Makefile.in (all): Remove the ja-dic target from all -- we don't need this file generated before we generate the .elc files. (generate-ja-dic): Add new target. * lisp/Makefile.in (.PHONY, generate-ja-dic): Add new target. (all): Make all depend on the new generate-ja-dic target so that the OKURO-NASI entries are computed while the .elc files are compiled. On a AMD Ryzen 9 5950X 16-Core Processor this brings compilation time on a "make -j32 bootstrap" down from 1m52s to 1m34s. diff --git a/leim/Makefile.in b/leim/Makefile.in index 4e70e8b7e9..3b4216c0b8 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -80,7 +80,7 @@ MISC= \ TIT_MISC = ${TIT_GB} ${TIT_BIG5} ${MISC} -all: ${leimdir}/leim-list.el ${leimdir}/ja-dic/ja-dic.el +all: ${leimdir}/leim-list.el .PHONY: all @@ -129,6 +129,8 @@ ${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC} ${leimdir}/ja-dic/ja-dic.el: | $(leimdir)/ja-dic +.PHONY: generate-ja-dic +generate-ja-dic: ${leimdir}/ja-dic/ja-dic.el ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L $(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \ --eval "(setq max-specpdl-size 5000)" \ diff --git a/lisp/Makefile.in b/lisp/Makefile.in index e3e6c41fec..ada791751f 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -118,10 +118,11 @@ SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS}) # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. -all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el +all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic PHONY_EXTRAS = -.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) +.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \ + generate-ja-dic # custom-deps and finder-data both used to scan _all_ the *.el files. # This could lead to problems in parallel builds if automatically @@ -152,6 +153,9 @@ $(lisp)/finder-inf.el: --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \ -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER} +generate-ja-dic: + $(MAKE) -C ../leim generate-ja-dic EMACS="$(EMACS)" + ## Comments on loaddefs generation: # loaddefs depends on gen-lisp for two reasons: commit 3b9bbb24ebcb23e9686bd0f3d70b6e65a83e80ab Author: Po Lu Date: Wed Jun 1 08:57:52 2022 +0800 Fix the GTK build * src/xterm.c (x_wait_for_cell_change): Don't initialize rfds on GTK. diff --git a/src/xterm.c b/src/xterm.c index 186014b0b4..f062e6485d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14857,9 +14857,9 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) struct timespec current, at; at = timespec_add (current_timespec (), timeout); - FD_ZERO (&rfds); #ifndef USE_GTK + FD_ZERO (&rfds); rc = 0; #endif commit 5ed566cae08d4f39920bea81fd6bf2160f38348f Author: Po Lu Date: Wed Jun 1 08:57:08 2022 +0800 Improve x_wait_for_cell_change * src/xterm.c (x_wait_for_cell_change): Keep processing events while still XPending. diff --git a/src/xterm.c b/src/xterm.c index 7235a1e959..186014b0b4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14849,13 +14849,19 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) fd_set fds; int fd, maxfd; #ifndef USE_GTK - int finish; + int finish, rc; XEvent event; + fd_set rfds; #endif struct input_event hold_quit; struct timespec current, at; at = timespec_add (current_timespec (), timeout); + FD_ZERO (&rfds); + +#ifndef USE_GTK + rc = 0; +#endif while (true) { @@ -14865,26 +14871,35 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { + fd = ConnectionNumber (dpyinfo->display); + #ifndef USE_GTK - if (XPending (dpyinfo->display)) + if ((rc < 0 || FD_ISSET (fd, &rfds)) + /* If pselect failed, the erroring display's IO error + handler will eventually be called. */ + && XPending (dpyinfo->display)) { - EVENT_INIT (hold_quit); + while (XPending (dpyinfo->display)) + { + EVENT_INIT (hold_quit); - XNextEvent (dpyinfo->display, &event); - handle_one_xevent (dpyinfo, &event, - &finish, &hold_quit); + XNextEvent (dpyinfo->display, &event); + handle_one_xevent (dpyinfo, &event, + &finish, &hold_quit); - /* Make us quit now. */ - if (hold_quit.kind != NO_EVENT) - kbd_buffer_store_event (&hold_quit); + if (!NILP (XCAR (cell))) + return; - if (!NILP (XCAR (cell))) - return; + if (finish == X_EVENT_GOTO_OUT) + break; + + /* Make us quit now. */ + if (hold_quit.kind != NO_EVENT) + kbd_buffer_store_event (&hold_quit); + } } #endif - fd = XConnectionNumber (dpyinfo->display); - if (fd > maxfd) maxfd = fd; @@ -14929,10 +14944,14 @@ x_wait_for_cell_change (Lisp_Object cell, struct timespec timeout) timeout = timespec_sub (at, current); - /* We don't have to check the return of pselect, because if an - error occurs XPending will call the IO error handler, which - then brings us out of this loop. */ +#ifndef USE_GTK + rc = pselect (maxfd, &fds, NULL, NULL, &timeout, NULL); + + if (rc > 0) + rfds = fds; +#else pselect (maxfd, &fds, NULL, NULL, &timeout, NULL); +#endif } } commit b1ac48bd7ee10721d7a07276378b632717616290 Author: Lars Ingebrigtsen Date: Tue May 31 22:56:21 2022 +0200 Note changes in ;;;### parsing diff --git a/etc/NEWS b/etc/NEWS index 597f92cfce..87cd41ec01 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1752,6 +1752,11 @@ so using 'M-x update-file-autoloads' no longer works. (This didn't work well in most files in the past, either, but it will now signal an error in any file.) +In addition, files are scanned in a slightly different way. +Previously ;;;### specs inside a top-level form (i.e., something like +(when ... ;;;### ...) would be ignored. They are now parsed as +normal. + +++ ** 'buffer-modified-p' has been extended. This function was previously documented to return only nil or t. This commit 7d1c44c2b3a71a676c00617f796c13b3a8b57c87 Author: Lars Ingebrigtsen Date: Tue May 31 22:49:12 2022 +0200 Fix the loaddefs updating logic * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Fix the logic of updating -- we update per loaddefs file. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 3a3f7c1b2a..02f584d0af 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -508,7 +508,6 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (directory-files (expand-file-name d) t files-re)) (if (consp dir) dir (list dir))))) - (updating (file-exists-p output-file)) (defs nil)) ;; Collect all the autoload data. @@ -519,7 +518,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (file-count 0)) (dolist (file files) (progress-reporter-update progress (setq file-count (1+ file-count))) - (when (or (not updating) + (when (or (not (file-exists-p output-file)) (file-newer-than-file-p file output-file)) (setq defs (nconc (loaddefs-generate--parse-file @@ -535,53 +534,54 @@ If INCLUDE-PACKAGE-VERSION, include package version data." ;; Generate the loaddef files. First group per output file. (dolist (fdefs (seq-group-by #'car defs)) - (with-temp-buffer - (if updating - (insert-file-contents output-file) - (insert (loaddefs-generate--rubric (car fdefs) nil t)) - (search-backward "\f") - (when extra-data - (insert extra-data) - (ensure-empty-lines 1))) - ;; Then group by source file (and sort alphabetically). - (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) - (lambda (e1 e2) - (string< - (file-name-sans-extension - (file-name-nondirectory (car e1))) - (file-name-sans-extension - (file-name-nondirectory (car e2))))))) - (pop section) - (let* ((relfile (file-relative-name - (cadar section) - (file-name-directory (car fdefs)))) - (head (concat "\n\f\n;;; Generated autoloads from " - relfile "\n\n"))) - (when updating - ;; If we're updating an old loaddefs file, then see if - ;; there's a section here for this file already. - (goto-char (point-min)) - (if (not (search-forward head nil t)) - ;; It's a new file; put the data at the end. - (progn - (goto-char (point-max)) - (search-backward "\f\n")) - ;; Delete the old version of the section. - (delete-region (match-beginning 0) - (and (search-forward "\n\f\n;;;") - (match-beginning 0))) - (forward-line -2))) - (insert head) - (dolist (def (reverse section)) - (setq def (caddr def)) - (if (stringp def) - (princ def (current-buffer)) - (loaddefs-generate--print-form def)) - (unless (bolp) - (insert "\n"))))) - (write-region (point-min) (point-max) (car fdefs) nil 'silent) - (byte-compile-info (file-relative-name (car fdefs) lisp-directory) - t "GEN"))))) + (let ((loaddefs-file (car fdefs))) + (with-temp-buffer + (if (file-exists-p loaddefs-file) + (insert-file-contents loaddefs-file) + (insert (loaddefs-generate--rubric loaddefs-file nil t)) + (search-backward "\f") + (when extra-data + (insert extra-data) + (ensure-empty-lines 1))) + ;; Then group by source file (and sort alphabetically). + (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) + (lambda (e1 e2) + (string< + (file-name-sans-extension + (file-name-nondirectory (car e1))) + (file-name-sans-extension + (file-name-nondirectory (car e2))))))) + (pop section) + (let* ((relfile (file-relative-name + (cadar section) + (file-name-directory loaddefs-file))) + (head (concat "\n\f\n;;; Generated autoloads from " + relfile "\n\n"))) + (when (file-exists-p loaddefs-file) + ;; If we're updating an old loaddefs file, then see if + ;; there's a section here for this file already. + (goto-char (point-min)) + (if (not (search-forward head nil t)) + ;; It's a new file; put the data at the end. + (progn + (goto-char (point-max)) + (search-backward "\f\n")) + ;; Delete the old version of the section. + (delete-region (match-beginning 0) + (and (search-forward "\n\f\n;;;") + (match-beginning 0))) + (forward-line -2))) + (insert head) + (dolist (def (reverse section)) + (setq def (caddr def)) + (if (stringp def) + (princ def (current-buffer)) + (loaddefs-generate--print-form def)) + (unless (bolp) + (insert "\n"))))) + (write-region (point-min) (point-max) loaddefs-file nil 'silent) + (byte-compile-info (file-relative-name loaddefs-file lisp-directory) + t "GEN")))))) (defun loaddefs-generate--print-form (def) "Print DEF in the way make-docfile.c expects it." commit 71aaa9ac1e6665e51455d6608bb2ace8a9138829 Author: Lars Ingebrigtsen Date: Tue May 31 21:04:59 2022 +0200 Fix yank-in-context--transform after recent reversion * lisp/simple.el (yank-in-context--transform): Fix call to comment-region-default-1 after recent reverted patch. diff --git a/lisp/simple.el b/lisp/simple.el index 29c4ba07be..24c61b5bee 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6161,7 +6161,7 @@ variable to determine how strings should be escaped." (goto-char (point-min)) (forward-line 1) (point))) - (point-max) nil t) + (point-max)) (buffer-string)))) (t string))) (t string)))) commit f461eb8fa770a6f6b048f13684bd697756f8790c Author: Manuel Giraud Date: Tue May 31 20:35:39 2022 +0200 Add a last-modified field when a bookmark is set * test/lisp/bookmark-tests.el (bookmark-tests-make-record) (bookmark-tests-make-record-list, bookmark-tests-set): fix tests to not consider last-modified in bookmark equality. * lisp/bookmark.el (bookmark-make-record-default): add a last-modified field. (bookmark-sort-flag): add the 'last-modified choice. (bookmark-get-last-modified): new function to get last-modified bookmark field. (bookmark-maybe-sort-alist): sort in last-modified first order. (bookmark-completing-read): use `bookmark-maybe-sort-alist'. diff --git a/etc/NEWS b/etc/NEWS index 0d4532985b..597f92cfce 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1690,6 +1690,11 @@ manual for more details. Types are registered via a 'bookmark-handler-type' symbol property on the jumping function. ++++ +*** 'bookmark-sort-flag' can now be set to 'last-modified'. +This will display bookmark list from most recently set to least +recently set. + --- *** New minor mode 'elide-head-mode'. Enabling this minor mode turns on hiding header material, like diff --git a/lisp/bookmark.el b/lisp/bookmark.el index c604395dd7..8e251e9de8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -115,10 +115,18 @@ just use the value of `version-control'." (defcustom bookmark-sort-flag t - "Non-nil means that bookmarks will be displayed sorted by bookmark name. -Otherwise they will be displayed in LIFO order (that is, most -recently set ones come first, oldest ones come last)." - :type 'boolean) + "This controls the bookmark display sorting. +nil means they will be displayed in LIFO order (that is, most +recently created ones come first, oldest ones come last). + +`last-modified' means that bookmarks will be displayed sorted +from most recently set to last recently set. + +Other values means that bookmarks will be displayed sorted by +bookmark name." + :type '(choice (const :tag "By name" t) + (const :tag "By modified time" last-modified) + (const :tag "By creation time" nil))) (defcustom bookmark-menu-confirm-deletion nil @@ -460,6 +468,10 @@ In other words, return all information but the name." "Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none." (bookmark-prop-get bookmark-name-or-record 'handler)) +(defun bookmark-get-last-modified (bookmark-name-or-record) + "Return the last-modified for BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'last-modified)) + (defvar bookmark-history nil "The history list for bookmark functions.") @@ -497,6 +509,21 @@ See user option `bookmark-set-fringe'." (when (eq 'bookmark (overlay-get temp 'category)) (delete-overlay (setq found temp)))))))))) +(defun bookmark-maybe-sort-alist () + "Return `bookmark-alist' for display. +If `bookmark-sort-flag' is T, then return a sorted by name copy of the alist. +If `bookmark-sort-flag' is LAST-MODIFIED, then return a sorted by last modified +copy of the alist. Otherwise, just return `bookmark-alist', which by default +is ordered from most recently created to least recently created bookmark." + (let ((copy (copy-alist bookmark-alist))) + (cond ((eq bookmark-sort-flag t) + (sort copy (lambda (x y) (string-lessp (car x) (car y))))) + ((eq bookmark-sort-flag 'last-modified) + (sort copy (lambda (x y) + (time-less-p (bookmark-get-last-modified y) + (bookmark-get-last-modified x))))) + (t copy)))) + (defun bookmark-completing-read (prompt &optional default) "Prompting with PROMPT, read a bookmark name in completion. PROMPT will get a \": \" stuck on the end no matter what, so you @@ -506,10 +533,8 @@ If DEFAULT is nil then return empty string for empty input." (bookmark-maybe-load-default-file) ; paranoia (if (listp last-nonmenu-event) (bookmark-menu-popup-paned-menu t prompt - (if bookmark-sort-flag - (sort (bookmark-all-names) - 'string-lessp) - (bookmark-all-names))) + (mapcar 'bookmark-name-from-full-record + (bookmark-maybe-sort-alist))) (let* ((completion-ignore-case bookmark-completion-ignore-case) (default (unless (equal "" default) default))) (completing-read (format-prompt prompt default) @@ -630,7 +655,8 @@ If POSN is non-nil, record POSN as the point instead of `(point)'." (point) (- (point) bookmark-search-size)) nil)))) - (position . ,(or posn (point))))) + (position . ,(or posn (point))) + (last-modified . ,(current-time)))) ;;; File format stuff @@ -1140,15 +1166,6 @@ it to the name of the bookmark currently being set, advancing (car bookmark-bookmarks-timestamp))))))) (bookmark-load (car bookmark-bookmarks-timestamp) t t)))) -(defun bookmark-maybe-sort-alist () - "Return `bookmark-alist' for display. -If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist. -Otherwise, just return `bookmark-alist', which by default is ordered -from most recently created to least recently created bookmark." - (if bookmark-sort-flag - (sort (copy-alist bookmark-alist) - (lambda (x y) (string-lessp (car x) (car y)))) - bookmark-alist)) (defvar bookmark-after-jump-hook nil @@ -1825,27 +1842,28 @@ Don't affect the buffer ring order." entries))) ;; The value of `bookmark-sort-flag' might have changed since the ;; last time the buffer contents were generated, so re-check it. - (if bookmark-sort-flag - (progn - (setq tabulated-list-sort-key '("Bookmark Name" . nil)) - (setq tabulated-list-entries entries)) - (setq tabulated-list-sort-key nil) - ;; And since we're not sorting by bookmark name, show bookmarks - ;; according to order of creation, with the most recently - ;; created bookmarks at the top and the least recently created - ;; at the bottom. - ;; - ;; Note that clicking the column sort toggle for the bookmark - ;; name column will invoke the `tabulated-list-mode' sort, which - ;; uses `bookmark-bmenu--name-predicate' to sort lexically by - ;; bookmark name instead of by (reverse) creation order. - ;; Clicking the toggle again will reverse the lexical sort, but - ;; the sort will still be lexical not creation-order. However, - ;; if the user reverts the buffer, then the above check of - ;; `bookmark-sort-flag' will happen again and the buffer will - ;; go back to a creation-order sort. This is all expected - ;; behavior, as documented in `bookmark-bmenu-mode'. - (setq tabulated-list-entries (reverse entries))) + (cond ((eq bookmark-sort-flag t) + (setq tabulated-list-sort-key '("Bookmark Name" . nil) + tabulated-list-entries entries)) + ((or (null bookmark-sort-flag) + (eq bookmark-sort-flag 'last-modified)) + (setq tabulated-list-sort-key nil) + ;; And since we're not sorting by bookmark name, show bookmarks + ;; according to order of creation, with the most recently + ;; created bookmarks at the top and the least recently created + ;; at the bottom. + ;; + ;; Note that clicking the column sort toggle for the bookmark + ;; name column will invoke the `tabulated-list-mode' sort, which + ;; uses `bookmark-bmenu--name-predicate' to sort lexically by + ;; bookmark name instead of by (reverse) creation order. + ;; Clicking the toggle again will reverse the lexical sort, but + ;; the sort will still be lexical not creation-order. However, + ;; if the user reverts the buffer, then the above check of + ;; `bookmark-sort-flag' will happen again and the buffer will + ;; go back to a creation-order sort. This is all expected + ;; behavior, as documented in `bookmark-bmenu-mode'. + (setq tabulated-list-entries (reverse entries)))) ;; Generate the header only after `tabulated-list-sort-key' is ;; settled, because if that's non-nil then the sort-direction ;; indicator will be shown in the named column, but if it's @@ -1953,7 +1971,8 @@ At any time you may use \\[revert-buffer] to go back to sorting by creation orde ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) - (when bookmark-sort-flag + (when (and bookmark-sort-flag + (not (eq bookmark-sort-flag 'last-modified))) (setq tabulated-list-sort-key '("Bookmark Name" . nil))) (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)' (setq revert-buffer-function 'bookmark-bmenu--revert) diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index ae7331fcc2..a2d8f2d260 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -197,6 +197,9 @@ the lexically-bound variable `buffer'." (bookmark-maybe-historicize-string "foo") (should (equal (car bookmark-history) "foo")))) +(defun bookmark-remove-last-modified (bmk) + (assoc-delete-all 'last-modified bmk)) + (ert-deftest bookmark-tests-make-record () (with-bookmark-test-file (let* ((record `("example.txt" (filename . ,bookmark-tests-example-file) @@ -206,9 +209,11 @@ the lexically-bound variable `buffer'." (defaults "example.txt")))) (with-current-buffer buffer (goto-char 3) - (should (equal (bookmark-make-record) record)) + (should (equal (bookmark-remove-last-modified (bookmark-make-record)) + record)) ;; calling twice gives same record - (should (equal (bookmark-make-record) record)))))) + (should (equal (bookmark-remove-last-modified (bookmark-make-record)) + record)))))) (ert-deftest bookmark-tests-make-record-list () (with-bookmark-test-file-list @@ -219,9 +224,11 @@ the lexically-bound variable `buffer'." (defaults "example.txt")))) (with-current-buffer buffer (goto-char 3) - (should (equal (bookmark-make-record) record)) + (should (equal (bookmark-remove-last-modified (bookmark-make-record)) + record)) ;; calling twice gives same record - (should (equal (bookmark-make-record) record)))))) + (should (equal (bookmark-remove-last-modified (bookmark-make-record)) + record)))))) (ert-deftest bookmark-tests-make-record-function () (with-bookmark-test @@ -255,15 +262,18 @@ the lexically-bound variable `buffer'." ;; Set first bookmark (goto-char (point-min)) (bookmark-set "foo") - (should (equal bookmark-alist (list bmk1))) + (should (equal (mapcar #'bookmark-remove-last-modified bookmark-alist) + (list bmk1))) ;; Replace that bookmark (goto-char (point-max)) (bookmark-set "foo") - (should (equal bookmark-alist (list bmk2))) + (should (equal (mapcar #'bookmark-remove-last-modified bookmark-alist) + (list bmk2))) ;; Push another bookmark with the same name (goto-char (point-min)) (bookmark-set "foo" t) ; NO-OVERWRITE is t - (should (equal bookmark-alist (list bmk1 bmk2))) + (should (equal (mapcar #'bookmark-remove-last-modified bookmark-alist) + (list bmk1 bmk2))) ;; 2. bookmark-set-no-overwrite ;; Don't overwrite @@ -271,11 +281,13 @@ the lexically-bound variable `buffer'." ;; Set new bookmark (setq bookmark-alist nil) (bookmark-set-no-overwrite "foo") - (should (equal bookmark-alist (list bmk1))) + (should (equal (mapcar #'bookmark-remove-last-modified bookmark-alist) + (list bmk1))) ;; Push another bookmark with the same name (goto-char (point-max)) (bookmark-set-no-overwrite "foo" t) ; PUSH-BOOKMARK is t - (should (equal bookmark-alist (list bmk2 bmk1))) + (should (equal (mapcar #'bookmark-remove-last-modified bookmark-alist) + (list bmk2 bmk1))) ;; 3. bookmark-set-internal (should-error (bookmark-set-internal "foo" "bar" t)))))) commit 6a2cc870d23485a8f440a8b58768eefdf16c8912 Author: Lars Ingebrigtsen Date: Tue May 31 20:20:23 2022 +0200 Revert "Allow commenting out white space lines in latex-mode" This reverts commit 0870ebb3cbfcb097d85eea5eacaf992dd88ed204. This was the wrong way to try to fix this -- see bug#55716. diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 95adf9f90a..385dd80beb 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1235,33 +1235,21 @@ changed with `comment-style'." ;; FIXME: maybe we should call uncomment depending on ARG. (funcall comment-region-function beg end arg))) -(defun comment-region-default-1 (beg end &optional arg noadjust) - "Comment region between BEG and END. -See `comment-region' for ARG. If NOADJUST, do not skip past -leading/trailing space when determining the region to comment -out." +(defun comment-region-default-1 (beg end &optional arg) (let* ((numarg (prefix-numeric-value arg)) (style (cdr (assoc comment-style comment-styles))) (lines (nth 2 style)) (block (nth 1 style)) (multi (nth 0 style))) - (if noadjust - (when (bolp) - (setq end (1- end))) - ;; We use `chars' instead of `syntax' because `\n' might be - ;; of end-comment syntax rather than of whitespace syntax. - ;; sanitize BEG and END - (goto-char beg) - (skip-chars-forward " \t\n\r") - (beginning-of-line) - (setq beg (max beg (point))) - (goto-char end) - (skip-chars-backward " \t\n\r") - (end-of-line) - (setq end (min end (point))) - (when (>= beg end) - (error "Nothing to comment"))) + ;; We use `chars' instead of `syntax' because `\n' might be + ;; of end-comment syntax rather than of whitespace syntax. + ;; sanitize BEG and END + (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line) + (setq beg (max beg (point))) + (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line) + (setq end (min end (point))) + (if (>= beg end) (error "Nothing to comment")) ;; sanitize LINES (setq lines diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index da4d7cc442..473643bb48 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1178,12 +1178,7 @@ subshell is initiated, `tex-shell-hook' is run." (setq-local outline-regexp latex-outline-regexp) (setq-local outline-level #'latex-outline-level) (setq-local forward-sexp-function #'latex-forward-sexp) - (setq-local skeleton-end-hook nil) - (setq-local comment-region-function #'latex--comment-region) - (setq-local comment-style 'plain)) - -(defun latex--comment-region (beg end &optional arg) - (comment-region-default-1 beg end arg t)) + (setq-local skeleton-end-hook nil)) ;;;###autoload (define-derived-mode slitex-mode latex-mode "SliTeX" commit 89404b4f69f9677189b55d9914bccf3ba0ef0c18 Author: Lars Ingebrigtsen Date: Tue May 31 20:08:18 2022 +0200 Make partial loaddefs updates work again * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Only update the loaddefs section for the files that have changed. This makes "git pull" (when few/no Lisp files have changed much faster). diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 729a604ff4..3a3f7c1b2a 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -442,7 +442,7 @@ FILE's name." (if lp "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n\n") - " \n" + " \n;;; End of scraped data\n\n" ;; This is used outside of autoload.el, eg cus-dep, finder. (if feature (format "(provide '%s)\n" @@ -508,6 +508,7 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (directory-files (expand-file-name d) t files-re)) (if (consp dir) dir (list dir))))) + (updating (file-exists-p output-file)) (defs nil)) ;; Collect all the autoload data. @@ -518,28 +519,31 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (file-count 0)) (dolist (file files) (progress-reporter-update progress (setq file-count (1+ file-count))) - ;; Do not insert autoload entries for excluded files. - (setq defs (nconc - (loaddefs-generate--parse-file - file output-file - ;; We only want the package name from the - ;; excluded files. - (and include-package-version - (if (member (expand-file-name file) excluded-files) - 'only - t))) - defs))) + (when (or (not updating) + (file-newer-than-file-p file output-file)) + (setq defs (nconc + (loaddefs-generate--parse-file + file output-file + ;; We only want the package name from the + ;; excluded files. + (and include-package-version + (if (member (expand-file-name file) excluded-files) + 'only + t))) + defs)))) (progress-reporter-done progress)) ;; Generate the loaddef files. First group per output file. (dolist (fdefs (seq-group-by #'car defs)) (with-temp-buffer - (insert (loaddefs-generate--rubric (car fdefs) nil t)) - (search-backward "\f") - (when extra-data - (insert extra-data) - (ensure-empty-lines 1)) - ;; The group by source file (and sort alphabetically). + (if updating + (insert-file-contents output-file) + (insert (loaddefs-generate--rubric (car fdefs) nil t)) + (search-backward "\f") + (when extra-data + (insert extra-data) + (ensure-empty-lines 1))) + ;; Then group by source file (and sort alphabetically). (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) (lambda (e1 e2) (string< @@ -548,18 +552,33 @@ If INCLUDE-PACKAGE-VERSION, include package version data." (file-name-sans-extension (file-name-nondirectory (car e2))))))) (pop section) - (let ((relfile (file-relative-name - (cadar section) - (file-name-directory (car fdefs))))) - (insert "\f\n;;; Generated autoloads from " relfile "\n\n") + (let* ((relfile (file-relative-name + (cadar section) + (file-name-directory (car fdefs)))) + (head (concat "\n\f\n;;; Generated autoloads from " + relfile "\n\n"))) + (when updating + ;; If we're updating an old loaddefs file, then see if + ;; there's a section here for this file already. + (goto-char (point-min)) + (if (not (search-forward head nil t)) + ;; It's a new file; put the data at the end. + (progn + (goto-char (point-max)) + (search-backward "\f\n")) + ;; Delete the old version of the section. + (delete-region (match-beginning 0) + (and (search-forward "\n\f\n;;;") + (match-beginning 0))) + (forward-line -2))) + (insert head) (dolist (def (reverse section)) (setq def (caddr def)) (if (stringp def) (princ def (current-buffer)) (loaddefs-generate--print-form def)) (unless (bolp) - (insert "\n"))) - (insert "\n"))) + (insert "\n"))))) (write-region (point-min) (point-max) (car fdefs) nil 'silent) (byte-compile-info (file-relative-name (car fdefs) lisp-directory) t "GEN"))))) commit 03b780e387e54c23ac9322e329aca6e5ab4f18e6 Author: Juri Linkov Date: Tue May 31 20:52:37 2022 +0300 Fix handling of windows/buffers for non-nil completion-auto-select (bug#55712) * lisp/minibuffer.el (completion--in-region-1): When completion-auto-select is `second-tab', call switch-to-completions outside of `with-current-buffer'. For the case of completion-auto-select customized to t, move switch-to-completions from completion-setup-function where it was called inside of with-current-buffer-window. * lisp/simple.el (completion-setup-function): Move switch-to-completions for completion-auto-select=t to completion--in-region-1 where it's handled together with the case of `second-tab'. (next-completion): Add check for the minibuffer to support in-buffer inline completions. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6ae25b8def..cdbde2d340 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1422,9 +1422,10 @@ scroll the window of possible completions." (let ((window minibuffer-scroll-window)) (with-current-buffer (window-buffer window) (cond - ;; Here this is possible only when second-tab, so jump now. - (completion-auto-select - (switch-to-completions)) + ;; Here this is possible only when second-tab, but instead of + ;; scrolling the completion list window, switch to it below, + ;; outside of `with-current-buffer'. + ((eq completion-auto-select 'second-tab)) ;; Reverse tab ((equal (this-command-keys) [backtab]) (if (pos-visible-in-window-p (point-min) window) @@ -1438,15 +1439,22 @@ scroll the window of possible completions." ;; If end is in view, scroll up to the end. (set-window-start window (point-min) nil) ;; Else scroll down one screen. - (with-selected-window window (scroll-up))))) - nil))) + (with-selected-window window (scroll-up)))))) + (when (eq completion-auto-select 'second-tab) + (switch-to-completions)) + nil)) ;; If we're cycling, keep on cycling. ((and completion-cycling completion-all-sorted-completions) (minibuffer-force-complete beg end) t) - (t (pcase (completion--do-completion beg end) - (#b000 nil) - (_ t))))) + (t (prog1 (pcase (completion--do-completion beg end) + (#b000 nil) + (_ t)) + (when (and (eq completion-auto-select t) + (window-live-p minibuffer-scroll-window) + (eq t (frame-visible-p (window-frame minibuffer-scroll-window)))) + ;; When the completion list window was displayed, select it. + (switch-to-completions)))))) (defun completion--cache-all-sorted-completions (beg end comps) (add-hook 'after-change-functions diff --git a/lisp/simple.el b/lisp/simple.el index d6b7045432..29c4ba07be 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9513,14 +9513,14 @@ This affects the commands `next-completion' and When the value is t, pressing TAB will switch to the completion list buffer when Emacs pops up a window showing that buffer. If the value is `second-tab', then the first TAB will pop up the -window shwoing the completions list buffer, and the next TAB will +window showing the completions list buffer, and the next TAB will switch to that window. See `completion-auto-help' for controlling when the window showing the completions is popped up and down." :type '(choice (const :tag "Don't auto-select completions window" nil) (const :tag "Select completions window on first TAB" t) - (const :tag - "Select completions window on second TAB" second-tab)) + (const :tag "Select completions window on second TAB" + second-tab)) :version "29.1" :group 'completion) @@ -9573,7 +9573,8 @@ Also see the `completion-wrap-movement' variable." ;; If at the last completion option, wrap or skip ;; to the minibuffer, if requested. (when completion-wrap-movement - (if (and (eq completion-auto-select t) tabcommand) + (if (and (eq completion-auto-select t) tabcommand + (minibufferp completion-reference-buffer)) (throw 'bound nil) (first-completion)))) (setq n (1- n))) @@ -9596,9 +9597,9 @@ Also see the `completion-wrap-movement' variable." ;; If at the first completion option, wrap or skip ;; to the minibuffer, if requested. (when completion-wrap-movement - (if (and (eq completion-auto-select t) tabcommand) + (if (and (eq completion-auto-select t) tabcommand + (minibufferp completion-reference-buffer)) (progn - ;; (goto-char (next-single-property-change (point) 'mouse-face)) (throw 'bound nil)) (last-completion)))) (setq n (1+ n)))) @@ -9826,9 +9827,7 @@ Called from `temp-buffer-show-hook'." (insert "Click on a completion to select it.\n")) (insert (substitute-command-keys "In this buffer, type \\[choose-completion] to \ -select the completion near point.\n\n"))))) - (when (eq completion-auto-select t) - (switch-to-completions))) +select the completion near point.\n\n")))))) (add-hook 'completion-setup-hook #'completion-setup-function) commit 576d75091560119205657d8d5c27c5b862776aca Author: Eli Zaretskii Date: Tue May 31 20:28:50 2022 +0300 Remove unused w32-* variables * src/w32fns.c (syms_of_w32fns) : Remove unused variables. diff --git a/src/w32fns.c b/src/w32fns.c index e5becb5d64..a03fa3a665 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10790,21 +10790,6 @@ bass-down, bass-boost, bass-up, treble-down, treble-up */); doc: /* SKIP: real doc in xfns.c. */); Vx_pixel_size_width_font_regexp = Qnil; - DEFVAR_LISP ("w32-bdf-filename-alist", - Vw32_bdf_filename_alist, - doc: /* List of bdf fonts and their corresponding filenames. */); - Vw32_bdf_filename_alist = Qnil; - - DEFVAR_BOOL ("w32-strict-fontnames", - w32_strict_fontnames, - doc: /* Non-nil means only use fonts that are exact matches for those requested. -Default is nil, which allows old fontnames that are not XLFD compliant, -and allows third-party CJK display to work by specifying false charset -fields to trick Emacs into translating to Big5, SJIS etc. -Setting this to t will prevent wrong fonts being selected when -fontsets are automatically created. */); - w32_strict_fontnames = 0; - DEFVAR_BOOL ("w32-strict-painting", w32_strict_painting, doc: /* Non-nil means use strict rules for repainting frames. commit 8ebfcff3a6196f2003b7d84aa9e7a887cc1908d2 Author: Eli Zaretskii Date: Tue May 31 19:19:23 2022 +0300 ; * etc/NEWS: Fix a typo. diff --git a/etc/NEWS b/etc/NEWS index ea68728259..0d4532985b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1738,7 +1738,7 @@ Emacs buffers, like indentation and the like. The new ert function +++ ** loaddefs.el generation has been reimplemented. -The various loaddefs.el files in the Emacs tree (which contains +The various loaddefs.el files in the Emacs tree (which contain information about autoloads, built-in packages and package prefixes) used to be generated by functions in autoloads.el. These are now generated by loaddefs-gen.el instead. This leads to functionally commit 1d4e90341782030cc7d8c29c639450b079587908 Author: Lars Ingebrigtsen Date: Tue May 31 18:08:33 2022 +0200 Speed up generation of loaddefs files * doc/lispref/loading.texi (Autoload, Autoload by Prefix): Refer to loaddefs-generate instead of update-file-autoloads. * lisp/Makefile.in (LOADDEFS): Remove, because all the loaddefs files are created in one go now. (COMPILE_FIRST): Add loaddefs-gen/radix-tree, and drop autoload. ($(lisp)/loaddefs.el): Use loaddefs-gen. (MH_E_DIR, $(TRAMP_DIR)/tramp-loaddefs.el) ($(MH_E_DIR)/mh-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el) ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el): Remove. * lisp/generic-x.el: Inhibit computing prefixes, because the namespace here is all wonky. * lisp/w32-fns.el (w32-batch-update-autoloads): Removed -- unused function. * lisp/calendar/holidays.el ("holiday-loaddefs"): Renamed from hol-loaddefs to have a more regular name. * lisp/cedet/ede/proj-elisp.el (ede-emacs-cedet-autogen-compiler): Refer to loaddefs-gen instead of autoload. * lisp/emacs-lisp/autoload.el (make-autoload, autoload-rubric) (autoload-insert-section-header): Made into aliases of loaddefs-gen functions. (autoload--make-defs-autoload): Ditto. (autoload-ignored-definitions, autoload-compute-prefixes): Moved to loaddefs-gen. * lisp/emacs-lisp/lisp-mode.el (lisp-mode-autoload-regexp): New constant. (lisp-fdefs, lisp-mode-variables, lisp-outline-level): Use it to recognize all ;;;###autoload forms. * lisp/emacs-lisp/loaddefs-gen.el: New file. * lisp/emacs-lisp/package.el: Use loaddefs-generate instead of make-directory-autoloads. * test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-faulty-bzr-autoloads): Use loaddefs instead of autoloads. diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 68cd74c7d1..8a2bb5fa2d 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -529,7 +529,7 @@ primitive for autoloading; any Lisp program can call @code{autoload} at any time. Magic comments are the most convenient way to make a function autoload, for packages installed along with Emacs. These comments do nothing on their own, but they serve as a guide for the command -@code{update-file-autoloads}, which constructs calls to @code{autoload} +@code{loaddefs-generate}, which constructs calls to @code{autoload} and arranges to execute them when Emacs is built. @defun autoload function filename &optional docstring interactive type @@ -627,22 +627,19 @@ subroutines not loaded successfully because they come later in the file. macro, then an error is signaled with data @code{"Autoloading failed to define function @var{function-name}"}. -@findex update-file-autoloads -@findex make-directory-autoloads +@findex loaddefs-generate @cindex magic autoload comment @cindex autoload cookie @anchor{autoload cookie} A magic autoload comment (often called an @dfn{autoload cookie}) consists of @samp{;;;###autoload}, on a line by itself, just before the real definition of the function in its -autoloadable source file. The command @kbd{M-x update-file-autoloads} +autoloadable source file. The function @code{loaddefs-generate} writes a corresponding @code{autoload} call into @file{loaddefs.el}. (The string that serves as the autoload cookie and the name of the -file generated by @code{update-file-autoloads} can be changed from the +file generated by @code{loaddefs-generate} can be changed from the above defaults, see below.) Building Emacs loads @file{loaddefs.el} and thus calls @code{autoload}. -@kbd{M-x make-directory-autoloads} is even more powerful; it updates -autoloads for all files in the current directory. The same magic comment can copy any kind of form into @file{loaddefs.el}. The form following the magic comment is copied @@ -675,7 +672,7 @@ and @code{define-global-minor-mode}. @emph{without} executing it when the file itself is loaded. To do this, write the form @emph{on the same line} as the magic comment. Since it is in a comment, it does nothing when you load the source file; but -@kbd{M-x update-file-autoloads} copies it to @file{loaddefs.el}, where +@code{loaddefs-generate} copies it to @file{loaddefs.el}, where it is executed while building Emacs. The following example shows how @code{doctor} is prepared for @@ -728,11 +725,11 @@ corresponding autoload calls written into a file whose name is different from the default @file{loaddefs.el}. Emacs provides two variables to control this: -@defvar generate-autoload-cookie -The value of this variable should be a string whose syntax is a Lisp -comment. @kbd{M-x update-file-autoloads} copies the Lisp form that -follows the cookie into the autoload file it generates. The default -value of this variable is @code{";;;###autoload"}. +@defvar lisp-mode-autoload-regexp +The value of this constant is a regexp that matches autoload cookies. +@code{loaddefs-generate} copies the Lisp form that follows the +cookie into the autoload file it generates. This will match comments +like like @samp{;;;###autoload} and @samp{;;;###calc-autoload}. @end defvar @defvar generated-autoload-file @@ -769,7 +766,7 @@ contain definitions matching the prefix being completed. The variable @code{definition-prefixes} holds a hashtable which maps a prefix to the corresponding list of files to load for it. Entries to this mapping are added by calls to @code{register-definition-prefixes} -which are generated by @code{update-file-autoloads} +which are generated by @code{loaddefs-generate} (@pxref{Autoload}). Files which don't contain any definitions worth loading (test files, for examples), should set @code{autoload-compute-prefixes} to @code{nil} as a file-local diff --git a/etc/NEWS b/etc/NEWS index 166e991c49..ea68728259 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1736,6 +1736,17 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 ++++ +** loaddefs.el generation has been reimplemented. +The various loaddefs.el files in the Emacs tree (which contains +information about autoloads, built-in packages and package prefixes) +used to be generated by functions in autoloads.el. These are now +generated by loaddefs-gen.el instead. This leads to functionally +equivalent loaddef files, but they do not use exactly the same syntax, +so using 'M-x update-file-autoloads' no longer works. (This didn't +work well in most files in the past, either, but it will now signal an +error in any file.) + +++ ** 'buffer-modified-p' has been extended. This function was previously documented to return only nil or t. This diff --git a/lisp/Makefile.in b/lisp/Makefile.in index fabf6ed55e..e3e6c41fec 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -59,15 +59,6 @@ BYTE_COMPILE_EXTRA_FLAGS = # BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))' # The example above is just for developers, it should not be used by default. -# Those automatically generated autoload files that need special rules -# to build; i.e. not including things created via generated-autoload-file -# (eg calc/calc-loaddefs.el). -LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ - $(lisp)/calendar/diary-loaddefs.el \ - $(lisp)/calendar/hol-loaddefs.el \ - $(lisp)/mh-e/mh-loaddefs.el \ - $(lisp)/net/tramp-loaddefs.el - # All generated autoload files. loaddefs = $(shell find ${srcdir} -name '*loaddefs.el' ! -name '.*') # Elisp files auto-generated. @@ -84,10 +75,11 @@ compile-first: BYTE_COMPILE_FLAGS = \ # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use -# the slowest-compiler on the smallest file and move to larger files as the -# compiler gets faster. 'autoload.elc' comes last because it is not used by -# the compiler (so its compilation does not speed up subsequent compilations), -# it's only placed here so as to speed up generation of the loaddefs.el file. +# the slowest-compiler on the smallest file and move to larger files +# as the compiler gets faster. 'loaddefs-gen.elc'/'radix-tree.el' +# comes last because they're not used by the compiler (so its +# compilation does not speed up subsequent compilations), it's only +# placed here so as to speed up generation of the loaddefs.el files. COMPILE_FIRST = \ $(lisp)/emacs-lisp/macroexp.elc \ @@ -98,7 +90,8 @@ ifeq ($(HAVE_NATIVE_COMP),yes) COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc endif -COMPILE_FIRST += $(lisp)/emacs-lisp/autoload.elc +COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc +COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc # Files to compile early in compile-main. Works around bug#25556. MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \ @@ -186,19 +179,13 @@ $(lisp)/finder-inf.el: # We make $(lisp)/loaddefs.el a dependency of .PHONY to cause Make to # ignore its time stamp. That's because the real dependencies of # loaddefs.el aren't known to Make, they are implemented in -# batch-update-autoloads, which only updates the autoloads whose -# sources have changed. - -# Use expand-file-name rather than $abs_scrdir so that Emacs does not -# get confused when it compares file-names for equality. +# loaddefs-generate-batch. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) - $(AM_V_GEN)$(emacs) -l autoload \ - --eval '(setq autoload-ensure-writable t)' \ - --eval '(setq autoload-builtin-package-versions t)' \ - --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ - -f batch-update-autoloads ${SUBDIRS_ALMOST} + $(AM_V_GEN)$(emacs) \ + -l $(lisp)/emacs-lisp/loaddefs-gen.elc \ + -f loaddefs-generate-batch $(lisp)/loaddefs.el ${SUBDIRS_ALMOST} # autoloads only runs when loaddefs.el is nonexistent, although it # generates a number of different files. Provide a force option to enable @@ -456,57 +443,6 @@ compile-one-process: $(LOADDEFS) compile-first $(emacs) $(BYTE_COMPILE_FLAGS) \ --eval "(batch-byte-recompile-directory 0)" $(lisp) -# Update MH-E internal autoloads. These are not to be confused with -# the autoloads for the MH-E entry points, which are already in loaddefs.el. -MH_E_DIR = $(lisp)/mh-e -MH_E_SRC = $(sort $(wildcard ${MH_E_DIR}/mh*.el)) -MH_E_SRC := $(filter-out ${MH_E_DIR}/mh-loaddefs.el,${MH_E_SRC}) - -.PHONY: mh-autoloads -mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el -$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) - $(AM_V_GEN)$(emacs) -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ - --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - -f batch-update-autoloads $(MH_E_DIR) - -# Update TRAMP internal autoloads. Maybe we could move tramp*.el into -# an own subdirectory. OTOH, it does not hurt to keep them in -# lisp/net. -TRAMP_DIR = $(lisp)/net -TRAMP_SRC = $(sort $(wildcard ${TRAMP_DIR}/tramp*.el)) -TRAMP_SRC := $(filter-out ${TRAMP_DIR}/tramp-loaddefs.el,${TRAMP_SRC}) - -$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) - $(AM_V_GEN)$(emacs) -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ - --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - -f batch-update-autoloads $(TRAMP_DIR) - -CAL_DIR = $(lisp)/calendar -## Those files that may contain internal calendar autoload cookies. -CAL_SRC = $(addprefix ${CAL_DIR}/,diary-lib.el holidays.el lunar.el solar.el) -CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal-*.el)) -CAL_SRC := $(filter-out ${CAL_DIR}/cal-loaddefs.el,${CAL_SRC}) - -$(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC) - $(AM_V_GEN)$(emacs) -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \ - --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - -f batch-update-autoloads $(CAL_DIR) - -$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/cal-loaddefs.el - $(AM_V_GEN)$(emacs) -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \ - --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - -f batch-update-autoloads $(CAL_DIR) - -$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el - $(AM_V_GEN)$(emacs) -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \ - --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - -f batch-update-autoloads $(CAL_DIR) - .PHONY: bootstrap-clean distclean maintainer-clean bootstrap-clean: diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 7e11044dbc..5aa0d26d19 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -30,7 +30,7 @@ ;;; Code: (require 'calendar) -(load "hol-loaddefs" nil t) +(load "holiday-loaddefs" nil t) (defgroup holidays nil "Holidays support in calendar." diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 0c65af15c4..7c56ca1993 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -319,8 +319,7 @@ Lays claim to all .elc files that match .el files in this target." ("require" . "$(foreach r,$(1),(require (quote $(r))))")) :commands '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ ---eval '(setq generated-autoload-file \"$(abspath $(LOADDEFS))\")' \ --f batch-update-autoloads $(abspath $(LOADDIRS))") +-f loaddefs-generate-batch $(abspath $(LOADDEFS)) $(abspath $(LOADDIRS))") :rules (list (ede-makefile-rule :target "clean-autoloads" :phony t :rules '("rm -f $(LOADDEFS)"))) :sourcetype '(ede-source-emacs) ) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1e4b2c14a0..d324a7fc70 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -28,11 +28,15 @@ ;; Lisp source files in various useful ways. To learn more, read the ;; source; if you're going to use this, you'd better be able to. +;; The functions in this file have been largely superseded by +;; loaddefs-gen.el. + ;;; Code: (require 'lisp-mode) ;for `doc-string-elt' properties. (require 'lisp-mnt) (require 'cl-lib) +(require 'loaddefs-gen) (defvar generated-autoload-file nil "File into which to write autoload definitions. @@ -112,165 +116,7 @@ then we use the timestamp of the output file instead. As a result: (defvar autoload-modified-buffers) ;Dynamically scoped var. -(defun make-autoload (form file &optional expansion) - "Turn FORM into an autoload or defvar for source file FILE. -Returns nil if FORM is not a special autoload form (i.e. a function definition -or macro definition or a defcustom). -If EXPANSION is non-nil, we're processing the macro expansion of an -expression, in which case we want to handle forms differently." - (let ((car (car-safe form)) expand) - (cond - ((and expansion (eq car 'defalias)) - (pcase-let* - ((`(,_ ,_ ,arg . ,rest) form) - ;; `type' is non-nil if it defines a macro. - ;; `fun' is the function part of `arg' (defaults to `arg'). - ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t)) - (and (let fun arg) (let type nil))) - arg) - ;; `lam' is the lambda expression in `fun' (or nil if not - ;; recognized). - (lam (if (memq (car-safe fun) '(quote function)) (cadr fun))) - ;; `args' is the list of arguments (or t if not recognized). - ;; `body' is the body of `lam' (or t if not recognized). - ((or `(lambda ,args . ,body) - (and (let args t) (let body t))) - lam) - ;; Get the `doc' from `body' or `rest'. - (doc (cond ((stringp (car-safe body)) (car body)) - ((stringp (car-safe rest)) (car rest)))) - ;; Look for an interactive spec. - (interactive (pcase body - ((or `((interactive . ,iargs) . ,_) - `(,_ (interactive . ,iargs) . ,_)) - ;; List of modes or just t. - (if (nthcdr 1 iargs) - (list 'quote (nthcdr 1 iargs)) - t))))) - ;; Add the usage form at the end where describe-function-1 - ;; can recover it. - (when (consp args) (setq doc (help-add-fundoc-usage doc args))) - ;; (message "autoload of %S" (nth 1 form)) - `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))) - - ((and expansion (memq car '(progn prog1))) - (let ((end (memq :autoload-end form))) - (when end ;Cut-off anything after the :autoload-end marker. - (setq form (copy-sequence form)) - (setcdr (memq :autoload-end form) nil)) - (let ((exps (delq nil (mapcar (lambda (form) - (make-autoload form file expansion)) - (cdr form))))) - (when exps (cons 'progn exps))))) - - ;; For complex cases, try again on the macro-expansion. - ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode - define-globalized-minor-mode defun defmacro - easy-mmode-define-minor-mode define-minor-mode - define-inline cl-defun cl-defmacro cl-defgeneric - cl-defstruct pcase-defmacro)) - (macrop car) - (setq expand (let ((load-true-file-name file) - (load-file-name file)) - (macroexpand form))) - (memq (car expand) '(progn prog1 defalias))) - (make-autoload expand file 'expansion)) ;Recurse on the expansion. - - ;; For special function-like operators, use the `autoload' function. - ((memq car '(define-skeleton define-derived-mode - define-compilation-mode define-generic-mode - easy-mmode-define-global-mode define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode define-minor-mode - cl-defun defun* cl-defmacro defmacro* - define-overloadable-function)) - (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) - (name (nth 1 form)) - (args (pcase car - ((or 'defun 'defmacro - 'defun* 'defmacro* 'cl-defun 'cl-defmacro - 'define-overloadable-function) - (nth 2 form)) - ('define-skeleton '(&optional str arg)) - ((or 'define-generic-mode 'define-derived-mode - 'define-compilation-mode) - nil) - (_ t))) - (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) - (doc (if (stringp (car body)) (pop body)))) - ;; Add the usage form at the end where describe-function-1 - ;; can recover it. - (when (listp args) (setq doc (help-add-fundoc-usage doc args))) - ;; `define-generic-mode' quotes the name, so take care of that - `(autoload ,(if (listp name) name (list 'quote name)) - ,file ,doc - ,(or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) - t) - (and (eq (car-safe (car body)) 'interactive) - ;; List of modes or just t. - (or (if (nthcdr 1 (car body)) - (list 'quote (nthcdr 1 (car body))) - t)))) - ,(if macrop ''macro nil)))) - - ;; For defclass forms, use `eieio-defclass-autoload'. - ((eq car 'defclass) - (let ((name (nth 1 form)) - (superclasses (nth 2 form)) - (doc (nth 4 form))) - (list 'eieio-defclass-autoload (list 'quote name) - (list 'quote superclasses) file doc))) - - ;; Convert defcustom to less space-consuming data. - ((eq car 'defcustom) - (let* ((varname (car-safe (cdr-safe form))) - (props (nthcdr 4 form)) - (initializer (plist-get props :initialize)) - (init (car-safe (cdr-safe (cdr-safe form)))) - (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) - ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) - ) - `(progn - ,(if (not (member initializer '(nil 'custom-initialize-default - #'custom-initialize-default - 'custom-initialize-reset - #'custom-initialize-reset))) - form - `(defvar ,varname ,init ,doc)) - ;; When we include the complete `form', this `custom-autoload' - ;; is not indispensable, but it still helps in case the `defcustom' - ;; doesn't specify its group explicitly, and probably in a few other - ;; corner cases. - (custom-autoload ',varname ,file - ,(condition-case nil - (null (plist-get props :set)) - (error nil))) - ;; Propagate the :safe property to the loaddefs file. - ,@(when-let ((safe (plist-get props :safe))) - `((put ',varname 'safe-local-variable ,safe)))))) - - ((eq car 'defgroup) - ;; In Emacs this is normally handled separately by cus-dep.el, but for - ;; third party packages, it can be convenient to explicitly autoload - ;; a group. - (let ((groupname (nth 1 form))) - `(let ((loads (get ',groupname 'custom-loads))) - (if (member ',file loads) nil - (put ',groupname 'custom-loads (cons ',file loads)))))) - - ;; When processing a macro expansion, any expression - ;; before a :autoload-end should be included. These are typically (put - ;; 'fun 'prop val) and things like that. - ((and expansion (consp form)) form) - - ;; nil here indicates that this is not a special autoload form. - (t nil)))) +(defalias 'make-autoload #'loaddefs-generate--make-autoload) ;; Forms which have doc-strings which should be printed specially. ;; A doc-string-elt property of ELT says that (nth ELT FORM) is @@ -379,41 +225,7 @@ put the output in." (print-escape-nonascii t)) (print form outbuf))))))) -(defun autoload-rubric (file &optional type feature) - "Return a string giving the appropriate autoload rubric for FILE. -TYPE (default \"autoloads\") is a string stating the type of -information contained in FILE. TYPE \"package\" acts like the default, -but adds an extra line to the output to modify `load-path'. - -If FEATURE is non-nil, FILE will provide a feature. FEATURE may -be a string naming the feature, otherwise it will be based on -FILE's name." - (let ((basename (file-name-nondirectory file)) - (lp (if (equal type "package") (setq type "autoloads")))) - (concat ";;; " basename - " --- automatically extracted " (or type "autoloads") - " -*- lexical-binding: t -*-\n" - (when (string-match "/lisp/loaddefs\\.el\\'" file) - ";; This file will be copied to ldefs-boot.el and checked in periodically.\n") - ";;\n" - ";;; Code:\n\n" - (if lp - "(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path))))\n\n") - " \n" - ;; This is used outside of autoload.el, eg cus-dep, finder. - (if feature - (format "(provide '%s)\n" - (if (stringp feature) feature - (file-name-sans-extension basename)))) - ";; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil. - ";; no-update-autoloads: t\n" - ";; coding: utf-8-emacs-unix\n" - ";; End:\n" - ";;; " basename - " ends here\n"))) +(defalias 'autoload-rubric #'loaddefs-generate--rubric) (defvar autoload-ensure-writable nil "Non-nil means `autoload-find-generated-file' makes existing file writable.") @@ -480,35 +292,13 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." (hack-local-variables)) (current-buffer))) +(defalias 'autoload-insert-section-header + #'loaddefs-generate--insert-section-header) + (defvar no-update-autoloads nil "File local variable to prevent scanning this file for autoload cookies.") -(defun autoload-file-load-name (file outfile) - "Compute the name that will be used to load FILE. -OUTFILE should be the name of the global loaddefs.el file, which -is expected to be at the root directory of the files we are -scanning for autoloads and will be in the `load-path'." - (let* ((name (file-relative-name file (file-name-directory outfile))) - (names '()) - (dir (file-name-directory outfile))) - ;; If `name' has directory components, only keep the - ;; last few that are really needed. - (while name - (setq name (directory-file-name name)) - (push (file-name-nondirectory name) names) - (setq name (file-name-directory name))) - (while (not name) - (cond - ((null (cdr names)) (setq name (car names))) - ((file-exists-p (expand-file-name "subdirs.el" dir)) - ;; FIXME: here we only check the existence of subdirs.el, - ;; without checking its content. This makes it generate wrong load - ;; names for cases like lisp/term which is not added to load-path. - (setq dir (expand-file-name (pop names) dir))) - (t (setq name (mapconcat #'identity names "/"))))) - (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) - (substring name 0 (match-beginning 0)) - name))) +(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name) (defun generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. @@ -522,13 +312,6 @@ Return non-nil in the case where no autoloads were added at point." (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) autoload-modified-buffers)) -(defvar autoload-compute-prefixes t - "If non-nil, autoload will add code to register the prefixes used in a file. -Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines -variables or functions that use \"foo-\" as prefix, that will not be registered. -But all other prefixes will be included.") -(put 'autoload-compute-prefixes 'safe #'booleanp) - (defconst autoload-def-prefixes-max-entries 5 "Target length of the list of definition prefixes per file. If set too small, the prefixes will be too generic (i.e. they'll use little @@ -540,102 +323,7 @@ cost more memory use).") "Target size of definition prefixes. Don't try to split prefixes that are already longer than that.") -(require 'radix-tree) - -(defun autoload--make-defs-autoload (defs file) - - ;; Remove the defs that obey the rule that file foo.el (or - ;; foo-mode.el) uses "foo-" as prefix. - ;; FIXME: help--symbol-completion-table still doesn't know how to use - ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix. - ;;(let ((prefix - ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-"))) - ;; (dolist (def (prog1 defs (setq defs nil))) - ;; (unless (string-prefix-p prefix def) - ;; (push def defs)))) - - ;; Then compute a small set of prefixes that cover all the - ;; remaining definitions. - (let* ((tree (let ((tree radix-tree-empty)) - (dolist (def defs) - (setq tree (radix-tree-insert tree def t))) - tree)) - (prefixes nil)) - ;; Get the root prefixes, that we should include in any case. - (radix-tree-iter-subtrees - tree (lambda (prefix subtree) - (push (cons prefix subtree) prefixes))) - ;; In some cases, the root prefixes are too short, e.g. if you define - ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. - (dolist (pair (prog1 prefixes (setq prefixes nil))) - (let ((s (car pair))) - (if (or (and (> (length s) 2) ; Long enough! - ;; But don't use "def" from deffoo-pkg-thing. - (not (string= "def" s))) - (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? - (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! - (push pair prefixes) ;Keep it as is. - (radix-tree-iter-subtrees - (cdr pair) (lambda (prefix subtree) - (push (cons (concat s prefix) subtree) prefixes)))))) - ;; FIXME: The expansions done below are mostly pointless, such as - ;; for `yenc', where we replace "yenc-" with an exhaustive list (5 - ;; elements). - ;; (while - ;; (let ((newprefixes nil) - ;; (changes nil)) - ;; (dolist (pair prefixes) - ;; (let ((prefix (car pair))) - ;; (if (or (> (length prefix) autoload-def-prefixes-max-length) - ;; (radix-tree-lookup (cdr pair) "")) - ;; ;; No point splitting it any further. - ;; (push pair newprefixes) - ;; (setq changes t) - ;; (radix-tree-iter-subtrees - ;; (cdr pair) (lambda (sprefix subtree) - ;; (push (cons (concat prefix sprefix) subtree) - ;; newprefixes)))))) - ;; (and changes - ;; (<= (length newprefixes) - ;; autoload-def-prefixes-max-entries) - ;; (let ((new nil) - ;; (old nil)) - ;; (dolist (pair prefixes) - ;; (unless (memq pair newprefixes) ;Not old - ;; (push pair old))) - ;; (dolist (pair newprefixes) - ;; (unless (memq pair prefixes) ;Not new - ;; (push pair new))) - ;; (cl-assert new) - ;; (message "Expanding %S to %S" - ;; (mapcar #'car old) (mapcar #'car new)) - ;; t) - ;; (setq prefixes newprefixes) - ;; (< (length prefixes) autoload-def-prefixes-max-entries)))) - - ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) - (when prefixes - (let ((strings - (mapcar - (lambda (x) - (let ((prefix (car x))) - (if (or (> (length prefix) 2) ;Long enough! - (and (eq (length prefix) 2) - (string-match "[[:punct:]]" prefix))) - prefix - ;; Some packages really don't follow the rules. - ;; Drop the most egregious cases such as the - ;; one-letter prefixes. - (let ((dropped ())) - (radix-tree-iter-mappings - (cdr x) (lambda (s _) - (push (concat prefix s) dropped))) - (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S" - file prefix dropped) - nil)))) - prefixes))) - `(register-definition-prefixes ,file ',(sort (delq nil strings) - 'string<)))))) +(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes) (defun autoload--setup-output (otherbuf outbuf absfile load-name output-file) (let ((outbuf @@ -687,21 +375,6 @@ Don't try to split prefixes that are already longer than that.") (defvar autoload-builtin-package-versions nil) -(defvar autoload-ignored-definitions - '("define-obsolete-function-alias" - "define-obsolete-variable-alias" - "define-category" "define-key" - "defgroup" "defface" "defadvice" - "def-edebug-spec" - ;; Hmm... this is getting ugly: - "define-widget" - "define-erc-module" - "define-erc-response-handler" - "defun-rcirc-command") - "List of strings naming definitions to ignore for prefixes. -More specifically those definitions will not be considered for the -`register-definition-prefixes' call.") - (defun autoload-generate-file-autoloads (file &optional outbuf outfile) "Insert an autoload section for FILE in the appropriate buffer. Autoloads are generated for defuns and defmacros in FILE diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 5b93f145e8..0492f25dc9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -165,6 +165,12 @@ "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") +(defconst lisp-mode-autoload-regexp + "^;;;###\\(\\([-[:alnum:]]+?\\)-\\)?\\(autoload\\)" + "Regexp to match autoload cookies. +The second group matches package names used to redirect autoloads +to a package-local -loaddefs.el file.") + ;; This was originally in autoload.el and is still used there. (put 'autoload 'doc-string-elt 3) (put 'defmethod 'doc-string-elt 3) @@ -430,7 +436,8 @@ This will generate compile-time constants from BINDINGS." nil t)) ;; Emacs Lisp autoload cookies. Supports the slightly different ;; forms used by mh-e, calendar, etc. - ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)) + (,lisp-mode-autoload-regexp (3 font-lock-warning-face prepend) + (2 font-lock-function-name-face prepend))) "Subdued level highlighting for Emacs Lisp mode.") (defconst lisp-cl-font-lock-keywords-1 @@ -660,7 +667,9 @@ font-lock keywords will not be case sensitive." (setq-local indent-line-function 'lisp-indent-line) (setq-local indent-region-function 'lisp-indent-region) (setq-local comment-indent-function #'lisp-comment-indent) - (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") + (setq-local outline-regexp (concat ";;;;* [^ \t\n]\\|(\\|\\(" + lisp-mode-autoload-regexp + "\\)")) (setq-local outline-level 'lisp-outline-level) (setq-local add-log-current-defun-function #'lisp-current-defun-name) (setq-local comment-start ";") @@ -700,7 +709,8 @@ font-lock keywords will not be case sensitive." ;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(" ;; and point is at the beginning of a matching line. (let ((len (- (match-end 0) (match-beginning 0)))) - (cond ((looking-at "(\\|;;;###autoload") + (cond ((or (looking-at-p "(") + (looking-at-p lisp-mode-autoload-regexp)) 1000) ((looking-at ";;\\(;+\\) ") (- (match-end 1) (match-beginning 1))) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el new file mode 100644 index 0000000000..729a604ff4 --- /dev/null +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -0,0 +1,633 @@ +;;; loaddefs-gen.el --- generate loaddefs.el files -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Keywords: maint +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package generates the main lisp/loaddefs.el file, as well as +;; all the other loaddefs files, like calendar/diary-loaddefs.el, etc. + +;; The main entry point is `loaddefs-generate' (normally called +;; from loaddefs-generate-batch via lisp/Makefile). +;; +;; The "other" loaddefs files are specified either via a file-local +;; setting of `generated-autoload-file', or by specifying +;; +;; ;;;###foo-autoload +;; +;; This makes the autoload go to foo-loaddefs.el in the current directory. +;; Normal ;;;###autoload specs go to the main loaddefs file. + +;;; Code: + +(require 'radix-tree) +(require 'lisp-mnt) + +(defvar autoload-compute-prefixes t + "If non-nil, autoload will add code to register the prefixes used in a file. +Standard prefixes won't be registered anyway. I.e. if a file +\"foo.el\" defines variables or functions that use \"foo-\" as +prefix, that will not be registered. But all other prefixes will +be included.") +(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp) + +(defvar autoload-ignored-definitions + '("define-obsolete-function-alias" + "define-obsolete-variable-alias" + "define-category" "define-key" + "defgroup" "defface" "defadvice" + "def-edebug-spec" + ;; Hmm... this is getting ugly: + "define-widget" + "define-erc-module" + "define-erc-response-handler" + "defun-rcirc-command") + "List of strings naming definitions to ignore for prefixes. +More specifically those definitions will not be considered for the +`register-definition-prefixes' call.") + +(defun loaddefs-generate--file-load-name (file outfile) + "Compute the name that will be used to load FILE. +OUTFILE should be the name of the global loaddefs.el file, which +is expected to be at the root directory of the files we are +scanning for autoloads and will be in the `load-path'." + (let* ((name (file-relative-name file (file-name-directory outfile))) + (names '()) + (dir (file-name-directory outfile))) + ;; If `name' has directory components, only keep the + ;; last few that are really needed. + (while name + (setq name (directory-file-name name)) + (push (file-name-nondirectory name) names) + (setq name (file-name-directory name))) + (while (not name) + (cond + ((null (cdr names)) (setq name (car names))) + ((file-exists-p (expand-file-name "subdirs.el" dir)) + ;; FIXME: here we only check the existence of subdirs.el, + ;; without checking its content. This makes it generate wrong load + ;; names for cases like lisp/term which is not added to load-path. + (setq dir (expand-file-name (pop names) dir))) + (t (setq name (mapconcat #'identity names "/"))))) + (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) + (substring name 0 (match-beginning 0)) + name))) + +(defun loaddefs-generate--make-autoload (form file &optional expansion) + "Turn FORM into an autoload or defvar for source file FILE. +Returns nil if FORM is not a special autoload form (i.e. a function definition +or macro definition or a defcustom). +If EXPANSION is non-nil, we're processing the macro expansion of an +expression, in which case we want to handle forms differently." + (let ((car (car-safe form)) expand) + (cond + ((and expansion (eq car 'defalias)) + (pcase-let* + ((`(,_ ,_ ,arg . ,rest) form) + ;; `type' is non-nil if it defines a macro. + ;; `fun' is the function part of `arg' (defaults to `arg'). + ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t)) + (and (let fun arg) (let type nil))) + arg) + ;; `lam' is the lambda expression in `fun' (or nil if not + ;; recognized). + (lam (if (memq (car-safe fun) '(quote function)) (cadr fun))) + ;; `args' is the list of arguments (or t if not recognized). + ;; `body' is the body of `lam' (or t if not recognized). + ((or `(lambda ,args . ,body) + (and (let args t) (let body t))) + lam) + ;; Get the `doc' from `body' or `rest'. + (doc (cond ((stringp (car-safe body)) (car body)) + ((stringp (car-safe rest)) (car rest)))) + ;; Look for an interactive spec. + (interactive (pcase body + ((or `((interactive . ,iargs) . ,_) + `(,_ (interactive . ,iargs) . ,_)) + ;; List of modes or just t. + (if (nthcdr 1 iargs) + (list 'quote (nthcdr 1 iargs)) + t))))) + ;; Add the usage form at the end where describe-function-1 + ;; can recover it. + (when (consp args) (setq doc (help-add-fundoc-usage doc args))) + ;; (message "autoload of %S" (nth 1 form)) + `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))) + + ((and expansion (memq car '(progn prog1))) + (let ((end (memq :autoload-end form))) + (when end ;Cut-off anything after the :autoload-end marker. + (setq form (copy-sequence form)) + (setcdr (memq :autoload-end form) nil)) + (let ((exps (delq nil (mapcar (lambda (form) + (loaddefs-generate--make-autoload + form file expansion)) + (cdr form))))) + (when exps (cons 'progn exps))))) + + ;; For complex cases, try again on the macro-expansion. + ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode + define-globalized-minor-mode defun defmacro + easy-mmode-define-minor-mode define-minor-mode + define-inline cl-defun cl-defmacro cl-defgeneric + cl-defstruct pcase-defmacro)) + (macrop car) + (setq expand (let ((load-true-file-name file) + (load-file-name file)) + (macroexpand form))) + (memq (car expand) '(progn prog1 defalias))) + ;; Recurse on the expansion. + (loaddefs-generate--make-autoload expand file 'expansion)) + + ;; For special function-like operators, use the `autoload' function. + ((memq car '(define-skeleton define-derived-mode + define-compilation-mode define-generic-mode + easy-mmode-define-global-mode define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode define-minor-mode + cl-defun defun* cl-defmacro defmacro* + define-overloadable-function)) + (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) + (name (nth 1 form)) + (args (pcase car + ((or 'defun 'defmacro + 'defun* 'defmacro* 'cl-defun 'cl-defmacro + 'define-overloadable-function) + (nth 2 form)) + ('define-skeleton '(&optional str arg)) + ((or 'define-generic-mode 'define-derived-mode + 'define-compilation-mode) + nil) + (_ t))) + (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) + (doc (if (stringp (car body)) (pop body)))) + ;; Add the usage form at the end where describe-function-1 + ;; can recover it. + (when (listp args) (setq doc (help-add-fundoc-usage doc args))) + ;; `define-generic-mode' quotes the name, so take care of that + `(autoload ,(if (listp name) name (list 'quote name)) + ,file ,doc + ,(or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) + t) + (and (eq (car-safe (car body)) 'interactive) + ;; List of modes or just t. + (or (if (nthcdr 1 (car body)) + (list 'quote (nthcdr 1 (car body))) + t)))) + ,(if macrop ''macro nil)))) + + ;; For defclass forms, use `eieio-defclass-autoload'. + ((eq car 'defclass) + (let ((name (nth 1 form)) + (superclasses (nth 2 form)) + (doc (nth 4 form))) + (list 'eieio-defclass-autoload (list 'quote name) + (list 'quote superclasses) file doc))) + + ;; Convert defcustom to less space-consuming data. + ((eq car 'defcustom) + (let* ((varname (car-safe (cdr-safe form))) + (props (nthcdr 4 form)) + (initializer (plist-get props :initialize)) + (init (car-safe (cdr-safe (cdr-safe form)))) + (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) + ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) + ) + `(progn + ,(if (not (member initializer '(nil 'custom-initialize-default + #'custom-initialize-default + 'custom-initialize-reset + #'custom-initialize-reset))) + form + `(defvar ,varname ,init ,doc)) + ;; When we include the complete `form', this `custom-autoload' + ;; is not indispensable, but it still helps in case the `defcustom' + ;; doesn't specify its group explicitly, and probably in a few other + ;; corner cases. + (custom-autoload ',varname ,file + ,(condition-case nil + (null (plist-get props :set)) + (error nil))) + ;; Propagate the :safe property to the loaddefs file. + ,@(when-let ((safe (plist-get props :safe))) + `((put ',varname 'safe-local-variable ,safe)))))) + + ((eq car 'defgroup) + ;; In Emacs this is normally handled separately by cus-dep.el, but for + ;; third party packages, it can be convenient to explicitly autoload + ;; a group. + (let ((groupname (nth 1 form))) + `(let ((loads (get ',groupname 'custom-loads))) + (if (member ',file loads) nil + (put ',groupname 'custom-loads (cons ',file loads)))))) + + ;; When processing a macro expansion, any expression + ;; before a :autoload-end should be included. These are typically (put + ;; 'fun 'prop val) and things like that. + ((and expansion (consp form)) form) + + ;; nil here indicates that this is not a special autoload form. + (t nil)))) + +(defun loaddefs-generate--make-prefixes (defs file) + ;; Remove the defs that obey the rule that file foo.el (or + ;; foo-mode.el) uses "foo-" as prefix. Then compute a small set of + ;; prefixes that cover all the remaining definitions. + (let* ((tree (let ((tree radix-tree-empty)) + (dolist (def defs) + (setq tree (radix-tree-insert tree def t))) + tree)) + (prefixes nil)) + ;; Get the root prefixes, that we should include in any case. + (radix-tree-iter-subtrees + tree (lambda (prefix subtree) + (push (cons prefix subtree) prefixes))) + ;; In some cases, the root prefixes are too short, e.g. if you define + ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. + (dolist (pair (prog1 prefixes (setq prefixes nil))) + (let ((s (car pair))) + (if (or (and (> (length s) 2) ; Long enough! + ;; But don't use "def" from deffoo-pkg-thing. + (not (string= "def" s))) + (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? + (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! + (push pair prefixes) ;Keep it as is. + (radix-tree-iter-subtrees + (cdr pair) (lambda (prefix subtree) + (push (cons (concat s prefix) subtree) prefixes)))))) + (when prefixes + (let ((strings + (mapcar + (lambda (x) + (let ((prefix (car x))) + (if (or (> (length prefix) 2) ;Long enough! + (and (eq (length prefix) 2) + (string-match "[[:punct:]]" prefix))) + prefix + ;; Some packages really don't follow the rules. + ;; Drop the most egregious cases such as the + ;; one-letter prefixes. + (let ((dropped ())) + (radix-tree-iter-mappings + (cdr x) (lambda (s _) + (push (concat prefix s) dropped))) + (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S" + file prefix dropped) + nil)))) + prefixes))) + `(register-definition-prefixes ,file ',(sort (delq nil strings) + 'string<)))))) + +(defun loaddefs-generate--parse-file (file main-outfile &optional package-data) + "Examing FILE for ;;;###autoload statements. +MAIN-OUTFILE is the main loaddefs file these statements are +destined for, but this can be overriden by the buffer-local +setting of `generated-autoload-file' in FILE, and +by ;;;###foo-autoload statements. + +If PACKAGE-DATA is `only', return only the package data. If t, +include the package data with the rest of the data. Otherwise, +don't include." + (let ((defs nil) + (load-name (loaddefs-generate--file-load-name file main-outfile)) + (compute-prefixes t) + local-outfile inhibit-autoloads) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-max)) + ;; We "open-code" this version of `hack-local-variables', + ;; because it's really slow in bootstrap-emacs. + (when (search-backward ";; Local Variables:" (- (point-max) 1000) t) + (save-excursion + (when (re-search-forward "generated-autoload-file: *" nil t) + ;; Buffer-local file that should be interpreted relative to + ;; the .el file. + (setq local-outfile (expand-file-name (read (current-buffer)) + (file-name-directory file))))) + (save-excursion + (when (re-search-forward "generated-autoload-load-name: *" nil t) + (setq load-name (read (current-buffer))))) + (save-excursion + (when (re-search-forward "no-update-autoloads: *" nil t) + (setq inhibit-autoloads (read (current-buffer))))) + (save-excursion + (when (re-search-forward "autoload-compute-prefixes: *" nil t) + (setq compute-prefixes (read (current-buffer)))))) + + ;; We always return the package version (even for pre-dumped + ;; files). + (when package-data + (let ((version (lm-header "version")) + package) + (when (and version + (setq version (ignore-errors (version-to-list version))) + (setq package (or (lm-header "package") + (file-name-sans-extension + (file-name-nondirectory file))))) + (push (list (or local-outfile main-outfile) file + `(push (purecopy ',(cons (intern package) version)) + package--builtin-versions)) + defs)))) + + ;; Obey the `no-update-autoloads' file local variable. + (when (and (not inhibit-autoloads) + (not (eq package-data 'only))) + (goto-char (point-min)) + ;; The cookie might be like ;;;###tramp-autoload... + (while (re-search-forward lisp-mode-autoload-regexp nil t) + ;; ... and if we have one of these names, then alter outfile. + (let* ((aname (match-string 2)) + (to-file (if aname + (expand-file-name + (concat aname "-loaddefs.el") + (file-name-directory file)) + (or local-outfile main-outfile)))) + (if (eolp) + ;; We have a form following. + (let* ((form (prog1 + (read (current-buffer)) + (unless (bolp) + (forward-line 1)))) + (autoload (or (loaddefs-generate--make-autoload + form load-name) + form))) + ;; We get back either an autoload form, or a tree + ;; structure of `(progn ...)' things, so unravel that. + (let ((forms (if (eq (car autoload) 'progn) + (cdr autoload) + (list autoload)))) + (while forms + (let ((elem (pop forms))) + (if (eq (car elem) 'progn) + ;; More recursion; add it to the start. + (setq forms (nconc (cdr elem) forms)) + ;; We have something to add to the defs; do it. + (push (list to-file file elem) defs)))))) + ;; Just put the rest of the line into the loaddefs. + ;; FIXME: We skip the first space if there's more + ;; whitespace after. + (when (looking-at-p " [\t ]") + (forward-char 1)) + (push (list to-file file + (buffer-substring (point) (line-end-position))) + defs)))) + + (when (and autoload-compute-prefixes + compute-prefixes) + (when-let ((form (loaddefs-generate--compute-prefixes load-name))) + ;; This output needs to always go in the main loaddefs.el, + ;; regardless of `generated-autoload-file'. + (push (list main-outfile file form) defs))))) + defs)) + +(defun loaddefs-generate--compute-prefixes (load-name) + (goto-char (point-min)) + (let ((prefs nil)) + ;; Avoid (defvar ) by requiring a trailing space. + (while (re-search-forward + "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) + (unless (member (match-string 1) autoload-ignored-definitions) + (let ((name (match-string-no-properties 2))) + (when (save-excursion + (goto-char (match-beginning 0)) + (or (bobp) + (progn + (forward-line -1) + (not (looking-at ";;;###autoload"))))) + (push name prefs))))) + (loaddefs-generate--make-prefixes prefs load-name))) + +(defun loaddefs-generate--rubric (file &optional type feature) + "Return a string giving the appropriate autoload rubric for FILE. +TYPE (default \"autoloads\") is a string stating the type of +information contained in FILE. TYPE \"package\" acts like the default, +but adds an extra line to the output to modify `load-path'. + +If FEATURE is non-nil, FILE will provide a feature. FEATURE may +be a string naming the feature, otherwise it will be based on +FILE's name." + (let ((basename (file-name-nondirectory file)) + (lp (if (equal type "package") (setq type "autoloads")))) + (concat ";;; " basename + " --- automatically extracted " (or type "autoloads") + " -*- lexical-binding: t -*-\n" + (when (string-match "/lisp/loaddefs\\.el\\'" file) + ";; This file will be copied to ldefs-boot.el and checked in periodically.\n") + ";;\n" + ";;; Code:\n\n" + (if lp + "(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path))))\n\n") + " \n" + ;; This is used outside of autoload.el, eg cus-dep, finder. + (if feature + (format "(provide '%s)\n" + (if (stringp feature) feature + (file-name-sans-extension basename)))) + ";; Local Variables:\n" + ";; version-control: never\n" + ";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil. + ";; no-update-autoloads: t\n" + ";; coding: utf-8-emacs-unix\n" + ";; End:\n" + ";;; " basename + " ends here\n"))) + +(defun loaddefs-generate--insert-section-header (outbuf autoloads + load-name file time) + "Insert into buffer OUTBUF the section-header line for FILE. +The header line lists the file name, its \"load name\", its autoloads, +and the time the FILE was last updated (the time is inserted only +if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." + (insert "\f\n;;;### ") + (prin1 `(autoloads ,autoloads ,load-name ,file ,time) + outbuf) + (terpri outbuf) + ;; Break that line at spaces, to avoid very long lines. + ;; Make each sub-line into a comment. + (with-current-buffer outbuf + (save-excursion + (forward-line -1) + (while (not (eolp)) + (move-to-column 64) + (skip-chars-forward "^ \n") + (or (eolp) + (insert "\n" ";;;;;; ")))))) + +;;;###autoload +(defun loaddefs-generate (dir output-file &optional excluded-files + extra-data include-package-version) + "Generate loaddefs files for Lisp files in the directories DIRS. +DIR can be either a single directory or a list of directories. + +The autoloads will be written to OUTPUT-FILE. If any Lisp file +binds `generated-autoload-file' as a file-local variable, write +its autoloads into the specified file instead. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified. + +If EXTRA-DATA, include this string at the start of the generated file. + +If INCLUDE-PACKAGE-VERSION, include package version data." + (let* ((files-re (let ((tmp nil)) + (dolist (suf (get-load-suffixes)) + ;; We don't use module-file-suffix below because + ;; we don't want to depend on whether Emacs was + ;; built with or without modules support, nor + ;; what is the suffix for the underlying OS. + (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) + (push suf tmp))) + (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) + (files (apply #'nconc + (mapcar (lambda (d) + (directory-files (expand-file-name d) + t files-re)) + (if (consp dir) dir (list dir))))) + (defs nil)) + + ;; Collect all the autoload data. + (let ((progress (make-progress-reporter + (byte-compile-info + (concat "Scraping files for loaddefs")) + 0 (length files) nil 10)) + (file-count 0)) + (dolist (file files) + (progress-reporter-update progress (setq file-count (1+ file-count))) + ;; Do not insert autoload entries for excluded files. + (setq defs (nconc + (loaddefs-generate--parse-file + file output-file + ;; We only want the package name from the + ;; excluded files. + (and include-package-version + (if (member (expand-file-name file) excluded-files) + 'only + t))) + defs))) + (progress-reporter-done progress)) + + ;; Generate the loaddef files. First group per output file. + (dolist (fdefs (seq-group-by #'car defs)) + (with-temp-buffer + (insert (loaddefs-generate--rubric (car fdefs) nil t)) + (search-backward "\f") + (when extra-data + (insert extra-data) + (ensure-empty-lines 1)) + ;; The group by source file (and sort alphabetically). + (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) + (lambda (e1 e2) + (string< + (file-name-sans-extension + (file-name-nondirectory (car e1))) + (file-name-sans-extension + (file-name-nondirectory (car e2))))))) + (pop section) + (let ((relfile (file-relative-name + (cadar section) + (file-name-directory (car fdefs))))) + (insert "\f\n;;; Generated autoloads from " relfile "\n\n") + (dolist (def (reverse section)) + (setq def (caddr def)) + (if (stringp def) + (princ def (current-buffer)) + (loaddefs-generate--print-form def)) + (unless (bolp) + (insert "\n"))) + (insert "\n"))) + (write-region (point-min) (point-max) (car fdefs) nil 'silent) + (byte-compile-info (file-relative-name (car fdefs) lisp-directory) + t "GEN"))))) + +(defun loaddefs-generate--print-form (def) + "Print DEF in the way make-docfile.c expects it." + (if (or (not (consp def)) + (not (symbolp (car def))) + (not (stringp (nth 3 def)))) + (prin1 def (current-buffer) t) + ;; The salient point here is that we have to have the doc string + ;; that starts with a backslash and a newline, and there mustn't + ;; be any newlines before that. So -- typically + ;; (defvar foo 'value "\ + ;; Doc string" ...). + (insert "(") + (dotimes (_ 3) + (prin1 (pop def) (current-buffer) + '(t (escape-newlines . t) + (escape-control-characters . t))) + (insert " ")) + (let ((start (point))) + (prin1 (pop def) (current-buffer) t) + (save-excursion + (goto-char (1+ start)) + (insert "\\\n"))) + (while def + (insert " ") + (prin1 (pop def) (current-buffer) t)) + (insert ")"))) + +(defun loaddefs-generate--excluded-files () + ;; Exclude those files that are preloaded on ALL platforms. + ;; These are the ones in loadup.el where "(load" is at the start + ;; of the line (crude, but it works). + (let ((default-directory (file-name-directory lisp-directory)) + (excludes nil) + file) + (with-temp-buffer + (insert-file-contents "loadup.el") + (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t) + (setq file (match-string 1)) + (or (string-match "\\.el\\'" file) + (setq file (format "%s.el" file))) + (or (string-match "\\`site-" file) + (push (expand-file-name file) excludes)))) + ;; Don't scan ldefs-boot.el, either. + (cons (expand-file-name "ldefs-boot.el") excludes))) + +;;;###autoload +(defun loaddefs-generate-batch () + "Generate loaddefs.el files in batch mode. +This scans for ;;;###autoload forms and related things. + +The first element on the command line should be the (main) +loaddefs.el output file, and the rest are the directories to +use." + (let* ((args command-line-args-left) + (output-file (expand-file-name (car args) lisp-directory))) + (setq command-line-args-left nil) + (loaddefs-generate + (cdr args) output-file + (loaddefs-generate--excluded-files) + nil + ;; When generating the top-level Emacs loaddefs file, we want to + ;; include the `package--builtin-versions' things. + (equal (file-name-directory output-file) lisp-directory)))) + +(provide 'loaddefs-gen) + +;;; loaddefs-gen.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b340848a6f..48551f59b4 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1003,6 +1003,7 @@ untar into a directory named DIR; otherwise, signal an error." (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." + (declare (obsolete nil "29.1")) (unless (file-exists-p file) (require 'autoload) (let ((coding-system-for-write 'utf-8-emacs-unix)) @@ -1021,8 +1022,11 @@ untar into a directory named DIR; otherwise, signal an error." (autoload-timestamps nil) (backup-inhibited t) (version-control 'never)) - (package-autoload-ensure-default-file output-file) - (make-directory-autoloads pkg-dir output-file) + (loaddefs-generate + pkg-dir output-file + nil + "(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path))))") (let ((buf (find-buffer-visiting output-file))) (when buf (kill-buffer buf))) auto-name)) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index ecfa8aab84..2c9d1b316e 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1847,4 +1847,8 @@ like an INI file. You can add this hook to `find-file-hook'." (provide 'generic-x) +;; Local Variables: +;; autoload-compute-prefixes: nil +;; End: + ;;; generic-x.el ends here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 8afc7ac54a..d63c006678 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,6 +3,9 @@ ;; ;;; Code: +(autoload 'loaddefs-generate "loaddefs-gen") +(autoload 'loaddefs-generate-batch "loaddefs-gen") + ;;;### (autoloads nil "5x5" "play/5x5.el" (0 0 0 0)) ;;; Generated autoloads from play/5x5.el diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index bdef0ae17c..85e37ec609 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -359,23 +359,6 @@ names." ;;;; Support for build process -;; From autoload.el -(defvar autoload-make-program) -(defvar generated-autoload-file) - -(defun w32-batch-update-autoloads () - "Like `batch-update-autoloads', but takes the name of the autoloads file -from the command line. - -This is required because some Windows build environments, such as MSYS, -munge command-line arguments that include file names to a horrible mess -that Emacs is unable to cope with." - (let ((generated-autoload-file - (expand-file-name (pop command-line-args-left))) - ;; I can only assume the same considerations may apply here... - (autoload-make-program (pop command-line-args-left))) - (batch-update-autoloads))) - (defun w32-append-code-lines (orig extra) "Append non-empty non-comment lines in the file EXTRA to the file ORIG. diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index 12f1e9034c..52f06df5bc 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -140,7 +140,7 @@ ;; causes bzr status to fail. This simulates a broken bzr ;; installation. (delete-file ".bzr/checkout/dirstate") - (should (progn (make-directory-autoloads + (should (progn (loaddefs-generate default-directory (expand-file-name "loaddefs.el" bzrdir)) t))))) commit 41a2def162ee95db6a9ca7e904bbd7feee5e3ccf Author: Po Lu Date: Tue May 31 13:31:18 2022 +0000 Convert FILE_NAME to refs on Haiku instead of text/uri-list * lisp/term/haiku-win.el (haiku-dnd-selection-converters): Use more appropriate target for file names. (haiku-dnd-convert-uri-list): Delete function. (haiku-dnd-convert-file-name): New function. Also handle remote file names. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 7f3bba52e5..a8cc1da731 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -52,7 +52,7 @@ "The local value of the special `XdndSelection' selection.") (defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string) - (text/uri-list . haiku-dnd-convert-uri-list)) + (FILE_NAME . haiku-dnd-convert-file-name)) "Alist of X selection types to functions that act as selection converters. The functions should accept a single argument VALUE, describing the value of the drag-and-drop selection, and return a list of @@ -141,9 +141,10 @@ VALUE as a unibyte string, or nil if VALUE was not a string." (list "text/plain" (string-to-unibyte (encode-coding-string value 'utf-8))))) -(defun haiku-dnd-convert-uri-list (value) +(defun haiku-dnd-convert-file-name (value) "Convert VALUE to a file system reference if it is a file name." (when (and (stringp value) + (not (file-remote-p value)) (file-exists-p value)) (list "refs" (propertize (expand-file-name value) 'type 'ref)))) commit 0a7bd8c07c805f5edaadd758cec34650a4d84a1a Merge: f1e21a0341 e10d10a3e3 Author: Eli Zaretskii Date: Tue May 31 16:19:44 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit e10d10a3e33df49bdbb5990db8af7a05ab0b191c Author: Po Lu Date: Tue May 31 21:14:16 2022 +0800 Add missing part of recent changes to NS DND support * lisp/term/ns-win.el (x-begin-drag): Implement `return-frame' argument. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index d90146284f..65abdcf0fb 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -895,7 +895,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") &context (window-system ns)) (ns-get-selection selection-symbol target-type)) -(defun x-begin-drag (targets &optional action frame _return-frame _allow-current-frame) +(defun x-begin-drag (targets &optional action frame return-frame _allow-current-frame) "SKIP: real doc in xfns.c." (unless ns-dnd-selection-value (error "No local value for XdndSelection")) @@ -910,7 +910,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (expand-file-name ns-dnd-selection-value)))) pasteboard)) - (ns-begin-drag frame pasteboard action))) + (ns-begin-drag frame pasteboard action return-frame))) (defun ns-handle-drag-motion (frame x y) "Handle mouse movement on FRAME at X and Y during drag-and-drop. commit f1e21a03419f6b2071153098a6129e5701884643 Author: समीर सिंह Sameer Singh Date: Mon May 30 17:46:14 2022 +0530 Add support for the Makasar and Lontara scripts (bug#55734) * lisp/language/indonesian.el ("Makasar") ("Buginese"): New language environment. Add composition rules for Makasar and Lontara. Add sample texts and input methods. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Makasar and Buginese. * lisp/leim/quail/indonesian.el ("makasar") ("lontara"): New input methods. * etc/HELLO: Add Makasar and Buginese greetings. * etc/NEWS: Announce the new language environments. diff --git a/etc/HELLO b/etc/HELLO index 39cf6c7504..f63f65ff7d 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -34,6 +34,7 @@ Bengali (বাংলা) নমস্কার Brahmi (𑀩𑁆𑀭𑀸𑀳𑁆𑀫𑀻) 𑀦𑀫𑀲𑁆𑀢𑁂 Braille ⠓⠑⠇⠇⠕ +Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ Burmese (မြန်မာ) မင်္ဂလာပါ C printf (orange red"Hello, world!\n"); Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨁꨰ @@ -73,6 +74,7 @@ Khmer (ភាសាខ្មែរ) ជំរាបសួរ Lakota (Lakȟotiyapi) Taŋyáŋ yahí! Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ Limbu (ᤕᤰᤌᤢᤱ ᤐᤠᤴ) ᤛᤣᤘᤠᤖᤥ +Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱 Malayalam (മലയാളം) നമസ്കാരം Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނެހް؟ Maltese (il-Malti) Bonġu / Saħħa diff --git a/etc/NEWS b/etc/NEWS index 1d37bb84c6..166e991c49 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -838,6 +838,8 @@ corresponding language environments are: **** Sundanese script and language environment **** Batak script and language environment **** Rejang script and language environment +**** Makasar script and language environment +**** Lontara script and language environment --- *** The "Oriya" language environment was renamed to "Odia". diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 0c008f90b7..425e9dcb41 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -189,6 +189,7 @@ (khmer #x1780) (mongolian #x1826) (limbu #x1901 #x1920 #x1936) + (buginese #x1A00 #x1A1E) (balinese #x1B13 #x1B35 #x1B5E) (sundanese #x1B8A #x1BAB #x1CC4) (batak #x1BC2 #x1BE7 #x1BFF) @@ -266,7 +267,7 @@ (marchen #x11C72) (masaram-gondi #x11D00) (gunjala-gondi #x11D60) - (makasar #x11EE0) + (makasar #x11EE0 #x11EF7) (cuneiform #x12000) (cypro-minoan #x12F90) (egyptian #x13000) @@ -762,6 +763,7 @@ buhid tagbanwa limbu + buginese balinese sundanese batak diff --git a/lisp/language/indonesian.el b/lisp/language/indonesian.el index efc7b73904..699f819254 100644 --- a/lisp/language/indonesian.el +++ b/lisp/language/indonesian.el @@ -73,6 +73,24 @@ and Simalungun, are supported in this language environment."))) (documentation . "\ Rejang language and its script are supported in this language environment."))) +(set-language-info-alist + "Makasar" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "makasar") + (sample-text . "Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱") + (documentation . "\ +Makassarese language and its script Makasar are supported in this language environment."))) + +(set-language-info-alist + "Buginese" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "lontara") + (sample-text . "Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ") + (documentation . "\ +Buginese language and its script Lontara are supported in this language environment."))) + ;; Balinese composition rules (let ((consonant "[\x1B13-\x1B33\x1B45-\x1B4B]") (independent-vowel "[\x1B05-\x1B12]") @@ -165,5 +183,15 @@ Rejang language and its script are supported in this language environment."))) dependant-consonant "?") 1 'font-shape-gstring)))) +;; Makasar composition rules +(let ((akshara "[\x11EE0-\x11EF2]") + (vowel "[\x11EF3-\x11EF6]")) + (set-char-table-range composition-function-table + '(#x11EF3 . #x11EF6) + (list (vector + ;; Akshara based syllables + (concat akshara vowel "*") + 1 'font-shape-gstring)))) + (provide 'indonesian) ;;; indonesian.el ends here diff --git a/lisp/leim/quail/indonesian.el b/lisp/leim/quail/indonesian.el index 206bcfc5fe..8d0d158076 100644 --- a/lisp/leim/quail/indonesian.el +++ b/lisp/leim/quail/indonesian.el @@ -444,8 +444,8 @@ ("`m" ?ᯣ)) (quail-define-package - "rejang" "Rejang" "ꤽꥍ" nil "Rejang phonetic input method." - nil t t t t nil nil nil nil nil t) + "rejang" "Rejang" "ꤽꥍ" nil "Rejang phonetic input method." + nil t t t t nil nil nil nil nil t) (quail-define-rules ("q" ?꥟) @@ -486,5 +486,72 @@ ("m" ?ꤸ) ("M" ?ꥂ)) +(quail-define-package + "makasar" "Makasar" "𑻪" nil "Makasar phonetic input method." + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?𑻷) + ("Q" ?𑻸) + ("e" ?𑻵) + ("r" ?𑻭) + ("t" ?𑻦) + ("y" ?𑻬) + ("u" ?𑻴) + ("i" ?𑻳) + ("o" ?𑻶) + ("p" ?𑻣) + ("a" ?𑻱) + ("s" ?𑻰) + ("d" ?𑻧) + ("g" ?𑻡) + ("j" ?𑻪) + ("k" ?𑻠) + ("l" ?𑻮) + ("z" ?𑻢) + ("Z" ?𑻲) + ("x" ?𑻫) + ("c" ?𑻩) + ("v" ?𑻯) + ("b" ?𑻤) + ("n" ?𑻨) + ("m" ?𑻥)) + +(quail-define-package + "lontara" "Lontara" "ᨒ" nil "Lontara phonetic input method." + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?᨞) + ("Q" ?᨟) + ("e" ?ᨙ) + ("E" ?ᨛ) + ("r" ?ᨑ) + ("t" ?ᨈ) + ("y" ?ᨐ) + ("u" ?ᨘ) + ("i" ?ᨗ) + ("o" ?ᨚ) + ("p" ?ᨄ) + ("a" ?ᨕ) + ("s" ?ᨔ) + ("d" ?ᨉ) + ("g" ?ᨁ) + ("h" ?ᨖ) + ("j" ?ᨍ) + ("k" ?ᨀ) + ("l" ?ᨒ) + ("z" ?ᨂ) + ("Z" ?ᨃ) + ("x" ?ᨎ) + ("X" ?ᨏ) + ("c" ?ᨌ) + ("v" ?ᨓ) + ("b" ?ᨅ) + ("n" ?ᨊ) + ("N" ?ᨋ) + ("m" ?ᨆ) + ("M" ?ᨇ)) + (provide 'indonesian) ;;; indonesian.el ends here commit 90957dfb7a21528b19f587b1aa64752f5f2f194e Author: Po Lu Date: Tue May 31 20:56:43 2022 +0800 Slightly optimize x_check_errors as well * src/xterm.c (x_check_errors): Don't sync if no requests were made since the error trap was installed. diff --git a/src/xterm.c b/src/xterm.c index fb7d18a53f..7235a1e959 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -21414,8 +21414,10 @@ x_check_errors (Display *dpy, const char *format) /* There is no point in making this extra sync if all requests are known to have been fully processed. */ - if (LastKnownRequestProcessed (dpy) - != NextRequest (dpy) - 1) + if ((LastKnownRequestProcessed (dpy) + != NextRequest (dpy) - 1) + && (NextRequest (dpy) + > x_error_message->first_request)) XSync (dpy, False); if (x_error_message->string[0]) commit dea1a502ef9463a7c23e0726d0a99fa938622207 Author: Stefan Kangas Date: Tue May 31 14:30:38 2022 +0200 * lisp/play/handwrite.el: Minor doc fixes. diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 0b9f9fb2e6..68a82f5a9e 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -1,6 +1,6 @@ ;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- lexical-binding: t -*- -;; Copyright (C) 1996, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1996-2022 Free Software Foundation, Inc. ;; Author: Danny Roozendaal (was: ) ;; Maintainer: emacs-devel@gnu.org @@ -29,30 +29,31 @@ ;; ;; Other functions that may be useful are: ;; -;; handwrite-10pt: sets the font size to 10 and finds corresponding -;; values for the line spacing and the number of lines -;; on a page. -;; handwrite-11pt: which is similar -;; handwrite-12pt: which is also similar -;; handwrite-13pt: which is similar, too +;; `handwrite-10pt': set the font size to 10 and find corresponding +;; values for the line spacing and the number of lines +;; on a page. +;; `handwrite-11pt': which is similar +;; `handwrite-12pt': which is also similar +;; `handwrite-13pt': which is similar, too ;; -;; handwrite-set-pagenumber: set and unset page numbering +;; `handwrite-set-pagenumber': set and unset page numbering ;; ;; ;; If you are not satisfied with the type page there are a number of ;; variables you may want to set. ;; -;; To use this, say "M-x handwrite" or type at your prompt +;; To use this, say `M-x handwrite' or type at your prompt ;; "emacs -l handwrite.el". ;; ;; I tried to make it `iso_8859_1'-friendly, but there are some exotic ;; characters missing. ;; ;; -;; Known bugs: -Page feeds do not do their work, but are ignored instead. -;; -Tabs are not always properly displayed. -;; -Handwrite may create corrupt PostScript if it encounters -;; unknown characters. +;; Known bugs: +;; - Page feeds do not work, and are ignored instead. +;; - Tabs are not always properly displayed. +;; - Handwrite may create corrupt PostScript if it encounters +;; unknown characters. ;; ;; Thanks to anyone who emailed me suggestions! @@ -63,7 +64,7 @@ ;; Variables (defgroup handwrite nil - "Turns your Emacs buffer into a handwritten document." + "Turn your Emacs buffer into a handwritten document." :prefix "handwrite-" :group 'games) @@ -254,8 +255,8 @@ Variables: `handwrite-linespace' (default 12) (defun handwrite-10pt () "Specify 10-point output for `handwrite'. -This sets `handwrite-fontsize' to 10 and finds correct -values for `handwrite-linespace' and `handwrite-numlines'." +Set `handwrite-fontsize' to 10 and find correct values for +`handwrite-linespace' and `handwrite-numlines'." (interactive) (setq handwrite-fontsize 10) (setq handwrite-linespace 11) @@ -264,8 +265,8 @@ values for `handwrite-linespace' and `handwrite-numlines'." (defun handwrite-11pt () "Specify 11-point output for `handwrite'. -This sets `handwrite-fontsize' to 11 and finds correct -values for `handwrite-linespace' and `handwrite-numlines'." +Set `handwrite-fontsize' to 11 and find correct values for +`handwrite-linespace' and `handwrite-numlines'." (interactive) (setq handwrite-fontsize 11) (setq handwrite-linespace 12) @@ -274,8 +275,8 @@ values for `handwrite-linespace' and `handwrite-numlines'." (defun handwrite-12pt () "Specify 12-point output for `handwrite'. -This sets `handwrite-fontsize' to 12 and finds correct -values for `handwrite-linespace' and `handwrite-numlines'." +Set `handwrite-fontsize' to 12 and find correct values for +`handwrite-linespace' and `handwrite-numlines'." (interactive) (setq handwrite-fontsize 12) (setq handwrite-linespace 13) @@ -284,8 +285,8 @@ values for `handwrite-linespace' and `handwrite-numlines'." (defun handwrite-13pt () "Specify 13-point output for `handwrite'. -This sets `handwrite-fontsize' to 13 and finds correct -values for `handwrite-linespace' and `handwrite-numlines'." +Set `handwrite-fontsize' to 13 and find correct values for +`handwrite-linespace' and `handwrite-numlines'." (interactive) (setq handwrite-fontsize 13) (setq handwrite-linespace 14) commit f0361c225c7f340cd31f7873ac2f3f6c8df31404 Author: Antonio Ruiz Date: Tue May 31 13:27:28 2022 +0200 Make handwrite.el printing use more of the ps-print setup * lisp/play/handwrite.el (handwrite): Allow ps-lpr-printer to be computed at runtime (bug#55733). Copyright-paperwork-exempt: yes diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 14624ddce2..0b9f9fb2e6 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -58,10 +58,7 @@ ;;; Code: -;; From ps-print.el -(defvar ps-printer-name) -(defvar ps-lpr-command) -(defvar ps-lpr-switches) +(require 'ps-print) ;; Variables @@ -235,20 +232,13 @@ Variables: `handwrite-linespace' (default 12) (while (search-forward "\f" nil t) (replace-match "" nil t) ) (untabify textp (point-max)) ; this may result in strange tabs - (if (y-or-n-p "Send this to the printer? ") - (progn - (require 'ps-print) - (let* ((coding-system-for-write 'raw-text-unix) - (ps-printer-name (or ps-printer-name - (and (boundp 'printer-name) - printer-name))) - (ps-lpr-switches - (if (stringp ps-printer-name) - (list (concat "-P" ps-printer-name))))) - (apply (or (and (boundp 'ps-print-region-function) - ps-print-region-function) - 'call-process-region) - (point-min) (point-max) ps-lpr-command nil nil nil)))) + (when (y-or-n-p "Send this to the printer? ") + (let* ((coding-system-for-write 'raw-text-unix) + (printer-name (or ps-printer-name printer-name)) + (lpr-printer-switch ps-printer-name-option) + (print-region-function ps-print-region-function) + (lpr-command ps-lpr-command)) + (lpr-print-region (point-min) (point-max) ps-lpr-switches nil))) (message "") (bury-buffer ()) (switch-to-buffer cur-buf) commit fbe7ac16d722f786e5f3f2e3a916b1aa79510eb5 Author: Po Lu Date: Tue May 31 18:18:52 2022 +0800 Fix replying to _NET_WM_PING during drag-and-drop * src/xterm.c (handle_one_xevent): Test client window against root window instead of using nonstandard event mask. diff --git a/src/xterm.c b/src/xterm.c index 0ebabdccaf..fb7d18a53f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15246,25 +15246,23 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_ping + /* Handling window stacking changes during + drag-and-drop requires Emacs to select for + SubstructureNotifyMask, which in turn causes the + message to be sent to Emacs itself using the event + mask specified by the EWMH. To avoid an infinite + loop, make sure the client message's window is not + the root window if DND is in progress. */ + && (!x_dnd_in_progress + || !x_dnd_waiting_for_finish + || event->xclient.window != dpyinfo->root_window) && event->xclient.format == 32) { XEvent send_event = *event; send_event.xclient.window = dpyinfo->root_window; XSendEvent (dpyinfo->display, dpyinfo->root_window, False, - /* FIXME: handling window stacking changes - during drag-and-drop requires Emacs to - select for SubstructureNotifyMask, - which in turn causes the message to be - sent to Emacs itself using the event - mask specified by the EWMH. To avoid - an infinite loop, just use - SubstructureRedirectMask when a - drag-and-drop operation is in - progress. */ - ((x_dnd_in_progress || x_dnd_waiting_for_finish) - ? SubstructureRedirectMask - : SubstructureRedirectMask | SubstructureNotifyMask), + SubstructureRedirectMask | SubstructureNotifyMask, &send_event); *finish = X_EVENT_DROP; commit f8d07fbeb36cfae8b2b117c3050476f8984a515f Merge: 2021835326 a55a0483c9 Author: Po Lu Date: Tue May 31 18:06:15 2022 +0800 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 20218353262dc38d82adb945a6a38d6e629c1417 Author: Po Lu Date: Tue May 31 18:05:41 2022 +0800 Implement `return-frame' for DND on NS * src/nsselect.m (Fns_begin_drag): New argument `return-frame'. (syms_of_nsselect): New defsym. * src/nsterm.h (EmacsWindow): New fields. * src/nsterm.m (ns_read_socket): Split parts off to ns_read_socket_1. (ns_read_socket_1): New function. (ns_flush_display): Use that function instead. ([EmacsWindow beginDrag:forPasteboard:]): Update for return-frame. diff --git a/src/nsselect.m b/src/nsselect.m index 1ff627e657..63cea365e2 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -662,7 +662,7 @@ Updated by Christian Limpach (chris@nice.ch) } } -DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 3, 0, +DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 4, 0, doc: /* Begin a drag-and-drop operation on FRAME. FRAME must be a window system frame. PBOARD is an alist of (TYPE @@ -680,13 +680,30 @@ Updated by Christian Limpach (chris@nice.ch) Return the action that the drop target actually chose to perform, or nil if no action was performed (either because there was no drop -target, or the drop was rejected). */) - (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action) +target, or the drop was rejected). If RETURN_FRAME is the symbol +`now', also return any frame that mouse moves into during the +drag-and-drop operation, whilst simultaneously cancelling it. Any +other non-nil value means to do the same, but to wait for the mouse to +leave FRAME first. */) + (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action, + Lisp_Object return_frame) { - struct frame *f; + struct frame *f, *return_to; NSPasteboard *pasteboard; EmacsWindow *window; NSDragOperation operation; + enum ns_return_frame_mode mode; + Lisp_Object val; + + if (EQ (return_frame, Qnow)) + mode = RETURN_FRAME_NOW; + else if (!NILP (return_frame)) + mode = RETURN_FRAME_EVENTUALLY; + else + mode = RETURN_FRAME_NEVER; + + if (NILP (pboard)) + signal_error ("Empty pasteboard", pboard); f = decode_window_system_frame (frame); pasteboard = [NSPasteboard pasteboardWithName: NSPasteboardNameDrag]; @@ -696,7 +713,15 @@ nil if no action was performed (either because there was no drop ns_lisp_to_pasteboard (pboard, pasteboard); operation = [window beginDrag: operation - forPasteboard: pasteboard]; + forPasteboard: pasteboard + withMode: mode + returnFrameTo: &return_to]; + + if (return_to) + { + XSETFRAME (val, return_to); + return val; + } return ns_dnd_action_from_operation (operation); } @@ -714,6 +739,7 @@ nil if no action was performed (either because there was no drop DEFSYM (QXdndActionMove, "XdndActionMove"); DEFSYM (QXdndActionLink, "XdndActionLink"); DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); + DEFSYM (Qnow, "now"); defsubr (&Sns_disown_selection_internal); defsubr (&Sns_get_selection); diff --git a/src/nsterm.h b/src/nsterm.h index f74c457fe3..c39b66534f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -408,6 +408,13 @@ typedef id instancetype; @end #endif +enum ns_return_frame_mode + { + RETURN_FRAME_NEVER, + RETURN_FRAME_EVENTUALLY, + RETURN_FRAME_NOW, + }; + /* EmacsWindow */ @interface EmacsWindow : NSWindow { @@ -415,6 +422,9 @@ typedef id instancetype; NSEvent *last_drag_event; NSDragOperation drag_op; NSDragOperation selected_op; + + struct frame *dnd_return_frame; + enum ns_return_frame_mode dnd_mode; } #ifdef NS_IMPL_GNUSTEP @@ -432,7 +442,9 @@ typedef id instancetype; - (void) setAppearance; - (void) setLastDragEvent: (NSEvent *) event; - (NSDragOperation) beginDrag: (NSDragOperation) op - forPasteboard: (NSPasteboard *) pasteboard; + forPasteboard: (NSPasteboard *) pasteboard + withMode: (enum ns_return_frame_mode) mode + returnFrameTo: (struct frame **) frame_return; @end diff --git a/src/nsterm.m b/src/nsterm.m index 0f1b597457..f4fde9bd12 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4529,11 +4529,14 @@ in certain situations (rapid incoming events). static int -ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) +ns_read_socket_1 (struct terminal *terminal, struct input_event *hold_quit, + BOOL no_release) /* -------------------------------------------------------------------------- External (hook): Post an event to ourself and keep reading events until we read it back again. In effect process all events which were waiting. From 21+ we have to manage the event buffer ourselves. + + NO_RELEASE means not to touch the global autorelease pool. -------------------------------------------------------------------------- */ { struct input_event ev; @@ -4564,11 +4567,14 @@ in certain situations (rapid incoming events). ns_init_events (&ev); q_event_ptr = hold_quit; - /* We manage autorelease pools by allocate/reallocate each time around - the loop; strict nesting is occasionally violated but seems not to - matter... earlier methods using full nesting caused major memory leaks. */ - [outerpool release]; - outerpool = [[NSAutoreleasePool alloc] init]; + if (!no_release) + { + /* We manage autorelease pools by allocate/reallocate each time around + the loop; strict nesting is occasionally violated but seems not to + matter... earlier methods using full nesting caused major memory leaks. */ + [outerpool release]; + outerpool = [[NSAutoreleasePool alloc] init]; + } /* If have pending open-file requests, attend to the next one of those. */ if (ns_pending_files && [ns_pending_files count] != 0 @@ -4607,6 +4613,12 @@ in certain situations (rapid incoming events). return nevents; } +static int +ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + return ns_read_socket_1 (terminal, hold_quit, NO); +} + static int ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, @@ -5191,19 +5203,10 @@ static Lisp_Object ns_string_to_lispmod (const char *s) static void ns_flush_display (struct frame *f) { - NSAutoreleasePool *ap; - - ap = [[NSAutoreleasePool alloc] init]; - - /* Called from some of the minibuffer code. Run the event loop once - to make the toolkit make changes that were made to the back - buffer visible again. */ - - send_appdefined = YES; - ns_send_appdefined (-1); + struct input_event ie; - [NSApp run]; - [ap release]; + EVENT_INIT (ie); + ns_read_socket_1 (FRAME_TERMINAL (f), &ie, YES); } /* This and next define (many of the) public functions in this @@ -9579,14 +9582,51 @@ - (void) draggedImage: (NSImage *) image selected_op = operation; } +#ifdef NS_IMPL_COCOA +- (void) draggedImage: (NSImage *) dragged_image + movedTo: (NSPoint) screen_point +{ + NSInteger window_number; + NSWindow *w; + + if (dnd_mode == RETURN_FRAME_NEVER) + return; + + window_number = [NSWindow windowNumberAtPoint: [NSEvent mouseLocation] + belowWindowWithWindowNumber: 0]; + w = [NSApp windowWithWindowNumber: window_number]; + + if (!w || w != self) + dnd_mode = RETURN_FRAME_NOW; + + if (dnd_mode != RETURN_FRAME_NOW + || ![[w delegate] isKindOfClass: [EmacsView class]]) + return; + + dnd_return_frame = ((EmacsView *) [w delegate])->emacsframe; + + /* FIXME: there must be a better way to leave the event loop. */ + [NSException raise: @"" + format: @"Must return DND frame"]; +} +#endif + - (NSDragOperation) beginDrag: (NSDragOperation) op forPasteboard: (NSPasteboard *) pasteboard + withMode: (enum ns_return_frame_mode) mode + returnFrameTo: (struct frame **) frame_return { NSImage *image; +#ifdef NS_IMPL_COCOA + NSInteger window_number; + NSWindow *w; +#endif drag_op = op; selected_op = NSDragOperationNone; image = [[NSImage alloc] initWithSize: NSMakeSize (1.0, 1.0)]; + dnd_mode = mode; + dnd_return_frame = NULL; /* Now draw transparency onto the image. */ [image lockFocus]; @@ -9596,18 +9636,47 @@ - (NSDragOperation) beginDrag: (NSDragOperation) op [image unlockFocus]; block_input (); - if (last_drag_event) - [self dragImage: image - at: NSMakePoint (0, 0) - offset: NSMakeSize (0, 0) - event: last_drag_event - pasteboard: pasteboard - source: self - slideBack: NO]; +#ifdef NS_IMPL_COCOA + if (mode == RETURN_FRAME_NOW) + { + window_number = [NSWindow windowNumberAtPoint: [NSEvent mouseLocation] + belowWindowWithWindowNumber: 0]; + w = [NSApp windowWithWindowNumber: window_number]; + + if (w && [[w delegate] isKindOfClass: [EmacsView class]]) + { + *frame_return = ((EmacsView *) [w delegate])->emacsframe; + [image release]; + unblock_input (); + + return NSDragOperationNone; + } + } + + @try + { +#endif + if (last_drag_event) + [self dragImage: image + at: NSMakePoint (0, 0) + offset: NSMakeSize (0, 0) + event: last_drag_event + pasteboard: pasteboard + source: self + slideBack: NO]; +#ifdef NS_IMPL_COCOA + } + @catch (NSException *e) + { + /* Ignore. This is probably the wrong way to leave the + drag-and-drop run loop. */ + } +#endif unblock_input (); [image release]; + *frame_return = dnd_return_frame; return selected_op; } commit 7263b10efbfd2f0478e521173e9d657e080e5cff Author: Po Lu Date: Tue May 31 16:40:57 2022 +0800 Fix autorelease pool "straddling" during DND on NS * src/nsterm.m (ns_mouse_position): Implement `drag-source' on NS. ([EmacsView draggingUpdated:]): Add autorelease pool around callbacks. ([EmacsWindow beginDrag:forPasteboard:]): Block input around dragImage. diff --git a/src/nsterm.m b/src/nsterm.m index 0c83656125..0f1b597457 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2297,6 +2297,11 @@ Hide the window (X11 semantics) struct frame *f = NULL; struct ns_display_info *dpyinfo; bool return_no_frame_flag = false; +#ifdef NS_IMPL_COCOA + NSPoint screen_position; + NSInteger window_number; + NSWindow *w; +#endif NSTRACE ("ns_mouse_position"); @@ -2323,18 +2328,19 @@ Hide the window (X11 semantics) This doesn't work on GNUstep, although in recent versions there is compatibility code that makes it a noop. */ - NSPoint screen_position = [NSEvent mouseLocation]; - NSInteger window_number = 0; + screen_position = [NSEvent mouseLocation]; + window_number = 0; + do { - NSWindow *w; + window_number = [NSWindow windowNumberAtPoint: screen_position + belowWindowWithWindowNumber: window_number]; + w = [NSApp windowWithWindowNumber: window_number]; - window_number = [NSWindow windowNumberAtPoint:screen_position - belowWindowWithWindowNumber:window_number]; - w = [NSApp windowWithWindowNumber:window_number]; - - if (w && [[w delegate] isKindOfClass:[EmacsView class]]) - f = ((EmacsView *)[w delegate])->emacsframe; + if (w && [[w delegate] isKindOfClass: [EmacsView class]]) + f = ((EmacsView *) [w delegate])->emacsframe; + else if (EQ (track_mouse, Qdrag_source)) + break; } while (window_number > 0 && !f); #endif @@ -8623,6 +8629,12 @@ - (NSDragOperation) draggingUpdated: (id ) sender #endif NSPoint position; int x, y; + NSAutoreleasePool *ap; + specpdl_ref count; + + ap = [[NSAutoreleasePool alloc] init]; + count = SPECPDL_INDEX (); + record_unwind_protect_ptr (ns_release_autorelease_pool, ap); #ifdef NS_IMPL_GNUSTEP EVENT_INIT (ie); @@ -8656,6 +8668,7 @@ - (NSDragOperation) draggingUpdated: (id ) sender redisplay (); #endif + unbind_to (count, Qnil); return NSDragOperationGeneric; } @@ -9582,6 +9595,7 @@ - (NSDragOperation) beginDrag: (NSDragOperation) op NSCompositingOperationCopy); [image unlockFocus]; + block_input (); if (last_drag_event) [self dragImage: image at: NSMakePoint (0, 0) @@ -9590,6 +9604,7 @@ - (NSDragOperation) beginDrag: (NSDragOperation) op pasteboard: pasteboard source: self slideBack: NO]; + unblock_input (); [image release]; commit a55a0483c939b7e0cc8b85d96a2fe8ac3fc6fb41 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 in x_get_current_wm_state * src/xterm.c (x_get_current_wm_state): When lint checking, initialize reply_data to a non-null dummy value instead of to a null one. This pacifies GCC 12 -Wanalyzer-null-dereference. diff --git a/src/xterm.c b/src/xterm.c index e9c38ae484..0ebabdccaf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -22468,15 +22468,20 @@ x_get_current_wm_state (struct frame *f, #ifdef USE_XCB xcb_get_property_cookie_t prop_cookie; xcb_get_property_reply_t *prop; - xcb_atom_t *reply_data UNINIT; + typedef xcb_atom_t reply_data_object; #else Display *dpy = FRAME_X_DISPLAY (f); unsigned long bytes_remaining; int rc, actual_format; Atom actual_type; unsigned char *tmp_data = NULL; - Atom *reply_data UNINIT; + typedef Atom reply_data_object; #endif + reply_data_object *reply_data; +# if defined GCC_LINT || defined lint + reply_data_object reply_data_dummy; + reply_data = &reply_data_dummy; +# endif *sticky = false; *size_state = FULLSCREEN_NONE; commit 0614e0f3e9e1b8e10463f6e1e470a82585b2f7c0 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 in dump_queue_enqueue * src/pdumper.c (dump_queue_enqueue): Use BASE_EQ, not EQ. This pacifies GCC 12 -Wanalyzer-null-dereference. diff --git a/src/pdumper.c b/src/pdumper.c index 88e7b311a8..0efd5cfb0b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1069,7 +1069,7 @@ dump_queue_enqueue (struct dump_queue *dump_queue, } } - if (!EQ (weights, orig_weights)) + if (!BASE_EQ (weights, orig_weights)) Fputhash (object, weights, dump_queue->link_weights); } commit 569d4c7ad60ec84e69df02f74e0c013ff83b93c2 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Be more robust if doc file is corrupted * src/doc.c (Fsnarf_documentation): Don’t dump core on a corrupted doc file. Problem found by GCC 12 -Wanalyzer-null-argument. diff --git a/src/doc.c b/src/doc.c index 71e66853b0..14db3189f3 100644 --- a/src/doc.c +++ b/src/doc.c @@ -569,6 +569,8 @@ the same file name is found in the `doc-directory'. */) if (p) { end = strchr (p, '\n'); + if (!end) + error ("DOC file invalid at position %"pI"d", pos); /* We used to skip files not in build_files, so that when a function was defined several times in different files commit c4da5db04ba611b9a646c325e0e6eee165834f7a Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 in Fmove_overlay * src/buffer.c (Fmove_overlay): Use BASE_EQ, not EQ. This pacifies GCC 12 -Wanalyzer-null-dereference. diff --git a/src/buffer.c b/src/buffer.c index 548d7b1c65..d2b2f25575 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4107,7 +4107,7 @@ buffer. */) n_end = marker_position (OVERLAY_END (overlay)); /* If the overlay has changed buffers, do a thorough redisplay. */ - if (!EQ (buffer, obuffer)) + if (!BASE_EQ (buffer, obuffer)) { /* Redisplay where the overlay was. */ if (ob) commit 1f6973241a57b24818126f513ec753772468c757 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 in Fx_show_tip * src/xfns.c (Fx_show_tip): Use BASE_EQ, not EQ. This pacifies GCC 12 -Wanalyzer-null-dereference. diff --git a/src/xfns.c b/src/xfns.c index 259034861a..d696078440 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8487,7 +8487,7 @@ Text larger than the specified size is clipped. */) if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) { if (FRAME_VISIBLE_P (XFRAME (tip_frame)) - && EQ (frame, tip_last_frame) + && BASE_EQ (frame, tip_last_frame) && !NILP (Fequal_including_properties (tip_last_string, string)) && !NILP (Fequal (tip_last_parms, parms))) { @@ -8508,7 +8508,7 @@ Text larger than the specified size is clipped. */) goto start_timer; } - else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame)) { bool delete = false; Lisp_Object tail, elt, parm, last; commit 920f1e68b868537d64b28e7623e428338357bfbc Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 in xrdb.c * src/xrdb.c (x_get_resource): Simply assign the return value. This pacifies GCC 12 -Wanalyzer-use-of-uninitialized-value. diff --git a/src/xrdb.c b/src/xrdb.c index aa79d719c8..faeea04a53 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -486,11 +486,7 @@ x_get_resource (XrmDatabase rdb, const char *name, const char *class, if (XrmQGetResource (rdb, namelist, classlist, &type, &value) == True && (type == expected_type)) { - if (type == x_rm_string) - ret_value->addr = (char *) value.addr; - else - memcpy (ret_value->addr, value.addr, ret_value->size); - + *ret_value = value; return value.size; } commit 13dac6f3e95f951d7174d727cc88c7e7bf24ac8c Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 false positive in ccl.c * src/ccl.c: Suppress -Wanalyzer-use-of-uninitialized-value in GCC 12 or later. diff --git a/src/ccl.c b/src/ccl.c index a3121f7278..1a4f73500a 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -35,6 +35,11 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "keyboard.h" +/* Avoid GCC 12 bug . */ +#if GNUC_PREREQ (12, 0, 0) +# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value" +#endif + /* Table of registered CCL programs. Each element is a vector of NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the name of the program, CCL_PROG (vector) is the compiled code of the commit 30966a6e67ff5b599a2906b9e336ab5744786f06 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Simplify CHAR_TABLE_REF_ASCII * src/lisp.h (CHAR_TABLE_REF_ASCII): Refactor as a straightforward for-loop. Redo an if-then-else to be an (!if)-else-then as this is a bit cleaner, and it also works around GCC bug 105755. diff --git a/src/lisp.h b/src/lisp.h index 3578ca57b4..ff6f0aaf54 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2091,19 +2091,17 @@ XSUB_CHAR_TABLE (Lisp_Object a) INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) { - struct Lisp_Char_Table *tbl = NULL; - Lisp_Object val; - do + for (struct Lisp_Char_Table *tbl = XCHAR_TABLE (ct); ; + tbl = XCHAR_TABLE (tbl->parent)) { - tbl = tbl ? XCHAR_TABLE (tbl->parent) : XCHAR_TABLE (ct); - val = (! SUB_CHAR_TABLE_P (tbl->ascii) ? tbl->ascii - : XSUB_CHAR_TABLE (tbl->ascii)->contents[idx]); + Lisp_Object val = (SUB_CHAR_TABLE_P (tbl->ascii) + ? XSUB_CHAR_TABLE (tbl->ascii)->contents[idx] + : tbl->ascii); if (NILP (val)) val = tbl->defalt; + if (!NILP (val) || NILP (tbl->parent)) + return val; } - while (NILP (val) && ! NILP (tbl->parent)); - - return val; } /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII commit 82c05c034e1ecec49e4e8916b2cb6163d7a5bb74 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Avoid undefined behavior in detect_coding routines * src/coding.c (detect_coding): Always initialize all components of detect_info, so that detect_coding_utf_8 etc. do not have undefined behavior when they read detect_info.checked. This bug is not likely to cause problems on real systems. Problem found by GCC 12 -fanalyzer. (detect_coding_system): Use consistent style with detect_coding initialization. diff --git a/src/coding.c b/src/coding.c index 2bed293d57..aa32efc3f6 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6528,7 +6528,7 @@ detect_coding (struct coding_system *coding) if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided)) { int c, i; - struct coding_detection_info detect_info; + struct coding_detection_info detect_info = {0}; bool null_byte_found = 0, eight_bit_found = 0; bool inhibit_nbd = inhibit_flag (coding->spec.undecided.inhibit_nbd, inhibit_null_byte_detection); @@ -6537,7 +6537,6 @@ detect_coding (struct coding_system *coding) bool prefer_utf_8 = coding->spec.undecided.prefer_utf_8; coding->head_ascii = 0; - detect_info.checked = detect_info.found = detect_info.rejected = 0; for (src = coding->source; src < src_end; src++) { c = *src; @@ -6712,12 +6711,8 @@ detect_coding (struct coding_system *coding) else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_8_auto) { - Lisp_Object coding_systems; - struct coding_detection_info detect_info; - - coding_systems + Lisp_Object coding_systems = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom); - detect_info.found = detect_info.rejected = 0; if (check_ascii (coding) == coding->src_bytes) { if (CONSP (coding_systems)) @@ -6725,6 +6720,7 @@ detect_coding (struct coding_system *coding) } else { + struct coding_detection_info detect_info = {0}; if (CONSP (coding_systems) && detect_coding_utf_8 (coding, &detect_info)) { @@ -6738,20 +6734,19 @@ detect_coding (struct coding_system *coding) else if (XFIXNUM (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) == coding_category_utf_16_auto) { - Lisp_Object coding_systems; - struct coding_detection_info detect_info; - - coding_systems + Lisp_Object coding_systems = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom); - detect_info.found = detect_info.rejected = 0; coding->head_ascii = 0; - if (CONSP (coding_systems) - && detect_coding_utf_16 (coding, &detect_info)) + if (CONSP (coding_systems)) { - if (detect_info.found & CATEGORY_MASK_UTF_16_LE) - found = XCAR (coding_systems); - else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) - found = XCDR (coding_systems); + struct coding_detection_info detect_info = {0}; + if (detect_coding_utf_16 (coding, &detect_info)) + { + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + found = XCAR (coding_systems); + else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) + found = XCDR (coding_systems); + } } } @@ -8639,7 +8634,7 @@ detect_coding_system (const unsigned char *src, Lisp_Object val = Qnil; struct coding_system coding; ptrdiff_t id; - struct coding_detection_info detect_info; + struct coding_detection_info detect_info = {0}; enum coding_category base_category; bool null_byte_found = 0, eight_bit_found = 0; @@ -8658,8 +8653,6 @@ detect_coding_system (const unsigned char *src, coding.mode |= CODING_MODE_LAST_BLOCK; coding.head_ascii = 0; - detect_info.checked = detect_info.found = detect_info.rejected = 0; - /* At first, detect text-format if necessary. */ base_category = XFIXNUM (CODING_ATTR_CATEGORY (attrs)); if (base_category == coding_category_undecided) commit 877be9098ee3ecc041216d39dbb20d0d044a46c0 Author: Paul Eggert Date: Tue May 31 01:19:32 2022 -0700 Pacify GCC 12 -fanalyzer in x_popup_menu_1 * src/menu.c (x_popup_menu_1): Rework to avoid unnecessary initialization and test. This also pacifies GCC 12. diff --git a/src/menu.c b/src/menu.c index 398bf9329f..eeb0c9a7e5 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1118,7 +1118,7 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) Lisp_Object title; const char *error_name = NULL; Lisp_Object selection = Qnil; - struct frame *f = NULL; + struct frame *f; Lisp_Object x, y, window; int menuflags = 0; specpdl_ref specpdl_count = SPECPDL_INDEX (); @@ -1269,9 +1269,9 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) } } else - /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, + /* ??? Not really clean; should be Qwindow_or_framep but I don't want to make one now. */ - CHECK_WINDOW (window); + wrong_type_argument (Qwindowp, window); xpos += check_integer_range (x, (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM commit a1c19dfca4b1e0b84a958aee33c8212dc69cd2cb Author: Paul Eggert Date: Tue May 31 01:19:31 2022 -0700 Pacify GCC 12 -Wanalyzer-use-of-uninitialized-value * lib-src/etags.c (readline_internal): Do not copy a pointer to freed storage, as that has undefined behavior even if the pointer is not dereferenced. (relative_filename): Avoid a backward scan by remembering where the last slash was. This is a bit faster, and pacifies a GCC false alarm. diff --git a/lib-src/etags.c b/lib-src/etags.c index ea99ed9f39..f76dda7936 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -7248,8 +7248,8 @@ readline_internal (linebuffer *lbp, FILE *stream, char const *filename) { /* We're at the end of linebuffer: expand it. */ xrnew (buffer, lbp->size, 2); + p = buffer + lbp->size; lbp->size *= 2; - p += buffer - lbp->buffer; pend = buffer + lbp->size; lbp->buffer = buffer; } @@ -7670,21 +7670,21 @@ relative_filename (char *file, char *dir) { char *fp, *dp, *afn, *res; ptrdiff_t i; + char *dir_last_slash UNINIT; /* Find the common root of file and dir (with a trailing slash). */ afn = absolute_filename (file, cwd); fp = afn; dp = dir; while (*fp++ == *dp++) - continue; - fp--, dp--; /* back to the first differing char */ + if (dp[-1] == '/') + dir_last_slash = dp - 1; #ifdef DOS_NT - if (fp == afn && afn[0] != '/') /* cannot build a relative name */ - return afn; + if (fp - 1 == afn && afn[0] != '/') + return afn; /* Cannot build a relative name. */ #endif - do /* look at the equal chars until '/' */ - fp--, dp--; - while (*fp != '/'); + fp -= dp - dir_last_slash; + dp = dir_last_slash; /* Build a sequence of "../" strings for the resulting relative file name. */ i = 0; commit d94890404e91d5ba50afaa4bc27b9c655dbed5f1 Author: Po Lu Date: Tue May 31 16:25:20 2022 +0800 Fix crashes displaying menu help text on NS * src/nsterm.m (ns_flush_display): Run event loop manually, avoiding a double free of an autorelease pool. diff --git a/src/nsterm.m b/src/nsterm.m index 3d2b4116ca..0c83656125 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5185,14 +5185,19 @@ static Lisp_Object ns_string_to_lispmod (const char *s) static void ns_flush_display (struct frame *f) { - struct input_event ie; + NSAutoreleasePool *ap; + + ap = [[NSAutoreleasePool alloc] init]; /* Called from some of the minibuffer code. Run the event loop once to make the toolkit make changes that were made to the back - buffer visible again. TODO: what should happen to ie? */ + buffer visible again. */ - EVENT_INIT (ie); - ns_read_socket (FRAME_TERMINAL (f), &ie); + send_appdefined = YES; + ns_send_appdefined (-1); + + [NSApp run]; + [ap release]; } /* This and next define (many of the) public functions in this