[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk 0e69753: Merge remote-tracking branch 'origin/master' into
|
From: |
Po Lu |
|
Subject: |
feature/pgtk 0e69753: Merge remote-tracking branch 'origin/master' into feature/pgtk |
|
Date: |
Sat, 11 Dec 2021 22:15:19 -0500 (EST) |
branch: feature/pgtk
commit 0e69753ac142ef0f45ec14c8281ec4f76aea723b
Merge: b9c1e1d ff9360f
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/pgtk
---
configure.ac | 2 +-
doc/lispref/text.texi | 83 +++++----
etc/NEWS | 14 +-
lisp/emacs-lisp/byte-opt.el | 8 +-
lisp/gnus/gnus-sum.el | 24 +--
lisp/pixel-scroll.el | 66 ++++---
lisp/sqlite-mode.el | 2 +-
lisp/subr.el | 2 +-
src/haikuterm.c | 321 ++++++++++++++++-----------------
src/w32.c | 28 ++-
src/w32.h | 1 +
src/w32proc.c | 21 ++-
test/lisp/emacs-lisp/bytecomp-tests.el | 6 +
13 files changed, 313 insertions(+), 265 deletions(-)
diff --git a/configure.ac b/configure.ac
index 892c3e0..9a74c52 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 e964d7b..b8d92f7 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 b0dfa30..807751a 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 f6db803..2bdf1f5 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 ba61658..1bd0e88 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 336b555..0e22ef2 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 61398c1..9306bd8 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 d224f76..9c07606 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 f3c37b0..f95a013 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 2b2f8aa..1de148f 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 b31d666..bb3ec40 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 360f45e..bfe720e 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 7e51f82..a442eb4 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.")