Merge remote-tracking branch 'origin/master' into feature/pgtk

13 files changed, 313 insertions, 265 deletions

diff --git a/configure.ac b/configure.ac
index 892c3e0b7b8..9a74c52c68a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2704,7 +2704,7 @@ if test "${with_sqlite3}" != "no"; then
      AC_SUBST(SQLITE3_LIBS)
      LIBS="$SQLITE3_LIBS $LIBS"
      AC_DEFINE(HAVE_SQLITE3, 1, [Define to 1 if you have the libsqlite3 library (-lsqlite).])
-     # Windows loads libwebp dynamically
+     # Windows loads libsqlite dynamically
      if test "${opsys}" = "mingw32"; then
         SQLITE3_LIBS=
      fi
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e964d7b53c8..b8d92f7fdca 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5138,8 +5138,11 @@ IV used.
 
 @node Database
 @section Database
+@cindex database access, SQLite
 
-  Emacs can be compiled with built-in SQLite support.
+  Emacs can be compiled with built-in support for accessing SQLite
+databases.  This section describes the facilities available for
+accessing SQLite databases from Lisp programs.
 
 @defun sqlite-available-p
 The function returns non-@code{nil} if built-in SQLite support is
@@ -5148,20 +5151,21 @@ available in this Emacs session.
 
 When SQLite support is available, the following functions can be used.
 
+@cindex database object
 @defun sqlite-open &optional file
-This function opens @var{file} as a database file.  If it doesn't
-exist, a new database will be created and stored there.  If this
-argument is missing or @code{nil}, a new in-memory database is created
-instead.
+This function opens @var{file} as an SQLite database file.  If
+@var{file} doesn't exist, a new database will be created and stored in
+that file.  If @var{file} is omitted or @code{nil}, a new in-memory
+database is created instead.
 
 The return value is a @dfn{database object} that can be used as the
-argument to most of the subsequent functions in this section of the
-manual.
+argument to most of the subsequent functions described below.
 @end defun
 
-@defun sqlitep
-The database object returned by the @code{sqlite-open} function
-satisfies this predicate.
+@defun sqlitep object
+This predicate returns non-@code{nil} if @var{object} is an SQLite
+database object.  The database object returned by the
+@code{sqlite-open} function satisfies this predicate.
 @end defun
 
 @defun sqlite-close db
