commit e1757c00caa342e698216fba0098dc9f42fc4777 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sat Feb 26 07:24:12 2022 +0000 Prevent crashes on event for removed scroll bar on Haiku * src/haiku_support.cc (class EmacsScrollBar): Remove field `scroll_bar'. (ValueChanged, MouseDown, MouseUp, BScrollBar_make_for_view): Adjust for changes. * src/haiku_support.h (struct haiku_scroll_bar_value_event) (struct haiku_scroll_bar_drag_event) (struct haiku_scroll_bar_part_event): New field `window'. * src/haikuterm.c (haiku_scroll_bar_from_widget): New function. (haiku_read_socket): Adjust for changes in scroll bar event structures. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index ab33e38dc7..fe91986e8c 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1557,7 +1557,6 @@ class EmacsView : public BView class EmacsScrollBar : public BScrollBar { public: - void *scroll_bar; int dragging = 0; bool horizontal; enum haiku_scroll_bar_part current_part; @@ -1599,7 +1598,8 @@ class EmacsScrollBar : public BScrollBar { SetValue (old_value); - part.scroll_bar = scroll_bar; + part.scroll_bar = this; + part.window = Window (); part.part = current_part; haiku_write (SCROLL_BAR_PART_EVENT, &part); } @@ -1610,7 +1610,8 @@ class EmacsScrollBar : public BScrollBar return; } - rq.scroll_bar = scroll_bar; + rq.scroll_bar = this; + rq.window = Window (); rq.position = new_value; haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); @@ -1688,7 +1689,8 @@ class EmacsScrollBar : public BScrollBar if (r.Contains (pt)) { - part.scroll_bar = scroll_bar; + part.scroll_bar = this; + part.window = Window (); part.part = HAIKU_SCROLL_BAR_UP_BUTTON; dragging = 1; current_part = HAIKU_SCROLL_BAR_UP_BUTTON; @@ -1701,7 +1703,8 @@ class EmacsScrollBar : public BScrollBar if (r.Contains (pt)) { - part.scroll_bar = scroll_bar; + part.scroll_bar = this; + part.window = Window (); part.part = HAIKU_SCROLL_BAR_DOWN_BUTTON; dragging = 1; current_part = HAIKU_SCROLL_BAR_DOWN_BUTTON; @@ -1711,7 +1714,8 @@ class EmacsScrollBar : public BScrollBar } rq.dragging_p = 1; - rq.scroll_bar = scroll_bar; + rq.window = Window (); + rq.scroll_bar = this; haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); @@ -1724,7 +1728,8 @@ class EmacsScrollBar : public BScrollBar { struct haiku_scroll_bar_drag_event rq; rq.dragging_p = 0; - rq.scroll_bar = scroll_bar; + rq.scroll_bar = this; + rq.window = Window (); haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); dragging = false; @@ -2199,10 +2204,9 @@ BScrollBar_make_for_view (void *view, int horizontal_p, void *scroll_bar_ptr) { EmacsScrollBar *sb = new EmacsScrollBar (x, y, x1, y1, horizontal_p); - sb->scroll_bar = scroll_bar_ptr; - BView *vw = (BView *) view; BView *sv = (BView *) sb; + if (!vw->LockLooper ()) gui_abort ("Failed to lock scrollbar owner"); vw->AddChild ((BView *) sb); diff --git a/src/haiku_support.h b/src/haiku_support.h index 714cb18ae7..9d13cae47c 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -296,12 +296,14 @@ struct haiku_font_pattern struct haiku_scroll_bar_value_event { void *scroll_bar; + void *window; int position; }; struct haiku_scroll_bar_drag_event { void *scroll_bar; + void *window; int dragging_p; }; @@ -314,6 +316,7 @@ enum haiku_scroll_bar_part struct haiku_scroll_bar_part_event { void *scroll_bar; + void *window; enum haiku_scroll_bar_part part; }; diff --git a/src/haikuterm.c b/src/haikuterm.c index 357ec8239c..7779b3168b 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -416,6 +416,28 @@ haiku_mouse_or_wdesc_frame (void *window) } } +static struct scroll_bar * +haiku_scroll_bar_from_widget (void *scroll_bar, void *window) +{ + Lisp_Object tem; + struct frame *frame = haiku_window_to_frame (window); + + if (!frame) + return NULL; + + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + for (tem = FRAME_SCROLL_BARS (frame); !NILP (tem); + tem = XSCROLL_BAR (tem)->next) + { + if (XSCROLL_BAR (tem)->scroll_bar == scroll_bar) + return XSCROLL_BAR (tem); + } + } + + return NULL; +} + /* Unfortunately, NOACTIVATE is not implementable on Haiku. */ static void haiku_focus_frame (struct frame *frame, bool noactivate) @@ -3127,7 +3149,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case SCROLL_BAR_VALUE_EVENT: { struct haiku_scroll_bar_value_event *b = buf; - struct scroll_bar *bar = b->scroll_bar; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; struct window *w = XWINDOW (bar->window); @@ -3153,7 +3179,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case SCROLL_BAR_PART_EVENT: { struct haiku_scroll_bar_part_event *b = buf; - struct scroll_bar *bar = b->scroll_bar; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; inev.kind = (bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : SCROLL_BAR_CLICK_EVENT); @@ -3183,7 +3213,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case SCROLL_BAR_DRAG_EVENT: { struct haiku_scroll_bar_drag_event *b = buf; - struct scroll_bar *bar = b->scroll_bar; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; bar->dragging = b->dragging_p; if (!b->dragging_p && bar->horizontal) commit 3e9c36e7999356d5d14bd587ce74083c5a2c6512 Author: Po Lu Date: Sat Feb 26 07:06:55 2022 +0000 Fix reporting of horizontal scroll bar buttons on Haiku * haikuterm.c (haiku_read_socket): Use correct values for scroll bar buttons when the scroll bar is horizontal. diff --git a/src/haikuterm.c b/src/haikuterm.c index badc3f5801..357ec8239c 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3163,10 +3163,14 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) switch (b->part) { case HAIKU_SCROLL_BAR_UP_BUTTON: - inev.part = scroll_bar_up_arrow; + inev.part = (bar->horizontal + ? scroll_bar_left_arrow + : scroll_bar_up_arrow); break; case HAIKU_SCROLL_BAR_DOWN_BUTTON: - inev.part = scroll_bar_down_arrow; + inev.part = (bar->horizontal + ? scroll_bar_right_arrow + : scroll_bar_down_arrow); break; } commit 974c44414a1bd3dced0f77ce65c60a41e0f25a1a Author: Po Lu Date: Sat Feb 26 06:56:31 2022 +0000 Improve scroll bar button handling on Haiku * src/haiku_io.c (haiku_len): Add `SCROLL_BAR_PART_EVENT'. * src/haiku_support.cc (class EmacsScrollBar): New fields `dragging' and `current_state', along with `old_value' and `current_part'. (EmacsScrollBar): Set horizontal flag to `horizontal_p'. (MessageReceived): Set old_value when receiving SCROLL_BAR_UPDATE message. (ValueChanged): Don't allow scroll bar values to change while dragging. (MouseUp, MouseDown): Calculate button under mouse and act accordingly. * src/haiku_support.h (enum haiku_event_type): New event `SCROLL_BAR_PART_EVENT'. (enum haiku_scroll_bar_part): New enumerator. (struct haiku_scroll_bar_part_event): New struct. * src/haikuterm.c (haiku_read_socket): Handle SCROLL_BAR_PART_EVENTs. diff --git a/src/haiku_io.c b/src/haiku_io.c index cade69f338..ff684df433 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -98,6 +98,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_dummy_event); case MENU_BAR_LEFT: return sizeof (struct haiku_menu_bar_left_event); + case SCROLL_BAR_PART_EVENT: + return sizeof (struct haiku_scroll_bar_part_event); } emacs_abort (); diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 43b996b795..ab33e38dc7 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1558,6 +1558,10 @@ class EmacsScrollBar : public BScrollBar { public: void *scroll_bar; + int dragging = 0; + bool horizontal; + enum haiku_scroll_bar_part current_part; + float old_value; EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) : BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? @@ -1565,6 +1569,7 @@ class EmacsScrollBar : public BScrollBar { BView *vw = (BView *) this; vw->SetResizingMode (B_FOLLOW_NONE); + horizontal = horizontal_p; } void @@ -1572,6 +1577,7 @@ class EmacsScrollBar : public BScrollBar { if (msg->what == SCROLL_BAR_UPDATE) { + old_value = msg->GetInt32 ("emacs:units", 0); this->SetRange (0, msg->GetInt32 ("emacs:range", 0)); this->SetValue (msg->GetInt32 ("emacs:units", 0)); } @@ -1583,20 +1589,133 @@ class EmacsScrollBar : public BScrollBar ValueChanged (float new_value) { struct haiku_scroll_bar_value_event rq; + struct haiku_scroll_bar_part_event part; + + if (dragging) + { + if (new_value != old_value) + { + if (dragging > 1) + { + SetValue (old_value); + + part.scroll_bar = scroll_bar; + part.part = current_part; + haiku_write (SCROLL_BAR_PART_EVENT, &part); + } + else + dragging++; + } + + return; + } + rq.scroll_bar = scroll_bar; rq.position = new_value; haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); } + BRegion + ButtonRegionFor (enum haiku_scroll_bar_part button) + { + BRegion region; + BRect bounds; + BRect rect; + float button_size; + scroll_bar_info info; + + get_scroll_bar_info (&info); + + bounds = Bounds (); + bounds.InsetBy (0.0, 0.0); + + if (horizontal) + button_size = bounds.Height () + 1.0f; + else + button_size = bounds.Width () + 1.0f; + + rect = BRect (bounds.left, bounds.top, + bounds.left + button_size - 1.0f, + bounds.top + button_size - 1.0f); + + if (button == HAIKU_SCROLL_BAR_UP_BUTTON) + { + if (!horizontal) + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.left, + bounds.bottom - 2 * button_size + 1)); + } + else + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.right - 2 * button_size, + bounds.top)); + } + } + else + { + if (!horizontal) + { + region.Include (rect.OffsetToCopy (bounds.left, bounds.bottom - button_size)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (0.0, button_size)); + } + else + { + region.Include (rect.OffsetToCopy (bounds.right - button_size, bounds.top)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (button_size, 0.0)); + } + } + + return region; + } + void MouseDown (BPoint pt) { struct haiku_scroll_bar_drag_event rq; + struct haiku_scroll_bar_part_event part; + BRegion r; + + r = ButtonRegionFor (HAIKU_SCROLL_BAR_UP_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = scroll_bar; + part.part = HAIKU_SCROLL_BAR_UP_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_UP_BUTTON; + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + + r = ButtonRegionFor (HAIKU_SCROLL_BAR_DOWN_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = scroll_bar; + part.part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + rq.dragging_p = 1; rq.scroll_bar = scroll_bar; haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + + out: BScrollBar::MouseDown (pt); } @@ -1608,6 +1727,8 @@ class EmacsScrollBar : public BScrollBar rq.scroll_bar = scroll_bar; haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + dragging = false; + BScrollBar::MouseUp (pt); } diff --git a/src/haiku_support.h b/src/haiku_support.h index 4de71075c0..714cb18ae7 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -76,6 +76,7 @@ enum haiku_event_type ICONIFICATION, MOVE_EVENT, SCROLL_BAR_VALUE_EVENT, + SCROLL_BAR_PART_EVENT, SCROLL_BAR_DRAG_EVENT, WHEEL_MOVE_EVENT, MENU_BAR_RESIZE, @@ -304,6 +305,18 @@ struct haiku_scroll_bar_drag_event int dragging_p; }; +enum haiku_scroll_bar_part + { + HAIKU_SCROLL_BAR_UP_BUTTON, + HAIKU_SCROLL_BAR_DOWN_BUTTON + }; + +struct haiku_scroll_bar_part_event +{ + void *scroll_bar; + enum haiku_scroll_bar_part part; +}; + struct haiku_menu_bar_resize_event { void *window; diff --git a/src/haikuterm.c b/src/haikuterm.c index 5e2259e49a..badc3f5801 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3150,6 +3150,32 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } break; } + case SCROLL_BAR_PART_EVENT: + { + struct haiku_scroll_bar_part_event *b = buf; + struct scroll_bar *bar = b->scroll_bar; + + inev.kind = (bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT + : SCROLL_BAR_CLICK_EVENT); + + bar->dragging = 0; + + switch (b->part) + { + case HAIKU_SCROLL_BAR_UP_BUTTON: + inev.part = scroll_bar_up_arrow; + break; + case HAIKU_SCROLL_BAR_DOWN_BUTTON: + inev.part = scroll_bar_down_arrow; + break; + } + + XSETINT (inev.x, 0); + XSETINT (inev.y, 0); + inev.frame_or_window = bar->window; + + break; + } case SCROLL_BAR_DRAG_EVENT: { struct haiku_scroll_bar_drag_event *b = buf; commit c215158756b127f77a1cf298e80529e2589a23b4 Merge: 63a21224a5 ded89ed3fa Author: Stefan Kangas Date: Sat Feb 26 06:32:26 2022 +0100 Merge from origin/emacs-28 ded89ed3fa * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): ... commit 63a21224a505fc22b919eafd1df8ad68b31457ca Author: Po Lu Date: Sat Feb 26 08:54:36 2022 +0800 * src/xterm.c (handle_one_xevent): Set user time for xwidgets as well. diff --git a/src/xterm.c b/src/xterm.c index 32f76d156a..040397777b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10572,6 +10572,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case LeaveNotify: + x_display_set_last_user_time (dpyinfo, event->xcrossing.time); + #ifdef HAVE_XWIDGETS { struct xwidget_view *xvw = xwidget_view_from_window (event->xcrossing.window); @@ -10583,7 +10585,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } #endif - x_display_set_last_user_time (dpyinfo, event->xcrossing.time); if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) x_detect_focus_change (dpyinfo, any, event, &inev.ie); @@ -10919,6 +10920,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, case ButtonRelease: case ButtonPress: { + if (event->xbutton.type == ButtonPress) + x_display_set_last_user_time (dpyinfo, event->xbutton.time); + #ifdef HAVE_XWIDGETS struct xwidget_view *xvw = xwidget_view_from_window (event->xmotion.window); @@ -10948,9 +10952,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; - if (event->xbutton.type == ButtonPress) - x_display_set_last_user_time (dpyinfo, event->xbutton.time); - f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); if (f && event->xbutton.type == ButtonPress && !popup_activated () @@ -11318,6 +11319,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, enter->deviceid, false); #endif + x_display_set_last_user_time (dpyinfo, xi_event->time); + #ifdef HAVE_XWIDGETS { struct xwidget_view *xvw @@ -11333,8 +11336,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif - x_display_set_last_user_time (dpyinfo, xi_event->time); - if (any) x_detect_focus_change (dpyinfo, any, event, &inev.ie); @@ -11485,6 +11486,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xv) { uint state = xev->mods.effective; + x_display_set_last_user_time (dpyinfo, xev->time); if (xev->buttons.mask_len) { @@ -11667,6 +11669,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif + if (xev->evtype == XI_ButtonPress) + x_display_set_last_user_time (dpyinfo, xev->time); + #ifdef HAVE_XWIDGETS xvw = xwidget_view_from_window (xev->event); if (xvw) @@ -11701,9 +11706,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, dpyinfo->last_mouse_glyph_frame = NULL; - if (xev->evtype == XI_ButtonPress) - x_display_set_last_user_time (dpyinfo, xev->time); - f = mouse_or_wdesc_frame (dpyinfo, xev->event); if (f && xev->evtype == XI_ButtonPress commit 018eeb655aa66ce1f32288ed2c23c042877a578b Author: Dmitry Gutov Date: Sat Feb 26 02:18:34 2022 +0200 Drop the visited file modtime check for remote xref hits * lisp/progmodes/xref.el (xref--hits-remote-id): New variable. (xref--convert-hits, xref--collect-matches) (xref--find-file-buffer): Use it (bug#54025). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 96fb835d0f..5b27c83584 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1923,21 +1923,22 @@ Such as the current syntax table and the applied syntax properties." (defvar xref--last-file-buffer nil) (defvar xref--temp-buffer-file-name nil) +(defvar xref--hits-remote-id nil) (defun xref--convert-hits (hits regexp) (let (xref--last-file-buffer (tmp-buffer (generate-new-buffer " *xref-temp*")) - (remote-id (file-remote-p default-directory)) + (xref--hits-remote-id (file-remote-p default-directory)) (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (unwind-protect (mapcan (lambda (hit) - (xref--collect-matches hit regexp tmp-buffer remote-id syntax-needed)) + (xref--collect-matches hit regexp tmp-buffer syntax-needed)) hits) (kill-buffer tmp-buffer)))) -(defun xref--collect-matches (hit regexp tmp-buffer remote-id syntax-needed) +(defun xref--collect-matches (hit regexp tmp-buffer syntax-needed) (pcase-let* ((`(,line ,file ,text) hit) - (file (and file (concat remote-id file))) + (file (and file (concat xref--hits-remote-id file))) (buf (xref--find-file-buffer file)) (inhibit-modification-hooks t)) (if buf @@ -2016,7 +2017,8 @@ Such as the current syntax table and the applied syntax properties." (when (and buf (or (buffer-modified-p buf) - (not (verify-visited-file-modtime (current-buffer))))) + (unless xref--hits-remote-id + (not (verify-visited-file-modtime (current-buffer)))))) ;; We can't use buffers whose contents diverge from disk (bug#54025). (setq buf nil)) (setq xref--last-file-buffer (cons file buf)))) commit 9372e543a92306dabfb03a3c1f97ceb5cb4d8608 Author: Paul Eggert Date: Fri Feb 25 12:26:59 2022 -0800 Robustify merge-gnulib a bit * admin/merge-gnulib: Fail if autogen.sh fails. Remove autom4te.cache before running gnulib-tool. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 4aabffa0dc..fec469c017 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -103,7 +103,10 @@ test -x "$gnulib_srcdir"/gnulib-tool || { } # gnulib-tool has problems with a bare checkout (Bug#32452#65). -test -f configure || ./autogen.sh +test -f configure || ./autogen.sh || exit + +# Old caches can confuse autoconf when some Gnulib-related changes take effect. +rm -fr autom4te.cache || exit avoided_flags= for module in $AVOIDED_MODULES; do commit ca3858563c7ba8ee3caa82fbd2b7c386ea60c0d3 Author: Bob Rogers Date: Fri Feb 25 13:03:20 2022 +0100 Add new file ietf-drums-date.el * lisp/mail/ietf-drums-date.el: parse-time-string replacement which is compatible but can be made stricter if desired. * test/lisp/mail/ietf-drums-date-tests.el (added): Add tests for ietf-drums-parse-date-string. * lisp/mail/ietf-drums.el (ietf-drums-parse-date): Use ietf-drums-parse-date-string. diff --git a/etc/NEWS b/etc/NEWS index 902d89e62d..8deb699978 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1158,6 +1158,12 @@ functions. * Lisp Changes in Emacs 29.1 +--- +** New function 'ietf-drums-parse-date-string'. +This function parses RFC5322 (and RFC822) date strings, and should be +used instead of 'parse-time-string' when parsing data that's standards +compliant. + +++ ** New macro 'setopt'. This is like 'setq', but uses 'customize-set-variable' to set the diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el new file mode 100644 index 0000000000..6f64ae7337 --- /dev/null +++ b/lisp/mail/ietf-drums-date.el @@ -0,0 +1,274 @@ +;;; ietf-drums-date.el --- parse time/date for ietf-drums.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers +;; Keywords: mail, util + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; 'ietf-drums-parse-date-string' parses a time and/or date in a +;; string and returns a list of values, just like `decode-time', where +;; unspecified elements in the string are returned as nil (except +;; unspecified DST is returned as -1). `encode-time' may be applied +;; on these values to obtain an internal time value. + +;; Historically, `parse-time-string' was used for this purpose, but it +;; was gradually but imperfectly extended to handle other date +;; formats. 'ietf-drums-parse-date-string' is compatible in that it +;; uses the same return value format and parses the same email date +;; formats by default, but can be made stricter if desired. + +;;; Code: + +(require 'cl-lib) +(require 'parse-time) + +(define-error 'date-parse-error "Date/time parse error" 'error) + +(defconst ietf-drums-date--slot-names + '(second minute hour day month year weekday dst zone) + "Names of return value slots, for better error messages +See the decoded-time defstruct.") + +(defconst ietf-drums-date--slot-ranges + '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999)) + "Numeric slot ranges, for bounds checking. +Note that RFC5322 explicitly requires that seconds go up to 60, +to allow for leap seconds (see Mills, D., 'Network Time +Protocol', STD 12, RFC 1119, September 1989).") + +(defsubst ietf-drums-date--ignore-char-p (char) + ;; Ignore whitespace and commas. + (memq char '(?\s ?\t ?\r ?\n ?,))) + +(defun ietf-drums-date--tokenize-string (string &optional comment-eof) + "Turn STRING into tokens, separated only by whitespace and commas. +Multiple commas are ignored. Pure digit sequences are turned +into integers. If COMMENT-EOF is true, then a comment as +defined by RFC5322 (strictly, the CFWS production that also +accepts comments) is treated as an end-of-file, and no further +tokens are recognized, otherwise we strip out all comments and +treat them as whitespace (per RFC822)." + (let ((index 0) + (end (length string)) + (list ())) + (cl-flet ((skip-ignored () + ;; Skip ignored characters at index (the scan + ;; position). Skip RFC822 comments in matched parens, + ;; but do not complain about unterminated comments. + (let ((char nil) + (nest 0)) + (while (and (< index end) + (setq char (aref string index)) + (or (> nest 0) + (ietf-drums-date--ignore-char-p char) + (and (not comment-eof) (eql char ?\()))) + (cl-incf index) + ;; FWS bookkeeping. + (cond ((and (eq char ?\\) + (< (1+ index) end)) + ;; Move to the next char but don't check + ;; it to see if it might be a paren. + (cl-incf index)) + ((eq char ?\() (cl-incf nest)) + ((eq char ?\)) (cl-decf nest))))))) + (skip-ignored) ;; Skip leading whitespace. + (while (and (< index end) + (not (and comment-eof + (eq (aref string index) ?\()))) + (let* ((start index) + (char (aref string index)) + (all-digits (<= ?0 char ?9))) + ;; char is valid; look for more valid characters. + (when (and (eq char ?\\) + (< (1+ index) end)) + ;; Escaped character, which might be a "(". If so, we are + ;; correct to include it in the token, even though the + ;; caller is sure to barf. If not, we violate RFC2?822 by + ;; not removing the backslash, but no characters in valid + ;; RFC2?822 dates need escaping anyway, so it shouldn't + ;; matter that this is not done strictly correctly. -- + ;; rgr, 24-Dec-21. + (cl-incf index)) + (while (and (< (cl-incf index) end) + (setq char (aref string index)) + (not (or (ietf-drums-date--ignore-char-p char) + (eq char ?\()))) + (unless (<= ?0 char ?9) + (setq all-digits nil)) + (when (and (eq char ?\\) + (< (1+ index) end)) + ;; Escaped character, see above. + (cl-incf index))) + (push (if all-digits + (cl-parse-integer string :start start :end index) + (substring string start index)) + list) + (skip-ignored))) + (nreverse list)))) + +(defun ietf-drums-parse-date-string (time-string &optional error no-822) + "Parse an RFC5322 or RFC822 date, passed as TIME-STRING. +The optional ERROR parameter causes syntax errors to be flagged +by signalling an instance of the date-parse-error condition. The +optional NO-822 parameter disables the more lax RFC822 syntax, +which is permitted by default. + +The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ), +which can be accessed as a decoded-time defstruct (q.v.), +e.g. `decoded-time-year' to extract the year, and turned into an +Emacs timestamp by `encode-time'. + +The strict syntax for RFC5322 is as follows: + + [ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS] + +where the \"time\" production is: + + 2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT + +and FWS is \"folding white space,\" and CFWS is \"comments and/or +folding white space\", where comments are included in nesting +parentheses and are equivalent to white space. RFC822 also +accepts comments in random places (all of which is handled by +ietf-drums-date--tokenize-string) and two-digit years. For +two-digit years, 50 and up are interpreted as 1950 through 1999 +and 00 through 49 as 200 through 2049. + +We are somewhat more lax in what we accept (specifically, the +hours don't have to be two digits, and the TZ and the comma after +the DOW are optional), but we do insist that the items that are +present do appear in this order. Unspecified/unrecognized +elements in the string are returned as nil (except unspecified +DST is returned as -1)." + (let ((tokens (ietf-drums-date--tokenize-string (downcase time-string) + no-822)) + (time (list nil nil nil nil nil nil nil -1 nil))) + (cl-labels ((set-matched-slot (slot index token) + ;; Assign a slot value from match data if index is + ;; non-nil, else from token, signalling an error if + ;; enabled and it's out of range. + (let ((value (if index + (cl-parse-integer (match-string index token)) + token))) + (when error + (let ((range (nth slot ietf-drums-date--slot-ranges))) + (when (and range + (not (<= (car range) value (cadr range)))) + (signal 'date-parse-error + (list "Slot out of range" + (nth slot ietf-drums-date--slot-names) + token (car range) (cadr range)))))) + (setf (nth slot time) value))) + (set-numeric (slot token) + ;; Only assign the slot if the token is a number. + (cond ((natnump token) + (set-matched-slot slot nil token)) + (error + (signal 'date-parse-error + (list "Not a number" + (nth slot ietf-drums-date--slot-names) + token)))))) + ;; Check for weekday. + (let ((dow (assoc (car tokens) parse-time-weekdays))) + (when dow + ;; Day of the week. + (set-matched-slot 6 nil (cdr dow)) + (pop tokens))) + ;; Day. + (set-numeric 3 (pop tokens)) + ;; Alphabetic month. + (let* ((month (pop tokens)) + (match (assoc month parse-time-months))) + (cond (match + (set-matched-slot 4 nil (cdr match))) + (error + (signal 'date-parse-error + (list "Expected an alphabetic month" month))) + (t + (push month tokens)))) + ;; Year. + (let ((year (pop tokens))) + ;; Check the year for the right number of digits. + (cond ((not (natnump year)) + (when error + (signal 'date-parse-error + (list "Expected a year" year))) + (push year tokens)) + ((>= year 1000) + (set-numeric 5 year)) + ((or no-822 + (>= year 100)) + (when error + (signal 'date-parse-error + (list "Four-digit years are required" year))) + (push year tokens)) + ((>= year 50) + ;; second half of the 20th century. + (set-numeric 5 (+ 1900 year))) + (t + ;; first half of the 21st century. + (set-numeric 5 (+ 2000 year))))) + ;; Time. + (let ((time (pop tokens))) + (cond ((or (null time) (natnump time)) + (when error + (signal 'date-parse-error + (list "Expected a time" time))) + (push time tokens)) + ((string-match + "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$" + time) + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 3 time)) + ((string-match "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$" time) + ;; Time without seconds. + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 nil 0)) + (error + (signal 'date-parse-error + (list "Expected a time" time))))) + ;; Timezone. + (let* ((zone (pop tokens)) + (match (assoc zone parse-time-zoneinfo))) + (cond (match + (set-matched-slot 8 nil (cadr match)) + (set-matched-slot 7 nil (caddr match))) + ((and (stringp zone) + (string-match "^[-+][0-9][0-9][0-9][0-9]$" zone)) + ;; Numeric time zone. + (set-matched-slot + 8 nil + (* 60 + (+ (cl-parse-integer zone :start 3 :end 5) + (* 60 (cl-parse-integer zone :start 1 :end 3))) + (if (= (aref zone 0) ?-) -1 1)))) + ((and zone error) + (signal 'date-parse-error + (list "Expected a timezone" zone))))) + (when (and tokens error) + (signal 'date-parse-error + (list "Extra token(s)" (car tokens))))) + time)) + +(provide 'ietf-drums-date) + +;;; ietf-drums-date.el ends here diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 85aa27235f..d1ad671b16 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -294,9 +294,13 @@ a list of address strings." (replace-match " " t t)) (goto-char (point-min))) +(declare-function ietf-drums-parse-date-string "ietf-drums-date" + (time-string &optional error? no-822?)) + (defun ietf-drums-parse-date (string) "Return an Emacs time spec from STRING." - (encode-time (parse-time-string string))) + (require 'ietf-drums-date) + (encode-time (ietf-drums-parse-date-string string))) (defun ietf-drums-narrow-to-header () "Narrow to the header section in the current buffer." diff --git a/test/lisp/mail/ietf-drums-date-tests.el b/test/lisp/mail/ietf-drums-date-tests.el new file mode 100644 index 0000000000..5b798077ff --- /dev/null +++ b/test/lisp/mail/ietf-drums-date-tests.el @@ -0,0 +1,190 @@ +;;; ietf-drums-date-tests.el --- Test suite for ietf-drums-date.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ietf-drums) +(require 'ietf-drums-date) + +(ert-deftest ietf-drums-date-tests () + "Test basic ietf-drums-parse-date-string functionality." + + ;; Test tokenization. + (should (equal (ietf-drums-date--tokenize-string " ") '())) + (should (equal (ietf-drums-date--tokenize-string " a b") '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a bbc dde") + '("a" "bbc" "dde"))) + (should (equal (ietf-drums-date--tokenize-string " , a 27 b,, c 14:32 ") + '("a" 27 "b" "c" "14:32"))) + ;; Some folding whitespace tests. + (should (equal (ietf-drums-date--tokenize-string " a b (end) c" t) + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "(quux)a (foo (bar)) b(baz)") + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\cde") + ;; Strictly incorrect, but strictly unnecessary syntax. + '("a" "b\\cde"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\ de") + '("a" "b\\ de"))) + (should (equal (ietf-drums-date--tokenize-string "a \\de \\(f") + '("a" "\\de" "\\(f"))) + + ;; Start with some compatible RFC822 dates. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 nil -1 3600) + (22219 21758)) + ("Mon, 22 February 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Mon, 22 feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 PST" + (42 35 19 22 2 2016 1 nil -28800) + (22219 54158)) + ("Friday, 21 Sep 2018 13:47:58 PDT" + (58 47 13 21 9 2018 5 t -25200) + (23461 22782)) + ("Friday, 21 Sep 2018 13:47:58 EDT" + (58 47 13 21 9 2018 5 t -14400) + (23461 11982)))) + (let* ((input (car case)) + (parsed (cadr case)) + (encoded (caddr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) parsed)) + (should (equal (ietf-drums-parse-date-string input nil t) parsed)) + ;; Check the encoded date (the official output, though the + ;; decoded-time is easier to debug). + (should (equal (ietf-drums-parse-date input) encoded)))) + + ;; Test a few without timezones. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42" + (42 35 19 22 2 2016 1 -1 nil)) + ("Friday, 21 Sep 2018 13:47:58" + (58 47 13 21 9 2018 5 -1 nil)))) + (let* ((input (car case)) + (parsed (cadr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) parsed)) + (should (equal (ietf-drums-parse-date-string input nil t) parsed)) + ;; We can't check the encoded date here because it will differ + ;; depending on the TZ of the test environment. + )) + + ;; Two-digit years are not allowed by the "modern" format. + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 16 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 16))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 96 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 96))) + + ;; Try some dates with comments. + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" t t)) + '(date-parse-error "Expected a year" nil))) + (should (equal (ietf-drums-parse-date-string + "22 Feb 96 (long ago) 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep(comment \\) with \\( parens)18 19:35:42") + '(42 35 19 21 9 2018 5 -1 nil))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep 18 19:35:42 (unterminated comment") + '(42 35 19 21 9 2018 5 -1 nil))) + + ;; Test some RFC822 error cases + (dolist (test '(("33 1 2022" ("Slot out of range" day 33 1 31)) + ("0 1 2022" ("Slot out of range" day 0 1 31)) + ("1 1 2020 2021" ("Expected an alphabetic month" 1)) + ("1 Jan 2020 2021" ("Expected a time" 2021)) + ("1 Jan 2020 20:21 2000" ("Expected a timezone" 2000)) + ("1 Jan 2020 20:21 +0200 33" ("Extra token(s)" 33)))) + (should (equal (should-error (ietf-drums-parse-date-string (car test) t)) + (cons 'date-parse-error (cadr test))))) + + (dolist (test '(("22 Feb 196" nil ;; bad year + ("Four-digit years are required" 196)) + ("22 Feb 16 19:35:24" t ;; two-digit year + ("Four-digit years are required" 16)) + ("22 Feb 96 19:35:42" t ;; two-digit year + ("Four-digit years are required" 96)) + ("2 Feb 2021 1996" nil + ("Expected a time" 1996)) + ("22 Fub 1996" nil + ("Expected an alphabetic month" "fub")) + ("1 Jan 2020 30" nil + ("Expected a time" 30)) + ("1 Jan 2020 16:47 15:15" nil + ("Expected a timezone" "15:15")) + ("1 Jan 2020 16:47 +0800 -0800" t + ("Extra token(s)" "-0800")) + ;; Range tests + ("32 Dec 2021" nil + ("Slot out of range" day 32 1 31)) + ("0 Dec 2021" nil + ("Slot out of range" day 0 1 31)) + ("3 13 2021" nil + ("Expected an alphabetic month" 13)) + ("3 Dec 0000" t + ("Four-digit years are required" 0)) + ("3 Dec 20021" nil + ("Slot out of range" year 20021 1 9999)) + ("1 Jan 2020 24:21:14" nil + ("Slot out of range" hour "24:21:14" 0 23)) + ("1 Jan 2020 14:60:21" nil + ("Slot out of range" minute "14:60:21" 0 59)) + ("1 Jan 2020 14:21:61" nil + ("Slot out of range" second "14:21:61" 0 60)))) + (should (equal (should-error + (ietf-drums-parse-date-string (car test) t (cadr test))) + (cons 'date-parse-error (caddr test))))) + (should (equal (ietf-drums-parse-date-string + "1 Jan 2020 14:21:60") ;; a leap second! + '(60 21 14 1 1 2020 nil -1 nil)))) + +(provide 'ietf-drums-date-tests) + +;;; ietf-drums-date-tests.el ends here commit 2b8bb05383ea1589027786795c9efaba4c718cce Author: Po Lu Date: Fri Feb 25 11:36:07 2022 +0000 Improve treatment of dropping mouse track state on Haiku * src/haikuterm.c (haiku_mouse_or_wdesc_frame): New function. (haiku_read_socket): Use it to find the appropriate frame when handling motion or button events. diff --git a/src/haikuterm.c b/src/haikuterm.c index 023349327a..5e2259e49a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -393,6 +393,29 @@ haiku_frame_raise_lower (struct frame *f, bool raise_p) } } +static struct frame * +haiku_mouse_or_wdesc_frame (void *window) +{ + struct frame *lm_f = (gui_mouse_grabbed (x_display_list) + ? x_display_list->last_mouse_frame + : NULL); + + if (lm_f && !EQ (track_mouse, Qdropping)) + return lm_f; + else + { + struct frame *w_f = haiku_window_to_frame (window); + + /* Do not return a tooltip frame. */ + if (!w_f || FRAME_TOOLTIP_P (w_f)) + return EQ (track_mouse, Qdropping) ? lm_f : NULL; + else + /* When dropping it would be probably nice to raise w_f + here. */ + return w_f; + } +} + /* Unfortunately, NOACTIVATE is not implementable on Haiku. */ static void haiku_focus_frame (struct frame *frame, bool noactivate) @@ -2777,7 +2800,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case MOUSE_MOTION: { struct haiku_mouse_motion_event *b = buf; - struct frame *f = haiku_window_to_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window); Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; if (!f) @@ -2936,7 +2959,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case BUTTON_DOWN: { struct haiku_button_event *b = buf; - struct frame *f = haiku_window_to_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window); Lisp_Object tab_bar_arg = Qnil; int tab_bar_p = 0, tool_bar_p = 0; bool up_okay_p = false; commit ded89ed3fa93c17a03051c6a6f77335c58af2d21 Author: Michael Albinus Date: Fri Feb 25 10:11:40 2022 +0100 * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Adapt test. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b3694a6a8d..80fd99e7f6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4759,7 +4759,7 @@ Goes through the list `tramp-inline-compress-commands'." (with-temp-buffer (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster") (goto-char (point-min)) - (when (search-forward-regexp "missing.+argument" nil t) + (when (search-forward-regexp "\\(missing\\|no\\).+argument" nil t) (setq tramp-ssh-controlmaster-options "-o ControlMaster=auto"))) (unless (zerop (length tramp-ssh-controlmaster-options))