commit 04a215849cddf21c9ae99b603b26fd02aad6fc73 (HEAD, refs/remotes/origin/master) Merge: f91e87cc8a d3cde28b03 Author: Stefan Kangas Date: Sat May 28 07:06:30 2022 +0200 Merge from origin/emacs-28 d3cde28b03 Fix more occurrences of renamed kmacro-keymap command bd5c95a90d Mention "unspecified-fg" and "unspecified-bg" in some doc ... commit f91e87cc8aa4a477ef9995de5314eac6093572ef Author: Po Lu Date: Sat May 28 04:35:12 2022 +0000 Add more cursor bitmaps on Haiku * src/haikufns.c (cursor_bitmaps_for_id): Add hourglass cursor. diff --git a/src/haikufns.c b/src/haikufns.c index cf64eff702..86173c8e86 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1927,7 +1927,7 @@ struct user_cursor_bitmap_info cursor_bitmaps_for_id[28] = { NULL, NULL, 0, 0, 0, 0 }, { NULL, NULL, 0, 0, 0, 0 }, { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, { NULL, NULL, 0, 0, 0, 0 }, { NULL, NULL, 0, 0, 0, 0 }, { NULL, NULL, 0, 0, 0, 0 }, commit 79ae40c8e4dac5898d68c92f26f625ac400b960c Author: Po Lu Date: Sat May 28 10:30:45 2022 +0800 Improve documentation on what callers of `x-begin-drag' should do * doc/lispref/frames.texi (Drag and Drop): * src/xfns.c (Fx_begin_drag): Improve documentation of how the chosen action should be performed. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index e87e247496..20e9c17f1f 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4106,6 +4106,10 @@ is also a valid return value in addition to @code{XdndActionCopy} and @code{XdndActionMove}; it means that the drop target chose to perform an unspecified action, and no further processing is required by the caller. + +The caller must cooperate with the target to fully perform the action +chosen by the target. For example, callers should delete the buffer +text that was dragged if this function returns @code{XdndActionMove}. @end defun @node Color Names diff --git a/src/xfns.c b/src/xfns.c index 60b22ff145..9f218d2b7f 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6792,8 +6792,9 @@ buttons are released, then return the action chosen by the target, or starts when the mouse is pressed on FRAME, and the contents of the selection `XdndSelection' will be sent to the X window underneath the mouse pointer (the drop target) when the mouse button is released. -ACTION is a symbol which tells the target what the source will do, and -can be one of the following: + +ACTION is a symbol which tells the target what it should do, and can +be one of the following: - `XdndActionCopy', which means to copy the contents from the drag source (FRAME) to the drop target. @@ -6805,6 +6806,10 @@ can be one of the following: `XdndActionPrivate' is also a valid return value, and means that the drop target chose to perform an unspecified or unknown action. +The source is also expected to cooperate with the target to perform +the action chosen by the target. For example, callers should delete +the buffer text that was dragged if `XdndActionMove' is returned. + There are also some other valid values of ACTION that depend on details of both the drop target's implementation details and that of Emacs. For that reason, they are not mentioned here. Consult commit b52f36a33d84fad94deb2469d5b9f1bb96e2a920 Author: Po Lu Date: Sat May 28 10:21:52 2022 +0800 Improve documentation of `x-begin-drag' * src/xfns.c (Fx_begin_drag): Fix typos and improve wording. diff --git a/src/xfns.c b/src/xfns.c index 4b5d30bca2..60b22ff145 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6830,9 +6830,9 @@ is allowed to be FRAME. Otherwise, no action will be taken if the mouse buttons are released on top of FRAME. This function will sometimes return immediately if no mouse buttons -are currently held down, and should only be called in situations where -it is known that some are being held down down, such as immediately -after a `down-mouse-1' event. */) +are currently held down. It should only be called when it is known +that mouse buttons are being held down, such as immediately after a +`down-mouse-1' (or similar) event. */) (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, Lisp_Object return_frame, Lisp_Object allow_current_frame) { commit 73237458ba305506d42293beb88d26054f8a353c Author: Po Lu Date: Sat May 28 10:09:19 2022 +0800 Improve safety of various DND callbacks * src/xterm.c (x_dnd_begin_drag_and_drop): Restore selection events if DND is no longer in progress and don't call x-dnd-movement-function. diff --git a/src/xterm.c b/src/xterm.c index 94c996a11d..5c59113469 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10646,7 +10646,12 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, /* FIXME: how come this can end up with movement frames from other displays on GTK builds? */ && (FRAME_X_DISPLAY (x_dnd_movement_frame) - == FRAME_X_DISPLAY (f))) + == FRAME_X_DISPLAY (f)) + /* If both those variables are false, then F is no + longer protected from deletion by Lisp code. This + can only happen during the final iteration of the DND + event loop. */ + && (x_dnd_in_progress || x_dnd_waiting_for_finish)) { XSETFRAME (frame_object, x_dnd_movement_frame); XSETINT (x, x_dnd_movement_x); @@ -10677,14 +10682,24 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, { if (hold_quit.kind == SELECTION_REQUEST_EVENT) { - x_dnd_old_window_attrs = root_window_attrs; - x_dnd_unwind_flag = true; + /* It's not safe to run Lisp inside this function if + x_dnd_in_progress and x_dnd_waiting_for_finish + are unset, so push it back into the event queue. */ + + if (!x_dnd_in_progress && !x_dnd_waiting_for_finish) + kbd_buffer_store_event (&hold_quit); + else + { + x_dnd_old_window_attrs = root_window_attrs; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + x_handle_selection_event ((struct selection_input_event *) &hold_quit); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } - ref = SPECPDL_INDEX (); - record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); - x_handle_selection_event ((struct selection_input_event *) &hold_quit); - x_dnd_unwind_flag = false; - unbind_to (ref, Qnil); continue; } commit ac13957b86ad699a76a0b248063551f971c4cef9 Author: Po Lu Date: Sat May 28 09:37:29 2022 +0800 Fix frame destruction issues and misuse of x_get_atom_name * src/frame.c (delete_frame): Prevent deleting the dnd frame while waiting for finish as well. * src/xselect.c (Fx_get_atom_name): Clean up code and fix uninitialized use of need_sync. * src/xterm.c (x_dnd_send_unsupported_drop, x_dnd_send_drop) (handle_one_xevent): Clean up usage of x_get_atom_name. (x_get_atom_name): Accept NULL for need_sync. * src/xterm.h: Update declarations. diff --git a/src/frame.c b/src/frame.c index 252dc591bf..ea4c904e20 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1995,7 +1995,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) error ("Attempt to delete the only frame"); } #ifdef HAVE_X_WINDOWS - else if (x_dnd_in_progress && f == x_dnd_frame) + else if ((x_dnd_in_progress && f == x_dnd_frame) + || (x_dnd_waiting_for_finish && f == x_dnd_finish_frame)) error ("Attempt to delete the drop source frame"); #endif #ifdef HAVE_HAIKU diff --git a/src/xselect.c b/src/xselect.c index 3f35842daa..bfd081b1e2 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2458,24 +2458,25 @@ If the value is 0 or the atom is not known, return the empty string. */) struct x_display_info *dpyinfo; Atom atom; bool had_errors_p, need_sync; + char *name; + Lisp_Object ret; dpyinfo = FRAME_DISPLAY_INFO (f); - CONS_TO_INTEGER (value, Atom, atom); - block_input (); x_catch_errors (dpy); - char *name = atom ? x_get_atom_name (dpyinfo, atom, &need_sync) : NULL; + name = x_get_atom_name (dpyinfo, atom, &need_sync); had_errors_p = need_sync && x_had_errors_p (dpy); x_uncatch_errors_after_check (); - Lisp_Object ret = empty_unibyte_string; + + ret = empty_unibyte_string; + if (name) { if (!had_errors_p) ret = build_string (name); xfree (name); } - unblock_input (); return ret; } diff --git a/src/xterm.c b/src/xterm.c index 756f030811..94c996a11d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1011,11 +1011,16 @@ unsigned x_dnd_unsupported_event_level; /* The frame where the drag-and-drop operation originated. */ struct frame *x_dnd_frame; +/* That frame, but set when x_dnd_waiting_for_finish is true. Used to + prevent the frame from being deleted inside selection handlers and + other callbacks. */ +struct frame *x_dnd_finish_frame; + /* Flag that indicates if a drag-and-drop operation is no longer in progress, but the nested event loop should continue to run, because handle_one_xevent is waiting for the drop target to return some important information. */ -static bool x_dnd_waiting_for_finish; +bool x_dnd_waiting_for_finish; /* The display the drop target that is supposed to send information is on. */ @@ -3277,7 +3282,7 @@ x_dnd_send_unsupported_drop (struct x_display_info *dpyinfo, Window target_windo } name = x_get_atom_name (dpyinfo, x_dnd_wanted_action, - false); + NULL); if (name) { @@ -3842,7 +3847,7 @@ x_dnd_send_drop (struct frame *f, Window target, Time timestamp, lval = Qnil; atom_names = alloca (x_dnd_n_targets * sizeof *atom_names); - name = x_get_atom_name (dpyinfo, x_dnd_wanted_action, false); + name = x_get_atom_name (dpyinfo, x_dnd_wanted_action, NULL); if (!XGetAtomNames (dpyinfo->display, x_dnd_targets, x_dnd_n_targets, atom_names)) @@ -17226,6 +17231,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { x_dnd_end_window = x_dnd_last_seen_window; x_dnd_in_progress = false; + x_dnd_finish_frame = x_dnd_frame; if (x_dnd_last_seen_window != None && x_dnd_last_protocol_version != -1) @@ -18531,6 +18537,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_end_window = x_dnd_last_seen_window; x_dnd_in_progress = false; + /* This doesn't have to be marked since it + is only accessed if + x_dnd_waiting_for_finish is true, which + is only possible inside the DND event + loop where that frame is on the + stack. */ + x_dnd_finish_frame = x_dnd_frame; + if (x_dnd_last_seen_window != None && x_dnd_last_protocol_version != -1) { @@ -23830,7 +23844,10 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, dpyinfo_pointer = (char *) dpyinfo; value = NULL; - *need_sync = false; + + if (need_sync) + *need_sync = false; + buffer = alloca (45 + INT_STRLEN_BOUND (int)); switch (atom) @@ -23878,7 +23895,9 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, } name = XGetAtomName (dpyinfo->display, atom); - *need_sync = true; + + if (need_sync) + *need_sync = true; if (name) { diff --git a/src/xterm.h b/src/xterm.h index 283d4fa9b1..6c798ea246 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1603,7 +1603,9 @@ extern struct input_event xg_pending_quit_event; #endif extern bool x_dnd_in_progress; +extern bool x_dnd_waiting_for_finish; extern struct frame *x_dnd_frame; +extern struct frame *x_dnd_finish_frame; extern unsigned x_dnd_unsupported_event_level; #ifdef HAVE_XINPUT2 commit b2c8e8a299dadce7dc1bae2adf73ee9303856bb6 Author: Po Lu Date: Sat May 28 09:21:40 2022 +0800 ; * src/nsselect.m (ns_decode_data_to_pasteboard): Fix GNUstep build. diff --git a/src/nsselect.m b/src/nsselect.m index ce9d8ab318..1ff627e657 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -590,8 +590,14 @@ Updated by Christian Limpach (chris@nice.ch) [pasteboard declareTypes: new owner: nil]; + +#if NS_USE_NSPasteboardTypeFileURL [pasteboard setString: [NSString stringWithLispString: data] forType: NSPasteboardTypeFileURL]; +#else + [pasteboard setString: [NSString stringWithLispString: data] + forType: NSFilenamesPboardType]; +#endif } else signal_error ("Unknown pasteboard type", type); commit 6d6d1adbe7aa507fc15b1c6830f2eac5e7592ebc Author: Po Lu Date: Sat May 28 09:19:33 2022 +0800 Fix build on earlier versions of Mac OS X * src/nsselect.m (ns_decode_data_to_pasteboard): Respect NS_USE_NSPasteboardTypeFileUrl. diff --git a/src/nsselect.m b/src/nsselect.m index 0bd840d92b..ce9d8ab318 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -582,7 +582,11 @@ Updated by Christian Limpach (chris@nice.ch) { CHECK_STRING (data); +#if NS_USE_NSPasteboardTypeFileURL new = [types arrayByAddingObject: NSPasteboardTypeFileURL]; +#else + new = [types arrayByAddingObject: NSFilenamesPboardType]; +#endif [pasteboard declareTypes: new owner: nil]; commit ffab237cbfda5121fe9d6a1a479dbb5a4c3e5f2f Author: Po Lu Date: Sat May 28 09:18:09 2022 +0800 Add file dragging support to NS port * lisp/dired.el (dired-mouse-drag-files): Document that `dired-mouse-drag-files' now works on NS. * lisp/term/ns-win.el (x-begin-drag): Handle FILE_NAME. * src/nsselect.m (ns_decode_data_to_pasteboard): Handle file URL type. (ns_lisp_to_pasteboard, Fns_begin_drag): Handle new type `file'. diff --git a/lisp/dired.el b/lisp/dired.el index fbf26dbce7..6ed4a949e0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -254,7 +254,7 @@ The target is used in the prompt for file copy, rename etc." Dragging the mouse and then releasing it over the window of another program will result in that program opening the file, or creating a copy of it. This feature is supported only on X -Windows and Haiku. +Windows, Haiku, and Nextstep (macOS or GNUstep). If the value is `link', then a symbolic link will be created to the file instead by the other program (usually a file manager)." diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 42b8d72c26..b49143fbc2 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -903,6 +903,13 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (when (and (member "STRING" targets) (stringp ns-dnd-selection-value)) (push (cons 'string ns-dnd-selection-value) pasteboard)) + (when (and (member "FILE_NAME" targets) + (file-exists-p ns-dnd-selection-value)) + (push (cons 'file + (url-encode-url (concat "file://" + (expand-file-name + ns-dnd-selection-value)))) + pasteboard)) (ns-begin-drag frame pasteboard action))) (provide 'ns-win) diff --git a/src/nsselect.m b/src/nsselect.m index a481e80d77..0bd840d92b 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -561,17 +561,34 @@ Updated by Christian Limpach (chris@nice.ch) ns_decode_data_to_pasteboard (Lisp_Object type, Lisp_Object data, NSPasteboard *pasteboard) { + NSArray *types, *new; + + types = [pasteboard types]; + CHECK_SYMBOL (type); if (EQ (type, Qstring)) { CHECK_STRING (data); - [pasteboard declareTypes: [NSArray arrayWithObject: NSPasteboardTypeString] + new = [types arrayByAddingObject: NSPasteboardTypeString]; + + [pasteboard declareTypes: new owner: nil]; [pasteboard setString: [NSString stringWithLispString: data] forType: NSPasteboardTypeString]; } + else if (EQ (type, Qfile)) + { + CHECK_STRING (data); + + new = [types arrayByAddingObject: NSPasteboardTypeFileURL]; + + [pasteboard declareTypes: new + owner: nil]; + [pasteboard setString: [NSString stringWithLispString: data] + forType: NSPasteboardTypeFileURL]; + } else signal_error ("Unknown pasteboard type", type); } @@ -582,6 +599,9 @@ Updated by Christian Limpach (chris@nice.ch) { Lisp_Object tem, type, data; + [pasteboard declareTypes: [NSArray array] + owner: nil]; + CHECK_LIST (object); for (tem = object; CONSP (tem); tem = XCDR (tem)) { @@ -642,6 +662,9 @@ Updated by Christian Limpach (chris@nice.ch) - `string' means DATA should be a string describing text that will be dragged to another program. + - `file' means DATA should be a file URL that will be dragged to + another program. + ACTION is the action that will be taken by the drop target towards the data inside PBOARD. commit 3c5fbfe4ac52fb951918f0b0e6a10bade7590fa5 Author: Po Lu Date: Sat May 28 09:03:29 2022 +0800 Improve DND documentation * doc/lispref/frames.texi (Drag and Drop): * src/xfns.c (Fx_begin_drag): Document that x-begin-drag may return immediately if no mouse buttons are held down. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index e8765cf958..e87e247496 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -4067,7 +4067,9 @@ drag-and-drop operation ends, either because the drop was successful, or because the drop was rejected. The drop occurs when all mouse buttons are released on top of an X window other than @var{frame} (the @dfn{drop target}), or any X window if @var{allow-current-frame} is -non-@code{nil}. +non-@code{nil}. If no mouse buttons are held down when the +drag-and-drop operation begins, this function may immediately return +@code{nil}. @var{targets} is a list of strings describing selection targets, much like the @var{data-type} argument to @code{gui-get-selection}, that diff --git a/src/xfns.c b/src/xfns.c index 47321a1d6b..4b5d30bca2 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6827,7 +6827,12 @@ instead. If ALLOW-CURRENT-FRAME is not specified or nil, then the drop target is allowed to be FRAME. Otherwise, no action will be taken if the -mouse buttons are released on top of FRAME. */) +mouse buttons are released on top of FRAME. + +This function will sometimes return immediately if no mouse buttons +are currently held down, and should only be called in situations where +it is known that some are being held down down, such as immediately +after a `down-mouse-1' event. */) (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, Lisp_Object return_frame, Lisp_Object allow_current_frame) { commit 5c07aed894f9822560eabc607674b22aaaaf4780 Author: Po Lu Date: Sat May 28 08:55:13 2022 +0800 Fix x_dnd_movement_frame detection on GTK builds * src/xterm.c (x_dnd_begin_drag_and_drop): Make sure movement frame is on the correct display. diff --git a/src/xterm.c b/src/xterm.c index efa153efca..756f030811 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10637,7 +10637,11 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (event_display == FRAME_DISPLAY_INFO (f)) { #endif - if (x_dnd_movement_frame) + if (x_dnd_movement_frame + /* FIXME: how come this can end up with movement frames + from other displays on GTK builds? */ + && (FRAME_X_DISPLAY (x_dnd_movement_frame) + == FRAME_X_DISPLAY (f))) { XSETFRAME (frame_object, x_dnd_movement_frame); XSETINT (x, x_dnd_movement_x); commit 26588e9594e869d6e1d813ac4a77c035048be74d Author: Po Lu Date: Sat May 28 08:48:29 2022 +0800 ; * src/xterm.c (x_color_cache_bucket_size): Improve doc string. diff --git a/src/xterm.c b/src/xterm.c index 00df7dce34..efa153efca 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -25943,7 +25943,7 @@ operation, and TIME is the X server time when the drop happened. */); Vx_dnd_unsupported_drop_function = Qnil; DEFVAR_INT ("x-color-cache-bucket-size", x_color_cache_bucket_size, - doc: /* Most buckets allowed per display in the internal color cache. + doc: /* Max number of buckets allowed per display in the internal color cache. Values less than 1 mean 128. This option is for debugging only. */); x_color_cache_bucket_size = 128; } commit 3bbf047cd826c634b7f049e0788026747023c29c Author: Paul Eggert Date: Fri May 27 16:33:25 2022 -0700 Remove stray decl of nonexistent var * src/lisp.h (symbols_with_pos_enabled): Remove decl. diff --git a/src/lisp.h b/src/lisp.h index 9ee63428d4..95b33ff173 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -619,7 +619,6 @@ extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE; extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ -extern bool symbols_with_pos_enabled; extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); commit d9879e686d2124f28dbe15342a02166c5739abb9 Author: Paul Eggert Date: Fri May 27 12:19:43 2022 -0700 decoded-time-set-defaults now leaves DST alone * lisp/calendar/time-date.el (decoded-time-set-defaults): Don’t mess with decoded-time-dst (Bug#55635). diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index dc77a7c7e0..40374c3bb4 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -562,6 +562,9 @@ The default value is based on January 1st, 1970 at midnight. This year is used to guarantee portability; see Info node `(elisp) Time of Day'. +Optional argument DEFAULT-ZONE specifies what time zone to +default to when TIME's time zone is nil (meaning local time). + TIME is modified and returned." (unless (decoded-time-second time) (setf (decoded-time-second time) 0)) @@ -577,13 +580,11 @@ TIME is modified and returned." (unless (decoded-time-year time) (setf (decoded-time-year time) 1970)) - ;; When we don't have a time zone, default to DEFAULT-ZONE without - ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise. (unless (decoded-time-zone time) - (if default-zone - (progn (setf (decoded-time-zone time) default-zone) - (setf (decoded-time-dst time) nil)) - (setf (decoded-time-dst time) -1))) + (setf (decoded-time-zone time) default-zone)) + + ;; Do not set decoded-time-weekday or decoded-time-dst, + ;; as encode-time can infer them well enough when unknown. time) commit eb37e4814e354befaa12f80dc5e75368ad489a1e Author: Paul Eggert Date: Fri May 27 11:44:34 2022 -0700 Fix unlikely null pointer dereference * src/xselect.c (Fx_get_atom_name): Fix unlikely core dump when build_string is called on a null pointer. Found by GCC -fanalyzer. diff --git a/src/xselect.c b/src/xselect.c index ae15fecccc..3f35842daa 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2454,9 +2454,6 @@ If the value is 0 or the atom is not known, return the empty string. */) (Lisp_Object value, Lisp_Object frame) { struct frame *f = decode_window_system_frame (frame); - char *name = 0; - char empty[] = ""; - Lisp_Object ret = Qnil; Display *dpy = FRAME_X_DISPLAY (f); struct x_display_info *dpyinfo; Atom atom; @@ -2468,17 +2465,16 @@ If the value is 0 or the atom is not known, return the empty string. */) block_input (); x_catch_errors (dpy); - name = (atom ? x_get_atom_name (dpyinfo, atom, - &need_sync) : empty); + char *name = atom ? x_get_atom_name (dpyinfo, atom, &need_sync) : NULL; had_errors_p = need_sync && x_had_errors_p (dpy); x_uncatch_errors_after_check (); - - if (!had_errors_p) - ret = build_string (name); - - if (atom && name) xfree (name); - if (NILP (ret)) ret = empty_unibyte_string; - + Lisp_Object ret = empty_unibyte_string; + if (name) + { + if (!had_errors_p) + ret = build_string (name); + xfree (name); + } unblock_input (); return ret; commit cb57db513b3b5e2c5e09d197e63d6a921188d599 Author: Paul Eggert Date: Fri May 27 11:27:08 2022 -0700 Add ATTRIBUTE_DEALLOC to extern functions This can help static checking. It’s not as important for static functions, where GCC can figure this stuff out own its own. * src/sysstdio.h (emacs_fopen): Add ATTRIBUTE_DEALLOC (fclose, 1). * src/tparam.h (tparam): Add ATTRIBUTE_DEALLOC_FREE. Include stdlib.h so that ‘free’ is declared. * src/xterm.h (x_get_atom_name): Add ATTRIBUTE_DEALLOC_FREE. diff --git a/src/sysstdio.h b/src/sysstdio.h index 727a466be5..efedc3e450 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -28,7 +28,8 @@ along with GNU Emacs. If not, see . */ #include #include -extern FILE *emacs_fopen (char const *, char const *) ATTRIBUTE_MALLOC; +extern FILE *emacs_fopen (char const *, char const *) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC (fclose, 1); extern void errputc (int); extern void errwrite (void const *, ptrdiff_t); extern void close_output_streams (void); diff --git a/src/tparam.h b/src/tparam.h index 653f01bdde..4f4bdc8820 100644 --- a/src/tparam.h +++ b/src/tparam.h @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_TPARAM_H #define EMACS_TPARAM_H +#include + #include /* Don't try to include termcap.h. On some systems, configure finds a @@ -32,7 +34,8 @@ int tgetnum (const char *); char *tgetstr (const char *, char **); char *tgoto (const char *, int, int); -char *tparam (const char *, char *, int, int, int, int, int) ATTRIBUTE_MALLOC; +char *tparam (const char *, char *, int, int, int, int, int) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; extern char PC; extern char *BC; diff --git a/src/xterm.h b/src/xterm.h index 329fa4c84f..283d4fa9b1 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1542,7 +1542,7 @@ extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object); extern Atom x_intern_cached_atom (struct x_display_info *, const char *, bool); extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) - ATTRIBUTE_MALLOC; + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); commit 7f3d781dab9a7a153badb62fd538908cb6595105 Author: Paul Eggert Date: Fri May 27 10:50:56 2022 -0700 Pacify gcc -Wsuggest-attribute-malloc * src/xterm.h (x_get_atom_name): Add ATTRIBUTE_MALLOC. diff --git a/src/xterm.h b/src/xterm.h index fbb381d066..329fa4c84f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1541,7 +1541,8 @@ extern void x_set_pending_dnd_time (Time); extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object); extern Atom x_intern_cached_atom (struct x_display_info *, const char *, bool); -extern char *x_get_atom_name (struct x_display_info *, Atom, bool *); +extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) + ATTRIBUTE_MALLOC; #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); commit 6c4d767019c69e0c3a6b464a5856eb7655022e38 Author: Juri Linkov Date: Fri May 27 19:13:09 2022 +0300 Fix navigation in the *Completions* buffer and enable more tests (bug#54374) * lisp/ido.el: Use first-completion instead of next-completion. * lisp/minibuffer.el (completion--insert): Put completion--string text property on prefix and suffix as well. * lisp/simple.el (first-completion, last-completion): New commands. (next-completion): Rewrite to fix many bugs reported in bug#54374, bug#55289, bug#55430. (choose-completion): Use the text property completion--string that allows to select a completion when point is on its prefix or suffix. (switch-to-completions): Use first-completion instead of next-completion, and last-completion instead of previous-completion. * test/lisp/minibuffer-tests.el (completion-auto-select-test) (completion-auto-wrap-test, completions-header-format-test) (completions-affixation-navigation-test): Uncomment fixed lines. diff --git a/lisp/ido.el b/lisp/ido.el index e5717d6e53..73cd163d46 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3939,7 +3939,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil." ;; In the new buffer, go to the first completion. ;; FIXME: Perhaps this should be done in `ido-completion-help'. (when (bobp) - (next-completion 1))))) + (first-completion))))) (defun ido-completion-auto-help () "Call `ido-completion-help' if `completion-auto-help' is non-nil." diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6694340e02..6ae25b8def 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2074,11 +2074,11 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a (when prefix (let ((beg (point)) (end (progn (insert prefix) (point)))) - (put-text-property beg end 'mouse-face nil))) + (add-text-properties beg end `(mouse-face nil completion--string ,(car str))))) (completion--insert (car str) group-fun) (let ((beg (point)) (end (progn (insert suffix) (point)))) - (put-text-property beg end 'mouse-face nil) + (add-text-properties beg end `(mouse-face nil completion--string ,(car str))) ;; Put the predefined face only when suffix ;; is added via annotation-function without prefix, ;; and when the caller doesn't use own face. diff --git a/lisp/simple.el b/lisp/simple.el index 420718869a..db52d83cea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9521,6 +9521,24 @@ the completions is popped up and down." :version "29.1" :group 'completion) +(defun first-completion () + "Move to the first item in the completion list." + (interactive) + (goto-char (point-min)) + (unless (get-text-property (point) 'mouse-face) + (when-let ((pos (next-single-property-change (point) 'mouse-face))) + (goto-char pos)))) + +(defun last-completion () + "Move to the last item in the completion list." + (interactive) + (goto-char (previous-single-property-change + (point-max) 'mouse-face nil (point-min))) + ;; Move to the start of last one. + (unless (get-text-property (point) 'mouse-face) + (when-let ((pos (previous-single-property-change (point) 'mouse-face))) + (goto-char pos)))) + (defun previous-completion (n) "Move to the previous item in the completion list. With prefix argument N, move back N items (negative N means move @@ -9537,60 +9555,51 @@ backward). Also see the `completion-wrap-movement' variable." (interactive "p") - (let ((prev (previous-single-property-change (point) 'mouse-face))) - (goto-char (cond - ((not prev) - (1- (next-single-property-change (point) 'mouse-face))) - ((/= prev (point)) - (point)) - (t prev)))) - - (let ((beg (point-min)) - (end (point-max)) - (tabcommand (member (this-command-keys) '("\t" [backtab]))) - prop) + (let ((tabcommand (member (this-command-keys) '("\t" [backtab]))) + pos) (catch 'bound (while (> n 0) + (setq pos (point)) ;; If in a completion, move to the end of it. - (when (get-text-property (point) 'mouse-face) - (goto-char (next-single-property-change (point) 'mouse-face nil end))) - ;; If at the last completion option, wrap or skip to the - ;; minibuffer, if requested. We can't use (eobp) because some - ;; extra text may be after the last candidate: ex: when - ;; completion-detailed - (setq prop (next-single-property-change (point) 'mouse-face nil end)) - (when (and completion-wrap-movement (eq end prop)) - (if (and completion-auto-select tabcommand) - (throw 'bound nil) - (goto-char (point-min)))) - ;; Move to start of next one. - (unless (get-text-property (point) 'mouse-face) - (goto-char (next-single-property-change (point) 'mouse-face nil end))) + (when (get-text-property pos 'mouse-face) + (setq pos (next-single-property-change pos 'mouse-face))) + (when pos (setq pos (next-single-property-change pos 'mouse-face))) + (if pos + ;; Move to the start of next one. + (goto-char pos) + ;; If at the last completion option, wrap or skip + ;; to the minibuffer, if requested. + (when completion-wrap-movement + (if (and (eq completion-auto-select t) tabcommand) + (throw 'bound nil) + (first-completion)))) (setq n (1- n))) - (while (and (< n 0) (not (bobp))) - (setq prop (get-text-property (1- (point)) 'mouse-face)) + (while (< n 0) + (setq pos (point)) ;; If in a completion, move to the start of it. - (when (and prop (eq prop (get-text-property (point) 'mouse-face))) - (goto-char (previous-single-property-change - (point) 'mouse-face nil beg))) - ;; Move to end of the previous completion. - (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face)) - (goto-char (previous-single-property-change - (point) 'mouse-face nil beg))) - ;; If at the first completion option, wrap or skip to the - ;; minibuffer, if requested. - (setq prop (previous-single-property-change (point) 'mouse-face nil beg)) - (when (and completion-wrap-movement (eq beg prop)) - (if (and completion-auto-select tabcommand) - (progn - (goto-char (next-single-property-change (point) 'mouse-face nil end)) - (throw 'bound nil)) - (goto-char (point-max)))) - ;; Move to the start of that one. - (goto-char (previous-single-property-change - (point) 'mouse-face nil beg)) + (when (and (get-text-property pos 'mouse-face) + (not (bobp)) + (get-text-property (1- pos) 'mouse-face)) + (setq pos (previous-single-property-change pos 'mouse-face))) + (when pos (setq pos (previous-single-property-change pos 'mouse-face))) + (if pos + (progn + (goto-char pos) + ;; Move to the start of that one. + (unless (get-text-property (point) 'mouse-face) + (goto-char (previous-single-property-change + (point) 'mouse-face nil (point-min))))) + ;; If at the first completion option, wrap or skip + ;; to the minibuffer, if requested. + (when completion-wrap-movement + (if (and (eq completion-auto-select t) tabcommand) + (progn + ;; (goto-char (next-single-property-change (point) 'mouse-face)) + (throw 'bound nil)) + (last-completion)))) (setq n (1+ n)))) + (when (/= 0 n) (switch-to-minibuffer)))) @@ -9618,13 +9627,16 @@ minibuffer, but don't quit the completions window." (goto-char (posn-point (event-start event))) (let (beg) (cond - ((and (not (eobp)) (get-text-property (point) 'mouse-face)) + ((and (not (eobp)) + (get-text-property (point) 'completion--string)) (setq beg (1+ (point)))) ((and (not (bobp)) - (get-text-property (1- (point)) 'mouse-face)) + (get-text-property (1- (point)) 'completion--string)) (setq beg (point))) (t (error "No completion here"))) - (setq beg (previous-single-property-change beg 'mouse-face)) + (setq beg (or (previous-single-property-change + beg 'completion--string) + beg)) (substring-no-properties (get-text-property beg 'completion--string)))))) @@ -9830,8 +9842,8 @@ select the completion near point.\n\n"))))) ((and (memq this-command '(completion-at-point minibuffer-complete)) (equal (this-command-keys) [backtab])) (goto-char (point-max)) - (previous-completion 1)) - (t (next-completion 1)))))) + (last-completion)) + (t (first-completion)))))) (defun read-expression-switch-to-completions () "Select the completion list window while reading an expression." diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 9111b5f4a8..56db00a124 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -365,6 +365,12 @@ (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (execute-kbd-macro (kbd "a TAB")) + (should (and (get-buffer-window "*Completions*" 0) + (eq (current-buffer) (get-buffer "*Completions*")))) + (execute-kbd-macro (kbd "TAB TAB TAB")) + (should (and (get-buffer-window "*Completions*" 0) + (eq (current-buffer) (get-buffer " *Minibuf-1*")))) + (execute-kbd-macro (kbd "S-TAB")) (should (and (get-buffer-window "*Completions*" 0) (eq (current-buffer) (get-buffer "*Completions*")))))) (let ((completion-auto-select 'second-tab)) @@ -386,11 +392,11 @@ (should (equal "aa" (get-text-property (point) 'completion--string))) (next-completion 2) (should (equal "ac" (get-text-property (point) 'completion--string))) - ;; FIXME: bug#54374 - ;; (next-completion 1) - ;; (should (equal "ac" (get-text-property (point) 'completion--string))) - (previous-completion 1) - (should (equal "ab" (get-text-property (point) 'completion--string))))) + ;; Fixed in bug#54374 + (next-completion 5) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-completion 5) + (should (equal "aa" (get-text-property (point) 'completion--string))))) (let ((completion-wrap-movement t)) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") @@ -406,30 +412,32 @@ (should (equal "ac" (get-text-property (point) 'completion--string)))))) (ert-deftest completions-header-format-test () - (let ((completions-header-format nil) - (completion-show-help nil)) + (let ((completion-show-help nil) + (completions-header-format nil)) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (insert "a") (minibuffer-completion-help) (switch-to-completions) - ;; FIXME: bug#55430 - ;; (should (equal "aa" (get-text-property (point) 'completion--string))) - ;; FIXME: bug#54374 - ;; (previous-completion 1) - ;; (should (equal "ac" (get-text-property (point) 'completion--string))) - ;; (next-completion 1) - ;; (should (equal "aa" (get-text-property (point) 'completion--string))) - ;; FIXME: bug#55430 - ;; (choose-completion nil t) - ;; (should (equal (minibuffer-contents) "aa")) - ) + ;; Fixed in bug#55430 + (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-completion 2) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (previous-completion 2) + (should (equal "aa" (get-text-property (point) 'completion--string))) + ;; Fixed in bug#54374 + (previous-completion 1) + (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-completion 1) + (should (equal "aa" (get-text-property (point) 'completion--string))) + ;; Fixed in bug#55430 + (execute-kbd-macro (kbd "C-u RET")) + (should (equal (minibuffer-contents) "aa"))) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") - ;; FIXME: bug#55289 - ;; (execute-kbd-macro (kbd "a M- M-")) - ;; (should (equal (minibuffer-contents) "aa")) - ))) + ;; Fixed in bug#55289 + (execute-kbd-macro (kbd "a M- M-")) + (should (equal (minibuffer-contents) "aa"))))) (ert-deftest completions-affixation-navigation-test () (let ((completion-extra-properties @@ -445,14 +453,19 @@ (switch-to-completions) (should (equal 'highlight (get-text-property (point) 'mouse-face))) (should (equal "aa" (get-text-property (point) 'completion--string))) - (next-completion 1) + (let ((completion-wrap-movement t)) + (next-completion 3)) + (should (equal 'highlight (get-text-property (point) 'mouse-face))) + (should (equal "aa" (get-text-property (point) 'completion--string))) + (let ((completion-wrap-movement nil)) + (next-completion 3)) (should (equal 'highlight (get-text-property (point) 'mouse-face))) - (should (equal "ab" (get-text-property (point) 'completion--string))) + (should (equal "ac" (get-text-property (point) 'completion--string))) + ;; Fixed in bug#54374 (goto-char (1- (point-max))) - ;; FIXME: bug#54374 - ;; (choose-completion nil t) - ;; (should (equal (minibuffer-contents) "ac")) - ))) + (should-not (equal 'highlight (get-text-property (point) 'mouse-face))) + (execute-kbd-macro (kbd "C-u RET")) + (should (equal (minibuffer-contents) "ac"))))) (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here commit 4df20e2f14ac6f1bae2730e2f9afed8e83dd78de Author: Eli Zaretskii Date: Fri May 27 18:41:12 2022 +0300 Extend 'C-x 8 =' to produce characters with macron * lisp/international/iso-transl.el (iso-transl-char-map): Add several new sequences for characters with macron. (Bug#55668) diff --git a/etc/NEWS b/etc/NEWS index 3065fa85d3..90d03f8fa8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -203,6 +203,13 @@ files that were compiled with an old EIEIO (Emacs<25). ** 'C-x 8 .' has been moved to 'C-x 8 . .'. This is to open up the 'C-x 8 .' map to bind further characters there. +--- +** 'C-x 8 =' moved to 'C-x 8 = ='. +You can now use 'C-x 8 =' to insert several characters with macron; +for example, 'C-x 8 = a' will insert U+0101 LATIN SMALL LETTER A WITH +MACRON. To insert a lone macron, type 'C-x 8 = =' instead of the +previous 'C-x ='. + ** Eshell --- diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index b90c065461..bdfe9b1670 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -134,7 +134,19 @@ ("*<" . [?«]) ("<" . [?«]) ("*=" . [?¯]) - ("=" . [?¯]) + ("==" . [?¯]) + ("=A" . [?Ā]) + ("=a" . [?ā]) + ("=E" . [?Ē]) + ("=e" . [?ē]) + ("=I" . [?Ī]) + ("=i" . [?ī]) + ("=O" . [?Ō]) + ("=o" . [?ō]) + ("=U" . [?Ū]) + ("=u" . [?ū]) + ("=Y" . [?Ȳ]) + ("=y" . [?ȳ]) ("*>" . [?»]) (">" . [?»]) ("*?" . [?¿]) commit f8b2a01a9eea84e374ec65bdfb0ddf31e486d374 Author: Stefan Monnier Date: Fri May 27 09:14:40 2022 -0400 * lisp/shell.el (shell): Query shell file name from `interactive` This avoids the use of the brittle `called-interactively-p` and makes it easier to start a shell buffer running another shell than your usual one. diff --git a/lisp/shell.el b/lisp/shell.el index 4e65fccf9e..1fcd1a1d1c 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -719,7 +719,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." (insert (format "\nProcess %s %s\n" process event)))))) ;;;###autoload -(defun shell (&optional buffer) +(defun shell (&optional buffer file-name) "Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*'). Interactively, a prefix arg means to prompt for BUFFER. If `default-directory' is a remote file name, it is also prompted @@ -730,6 +730,8 @@ If BUFFER exists and shell process is running, just switch to BUFFER. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or (if that is nil) from `shell-file-name'. +Non-interactively, it can also be specified via the FILE-NAME arg. + If a file `~/.emacs_SHELLNAME' exists, or `~/.emacs.d/init_SHELLNAME.sh', it is given as initial input (but this may be lost, due to a timing error, if the shell discards input when it starts up). @@ -771,7 +773,20 @@ Make the shell buffer the current buffer, and return it. (expand-file-name (read-directory-name "Default directory: " default-directory default-directory - t nil)))))))) + t nil)))))) + ;; On remote hosts, the local `shell-file-name' might be useless. + (when (and (file-remote-p default-directory) + (null explicit-shell-file-name) + (null (getenv "ESHELL"))) + ;; `expand-file-name' shall not add the MS Windows volume letter + ;; (Bug#49229). + (replace-regexp-in-string + "^[[:alpha:]]:" "" + (file-local-name + (expand-file-name + (read-file-name "Remote shell path: " default-directory + shell-file-name t shell-file-name + #'file-remote-p))))))) (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode)) (comint-check-proc (current-buffer))) (get-buffer-create (or buffer "*shell*")) @@ -782,21 +797,8 @@ Make the shell buffer the current buffer, and return it. (pop-to-buffer buffer display-comint-buffer-action) (with-connection-local-variables - ;; On remote hosts, the local `shell-file-name' might be useless. - (when (and (file-remote-p default-directory) - (called-interactively-p 'any) - (null explicit-shell-file-name) - (null (getenv "ESHELL"))) - ;; `expand-file-name' shall not add the MS Windows volume letter - ;; (Bug#49229). - (setq-local explicit-shell-file-name - (replace-regexp-in-string - "^[[:alpha:]]:" "" - (file-local-name - (expand-file-name - (read-file-name "Remote shell path: " default-directory - shell-file-name t shell-file-name - #'file-remote-p)))))) + (when file-name + (setq-local explicit-shell-file-name file-name)) ;; Rain or shine, BUFFER must be current by now. (unless (comint-check-proc buffer) commit 8399c6a82127f3c6a2e5f781122567d27ae799f8 Author: Eli Zaretskii Date: Fri May 27 15:07:33 2022 +0300 Improve font selection on MS-Windows The Arial Unicode MS font claims in its USB (Unicode Subset Bitfields) values support for several scripts for which it doesn't actually have glyphs. This sometimes caused Emacs to decide to use Arial Unicode MS for some script, only to discover later that there are no glyphs for that script's characters. This change fixes the USB values according to actual font coverage, as determined by BabelMap. * src/w32font.c (add_font_entity_to_list): Fix USB values of Arial Unicode MS font according to its actual coverage of scripts. diff --git a/src/w32font.c b/src/w32font.c index 4e60b818ce..611a0c8965 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1540,6 +1540,19 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, || physical_font->ntmFontSig.fsUsb[1] || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff; + /* Kludgey fix for Arial Unicode MS font that claims support for + scripts it doesn't actually cover. */ + if (strncmp (logical_font->elfLogFont.lfFaceName, + "Arial Unicode MS", 16) == 0) + { + /* Reset bits 4 (Phonetic), 12 (Vai), 14 (Nko), 27 (Balinese). */ + physical_font->ntmFontSig.fsUsb[0] &= 0xf7ffafef; + /* Reset bits 53 (Phags-pa) and 58 (Phoenician). */ + physical_font->ntmFontSig.fsUsb[1] &= 0xfbdfffff; + /* Set bit 70 (Tibetan). */ + physical_font->ntmFontSig.fsUsb[2] |= 0x00000040; + } + /* Skip non matching fonts. */ /* For uniscribe backend, consider only truetype or opentype fonts commit a83e75b207c9678394e3e4c29a2dd592d06bbbe6 Author: Lars Ingebrigtsen Date: Fri May 27 12:38:02 2022 +0200 Make make-decoded-time use -1 for dst unless given * lisp/calendar/time-date.el (make-decoded-time): DST -1 is the value for "doesn't know", not nil (bug#55635). diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index ba7c48b290..dc77a7c7e0 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -552,7 +552,7 @@ changes in daylight saving time are not taken into account." (cl-defun make-decoded-time (&key second minute hour day month year - dst zone) + (dst -1) zone) "Return a `decoded-time' structure with only the keywords given filled out." (list second minute hour day month year nil dst zone)) commit fd4a0c022b7406b9d2a947937600e34e5cccb9bf Author: Lars Ingebrigtsen Date: Fri May 27 12:17:28 2022 +0200 Make package-update-all also refresh the list * lisp/emacs-lisp/package.el (package-update-all): Also refresh package list. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f4872a1a52..b340848a6f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2168,10 +2168,11 @@ to install it but still mark it as selected." ;;;###autoload (defun package-update-all (&optional query) - "Upgrade all packages. + "Refresh package list and upgrade all packages. If QUERY, ask the user before updating packages. When called interactively, QUERY is always true." (interactive (list (not noninteractive))) + (package-refresh-contents) (let ((updateable (package--updateable-packages))) (if (not updateable) (message "No packages to update") commit 82b75a97ba2c26bcdb83c3109401d97e6293a63f Author: Po Lu Date: Fri May 27 17:11:59 2022 +0800 Fix GNUstep build * src/nsterm.h (NSPasteboardNameGeneral): Fix definition. diff --git a/src/nsterm.h b/src/nsterm.h index 43f21b0357..f74c457fe3 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1331,7 +1331,7 @@ enum NSWindowTabbingMode #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_13) /* Deprecated in macOS 10.13. */ #define NSPasteboardNameGeneral NSGeneralPboard -#define NSPasteboardNameDrag NSDragPBoard +#define NSPasteboardNameDrag NSDragPboard #endif #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_14) commit 5d2523dcd035b2ac058abc9962405422e9717ea1 Author: Po Lu Date: Fri May 27 17:11:07 2022 +0800 Fix NS drag and drop on macOS * lisp/term/ns-win.el (gui-backend-set-selection): * src/nsselect.m (Fns_begin_drag): Fix deprecation warnings and selection/value mixup. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 0b0775f10a..42b8d72c26 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -879,7 +879,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (cl-defmethod gui-backend-set-selection (selection value &context (window-system ns)) (if (eq selection 'XdndSelection) - (setq ns-dnd-selection-value selection) + (setq ns-dnd-selection-value value) (if value (ns-own-selection-internal selection value) (ns-disown-selection-internal selection)))) diff --git a/src/nsselect.m b/src/nsselect.m index f7a8933c85..a481e80d77 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -656,7 +656,7 @@ nil if no action was performed (either because there was no drop NSDragOperation operation; f = decode_window_system_frame (frame); - pasteboard = [NSPasteboard pasteboardWithName: NSDragPboard]; + pasteboard = [NSPasteboard pasteboardWithName: NSPasteboardNameDrag]; window = (EmacsWindow *) [FRAME_NS_VIEW (f) window]; operation = ns_dnd_action_to_operation (action); commit 01e3345b7bac8f8e79433360e3f2a6fa089c8ff7 Merge: 27de58af8b 758fed537b Author: Po Lu Date: Fri May 27 16:34:28 2022 +0800 Merge remote-tracking branch 'origin/master' into x-window-xwidget commit 27de58af8b3a7617868408886f94bb12f7785800 Author: Po Lu Date: Fri May 27 16:33:12 2022 +0800 Implement some drag and drop functions on NS * lisp/term/ns-win.el (ns-selection-exists-p): (gui-backend-set-selection): (x-begin-drag): New functions and selection types. * src/nsfns.m (Fns_get_resource): (Fns_set_resource): (Fx_server_max_request_size): Fix coding style. * src/nsselect.m (ns_decode_data_to_pasteboard): (ns_lisp_to_pasteboard): (ns_dnd_action_to_operation): (ns_dnd_action_from_operation): (Fns_begin_drag): New functions. (syms_of_nsselect): New subrs. * src/nsterm.h (EmacsWindow): New fields and messages. (NSPasteboardNameGeneral): New define. * src/nsterm.m ([EmacsView mouseDown:]): Store last mouse event. ([EmacsWindow initWithEmacsFrame:fullscreen:screen:]): Clear that event. ([EmacsWindow dealloc]): Free last mouse event. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 6a414d83f1..0b0775f10a 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -870,12 +870,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function ns-disown-selection-internal "nsselect.m" (selection)) (declare-function ns-selection-owner-p "nsselect.m" (&optional selection)) (declare-function ns-selection-exists-p "nsselect.m" (&optional selection)) +(declare-function ns-begin-drag "nsselect.m") + +(defvar ns-dnd-selection-value nil + "The value of the special `XdndSelection' selection on NS.") + (declare-function ns-get-selection "nsselect.m" (selection-symbol target-type)) -(cl-defmethod gui-backend-set-selection (selection value - &context (window-system ns)) - (if value (ns-own-selection-internal selection value) - (ns-disown-selection-internal selection))) +(cl-defmethod gui-backend-set-selection (selection value &context (window-system ns)) + (if (eq selection 'XdndSelection) + (setq ns-dnd-selection-value selection) + (if value (ns-own-selection-internal selection value) + (ns-disown-selection-internal selection)))) (cl-defmethod gui-backend-selection-owner-p (selection &context (window-system ns)) @@ -889,6 +895,16 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") &context (window-system ns)) (ns-get-selection selection-symbol target-type)) +(defun x-begin-drag (targets &optional action frame _return-frame _allow-current-frame) + "SKIP: real doc in xfns.c." + (unless ns-dnd-selection-value + (error "No local value for XdndSelection")) + (let ((pasteboard nil)) + (when (and (member "STRING" targets) + (stringp ns-dnd-selection-value)) + (push (cons 'string ns-dnd-selection-value) pasteboard)) + (ns-begin-drag frame pasteboard action))) + (provide 'ns-win) (provide 'term/ns-win) diff --git a/src/nsfns.m b/src/nsfns.m index 20c36209eb..1593338dc9 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1859,7 +1859,7 @@ Frames are listed from topmost (first) to bottommost (last). */) DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0, doc: /* Return the value of the property NAME of OWNER from the defaults database. If OWNER is nil, Emacs is assumed. */) - (Lisp_Object owner, Lisp_Object name) + (Lisp_Object owner, Lisp_Object name) { const char *value; @@ -1880,7 +1880,7 @@ Frames are listed from topmost (first) to bottommost (last). */) doc: /* Set property NAME of OWNER to VALUE, from the defaults database. If OWNER is nil, Emacs is assumed. If VALUE is nil, the default is removed. */) - (Lisp_Object owner, Lisp_Object name, Lisp_Object value) + (Lisp_Object owner, Lisp_Object name, Lisp_Object value) { check_window_system (NULL); if (NILP (owner)) @@ -1907,7 +1907,7 @@ Frames are listed from topmost (first) to bottommost (last). */) Sx_server_max_request_size, 0, 1, 0, doc: /* SKIP: real doc in xfns.c. */) - (Lisp_Object terminal) + (Lisp_Object terminal) { check_ns_display_info (terminal); /* This function has no real equivalent under Nextstep. Return nil to diff --git a/src/nsselect.m b/src/nsselect.m index a7ef9df0e0..f7a8933c85 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -17,13 +17,11 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -/* -Originally by Carl Edman -Updated by Christian Limpach (chris@nice.ch) -OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) -macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net) -GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) -*/ +/* Originally by Carl Edman + Updated by Christian Limpach (chris@nice.ch) + OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) + macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net) + GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) */ /* This should be the first include, as it may set up #defines affecting interpretation of even the system includes. */ @@ -559,6 +557,117 @@ Updated by Christian Limpach (chris@nice.ch) nil] retain]; } +static void +ns_decode_data_to_pasteboard (Lisp_Object type, Lisp_Object data, + NSPasteboard *pasteboard) +{ + CHECK_SYMBOL (type); + + if (EQ (type, Qstring)) + { + CHECK_STRING (data); + + [pasteboard declareTypes: [NSArray arrayWithObject: NSPasteboardTypeString] + owner: nil]; + [pasteboard setString: [NSString stringWithLispString: data] + forType: NSPasteboardTypeString]; + } + else + signal_error ("Unknown pasteboard type", type); +} + +static void +ns_lisp_to_pasteboard (Lisp_Object object, + NSPasteboard *pasteboard) +{ + Lisp_Object tem, type, data; + + CHECK_LIST (object); + for (tem = object; CONSP (tem); tem = XCDR (tem)) + { + maybe_quit (); + + type = Fcar (Fcar (tem)); + data = Fcdr (Fcar (tem)); + + ns_decode_data_to_pasteboard (type, data, pasteboard); + } + CHECK_LIST_END (tem, object); +} + +static NSDragOperation +ns_dnd_action_to_operation (Lisp_Object action) +{ + if (EQ (action, QXdndActionCopy)) + return NSDragOperationCopy; + + if (EQ (action, QXdndActionMove)) + return NSDragOperationMove; + + if (EQ (action, QXdndActionLink)) + return NSDragOperationLink; + + signal_error ("Unsupported drag-and-drop action", action); +} + +static Lisp_Object +ns_dnd_action_from_operation (NSDragOperation operation) +{ + switch (operation) + { + case NSDragOperationCopy: + return QXdndActionCopy; + + case NSDragOperationMove: + return QXdndActionMove; + + case NSDragOperationLink: + return QXdndActionLink; + + case NSDragOperationNone: + return Qnil; + + default: + return QXdndActionPrivate; + } +} + +DEFUN ("ns-begin-drag", Fns_begin_drag, Sns_begin_drag, 3, 3, 0, + doc: /* Begin a drag-and-drop operation on FRAME. + +FRAME must be a window system frame. PBOARD is an alist of (TYPE +. DATA), where TYPE is one of the following data types that determine +the meaning of DATA: + + - `string' means DATA should be a string describing text that will + be dragged to another program. + +ACTION is the action that will be taken by the drop target towards the +data inside PBOARD. + +Return the action that the drop target actually chose to perform, or +nil if no action was performed (either because there was no drop +target, or the drop was rejected). */) + (Lisp_Object frame, Lisp_Object pboard, Lisp_Object action) +{ + struct frame *f; + NSPasteboard *pasteboard; + EmacsWindow *window; + NSDragOperation operation; + + f = decode_window_system_frame (frame); + pasteboard = [NSPasteboard pasteboardWithName: NSDragPboard]; + window = (EmacsWindow *) [FRAME_NS_VIEW (f) window]; + + operation = ns_dnd_action_to_operation (action); + ns_lisp_to_pasteboard (pboard, pasteboard); + + operation = [window beginDrag: operation + forPasteboard: pasteboard]; + + return ns_dnd_action_from_operation (operation); +} + void syms_of_nsselect (void) { @@ -568,12 +677,17 @@ Updated by Christian Limpach (chris@nice.ch) DEFSYM (QFILE_NAME, "FILE_NAME"); DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (QXdndActionCopy, "XdndActionCopy"); + DEFSYM (QXdndActionMove, "XdndActionMove"); + DEFSYM (QXdndActionLink, "XdndActionLink"); + DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); defsubr (&Sns_disown_selection_internal); defsubr (&Sns_get_selection); defsubr (&Sns_own_selection_internal); defsubr (&Sns_selection_exists_p); defsubr (&Sns_selection_owner_p); + defsubr (&Sns_begin_drag); Vselection_alist = Qnil; staticpro (&Vselection_alist); diff --git a/src/nsterm.h b/src/nsterm.h index 2c46298a93..43f21b0357 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -412,19 +412,27 @@ typedef id instancetype; @interface EmacsWindow : NSWindow { NSPoint grabOffset; + NSEvent *last_drag_event; + NSDragOperation drag_op; + NSDragOperation selected_op; } #ifdef NS_IMPL_GNUSTEP - (NSInteger) orderedIndex; #endif -- (instancetype)initWithEmacsFrame:(struct frame *)f; -- (instancetype)initWithEmacsFrame:(struct frame *)f fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen; -- (void)createToolbar:(struct frame *)f; -- (void)setParentChildRelationships; -- (NSInteger)borderWidth; -- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above; -- (void)setAppearance; +- (instancetype) initWithEmacsFrame: (struct frame *) f; +- (instancetype) initWithEmacsFrame: (struct frame *) f + fullscreen: (BOOL) fullscreen + screen: (NSScreen *) screen; +- (void) createToolbar: (struct frame *) f; +- (void) setParentChildRelationships; +- (NSInteger) borderWidth; +- (BOOL) restackWindow: (NSWindow *) win above: (BOOL) above; +- (void) setAppearance; +- (void) setLastDragEvent: (NSEvent *) event; +- (NSDragOperation) beginDrag: (NSDragOperation) op + forPasteboard: (NSPasteboard *) pasteboard; @end @@ -1323,6 +1331,7 @@ enum NSWindowTabbingMode #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_13) /* Deprecated in macOS 10.13. */ #define NSPasteboardNameGeneral NSGeneralPboard +#define NSPasteboardNameDrag NSDragPBoard #endif #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_14) diff --git a/src/nsterm.m b/src/nsterm.m index d7e62a70c4..79e30d6ff9 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7059,6 +7059,7 @@ - (void)mouseDown: (NSEvent *)theEvent { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; + EmacsWindow *window; NSTRACE ("[EmacsView mouseDown:]"); @@ -7070,6 +7071,9 @@ - (void)mouseDown: (NSEvent *)theEvent button clicks. */ emacsframe->mouse_moved = 0; + window = (EmacsWindow *) [self window]; + [window setLastDragEvent: theEvent]; + if ([theEvent type] == NSEventTypeScrollWheel) { #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 @@ -8859,6 +8863,8 @@ - (instancetype) initWithEmacsFrame: (struct frame *) f | NSWindowStyleMaskMiniaturizable | NSWindowStyleMaskClosable); + last_drag_event = nil; + width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols); height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines); @@ -8974,6 +8980,11 @@ - (void)dealloc /* We need to release the toolbar ourselves. */ [[self toolbar] release]; + + /* Also the last button press event . */ + if (last_drag_event) + [last_drag_event release]; + [super dealloc]; } @@ -9498,6 +9509,55 @@ - (BOOL)canBecomeMainWindow return YES; } +- (void) setLastDragEvent: (NSEvent *) event +{ + if (last_drag_event) + [last_drag_event release]; + last_drag_event = [event copy]; +} + +- (NSDragOperation) draggingSourceOperationMaskForLocal: (BOOL) is_local +{ + return drag_op; +} + +- (void) draggedImage: (NSImage *) image + endedAt: (NSPoint) screen_point + operation: (NSDragOperation) operation +{ + selected_op = operation; +} + +- (NSDragOperation) beginDrag: (NSDragOperation) op + forPasteboard: (NSPasteboard *) pasteboard +{ + NSImage *image; + + drag_op = op; + selected_op = NSDragOperationNone; + image = [[NSImage alloc] initWithSize: NSMakeSize (1.0, 1.0)]; + + /* Now draw transparency onto the image. */ + [image lockFocus]; + [[NSColor colorWithUnsignedLong: 0] set]; + NSRectFillUsingOperation (NSMakeRect (0, 0, 1, 1), + NSCompositingOperationCopy); + [image unlockFocus]; + + if (last_drag_event) + [self dragImage: image + at: NSMakePoint (0, 0) + offset: NSMakeSize (0, 0) + event: last_drag_event + pasteboard: pasteboard + source: self + slideBack: NO]; + + [image release]; + + return selected_op; +} + @end /* EmacsWindow */ commit 758fed537b7780807bf00705f6441d1550e7a945 Author: Stefan Kangas Date: Fri May 27 10:03:44 2022 +0200 * lisp/progmodes/asm-mode.el: Minor doc fixes. diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 05c3fc7296..aaf063b517 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -24,16 +24,16 @@ ;;; Commentary: ;; This mode was written by Eric S. Raymond , -;; inspired by an earlier asm-mode by Martin Neitzel. +;; inspired by an earlier `asm-mode' by Martin Neitzel. -;; This major mode is based on prog mode. It defines a private abbrev table -;; that can be used to save abbrevs for assembler mnemonics. It binds just -;; five keys: +;; This major mode is based on `prog-mode'. It defines a private +;; abbrev table that can be used to save abbrevs for assembler +;; mnemonics. It binds just five keys: ;; ;; TAB tab to next tab stop ;; : outdent preceding label, tab to tab stop ;; comment char place or move comment -;; asm-comment-char specifies which character this is; +;; `asm-comment-char' specifies which character this is; ;; you can use a different character in different ;; Asm mode buffers. ;; C-j, C-m newline and tab to tab stop @@ -41,9 +41,9 @@ ;; Code is indented to the first tab stop level. ;; This mode runs two hooks: -;; 1) An asm-mode-set-comment-hook before the part of the initialization -;; depending on asm-comment-char, and -;; 2) an asm-mode-hook at the end of initialization. +;; 1) `asm-mode-set-comment-hook' before the part of the initialization +;; depending on `asm-comment-char', and +;; 2) `asm-mode-hook' at the end of initialization. ;;; Code: @@ -128,7 +128,7 @@ Special commands: (setq-local tab-always-indent nil) (run-hooks 'asm-mode-set-comment-hook) - ;; Make our own local child of asm-mode-map + ;; Make our own local child of `asm-mode-map' ;; so we can define our own comment character. (use-local-map (nconc (make-sparse-keymap) asm-mode-map)) (local-set-key (vector asm-comment-char) #'asm-comment) commit 7d74b8f632b1af75b837f5b5259cd1758aab1489 Author: Stefan Kangas Date: Tue May 17 17:25:27 2022 +0200 Prefer defvar-keymap in some progmodes * lisp/progmodes/asm-mode.el (asm-mode-map): * lisp/progmodes/bug-reference.el (bug-reference-map): * lisp/progmodes/erts-mode.el (erts-mode-map): * lisp/progmodes/flymake.el (flymake-mode-map) (flymake-diagnostics-buffer-mode-map): * lisp/progmodes/icon.el (icon-mode-map): * lisp/progmodes/js.el (js-mode-map): * lisp/progmodes/m4-mode.el (m4-mode-map): * lisp/progmodes/mixal-mode.el (mixal-mode-map): * lisp/progmodes/scheme.el (scheme-mode-map): Prefer defvar-keymap. diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 370fb1b80b..05c3fc7296 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -68,13 +68,11 @@ "Abbrev table used while in Asm mode.") (define-abbrev-table 'asm-mode-abbrev-table ()) -(defvar asm-mode-map - (let ((map (make-sparse-keymap))) - ;; Note that the comment character isn't set up until asm-mode is called. - (define-key map ":" 'asm-colon) - (define-key map "\C-c;" 'comment-region) - map) - "Keymap for Asm mode.") +(defvar-keymap asm-mode-map + :doc "Keymap for Asm mode." + ;; Note that the comment character isn't set up until asm-mode is called. + ":" #'asm-colon + "C-c ;" #'comment-region) (easy-menu-define asm-mode-menu asm-mode-map "Menu for Asm mode." diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 06242a4cba..d3626dbaf0 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -40,12 +40,10 @@ ;; Somewhat arbitrary, by analogy with eg goto-address. :group 'comm) -(defvar bug-reference-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'bug-reference-push-button) - (define-key map (kbd "C-c RET") 'bug-reference-push-button) - map) - "Keymap used by bug reference buttons.") +(defvar-keymap bug-reference-map + :doc "Keymap used by bug reference buttons." + "" #'bug-reference-push-button + "C-c RET" #'bug-reference-push-button) ;; E.g., "https://gcc.gnu.org/PR%s" (defvar bug-reference-url-format nil diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el index 1b88540ff3..13da1d478d 100644 --- a/lisp/progmodes/erts-mode.el +++ b/lisp/progmodes/erts-mode.el @@ -64,12 +64,10 @@ "Face used for displaying specification test start markers." :group 'erts-mode) -(defvar erts-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map prog-mode-map) - (define-key map "\C-c\C-r" 'erts-tag-region) - (define-key map "\C-c\C-c" 'erts-run-test) - map)) +(defvar-keymap erts-mode-map + :parent prog-mode-map + "C-c C-r" #'erts-tag-region + "C-c C-c" #'erts-run-test) (defvar erts-mode-font-lock-keywords ;; Specifications. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0b7958e52f..9e3255874d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1080,9 +1080,8 @@ Interactively, with a prefix arg, FORCE is t." (flymake--run-backend backend backend-args))) nil)))))))) -(defvar flymake-mode-map - (let ((map (make-sparse-keymap))) map) - "Keymap for `flymake-mode'.") +(defvar-keymap flymake-mode-map + :doc "Keymap for `flymake-mode'.") ;;;###autoload (define-minor-mode flymake-mode @@ -1493,11 +1492,9 @@ TYPE is usually keyword `:error', `:warning' or `:note'." (defvar-local flymake--diagnostics-buffer-source nil) -(defvar flymake-diagnostics-buffer-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'flymake-goto-diagnostic) - (define-key map (kbd "SPC") 'flymake-show-diagnostic) - map)) +(defvar-keymap flymake-diagnostics-buffer-mode-map + "RET" #'flymake-goto-diagnostic + "SPC" #'flymake-show-diagnostic) (defun flymake-show-diagnostic (pos &optional other-window) "Show location of diagnostic at POS." diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index e1ee9efc54..ec281f3a49 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -31,17 +31,16 @@ "Abbrev table in use in Icon-mode buffers.") (define-abbrev-table 'icon-mode-abbrev-table ()) -(defvar icon-mode-map - (let ((map (make-sparse-keymap "Icon"))) - (define-key map "{" 'electric-icon-brace) - (define-key map "}" 'electric-icon-brace) - (define-key map "\e\C-h" 'mark-icon-function) - (define-key map "\e\C-a" 'beginning-of-icon-defun) - (define-key map "\e\C-e" 'end-of-icon-defun) - (define-key map "\e\C-q" 'indent-icon-exp) - (define-key map "\177" 'backward-delete-char-untabify) - map) - "Keymap used in Icon mode.") +(defvar-keymap icon-mode-map + :doc "Keymap used in Icon mode." + :name "Icon" + "{" #'electric-icon-brace + "}" #'electric-icon-brace + "C-M-h" #'mark-icon-function + "C-M-a" #'beginning-of-icon-defun + "C-M-e" #'end-of-icon-defun + "C-M-q" #'indent-icon-exp + "DEL" #'backward-delete-char-untabify) (easy-menu-define icon-mode-menu icon-mode-map "Menu for Icon mode." diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9c1358e466..eb2a1e4fcc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -660,13 +660,11 @@ This variable is like `sgml-attribute-offset'." :type 'integer :safe 'integerp) -;;; KeyMap +;;; Keymap -(defvar js-mode-map - (let ((keymap (make-sparse-keymap))) - (define-key keymap [(meta ?.)] #'js-find-symbol) - keymap) - "Keymap for `js-mode'.") +(defvar-keymap js-mode-map + :doc "Keymap for `js-mode'." + "M-." #'js-find-symbol) ;;; Syntax table and parsing diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index b9fcd033bb..a18c8bcce4 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -121,13 +121,11 @@ If m4 is not in your PATH, set this to an absolute file name." ("#" (0 (when (m4--quoted-p (match-beginning 0)) (string-to-syntax ".")))))) -(defvar m4-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-b" 'm4-m4-buffer) - (define-key map "\C-c\C-r" 'm4-m4-region) - (define-key map "\C-c\C-c" 'comment-region) - map) - "Keymap for M4 Mode.") +(defvar-keymap m4-mode-map + :doc "Keymap for M4 Mode." + "C-c C-b" #'m4-m4-buffer + "C-c C-r" #'m4-m4-region + "C-c C-c" #'comment-region) (easy-menu-define m4-mode-menu m4-mode-map "Menu for M4 Mode." diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 97a218fcfa..9d1ceaa55a 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -78,16 +78,13 @@ ;;; Code: (defvar compile-command) -;;; Key map -(defvar mixal-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'compile) - (define-key map "\C-c\C-r" 'mixal-run) - (define-key map "\C-c\C-d" 'mixal-debug) - (define-key map "\C-h\C-o" 'mixal-describe-operation-code) - map) - "Keymap for `mixal-mode'.") -;; (makunbound 'mixal-mode-map) +;;; Keymap +(defvar-keymap mixal-mode-map + :doc "Keymap for `mixal-mode'." + "C-c C-c" #'compile + "C-c C-r" #'mixal-run + "C-c C-d" #'mixal-debug + "C-h C-o" #'mixal-describe-operation-code) ;;; Syntax table (defvar mixal-mode-syntax-table diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index cd397733d2..cf1d394983 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,7 +1,6 @@ ;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*- -;; Copyright (C) 1986-1988, 1997-1998, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Author: Bill Rozas ;; Adapted-by: Dave Love @@ -201,12 +200,10 @@ (defvar scheme-mode-line-process "") -(defvar scheme-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map lisp-mode-shared-map) - map) - "Keymap for Scheme mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") +(defvar-keymap scheme-mode-map + :doc "Keymap for Scheme mode. +All commands in `lisp-mode-shared-map' are inherited by this map." + :parent lisp-mode-shared-map) (easy-menu-define scheme-mode-menu scheme-mode-map "Menu for Scheme mode." commit 4ed0f6e9658279c25f66072c2ddef96aa6f7a93c Author: Stefan Kangas Date: Fri May 27 09:42:12 2022 +0200 Silence byte-compiler warning about x-pointer-invisible * lisp/avoid.el (x-pointer-invisible): Declare to silence byte-compiler. diff --git a/lisp/avoid.el b/lisp/avoid.el index c97e51a6f7..2e77c8feff 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -293,6 +293,8 @@ accumulated, and tries to keep it close to zero." (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) +(defvar x-pointer-invisible) ; silence byte-compiler + (defun mouse-avoidance-random-shape () "Return a random cursor shape. This assumes that any variable whose name begins with x-pointer- and commit d3cde28b03b429c15405a452119e636c371a9c25 (refs/remotes/origin/emacs-28) Author: Juri Linkov Date: Fri May 27 10:32:56 2022 +0300 Fix more occurrences of renamed kmacro-keymap command * doc/emacs/kmacro.texi (Basic Keyboard Macro): Fix documentation after recent kmacro-redisplay command name change. diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index fbbceb7d5e..5205c0b716 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -179,7 +179,7 @@ itself counts as the first repetition, since it is executed as you define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3 additional times. -@findex kdb-macro-redisplay +@findex kmacro-redisplay @kindex C-x C-k d While executing a long-running keyboard macro, it can sometimes be useful to trigger a redisplay (to show how far we've gotten). The commit bd5c95a90d85cb2ec48c53e654fa233c13abd7ac Author: Eli Zaretskii Date: Fri May 27 09:21:31 2022 +0300 Mention "unspecified-fg" and "unspecified-bg" in some doc strings * lisp/faces.el (face-foreground, face-background) (foreground-color-at-point, background-color-at-point): * lisp/color.el (color-name-to-rgb): Mention "unspecified-fg" and "unspecified-bg" pseudo-colors on TTY frames. (Bug#55623) diff --git a/lisp/color.el b/lisp/color.el index 0fe663d97a..ef3a2f5836 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -39,6 +39,10 @@ COLOR should be a color name (e.g. \"white\") or an RGB triplet string (e.g. \"#ffff1122eecc\"). +COLOR can also be the symbol `unspecified' or one of the strings +\"unspecified-fg\" or \"unspecified-bg\", in which case the +return value is nil. + Normally the return value is a list of three floating-point numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. diff --git a/lisp/faces.el b/lisp/faces.el index 3bd1e5db6f..e93d8c7af8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -515,6 +515,9 @@ FACES may be either a single face or a list of faces. (defun face-foreground (face &optional frame inherit) "Return the foreground color name of FACE, or nil if unspecified. +On TTY frames, the returned color name can be \"unspecified-fg\", +which stands for the unknown default foreground color of the display +where the frame is displayed. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. @@ -536,6 +539,9 @@ merging with the `default' face (which is always completely specified)." (defun face-background (face &optional frame inherit) "Return the background color name of FACE, or nil if unspecified. +On TTY frames, the returned color name can be \"unspecified-bg\", +which stands for the unknown default background color of the display +where the frame is displayed. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. @@ -2061,11 +2067,17 @@ unnamed faces (e.g, `foreground-color')." (face-attribute 'default attribute)))) (defun foreground-color-at-point () - "Return the foreground color of the character after point." + "Return the foreground color of the character after point. +On TTY frames, the returned color name can be \"unspecified-fg\", +which stands for the unknown default foreground color of the +display where the frame is displayed." (faces--attribute-at-point :foreground 'foreground-color)) (defun background-color-at-point () - "Return the background color of the character after point." + "Return the background color of the character after point. +On TTY frames, the returned color name can be \"unspecified-bg\", +which stands for the unknown default background color of the +display where the frame is displayed." (faces--attribute-at-point :background 'background-color))