@@ -5185,13 +5189,13 @@ For instance:
 (sqlite-execute db "insert into foo values (?, ?)" '("bar" 2))
 @end lisp
 
-This has exactly the same effect as the first form, but is more
+This has exactly the same effect as the previous example, but is more
 efficient and safer (because it doesn't involve any string parsing or
 interpolation).
 
-The number of affected rows is returned.  For instance, an
-@samp{insert} statement will return @samp{1}, but an @samp{update}
-statement may return zero or a higher number.
+@code{sqlite-execute} returns the number of affected rows.  For
+instance, an @samp{insert} statement will return @samp{1}, whereas an
+@samp{update} statement may return zero or a higher number.
 @end defun
 
 @defun sqlite-select db query &optional values result-type
@@ -5202,33 +5206,36 @@ Select some data from @var{db} and return them.  For instance:
   @result{} (("bar" 2))
 @end lisp
 
-As with the @code{sqlite-execute} command, you can pass in a list or a
-vector of values that will be bound before executing the select:
+As with the @code{sqlite-execute}, you can optionally pass in a list
+or a vector of values that will be bound before executing the select:
 
 @lisp
 (sqlite-select db "select * from foo where key = ?" [2])
   @result{} (("bar" 2))
 @end lisp
 
-This is usually more efficient and safer than the first method.
+This is usually more efficient and safer than the method used by the
+previous example.
 
-This function, by default, returns a list of matching rows, where each
+By default, this function returns a list of matching rows, where each
 row is a list of column values.  If @var{return-type} is @code{full},
 the names of the columns (as a list of strings) will be returned as
 the first element in the return value.
 
+@cindex statement object
 If @var{return-type} is @code{set}, this function will return a
-@dfn{statement object} instead.  This object can be interrogated by
+@dfn{statement object} instead.  This object can be examined by using
 the @code{sqlite-next}, @code{sqlite-columns} and @code{sqlite-more-p}
 functions.  If the result set is small, it's often more convenient to
 just return the data directly, but if the result set is large (or if
 you won't be using all the data from the set), using the @code{set}
-method will allocate a lot less data, and therefore be more efficient.
+method will allocate a lot less memory, and is therefore more
+memory-efficient.
 @end defun
 
 @defun sqlite-next statement
-This function returns the next row in the result set returned by
-@code{sqlite-select}.
+This function returns the next row in the result set @var{statement},
+typically an object returned by @code{sqlite-select}.
 
 @lisp
 (sqlite-next stmt)
@@ -5237,8 +5244,8 @@ This function returns the next row in the result set returned by
 @end defun
 
 @defun sqlite-columns statement
-This function returns the column names of the result set returned by
-@code{sqlite-select}.
+This function returns the column names of the result set
+@var{statement}, typically an object returned by @code{sqlite-select}.
 
 @lisp
 (sqlite-columns stmt)
@@ -5247,38 +5254,42 @@ This function returns the column names of the result set returned by
 @end defun
 
 @defun sqlite-more-p statement
-This predicate says whether there is more data to be fetched in the
-result set returned by @code{sqlite-select}.
+This predicate says whether there is more data to be fetched from the
+result set @var{statement}, typically an object returned by
+@code{sqlite-select}.
 @end defun
 
 @defun sqlite-finalize statement
 If @var{statement} is not going to be used any more, calling this
-function will free the resources bound by @var{statement}.  This is
-usually not necessary---when the statement object is
-garbage-collected, this will happen automatically.
+function will free the resources used by @var{statement}.  This is
+usually not necessary---when the @var{statement} object is
+garbage-collected, Emacs will automatically free its resources.
 @end defun
 
 @defun sqlite-transaction db
 Start a transaction in @var{db}.  When in a transaction, other readers
 of the database won't access the results until the transaction has
-been committed.
+been committed by @code{sqlite-commit}.
 @end defun
 
 @defun sqlite-commit db
-End a transaction and write the data out to file.
+End a transaction in @var{db} and write the data out to its file.
 @end defun
 
 @defun sqlite-rollback db
-End a transaction and discard any changes that have been made.
+End a transaction in @var{db} and discard any changes that have been
+made by the transaction.
 @end defun
 
-@defmac with-sqlite-transaction db &body body
-Like @code{progn}, but executes @var{body} with a transaction held,
-and do a commit at the end.
+@defmac with-sqlite-transaction db body@dots{}
+Like @code{progn} (@pxref{Sequencing}), but executes @var{body} with a
+transaction held, and commits the transaction at the end.
 @end defmac
 
 @defun sqlite-load-extension db module
-Load an extension into @var{db}.  Extensions are usually @file{.so} files.
+Load the named extension @var{module} into the database @var{db}.
+Extensions are usually shared-library files; on GNU and Unix systems,
+they have the @file{.so} file-name extension.
 @end defun
 
 @node Parsing HTML/XML
diff --git a/etc/NEWS b/etc/NEWS
index b0dfa301d31..807751ae126 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,6 +24,11 @@ applies, and please also update docstrings as needed.
 
 * Installation Changes in Emacs 29.1
 
++++
+** Emacs can be built with built-in support for accessing SQLite databases.
+This uses the popular sqlite3 library, and can be disabled by using
+the '--without-sqlite3' option to the 'configure' script.
+
 ** Emacs has been ported to the Haiku operating system.
 The configuration process should automatically detect and build for
 Haiku.  There is also an optional window-system port to Haiku, which
@@ -91,13 +96,10 @@ the 'variable-pitch' face, or add this to your "~/.emacs":
 
 * Changes in Emacs 29.1
 
-+++
-** Emacs now comes with optional built-in support for sqlite3.
-This allows you to examine and manipulate sqlite3 databases.
-
 ** New command 'sqlite-mode-open-file' for examining an sqlite3 file.
-This uses the new 'sqlite-mode' which allows listing the tables
-in a file, the columns, and the contents of the tables.
+This uses the new 'sqlite-mode' which allows listing the tables in a
+DB file, and examining and modifying the columns and the contents of
+those tables.
 
 ---
 ** 'write-file' will now copy some file mode bits.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index f6db803b78e..2bdf1f55111 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -342,8 +342,12 @@ for speeding up processing.")
       (numberp expr)
       (stringp expr)
       (and (consp expr)
-           (memq (car expr) '(quote function))
-           (symbolp (cadr expr)))
+           (or (and (memq (car expr) '(quote function))
+                    (symbolp (cadr expr)))
+               ;; (internal-get-closed-var N) can be considered constant for
+               ;; const-prop purposes.
+               (and (eq (car expr) 'internal-get-closed-var)
+                    (integerp (cadr expr)))))
       (keywordp expr)))
 
 (defmacro byte-optimize--pcase (exp &rest cases)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index ba616586002..1bd0e8847e2 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5001,23 +5001,13 @@ If LINE, insert the rebuilt thread starting on line LINE."
                               gnus-article-sort-functions)))
       (gnus-message 7 "Sorting articles...done"))))
 
