commit 48e8569c8772ed4cb2af299e353e7376606992be (HEAD, refs/remotes/origin/master) Author: Andrew G Cohen Date: Fri Feb 11 15:09:46 2022 +0800 Allow searching of nnselect (search) groups * lisp/gnus/gnus-group.el (gnus-group-make-search-group): (gnus-group-read-ephemeral-search-group): Ensure the server is correctly identified even for nnselect groups. * lisp/gnus/gnus-search.el (gnus-search-nnselect): New function. (gnus-search-default-engines): Use it. (gnus-search-make-spec): Queries from nnselect should always be raw. * lisp/gnus/nnselect.el (gnus-search): Silence the byte-compiler. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8937df2601..e59a972350 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3226,7 +3226,8 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) (gnus-method-to-server + (gnus-find-method-for-group elt))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) @@ -3277,7 +3278,8 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) (gnus-method-to-server + (gnus-find-method-for-group elt))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index bf88abae76..4babe9f96f 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -762,6 +762,9 @@ the files in ARTLIST by that search key.") (generate-new-buffer " *gnus-search-"))) (cl-call-next-method engine slots)) +(defclass gnus-search-nnselect (gnus-search-engine) + nil) + (defclass gnus-search-imap (gnus-search-engine) ((literal-plus :initarg :literal-plus @@ -907,13 +910,15 @@ quirks.") (define-obsolete-variable-alias 'nnir-method-default-engines 'gnus-search-default-engines "28.1") -(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)) +(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap) + (nnselect . gnus-search-nnselect)) "Alist of default search engines keyed by server method." :version "26.1" :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) - (const nnfolder) (const nnmaildir)) + (const nnfolder) (const nnmaildir) + (const nnselect)) (choice ,@(mapcar (lambda (el) (list 'const (intern (car el)))) @@ -1010,6 +1015,33 @@ Responsible for handling and, or, and parenthetical expressions.") unseen all old new or not) "Known IMAP search keys.") +(autoload 'nnselect-categorize "nnselect") +(autoload 'nnselect-get-artlist "nnselect" nil nil 'macro) +(autoload 'ids-by-group "nnselect") +;; nnselect interface +(cl-defmethod gnus-search-run-search ((_engine gnus-search-nnselect) + _srv query-spec groups) + (let ((artlist [])) + (dolist (group groups) + (let* ((gnus-newsgroup-selection (nnselect-get-artlist group)) + (group-spec + (nnselect-categorize + (mapcar 'car + (ids-by-group + (number-sequence 1 + (length gnus-newsgroup-selection)))) + (lambda (x) + (gnus-group-server x))))) + (setq artlist + (vconcat artlist + (seq-intersection + gnus-newsgroup-selection + (gnus-search-run-query + (list (cons 'search-query-spec query-spec) + (cons 'search-group-spec group-spec)))))))) + artlist)) + + ;; imap interface (cl-defmethod gnus-search-run-search ((engine gnus-search-imap) srv query groups) @@ -2155,7 +2187,8 @@ article came from is also searched." (read-from-minibuffer "Query: " nil gnus-search-minibuffer-map nil 'gnus-search-history))) - (cons 'raw arg))) + (cons 'raw + (or (gnus-nnselect-group-p (gnus-group-group-name)) arg)))) (provide 'gnus-search) ;;; gnus-search.el ends here diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index f8a0c33d4e..f5be477d26 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -47,7 +47,8 @@ ;;; Setup: (require 'gnus-art) -(require 'gnus-search) +(autoload 'gnus-search-run-query "gnus-search") +(autoload 'gnus-search-server-to-engine "gnus-search") (eval-when-compile (require 'cl-lib)) commit 20da50619fd5b65e6d0c18c48d10ab1ec9067b63 Author: Po Lu Date: Fri Feb 11 14:46:25 2022 +0800 * etc/PROBLEMS: Document some limitations of Xwayland and PGTK. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 7c8c364c56..4e4ec6d353 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1768,7 +1768,16 @@ If setting GDK_DEBUG causes GTK to complain about not being built with support for debugging options, then there is nothing you can do, except switch to a free X server. -* Runtime problems on character terminals +*** 'set-mouse-position' does not move the pointer on Xwayland. + +This is because Wayland does not allow programs to warp the pointer. +There is nothing that can be done about this problem, except to switch +to an X session. + +Some versions of the Xwayland server will pretend to warp the pointer, +so mouse-motion events might be sent to the position the mouse was +supposed to have moved to, even though the cursor displays at the same +on-screen position. *** With X forwarding, mouse highlighting can make Emacs slow. @@ -1777,6 +1786,8 @@ remote X server, try this: (setq mouse-highlight nil) +* Runtime problems on character terminals + ** The meta key does not work on xterm. Typing M-x rings the terminal bell, and inserts a string like ";120~". @@ -2896,6 +2907,11 @@ when started from the command line. Especially, PGTK Emacs needs environment variables LANG and GTK_IM_MODULE. +** 'set-mouse-position' does nothing. + +GTK does not allow programs to warp the pointer anymore. There is +nothing that can be done about this problem. + * Build-time problems ** Configuration commit a9d54814b7337c78df8fae69895d1f0554517c43 Author: Po Lu Date: Fri Feb 11 13:59:03 2022 +0800 Don't make cursors affected by background alpha on PGTK * src/ftcrfont.c (ftcrfont_draw): * src/pgtkterm.c (x_clear_glyph_string_rect): Make behavior on PGTK consistent with X. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 4d1ecee378..98a28af5f2 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -568,7 +568,8 @@ ftcrfont_draw (struct glyph_string *s, #ifdef HAVE_X_WINDOWS x_set_cr_source_with_gc_background (f, s->gc, s->hl != DRAW_CURSOR); #else - pgtk_set_cr_source_with_color (f, s->xgcv.background, true); + pgtk_set_cr_source_with_color (f, s->xgcv.background, + s->hl != DRAW_CURSOR); #endif #else uint32_t col = be_background; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 8faffe94d4..43c475f2a7 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -1197,7 +1197,9 @@ pgtk_compute_glyph_string_overhangs (struct glyph_string *s) static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { - pgtk_fill_rectangle (s->f, s->xgcv.background, x, y, w, h, true); + pgtk_fill_rectangle (s->f, s->xgcv.background, x, y, w, h, + (s->first_glyph->type != STRETCH_GLYPH + || s->hl != DRAW_CURSOR)); } commit 9fdc0f08ce69ae0a41f75b10067c29492472f6a6 Author: Po Lu Date: Fri Feb 11 13:44:42 2022 +0800 Set _NET_WM_OPAQUE_REGION on non-GTK3 toolkits when using 32 bit visual * src/xfns.c (x_set_alpha_background): Set opaque region if opaque. * src/xterm.c (x_update_opaque_region): New parameter `configure'. All callers changed. (handle_one_xevent): Call `x_update_opaque_region' on configure events. diff --git a/src/xfns.c b/src/xfns.c index 7d91f32ad4..849fa72f39 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -730,6 +730,11 @@ x_set_wait_for_wm (struct frame *f, Lisp_Object new_value, Lisp_Object old_value static void x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)}; +#endif + gui_set_alpha_background (f, arg, oldval); #ifdef USE_GTK @@ -749,6 +754,14 @@ x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) XA_CARDINAL, 32, PropModeReplace, NULL, 0); } +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif } static void diff --git a/src/xterm.c b/src/xterm.c index 66666229cd..e7736f741a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -345,7 +345,7 @@ static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t); static void x_initialize (void); static bool x_get_current_wm_state (struct frame *, Window, int *, bool *); -static void x_update_opaque_region (struct frame *); +static void x_update_opaque_region (struct frame *, XEvent *); /* Flush display of frame F. */ @@ -366,7 +366,6 @@ x_flush (struct frame *f) static void x_drop_xrender_surfaces (struct frame *f) { - x_update_opaque_region (f); font_drop_xrender_surfaces (f); #ifdef HAVE_XRENDER @@ -440,14 +439,37 @@ record_event (char *locus, int type) #endif static void -x_update_opaque_region (struct frame *f) +x_update_opaque_region (struct frame *f, XEvent *configure) { +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, + (configure + ? configure->xconfigure.width + : FRAME_PIXEL_WIDTH (f)), + (configure + ? configure->xconfigure.height + : FRAME_PIXEL_HEIGHT (f))}; +#endif + + if (!FRAME_DISPLAY_INFO (f)->alpha_bits) + return; + + block_input (); if (f->alpha_background < 1.0) XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, XA_CARDINAL, 32, PropModeReplace, NULL, 0); +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif + unblock_input (); } @@ -9712,7 +9734,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, f->output_data.x->has_been_visible = true; } - x_update_opaque_region (f); + x_update_opaque_region (f, NULL); if (not_hidden && iconified) { @@ -10350,6 +10372,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (any, configureEvent.xconfigure.width, configureEvent.xconfigure.height); + x_update_opaque_region (f, &configureEvent); #endif #ifdef USE_GTK if (!f @@ -10378,6 +10401,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); #endif + x_update_opaque_region (f, &configureEvent); f = 0; } #endif commit 2d5b2192398c6ddda15a50a3057832f80ee4a00f Author: Po Lu Date: Fri Feb 11 13:30:11 2022 +0800 Fix fallout from switch to 32-bit visuals * src/xfns.c (x_decode_color): Make return type wide enough to hold any pixel value. * src/xterm.h (x_make_truecolor_pixel): Simplify. diff --git a/src/xfns.c b/src/xfns.c index 58f5cb847b..7d91f32ad4 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -687,7 +687,7 @@ x_defined_color (struct frame *f, const char *color_name, is a monochrome frame, return MONO_COLOR regardless of what ARG says. Signal an error if color can't be allocated. */ -static int +static unsigned long x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color) { XColor cdef; diff --git a/src/xterm.h b/src/xterm.h index afd6a1757c..3a69c02879 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1307,7 +1307,7 @@ x_display_pixel_width (struct x_display_info *dpyinfo) INLINE unsigned long x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) { - unsigned long pr, pg, pb, pa = 0; + unsigned long pr, pg, pb, pa = dpyinfo->alpha_mask; /* Scale down RGB values to the visual's bits per RGB, and shift them to the right position in the pixel color. Note that the @@ -1316,12 +1316,6 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset; pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset; - if (dpyinfo->alpha_bits) - pa = (((unsigned long) 0xffff >> (16 - dpyinfo->alpha_bits)) - << dpyinfo->alpha_offset); - else - pa = 0; - /* Assemble the pixel color. */ return pr | pg | pb | pa; } commit c7bde988068786a5e6e00d91cf3165b8a3ce0fde Author: Po Lu Date: Fri Feb 11 02:37:38 2022 +0000 Improve reliability of selection ownership on Haiku * src/haiku_select.cc (count_clipboard, count_primary) (count_secondary): Initialize to -1 (BClipboard_set_system_data) (BClipboard_set_primary_selection_data) (BClipboard_set_secondary_selection_data): Store count before saving to the the clipboard. (BClipboard_owns_clipboard, BClipboard_owns_primary) (BClipboard_owns_secondary): Adjust tests accordingly. diff --git a/src/haiku_select.cc b/src/haiku_select.cc index d39000d8bb..011ad58036 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -29,9 +29,9 @@ along with GNU Emacs. If not, see . */ static BClipboard *primary = NULL; static BClipboard *secondary = NULL; static BClipboard *system_clipboard = NULL; -static unsigned long count_clipboard = 0; -static unsigned long count_primary = 0; -static unsigned long count_secondary = 0; +static int64 count_clipboard = -1; +static int64 count_primary = -1; +static int64 count_secondary = -1; int selection_state_flag; @@ -176,8 +176,8 @@ BClipboard_set_system_data (const char *type, const char *data, if (!system_clipboard) return; - BClipboard_set_data (system_clipboard, type, data, len, clear); count_clipboard = system_clipboard->SystemCount (); + BClipboard_set_data (system_clipboard, type, data, len, clear); } void @@ -187,8 +187,8 @@ BClipboard_set_primary_selection_data (const char *type, const char *data, if (!primary) return; - BClipboard_set_data (primary, type, data, len, clear); count_primary = primary->SystemCount (); + BClipboard_set_data (primary, type, data, len, clear); } void @@ -198,8 +198,8 @@ BClipboard_set_secondary_selection_data (const char *type, const char *data, if (!secondary) return; - BClipboard_set_data (secondary, type, data, len, clear); count_secondary = secondary->SystemCount (); + BClipboard_set_data (secondary, type, data, len, clear); } void @@ -229,22 +229,25 @@ BClipboard_secondary_targets (char **buf, int len) bool BClipboard_owns_clipboard (void) { - return (count_clipboard - == system_clipboard->SystemCount ()); + return (count_clipboard >= 0 + && (count_clipboard + 1 + == system_clipboard->SystemCount ())); } bool BClipboard_owns_primary (void) { - return (count_primary - == primary->SystemCount ()); + return (count_primary >= 0 + && (count_primary + 1 + == primary->SystemCount ())); } bool BClipboard_owns_secondary (void) { - return (count_secondary - == secondary->SystemCount ()); + return (count_secondary >= 0 + && (count_secondary + 1 + == secondary->SystemCount ())); } void commit 2469e036035f8f5baa78e1557c61df019d8fd572 Author: Po Lu Date: Fri Feb 11 09:26:45 2022 +0800 Disable nearest-color allocation on DirectColor visuals * src/xterm.c (x_alloc_nearest_color_1): Disable such allocation on DirectColor. The method we use can't possibly work there. diff --git a/src/xterm.c b/src/xterm.c index 095ed316cf..66666229cd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3193,9 +3193,15 @@ x_parse_color (struct frame *f, const char *color_name, static bool x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) { + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); bool rc; + eassume (dpyinfo); rc = XAllocColor (dpy, cmap, color) != 0; + + if (dpyinfo->visual->class == DirectColor) + return rc; + if (rc == 0) { /* If we got to this point, the colormap is full, so we're going commit 26eeca71fbb3ee76ad51d3b83b79992f165e5f06 Author: Mattias Engdegård Date: Thu Feb 10 22:59:26 2022 +0100 Silence macOS vfork deprecation warnings The vfork system call exists and works in macOS 11.6 but the compiler gives a deprecation message; silence it, because the performance is still better than that of plain fork. See discussion at https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00260.html * src/conf_post.h (VFORK): New #define. * src/callproc.c (emacs_spawn): * src/sysdep.c (sys_subshell): Use it. diff --git a/src/callproc.c b/src/callproc.c index 4d3b0bb8e0..dcee740043 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1500,7 +1500,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, if (pty != NULL) pid = fork (); else - pid = vfork (); + pid = VFORK (); #else pid = vfork (); #endif diff --git a/src/conf_post.h b/src/conf_post.h index 6db76a2dfa..0b6260b287 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -353,6 +353,19 @@ extern int emacs_setenv_TZ (char const *); # define vfork fork #endif +/* vfork is deprecated on at least macOS 11.6 and later, but it still works + and is faster than fork, so silence the warning as if we knew what we + are doing. */ +#ifdef DARWIN_OS +#define VFORK() \ + (_Pragma("clang diagnostic push") \ + _Pragma("clang diagnostic ignored \"-Wdeprecated-declarations\"") \ + vfork () \ + _Pragma("clang diagnostic pop")) +#else +#define VFORK() vfork () +#endif + #if ! (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) # undef PROFILING #endif diff --git a/src/sysdep.c b/src/sysdep.c index d682e87cc7..c772aff6a0 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -664,7 +664,7 @@ sys_subshell (void) #else { char *volatile str_volatile = str; - pid = vfork (); + pid = VFORK (); str = str_volatile; } #endif commit 437382734a53e8fb311938d5dd8a39508e60b9bf Author: Juri Linkov Date: Thu Feb 10 20:57:42 2022 +0200 * lisp/mouse.el (context-menu-map): Select only unselected window (bug#53910) diff --git a/lisp/mouse.el b/lisp/mouse.el index acaf6611af..1e205283de 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -321,10 +321,12 @@ At the end, it's possible to modify the final menu by specifying the function `context-menu-filter-function'." (let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))) (click (or click last-input-event)) + (window (posn-window (event-start click))) (fun (mouse-posn-property (event-start click) 'context-menu-function))) - (select-window (posn-window (event-start click))) + (unless (eq (selected-window) window) + (select-window window)) (if (functionp fun) (setq menu (funcall fun menu click)) commit a6df8f9f990e2553e9b85b273395a4142a427bf8 Author: Juri Linkov Date: Thu Feb 10 20:52:55 2022 +0200 * lisp/tab-line.el (tab-line-format): Use mode-line-window-selected-p. Recently 'mode-line-window-selected-p' was added to 'tab-line-tab-name-format-default'. Now add the same to another place that handles the face 'tab-line-tab-current' (bug#53629). diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 4d9b5e0ab7..80b0aabd77 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -591,7 +591,7 @@ For use in `tab-line-tab-face-functions'." ;; handle tab-line scrolling (window-parameter nil 'tab-line-hscroll) ;; for setting face 'tab-line-tab-current' - (eq (selected-window) (old-selected-window)) + (mode-line-window-selected-p) (and (memq 'tab-line-tab-face-modified tab-line-tab-face-functions) (buffer-file-name) (buffer-modified-p)))) commit 64d211179db9de955a793a158bc969d9ca568712 Author: Corwin Brust Date: Tue Feb 8 17:48:14 2022 -0600 Autoload package-installed-p * lisp/emacs-lisp/package.el (package-installed-p): Add autoload cookie. (Bug#53885) Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2e01449613..6aa82e576d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2040,6 +2040,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." package-alist)))) (setf (package-desc-signed (car pkg-descs)) t)))))))))) +;;;###autoload (defun package-installed-p (package &optional min-version) "Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. If PACKAGE is a symbol, it is the package name and MIN-VERSION commit 2d897f7c6691b3f72ce43ae1827307653ed9fc0b Merge: 6548286446 c30106ce9f Author: Eli Zaretskii Date: Thu Feb 10 19:12:19 2022 +0200 Merge from origin/emacs-28 # Conflicts: # lisp/startup.el commit c30106ce9f713edea173cbb301747cbbe3766257 (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Thu Feb 10 19:05:41 2022 +0200 ; * lisp/startup.el (normal-top-level): Fix byte-compilation warning. diff --git a/lisp/startup.el b/lisp/startup.el index 59fe5428b7..d369f3ef84 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -520,6 +520,9 @@ DIRS are relative." (t emacs-d-dir)))) (defvar native-comp-eln-load-path) +(defvar native-comp-deferred-compilation) +(defvar comp-enable-subr-trampolines) + (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -540,7 +543,8 @@ It is the default value of the variable `top-level'." (unless (native-comp-available-p) ;; Disable deferred async compilation and trampoline synthesis ;; in this session. This is necessary if libgccjit is not - ;; available on MS-Windows. + ;; available on MS-Windows, but Emacs was built with + ;; native-compilation support. (setq native-comp-deferred-compilation nil comp-enable-subr-trampolines nil)) commit 65482864460677b74ec7a4609df14289393c1d22 Author: Alan Mackenzie Date: Thu Feb 10 17:03:50 2022 +0000 Note current buffer and restore it in c-force-redisplay. This fixes bug #52709. * lisp/progmodes/cc-fonts.el (c-force-redisplay): New parameter BUFFER. Set current buffer to this before fontifying. (c-fontify-new-found-type): Give the current buffer as argument to run-with-timer. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 230d39efee..15e3beb837 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2253,12 +2253,13 @@ higher." ;; redisplay. (defvar c-re-redisplay-timer nil) -(defun c-force-redisplay (start end) +(defun c-force-redisplay (buffer start end) ;; Force redisplay immediately. This assumes `font-lock-support-mode' is ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. - (save-excursion (c-font-lock-fontify-region start end)) - (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) - (setq c-re-redisplay-timer nil)) + (with-current-buffer buffer + (save-excursion (c-font-lock-fontify-region start end)) + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil))) (defun c-fontify-new-found-type (type) ;; Cause the fontification of TYPE, a string, wherever it occurs in the @@ -2288,6 +2289,7 @@ higher." (not c-re-redisplay-timer)) (setq c-re-redisplay-timer (run-with-timer 0 nil #'c-force-redisplay + (current-buffer) (match-beginning 0) (match-end 0))))))))))) commit d64a1f7251e271074a1ab43fa548ef245142640a Author: Lars Ingebrigtsen Date: Thu Feb 10 15:13:21 2022 +0100 Restore command-line--load-script messaging * lisp/startup.el (command-line--load-script): Restore previous non-messaging behaviour. diff --git a/lisp/startup.el b/lisp/startup.el index 8b059e756d..053afa104d 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2840,7 +2840,7 @@ nil default-directory" name) (defun command-line--load-script (file) (load-with-code-conversion - file file nil nil + file file nil t (lambda (buffer file) (with-current-buffer buffer (goto-char (point-min)) commit 202d3be8734343e6e4fb3eafeb5e2521365dd204 Author: Andrea Corallo Date: Thu Feb 10 09:46:31 2022 +0100 * lisp/startup.el (normal-top-level): Disable native-comp if not available diff --git a/lisp/startup.el b/lisp/startup.el index 71e492e3b4..59fe5428b7 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -537,6 +537,13 @@ It is the default value of the variable `top-level'." (setq user-emacs-directory (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) + (unless (native-comp-available-p) + ;; Disable deferred async compilation and trampoline synthesis + ;; in this session. This is necessary if libgccjit is not + ;; available on MS-Windows. + (setq native-comp-deferred-compilation nil + comp-enable-subr-trampolines nil)) + (when (featurep 'native-compile) ;; Form `native-comp-eln-load-path'. (let ((path-env (getenv "EMACSNATIVELOADPATH"))) commit 8ababad570e438d1cca88dc9afb6eb0e342483b6 Author: Michael Albinus Date: Thu Feb 10 14:14:06 2022 +0100 Improve handling of file modes in Tramp * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-get-remote-uid) (tramp-gvfs-handle-get-remote-gid): Do not assume that the default location is owned be the remote uid/gid. (tramp-gvfs-handle-file-executable-p): * lisp/net/tramp-sh.el (tramp-sh-handle-file-executable-p): Check also for setuid/setgid bit. * lisp/net/tramp.el (tramp-check-cached-permissions): Check also for ?s access type. Check whether remote uid/gid are unknown. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d3af9f4769..d3634b0cc2 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1385,7 +1385,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-executable-p" - (tramp-check-cached-permissions v ?x)))) + (or (tramp-check-cached-permissions v ?x) + (tramp-check-cached-permissions v ?s))))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -1603,8 +1604,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-file-name-user vec) (when-let ((localname (tramp-get-connection-property - (tramp-get-process vec) "share" - (tramp-get-connection-property vec "default-location" nil)))) + (tramp-get-process vec) "share" nil))) (file-attribute-user-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format))))) @@ -1613,8 +1613,7 @@ ID-FORMAT valid values are `string' and `integer'." ID-FORMAT valid values are `string' and `integer'." (when-let ((localname (tramp-get-connection-property - (tramp-get-process vec) "share" - (tramp-get-connection-property vec "default-location" nil)))) + (tramp-get-process vec) "share" nil))) (file-attribute-group-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 98192bd96d..ea089224ae 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1585,6 +1585,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?x) + (tramp-check-cached-permissions v ?s) (tramp-run-test "-x" filename))))) (defun tramp-sh-handle-file-readable-p (filename) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1b5de46016..f93ca7601a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5402,7 +5402,8 @@ be granted." (offset (cond ((eq ?r access) 1) ((eq ?w access) 2) - ((eq ?x access) 3)))) + ((eq ?x access) 3) + ((eq ?s access) 3)))) (dolist (suffix '("string" "integer") result) (setq result @@ -5432,13 +5433,15 @@ be granted." ;; User accessible and owned by user. (and (eq access (aref (file-attribute-modes file-attr) offset)) - (or (equal remote-uid (file-attribute-user-id file-attr)) + (or (equal remote-uid unknown-id) + (equal remote-uid (file-attribute-user-id file-attr)) (equal unknown-id (file-attribute-user-id file-attr)))) ;; Group accessible and owned by user's principal group. (and (eq access (aref (file-attribute-modes file-attr) (+ offset 3))) - (or (equal remote-gid (file-attribute-group-id file-attr)) + (or (equal remote-gid unknown-id) + (equal remote-gid (file-attribute-group-id file-attr)) (equal unknown-id (file-attribute-group-id file-attr)))))))))))) (defun tramp-get-remote-uid (vec id-format) commit 53da8c50fca98b5a7d0418f6030181df50af8876 Author: Lars Ingebrigtsen Date: Thu Feb 10 13:44:55 2022 +0100 Don't signal a backtrace on empty --script files * lisp/startup.el (command-line--load-script): New function that avoids erroring out if it turns out there's no forms in the buffer (bug#4616). * lisp/subr.el (delete-line): New utility function. * lisp/international/mule.el (load-with-code-conversion): Accept an eval function. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 0758359e15..1596cdb481 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -298,13 +298,21 @@ attribute." (defvar hack-read-symbol-shorthands-function nil "Holds function to compute `read-symbol-shorthands'.") -(defun load-with-code-conversion (fullname file &optional noerror nomessage) +(defun load-with-code-conversion (fullname file &optional noerror nomessage + eval-function) "Execute a file of Lisp code named FILE whose absolute name is FULLNAME. The file contents are decoded before evaluation if necessary. -If optional third arg NOERROR is non-nil, - report no error if FILE doesn't exist. -Print messages at start and end of loading unless - optional fourth arg NOMESSAGE is non-nil. + +If optional third arg NOERROR is non-nil, report no error if FILE +doesn't exist. + +Print messages at start and end of loading unless optional fourth +arg NOMESSAGE is non-nil. + +If EVAL-FUNCTION, call that instead of calling `eval-buffer' +directly. It is called with two paramameters: The buffer object +and the file name. + Return t if file exists." (if (null (file-readable-p fullname)) (and (null noerror) @@ -353,10 +361,13 @@ Return t if file exists." ;; Have the original buffer current while we eval, ;; but consider shorthands of the eval'ed one. (let ((read-symbol-shorthands shorthands)) - (eval-buffer buffer nil - ;; This is compatible with what `load' does. - (if dump-mode file fullname) - nil t))) + (if eval-function + (funcall eval-function buffer + (if dump-mode file fullname)) + (eval-buffer buffer nil + ;; This is compatible with what `load' does. + (if dump-mode file fullname) + nil t)))) (let (kill-buffer-hook kill-buffer-query-functions) (kill-buffer buffer))) (do-after-load-evaluation fullname) diff --git a/lisp/startup.el b/lisp/startup.el index 9a4c3e2d14..8b059e756d 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2663,7 +2663,7 @@ nil default-directory" name) ;; actually exist on some systems. (when (file-exists-p truename) (setq file-ex truename)) - (load file-ex nil t t))) + (command-line--load-script file-ex))) ((equal argi "-insert") (setq inhibit-startup-screen t) @@ -2838,6 +2838,19 @@ nil default-directory" name) (display-startup-screen (> displayable-buffers-len 0)))))) +(defun command-line--load-script (file) + (load-with-code-conversion + file file nil nil + (lambda (buffer file) + (with-current-buffer buffer + (goto-char (point-min)) + ;; Removing the #! and then calling `eval-buffer' will make the + ;; reader not signal an error if it then turns out that the + ;; buffer is empty. + (when (looking-at "#!") + (delete-line)) + (eval-buffer buffer nil file nil t))))) + (defun command-line-normalize-file-name (file) "Collapse multiple slashes to one, to handle non-Emacs file names." (save-match-data diff --git a/lisp/subr.el b/lisp/subr.el index 0b546c0e0b..a78af09c40 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6591,4 +6591,11 @@ OBJECT if it is readable." (throw 'unreadable nil)))) (prin1-to-string object)))) +(defun delete-line () + "Delete the current line." + (delete-region (line-beginning-position) + (progn + (forward-line 1) + (point)))) + ;;; subr.el ends here commit 15781beda80fffa6c2dca1b5b32da8f0b4b3b306 Author: Po Lu Date: Thu Feb 10 20:00:47 2022 +0800 Enable TrueColor allocation optimizations on all visuals * src/xterm.c (x_alloc_nearest_color): Enable optimizations on 32-bit TrueColor visuals that legitimately don't have an alpha mask. diff --git a/src/xterm.c b/src/xterm.c index 469077c897..095ed316cf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3292,9 +3292,7 @@ x_alloc_nearest_color (struct frame *f, Colormap cmap, XColor *color) gamma_correct (f, color); - if (dpyinfo->red_bits > 0 - && (dpyinfo->n_planes != 32 - || dpyinfo->alpha_bits > 0)) + if (dpyinfo->red_bits > 0) { color->pixel = x_make_truecolor_pixel (dpyinfo, color->red, commit d49c8cea4377066e8fd8035d941bf671e51722eb Author: Po Lu Date: Thu Feb 10 19:56:30 2022 +0800 Correctly premultiply background color of fringe bitmaps * src/xterm.c (x_draw_fringe_bitmap): Premultiply alphas by alpha_background. diff --git a/src/xterm.c b/src/xterm.c index bd0fdde01e..469077c897 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -2111,6 +2111,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring int depth = FRAME_DISPLAY_INFO (f)->n_planes; XGCValues gcv; unsigned long background = face->background; + XColor bg; #ifdef HAVE_XRENDER Picture picture = None; XRenderPictureAttributes attrs; @@ -2123,9 +2124,18 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring else bits = (char *) p->bits + p->dh; - if (FRAME_DISPLAY_INFO (f)->alpha_bits) + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && f->alpha_background < 1.0) { - background = (background & ~FRAME_DISPLAY_INFO (f)->alpha_mask); + bg.pixel = background; + x_query_colors (f, &bg, 1); + bg.red *= f->alpha_background; + bg.green *= f->alpha_background; + bg.blue *= f->alpha_background; + + background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), + bg.red, bg.green, bg.blue); + background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; background |= (((unsigned long) (f->alpha_background * 0xffff) >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) << FRAME_DISPLAY_INFO (f)->alpha_offset); commit e16a78c44e05237b98207a7cee4b0666b7e1ac2a Author: Po Lu Date: Thu Feb 10 18:43:08 2022 +0800 Correctly allocate colors in xftfont * src/xftfont.c (struct xftface_info): New fields `bg_allocated_p' and `fg_allocated_p'. (xftfont_get_colors): Actually allocate colors and tell the caller whether colors were allocated. (xftfont_prepare_face): Set allocated fields. (xftfont_done_face): (xftfont_draw): Free colors that were allocated. diff --git a/src/xftfont.c b/src/xftfont.c index 6a2b2086df..e27c6cf314 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -49,19 +49,26 @@ along with GNU Emacs. If not, see . */ struct xftface_info { + bool bg_allocated_p; + bool fg_allocated_p; XftColor xft_fg; /* color for face->foreground */ XftColor xft_bg; /* color for face->background */ }; /* Setup foreground and background colors of GC into FG and BG. If XFTFACE_INFO is not NULL, reuse the colors in it if possible. BG - may be NULL. */ + may be NULL. Return whether or not colors were allocated in + BG_ALLOCATED_P and FG_ALLOCATED_P. */ static void xftfont_get_colors (struct frame *f, struct face *face, GC gc, struct xftface_info *xftface_info, - XftColor *fg, XftColor *bg) + XftColor *fg, XftColor *bg, + bool *bg_allocated_p, bool *fg_allocated_p) { + *bg_allocated_p = false; + *fg_allocated_p = false; + if (xftface_info && face->gc == gc) { *fg = xftface_info->xft_fg; @@ -94,20 +101,39 @@ xftfont_get_colors (struct frame *f, struct face *face, GC gc, { XColor colors[2]; - colors[0].pixel = fg->pixel = xgcv.foreground; + colors[0].pixel = xgcv.foreground; if (bg) - colors[1].pixel = bg->pixel = xgcv.background; + colors[1].pixel = xgcv.background; x_query_colors (f, colors, bg ? 2 : 1); fg->color.alpha = 0xFFFF; fg->color.red = colors[0].red; fg->color.green = colors[0].green; fg->color.blue = colors[0].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg->color, fg)) + /* This color should've been allocated when creating the + GC. */ + emacs_abort (); + else + *fg_allocated_p = true; + if (bg) { bg->color.alpha = 0xFFFF; bg->color.red = colors[1].red; bg->color.green = colors[1].green; bg->color.blue = colors[1].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg->color, bg)) + emacs_abort (); + else + *bg_allocated_p = true; } } unblock_input (); @@ -360,9 +386,12 @@ xftfont_prepare_face (struct frame *f, struct face *face) } #endif - xftface_info = xmalloc (sizeof *xftface_info); + xftface_info = xzalloc (sizeof *xftface_info); xftfont_get_colors (f, face, face->gc, NULL, - &xftface_info->xft_fg, &xftface_info->xft_bg); + &xftface_info->xft_fg, + &xftface_info->xft_bg, + &xftface_info->bg_allocated_p, + &xftface_info->fg_allocated_p); face->extra = xftface_info; } @@ -381,6 +410,18 @@ xftfont_done_face (struct frame *f, struct face *face) xftface_info = (struct xftface_info *) face->extra; if (xftface_info) { + if (xftface_info->fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_fg); + + if (xftface_info->bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_bg); + xfree (xftface_info); face->extra = NULL; } @@ -469,13 +510,16 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, XftDraw *xft_draw = xftfont_get_xft_draw (f); FT_UInt *code; XftColor fg, bg; + bool bg_allocated_p, fg_allocated_p; int len = to - from; int i; if (s->font == face->font) xftface_info = (struct xftface_info *) face->extra; xftfont_get_colors (f, face, s->gc, xftface_info, - &fg, with_background ? &bg : NULL); + &fg, with_background ? &bg : NULL, + &bg_allocated_p, &fg_allocated_p); + if (s->num_clips > 0) XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips); else @@ -550,6 +594,19 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, FRAME_X_DRAWABLE in order to draw: we cached the drawable in the XftDraw structure. */ x_mark_frame_dirty (f); + + if (bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg); + + if (fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg); + unblock_input (); return len; } commit 849895d0db9c8879dedd6658f66b28b1613358ff Author: Dima Kogan Date: Thu Feb 10 08:01:24 2022 +0100 Make comint-word actually check comint-file-name-quote-list * lisp/comint.el (comint-word): We were checking for comint-file-name-quote-list existing, but not actually comparing to the characters in that list. This patch actually checks the contents of comint-file-name-quote-list (bug#53911). diff --git a/lisp/comint.el b/lisp/comint.el index fdea3e33bb..4c82e74e4b 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3191,8 +3191,8 @@ inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters. (while (not giveup) (let ((startpoint (point))) (skip-chars-backward (concat "\\\\" word-chars)) - (if (and comint-file-name-quote-list - (eq (char-before (1- (point))) ?\\)) + (if (and (eq (char-before (1- (point))) ?\\) + (memq (char-before) comint-file-name-quote-list)) (forward-char -2)) ;; FIXME: This isn't consistent with Bash, at least -- not ;; all non-ASCII chars should be word constituents. commit d3c47011d5ace1e1c3fca830d3ff71d9c693ed5d Author: Eli Zaretskii Date: Thu Feb 10 10:34:29 2022 +0200 Allow customization of the user's eln-cache directory * lisp/startup.el (startup-redirect-eln-cache) (startup--update-eln-cache): New functions. (startup--original-eln-load-path): New defvar. (normal-top-level): Record the original value of 'native-comp-eln-load-path' in 'startup--original-eln-load-path'. Do not amend 'native-comp-eln-load-path' here, as that could overwrite user customizations. (command-line): Amend 'native-comp-eln-load-path' after loading the early-init file, and then again after loading the user init file. (Bug#53891) * etc/NEWS: Announce 'startup-redirect-eln-cache'. diff --git a/etc/NEWS b/etc/NEWS index 0f5e28b31a..6f19224026 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -92,6 +92,14 @@ This is run at the end of the Emacs startup process, and it meant to be used to reinitialize structures that would normally be done at load time. +--- +** New function 'startup-redirect-eln-cache'. +This function can be called in your init files to change the +user-specific directory where Emacs stores the "*.eln" files produced +by native compilation of Lisp packages Emacs loads. The default +eln-cache directory is unchanged: it is the 'eln-cache' subdirectory +of 'user-emacs-directory'. + * Incompatible changes in Emacs 29.1 diff --git a/lisp/startup.el b/lisp/startup.el index d838dd6827..9a4c3e2d14 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -541,6 +541,49 @@ DIRS are relative." (setq comp--compilable t)) (defvar native-comp-eln-load-path) + +(defvar startup--original-eln-load-path nil + "Original value of `native-comp-eln-load-path'.") + +(defun startup-redirect-eln-cache (cache-directory) + "Redirect the user's eln-cache directory to CACHE-DIRECTORY. +CACHE-DIRECTORY must be a single directory, a string. +This function destructively changes `native-comp-eln-load-path' +so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY +is not an absolute file name, it is interpreted relative +to `user-emacs-directory'. +For best results, call this function in your early-init file, +so that the rest of initialization and package loading uses +the updated value." + (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") + (file-writable-p (expand-file-name + (or temporary-file-directory ""))) + (car native-comp-eln-load-path)))) + (if tmp-dir + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path))) + ;; Remove the original eln-cache. + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path)) + ;; Add the new eln-cache. + (push (expand-file-name (file-name-as-directory cache-directory) + user-emacs-directory) + native-comp-eln-load-path) + (when tmp-dir + ;; Recompute tmp-dir, in case user-emacs-directory affects it. + (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) + (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) + (push tmp-dir native-comp-eln-load-path)))) + +(defun startup--update-eln-cache () + "Update the user eln-cache directory due to user customizations." + ;; Don't override user customizations! + (when (equal native-comp-eln-load-path + startup--original-eln-load-path) + (startup-redirect-eln-cache "eln-cache") + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path)))) + (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -559,7 +602,7 @@ It is the default value of the variable `top-level'." (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) (when (featurep 'native-compile) - ;; Form `native-comp-eln-load-path'. + ;; Form the initial value of `native-comp-eln-load-path'. (let ((path-env (getenv "EMACSNATIVELOADPATH"))) (when path-env (dolist (path (split-string path-env path-separator)) @@ -674,7 +717,9 @@ It is the default value of the variable `top-level'." ;; native-comp-eln-load-path. (expand-file-name (decode-coding-string dir coding t))) - npath)))) + npath))) + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path))) (dolist (filesym '(data-directory doc-directory exec-directory installation-directory invocation-directory invocation-name @@ -725,46 +770,6 @@ It is the default value of the variable `top-level'." (unwind-protect (command-line) - ;; Do this after `command-line', since it may alter - ;; `user-emacs-directory'. - (when (featurep 'native-compile) - ;; Form `native-comp-eln-load-path'. - (let ((path-env (getenv "EMACSNATIVELOADPATH"))) - (when path-env - (dolist (path (split-string path-env path-separator)) - (unless (string= "" path) - (push path native-comp-eln-load-path))))) - (push (expand-file-name "eln-cache/" user-emacs-directory) - native-comp-eln-load-path) - ;; When $HOME is set to '/nonexistent' means we are running the - ;; testsuite, add a temporary folder in front to produce there - ;; new compilations. - (when (and (equal (getenv "HOME") "/nonexistent") - ;; We may be running in a chroot environment where we - ;; can't write anything. - (file-writable-p (expand-file-name - (or temporary-file-directory "")))) - (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) - (add-hook 'kill-emacs-hook - (lambda () - (delete-directory tmp-dir t))) - (push tmp-dir native-comp-eln-load-path))) - (when locale-coding-system - (let ((coding (if (eq system-type 'windows-nt) - ;; MS-Windows build converts all file names to - ;; UTF-8 during startup. - 'utf-8 - locale-coding-system)) - (npath (symbol-value 'native-comp-eln-load-path))) - (set 'native-comp-eln-load-path - (mapcar (lambda (dir) - ;; Call expand-file-name to remove all the - ;; pesky ".." from the directyory names in - ;; native-comp-eln-load-path. - (expand-file-name - (decode-coding-string dir coding t))) - npath))))) - ;; Do this again, in case .emacs defined more abbreviations. (if default-directory (setq default-directory (abbreviate-file-name default-directory))) @@ -832,35 +837,6 @@ It is the default value of the variable `top-level'." (unless inhibit-startup-hooks (run-hooks 'window-setup-hook)))) - ;; Amend `native-comp-eln-load-path' after `command-line', since - ;; the latter may have altered `user-emacs-directory'. - (when (featurep 'native-compile) - (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") - (file-writable-p (expand-file-name - (or temporary-file-directory ""))) - (car native-comp-eln-load-path))) - (coding (if (eq system-type 'windows-nt) - 'utf-8 - locale-coding-system))) - (if tmp-dir - (setq native-comp-eln-load-path - (cdr native-comp-eln-load-path))) - ;; Remove the original eln-cache. - (setq native-comp-eln-load-path - (cdr native-comp-eln-load-path)) - ;; Add the new eln-cache. - (push (expand-file-name "eln-cache/" - (if coding - (decode-coding-string user-emacs-directory - coding t) - user-emacs-directory)) - native-comp-eln-load-path) - (when tmp-dir - ;; Recompute tmp-dir, in case user-emacs-directory affects it. - (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) - (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) - (push tmp-dir native-comp-eln-load-path)))) - ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -1362,6 +1338,12 @@ please check its value") startup-init-directory))) (setq early-init-file user-init-file) + ;; Amend `native-comp-eln-load-path', since the early-init file may + ;; have altered `user-emacs-directory' and/or changed the eln-cache + ;; directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + ;; If any package directory exists, initialize the package system. (and user-init-file package-enable-at-startup @@ -1496,6 +1478,12 @@ please check its value") startup-init-directory)) t) + ;; Amend `native-comp-eln-load-path' again, since the early-init + ;; file may have altered `user-emacs-directory' and/or changed the + ;; eln-cache directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + (when (and deactivate-mark transient-mark-mode) (with-current-buffer (window-buffer) (deactivate-mark)))