mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity

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

Browse Source
This commit is contained in:
Po Lu 2021-12-12 11:15:00 +08:00
commit 0e69753ac1
13 changed files with 313 additions and 265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
configure.ac
View File

@ -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

83
doc/lispref/text.texi
View File

@ -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

14
etc/NEWS
View File

@ -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.

8
lisp/emacs-lisp/byte-opt.el
View File

@ -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)

24
lisp/gnus/gnus-sum.el
View File

@ -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."

66
lisp/pixel-scroll.el
View File

@ -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."

2
lisp/sqlite-mode.el
View File

@ -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))))

2
lisp/subr.el
View File

@ -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.

321
src/haikuterm.c
View File

@ -535,162 +535,6 @@ haiku_draw_relief_rect (struct glyph_string *s,
BView_EndClip (view);
}
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)
{
@ -875,6 +719,164 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face,
BView_draw_unlock (view);
}
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)
{
@ -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;

28
src/w32.c
View File

@ -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

1
src/w32.h
View File

@ -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);

21
src/w32proc.c
View File

@ -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;
}

6
test/lisp/emacs-lisp/bytecomp-tests.el
View File

@ -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.")