-;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(defmacro gnus-thread-header (thread)
-  "Return header of first article in THREAD.
-Note that THREAD must never, ever be anything else than a variable -
-using some other form will lead to serious barfage."
-  (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
-  ;; (8% speedup to gnus-summary-prepare, just for fun :-)
-  (cond
-   ((and (boundp 'lexical-binding) lexical-binding)
-    ;; FIXME: This version could be a "defsubst" rather than a macro.
-    `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207"
-            [] 2]
-      ,thread))
-   (t
-    ;; Not sure how XEmacs handles these things, so let's keep the old code.
-    (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
-          (vector thread) 2))))
+(defsubst gnus-thread-header (thread)
+  "Return header of first article in THREAD."
+  (if (consp thread)
+      (car (if (stringp (car thread))
+               (cadr thread)
+             thread))
+    thread))
 
 (defsubst gnus-article-sort-by-number (h1 h2)
   "Sort articles by article number."
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 336b555e77c..0e22ef2a6a7 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -542,35 +542,43 @@ animation."
                (< (- (float-time) time) 1.0)
                (eq (< delta 0) (< rem 0)))
       (setq delta (+ delta rem)))
-    (while-no-input
-      (unwind-protect
-          (while (< percentage 1)
-            (redisplay t)
-            (sleep-for between-scroll)
-            (setq time-elapsed (+ time-elapsed
-                                  (- (float-time) last-time))
-                  percentage (/ time-elapsed total-time))
-            (let ((throw-on-input nil))
-              (if (< delta 0)
-                  (pixel-scroll-precision-scroll-down
-                   (ceiling (abs (* (* delta factor)
-                                    (/ between-scroll total-time)))))
-                (pixel-scroll-precision-scroll-up
-                 (ceiling (* (* delta factor)
-                             (/ between-scroll total-time))))))
-            (setq last-time (float-time)))
-        (if (< percentage 1)
-            (progn
-              (set-window-parameter nil 'interpolated-scroll-remainder
-                                    (* delta (- 1 percentage)))
-              (set-window-parameter nil 'interpolated-scroll-remainder-time
-                                    (float-time)))
-          (set-window-parameter nil
-                                'interpolated-scroll-remainder
-                                nil)
-          (set-window-parameter nil
-                                'interpolated-scroll-remainder-time
-                                nil))))))
+    (if (or (null rem)
+            (eq (< delta 0) (< rem 0)))
+        (while-no-input
+          (unwind-protect
+              (while (< percentage 1)
+                (redisplay t)
+                (sleep-for between-scroll)
+                (setq time-elapsed (+ time-elapsed
+                                      (- (float-time) last-time))
+                      percentage (/ time-elapsed total-time))
+                (let ((throw-on-input nil))
+                  (if (< delta 0)
+                      (pixel-scroll-precision-scroll-down
+                       (ceiling (abs (* (* delta factor)
+                                        (/ between-scroll total-time)))))
+                    (pixel-scroll-precision-scroll-up
+                     (ceiling (* (* delta factor)
+                                 (/ between-scroll total-time))))))
+                (setq last-time (float-time)))
+            (if (< percentage 1)
+                (progn
+                  (set-window-parameter nil 'interpolated-scroll-remainder
+                                        (* delta (- 1 percentage)))
+                  (set-window-parameter nil 'interpolated-scroll-remainder-time
+                                        (float-time)))
+              (set-window-parameter nil
+                                    'interpolated-scroll-remainder
+                                    nil)
+              (set-window-parameter nil
+                                    'interpolated-scroll-remainder-time
+                                    nil))))
+      (set-window-parameter nil
+                            'interpolated-scroll-remainder
+                            nil)
+      (set-window-parameter nil
+                            'interpolated-scroll-remainder-time
+                            nil))))
 
 (defun pixel-scroll-precision-scroll-up (delta)
   "Scroll the current window up by DELTA pixels."
diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el
index 61398c180f7..9306bd85dcd 100644
--- a/lisp/sqlite-mode.el
+++ b/lisp/sqlite-mode.el
@@ -130,7 +130,7 @@
      (split-string (replace-regexp-in-string "^.*(\\|)$" "" sql) ","))))
 
 (defun sqlite-mode-list-data ()
-  "List the data from the table under poing."
+  "List the data from the table under point."
   (interactive nil sqlite-mode)
   (let ((row (and (eq (get-text-property (point) 'sqlite--type) 'table)
                   (get-text-property (point) 'sqlite--row))))
diff --git a/lisp/subr.el b/lisp/subr.el
index d224f761e1f..9c07606100b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4057,7 +4057,7 @@ BUFFER is the buffer (or buffer name) to associate with the process.
  Process output goes at end of that buffer, unless you specify
  an output stream or filter function to handle the output.
  BUFFER may be also nil, meaning that this process is not associated
- with any buffer
+ with any buffer.
 COMMAND is the shell command to run."
   ;; We used to use `exec' to replace the shell with the command,
   ;; but that failed to handle (...) and semicolon, etc.
diff --git a/src/haikuterm.c b/src/haikuterm.c
index f3c37b0258e..f95a013867f 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -536,162 +536,6 @@ haiku_draw_relief_rect (struct glyph_string *s,
 }
 
 static void
-haiku_draw_string_box (struct glyph_string *s, int clip_p)
-{
-  int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
-  bool raised_p, left_p, right_p;
-  struct glyph *last_glyph;
-  struct haiku_rect clip_rect;
-
-  struct face *face = s->face;
-
-  last_x = ((s->row->full_width_p && !s->w->pseudo_window_p)
-            ? WINDOW_RIGHT_EDGE_X (s->w)
-            : window_box_right (s->w, s->area));
-
-  /* The glyph that may have a right box line.  For static
-     compositions and images, the right-box flag is on the first glyph
-     of the glyph string; for other types it's on the last glyph.  */
-  if (s->cmp || s->img)
-    last_glyph = s->first_glyph;
-  else if (s->first_glyph->type == COMPOSITE_GLYPH
-           && s->first_glyph->u.cmp.automatic)
-    {
-      /* For automatic compositions, we need to look up the last glyph
-         in the composition.  */
-        struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area];
-        struct glyph *g = s->first_glyph;
-        for (last_glyph = g++;
-             g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id
-               && g->slice.cmp.to < s->cmp_to;
-             last_glyph = g++)
-          ;
-    }
-  else
-    last_glyph = s->first_glyph + s->nchars - 1;
-
-  vwidth = eabs (face->box_vertical_line_width);
-  hwidth = eabs (face->box_horizontal_line_width);
-  raised_p = face->box == FACE_RAISED_BOX;
-  left_x = s->x;
-  right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
-             ? last_x - 1
-             : min (last_x, s->x + s->background_width) - 1);
-
-  top_y = s->y;
-  bottom_y = top_y + s->height - 1;
-
-  left_p = (s->first_glyph->left_box_line_p
-            || (s->hl == DRAW_MOUSE_FACE
-                && (s->prev == NULL
-                    || s->prev->hl != s->hl)));
-  right_p = (last_glyph->right_box_line_p
-             || (s->hl == DRAW_MOUSE_FACE
-                 && (s->next == NULL
-                     || s->next->hl != s->hl)));
-
-  get_glyph_string_clip_rect (s, &clip_rect);
-
-  if (face->box == FACE_SIMPLE_BOX)
-    haiku_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
-                         vwidth, left_p, right_p, &clip_rect);
-  else
-    haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
-                            vwidth, raised_p, true, true, left_p, right_p,
-                            &clip_rect, 1);
-
-  if (clip_p)
-    {
-      void *view = FRAME_HAIKU_VIEW (s->f);
-      BView_ClipToInverseRect (view, left_x, top_y, right_x - left_x + 1, hwidth);
-      if (left_p)
-        BView_ClipToInverseRect (view, left_x, top_y, vwidth, bottom_y - top_y + 1);
-      BView_ClipToInverseRect (view, left_x, bottom_y - hwidth + 1,
-                               right_x - left_x + 1, hwidth);
-      if (right_p)
-        BView_ClipToInverseRect (view, right_x - vwidth + 1,
-                                 top_y, vwidth, bottom_y - top_y + 1);
-    }
-}
-
-static void
-haiku_draw_plain_background (struct glyph_string *s, struct face *face,
-                             int box_line_hwidth, int box_line_vwidth)
-{
-  void *view = FRAME_HAIKU_VIEW (s->f);
-  BView_StartClip (view);
-  if (s->hl == DRAW_CURSOR)
-    BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel);
-  else
-    BView_SetHighColor (view, face->background_defaulted_p ?
-                        FRAME_BACKGROUND_PIXEL (s->f) :
-                      face->background);
-
-  BView_FillRectangle (view, s->x,
-                       s->y + box_line_hwidth,
-                       s->background_width,
-                       s->height - 2 * box_line_hwidth);
-  BView_EndClip (view);
-}
-
-static void
-haiku_draw_stipple_background (struct glyph_string *s, struct face *face,
-                               int box_line_hwidth, int box_line_vwidth)
-{
-}
-
-static void
-haiku_maybe_draw_background (struct glyph_string *s, int force_p)
-{
-  if ((s->first_glyph->type != IMAGE_GLYPH) && !s->background_filled_p)
-    {
-      struct face *face = s->face;
-      int box_line_width = max (face->box_horizontal_line_width, 0);
-      int box_vline_width = max (face->box_vertical_line_width, 0);
-
-      if (FONT_HEIGHT (s->font) < s->height - 2 * box_vline_width
-          || FONT_TOO_HIGH (s->font)
-          || s->font_not_found_p || s->extends_to_end_of_line_p || force_p)
-        {
-          if (!face->stipple)
-            haiku_draw_plain_background (s, face, box_line_width,
-                                         box_vline_width);
-          else
-            haiku_draw_stipple_background (s, face, box_line_width,
-                                           box_vline_width);
-          s->background_filled_p = 1;
-        }
-    }
-}
-
-static void
-haiku_mouse_face_colors (struct glyph_string *s, uint32_t *fg,
-                         uint32_t *bg)
-{
-  int face_id;
-  struct face *face;
-
-  /* What face has to be used last for the mouse face?  */
-  face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id;
-  face = FACE_FROM_ID_OR_NULL (s->f, face_id);
-  if (face == NULL)
-    face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
-
-  if (s->first_glyph->type == CHAR_GLYPH)
-    face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
-  else
-    face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
-
-  face = FACE_FROM_ID (s->f, face_id);
-  prepare_face_for_display (s->f, s->face);
-
-  if (fg)
-    *fg = face->foreground;
-  if (bg)
-    *bg = face->background;
-}
-
-static void
 haiku_draw_underwave (struct glyph_string *s, int width, int x)
 {
   int wave_height = 3, wave_length = 2;
@@ -876,6 +720,164 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
 }
 
 static void
+haiku_draw_string_box (struct glyph_string *s, int clip_p)
+{
+  int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
+  bool raised_p, left_p, right_p;
+  struct glyph *last_glyph;
+  struct haiku_rect clip_rect;
+
+  struct face *face = s->face;
+
+  last_x = ((s->row->full_width_p && !s->w->pseudo_window_p)
+            ? WINDOW_RIGHT_EDGE_X (s->w)
+            : window_box_right (s->w, s->area));
+
+  /* The glyph that may have a right box line.  For static
+     compositions and images, the right-box flag is on the first glyph
+     of the glyph string; for other types it's on the last glyph.  */
+  if (s->cmp || s->img)
+    last_glyph = s->first_glyph;
+  else if (s->first_glyph->type == COMPOSITE_GLYPH
+           && s->first_glyph->u.cmp.automatic)
+    {
+      /* For automatic compositions, we need to look up the last glyph
+         in the composition.  */
+        struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area];
+        struct glyph *g = s->first_glyph;
+        for (last_glyph = g++;
+             g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id
+               && g->slice.cmp.to < s->cmp_to;
+             last_glyph = g++)
+          ;
+    }
+  else
+    last_glyph = s->first_glyph + s->nchars - 1;
+
+  vwidth = eabs (face->box_vertical_line_width);
+  hwidth = eabs (face->box_horizontal_line_width);
+  raised_p = face->box == FACE_RAISED_BOX;
+  left_x = s->x;
+  right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
+             ? last_x - 1
+             : min (last_x, s->x + s->background_width) - 1);
+
+  top_y = s->y;
+  bottom_y = top_y + s->height - 1;
+
+  left_p = (s->first_glyph->left_box_line_p
+            || (s->hl == DRAW_MOUSE_FACE
+                && (s->prev == NULL
+                    || s->prev->hl != s->hl)));
+  right_p = (last_glyph->right_box_line_p
+             || (s->hl == DRAW_MOUSE_FACE
+                 && (s->next == NULL
+                     || s->next->hl != s->hl)));
+
+  get_glyph_string_clip_rect (s, &clip_rect);
+
+  if (face->box == FACE_SIMPLE_BOX)
+    haiku_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+                         vwidth, left_p, right_p, &clip_rect);
+  else
+    haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+                            vwidth, raised_p, true, true, left_p, right_p,
+                            &clip_rect, 1);
+
+  if (clip_p)
+    {
+      void *view = FRAME_HAIKU_VIEW (s->f);
+
+      haiku_draw_text_decoration (s, face, face->foreground, s->width, s->x);
+      BView_ClipToInverseRect (view, left_x, top_y, right_x - left_x + 1, hwidth);
+      if (left_p)
+        BView_ClipToInverseRect (view, left_x, top_y, vwidth, bottom_y - top_y + 1);
+      BView_ClipToInverseRect (view, left_x, bottom_y - hwidth + 1,
+                               right_x - left_x + 1, hwidth);
+      if (right_p)
+        BView_ClipToInverseRect (view, right_x - vwidth + 1,
+                                 top_y, vwidth, bottom_y - top_y + 1);
+    }
+}
+
+static void
+haiku_draw_plain_background (struct glyph_string *s, struct face *face,
+                             int box_line_hwidth, int box_line_vwidth)
+{
+  void *view = FRAME_HAIKU_VIEW (s->f);
+  BView_StartClip (view);
+  if (s->hl == DRAW_CURSOR)
+    BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel);
+  else
+    BView_SetHighColor (view, face->background_defaulted_p ?
+                        FRAME_BACKGROUND_PIXEL (s->f) :
+                      face->background);
+
+  BView_FillRectangle (view, s->x,
+                       s->y + box_line_hwidth,
+                       s->background_width,
+                       s->height - 2 * box_line_hwidth);
+  BView_EndClip (view);
+}
+
+static void
+haiku_draw_stipple_background (struct glyph_string *s, struct face *face,
+                               int box_line_hwidth, int box_line_vwidth)
+{
+}
+
+static void
+haiku_maybe_draw_background (struct glyph_string *s, int force_p)
+{
+  if ((s->first_glyph->type != IMAGE_GLYPH) && !s->background_filled_p)
+    {
+      struct face *face = s->face;
+      int box_line_width = max (face->box_horizontal_line_width, 0);
+      int box_vline_width = max (face->box_vertical_line_width, 0);
+
+      if (FONT_HEIGHT (s->font) < s->height - 2 * box_vline_width
+          || FONT_TOO_HIGH (s->font)
+          || s->font_not_found_p || s->extends_to_end_of_line_p || force_p)
+        {
+          if (!face->stipple)
+            haiku_draw_plain_background (s, face, box_line_width,
+                                         box_vline_width);
+          else
+            haiku_draw_stipple_background (s, face, box_line_width,
+                                           box_vline_width);
+          s->background_filled_p = 1;
+        }
+    }
+}
+
+static void
+haiku_mouse_face_colors (struct glyph_string *s, uint32_t *fg,
+                         uint32_t *bg)
+{
+  int face_id;
+  struct face *face;
+
+  /* What face has to be used last for the mouse face?  */
+  face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id;
+  face = FACE_FROM_ID_OR_NULL (s->f, face_id);
+  if (face == NULL)
+    face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
+
+  if (s->first_glyph->type == CHAR_GLYPH)
+    face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
+  else
+    face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
+
+  face = FACE_FROM_ID (s->f, face_id);
+  prepare_face_for_display (s->f, s->face);
+
+  if (fg)
+    *fg = face->foreground;
+  if (bg)
+    *bg = face->background;
+}
+
+static void
 haiku_draw_glyph_string_foreground (struct glyph_string *s)
 {
   struct face *face = s->face;
@@ -1557,14 +1559,11 @@ haiku_draw_glyph_string (struct glyph_string *s)
 
   if (!box_filled_p && face->box != FACE_NO_BOX)
     haiku_draw_string_box (s, 1);
+  else
+    haiku_draw_text_decoration (s, face, face->foreground, s->width, s->x);
 
   if (!s->for_overlaps)
     {
-      uint32_t dcol;
-      dcol = face->foreground;
-
-      haiku_draw_text_decoration (s, face, dcol, s->width, s->x);
-
       if (s->prev)
         {
           struct glyph_string *prev;
diff --git a/src/w32.c b/src/w32.c
index 2b2f8aadf6b..1de148f0343 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -8548,7 +8548,7 @@ fcntl (int s, int cmd, int options)
 int
 sys_close (int fd)
 {
-  int rc;
+  int rc = -1;
 
   if (fd < 0)
     {
@@ -8603,14 +8603,31 @@ sys_close (int fd)
         }
     }
 
-  if (fd >= 0 && fd < MAXDESC)
-    fd_info[fd].flags = 0;
-
   /* Note that sockets do not need special treatment here (at least on
      NT and Windows 95 using the standard tcp/ip stacks) - it appears that
      closesocket is equivalent to CloseHandle, which is to be expected
      because socket handles are fully fledged kernel handles. */
-  rc = _close (fd);
+  if (fd < MAXDESC)
+    {
+      if ((fd_info[fd].flags & FILE_DONT_CLOSE) == 0)
+        {
+          fd_info[fd].flags = 0;
+          rc = _close (fd);
+        }
+      else
+        {
+          /* We don't close here descriptors open by pipe processes
+             for reading from the pipe, because the reader thread
+             might be stuck in _sys_read_ahead, and then we will hang
+             here.  If the reader thread exits normally, it will close
+             the descriptor; otherwise we will leave a zombie thread
+             hanging around.  */
+          rc = 0;
+          /* Leave the flag set for the reader thread to close the
+             descriptor.  */
+          fd_info[fd].flags = FILE_DONT_CLOSE;
+        }
+    }
 
   return rc;
 }
@@ -10898,6 +10915,7 @@ register_aux_fd (int infd)
     }
   fd_info[ infd ].cp = cp;
   fd_info[ infd ].hnd = (HANDLE) _get_osfhandle (infd);
+  fd_info[ infd ].flags |= FILE_DONT_CLOSE;
 }
 
 #ifdef HAVE_GNUTLS
