commit d0d7765f236fe7f58e87342628f2491ee2d26195 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Tue Mar 8 08:52:57 2022 +0100 Handle bug#54294 in Tramp * lisp/net/tramp.el (tramp-handle-file-locked-p, tramp-handle-lock-file): Use `tramp-system-name'. (Bug#54294) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5bf6a54020..8f54f96573 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -185,7 +185,7 @@ See the variable `tramp-encoding-shell' for more information." ;; Since Emacs 26.1, `system-name' can return nil at build time if ;; Emacs is compiled with "--no-build-details". We do expect it to be -;; a string. (Bug#44481) +;; a string. (Bug#44481, Bug#54294) (defconst tramp-system-name (or (system-name) "") "The system name Tramp is running locally.") @@ -4021,7 +4021,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (match (string-match tramp-lock-file-info-regexp info))) (or ; Locked by me. (and (string-equal (match-string 1 info) (user-login-name)) - (string-equal (match-string 2 info) (system-name)) + (string-equal (match-string 2 info) tramp-system-name) (string-equal (match-string 3 info) (tramp-get-lock-pid file))) ; User name. (match-string 1 info)))) @@ -4052,7 +4052,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; USER@HOST.PID[:BOOT_TIME] (info (format - "%s@%s.%s" (user-login-name) (system-name) + "%s@%s.%s" (user-login-name) tramp-system-name (tramp-get-lock-pid file)))) ;; Protect against security hole. commit 212aa7748bab6621453136d1d5df1ef76f5c3194 Author: Po Lu Date: Tue Mar 8 15:19:37 2022 +0800 Fix more uses of opaque Visual structure * src/image.c (x_kill_gs_process): * src/xfaces.c (x_free_colors): (x_free_dpy_colors): * src/xfns.c (Fxw_display_color_p): (Fx_display_grayscale_p): (Fx_display_visual_class): * src/xterm.c (x_copy_color): * src/xterm.h (x_mutable_colormap): Stop using private fields of Visual. diff --git a/src/image.c b/src/image.c index e2ba744e0a..c412dc9029 100644 --- a/src/image.c +++ b/src/image.c @@ -11160,7 +11160,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) /* On displays with a mutable colormap, figure out the colors allocated for the image by looking at the pixels of an XImage for img->pixmap. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { XImage *ximg; diff --git a/src/xfaces.c b/src/xfaces.c index 1d2e2489de..d7f1f4d96e 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -475,7 +475,7 @@ x_free_colors (struct frame *f, unsigned long *pixels, int npixels) { /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); @@ -500,7 +500,7 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (dpyinfo->visual)) + if (x_mutable_colormap (&dpyinfo->visual_info)) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); diff --git a/src/xfns.c b/src/xfns.c index 9a445b2682..c71f2b025f 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5028,7 +5028,7 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, if (dpyinfo->n_planes <= 2) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -5055,7 +5055,7 @@ If omitted or nil, that stands for the selected frame's display. */) if (dpyinfo->n_planes <= 1) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -5335,7 +5335,7 @@ If omitted or nil, that stands for the selected frame's display. struct x_display_info *dpyinfo = check_x_display_info (terminal); Lisp_Object result; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticGray: result = intern ("static-gray"); diff --git a/src/xterm.c b/src/xterm.c index 52df2e9f04..fdecca3bcd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4010,7 +4010,7 @@ x_copy_color (struct frame *f, unsigned long pixel) necessary and some servers don't allow it. Since we won't free a color once we've allocated it, we don't need to re-allocate it to maintain the server's reference count. */ - if (!x_mutable_colormap (FRAME_X_VISUAL (f))) + if (!x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) return pixel; color.pixel = pixel; diff --git a/src/xterm.h b/src/xterm.h index 88949b3039..4875eabafe 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1381,7 +1381,7 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) also allows us to make other optimizations relating to server-side reference counts. */ INLINE bool -x_mutable_colormap (Visual *visual) +x_mutable_colormap (XVisualInfo *visual) { int class = visual->class; return (class != StaticColor && class != StaticGray && class != TrueColor); commit 39a2eb04f3f2e2b91192e3553e5366ca4d676370 Author: Po Lu Date: Tue Mar 8 14:15:01 2022 +0800 Return actual color cell count in x-display-color-cells * src/xfns.c (Fx_display_color_cells): Return the actual amount of color cells, or the amount of individual combinations of components. diff --git a/src/xfns.c b/src/xfns.c index 3d1fa92609..9a445b2682 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5131,14 +5131,17 @@ If omitted or nil, that stands for the selected frame's display. { struct x_display_info *dpyinfo = check_x_display_info (terminal); - int nr_planes = DisplayPlanes (dpyinfo->display, - XScreenNumberOfScreen (dpyinfo->screen)); + if (dpyinfo->visual_info.class != TrueColor + && dpyinfo->visual_info.class != DirectColor) + return make_fixnum (dpyinfo->visual_info.colormap_size); - /* Truncate nr_planes to 24 to avoid integer overflow. - Some displays says 32, but only 24 bits are actually significant. + int nr_planes = dpyinfo->n_planes; + + /* Truncate nr_planes to 24 to avoid integer overflow. Some + displays says 32, but only 24 bits are actually significant. There are only very few and rare video cards that have more than - 24 significant bits. Also 24 bits is more than 16 million colors, - it "should be enough for everyone". */ + 24 significant bits. Also 24 bits is more than 16 million + colors, it "should be enough for everyone". */ if (nr_planes > 24) nr_planes = 24; return make_fixnum (1 << nr_planes); commit 5f87550f533ba051fc366627a39aacab3c5629db Merge: 8f11fb114c 80736aef90 Author: Stefan Kangas Date: Tue Mar 8 06:32:57 2022 +0100 Merge from origin/emacs-28 80736aef90 Fix which-func-update doc string d9e5ae5e20 Improve wording of 'dired-jump's description commit 8f11fb114cec7cbf8c516432ae70a8823d9007a6 Author: Stefan Monnier Date: Mon Mar 7 22:27:19 2022 -0500 (cl-macro-list): Simplify by unifying the variants * lisp/emacs-lisp/cl-macs.el (cl-macro-list): Add the &whole and the dotted tail cases from `cl-macro-list1`. (cl-macro-list1, cl-define-compiler-macro-list): Delete edebug elem specs. (cl-destructuring-bind, cl-define-compiler-macro): Use `cl-macro-list` instead, now that it covers all the cases we need. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index accd70dc4e..4b231d8149 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -394,11 +394,17 @@ and BODY is implicitly surrounded by (cl-block NAME ...). `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name))) ;; The lambda list for macros is different from that of normal lambdas. -;; Note that &environment is only allowed as first or last items in the + +;; `cl-macro-list' is shared between a few different use cases that +;; don't all support exactly the same set of special keywords: the +;; debug spec accepts hence a superset of what the macros +;; actually support. +;; For example &environment is only allowed as first or last items in the ;; top level list. (def-edebug-elem-spec 'cl-macro-list - '(([&optional "&environment" arg] + '(([&optional "&whole" arg] ; Only for compiler-macros or at lower levels. + [&optional "&environment" arg] ; Only at top-level. [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] @@ -410,26 +416,12 @@ and BODY is implicitly surrounded by (cl-block NAME ...). &optional "&allow-other-keys"]] [&optional ["&aux" &rest &or (cl-macro-arg &optional def-form) arg]] - [&optional "&environment" arg] + [&optional "&environment" arg] ; Only at top-level. + . [&or arg nil] ; Only allowed at lower levels. ))) (def-edebug-elem-spec 'cl-macro-arg - '(&or arg cl-macro-list1)) - -(def-edebug-elem-spec 'cl-macro-list1 - '(([&optional "&whole" arg] ;; only allowed at lower levels - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - . [&or arg nil]))) + '(&or arg cl-macro-list)) ;;;###autoload (defmacro cl-defmacro (name args &rest body) @@ -692,7 +684,7 @@ its argument list allows full Common Lisp conventions." (defmacro cl-destructuring-bind (args expr &rest body) "Bind the variables in ARGS to the result of EXPR and execute BODY." (declare (indent 2) - (debug (&define cl-macro-list1 def-form cl-declarations def-body))) + (debug (&define cl-macro-list def-form cl-declarations def-body))) (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-defs nil) @@ -3489,10 +3481,6 @@ omitted, a default message listing FORM itself is used." ;;; Compiler macros. -(def-edebug-elem-spec 'cl-define-compiler-macro-list - `(([&optional "&whole" arg] - ,@(car (get 'cl-macro-list 'edebug-elem-spec))))) - ;;;###autoload (defmacro cl-define-compiler-macro (func args &rest body) "Define a compiler-only macro. @@ -3506,7 +3494,7 @@ possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo." ;; Like `cl-defmacro', but with the `&whole' special case. - (declare (debug (&define name cl-define-compiler-macro-list + (declare (debug (&define name cl-macro-list cl-declarations-or-string def-body)) (indent 2)) (let ((p args) (res nil)) commit bacd7ae4b6dbe3b8c8d5bcf100f97b4e856aac39 Author: Po Lu Date: Tue Mar 8 09:14:41 2022 +0800 Avoid color leaks while better ensuring a close color is found * src/xterm.c (x_alloc_nearest_color_1): Verify nearest can be allocated, and use that color value. diff --git a/src/xterm.c b/src/xterm.c index e20f9ca406..52df2e9f04 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3858,10 +3858,12 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) Status status; bool retry = false; int ncolor_cells, i; + bool temp_allocated; + XColor temp; start: - cells = x_color_cells (dpy, &no_cells); + temp_allocated = false; nearest = 0; /* I'm assuming CSE so I'm not going to condense this. */ @@ -3881,16 +3883,39 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) * ((color->blue >> 8) - (cells[x].blue >> 8)))); if (trial_delta < nearest_delta) { - nearest = x; - nearest_delta = trial_delta; + /* We didn't decide to use this color, so free it. */ + if (temp_allocated) + { + XFreeColors (dpy, cmap, &temp.pixel, 1, 0); + temp_allocated = false; + } + + temp.red = cells[x].red; + temp.green = cells[x].green; + temp.blue = cells[x].blue; + status = XAllocColor (dpy, cmap, &temp); + + if (status) + { + temp_allocated = true; + nearest = x; + nearest_delta = trial_delta; + } } } color->red = cells[nearest].red; color->green = cells[nearest].green; color->blue = cells[nearest].blue; - status = XAllocColor (dpy, cmap, color); - if (status != 0 && !retry) + if (!temp_allocated) + status = XAllocColor (dpy, cmap, color); + else + { + *color = temp; + status = 1; + } + + if (status == 0 && !retry) { /* Our private cache of color cells is probably out of date. Refresh it here, and try to allocate the nearest color commit b19db4861f552a2571a97dab590f6fdf59c5c81b Author: Po Lu Date: Tue Mar 8 08:41:15 2022 +0800 Fix choice of visuals for XPM icon * src/xterm.c (x_bitmap_icon): Allow using XPM icon on StaticColor and StaticGray as well. diff --git a/src/xterm.c b/src/xterm.c index 60cd57b851..e20f9ca406 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13988,7 +13988,9 @@ x_bitmap_icon (struct frame *f, Lisp_Object file) #elif defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) /* This allocates too many colors. */ - if (FRAME_X_VISUAL_INFO (f)->class == TrueColor + if ((FRAME_X_VISUAL_INFO (f)->class == TrueColor + || FRAME_X_VISUAL_INFO (f)->class == StaticColor + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) /* That pixmap needs about 240 colors, and we should also leave some more space for other colors as well. */ commit 530ac51f5b83b4ad189d55047f149e4bc0750f20 Author: Lars Ingebrigtsen Date: Mon Mar 7 18:03:14 2022 +0100 Remove lock file in --no-build-details, too * src/filelock.c (current_lock_owner): Make file writes work when using --no-build-details (bug#54294). diff --git a/src/filelock.c b/src/filelock.c index cb548ac79b..4fdad8d856 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -578,8 +578,13 @@ current_lock_owner (lock_info_type *owner, char *lfname) if (lfinfo_end != owner->user + lfinfolen) return EINVAL; - /* On current host? */ Lisp_Object system_name = Fsystem_name (); + /* If `system-name' returns nil, that means we're in a + --no-build-details Emacs, and the name part of the link (e.g., + .#test.txt -> larsi@.118961:1646577954) is an empty string. */ + if (NILP (system_name)) + system_name = build_string (""); + /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) commit 324d8938c783e9f09f989dbb19d092eaca7a99b8 Author: Lars Ingebrigtsen Date: Mon Mar 7 17:39:00 2022 +0100 Mark ert-test-run-tests-batch-expensive unstable on EMBA diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index dd12e3764c..7573d2ed05 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -595,6 +595,7 @@ This macro is used to test if macroexpansion in `should' works." (should found-complex))))) (ert-deftest ert-test-run-tests-batch-expensive () + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc")))))))) (failing-test-1 (make-ert-test :name 'failing-test-1 commit 494daefda1c7e6fc5881997de7c837172a4111c3 Author: Kjartan Oli Agustsson Date: Mon Mar 7 17:29:38 2022 +0100 Add user stylesheet option for doc-view EPUB support * lisp/doc-view.el (doc-view-start-process): Add user stylesheet to process arguments when appropriate. * lisp/doc-view.el (doc-view-mutool-user-stylesheet): New user option. Copyright-paperwork-exempt: yes diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 193cf42ea4..5b07d75f6d 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -226,6 +226,12 @@ are available (see Info node `(emacs)Document View')" Higher values result in larger images." :type 'number) +(defcustom doc-view-mutool-user-stylesheet nil + "User stylesheet to use when converting EPUB documents to PDF." + :type '(choice (const nil) + (file :must-match t)) + :version "29.1") + (defvar doc-view-doc-type nil "The type of document in the current buffer. Can be `dvi', `pdf', `ps', `djvu', `odf', 'epub', `cbz', `fb2', @@ -1169,8 +1175,16 @@ The test is performed using `doc-view-pdfdraw-program'." (options `(,(concat "-o" png) ,(format "-r%d" (round doc-view-resolution)) ,@(if pdf-passwd `("-p" ,pdf-passwd))))) - (when (and (eq doc-view-doc-type 'epub) doc-view-epub-font-size) - (setq options (append options (list (format "-S%s" doc-view-epub-font-size))))) + (when (eq doc-view-doc-type 'epub) + (when doc-view-epub-font-size + (setq options (append options + (list (format "-S%s" doc-view-epub-font-size))))) + (when doc-view-mutool-user-stylesheet + (setq options + (append options + (list (format "-U%s" + (expand-file-name + doc-view-mutool-user-stylesheet))))))) (doc-view-start-process "pdf->png" doc-view-pdfdraw-program `(,@(doc-view-pdfdraw-program-subcommand) commit 80736aef9085ad04e59902b0d0a31fb1f663858b (refs/remotes/origin/emacs-28) Author: Lars Ingebrigtsen Date: Mon Mar 7 16:19:19 2022 +0100 Fix which-func-update doc string * lisp/progmodes/which-func.el (which-func-update): Make the doc string match the code (bug#54288). diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 4388b0e7de..abe25f2c63 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -216,7 +216,7 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil)))) (defun which-func-update () - "Update the Which-Function mode display for all windows." + "Update the Which-Function mode display in the current window." ;; (walk-windows 'which-func-update-1 nil 'visible)) (let ((non-essential t)) (which-func-update-1 (selected-window)))) commit d67ca6739c3ed0c4ac36d3ee5a4eb158d791f668 Author: Stefan Monnier Date: Mon Mar 7 09:59:43 2022 -0500 * lisp/emacs-lisp/seq.el (seq-concatenate): Accept non-`sequencep` sequences diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index abfe51d32b..5ea9fae2e9 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -299,6 +299,7 @@ sorted. FUNCTION must be a function of one argument." TYPE must be one of following symbols: vector, string or list. \n(fn TYPE SEQUENCE...)" + (setq sequences (mapcar #'seq-into-sequence sequences)) (pcase type ('vector (apply #'vconcat sequences)) ('string (apply #'concat sequences)) commit 418e5da5d308b4e440f28545eb139211066b48a4 Author: Po Lu Date: Mon Mar 7 21:36:25 2022 +0800 Correctly handle exposure in oldXMenu * oldXMenu/Activate.c (XMenuActivate): Call set expose_func if no pane was found. (XMenuActivateSetExposeFunction): New function. * oldXMenu/XMenu.h: New typedef `expose_func'. Update prototypes. * src/xmenu.c (x_menu_expose_event): New function. (x_menu_show): Set expose event handler. * src/xterm.c (x_dispatch_event): Make `static' only on GTK. * src/xterm.h: Expose `x_dispatch_event' on no-toolkit builds. diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c index 781c05bd02..e679c2ffed 100644 --- a/oldXMenu/Activate.c +++ b/oldXMenu/Activate.c @@ -122,6 +122,7 @@ int x_menu_grab_keyboard = 1; static Wait_func wait_func; static void* wait_data; static Translate_func translate_func = NULL; +static Expose_func expose_func = NULL; void XMenuActivateSetWaitFunction (Wait_func func, void *data) @@ -136,6 +137,12 @@ XMenuActivateSetTranslateFunction (Translate_func func) translate_func = func; } +void +XMenuActivateSetExposeFunction (Expose_func func) +{ + expose_func = func; +} + int XMenuActivate( register Display *display, /* Display to put menu on. */ @@ -339,6 +346,9 @@ XMenuActivate( feq = feq_tmp; } else if (_XMEventHandler) (*_XMEventHandler)(&event); + + if (expose_func) + expose_func (&event); break; } if (event_xmp->activated) { diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h index 2eee18a384..54061235ae 100644 --- a/oldXMenu/XMenu.h +++ b/oldXMenu/XMenu.h @@ -259,6 +259,7 @@ typedef void (*Wait_func)(void*); XPutBackEvent on an equivalent artificial core event on any function it wants to translate. */ typedef void (*Translate_func)(XEvent *); +typedef void (*Expose_func)(XEvent *); /* * XMenu library routine declarations. @@ -280,6 +281,7 @@ int XMenuLocate(Display *display, XMenu *menu, int p_num, int s_num, int x_pos, void XMenuSetFreeze(XMenu *menu, int freeze); void XMenuActivateSetWaitFunction(Wait_func func, void *data); void XMenuActivateSetTranslateFunction(Translate_func func); +void XMenuActivateSetExposeFunction(Expose_func func); int XMenuActivate(Display *display, XMenu *menu, int *p_num, int *s_num, int x_pos, int y_pos, unsigned int event_mask, char **data, void (*help_callback) (char const *, int, int)); char *XMenuPost(Display *display, XMenu *menu, int *p_num, int *s_num, int x_pos, int y_pos, int event_mask); int XMenuDeletePane(Display *display, XMenu *menu, int p_num); diff --git a/src/xmenu.c b/src/xmenu.c index e085fa1ace..4d0e5bd81c 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -280,6 +280,14 @@ x_menu_translate_generic_event (XEvent *event) } } #endif + +#if !defined USE_X_TOOLKIT && !defined USE_GTK +static void +x_menu_expose_event (XEvent *event) +{ + x_dispatch_event (event, event->xexpose.display); +} +#endif #endif /* ! MSDOS */ @@ -2638,6 +2646,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, #ifdef HAVE_XINPUT2 XMenuActivateSetTranslateFunction (x_menu_translate_generic_event); #endif + XMenuActivateSetExposeFunction (x_menu_expose_event); #endif record_unwind_protect_ptr (pop_down_menu, diff --git a/src/xterm.c b/src/xterm.c index 6682d3c9a4..60cd57b851 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13520,14 +13520,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, return count; } -#if defined USE_X_TOOLKIT || defined USE_MOTIF || defined USE_GTK - /* Handles the XEvent EVENT on display DISPLAY. This is used for event loops outside the normal event handling, i.e. looping while a popup menu or a dialog is posted. Returns the value handle_one_xevent sets in the finish argument. */ + +#ifdef USE_GTK +static int +#else int +#endif x_dispatch_event (XEvent *event, Display *display) { struct x_display_info *dpyinfo; @@ -13540,7 +13543,6 @@ x_dispatch_event (XEvent *event, Display *display) return finish; } -#endif /* Read events coming from the X server. Return as soon as there are no more events to be read. diff --git a/src/xterm.h b/src/xterm.h index 846df03277..88949b3039 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1320,7 +1320,7 @@ extern void x_clear_area (struct frame *f, int, int, int, int); extern void x_mouse_leave (struct x_display_info *); #endif -#if defined USE_X_TOOLKIT || defined USE_MOTIF +#ifndef USE_GTK extern int x_dispatch_event (XEvent *, Display *); #endif extern int x_x_to_emacs_modifiers (struct x_display_info *, int); commit 8a7df412a640c8b2334b78ec0ca872a6d11e8b0e Author: Po Lu Date: Mon Mar 7 21:08:07 2022 +0800 Improve color handling on colormapped displays * src/xfns.c (select_visual): Set `visual_info' field whenever appropriate. (x_create_tip_frame, XDisplayCells): Don't access private fields of Visual. * src/xterm.c (x_color_cells, x_alloc_nearest_color_1): Use colormap_size instead of default cell count. (XTflash, x_bitmap_icon, x_term_init): * src/xterm.h (struct x_display_info, FRAME_X_VISUAL_INFO): Stop accessing private fields of Visual. diff --git a/src/xfns.c b/src/xfns.c index e288f797fb..3d1fa92609 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6605,6 +6605,7 @@ select_visual (struct x_display_info *dpyinfo) SSDATA (ENCODE_SYSTEM (value))); dpyinfo->visual = vinfo.visual; + dpyinfo->visual_info = vinfo; } else { @@ -6638,6 +6639,7 @@ select_visual (struct x_display_info *dpyinfo) { dpyinfo->n_planes = vinfo[i].depth; dpyinfo->visual = vinfo[i].visual; + dpyinfo->visual_info = vinfo[i]; dpyinfo->pict_format = format; XFree (vinfo); @@ -6658,7 +6660,7 @@ select_visual (struct x_display_info *dpyinfo) &vinfo_template, &n_visuals); if (n_visuals <= 0) fatal ("Can't get proper X visual info"); - + dpyinfo->visual_info = *vinfo; dpyinfo->n_planes = vinfo->depth; XFree (vinfo); } @@ -7540,8 +7542,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) if (FRAME_DISPLAY_INFO (f)->n_planes == 1) disptype = Qmono; - else if (FRAME_DISPLAY_INFO (f)->visual->class == GrayScale - || FRAME_DISPLAY_INFO (f)->visual->class == StaticGray) + else if (FRAME_X_VISUAL_INFO (f)->class == GrayScale + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) disptype = intern ("grayscale"); else disptype = intern ("color"); @@ -9019,7 +9021,15 @@ XkbFreeNames (XkbDescPtr xkb, unsigned int which, Bool free_map) int XDisplayCells (Display *dpy, int screen_number) { - return 1677216; + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + emacs_abort (); + + /* Not strictly correct, since the display could be using a + non-default visual, but it satisfies the callers we need to care + about. */ + return dpyinfo->visual_info.colormap_size; } #endif diff --git a/src/xterm.c b/src/xterm.c index 30229c45a4..6682d3c9a4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3641,8 +3641,7 @@ x_color_cells (Display *dpy, int *ncells) if (dpyinfo->color_cells == NULL) { - Screen *screen = dpyinfo->screen; - int ncolor_cells = XDisplayCells (dpy, XScreenNumberOfScreen (screen)); + int ncolor_cells = dpyinfo->visual_info.colormap_size; int i; dpyinfo->color_cells = xnmalloc (ncolor_cells, @@ -3841,7 +3840,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) eassume (dpyinfo); rc = XAllocColor (dpy, cmap, color) != 0; - if (dpyinfo->visual->class == DirectColor) + if (dpyinfo->visual_info.class == DirectColor) return rc; if (rc == 0) @@ -3900,7 +3899,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) retry = true; xfree (dpyinfo->color_cells); - ncolor_cells = XDisplayCells (dpy, XScreenNumberOfScreen (dpyinfo->screen)); + ncolor_cells = dpyinfo->visual_info.colormap_size; dpyinfo->color_cells = xnmalloc (ncolor_cells, sizeof *dpyinfo->color_cells); @@ -5735,7 +5734,7 @@ XTflash (struct frame *f) block_input (); - if (FRAME_X_VISUAL (f)->class == TrueColor) + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) { values.function = GXxor; values.foreground = (FRAME_FOREGROUND_PIXEL (f) @@ -5821,7 +5820,7 @@ XTflash (struct frame *f) flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - if (FRAME_X_VISUAL (f)->class == TrueColor) + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) XFreeGC (FRAME_X_DISPLAY (f), gc); x_flush (f); @@ -13986,11 +13985,17 @@ x_bitmap_icon (struct frame *f, Lisp_Object file) } #elif defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) - - rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); - if (rc != -1) - FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; - + /* This allocates too many colors. */ + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor + /* That pixmap needs about 240 colors, and we should + also leave some more space for other colors as + well. */ + || FRAME_X_VISUAL_INFO (f)->colormap_size >= (240 * 4)) + { + rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); + if (rc != -1) + FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; + } #endif /* If all else fails, use the (black and white) xbm image. */ @@ -17306,7 +17311,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* See if a private colormap is requested. */ if (dpyinfo->visual == DefaultVisualOfScreen (dpyinfo->screen)) { - if (dpyinfo->visual->class == PseudoColor) + if (dpyinfo->visual_info.class == PseudoColor) { AUTO_STRING (privateColormap, "privateColormap"); AUTO_STRING (PrivateColormap, "PrivateColormap"); @@ -17324,13 +17329,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->visual, AllocNone); /* See if we can construct pixel values from RGB values. */ - if (dpyinfo->visual->class == TrueColor) + if (dpyinfo->visual_info.class == TrueColor) { - get_bits_and_offset (dpyinfo->visual->red_mask, + get_bits_and_offset (dpyinfo->visual_info.red_mask, &dpyinfo->red_bits, &dpyinfo->red_offset); - get_bits_and_offset (dpyinfo->visual->blue_mask, + get_bits_and_offset (dpyinfo->visual_info.blue_mask, &dpyinfo->blue_bits, &dpyinfo->blue_offset); - get_bits_and_offset (dpyinfo->visual->green_mask, + get_bits_and_offset (dpyinfo->visual_info.green_mask, &dpyinfo->green_bits, &dpyinfo->green_offset); #ifdef HAVE_XRENDER @@ -17357,9 +17362,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) if (XAllocColor (dpyinfo->display, dpyinfo->cmap, &xc) != 0) { - alpha_mask = xc.pixel & ~(dpyinfo->visual->red_mask - | dpyinfo->visual->blue_mask - | dpyinfo->visual->green_mask); + alpha_mask = xc.pixel & ~(dpyinfo->visual_info.red_mask + | dpyinfo->visual_info.blue_mask + | dpyinfo->visual_info.green_mask); if (alpha_mask) get_bits_and_offset (alpha_mask, &dpyinfo->alpha_bits, diff --git a/src/xterm.h b/src/xterm.h index dd510ae257..846df03277 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -283,6 +283,9 @@ struct x_display_info /* The Visual being used for this display. */ Visual *visual; + /* The visual information corresponding to VISUAL. */ + XVisualInfo visual_info; + #ifdef HAVE_XRENDER /* The picture format for this display. */ XRenderPictFormat *pict_format; @@ -1031,6 +1034,9 @@ extern void x_mark_frame_dirty (struct frame *f); /* This is the Visual which frame F is on. */ #define FRAME_X_VISUAL(f) FRAME_DISPLAY_INFO (f)->visual +/* And its corresponding visual info. */ +#define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) + #ifdef HAVE_XRENDER #define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format #define FRAME_X_PICTURE(f) ((f)->output_data.x->picture) commit 4b0e1c6502534298465675a32ff65653c12df17d Author: Po Lu Date: Mon Mar 7 20:08:13 2022 +0800 Handle color allocation failures caused by colormap changes * src/xterm.c (x_alloc_nearest_color_1): Recompute color cells if allocation of cached value failed. diff --git a/src/xterm.c b/src/xterm.c index d3e3ed3a06..30229c45a4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3857,6 +3857,10 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) long nearest_delta, trial_delta; int x; Status status; + bool retry = false; + int ncolor_cells, i; + + start: cells = x_color_cells (dpy, &no_cells); @@ -3887,6 +3891,30 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) color->blue = cells[nearest].blue; status = XAllocColor (dpy, cmap, color); + if (status != 0 && !retry) + { + /* Our private cache of color cells is probably out of date. + Refresh it here, and try to allocate the nearest color + from the new colormap. */ + + retry = true; + xfree (dpyinfo->color_cells); + + ncolor_cells = XDisplayCells (dpy, XScreenNumberOfScreen (dpyinfo->screen)); + + dpyinfo->color_cells = xnmalloc (ncolor_cells, + sizeof *dpyinfo->color_cells); + dpyinfo->ncolor_cells = ncolor_cells; + + for (i = 0; i < ncolor_cells; ++i) + dpyinfo->color_cells[i].pixel = i; + + XQueryColors (dpy, dpyinfo->cmap, + dpyinfo->color_cells, ncolor_cells); + + goto start; + } + rc = status != 0; } else commit 3e4d4f472d3960a7d18dad76b8d54a66bc5d9f6c Author: Michael Albinus Date: Mon Mar 7 13:42:30 2022 +0100 Rework `abbreviate-file-name' in Tramp * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Add 'tramp-get-home-directory'. * lisp/net/tramp-compat.el (tramp-file-name-handler): Declare. (tramp-compat-exec-path): Use it. * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add 'tramp-get-home-directory'. (tramp-gvfs-handle-expand-file-name): Rewrite tilde handling. (tramp-gvfs-handle-get-home-directory): New defun. * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add 'tramp-get-home-directory'. (tramp-sh-handle-get-home-directory): New defun. (tramp-sh-handle-expand-file-name): Rewrite tilde handling. * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add 'tramp-get-home-directory'. (tramp-smb-handle-expand-file-name): Rewrite tilde handling. (tramp-smb-handle-get-home-directory): New defun. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add 'tramp-get-home-directory'. (tramp-sudoedit-handle-expand-file-name): Rewrite tilde handling. (tramp-sudoedit-handle-get-home-directory): New defun. * lisp/net/tramp.el (tramp-file-name-for-operation): Add `tramp-get-home-directory'. (tramp-get-home-directory): New defun. (tramp-handle-abbreviate-file-name): Use it. (tramp-set-file-uid-gid, tramp-get-remote-uid) (tramp-get-remote-gid): Use `tramp-file-name-handler'. (tramp-get-remote-null-device): Do not check for null VEC, it doesn't happen anymore. * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-relative): Reorder checks. (tramp-test07-abbreviate-file-name): (tramp--test-ange-ftp-p): Adapt tests. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a61179958c..ce90943d9a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -179,6 +179,7 @@ It is used for TCP/IP devices." (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index c6523003b8..788e457367 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -287,6 +287,7 @@ It must be supported by libarchive(3).") (start-file-process . tramp-archive-handle-not-implemented) ;; `substitute-in-file-name' performed by default handler. (temporary-file-directory . tramp-archive-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index db7e7d67c4..bd6d53afcb 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -37,6 +37,7 @@ (require 'subr-x) (declare-function tramp-error "tramp") +(declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") (defvar tramp-temp-name-prefix) @@ -133,8 +134,8 @@ NAME is unquoted." #'exec-path (lambda () "List of directories to search programs to run in remote subprocesses." - (if-let ((handler (find-file-name-handler default-directory 'exec-path))) - (funcall handler 'exec-path) + (if (tramp-tramp-file-p default-directory) + (tramp-file-name-handler 'exec-path) exec-path)))) ;; `time-equal-p' has appeared in Emacs 27.1. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 47c707451e..fb3ba08bb1 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -229,6 +229,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (start-file-process . ignore) ;; `substitute-in-file-name' performed by default handler. (temporary-file-directory . tramp-handle-temporary-file-directory) + ;; `tramp-get-home-directory' performed by default-handler. ;; `tramp-get-remote-gid' performed by default handler. ;; `tramp-get-remote-uid' performed by default handler. (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 23290de685..acded25292 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -816,6 +816,7 @@ It has been changed in GVFS 1.14.") (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory) (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid) (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) @@ -1139,18 +1140,14 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) - (save-match-data - (tramp-gvfs-maybe-open-connection - (make-tramp-file-name - :method method :user user :domain domain - :host host :port port :localname "/" :hop hop))) - (unless (string-empty-p - (tramp-get-connection-property v "default-location" "")) - (setq localname - (replace-match - (tramp-get-connection-property v "default-location" "~") - nil t localname 1)))) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) @@ -1601,6 +1598,17 @@ If FILE-SYSTEM is non-nil, return file system attributes." nil time))))) +(defun tramp-gvfs-handle-get-home-directory (vec &optional _user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (let ((localname + (tramp-get-connection-property vec "default-location" nil))) + (if (zerop (length localname)) + (tramp-get-connection-property (tramp-get-process vec) "share" nil) + localname))) + (defun tramp-gvfs-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 03a2c2457a..3b2e7c0f91 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -271,7 +271,7 @@ NAME must be equal to `tramp-current-connection'." #'tramp-compile-disable-ssh-controlmaster-options) (add-hook 'tramp-integration-unload-hook (lambda () - (remove-hook 'compilation-start-hook + (remove-hook 'compilation-mode-hook #'tramp-compile-disable-ssh-controlmaster-options)))) ;;; Default connection-local variables for Tramp. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 32ec19bf23..126b09fcbf 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -143,6 +143,7 @@ (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5f72b5c032..c80190a67f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1025,6 +1025,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-sh-handle-get-home-directory) (tramp-get-remote-gid . tramp-sh-handle-get-remote-gid) (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) @@ -1449,6 +1450,20 @@ of." (if (eq flag 'nofollow) "-h" "") (tramp-shell-quote-argument localname))))))) +(defun tramp-sh-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (when (tramp-send-command-and-check + vec (format + "echo %s" + (tramp-shell-quote-argument + (concat "~" (or user (tramp-file-name-user vec)))))) + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (buffer-substring (point) (point-at-eol))))) + (defun tramp-sh-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." @@ -2741,27 +2756,21 @@ the result will be a local, non-Tramp, file name." ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) + (fname (match-string 2 localname)) + hname) ;; We cannot simply apply "~/", because under sudo "~/" is ;; expanded to the local user home directory but to the ;; root home directory. On the other hand, using always ;; the default user name for tilde expansion is not ;; appropriate either, because ssh and companions might ;; use a user name from the config file. - (when (and (string-equal uname "~") + (when (and (zerop (length uname)) (string-match-p "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-tramp-connection-property v uname - (tramp-send-command - v - (format "cd %s && pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) - (setq localname (concat uname fname)))) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; There might be a double slash, for example when "~/" ;; expands to "/". Remove this. (while (string-match "//" localname) @@ -2769,15 +2778,17 @@ the result will be a local, non-Tramp, file name." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. ;; `default-directory' is bound, because on Windows there ;; would be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler - #'expand-file-name (list localname))))))))) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-drop-volume-letter + (tramp-run-real-handler + #'expand-file-name (list localname)))))))))) ;;; Remote commands: diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f52fa0a93b..67c63e6ce7 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -294,6 +294,7 @@ See `tramp-actions-before-shell' for more info.") (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-smb-handle-get-home-directory) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) @@ -745,25 +746,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-run-real-handler #'expand-file-name (list name nil)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil - ;; Tilde expansion if necessary. We use the user name as share, - ;; which is often the case in domains. - (when (string-match "\\`/?~\\([^/]*\\)" localname) - (setq localname - (replace-match - (if (zerop (length (match-string 1 localname))) - user - (match-string 1 localname)) - nil nil localname))) - ;; Make the file name absolute. + ;; Tilde expansion if necessary. + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) + ;; Tilde expansion is not possible. + (when (and (not tramp-tolerate-tilde) + (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (tramp-run-real-handler #'expand-file-name (list localname)))))) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-run-real-handler #'expand-file-name (list localname))))))) (defun tramp-smb-action-get-acl (proc vec) "Read ACL data from connection buffer." @@ -1589,6 +1595,15 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (tramp-run-real-handler #'substitute-in-file-name (list filename)) (error filename)))) +(defun tramp-smb-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (let ((user (or user (tramp-file-name-user vec)))) + (unless (zerop (length user)) + (concat "/" user)))) + (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 90b3c2ba2c..2f9d8a0681 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -145,6 +145,7 @@ (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index a35f9391a1..242a6c7f58 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -137,6 +137,7 @@ See `tramp-actions-before-shell' for more info.") (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory) (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid) (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid) @@ -369,17 +370,23 @@ the result will be a local, non-Tramp, file name." (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - (when (string-equal uname "~") - (setq uname (concat uname user))) - (setq localname (concat uname fname)))) - ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) - (setq localname "/")) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). - (tramp-make-tramp-file-name v (expand-file-name localname)))) + (tramp-make-tramp-file-name + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-run-real-handler + #'expand-file-name (list localname)))))) (defun tramp-sudoedit-remote-acl-p (vec) "Check, whether ACL is enabled on the remote host." @@ -699,6 +706,13 @@ component is used as the target of the symlink." (tramp-flush-file-property v localname "file-selinux-context")) t))))) +(defun tramp-sudoedit-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (expand-file-name (concat "~" (or user (tramp-file-name-user vec))))) + (defun tramp-sudoedit-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 932dfb3691..5bf6a54020 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2603,7 +2603,9 @@ Must be handled by the callers." (when (processp (nth 0 args)) (tramp-get-default-directory (process-buffer (nth 0 args))))) ;; VEC. - ((member operation '(tramp-get-remote-gid tramp-get-remote-uid)) + ((member operation + '(tramp-get-home-directory + tramp-get-remote-gid tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) ;; Unknown file primitive. (t (error "Unknown file I/O primitive: %s" operation)))) @@ -3360,15 +3362,16 @@ Let-bind it when necessary.") (tramp-tolerate-tilde t) (home-dir (if (let ((non-essential t)) (tramp-connectable-p vec)) - ;; If a connection has already been established, make - ;; sure the "home-directory" connection property is - ;; properly set. - (with-tramp-connection-property vec "home-directory" - (tramp-compat-funcall - 'directory-abbrev-apply - (expand-file-name (tramp-make-tramp-file-name vec "~")))) + ;; If a connection has already been established, get the + ;; home directory. + (tramp-get-home-directory vec) ;; Otherwise, just use the cached value. - (tramp-get-connection-property vec "home-directory" nil)))) + (tramp-get-connection-property vec "~" nil)))) + (when home-dir + (setq home-dir + (tramp-compat-funcall + 'directory-abbrev-apply + (tramp-make-tramp-file-name vec home-dir)))) ;; If any elt of `directory-abbrev-alist' matches this name, ;; abbreviate accordingly. (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) @@ -5366,8 +5369,8 @@ If FILENAME is remote, a file name handler is called." (when (and modes (not (zerop (logand modes #o2000)))) (setq gid (file-attribute-group-id (file-attributes dir))))) - (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid))) - (funcall handler #'tramp-set-file-uid-gid filename uid gid) + (if (tramp-tramp-file-p filename) + (tramp-file-name-handler #'tramp-set-file-uid-gid filename uid gid) ;; On W32 systems, "chown" does not work. (unless (memq system-type '(ms-dos windows-nt)) (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) @@ -5468,15 +5471,19 @@ be granted." (equal remote-gid (file-attribute-group-id file-attr)) (equal unknown-id (file-attribute-group-id file-attr)))))))))))) +(defun tramp-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (with-tramp-connection-property vec (concat "~" user) + (tramp-file-name-handler #'tramp-get-home-directory vec user))) + (defun tramp-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "uid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid))) - (funcall handler #'tramp-get-remote-uid vec id-format)) + (or (tramp-file-name-handler #'tramp-get-remote-uid vec id-format) ;; Ensure there is a valid result. (and (equal id-format 'integer) tramp-unknown-id-integer) (and (equal id-format 'string) tramp-unknown-id-string)))) @@ -5485,11 +5492,7 @@ ID-FORMAT valid values are `string' and `integer'." "The gid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "gid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid))) - (funcall handler #'tramp-get-remote-gid vec id-format)) + (or (tramp-file-name-handler #'tramp-get-remote-gid vec id-format) ;; Ensure there is a valid result. (and (equal id-format 'integer) tramp-unknown-id-integer) (and (equal id-format 'string) tramp-unknown-id-string)))) @@ -5755,8 +5758,8 @@ Consults the auth-source package." ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. + ;; In tramp-sh.el, we must use "password-vector" due to + ;; multi-hop. (vec (tramp-get-connection-property proc "password-vector" (process-get proc 'vector))) (key (tramp-make-tramp-file-name vec 'noloc)) @@ -5941,8 +5944,8 @@ name of a process or buffer, or nil to default to the current buffer." (defun tramp-get-remote-null-device (vec) "Return null device on the remote host identified by VEC. -If VEC is nil or `tramp-null-hop', return local null device." - (if (or (null vec) (equal vec tramp-null-hop)) +If VEC is `tramp-null-hop', return local null device." + (if (equal vec tramp-null-hop) null-device (with-tramp-connection-property vec "null-device" (let ((default-directory (tramp-make-tramp-file-name vec))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c468c3501b..22c7fc6b2f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2122,10 +2122,10 @@ Also see `ignore'." (ert-deftest tramp-test05-expand-file-name-relative () "Check `expand-file-name'." (skip-unless (tramp--test-enabled)) - ;; The bugs are fixed in Emacs 28.1. - (skip-unless (tramp--test-emacs28-p)) ;; Methods with a share do not expand "/path/..". (skip-unless (not (tramp--test-share-p))) + ;; The bugs are fixed in Emacs 28.1. + (skip-unless (tramp--test-emacs28-p)) (should (string-equal @@ -2226,9 +2226,12 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-test07-abbreviate-file-name () "Check that Tramp abbreviates file names correctly." (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-emacs29-p)) (skip-unless (not (tramp--test-ange-ftp-p))) + ;; `abbreviate-file-name' is supported since Emacs 29.1. + (skip-unless (tramp--test-emacs29-p)) + ;; We must refill the cache. `file-truename' does it. + (file-truename tramp-test-temporary-file-directory) (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) (remote-host-nohop (tramp-make-tramp-file-name (tramp-dissect-file-name remote-host))) @@ -2261,12 +2264,12 @@ This checks also `file-name-as-directory', `file-name-directory', (setq home-dir (concat remote-host "/") home-dir-nohop (tramp-make-tramp-file-name (tramp-dissect-file-name home-dir))) - ;; The remote home directory is kept in the connection property - ;; "home-directory". We fake this setting. - (tramp-set-connection-property tramp-test-vec "home-directory" home-dir) + ;; The remote home directory is kept in the connection property "~". + ;; We fake this setting. + (tramp-set-connection-property tramp-test-vec "~" (file-local-name home-dir)) (should (equal (abbreviate-file-name (concat home-dir "foo/bar")) (concat home-dir-nohop "foo/bar"))) - (tramp-flush-connection-property tramp-test-vec "home-directory"))) + (tramp-flush-connection-property tramp-test-vec "~"))) (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." @@ -6195,7 +6198,7 @@ This requires restrictions of file name syntax." (defun tramp--test-ange-ftp-p () "Check, whether Ange-FTP is used." (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + (tramp-find-foreign-file-name-handler tramp-test-vec) 'tramp-ftp-file-name-handler)) (defun tramp--test-asynchronous-processes-p () commit d9e5ae5e20960c0818038ba64beaa330db3c64c7 Author: Eli Zaretskii Date: Mon Mar 7 14:38:01 2022 +0200 Improve wording of 'dired-jump's description * doc/emacs/dired.texi (Dired Enter): Clarify wording. Reported by Natalie . diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index f6c3e93d10..6acee25cee 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -113,11 +113,17 @@ a directory's name. @findex dired-jump-other-window @kindex C-x C-j @kindex C-x 4 C-j - Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a -Dired buffer and move point to the line corresponding to the current -file. In Dired, move up a level and go to the previous directory's -line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the -same effect but opens a new window for the Dired buffer. + You can ask Emacs to invoke Dired on the default-directory +(@pxref{File Names, default-directory}) of any buffer, by typing +@kbd{C-x C-j} (@code{dired-jump}). If the buffer visits a file, this +command will move point to that file's line in the Dired buffer it +shows; otherwise, point will end up on the first file in the directory +listing. As an exception, if you type @kbd{C-x C-j} in a Dired +buffer, Emacs displays the directory listing of the parent directory +and places point on the line that corresponds to the directory where +you invoked @code{dired-jump}. Typing @kbd{C-x 4 C-j} +(@code{dired-jump-other-window} has the same effect, but displays the +Dired buffer in a new window. The variable @code{dired-listing-switches} specifies the options to give to @command{ls} for listing the directory; this string commit c7d3ebc7fd82199bf3f943c362d835fa0f0a1be6 Author: Po Lu Date: Mon Mar 7 19:57:19 2022 +0800 ; * src/xterm.c (x_alloc_nearest_color_1): Commit missing hunk (again). diff --git a/src/xterm.c b/src/xterm.c index 76222d6256..d3e3ed3a06 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3878,10 +3878,6 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) * ((color->blue >> 8) - (cells[x].blue >> 8)))); if (trial_delta < nearest_delta) { - temp.red = cells[x].red; - temp.green = cells[x].green; - temp.blue = cells[x].blue; - nearest = x; nearest_delta = trial_delta; } commit 9e1186a73279f9e6416cc594171482be5a223820 Author: Po Lu Date: Mon Mar 7 19:56:23 2022 +0800 ; * src/xterm.c (x_alloc_nearest_color_1): Add missing part of change. diff --git a/src/xterm.c b/src/xterm.c index 1befa97fd1..76222d6256 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3878,10 +3878,10 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) * ((color->blue >> 8) - (cells[x].blue >> 8)))); if (trial_delta < nearest_delta) { - XColor temp; temp.red = cells[x].red; temp.green = cells[x].green; temp.blue = cells[x].blue; + nearest = x; nearest_delta = trial_delta; } commit f2b58db280e28b1ec1607520ef706482e14f6a57 Author: Po Lu Date: Mon Mar 7 19:53:52 2022 +0800 Fix color leak * src/xterm.c (x_alloc_nearest_color_1): Don't allocate colors multiple times when searching for a closest match. diff --git a/src/xterm.c b/src/xterm.c index 0432bd78c6..1befa97fd1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3882,12 +3882,8 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) temp.red = cells[x].red; temp.green = cells[x].green; temp.blue = cells[x].blue; - status = XAllocColor (dpy, cmap, &temp); - if (status) - { - nearest = x; - nearest_delta = trial_delta; - } + nearest = x; + nearest_delta = trial_delta; } } color->red = cells[nearest].red;