commit 1b64e0fc0ee799060cfb406d2b048372b3edab70 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Apr 26 12:38:52 2022 +0800 Fix event mask of activation client message * src/xterm.c (x_alloc_lighter_color): (x_get_scale_factor): Minor formatting fixes. (x_ewmh_activate_frame): Fix event mask used to send message to the root window. diff --git a/src/xterm.c b/src/xterm.c index 3abc67a4b1..16d0ce6707 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7158,7 +7158,7 @@ x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, that scaling by FACTOR alone isn't enough. */ { /* How far below the limit this color is (0 - 1, 1 being darker). */ - double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; + double dimness = 1 - (double) bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; /* The additive adjustment. */ int min_delta = delta * dimness * factor / 2; @@ -8179,7 +8179,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) } static void -x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) +x_get_scale_factor (Display *disp, int *scale_x, int *scale_y) { const int base_res = 96; struct x_display_info * dpyinfo = x_display_info_for_display (disp); @@ -21468,20 +21468,30 @@ xembed_request_focus (struct frame *f) static void x_ewmh_activate_frame (struct frame *f) { - /* See Window Manager Specification/Extended Window Manager Hints at - https://freedesktop.org/wiki/Specifications/wm-spec/ */ + XEvent msg; + struct x_display_info *dpyinfo; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + dpyinfo = FRAME_DISPLAY_INFO (f); - if (FRAME_VISIBLE_P (f) && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) - { - Lisp_Object frame; - XSETFRAME (frame, f); - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_active_window, - make_fixnum (32), - list2 (make_fixnum (1), - INT_TO_INTEGER (dpyinfo->last_user_time))); + if (FRAME_VISIBLE_P (f) + && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) + { + /* See the documentation at + https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html + for more details on the format of this message. */ + msg.xclient.window = FRAME_OUTER_WINDOW (f); + msg.xclient.message_type = dpyinfo->Xatom_net_active_window; + msg.xclient.data.l[0] = 1; + msg.xclient.data.l[1] = dpyinfo->last_user_time; + msg.xclient.data.l[2] = (!dpyinfo->x_focus_frame + ? None + : FRAME_OUTER_WINDOW (dpyinfo->x_focus_frame)); + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); } } commit ec027d873c5660463cd65ce4e9445ed549b03ce4 Author: Po Lu Date: Tue Apr 26 11:57:47 2022 +0800 * src/xterm.c (x_scroll_run): Only flush GC if really necessary. diff --git a/src/xterm.c b/src/xterm.c index 0f93e4807f..3abc67a4b1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9128,11 +9128,13 @@ x_scroll_run (struct window *w, struct run *run) } #endif +#ifdef USE_CAIRO_XCB_SURFACE /* Some of the following code depends on `normal_gc' being up-to-date on the X server, but doesn't call a routine that will flush it first. So do this ourselves instead. */ XFlushGC (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc); +#endif #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) commit 39646c822bf9a3fb1ccdca0a7a5d192e607c03c3 Author: Dmitry Gutov Date: Tue Apr 26 05:36:35 2022 +0300 Fix Ruby indentation with double splat as first block param * lisp/progmodes/ruby-mode.el (ruby-smie--forward-token) (ruby-smie--backward-token): Tokenize "**" separately from "|". Problem reported at https://github.com/dgutov/robe/issues/136. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index fdc8164dc0..a197724634 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -508,7 +508,7 @@ This only affects the output of the command `ruby-toggle-block'." ((member tok '("unless" "if" "while" "until")) (if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp)) tok "iuwu-mod")) - ((string-match-p "\\`|[*&]?\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char (- 1 (length tok))) (setq tok "|") (cond @@ -561,7 +561,7 @@ This only affects the output of the command `ruby-toggle-block'." ((ruby-smie--closing-pipe-p) "closing-|") (t tok))) ((string-match-p "\\`[^|]+|\\'" tok) "closing-|") - ((string-match-p "\\`|[*&]\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char 1) (substring tok 1)) ((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n")) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index f31cea86a5..0c206b1e0c 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -491,3 +491,12 @@ def qux in {'th' => orig_text, 'ja' => trans_text} puts "Japanese translation: #{orig_text} => #{trans_text}" end + +# Tokenizing "**" and "|" separately. +def resolve(**args) + members = proc do |**args| + p(**args) + end + + member.call(**args) +end commit 4a837b0c721c9680d8fc88d49d6c1805e279f284 Author: Po Lu Date: Tue Apr 26 01:19:56 2022 +0000 Cache relief colors on Haiku since their computation is expensive * src/haikufns.c (haiku_create_frame, haiku_create_tip_frame): Clear `relief_background'. * src/haikuterm.c (haiku_calculate_relief_colors): Cache relief colors for each frame. * src/haikuterm.h (struct haiku_output): New fields for caching the last relief color. diff --git a/src/haikufns.c b/src/haikufns.c index 4f4979fe09..ae0f442a21 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -700,6 +700,7 @@ haiku_create_frame (Lisp_Object parms) f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", @@ -1015,6 +1016,7 @@ haiku_create_tip_frame (Lisp_Object parms) f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; f->tooltip = true; fset_icon_name (f, Qnil); diff --git a/src/haikuterm.c b/src/haikuterm.c index f81efbdcbb..86266424c4 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -623,17 +623,28 @@ haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, struct face *face = s->face; double h, cs, l; uint32_t rgbin; + struct haiku_output *di; - prepare_face_for_display (s->f, s->face); rgbin = (face->use_box_color_for_shadows_p ? face->box_color : face->background); + di = FRAME_OUTPUT_DATA (s->f); if (s->hl == DRAW_CURSOR) rgbin = FRAME_CURSOR_COLOR (s->f).pixel; - rgb_color_hsl (rgbin, &h, &cs, &l); - hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b); - hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w); + if (di->relief_background != rgbin) + { + di->relief_background = rgbin & 0xffffffff; + + rgb_color_hsl (rgbin, &h, &cs, &l); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), + &di->black_relief_pixel); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), + &di->white_relief_pixel); + } + + *rgbout_w = di->white_relief_pixel; + *rgbout_b = di->black_relief_pixel; } static void diff --git a/src/haikuterm.h b/src/haikuterm.h index d20d491838..30b474b1e1 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -181,6 +181,17 @@ struct haiku_output /* The type of any event that's being waited for. */ int wait_for_event_type; + + /* The "dark" color of the current relief. */ + uint32_t black_relief_pixel; + + /* The "light" color of the current relief. */ + uint32_t white_relief_pixel; + + /* The background for which the relief colors above were computed. + They are changed only when a different background is involved. + -1 means no color has been computed. */ + long relief_background; }; struct x_output commit d6c7054ff5e1e87904353ddd73aecfead4321a7a Author: Paul Eggert Date: Mon Apr 25 17:49:23 2022 -0700 Pacify misc/test-custom-opts * lisp/gnus/gnus-html.el (gnus-html-image-cache-ttl): Also allow it to be a cons of integers. diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 45f1e6099e..8b2200af54 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -46,8 +46,9 @@ :group 'gnus-art ;; FIXME hardly the friendliest type. The allowed value is actually ;; any time value, but we are assuming no-one cares about USEC and - ;; PSEC here. It would be better to eg make it a number of minutes. - :type '(list integer integer)) + ;; PSEC here. It would be better to make it a number of seconds. + :type '(choice (cons integer integer) + (list integer integer))) (defcustom gnus-html-image-automatic-caching t "Whether automatically cache retrieve images." commit 0a151b7c29c46ae67ae92d0960e199ae84b3a48b Author: Stefan Monnier Date: Mon Apr 25 15:41:04 2022 -0400 cl-generic.el: Upcase formal args in `C-h o` Try and improve the display of methods in `C-h o` by moving the qualifiers to a separate line and upcasing the formal args. It still needs love, tho. * lisp/emacs-lisp/cl-generic.el: Upcase formal args in `C-h o` (cl--generic-upcase-formal-args): New function. (cl--generic-describe): Use it. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 179310c145..200af057cd 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1078,6 +1078,19 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (setq combined-args (append (nreverse combined-args) args)) (list qual-string combined-args doconly))) +(defun cl--generic-upcase-formal-args (args) + (mapcar (lambda (arg) + (cond + ((symbolp arg) + (let ((name (symbol-name arg))) + (if (eq ?& (aref name 0)) arg + (intern (upcase name))))) + ((consp arg) + (cons (intern (upcase (symbol-name (car arg)))) + (cdr arg))) + (t arg))) + args)) + (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) (defun cl--generic-describe (function) ;; Supposedly this is called from help-fns, so help-fns should be loaded at @@ -1094,14 +1107,20 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (insert (propertize "Implementations:\n\n" 'face 'bold)) ;; Loop over fanciful generics (dolist (method (cl--generic-method-table generic)) - (let* ((info (cl--generic-method-info method))) + (pcase-let* + ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. - (let ((print-quoted nil)) - (if (length> (nth 0 info) 0) - (insert (format "%s%S" (nth 0 info) (nth 1 info))) - ;; Make the non-":extra" bits look more like `C-h f' - ;; output. - (insert (format "%S" (cons function (nth 1 info)))))) + (let ((print-quoted nil) + (quals (if (length> qualifiers 0) + (concat (substring qualifiers + 0 (string-match " *\\'" + qualifiers)) + "\n") + ""))) + (insert (format "%s%S" + quals + (cons function + (cl--generic-upcase-formal-args args))))) (let* ((met-name (cl--generic-load-hist-format function (cl--generic-method-qualifiers method) @@ -1113,7 +1132,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." 'help-function-def met-name file 'cl-defmethod) (insert (substitute-command-keys "'.\n")))) - (insert "\n" (or (nth 2 info) "Undocumented") "\n\n"))))))) + (insert "\n" (or doc "Undocumented") "\n\n"))))))) (defun cl--generic-specializers-apply-to-type-p (specializers type) "Return non-nil if a method with SPECIALIZERS applies to TYPE." commit 4a1f69ebca9bbf5797b8898f8250f6580753d829 Author: Paul Eggert Date: Mon Apr 25 11:56:48 2022 -0700 Use (TICKS . HZ) for current-time etc. * src/timefns.c (CURRENT_TIME_LIST): Change default to false. All documentation changed. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 466d7f0e60..afaed10cdf 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -15343,9 +15343,9 @@ nil 100 @end group @group -(20615 27034 579989 697000) -(17905 55681 0 0) -(20615 26327 734791 805000) +(1351051674579989697 . 1000000000) +(1173477761000000000 . 1000000000) +(1351050967734791805 . 1000000000) 13188 "-rw-r--r--" @end group diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d8b55b114a..4394f64a32 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1423,9 +1423,9 @@ For example, here are the file attributes for @file{files.texi}: @group (file-attributes "files.texi" 'string) @result{} (nil 1 "lh" "users" - (20614 64019 50040 152000) - (20000 23 0 0) - (20614 64555 902289 872000) + (1351023123050040152 . 1000000000) + (1310720023000000000 . 1000000000) + (1351023659902289872 . 1000000000) 122295 "-rw-rw-rw-" t 6473924464520138 1014478468) @@ -1449,13 +1449,13 @@ is owned by the user with name @samp{lh}. @item "users" is in the group with name @samp{users}. -@item (20614 64019 50040 152000) +@item (1351023123050040152 . 1000000000) was last accessed on October 23, 2012, at 20:12:03.050040152 UTC. -@item (20000 23 0 0) -was last modified on July 15, 2001, at 08:53:43 UTC. +@item (1310720023000000000 . 1000000000) +was last modified on July 15, 2001, at 08:53:43.000000000 UTC. -@item (20614 64555 902289 872000) +@item (1351023659902289872 . 1000000000) last had its status changed on October 23, 2012, at 20:20:59.902289872 UTC. @item 122295 diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 5afd2f4ecf..d1a3fef7a4 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -503,7 +503,7 @@ if the information is not available. @example @group emacs-build-time - @result{} (20614 63694 515336 438000) + @result{} (1650228902637038831 . 1000000000) @end group @end example @end defvar diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index af9ad0a533..9e87b3840e 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1359,9 +1359,6 @@ This represents the number of seconds using the formula: @tex $high \times 2^{16} + low + micro \times 10^{-6} + pico \times 10^{-12}$. @end tex -In some cases, functions may default to returning two- or -three-element lists, with omitted @var{micro} and @var{pico} -components defaulting to zero. On all current machines @var{pico} is a multiple of 1000, but this may change as higher-resolution clocks become available. @end itemize @@ -1415,11 +1412,13 @@ The operating system limits the range of time and zone values. @defun current-time This function returns the current time as a Lisp timestamp. -Although the timestamp takes the form @code{(@var{high} @var{low} -@var{micro} @var{pico})} in the current Emacs release, this is -planned to change in a future Emacs version. You can use the -@code{time-convert} function to convert a timestamp to some other -form. @xref{Time Conversion}. +The timestamp has the form @code{(@var{ticks} . @var{hz})} where +@var{ticks} counts clock ticks and @var{hz} is the clock ticks per second. + +In Emacs 28 and earlier, the returned timestamp had the list form +@code{(@var{high} @var{low} @var{usec} @var{psec})}. You can use +@code{(time-convert nil 'list)} to return the current time in this +older form. @xref{Time Conversion}. @end defun @defun float-time &optional time diff --git a/etc/NEWS b/etc/NEWS index 05c636102d..40e914cd32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -202,6 +202,14 @@ speakers of the Tamil language. To get back the previous behavior, use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input methods instead. ++++ +** current-time and related functions now yield (TICKS . HZ) timestamps. +Previously they yielded timestamps of the forms (HI LO US PS), (HI LO +US) or (HI LO), which were less regular and less efficient and which +lacked information about clock resolution. This long-planned change +was documented in Emacs 27. To convert a timestamp X to the old +4-element list form, you can use (time-convert X 'list). + * Changes in Emacs 29.1 diff --git a/src/timefns.c b/src/timefns.c index b0b84a438c..e7a2cd368e 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -69,12 +69,11 @@ enum { TM_YEAR_BASE = 1900 }; # define FASTER_TIMEFNS 1 #endif -/* Although current-time etc. generate list-format timestamps - (HI LO US PS), the plan is to change these functions to generate - frequency-based timestamps (TICKS . HZ) in a future release. - To try this now, compile with -DCURRENT_TIME_LIST=0. */ +/* current-time etc. generate (TICKS . HZ) timestamps. + To change that to the old 4-element list format (HI LO US PS), + compile with -DCURRENT_TIME_LIST=1. */ #ifndef CURRENT_TIME_LIST -enum { CURRENT_TIME_LIST = true }; +enum { CURRENT_TIME_LIST = false }; #endif #if FIXNUM_OVERFLOW_P (1000000000) @@ -1763,15 +1762,14 @@ bits, and USEC and PSEC are the microsecond and picosecond counts. */) DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. - -In a future Emacs version, the format of the returned timestamp is -planned to change. Use `time-convert' if you need a particular -timestamp form; for example, (time-convert nil \\='integer) returns -the current time in seconds. */) +The time is returned as a pair of integers (TICKS . HZ), where TICKS +counts clock ticks and HZ is the clock ticks per second. + +In Emacs 28 and earlier, the returned timestamp had the form (HIGH LOW +USEC PSEC), where HIGH is the most significant bits of the seconds, +LOW the least significant 16 bits, and USEC and PSEC are the +microsecond and picosecond counts. Use \(time-convert nil \\='list) +if you need this older timestamp form. */) (void) { return make_lisp_time (current_timespec ()); commit d75e2c12ebbc7a758d1c24d30685e790b703eb64 Author: Paul Eggert Date: Mon Apr 25 11:56:48 2022 -0700 Support (encode-time (list s m h D M Y)) * src/timefns.c (Fencode_time): Add support for a 6-elt list arg. Requested by Max Nikulin for Org (bug#54764). * test/src/timefns-tests.el (encode-time-alternate-apis): New test. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 71df402a6c..af9ad0a533 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1660,6 +1660,11 @@ standard time from 4 to 3 hours east of Greenwich; if you need to handle situations like this you can use a numeric @var{zone} to disambiguate instead. +The first argument can also be a list @code{(@var{second} @var{minute} +@var{hour} @var{day} @var{month} @var{year})}, which is treated like +the list @code{(@var{second} @var{minute} @var{hour} @var{day} +@var{month} @var{year} nil -1 nil)}. + As an obsolescent calling convention, this function can be given six or more arguments. The first six arguments @var{second}, @var{minute}, @var{hour}, @var{day}, @var{month}, and @var{year} diff --git a/etc/NEWS b/etc/NEWS index 89a8c34df9..05c636102d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2011,6 +2011,11 @@ For example, '(time-add nil '(1 . 1000))' no longer warns that the '(1 . 1000)' acts like '(1000 . 1000000)'. This warning, which was a temporary transition aid for Emacs 27, has served its purpose. ++++ +** 'encode-time' now also accepts a 6-element list with just time and date. +(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR)) is now short for +(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil)). + +++ ** 'date-to-time' now assumes earliest values if its argument lacks month, day, or time. For example, (date-to-time "2021-12-04") now diff --git a/src/timefns.c b/src/timefns.c index 7a4a7075ed..b0b84a438c 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1620,6 +1620,9 @@ time zone with daylight-saving transitions, DST is t for daylight saving time, nil for standard time, and -1 to cause the daylight saving flag to be guessed. +TIME can also be a list (SECOND MINUTE HOUR DAY MONTH YEAR), which is +equivalent to (SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil). + As an obsolescent calling convention, if this function is called with 6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR, DAY, MONTH, and YEAR, and specify the components of a decoded time. @@ -1645,7 +1648,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) if (nargs == 1) { Lisp_Object tail = a; - for (int i = 0; i < 9; i++, tail = XCDR (tail)) + for (int i = 0; i < 6; i++, tail = XCDR (tail)) CHECK_CONS (tail); secarg = XCAR (a); a = XCDR (a); minarg = XCAR (a); a = XCDR (a); @@ -1653,11 +1656,17 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) mdayarg = XCAR (a); a = XCDR (a); monarg = XCAR (a); a = XCDR (a); yeararg = XCAR (a); a = XCDR (a); - a = XCDR (a); - Lisp_Object dstflag = XCAR (a); a = XCDR (a); - zone = XCAR (a); - if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) - tm.tm_isdst = !NILP (dstflag); + if (! NILP (a)) + { + CHECK_CONS (a); + a = XCDR (a); + CHECK_CONS (a); + Lisp_Object dstflag = XCAR (a); a = XCDR (a); + CHECK_CONS (a); + zone = XCAR (a); + if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) + tm.tm_isdst = !NILP (dstflag); + } } else if (nargs < 6) xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs)); diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index e7c464472d..08d06f27d9 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -225,6 +225,15 @@ a fixed place on the right and are padded on the left." (encode-time '(29 31 17 30 4 2019 2 t 7200)) '(23752 27217)))) +(ert-deftest encode-time-alternate-apis () + (let* ((time '(30 30 12 15 6 1970)) + (time-1 (append time '(nil -1 nil))) + (etime (encode-time time))) + (should (time-equal-p etime (encode-time time-1))) + (should (time-equal-p etime (apply #'encode-time time))) + (should (time-equal-p etime (apply #'encode-time time-1))) + (should (time-equal-p etime (apply #'encode-time (append time '(nil))))))) + (ert-deftest float-time-precision () (should (= (float-time '(0 1 0 4025)) 1.000000004025)) (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025)) commit fd1ca094bc43d8fab859e7b78280f9f9693105f1 Author: Lars Ingebrigtsen Date: Mon Apr 25 21:14:24 2022 +0200 Change the display of menu bindings in *Help* * lisp/help-fns.el (help-fns--insert-menu-bindings): New function to describe menu entries more fully (bug#52870). (help-fns--key-bindings): Use it. diff --git a/etc/NEWS b/etc/NEWS index 2048e5aa98..89a8c34df9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -416,6 +416,18 @@ command also works for non-Emoji characters.) ** Help +--- +*** Commands like 'C-h f' have changed how they describe menu bindings. +For instance, previously a command might be described as having the +following bindings: + + It is bound to , C-x C-f, . + +This has been changed to: + + It is bound to and C-x C-f. + It can also be invoked from the menu: File → Visit New File.... + +++ *** The 'C-h .' command now accepts a prefix argument. 'C-u C-h .' would previously inhibit displaying a warning message if diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 23cfb04798..4599980166 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -568,9 +568,7 @@ the C sources, too." (insert (concat "It can " (and keys "also ") "be invoked from the menu: ")) - ;; FIXME: Should insert menu names instead of key - ;; binding names. - (help-fns--insert-bindings menus) + (help-fns--insert-menu-bindings menus) (insert ".") (fill-region-as-paragraph start (point)))) (ensure-empty-lines))))))) @@ -584,6 +582,33 @@ the C sources, too." (insert (help--key-description-fontified key))) keys)) +(defun help-fns--insert-menu-bindings (menus) + (seq-do-indexed + (lambda (menu i) + (insert + (cond ((zerop i) "") + ((= i (1- (length menus))) " and ") + (t ", "))) + (let ((map (lookup-key global-map (seq-take menu 1))) + (start (point))) + (seq-do-indexed + (lambda (entry level) + (when (> level 0) + (insert + (if (char-displayable-p ?→) + " → " + " => "))) + (let ((elem (assq entry (cdr map)))) + (if (eq (nth 1 elem) 'menu-item) + (progn + (insert (nth 2 elem)) + (setq map (cadddr elem))) + (insert (nth 1 elem)) + (setq map (cddr elem))))) + (cdr (seq-into menu 'list))) + (put-text-property start (point) 'face 'help-key-binding))) + menus)) + (defun help-fns--compiler-macro (function) (let ((handler (function-get function 'compiler-macro))) (when handler commit f2a4dc66c20f1a787b9cfd7fabbd36dd045c1ecc Author: Glenn Morris Date: Mon Apr 25 11:44:03 2022 -0700 Fix type of word-wrap-whitespace-characters * lisp/textmodes/word-wrap-mode.el (word-wrap-whitespace-characters): Fix type. ; Ref https://hydra.nixos.org/build/174560242 diff --git a/lisp/textmodes/word-wrap-mode.el b/lisp/textmodes/word-wrap-mode.el index 78823c4f13..1459a3395c 100644 --- a/lisp/textmodes/word-wrap-mode.el +++ b/lisp/textmodes/word-wrap-mode.el @@ -47,7 +47,7 @@ ?\N{ZERO WIDTH SPACE}) "Characters that `word-wrap-whitespace-mode' should add to `word-wrap'." :version "29.1" - :type '(repeat char) + :type '(repeat character) :group 'display) (defvar word-wrap-mode--previous-state) commit 96ec2ac7d0bdb6b1193217b35f7d74d79b7c2033 Author: Alan Third Date: Tue Apr 19 05:05:17 2022 +0100 Fix nsmenu compilation under macOS 10.6 * src/nsmenu.m ([EmacsMenu fillWithWidgetValue:]): Replace modern shorthand dictionary and array definitions. * src/nsterm.h (NSTextAlignmentRight): Redefine if necessary. * src/macfont.m (mac_font_create_preferred_family_for_attributes): isOperatingSystemAtLeastVersion is new in macOS 10.10, so it's probably wrong to use it to check whether we're below 10.9. (mac_font_copy_default_descriptors_for_language): (mac_font_copy_default_name_for_charset_and_languages): It seems these functions are only used on macOS 10.8 and below. * src/nsterm.m ([NSColor colorUsingDefaultColorSpace]): Use the generic colorspace. (ns_parent_window_rect): (ns_frame_scale_factor): ([EmacsWindow setParentChildRelationships]): Fix macOS version stuff. Co-authored-by: Po Lu diff --git a/src/macfont.m b/src/macfont.m index 34e48afb98..35648df06c 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -57,8 +57,10 @@ static Boolean mac_font_descriptor_supports_languages (CTFontDescriptorRef, static CFIndex mac_font_shape (CTFontRef, CFStringRef, struct mac_glyph_layout *, CFIndex, enum lgstring_direction); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef); static CFStringRef mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef, CFArrayRef); +#endif #if USE_CT_GLYPH_INFO static CGGlyph mac_ctfont_get_glyph_for_cid (CTFontRef, CTCharacterCollection, CGFontIndex); @@ -3570,18 +3572,17 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no if (languages && CFArrayGetCount (languages) > 0) { - if ([[NSProcessInfo processInfo] - isOperatingSystemAtLeastVersion: - ((NSOperatingSystemVersion){ - .majorVersion = 10, .minorVersion = 9})]) - values[num_values++] = CFArrayGetValueAtIndex (languages, 0); - else +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + if (CTGetCoreTextVersion () < kCTVersionNumber10_9) { CFCharacterSetRef charset = CFDictionaryGetValue (attributes, kCTFontCharacterSetAttribute); result = mac_font_copy_default_name_for_charset_and_languages (charset, languages); } + else +#endif + values[num_values++] = CFArrayGetValueAtIndex (languages, 0); } if (result == NULL) { @@ -4000,6 +4001,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no } #endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef language) { @@ -4134,6 +4136,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no return result; } +#endif void * macfont_get_nsctfont (struct font *font) diff --git a/src/nsmenu.m b/src/nsmenu.m index 81d7cd2da1..0f7d1fb98f 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -649,7 +649,8 @@ - (void)fillWithWidgetValue: (void *)wvptr work around it by using tabs to split the title into two columns. */ NSFont *menuFont = [NSFont menuFontOfSize:0]; - NSDictionary *font_attribs = @{NSFontAttributeName: menuFont}; + NSDictionary *font_attribs = [NSDictionary dictionaryWithObjectsAndKeys: + menuFont, NSFontAttributeName, nil]; CGFloat maxNameWidth = 0; CGFloat maxKeyWidth = 0; @@ -677,11 +678,12 @@ - (void)fillWithWidgetValue: (void *)wvptr NSTextTab *tab = [[[NSTextTab alloc] initWithTextAlignment: NSTextAlignmentRight location: maxWidth - options: @{}] autorelease]; + options: [NSDictionary dictionary]] autorelease]; NSMutableParagraphStyle *pstyle = [[[NSMutableParagraphStyle alloc] init] autorelease]; - [pstyle setTabStops: @[tab]]; - attributes = @{NSParagraphStyleAttributeName: pstyle}; + [pstyle setTabStops: [NSArray arrayWithObject:tab]]; + attributes = [NSDictionary dictionaryWithObjectsAndKeys: + pstyle, NSParagraphStyleAttributeName, nil]; #endif /* clear existing contents */ diff --git a/src/nsterm.h b/src/nsterm.h index 4cba5c0be8..5b121ede98 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1290,6 +1290,7 @@ extern char gnustep_base_version[]; /* version tracking */ #define NSAlertStyleCritical NSCriticalAlertStyle #define NSControlSizeRegular NSRegularControlSize #define NSCompositingOperationCopy NSCompositeCopy +#define NSTextAlignmentRight NSRightTextAlignment /* And adds NSWindowStyleMask. */ #ifdef __OBJC__ diff --git a/src/nsterm.m b/src/nsterm.m index 4737cb1b35..5d2e74ad56 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -163,7 +163,7 @@ - (NSColor *)colorUsingDefaultColorSpace && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; #endif - return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; + return [self colorUsingColorSpace: [NSColorSpace genericRGBColorSpace]]; } + (NSColor *)colorWithUnsignedLong:(unsigned long)c @@ -751,7 +751,18 @@ Free a pool and temporary objects it refers to (callable from C) EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); parentRect = [parentView convertRect:[parentView frame] toView:nil]; + +#if defined (NS_IMPL_COCOA) && !defined (MAC_OS_X_VERSION_10_7) + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#elif defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[parentView window] + respondsToSelector:@selector(convertRectToScreen:)]) + parentRect = [[parentView window] convertRectToScreen:parentRect]; + else + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#else parentRect = [[parentView window] convertRectToScreen:parentRect]; +#endif } else parentRect = [[[NSScreen screens] objectAtIndex:0] frame]; @@ -788,10 +799,16 @@ Free a pool and temporary objects it refers to (callable from C) double ns_frame_scale_factor (struct frame *f) { -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060 - return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; -#else +#if defined (NS_IMPL_GNUSTEP) || !defined (MAC_OS_X_VERSION_10_7) return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#elif MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[FRAME_NS_VIEW (f) window] + respondsToSelector:@selector(backingScaleFactor:)]) + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; + else + return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#else + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; #endif } @@ -6943,7 +6960,7 @@ - (void)otherMouseDragged: (NSEvent *)e [self mouseMoved: e]; } -#ifdef NS_IMPL_COCOA +#if defined NS_IMPL_COCOA && defined MAC_OS_X_VERSION_10_7 - (void) magnifyWithEvent: (NSEvent *) event { NSPoint pt = [self convertPoint: [event locationInWindow] fromView: nil]; @@ -8526,7 +8543,7 @@ - (void)setParentChildRelationships expected later. */ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) + if ([self respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif /* Set the accessibility subroles. */ if (parentFrame) @@ -8558,7 +8575,7 @@ - (void)setParentChildRelationships #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif /* If we are the descendent of a fullscreen window and we have no new parent, go fullscreen. */ @@ -8583,11 +8600,11 @@ - (void)setParentChildRelationships #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif - /* Child frames must not be fullscreen. */ - if ([ourView fsIsNative] && [ourView isFullscreen]) - [ourView toggleFullScreen:self]; + /* Child frames must not be fullscreen. */ + if ([ourView fsIsNative] && [ourView isFullscreen]) + [ourView toggleFullScreen:self]; #endif [parentWindow addChildWindow:self commit 42366383c6327e731e286266665d1bb3d6ab1526 Author: Karl Fogel Date: Mon Apr 25 12:30:02 2022 -0500 Update bookmark sort indicator at proper time This follows up to my commit 8b071c77b0d7 of 2022-04-24. Thanks to Manuel Giraud for reporting the buglet. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 6c46268a34..c604395dd7 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1823,7 +1823,6 @@ Don't affect the buffer ring order." ,@(if bookmark-bmenu-toggle-filenames (list location))]) entries))) - (tabulated-list-init-header) ;; The value of `bookmark-sort-flag' might have changed since the ;; last time the buffer contents were generated, so re-check it. (if bookmark-sort-flag @@ -1846,7 +1845,12 @@ Don't affect the buffer ring order." ;; `bookmark-sort-flag' will happen again and the buffer will ;; go back to a creation-order sort. This is all expected ;; behavior, as documented in `bookmark-bmenu-mode'. - (setq tabulated-list-entries (reverse entries)))) + (setq tabulated-list-entries (reverse entries))) + ;; Generate the header only after `tabulated-list-sort-key' is + ;; settled, because if that's non-nil then the sort-direction + ;; indicator will be shown in the named column, but if it's + ;; nil then the indicator will not be shown. + (tabulated-list-init-header)) (tabulated-list-print t)) ;;;###autoload commit ec4dabc2381df6d803bb6ff4c294ef0d374857b4 Author: Po Lu Date: Mon Apr 25 12:26:44 2022 +0000 Make default Haiku tool bar color match system preferences * lisp/faces.el (tool-bar): Use system bar color as the default tool-bar background color on Haiku. diff --git a/lisp/faces.el b/lisp/faces.el index 962501ee7c..6529374668 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2873,7 +2873,10 @@ Note: Other faces cannot inherit from the cursor face." '((default :box (:line-width 1 :style released-button) :foreground "black") - (((type x w32 ns haiku pgtk) (class color)) + (((type haiku)) + :foreground "B_MENU_ITEM_TEXT_COLOR" + :background "B_MENU_BACKGROUND_COLOR") + (((type x w32 ns pgtk) (class color)) :background "grey75") (((type x) (class mono)) :background "grey")) commit a956305f99c77d2b0f4cdffcfac91dbedf9f4038 Author: Lars Ingebrigtsen Date: Mon Apr 25 14:09:46 2022 +0200 Move the Incremental Search menu one menu up * lisp/menu-bar.el (menu-bar-search-menu): Move the Incremental Search from the Search menu... (menu-bar-edit-menu): ... one step up (bug#43308). diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d8c8c760f7..44922a016a 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -311,7 +311,7 @@ (isearch-update-ring string t) (re-search-backward string))) -;; The Edit->Search->Incremental Search menu +;; The Edit->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) (bindings--define-key menu [isearch-forward-symbol-at-point] @@ -340,8 +340,6 @@ (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - (bindings--define-key menu [i-search] - `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) (bindings--define-key menu [separator-tag-isearch] menu-bar-separator) @@ -501,6 +499,9 @@ (bindings--define-key menu [replace] `(menu-item "Replace" ,menu-bar-replace-menu)) + (bindings--define-key menu [i-search] + `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) + (bindings--define-key menu [search] `(menu-item "Search" ,menu-bar-search-menu)) commit 9fdaf9ac4d0d26f93ffa4376ec26be9e33816f6a Author: Lars Ingebrigtsen Date: Mon Apr 25 10:46:28 2022 +0200 Protect against the host name containing an alpha character * src/filelock.c (lock_file_1, current_lock_owner): Protect against the unlikely case that the host name contains an alpha character (bug#14250). diff --git a/src/filelock.c b/src/filelock.c index 67948e1f09..a657cc4582 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -419,6 +419,13 @@ lock_file_1 (Lisp_Object lfname, bool force) Lisp_Object luser_name = Fuser_login_name (Qnil); Lisp_Object lhost_name = Fsystem_name (); + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@')) + lhost_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + lhost_name); + char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; @@ -583,6 +590,12 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) .#test.txt -> larsi@.118961:1646577954) is an empty string. */ if (NILP (system_name)) system_name = build_string (""); + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + else if (strchr (SSDATA (system_name), '@')) + system_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + system_name); /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) commit d932c402aa44c50af60085193b489bc1979cfbc3 Author: Michael Albinus Date: Mon Apr 25 12:57:01 2022 +0200 Add test for Tramp password handling * lisp/net/tramp.el (tramp-error-show-message-timeout): New defvar. (tramp-error-with-buffer, tramp-user-error): Use it. * test/lisp/net/tramp-tests.el (tramp-error-show-message-timeout): Set it to nil. (tramp-test46-read-password): New test. (tramp-test47-auto-load, tramp-test47-delay-load) (tramp-test47-recursive-load, tramp-test47-remote-load-path) (tramp-test48-unload): * test/lisp/net/tramp-archive-tests.el (tramp-archive-test47-auto-load) (tramp-archive-test47-delay-load): Rename. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9aac5b27e6..3d28861179 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2183,6 +2183,11 @@ FMT-STRING and ARGUMENTS." (put #'tramp-error 'tramp-suppress-trace t) +(defvar tramp-error-show-message-timeout 30 + "Time to show the Tramp buffer in case of an error. +If it is bound to nil, the buffer is not shown. This is used in +tramp-tests.el.") + (defsubst tramp-error-with-buffer (buf vec-or-proc signal fmt-string &rest arguments) "Emit an error, and show BUF. @@ -2200,6 +2205,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (apply #'tramp-error vec-or-proc signal fmt-string arguments) ;; Save exit. (when (and buf + (natnump tramp-error-show-message-timeout) (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) @@ -2213,7 +2219,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; Show buffer. (pop-to-buffer buf) (discard-input) - (sit-for 30))) + (sit-for tramp-error-show-message-timeout))) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) @@ -2226,7 +2232,8 @@ an input event arrives. The other arguments are passed to `tramp-error'." (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. - (when (and (not (zerop tramp-verbose)) + (when (and (natnump tramp-error-show-message-timeout) + (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) ;; Show only when Emacs has started already. @@ -2236,7 +2243,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; `tramp-error' does not show messages. So we must do it ourselves. (apply #'message fmt-string arguments) (discard-input) - (sit-for 30) + (sit-for tramp-error-show-message-timeout) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index fe27629d90..54d1ecf365 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -888,7 +888,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test46-auto-load () +(ert-deftest tramp-archive-test47-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -931,7 +931,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (format "(setq tramp-archive-enabled %s)" enabled)) (shell-quote-argument (format code file))))))))))) -(ert-deftest tramp-archive-test46-delay-load () +(ert-deftest tramp-archive-test47-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e9ea758956..a5058f92ef 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -125,6 +125,7 @@ tramp-allow-unsafe-temporary-files t tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil + tramp-error-show-message-timeout nil tramp-persistency-file-name nil tramp-verbose 0) @@ -7301,8 +7302,62 @@ process sentinels. They shall not disturb each other." (delete-directory tmp-name) (delete-file (concat tmp-name ".tar.gz")))) +(ert-deftest tramp-test46-read-password () + "Check Tramp password handling." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-mock-p)) + + (let ((pass "aaaa") + (mock-entry (copy-sequence (assoc "mock" tramp-methods))) + mocked-input tramp-methods) + ;; We must mock `read-string', in order to avoid interactive + ;; arguments. + (cl-letf* (((symbol-function #'read-string) + (lambda (&rest _args) (pop mocked-input)))) + (setcdr + (assq 'tramp-login-args mock-entry) + `((("-c") + (,(tramp-shell-quote-argument + (concat + "read -s -p 'Password: ' pass; echo; " + "(test \"pass$pass\" != \"pass" pass "\" && " + "echo \"Login incorrect\" || sh -i)")))))) + (setq tramp-methods `(,mock-entry)) + + ;; Reading password from stdin works. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + ;; We don't want to invalidate the password. + (setq mocked-input `(,(copy-sequence pass))) + (should (file-exists-p tramp-test-temporary-file-directory)) + + ;; Don't entering a password returns in error. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; A wrong password doesn't work either. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input `(,(concat pass pass))) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; Reading password from auth-source works. We use the netrc + ;; backend; the other backends shall behave similar. + ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1. + (with-no-warnings (when (symbol-plist 'ert-with-temp-file) + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (auth-source-forget-all-cached) + (ert-with-temp-file netrc-file + :prefix "tramp-test" :suffix "" + :text (format + "machine %s port mock password %s" + (file-remote-p tramp-test-temporary-file-directory 'host) pass) + (let ((auth-sources `(,netrc-file))) + (should (file-exists-p tramp-test-temporary-file-directory))))))))) + ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test46-auto-load () +(ert-deftest tramp-test47-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -7327,7 +7382,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test46-delay-load () +(ert-deftest tramp-test47-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -7356,7 +7411,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test46-recursive-load () +(ert-deftest tramp-test47-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -7380,7 +7435,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test46-remote-load-path () +(ert-deftest tramp-test47-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -7405,7 +7460,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test47-unload () +(ert-deftest tramp-test48-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) commit c38e16a0cc2fe455a76a2de75aa3e71887dcf6b8 Author: Michael Albinus Date: Mon Apr 25 10:37:04 2022 +0200 ; Fix typos in tec/NEWS diff --git a/etc/NEWS b/etc/NEWS index 81e3003e05..2048e5aa98 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -106,7 +106,7 @@ If you start an executable script with #!/usr/bin/emacs -x -Emacs will start without reading any init files (like with --quick), +Emacs will start without reading any init files (like with '--quick'), and then execute the rest of the script file as Emacs Lisp. When it reaches the end of the script, Emacs will exit with an exit code from the value of the final form. @@ -136,7 +136,7 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 --- -** 'TAB' and '' is now bound in 'button-map'. +** 'TAB' and '' are now bound in 'button-map'. This means that if you're standing on a button, 'TAB' will take you to the next button, even if the mode has bound it to something else. This also means that 'TAB' on a button in an 'outline-minor-mode' @@ -451,7 +451,7 @@ This will take you to the Emacs Lisp manual entry for the item displayed, if any. --- -*** The 'C-h m' ('describe-mode') *Help* buffer has been reformatted. +*** The 'C-h m' ('describe-mode') "*Help*" buffer has been reformatted. It now only includes local minor modes at the start, and the global minor modes are listed after the major mode. @@ -679,7 +679,7 @@ value. When the minibuffer is the current buffer, typing 'M-' or 'M-' selects a previous/next completion candidate from the "*Completions*" buffer and inserts it to the minibuffer. -When the variable 'minibuffer-completion-auto-choose' is nil, +When the user option 'minibuffer-completion-auto-choose' is nil, 'M-' and 'M-' do the same, but without inserting a completion candidate to the minibuffer, then 'M-RET' can be used to choose the currently active candidate from the "*Completions*" @@ -737,7 +737,7 @@ The nil value disables this highlighting. *** Choosing a completion with a prefix argument doesn't exit the minibuffer. This means that typing 'C-u RET' on a completion candidate in the "*Completions*" buffer inserts the completion to the minibuffer, -bot doesn't exit the minibuffer. +but doesn't exit the minibuffer. ** Isearch and Replace @@ -1284,7 +1284,7 @@ keyword-driven fontifications. *** New package vtable.el for formatting tabular data. This package allows formatting data using variable-pitch fonts. The resulting tables can display text in variable pitch fonts, text -using fonts of different sizes, and images. See the '(vtable)Top' +using fonts of different sizes, and images. See the "(vtable) Top" manual for more details. --- @@ -1500,11 +1500,11 @@ scripts. This works like 'buttonize', but for a region instead of a string. +++ -** 'macroexp-let2*' can omit 'test' arg and use single-var bindings. +** 'macroexp-let2*' can omit TEST arg and use single-var bindings. +++ ** New macro-writing macros, 'cl-with-gensyms' and 'cl-once-only'. -See the '(cl) Macro-Writing Macros' manual section for descriptions. +See the "(cl) Macro-Writing Macros" manual section for descriptions. +++ ** New variable 'last-event-device' and new function 'device-class'. @@ -1619,14 +1619,14 @@ them towards or away from each other. This hook is run before 'x-popup-menu' is about to display a deck-of-cards menu on screen. -** New function 'buffer-match-p' +** New function 'buffer-match-p'. Check if a buffer satisfies some condition. Some examples for conditions can be regular expressions that match a buffer name, a -cons-cell like (major-mode . shell-mode) that matches any buffer where -major-mode is shell-mode or a combined with a condition like (and -"\\`\\*.+\\*\\'" (major-mode . special-mode)). +cons-cell like '(major-mode . shell-mode)' that matches any buffer +where 'major-mode' is 'shell-mode' or a combined with a condition like +'(and "\\`\\*.+\\*\\'" (major-mode . special-mode))'. -** New function 'match-buffers' +** New function 'match-buffers'. Use 'buffer-match-p' to gather a list of buffers that match a condition. commit dad2a41a2ab792ab6fdc3ff972117102c3c3e5ca Author: Lars Ingebrigtsen Date: Mon Apr 25 10:05:44 2022 +0200 Make flymake-show-buffer-diagnostics error out in non-Flymake buffers * lisp/progmodes/flymake.el (flymake-show-buffer-diagnostics): Signal an error if run outside of a buffer with Flymake enabled (bug#55097). diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 83d7bc8641..8cbebe78fe 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1637,6 +1637,8 @@ buffer." (defun flymake-show-buffer-diagnostics () "Show a list of Flymake diagnostics for current buffer." (interactive) + (unless flymake-mode + (user-error "Flymake mode is not enabled in the current buffer")) (let* ((name (flymake--diagnostics-buffer-name)) (source (current-buffer)) (target (or (get-buffer name) commit e1d0632003157228650ba20d47cc607c0f9cae86 Author: Lars Ingebrigtsen Date: Mon Apr 25 09:47:54 2022 +0200 Fix up some string-edit.el strings * lisp/textmodes/string-edit.el (string-edit) (read-string-from-buffer): Make doc strings use dynamic key bindings. (string-edit): Fix message at the end. diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el index 2a4c9abfad..7c3b570224 100644 --- a/lisp/textmodes/string-edit.el +++ b/lisp/textmodes/string-edit.el @@ -37,10 +37,10 @@ (cl-defun string-edit (string success-callback &key abort-callback help-text) "Switch to a new buffer to edit STRING. -When the user finishes editing (with `C-c C-c'), SUCCESS-CALLBACK +When the user finishes editing (with \\\\[string-edit-done]), SUCCESS-CALLBACK is called with the resulting string. -If the user aborts (with `C-c C-k'), ABORT-CALLBACK (if any) is +If the user aborts (with \\\\[string-edit-abort]), ABORT-CALLBACK (if any) is called with no parameters. If present, HELP-TEXT will be inserted at the start of the @@ -66,12 +66,12 @@ buffer, but won't be included in the resulting string." (setq-local string-edit--success-callback success-callback) (when abort-callback (setq-local string-edit--abort-callback abort-callback)) - (message "%S" (substitute-command-keys - "Type `C-c C-c' when you've finished editing"))) + (message "%s" (substitute-command-keys + "Type \\\\[string-edit-done] when you've finished editing"))) (defun read-string-from-buffer (string &optional help-text) "Switch to a new buffer to edit STRING in a recursive edit. -The user finishes editing with `C-c C-c', or aborts with `C-c C-k'). +The user finishes editing with \\\\[string-edit-done], or aborts with \\\\[string-edit-abort]). If present, HELP-TEXT will be inserted at the start of the buffer, but won't be included in the resulting string."