diff --git a/src/w32.h b/src/w32.h
index b31d66646c9..bb3ec40324a 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -135,6 +135,7 @@ extern filedesc fd_info [ MAXDESC ];
 #define FILE_SOCKET             0x0200
 #define FILE_NDELAY             0x0400
 #define FILE_SERIAL             0x0800
+#define FILE_DONT_CLOSE         0x1000
 
 extern child_process * new_child (void);
 extern void delete_child (child_process *cp);
diff --git a/src/w32proc.c b/src/w32proc.c
index 360f45e9e11..bfe720eb623 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1206,6 +1206,7 @@ static DWORD WINAPI
 reader_thread (void *arg)
 {
   child_process *cp;
+  int fd;
 
   /* Our identity */
   cp = (child_process *)arg;
@@ -1220,12 +1221,13 @@ reader_thread (void *arg)
     {
       int rc;
 
-      if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_CONNECT) != 0)
-        rc = _sys_wait_connect (cp->fd);
-      else if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_LISTEN) != 0)
-        rc = _sys_wait_accept (cp->fd);
+      fd = cp->fd;
+      if (fd >= 0 && (fd_info[fd].flags & FILE_CONNECT) != 0)
+        rc = _sys_wait_connect (fd);
+      else if (fd >= 0 && (fd_info[fd].flags & FILE_LISTEN) != 0)
+        rc = _sys_wait_accept (fd);
       else
-        rc = _sys_read_ahead (cp->fd);
+        rc = _sys_read_ahead (fd);
 
       /* Don't bother waiting for the event if we already have been
          told to exit by delete_child.  */
@@ -1238,7 +1240,7 @@ reader_thread (void *arg)
         {
           DebPrint (("reader_thread.SetEvent(0x%x) failed with %lu for fd %ld (PID %d)\n",
                      (DWORD_PTR)cp->char_avail, GetLastError (),
-                     cp->fd, cp->pid));
+                     fd, cp->pid));
           return 1;
         }
 
@@ -1266,6 +1268,13 @@ reader_thread (void *arg)
       if (cp->status == STATUS_READ_ERROR)
         break;
     }
+  /* If this thread was reading from a pipe process, close the
+     descriptor used for reading, as sys_close doesn't in that case.  */
+  if (fd_info[fd].flags == FILE_DONT_CLOSE)
+    {
+      fd_info[fd].flags = 0;
+      _close (fd);
+    }
   return 0;
 }
 
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 7e51f820b70..a442eb473be 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -686,6 +686,12 @@ inner loops respectively."
                  (let* ((x 'a))
                    (list x (funcall g) (funcall h)))))))
       (funcall (funcall f 'b)))
+
+    ;; Test constant-propagation of access to captured variables.
+    (let* ((x 2)
+           (f (lambda ()
+                (let ((y x)) (list y 3 y)))))
+      (funcall f))
     )
   "List of expressions for cross-testing interpreted and compiled code.")