From daf78963ee96484df1ecb0c10e7c0040d7b544a5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 16 Jun 2017 22:44:48 +0300 Subject: Initial version of native display of line numbers * src/xdisp.c (syms_of_xdisp) : New buffer-local variable. Include . (maybe_produce_line_number): New function. (DISP_INFINITY): Rename from INFINITY, since math.h defines INFINITY. (try_window_reusing_current_matrix): Don't use this method when display-line-numbers is in effect. * src/dispextern.h (struct it): New members 'lnum'. --- src/dispextern.h | 18 +++++- src/xdisp.c | 176 +++++++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 187 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/dispextern.h b/src/dispextern.h index d1e4715c329..050c68b8e08 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -384,6 +384,7 @@ struct glyph glyph standing for newline at end of line 0 empty space after the end of the line -1 overlay arrow on a TTY -1 + glyph displaying line number -1 glyph at EOB that ends in a newline -1 left truncation glyphs: -1 right truncation/continuation glyphs next buffer position @@ -2571,7 +2572,12 @@ struct it Do NOT use !BUFFERP (it.object) as a test whether we are iterating over a string; use STRINGP (it.string) instead. - Position is the current iterator position in object. */ + Position is the current iterator position in object. + + The 'position's CHARPOS is copied to glyph->charpos of the glyph + produced by PRODUCE_GLYPHS, so any artificial value documented + under 'struct glyph's 'charpos' member can also be found in the + 'position' member here. */ Lisp_Object object; struct text_pos position; @@ -2655,6 +2661,16 @@ struct it coordinate is past first_visible_x. */ int hpos; + /* Current line number, zero-based. */ + ptrdiff_t lnum; + + /* The byte position corresponding to lnum. */ + ptrdiff_t lnum_bytepos; + + /* The width in columns needed for display of the line numbers, or + zero if not computed. */ + int lnum_width; + /* Left fringe bitmap number (enum fringe_bitmap_type). */ unsigned left_user_fringe_bitmap : FRINGE_ID_BITS; diff --git a/src/xdisp.c b/src/xdisp.c index 34ee877e6be..dcef242966e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -290,6 +290,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "atimer.h" @@ -324,7 +325,7 @@ along with GNU Emacs. If not, see . */ #define FRAME_X_OUTPUT(f) ((f)->output_data.x) #endif -#define INFINITY 10000000 +#define DISP_INFINITY 10000000 /* Holds the list (error). */ static Lisp_Object list_of_error; @@ -843,6 +844,8 @@ static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *); static void display_menu_bar (struct window *); static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *); +static void pint2str (register char *, register int, register ptrdiff_t); + static int display_string (const char *, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int); static void compute_line_metrics (struct it *); @@ -6751,7 +6754,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string, FIELD_WIDTH < 0 means infinite field width. This is useful for padding with `-' at the end of a mode line. */ if (field_width < 0) - field_width = INFINITY; + field_width = DISP_INFINITY; /* Implementation note: We deliberately don't enlarge it->bidi_it.string.schars here to fit it->end_charpos, because the bidi iterator cannot produce characters out of thin air. */ @@ -13138,7 +13141,7 @@ hscroll_window_tree (Lisp_Object window) if (hscl) it.first_visible_x = window_hscroll_limited (w, it.f) * FRAME_COLUMN_WIDTH (it.f); - it.last_visible_x = INFINITY; + it.last_visible_x = DISP_INFINITY; move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS); /* If the line ends in an overlay string with a newline, we might infloop, because displaying the window will @@ -15823,7 +15826,7 @@ compute_window_start_on_continuation_line (struct window *w) So, we're looking for the display line start with the minimum distance from the old window start. */ pos_before_pt = pos = it.current.pos; - min_distance = INFINITY; + min_distance = DISP_INFINITY; while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))), distance < min_distance) { @@ -17593,6 +17596,12 @@ try_window_reusing_current_matrix (struct window *w) if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row)) return false; + /* Give up if line numbers are being displayed, because reusing the + current matrix might use the wrong width for line-number + display. */ + if (!NILP (Vdisplay_line_numbers)) + return false; + /* The variable new_start now holds the new window start. The old start `start' can be determined from the current matrix. */ SET_TEXT_POS_FROM_MARKER (new_start, w->start); @@ -20670,6 +20679,141 @@ find_row_edges (struct it *it, struct glyph_row *row, row->maxpos = it->current.pos; } +static void +maybe_produce_line_number (struct it *it) +{ + ptrdiff_t last_line = it->lnum; + ptrdiff_t start_from, bytepos; + + /* FIXME: Maybe reuse the data in it->w->base_line_number. */ + if (!last_line) + start_from = BEGV; + else + start_from = it->lnum_bytepos; + + /* Paranoia: what if someone changes the narrowing since the last + time display_line was called? Shouldn't really happen, but who + knows what some crazy Lisp invoked by :eval could do? */ + if (!(BEGV_BYTE <= start_from && start_from < ZV_BYTE)) + { + last_line = 0; + start_from = BEGV_BYTE; + } + + ptrdiff_t this_line; + + this_line = + last_line + display_count_lines (start_from, + IT_BYTEPOS (*it), IT_CHARPOS (*it), + &bytepos); + eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); + eassert (bytepos == IT_BYTEPOS (*it)); + + /* If this is a new logical line, produce the glyphs for the line + number. */ + if (this_line != last_line || !last_line || it->continuation_lines_width > 0) + { + if (this_line != last_line || !last_line) + { + it->lnum = this_line; + it->lnum_bytepos = IT_BYTEPOS (*it); + } + + void *itdata = bidi_shelve_cache (); + struct it tem_it; + char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; + bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; + /* Compute the required width if needed. */ + if (!it->lnum_width) + { + /* Max line number to be displayed cannot be more than the + one corresponding to the last row of the desired + matrix. */ + ptrdiff_t max_lnum = + this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + it->lnum_width = log10 (max_lnum) + 1; + eassert (it->lnum_width > 0); + } + pint2str (lnum_buf, it->lnum_width, this_line + 1); + /* Append a blank. */ + strcat (lnum_buf, " "); + + /* Setup for producing the glyphs. */ + init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row, + /* FIXME: Use specialized face. */ + DEFAULT_FACE_ID); + scratch_glyph_row.reversed_p = false; + scratch_glyph_row.used[TEXT_AREA] = 0; + SET_TEXT_POS (tem_it.position, 0, 0); + tem_it.bidi_it.type = WEAK_EN; + /* According to UAX#9, EN goes up 2 levels in L2R paragraph and + 1 level in R2L paragraphs. Emulate that. */ + tem_it.bidi_it.resolved_level = 2; + if (it->glyph_row && it->glyph_row->reversed_p) + tem_it.bidi_it.resolved_level = 1; + + /* Produce glyphs for the line number in a scratch glyph_row. */ + int n_glyphs_before; + for (const char *p = lnum_buf; *p; p++) + { + /* For continuation lines and lines after ZV, instead of a + line number, produce a blank prefix of the same width. */ + if (beyond_zv || it->continuation_lines_width > 0) + tem_it.c = tem_it.char_to_display = ' '; + else + tem_it.c = tem_it.char_to_display = *p; + tem_it.len = 1; + n_glyphs_before = scratch_glyph_row.used[TEXT_AREA]; + /* Make sure these glyphs will have a "position" of -1. */ + SET_TEXT_POS (tem_it.position, -1, -1); + PRODUCE_GLYPHS (&tem_it); + + /* Stop producing glyphs if we don't have enough space on + this line. FIXME: should we refrain from producing the + line number at all in that case? */ + if (tem_it.current_x > tem_it.last_visible_x) + { + scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before; + break; + } + } + + /* Copy the produced glyphs into IT's glyph_row. */ + struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA]; + struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA]; + struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; + short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; + + while (g < e) + { + it->current_x += g->pixel_width; + it->hpos++; + if (p) + { + *p++ = *g++; + (*u)++; + } + } + + /* Update IT->glyph_row's metrics. */ + if (it->glyph_row) + { + struct glyph_row *row = it->glyph_row; + + row->ascent = max (row->ascent, tem_it.max_ascent); + row->height = max (row->height, + tem_it.max_ascent + tem_it.max_descent); + row->phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); + row->phys_height = max (row->phys_height, + tem_it.max_phys_ascent + tem_it.max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + tem_it.max_extra_line_spacing); + } + + bidi_unshelve_cache (itdata, false); + } +} + /* Construct the glyph row IT->glyph_row in the desired matrix of IT->w from text at the current position of IT. See dispextern.h for an overview of struct it. Value is true if @@ -20775,9 +20919,17 @@ display_line (struct it *it, int cursor_vpos) are hscrolled to the left of the left edge of the window. */ min_pos = CHARPOS (this_line_min_pos); min_bpos = BYTEPOS (this_line_min_pos); + + /* Produce line number, if needed. */ + if (!NILP (Vdisplay_line_numbers)) + maybe_produce_line_number (it); } else if (it->area == TEXT_AREA) { + /* Line numbers should precede the line-prefix or wrap-prefix. */ + if (!NILP (Vdisplay_line_numbers)) + maybe_produce_line_number (it); + /* We only do this when not calling move_it_in_display_line_to above, because that function calls itself handle_line_prefix. */ handle_line_prefix (it); @@ -20936,6 +21088,10 @@ display_line (struct it *it, int cursor_vpos) process the prefix now. */ if (it->area == TEXT_AREA && pending_handle_line_prefix) { + /* Line numbers should precede the line-prefix or wrap-prefix. */ + if (!NILP (Vdisplay_line_numbers)) + maybe_produce_line_number (it); + pending_handle_line_prefix = false; handle_line_prefix (it); } @@ -22007,7 +22163,7 @@ Value is the new character position of point. */) reach point, in order to start from its X coordinate. So we need to disregard the window's horizontal extent in that case. */ if (it.line_wrap == TRUNCATE) - it.last_visible_x = INFINITY; + it.last_visible_x = DISP_INFINITY; if (it.cmp_it.id < 0 && it.method == GET_FROM_STRING @@ -22100,7 +22256,7 @@ Value is the new character position of point. */) { start_display (&it, w, pt); if (it.line_wrap == TRUNCATE) - it.last_visible_x = INFINITY; + it.last_visible_x = DISP_INFINITY; reseat_at_previous_visible_line_start (&it); it.current_x = it.current_y = it.hpos = 0; if (pt_vpos != 0) @@ -32134,6 +32290,14 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFSYM (Qline_prefix, "line-prefix"); Fmake_variable_buffer_local (Qline_prefix); + DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, + doc: /* Non-nil means display line numbers. +Line numbers are displayed before each non-continuation line, i.e. +after each newline that comes from buffer text. */); + Vdisplay_line_numbers = Qnil; + DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); + Fmake_variable_buffer_local (Qdisplay_line_numbers); + DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); inhibit_eval_during_redisplay = false; -- cgit v1.2.1 From 7277c0fca7dab9f1b311c3eba5c42fd17acc3593 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Jun 2017 17:42:44 +0300 Subject: Finish up native display of line numbers * src/xdisp.c (maybe_produce_line_number): Produce a blank before the number, for R2L rows. Increment 'g' in the loop even if glyph_row is NULL. Accept 2nd argument FORCE and produce the line-number glyphs if it is non-zero. (move_it_in_display_line_to): Account for the space taken by the line-number glyphs. Call maybe_produce_line_number with 2nd argument non-zero. (set_cursor_from_row): Fix calculation of cursor X coordinate in R2L rows with display-produced glyphs at the beginning. (syms_of_xdisp) : New face symbol. : New symbols. (maybe_produce_line_number): Use the line-number face for displaying line numbers. Support relative line-number display. Support user-defined width for displaying line numbers. (try_cursor_movement, try_window_id): Disable these optimizations when displaying relative line numbers. * src/dispextern.h (struct it): New member 'pt_lnum'. * lisp/faces.el (line-number): New face. * lisp/cus-start.el (standard): Provide customization forms for display-line-numbers and display-line-width. * lisp/menu-bar.el (menu-bar-showhide-menu): Add menu-bar item to turn display-line-numbers on and off. * etc/NEWS: Document the new feature. --- src/dispextern.h | 3 ++ src/xdisp.c | 126 ++++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 100 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/dispextern.h b/src/dispextern.h index 050c68b8e08..08e5caa893b 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2671,6 +2671,9 @@ struct it zero if not computed. */ int lnum_width; + /* The line number of point's line, or zero if not computed yet. */ + ptrdiff_t pt_lnum; + /* Left fringe bitmap number (enum fringe_bitmap_type). */ unsigned left_user_fringe_bitmap : FRINGE_ID_BITS; diff --git a/src/xdisp.c b/src/xdisp.c index dcef242966e..ebf5edc4d05 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -833,6 +833,7 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool); static bool update_menu_bar (struct frame *, bool, bool); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); +static void maybe_produce_line_number (struct it *, bool); static bool display_line (struct it *, int); static int display_mode_lines (struct window *); static int display_mode_line (struct window *, enum face_id, Lisp_Object); @@ -8652,9 +8653,16 @@ move_it_in_display_line_to (struct it *it, || (it->method == GET_FROM_DISPLAY_VECTOR \ && it->dpvec + it->current.dpvec_index + 1 >= it->dpend))) - /* If there's a line-/wrap-prefix, handle it. */ - if (it->hpos == 0 && it->method == GET_FROM_BUFFER) - handle_line_prefix (it); + if (it->hpos == 0) + { + /* If line numbers are being displayed, produce a line number. */ + if (!NILP (Vdisplay_line_numbers) + && it->current_x == it->first_visible_x) + maybe_produce_line_number (it, true); + /* If there's a line-/wrap-prefix, handle it. */ + if (it->method == GET_FROM_BUFFER) + handle_line_prefix (it); + } if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); @@ -14787,15 +14795,12 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, while (glyph > end + 1 && NILP (glyph->object) && glyph->charpos < 0) - { - --glyph; - x -= glyph->pixel_width; - } + --glyph; if (NILP (glyph->object) && glyph->charpos < 0) --glyph; /* By default, in reversed rows we put the cursor on the rightmost (first in the reading order) glyph. */ - for (g = end + 1; g < glyph; g++) + for (x = 0, g = end + 1; g < glyph; g++) x += g->pixel_width; while (end < glyph && NILP ((end + 1)->object) @@ -15932,6 +15937,9 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, && !windows_or_buffers_changed && !f->cursor_type_changed && NILP (Vshow_trailing_whitespace) + /* When display-line-numbers is in relative mode, moving point + requires to redraw the entire window. */ + && !EQ (Vdisplay_line_numbers, Qrelative) /* This code is not used for mini-buffer for the sake of the case of redisplaying to replace an echo area message; since in that case the mini-buffer contents per se are usually @@ -18433,6 +18441,10 @@ try_window_id (struct window *w) if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing))) GIVE_UP (23); + /* Give up if display-line-numbers is in relative mode. */ + if (EQ (Vdisplay_line_numbers, Qrelative)) + GIVE_UP (24); + /* Make sure beg_unchanged and end_unchanged are up to date. Do it only if buffer has really changed. The reason is that the gap is initially at Z for freshly visited files. The code below would @@ -20679,8 +20691,13 @@ find_row_edges (struct it *it, struct glyph_row *row, row->maxpos = it->current.pos; } +/* Produce the line-number glyphs for the current glyph_row. If + IT->glyph_row is non-NULL, populate the row with the produced + glyphs. FORCE non-zero means produce the glyphs even if the line + number didn't change since the last time this function was called; + this is used by move_it_in_display_line_to. */ static void -maybe_produce_line_number (struct it *it) +maybe_produce_line_number (struct it *it, bool force) { ptrdiff_t last_line = it->lnum; ptrdiff_t start_from, bytepos; @@ -20709,9 +20726,12 @@ maybe_produce_line_number (struct it *it) eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); eassert (bytepos == IT_BYTEPOS (*it)); - /* If this is a new logical line, produce the glyphs for the line - number. */ - if (this_line != last_line || !last_line || it->continuation_lines_width > 0) + /* Produce the glyphs for the line number if needed. */ + if (force + || !last_line + || this_line != last_line + || it->continuation_lines_width > 0 + || (EQ (Vdisplay_line_numbers, Qrelative) && PT != it->w->last_point)) { if (this_line != last_line || !last_line) { @@ -20723,19 +20743,51 @@ maybe_produce_line_number (struct it *it) struct it tem_it; char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; + ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ + /* Compute point's line number if needed. */ + if (EQ (Vdisplay_line_numbers, Qrelative) && !it->pt_lnum) + { + ptrdiff_t ignored; + if (PT_BYTE > it->lnum_bytepos) + it->pt_lnum = + this_line + display_count_lines (it->lnum_bytepos, PT_BYTE, PT, + &ignored); + else + it->pt_lnum = display_count_lines (BEGV_BYTE, PT_BYTE, PT, + &ignored); + } /* Compute the required width if needed. */ if (!it->lnum_width) { - /* Max line number to be displayed cannot be more than the - one corresponding to the last row of the desired - matrix. */ - ptrdiff_t max_lnum = - this_line + it->w->desired_matrix->nrows - 1 - it->vpos; - it->lnum_width = log10 (max_lnum) + 1; + if (NATNUMP (Vdisplay_line_width)) + it->lnum_width = XFASTINT (Vdisplay_line_width); + else + { + /* Max line number to be displayed cannot be more than + the one corresponding to the last row of the desired + matrix. */ + ptrdiff_t max_lnum; + + if (EQ (Vdisplay_line_numbers, Qrelative)) + /* We subtract one more because the current line is + always zero under relative line-number display. */ + max_lnum = it->w->desired_matrix->nrows - 2; + else + max_lnum = + this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + it->lnum_width = log10 (max_lnum) + 1; + } eassert (it->lnum_width > 0); } - pint2str (lnum_buf, it->lnum_width, this_line + 1); - /* Append a blank. */ + if (EQ (Vdisplay_line_numbers, Qrelative)) + lnum_offset = it->pt_lnum; + + /* In L2R rows we need to append the blank separator, in R2L + rows we need to prepend it. But this function is usually + called when no display elements were produced from the + following line, so the paragraph direction might be unknown. + Therefore we cheat and add 2 blanks, one on either side. */ + pint2str (lnum_buf, it->lnum_width + 1, eabs (this_line - lnum_offset)); strcat (lnum_buf, " "); /* Setup for producing the glyphs. */ @@ -20745,12 +20797,12 @@ maybe_produce_line_number (struct it *it) scratch_glyph_row.reversed_p = false; scratch_glyph_row.used[TEXT_AREA] = 0; SET_TEXT_POS (tem_it.position, 0, 0); + tem_it.face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); tem_it.bidi_it.type = WEAK_EN; /* According to UAX#9, EN goes up 2 levels in L2R paragraph and - 1 level in R2L paragraphs. Emulate that. */ + 1 level in R2L paragraphs. Emulate that, assuming we are in + an L2R paragraph. */ tem_it.bidi_it.resolved_level = 2; - if (it->glyph_row && it->glyph_row->reversed_p) - tem_it.bidi_it.resolved_level = 1; /* Produce glyphs for the line number in a scratch glyph_row. */ int n_glyphs_before; @@ -20784,13 +20836,17 @@ maybe_produce_line_number (struct it *it) struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; - while (g < e) + for ( ; g < e; g++) { it->current_x += g->pixel_width; - it->hpos++; + /* The following is important when this function is called + from move_it_in_display_line_to: HPOS is incremented only + when we are in the visible portion of the glyph row. */ + if (it->current_x > it->first_visible_x) + it->hpos++; if (p) { - *p++ = *g++; + *p++ = *g; (*u)++; } } @@ -20922,13 +20978,13 @@ display_line (struct it *it, int cursor_vpos) /* Produce line number, if needed. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it); + maybe_produce_line_number (it, false); } else if (it->area == TEXT_AREA) { /* Line numbers should precede the line-prefix or wrap-prefix. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it); + maybe_produce_line_number (it, false); /* We only do this when not calling move_it_in_display_line_to above, because that function calls itself handle_line_prefix. */ @@ -21090,7 +21146,7 @@ display_line (struct it *it, int cursor_vpos) { /* Line numbers should precede the line-prefix or wrap-prefix. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it); + maybe_produce_line_number (it, false); pending_handle_line_prefix = false; handle_line_prefix (it); @@ -31778,6 +31834,9 @@ They are still logged to the *Messages* buffer. */); /* Name of the face used to highlight trailing whitespace. */ DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); + /* Name of the face used to display line numbers. */ + DEFSYM (Qline_number, "line-number"); + /* Name and number of the face used to highlight escape glyphs. */ DEFSYM (Qescape_glyph, "escape-glyph"); @@ -32297,6 +32356,15 @@ after each newline that comes from buffer text. */); Vdisplay_line_numbers = Qnil; DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); + DEFSYM (Qrelative, "relative"); + + DEFVAR_LISP ("display-line-width", Vdisplay_line_width, + doc: /* Minimum width of space reserved for line number display. +A positive number means reserve that many columns for line numbers, +even if the actual number needs less space. +The default value of nil means compute the space dynamically. +Any other value is treated as nil. */); + Vdisplay_line_width = Qnil; DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); -- cgit v1.2.1 From d4eddb08e505ff9b4d956f00f225e3baf0d15462 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 23 Jun 2017 17:13:01 +0300 Subject: Fix display of indicate-empty-lines when line numbers are displayed * src/xdisp.c (row_text_area_empty): New function. (display_line): Call row_text_area_empty to verify that a glyph row's text area is devoid of any glyphs that came from a buffer or a string. This fixes a bug with empty-lines indication disappearing when line numbers or line-prefix are displayed. (display_line): Delete the argument FORCE; all callers changed. Remove the condition for actually producing the glyphs for the line number, as even if the number didn't change we need to produce empty space. --- src/xdisp.c | 298 ++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 158 insertions(+), 140 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index ebf5edc4d05..136e8391d46 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -833,7 +833,7 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool); static bool update_menu_bar (struct frame *, bool, bool); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); -static void maybe_produce_line_number (struct it *, bool); +static void maybe_produce_line_number (struct it *); static bool display_line (struct it *, int); static int display_mode_lines (struct window *); static int display_mode_line (struct window *, enum face_id, Lisp_Object); @@ -8658,7 +8658,7 @@ move_it_in_display_line_to (struct it *it, /* If line numbers are being displayed, produce a line number. */ if (!NILP (Vdisplay_line_numbers) && it->current_x == it->first_visible_x) - maybe_produce_line_number (it, true); + maybe_produce_line_number (it); /* If there's a line-/wrap-prefix, handle it. */ if (it->method == GET_FROM_BUFFER) handle_line_prefix (it); @@ -20693,14 +20693,13 @@ find_row_edges (struct it *it, struct glyph_row *row, /* Produce the line-number glyphs for the current glyph_row. If IT->glyph_row is non-NULL, populate the row with the produced - glyphs. FORCE non-zero means produce the glyphs even if the line - number didn't change since the last time this function was called; - this is used by move_it_in_display_line_to. */ + glyphs. */ static void -maybe_produce_line_number (struct it *it, bool force) +maybe_produce_line_number (struct it *it) { ptrdiff_t last_line = it->lnum; ptrdiff_t start_from, bytepos; + ptrdiff_t this_line; /* FIXME: Maybe reuse the data in it->w->base_line_number. */ if (!last_line) @@ -20717,8 +20716,6 @@ maybe_produce_line_number (struct it *it, bool force) start_from = BEGV_BYTE; } - ptrdiff_t this_line; - this_line = last_line + display_count_lines (start_from, IT_BYTEPOS (*it), IT_CHARPOS (*it), @@ -20726,148 +20723,168 @@ maybe_produce_line_number (struct it *it, bool force) eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); eassert (bytepos == IT_BYTEPOS (*it)); - /* Produce the glyphs for the line number if needed. */ - if (force - || !last_line - || this_line != last_line - || it->continuation_lines_width > 0 - || (EQ (Vdisplay_line_numbers, Qrelative) && PT != it->w->last_point)) + /* Produce the glyphs for the line number. */ + if (this_line != last_line || !last_line) { - if (this_line != last_line || !last_line) - { - it->lnum = this_line; - it->lnum_bytepos = IT_BYTEPOS (*it); - } + it->lnum = this_line; + it->lnum_bytepos = IT_BYTEPOS (*it); + } - void *itdata = bidi_shelve_cache (); - struct it tem_it; - char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; - bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; - ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ - /* Compute point's line number if needed. */ - if (EQ (Vdisplay_line_numbers, Qrelative) && !it->pt_lnum) - { - ptrdiff_t ignored; - if (PT_BYTE > it->lnum_bytepos) - it->pt_lnum = - this_line + display_count_lines (it->lnum_bytepos, PT_BYTE, PT, - &ignored); - else - it->pt_lnum = display_count_lines (BEGV_BYTE, PT_BYTE, PT, - &ignored); - } - /* Compute the required width if needed. */ - if (!it->lnum_width) + void *itdata = bidi_shelve_cache (); + struct it tem_it; + char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; + bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; + ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ + /* Compute point's line number if needed. */ + if (EQ (Vdisplay_line_numbers, Qrelative) && !it->pt_lnum) + { + ptrdiff_t ignored; + if (PT_BYTE > it->lnum_bytepos) + it->pt_lnum = + this_line + display_count_lines (it->lnum_bytepos, PT_BYTE, PT, + &ignored); + else + it->pt_lnum = display_count_lines (BEGV_BYTE, PT_BYTE, PT, + &ignored); + } + /* Compute the required width if needed. */ + if (!it->lnum_width) + { + if (NATNUMP (Vdisplay_line_width)) + it->lnum_width = XFASTINT (Vdisplay_line_width); + else { - if (NATNUMP (Vdisplay_line_width)) - it->lnum_width = XFASTINT (Vdisplay_line_width); - else - { - /* Max line number to be displayed cannot be more than - the one corresponding to the last row of the desired - matrix. */ - ptrdiff_t max_lnum; + /* Max line number to be displayed cannot be more than + the one corresponding to the last row of the desired + matrix. */ + ptrdiff_t max_lnum; - if (EQ (Vdisplay_line_numbers, Qrelative)) - /* We subtract one more because the current line is - always zero under relative line-number display. */ - max_lnum = it->w->desired_matrix->nrows - 2; - else - max_lnum = - this_line + it->w->desired_matrix->nrows - 1 - it->vpos; - it->lnum_width = log10 (max_lnum) + 1; - } - eassert (it->lnum_width > 0); - } - if (EQ (Vdisplay_line_numbers, Qrelative)) - lnum_offset = it->pt_lnum; - - /* In L2R rows we need to append the blank separator, in R2L - rows we need to prepend it. But this function is usually - called when no display elements were produced from the - following line, so the paragraph direction might be unknown. - Therefore we cheat and add 2 blanks, one on either side. */ - pint2str (lnum_buf, it->lnum_width + 1, eabs (this_line - lnum_offset)); - strcat (lnum_buf, " "); - - /* Setup for producing the glyphs. */ - init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row, - /* FIXME: Use specialized face. */ - DEFAULT_FACE_ID); - scratch_glyph_row.reversed_p = false; - scratch_glyph_row.used[TEXT_AREA] = 0; - SET_TEXT_POS (tem_it.position, 0, 0); - tem_it.face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); - tem_it.bidi_it.type = WEAK_EN; - /* According to UAX#9, EN goes up 2 levels in L2R paragraph and - 1 level in R2L paragraphs. Emulate that, assuming we are in - an L2R paragraph. */ - tem_it.bidi_it.resolved_level = 2; - - /* Produce glyphs for the line number in a scratch glyph_row. */ - int n_glyphs_before; - for (const char *p = lnum_buf; *p; p++) - { - /* For continuation lines and lines after ZV, instead of a - line number, produce a blank prefix of the same width. */ - if (beyond_zv || it->continuation_lines_width > 0) - tem_it.c = tem_it.char_to_display = ' '; + if (EQ (Vdisplay_line_numbers, Qrelative)) + /* We subtract one more because the current line is + always zero under relative line-number display. */ + max_lnum = it->w->desired_matrix->nrows - 2; else - tem_it.c = tem_it.char_to_display = *p; - tem_it.len = 1; - n_glyphs_before = scratch_glyph_row.used[TEXT_AREA]; - /* Make sure these glyphs will have a "position" of -1. */ - SET_TEXT_POS (tem_it.position, -1, -1); - PRODUCE_GLYPHS (&tem_it); - - /* Stop producing glyphs if we don't have enough space on - this line. FIXME: should we refrain from producing the - line number at all in that case? */ - if (tem_it.current_x > tem_it.last_visible_x) - { - scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before; - break; - } + max_lnum = + this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + it->lnum_width = log10 (max_lnum) + 1; + } + eassert (it->lnum_width > 0); + } + if (EQ (Vdisplay_line_numbers, Qrelative)) + lnum_offset = it->pt_lnum; + + /* In L2R rows we need to append the blank separator, in R2L + rows we need to prepend it. But this function is usually + called when no display elements were produced from the + following line, so the paragraph direction might be unknown. + Therefore we cheat and add 2 blanks, one on either side. */ + pint2str (lnum_buf, it->lnum_width + 1, eabs (this_line - lnum_offset)); + strcat (lnum_buf, " "); + + /* Setup for producing the glyphs. */ + init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row, + /* FIXME: Use specialized face. */ + DEFAULT_FACE_ID); + scratch_glyph_row.reversed_p = false; + scratch_glyph_row.used[TEXT_AREA] = 0; + SET_TEXT_POS (tem_it.position, 0, 0); + tem_it.face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); + tem_it.bidi_it.type = WEAK_EN; + /* According to UAX#9, EN goes up 2 levels in L2R paragraph and + 1 level in R2L paragraphs. Emulate that, assuming we are in + an L2R paragraph. */ + tem_it.bidi_it.resolved_level = 2; + + /* Produce glyphs for the line number in a scratch glyph_row. */ + int n_glyphs_before; + for (const char *p = lnum_buf; *p; p++) + { + /* For continuation lines and lines after ZV, instead of a + line number, produce a blank prefix of the same width. */ + if (beyond_zv || it->continuation_lines_width > 0) + tem_it.c = tem_it.char_to_display = ' '; + else + tem_it.c = tem_it.char_to_display = *p; + tem_it.len = 1; + n_glyphs_before = scratch_glyph_row.used[TEXT_AREA]; + /* Make sure these glyphs will have a "position" of -1. */ + SET_TEXT_POS (tem_it.position, -1, -1); + PRODUCE_GLYPHS (&tem_it); + + /* Stop producing glyphs if we don't have enough space on + this line. FIXME: should we refrain from producing the + line number at all in that case? */ + if (tem_it.current_x > tem_it.last_visible_x) + { + scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before; + break; } + } - /* Copy the produced glyphs into IT's glyph_row. */ - struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA]; - struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA]; - struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; - short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; + /* Copy the produced glyphs into IT's glyph_row. */ + struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA]; + struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA]; + struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; + short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; - for ( ; g < e; g++) + for ( ; g < e; g++) + { + it->current_x += g->pixel_width; + /* The following is important when this function is called + from move_it_in_display_line_to: HPOS is incremented only + when we are in the visible portion of the glyph row. */ + if (it->current_x > it->first_visible_x) + it->hpos++; + if (p) { - it->current_x += g->pixel_width; - /* The following is important when this function is called - from move_it_in_display_line_to: HPOS is incremented only - when we are in the visible portion of the glyph row. */ - if (it->current_x > it->first_visible_x) - it->hpos++; - if (p) - { - *p++ = *g; - (*u)++; - } + *p++ = *g; + (*u)++; } + } - /* Update IT->glyph_row's metrics. */ - if (it->glyph_row) - { - struct glyph_row *row = it->glyph_row; + /* Update IT->glyph_row's metrics. */ + if (it->glyph_row) + { + struct glyph_row *row = it->glyph_row; - row->ascent = max (row->ascent, tem_it.max_ascent); - row->height = max (row->height, - tem_it.max_ascent + tem_it.max_descent); - row->phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); - row->phys_height = max (row->phys_height, - tem_it.max_phys_ascent + tem_it.max_phys_descent); - row->extra_line_spacing = max (row->extra_line_spacing, - tem_it.max_extra_line_spacing); - } + row->ascent = max (row->ascent, tem_it.max_ascent); + row->height = max (row->height, + tem_it.max_ascent + tem_it.max_descent); + row->phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); + row->phys_height = max (row->phys_height, + tem_it.max_phys_ascent + tem_it.max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + tem_it.max_extra_line_spacing); + } - bidi_unshelve_cache (itdata, false); + bidi_unshelve_cache (itdata, false); +} + +/* Return true if ROW has no glyphs except those inserted by the + display engine. This is needed for indicate-empty-lines and + similar features when the glyph row starts with glyphs which didn't + come from buffer or string. */ +static bool +row_text_area_empty (struct glyph_row *row) +{ + if (!row->reversed_p) + { + for (struct glyph *g = row->glyphs[TEXT_AREA]; + g < row->glyphs[TEXT_AREA] + row->used[TEXT_AREA]; + g++) + if (!NILP (g->object) || g->charpos > 0) + return false; } + else + { + for (struct glyph *g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1; + g > row->glyphs[TEXT_AREA]; + g--) + if (!NILP ((g - 1)->object) || (g - 1)->charpos > 0) + return false; + } + + return true; } /* Construct the glyph row IT->glyph_row in the desired matrix of @@ -20978,13 +20995,13 @@ display_line (struct it *it, int cursor_vpos) /* Produce line number, if needed. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it, false); + maybe_produce_line_number (it); } else if (it->area == TEXT_AREA) { /* Line numbers should precede the line-prefix or wrap-prefix. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it, false); + maybe_produce_line_number (it); /* We only do this when not calling move_it_in_display_line_to above, because that function calls itself handle_line_prefix. */ @@ -21055,7 +21072,8 @@ display_line (struct it *it, int cursor_vpos) row->exact_window_width_line_p = true; else if ((append_space_for_newline (it, true) && row->used[TEXT_AREA] == 1) - || row->used[TEXT_AREA] == 0) + || row->used[TEXT_AREA] == 0 + || row_text_area_empty (row)) { row->glyphs[TEXT_AREA]->charpos = -1; row->displays_text_p = false; @@ -21146,7 +21164,7 @@ display_line (struct it *it, int cursor_vpos) { /* Line numbers should precede the line-prefix or wrap-prefix. */ if (!NILP (Vdisplay_line_numbers)) - maybe_produce_line_number (it, false); + maybe_produce_line_number (it); pending_handle_line_prefix = false; handle_line_prefix (it); -- cgit v1.2.1 From bbaf2f3d529ac3f8d72b671ee3a8a0c3347c5510 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 23 Jun 2017 18:13:53 +0300 Subject: Fix background color beyond EOB and cursor display * src/xdisp.c: (maybe_produce_line_number): Use the default face for background of the blank glyphs in the line-number area which are drawn beyond EOB. (display_line): Reset the glyph row's displays_text_p flag only on empty lines that don't display line numbers. This fixes cursor display beyond EOB. Fix the bidi information in the glyphs produced for line numbers. Set the avoid_cursor_p flag of glyphs produced for line numbers. --- src/xdisp.c | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 136e8391d46..f4e8aeee390 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20788,7 +20788,8 @@ maybe_produce_line_number (struct it *it) scratch_glyph_row.reversed_p = false; scratch_glyph_row.used[TEXT_AREA] = 0; SET_TEXT_POS (tem_it.position, 0, 0); - tem_it.face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); + tem_it.avoid_cursor_p = true; + tem_it.bidi_p = true; tem_it.bidi_it.type = WEAK_EN; /* According to UAX#9, EN goes up 2 levels in L2R paragraph and 1 level in R2L paragraphs. Emulate that, assuming we are in @@ -20797,10 +20798,16 @@ maybe_produce_line_number (struct it *it) /* Produce glyphs for the line number in a scratch glyph_row. */ int n_glyphs_before; + int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); for (const char *p = lnum_buf; *p; p++) { - /* For continuation lines and lines after ZV, instead of a - line number, produce a blank prefix of the same width. */ + /* For continuation lines and lines after ZV, instead of a line + number, produce a blank prefix of the same width. Use the + default face for the blank field beyond ZV. */ + if (beyond_zv) + tem_it.face_id = it->base_face_id; + else + tem_it.face_id = lnum_face_id; if (beyond_zv || it->continuation_lines_width > 0) tem_it.c = tem_it.char_to_display = ' '; else @@ -21064,6 +21071,7 @@ display_line (struct it *it, int cursor_vpos) buffer reached. */ if (!get_next_display_element (it)) { + bool row_has_glyphs = false; /* Maybe add a space at the end of this line that is used to display the cursor there under X. Set the charpos of the first glyph of blank lines not corresponding to any text @@ -21073,10 +21081,13 @@ display_line (struct it *it, int cursor_vpos) else if ((append_space_for_newline (it, true) && row->used[TEXT_AREA] == 1) || row->used[TEXT_AREA] == 0 - || row_text_area_empty (row)) + || (row_has_glyphs = row_text_area_empty (row))) { row->glyphs[TEXT_AREA]->charpos = -1; - row->displays_text_p = false; + /* Don't reset the displays_text_p flag if we are + displaying line numbers or line-prefix. */ + if (!row_has_glyphs) + row->displays_text_p = false; if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines)) && (!MINI_WINDOW_P (it->w) -- cgit v1.2.1 From 77f8b86e405cc0ff9c49aea5d98097212755b832 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 11:34:52 +0300 Subject: Fix display of line numbers with fonts larger than the default * src/xdisp.c (maybe_produce_line_number): Update the metrics in IT, not in IT->glyph_row, since the latter gets overwritten in display_line. Fixes display of line numbers when the font used for them is larger than that of the default face. --- src/xdisp.c | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index f4e8aeee390..39176e0e675 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20849,19 +20849,16 @@ maybe_produce_line_number (struct it *it) } } - /* Update IT->glyph_row's metrics. */ + /* Update IT's metrics due to glyphs produced for line numbers. */ if (it->glyph_row) { struct glyph_row *row = it->glyph_row; - row->ascent = max (row->ascent, tem_it.max_ascent); - row->height = max (row->height, - tem_it.max_ascent + tem_it.max_descent); - row->phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); - row->phys_height = max (row->phys_height, - tem_it.max_phys_ascent + tem_it.max_phys_descent); - row->extra_line_spacing = max (row->extra_line_spacing, - tem_it.max_extra_line_spacing); + it->max_ascent = max (row->ascent, tem_it.max_ascent); + it->max_descent = max (row->height - row->ascent, tem_it.max_descent); + it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent); + it->max_phys_descent = max (row->phys_height - row->phys_ascent, + tem_it.max_phys_descent); } bidi_unshelve_cache (itdata, false); -- cgit v1.2.1 From 5b648ac7a2b2e1b77eb59573db59019d5068476c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 12:37:30 +0300 Subject: Fix problems with line-number updates in Follow mode * src/xdisp.c (redisplay_window): If forced window-start requires to move a window's point, and the window is under relative line-number display, force another round of redisplay to update the relative line numbers. This fixes follow-mode "redisplay" of its window group. * lisp/frame.el: Add display-line-numbers to the list of variables that should trigger redisplay of the current buffer. --- src/xdisp.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 39176e0e675..9b5762550d7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16800,10 +16800,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) XBUFFER (w->contents)->text->redisplay = false; safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil)); - if (w->redisplay || XBUFFER (w->contents)->text->redisplay) - { - /* pre-redisplay-function made changes (e.g. move the region) - that require another round of redisplay. */ + if (w->redisplay || XBUFFER (w->contents)->text->redisplay + || (EQ (Vdisplay_line_numbers, Qrelative) + && row != MATRIX_FIRST_TEXT_ROW (w->desired_matrix))) + { + /* Either pre-redisplay-function made changes (e.g. move + the region), or we moved point in a window that is + under display-line-numbers = relative mode. We need + another round of redisplay. */ clear_glyph_matrix (w->desired_matrix); if (!try_window (window, startp, 0)) goto need_larger_matrices; -- cgit v1.2.1 From 9776d7bcf044722909c10c9395d18c81641f27d0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 13:01:30 +0300 Subject: Don't display line numbers in the minibuffer and in tooltip frames. --- src/xdisp.c | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 9b5762550d7..19e3efb2f3d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21002,13 +21002,23 @@ display_line (struct it *it, int cursor_vpos) min_bpos = BYTEPOS (this_line_min_pos); /* Produce line number, if needed. */ - if (!NILP (Vdisplay_line_numbers)) + if (!NILP (Vdisplay_line_numbers) +#ifdef HAVE_WINDOW_SYSTEM + && !(FRAMEP (tip_frame) + && EQ (WINDOW_FRAME (it->w), tip_frame)) +#endif + && (!MINI_WINDOW_P (it->w))) maybe_produce_line_number (it); } else if (it->area == TEXT_AREA) { /* Line numbers should precede the line-prefix or wrap-prefix. */ - if (!NILP (Vdisplay_line_numbers)) + if (!NILP (Vdisplay_line_numbers) +#ifdef HAVE_WINDOW_SYSTEM + && !(FRAMEP (tip_frame) + && EQ (WINDOW_FRAME (it->w), tip_frame)) +#endif + && (!MINI_WINDOW_P (it->w))) maybe_produce_line_number (it); /* We only do this when not calling move_it_in_display_line_to @@ -21091,8 +21101,7 @@ display_line (struct it *it, int cursor_vpos) row->displays_text_p = false; if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines)) - && (!MINI_WINDOW_P (it->w) - || (minibuf_level && EQ (it->window, minibuf_window)))) + && (!MINI_WINDOW_P (it->w))) row->indicate_empty_line_p = true; } @@ -21175,7 +21184,13 @@ display_line (struct it *it, int cursor_vpos) if (it->area == TEXT_AREA && pending_handle_line_prefix) { /* Line numbers should precede the line-prefix or wrap-prefix. */ - if (!NILP (Vdisplay_line_numbers)) + if (!NILP (Vdisplay_line_numbers) +#ifdef HAVE_WINDOW_SYSTEM + && !(FRAMEP (tip_frame) + && EQ (WINDOW_FRAME (it->w), tip_frame)) +#endif + && (!MINI_WINDOW_P (it->w) + || (minibuf_level && EQ (it->window, minibuf_window)))) maybe_produce_line_number (it); pending_handle_line_prefix = false; -- cgit v1.2.1 From 7d7602cea09692eddb6a8d16f7786b5086a01091 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 13:26:01 +0300 Subject: Fix crashes on TTY frames due to negative lnum_width. --- src/xdisp.c | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 19e3efb2f3d..f98e7a9ac7e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20770,6 +20770,7 @@ maybe_produce_line_number (struct it *it) else max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + max_lnum = max (1, max_lnum); it->lnum_width = log10 (max_lnum) + 1; } eassert (it->lnum_width > 0); -- cgit v1.2.1 From 55a9298d63121578cd66ef7f14c14b2160aae77d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 14:29:32 +0300 Subject: Fix tab stops when line numbers are displayed * src/xdisp.c (x_produce_glyphs): * src/term.c (produce_glyphs): Adjust tab stops for the horizontal space taken by the line-number display. --- src/term.c | 4 ++++ src/xdisp.c | 4 ++++ 2 files changed, 8 insertions(+) (limited to 'src') diff --git a/src/term.c b/src/term.c index 8770aff8a92..b0e7e052e51 100644 --- a/src/term.c +++ b/src/term.c @@ -1584,6 +1584,10 @@ produce_glyphs (struct it *it) { int absolute_x = (it->current_x + it->continuation_lines_width); + /* Adjust for line numbers. Kludge alert: the "2" below is + because we add 2 blanks to the actual line number. */ + if (!NILP (Vdisplay_line_numbers)) + absolute_x -= it->lnum_width + 2; int next_tab_x = (((1 + absolute_x + it->tab_width - 1) / it->tab_width) diff --git a/src/xdisp.c b/src/xdisp.c index f98e7a9ac7e..5f86f0bfde6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -27865,6 +27865,10 @@ x_produce_glyphs (struct it *it) { int tab_width = it->tab_width * font->space_width; int x = it->current_x + it->continuation_lines_width; + /* Adjust for line numbers. Kludge alert: the "2" below + is because we add 2 blanks to the actual line number. */ + if (!NILP (Vdisplay_line_numbers)) + x -= (it->lnum_width + 2) * font->space_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; /* If the distance from the current position to the next tab -- cgit v1.2.1 From efedb664666563da6455500ade488fd9726be83a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 14:53:35 +0300 Subject: Rename display-line-width * etc/NEWS: * src/xdisp.c (syms_of_xdisp, maybe_produce_line_number): * lisp/cus-start.el: Rename display-line-width to display-line-number-width. --- src/xdisp.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 5f86f0bfde6..d23b1768d68 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20754,8 +20754,8 @@ maybe_produce_line_number (struct it *it) /* Compute the required width if needed. */ if (!it->lnum_width) { - if (NATNUMP (Vdisplay_line_width)) - it->lnum_width = XFASTINT (Vdisplay_line_width); + if (NATNUMP (Vdisplay_line_number_width)) + it->lnum_width = XFASTINT (Vdisplay_line_number_width); else { /* Max line number to be displayed cannot be more than @@ -32408,13 +32408,13 @@ after each newline that comes from buffer text. */); Fmake_variable_buffer_local (Qdisplay_line_numbers); DEFSYM (Qrelative, "relative"); - DEFVAR_LISP ("display-line-width", Vdisplay_line_width, + DEFVAR_LISP ("display-line-number-width", Vdisplay_line_number_width, doc: /* Minimum width of space reserved for line number display. A positive number means reserve that many columns for line numbers, even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); - Vdisplay_line_width = Qnil; + Vdisplay_line_number_width = Qnil; DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); -- cgit v1.2.1 From fa5e84cccd31cf94074255180d6ff3a44d4f8f89 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 15:15:02 +0300 Subject: Change display of current line in relative mode * src/xdisp.c (maybe_produce_line_number): In relative mode display the current line number as its absolute value, not as zero. --- src/xdisp.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index d23b1768d68..8acba259d2f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20763,13 +20763,7 @@ maybe_produce_line_number (struct it *it) matrix. */ ptrdiff_t max_lnum; - if (EQ (Vdisplay_line_numbers, Qrelative)) - /* We subtract one more because the current line is - always zero under relative line-number display. */ - max_lnum = it->w->desired_matrix->nrows - 2; - else - max_lnum = - this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; max_lnum = max (1, max_lnum); it->lnum_width = log10 (max_lnum) + 1; } @@ -20778,12 +20772,18 @@ maybe_produce_line_number (struct it *it) if (EQ (Vdisplay_line_numbers, Qrelative)) lnum_offset = it->pt_lnum; + /* Under 'relative', display the absolute line number for the + current line, as displaying zero gives zero useful information. */ + ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset); + if (EQ (Vdisplay_line_numbers, Qrelative) + && lnum_to_display == 0) + lnum_to_display = it->pt_lnum + 1; /* In L2R rows we need to append the blank separator, in R2L rows we need to prepend it. But this function is usually called when no display elements were produced from the following line, so the paragraph direction might be unknown. Therefore we cheat and add 2 blanks, one on either side. */ - pint2str (lnum_buf, it->lnum_width + 1, eabs (this_line - lnum_offset)); + pint2str (lnum_buf, it->lnum_width + 1, lnum_to_display); strcat (lnum_buf, " "); /* Setup for producing the glyphs. */ -- cgit v1.2.1 From 71a7294d0a775a8969ec077eb3633da6bdad7c62 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 15:45:23 +0300 Subject: Support a separate face for displaying the current line's number * lisp/faces.el (line-number-current-line): New face. * src/xdisp.c (syms_of_xdisp) : New symbol. (try_window_id, try_cursor_movement): Disable these optimizations when the line-number-current-line face is different from line-number face. (maybe_produce_line_number): Display the current line in the line-number-current-line face, if it's different from line-number. --- src/xdisp.c | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 8acba259d2f..cf396de203e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15940,6 +15940,13 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, /* When display-line-numbers is in relative mode, moving point requires to redraw the entire window. */ && !EQ (Vdisplay_line_numbers, Qrelative) + /* When the current line number should be displayed in a + distinct face, moving point cannot be handled in optimized + way as below. */ + && !(!NILP (Vdisplay_line_numbers) + && NILP (Finternal_lisp_face_equal_p (Qline_number, + Qline_number_current_line, + w->frame))) /* This code is not used for mini-buffer for the sake of the case of redisplaying to replace an echo area message; since in that case the mini-buffer contents per se are usually @@ -18445,8 +18452,13 @@ try_window_id (struct window *w) if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing))) GIVE_UP (23); - /* Give up if display-line-numbers is in relative mode. */ - if (EQ (Vdisplay_line_numbers, Qrelative)) + /* Give up if display-line-numbers is in relative mode, or when the + current line's number needs to be displayed in a distinct face. */ + if (EQ (Vdisplay_line_numbers, Qrelative) + || (!NILP (Vdisplay_line_numbers) + && NILP (Finternal_lisp_face_equal_p (Qline_number, + Qline_number_current_line, + w->frame)))) GIVE_UP (24); /* Make sure beg_unchanged and end_unchanged are up to date. Do it @@ -20739,8 +20751,13 @@ maybe_produce_line_number (struct it *it) char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */ + int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); + int current_lnum_face_id + = merge_faces (it->f, Qline_number_current_line, 0, DEFAULT_FACE_ID); /* Compute point's line number if needed. */ - if (EQ (Vdisplay_line_numbers, Qrelative) && !it->pt_lnum) + if ((EQ (Vdisplay_line_numbers, Qrelative) + || lnum_face_id != current_lnum_face_id) + && !it->pt_lnum) { ptrdiff_t ignored; if (PT_BYTE > it->lnum_bytepos) @@ -20803,7 +20820,6 @@ maybe_produce_line_number (struct it *it) /* Produce glyphs for the line number in a scratch glyph_row. */ int n_glyphs_before; - int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID); for (const char *p = lnum_buf; *p; p++) { /* For continuation lines and lines after ZV, instead of a line @@ -20811,6 +20827,8 @@ maybe_produce_line_number (struct it *it) default face for the blank field beyond ZV. */ if (beyond_zv) tem_it.face_id = it->base_face_id; + else if (lnum_face_id != current_lnum_face_id && this_line == it->pt_lnum) + tem_it.face_id = current_lnum_face_id; else tem_it.face_id = lnum_face_id; if (beyond_zv || it->continuation_lines_width > 0) @@ -31884,8 +31902,9 @@ They are still logged to the *Messages* buffer. */); /* Name of the face used to highlight trailing whitespace. */ DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); - /* Name of the face used to display line numbers. */ + /* Names of the faces used to display line numbers. */ DEFSYM (Qline_number, "line-number"); + DEFSYM (Qline_number_current_line, "line-number-current-line"); /* Name and number of the face used to highlight escape glyphs. */ DEFSYM (Qescape_glyph, "escape-glyph"); -- cgit v1.2.1 From 6e18841b17c9b7ca9f38b923db4195cade05da2e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 16:58:01 +0300 Subject: Allow Lisp program to disable line-number display for specific lines * etc/NEWS: Update the documentation. * src/xdisp.c (syms_of_xdisp) : New symbol. (should_produce_line_number): New function. (display_line): Use should_produce_line_number to determine whether a line number should be produced for each glyph row. --- src/xdisp.c | 52 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index cf396de203e..d35170ed43e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20887,6 +20887,32 @@ maybe_produce_line_number (struct it *it) bidi_unshelve_cache (itdata, false); } +/* Return true if this glyph row needs a line number to be produced + for it. */ +static bool +should_produce_line_number (struct it *it) +{ + if (NILP (Vdisplay_line_numbers)) + return false; + + /* Don't display line numbers in minibuffer windows. */ + if (MINI_WINDOW_P (it->w)) + return false; + +#ifdef HAVE_WINDOW_SYSTEM + /* Don't display line number in tooltip frames. */ + if (FRAMEP (tip_frame) && EQ (WINDOW_FRAME (it->w), tip_frame)) + return false; +#endif + + /* If the character at current position has a non-nil special + property, disable line numbers for this row. */ + Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)), + Qdisplay_line_numbers_disable, + it->window); + return NILP (val) ? true : false; +} + /* Return true if ROW has no glyphs except those inserted by the display engine. This is needed for indicate-empty-lines and similar features when the glyph row starts with glyphs which didn't @@ -20984,6 +21010,8 @@ display_line (struct it *it, int cursor_vpos) (window_hscroll_limited (it->w, it->f) - it->w->min_hscroll) * FRAME_COLUMN_WIDTH (it->f); + bool line_number_needed = should_produce_line_number (it); + /* Move over display elements that are not visible because we are hscrolled. This may stop at an x-position < first_visible_x if the first glyph is partially visible or if we hit a line end. */ @@ -21021,23 +21049,13 @@ display_line (struct it *it, int cursor_vpos) min_bpos = BYTEPOS (this_line_min_pos); /* Produce line number, if needed. */ - if (!NILP (Vdisplay_line_numbers) -#ifdef HAVE_WINDOW_SYSTEM - && !(FRAMEP (tip_frame) - && EQ (WINDOW_FRAME (it->w), tip_frame)) -#endif - && (!MINI_WINDOW_P (it->w))) + if (line_number_needed) maybe_produce_line_number (it); } else if (it->area == TEXT_AREA) { /* Line numbers should precede the line-prefix or wrap-prefix. */ - if (!NILP (Vdisplay_line_numbers) -#ifdef HAVE_WINDOW_SYSTEM - && !(FRAMEP (tip_frame) - && EQ (WINDOW_FRAME (it->w), tip_frame)) -#endif - && (!MINI_WINDOW_P (it->w))) + if (line_number_needed) maybe_produce_line_number (it); /* We only do this when not calling move_it_in_display_line_to @@ -21203,13 +21221,7 @@ display_line (struct it *it, int cursor_vpos) if (it->area == TEXT_AREA && pending_handle_line_prefix) { /* Line numbers should precede the line-prefix or wrap-prefix. */ - if (!NILP (Vdisplay_line_numbers) -#ifdef HAVE_WINDOW_SYSTEM - && !(FRAMEP (tip_frame) - && EQ (WINDOW_FRAME (it->w), tip_frame)) -#endif - && (!MINI_WINDOW_P (it->w) - || (minibuf_level && EQ (it->window, minibuf_window)))) + if (line_number_needed) maybe_produce_line_number (it); pending_handle_line_prefix = false; @@ -31905,6 +31917,8 @@ They are still logged to the *Messages* buffer. */); /* Names of the faces used to display line numbers. */ DEFSYM (Qline_number, "line-number"); DEFSYM (Qline_number_current_line, "line-number-current-line"); + /* Name of a text property which disables line-number display. */ + DEFSYM (Qdisplay_line_numbers_disable, "display-line-numbers-disable"); /* Name and number of the face used to highlight escape glyphs. */ DEFSYM (Qescape_glyph, "escape-glyph"); -- cgit v1.2.1 From 13cc19a0a3685ceade4a5a560475ee47165f3bbc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 19:03:39 +0300 Subject: Partial fix of hscroll of truncated lines with line numbers * src/xdisp.c (x_produce_glyphs, hscroll_window_tree): Adjust hscroll calculations to line-number display. * src/term.c (produce_glyphs): Adjust tab stop to window's hscroll. These two changes fix horizontal scrolling when line numbers are displayed. But there's still a bug: the horizontal shift of lines that begin with a TAB is different from the rest. * src/xdisp.c (move_it_in_display_line_to): Call should_produce_line_number to determine whether a line number should be produced for this screen line. --- src/term.c | 2 +- src/xdisp.c | 34 ++++++++++++++++++++++++++++++---- 2 files changed, 31 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/term.c b/src/term.c index b0e7e052e51..46d8bff73cc 100644 --- a/src/term.c +++ b/src/term.c @@ -1587,7 +1587,7 @@ produce_glyphs (struct it *it) /* Adjust for line numbers. Kludge alert: the "2" below is because we add 2 blanks to the actual line number. */ if (!NILP (Vdisplay_line_numbers)) - absolute_x -= it->lnum_width + 2; + absolute_x -= it->lnum_width + 2 - it->w->hscroll; int next_tab_x = (((1 + absolute_x + it->tab_width - 1) / it->tab_width) diff --git a/src/xdisp.c b/src/xdisp.c index d35170ed43e..d0673595390 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -834,6 +834,7 @@ static bool update_menu_bar (struct frame *, bool, bool); static bool try_window_reusing_current_matrix (struct window *); static int try_window_id (struct window *); static void maybe_produce_line_number (struct it *); +static bool should_produce_line_number (struct it *); static bool display_line (struct it *, int); static int display_mode_lines (struct window *); static int display_mode_line (struct window *, enum face_id, Lisp_Object); @@ -8656,7 +8657,7 @@ move_it_in_display_line_to (struct it *it, if (it->hpos == 0) { /* If line numbers are being displayed, produce a line number. */ - if (!NILP (Vdisplay_line_numbers) + if (should_produce_line_number (it) && it->current_x == it->first_visible_x) maybe_produce_line_number (it); /* If there's a line-/wrap-prefix, handle it. */ @@ -13068,6 +13069,30 @@ hscroll_window_tree (Lisp_Object window) } bool row_r2l_p = cursor_row->reversed_p; bool hscl = hscrolling_current_line_p (w); + int x_offset = 0; + struct glyph *g; + if (!row_r2l_p) + { + for (g = cursor_row->glyphs[TEXT_AREA]; + g < cursor_row->glyphs[TEXT_AREA] + cursor_row->used[TEXT_AREA]; + g++) + { + if (!(NILP (g->object) && g->charpos < 0)) + break; + x_offset += g->pixel_width; + } + } + else + { + for (g = cursor_row->glyphs[TEXT_AREA] + cursor_row->used[TEXT_AREA]; + g > cursor_row->glyphs[TEXT_AREA]; + g--) + { + if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0)) + break; + x_offset += (g - 1)->pixel_width; + } + } text_area_width = window_box_width (w, TEXT_AREA); @@ -13100,7 +13125,7 @@ hscroll_window_tree (Lisp_Object window) inside the left margin and the window is already hscrolled. */ && ((!row_r2l_p - && ((w->hscroll && w->cursor.x <= h_margin) + && ((w->hscroll && w->cursor.x <= h_margin + x_offset) || (cursor_row->enabled_p && cursor_row->truncated_on_right_p && (w->cursor.x >= text_area_width - h_margin)))) @@ -13118,7 +13143,8 @@ hscroll_window_tree (Lisp_Object window) && cursor_row->truncated_on_right_p && w->cursor.x <= h_margin) || (w->hscroll - && (w->cursor.x >= text_area_width - h_margin)))) + && (w->cursor.x >= (text_area_width - h_margin + - x_offset))))) /* This last condition is needed when moving vertically from an hscrolled line to a short line that doesn't need to be hscrolled. If we omit @@ -27898,7 +27924,7 @@ x_produce_glyphs (struct it *it) /* Adjust for line numbers. Kludge alert: the "2" below is because we add 2 blanks to the actual line number. */ if (!NILP (Vdisplay_line_numbers)) - x -= (it->lnum_width + 2) * font->space_width; + x -= (it->lnum_width + 2 - it->w->hscroll) * font->space_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; /* If the distance from the current position to the next tab -- cgit v1.2.1 From 0d5c713a6b21cd3bd8a232ff35924c65cd3cce6b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jun 2017 19:40:41 +0300 Subject: Move additional hscrolling code into a suitable 'if' * src/xdisp.c (hscroll_window_tree): Make additional calculations regarding glyphs produced for line numbers conditional on line-number display. --- src/xdisp.c | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index d0673595390..6fa1d841ee2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13070,27 +13070,34 @@ hscroll_window_tree (Lisp_Object window) bool row_r2l_p = cursor_row->reversed_p; bool hscl = hscrolling_current_line_p (w); int x_offset = 0; - struct glyph *g; - if (!row_r2l_p) + /* When line numbers are displayed, we need to account for + the horizontal space they consume. */ + if (!NILP (Vdisplay_line_numbers)) { - for (g = cursor_row->glyphs[TEXT_AREA]; - g < cursor_row->glyphs[TEXT_AREA] + cursor_row->used[TEXT_AREA]; - g++) + struct glyph *g; + if (!row_r2l_p) { - if (!(NILP (g->object) && g->charpos < 0)) - break; - x_offset += g->pixel_width; + for (g = cursor_row->glyphs[TEXT_AREA]; + g < cursor_row->glyphs[TEXT_AREA] + + cursor_row->used[TEXT_AREA]; + g++) + { + if (!(NILP (g->object) && g->charpos < 0)) + break; + x_offset += g->pixel_width; + } } - } - else - { - for (g = cursor_row->glyphs[TEXT_AREA] + cursor_row->used[TEXT_AREA]; - g > cursor_row->glyphs[TEXT_AREA]; - g--) + else { - if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0)) - break; - x_offset += (g - 1)->pixel_width; + for (g = cursor_row->glyphs[TEXT_AREA] + + cursor_row->used[TEXT_AREA]; + g > cursor_row->glyphs[TEXT_AREA]; + g--) + { + if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0)) + break; + x_offset += (g - 1)->pixel_width; + } } } -- cgit v1.2.1 From 540669cda984f64964d7baeb7369d3eea424a34c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Jun 2017 19:33:04 +0300 Subject: Fix line number display for overlay/display strings with newlines * src/xdisp.c (maybe_produce_line_number): Fix the condition for producing space glyphs instead of a line number to include the case of display strings and overlays. --- src/xdisp.c | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 6fa1d841ee2..c318a6954c4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20749,10 +20749,15 @@ maybe_produce_line_number (struct it *it) ptrdiff_t last_line = it->lnum; ptrdiff_t start_from, bytepos; ptrdiff_t this_line; + bool first_time = false; /* FIXME: Maybe reuse the data in it->w->base_line_number. */ if (!last_line) - start_from = BEGV; + { + start_from = BEGV; + if (!it->lnum_bytepos) + first_time = true; + } else start_from = it->lnum_bytepos; @@ -20772,13 +20777,14 @@ maybe_produce_line_number (struct it *it) eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); eassert (bytepos == IT_BYTEPOS (*it)); - /* Produce the glyphs for the line number. */ + /* Record the line number information. */ if (this_line != last_line || !last_line) { it->lnum = this_line; it->lnum_bytepos = IT_BYTEPOS (*it); } + /* Produce the glyphs for the line number. */ void *itdata = bidi_shelve_cache (); struct it tem_it; char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; @@ -20864,7 +20870,10 @@ maybe_produce_line_number (struct it *it) tem_it.face_id = current_lnum_face_id; else tem_it.face_id = lnum_face_id; - if (beyond_zv || it->continuation_lines_width > 0) + if (beyond_zv + /* Don't display the same line number more than once. */ + || it->continuation_lines_width > 0 + || (this_line == last_line && !first_time)) tem_it.c = tem_it.char_to_display = ' '; else tem_it.c = tem_it.char_to_display = *p; -- cgit v1.2.1 From 5d1025e7162db46b3c8d7c19facd8f9b9eff6f49 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Jun 2017 20:53:05 +0300 Subject: Allow to disable display of line numbers beyond EOB * src/buffer.c (disable_line_numbers_overlay_at_eob): New function. * src/lisp.h (disable_line_numbers_overlay_at_eob): Add prototype. * src/xdisp.c (should_produce_line_number): When at ZV, call disable_line_numbers_overlay_at_eob to determine whether line numbers should be displayed beyond ZV. --- src/buffer.c | 27 +++++++++++++++++++++++++++ src/lisp.h | 1 + src/xdisp.c | 13 +++++++++---- 3 files changed, 37 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/buffer.c b/src/buffer.c index 80dbd3318dc..780e4d7a7d6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3054,6 +3054,33 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) return i < n; } +/* Return the value of the 'display-line-numbers-disable' property at + EOB, if there's an overlay at ZV with a non-nil value of that property. */ +Lisp_Object +disable_line_numbers_overlay_at_eob (void) +{ + ptrdiff_t n, i, size; + Lisp_Object *v, tem = Qnil; + Lisp_Object vbuf[10]; + USE_SAFE_ALLOCA; + + size = ARRAYELTS (vbuf); + v = vbuf; + n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL); + if (n > size) + { + SAFE_NALLOCA (v, 1, n); + overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL); + } + + for (i = 0; i < n; ++i) + if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable), + !NILP (tem))) + break; + + SAFE_FREE (); + return tem; +} /* Fast function to just test if we're at an overlay boundary. */ diff --git a/src/lisp.h b/src/lisp.h index ff8dde2b825..f5cb6c75706 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3965,6 +3965,7 @@ extern void syms_of_editfns (void); /* Defined in buffer.c. */ extern bool mouse_face_overlay_overlaps (Lisp_Object); +extern Lisp_Object disable_line_numbers_overlay_at_eob (void); extern _Noreturn void nsberror (Lisp_Object); extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t); extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); diff --git a/src/xdisp.c b/src/xdisp.c index c318a6954c4..7649b16e974 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20948,10 +20948,15 @@ should_produce_line_number (struct it *it) #endif /* If the character at current position has a non-nil special - property, disable line numbers for this row. */ - Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)), - Qdisplay_line_numbers_disable, - it->window); + property, disable line numbers for this row. For ZV, we need to + use a special algorithm that only supports empty overlays at that + point, because get-char-property always returns nil for ZV. */ + Lisp_Object val = Qnil; + if (IT_CHARPOS (*it) >= ZV) + val = disable_line_numbers_overlay_at_eob (); + else + val = Fget_char_property (make_number (IT_CHARPOS (*it)), + Qdisplay_line_numbers_disable, it->window); return NILP (val) ? true : false; } -- cgit v1.2.1 From 33073d5629ca44f0d5db6fb29d1229da74e0e3c1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Jun 2017 20:55:58 +0300 Subject: Minor aesthetic fix of last change. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 7649b16e974..aa75fcaf77c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20951,7 +20951,7 @@ should_produce_line_number (struct it *it) property, disable line numbers for this row. For ZV, we need to use a special algorithm that only supports empty overlays at that point, because get-char-property always returns nil for ZV. */ - Lisp_Object val = Qnil; + Lisp_Object val; if (IT_CHARPOS (*it) >= ZV) val = disable_line_numbers_overlay_at_eob (); else -- cgit v1.2.1 From 67c8a219e670eed317acdffc68a2888e2c557e79 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Jun 2017 19:38:17 +0300 Subject: Update IT's metrics while simulating display * src/xdisp.c (maybe_produce_line_number): Update IT's metrics also when glyph_row is NULL. This is important for move_it_* functions. --- src/xdisp.c | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index aa75fcaf77c..3283f9ee971 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20925,6 +20925,13 @@ maybe_produce_line_number (struct it *it) it->max_phys_descent = max (row->phys_height - row->phys_ascent, tem_it.max_phys_descent); } + else + { + it->max_ascent = max (it->max_ascent, tem_it.max_ascent); + it->max_descent = max (it->max_descent, tem_it.max_descent); + it->max_phys_ascent = max (it->max_phys_ascent, tem_it.max_phys_ascent); + it->max_phys_descent = max (it->max_phys_descent, tem_it.max_phys_descent); + } bidi_unshelve_cache (itdata, false); } -- cgit v1.2.1 From beb95a8f890da611acc1a4422211deafe512d87d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Jun 2017 23:20:49 +0300 Subject: Initial support for visually-relative line numbers Works very slowly. * src/xdisp.c (display_count_lines_visually): New function. (maybe_produce_line_number): Support 'visual' mode of line-number display. * src/xdisp.c (maybe_produce_line_number): Update IT's metrics also when glyph_row is NULL. This is important for move_it_* functions. (syms_of_xdisp) : Now buffer-local. (try_window_id, redisplay_window, try_cursor_movement): For 'visual' line-number display, disable the same redisplay optimizations as for 'relative'. * lisp/cus-start.el (standard): Add new value for the customization form of display-line-numbers. --- src/xdisp.c | 116 ++++++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 82 insertions(+), 34 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 3283f9ee971..67266fdf315 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15973,6 +15973,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, /* When display-line-numbers is in relative mode, moving point requires to redraw the entire window. */ && !EQ (Vdisplay_line_numbers, Qrelative) + && !EQ (Vdisplay_line_numbers, Qvisual) /* When the current line number should be displayed in a distinct face, moving point cannot be handled in optimized way as below. */ @@ -16841,7 +16842,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil)); if (w->redisplay || XBUFFER (w->contents)->text->redisplay - || (EQ (Vdisplay_line_numbers, Qrelative) + || ((EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual)) && row != MATRIX_FIRST_TEXT_ROW (w->desired_matrix))) { /* Either pre-redisplay-function made changes (e.g. move @@ -18488,6 +18490,7 @@ try_window_id (struct window *w) /* Give up if display-line-numbers is in relative mode, or when the current line's number needs to be displayed in a distinct face. */ if (EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual) || (!NILP (Vdisplay_line_numbers) && NILP (Finternal_lisp_face_equal_p (Qline_number, Qline_number_current_line, @@ -20740,6 +20743,35 @@ find_row_edges (struct it *it, struct glyph_row *row, row->maxpos = it->current.pos; } +/* Count the number of screen lines in window W between character + position CHARPOS and the line showing that window's point. */ +static ptrdiff_t +display_count_lines_visually (struct window *w, struct text_pos pos) +{ + struct it tem_it; + ptrdiff_t to; + struct text_pos from; + ptrdiff_t count = SPECPDL_INDEX (); + + if (CHARPOS (pos) <= PT) + { + from = pos; + to = PT; + } + else + { + SET_TEXT_POS (from, PT, PT_BYTE); + to = CHARPOS (pos); + } + start_display (&tem_it, w, from); + /* Need to disable visual mode temporarily, since otherwise the call + to move_it_to will cause infionite recursion. */ + specbind (Qdisplay_line_numbers, Qrelative); + move_it_to (&tem_it, to, -1, -1, -1, MOVE_TO_POS); + unbind_to (count, Qnil); + return CHARPOS (pos) <= PT ? -tem_it.vpos : tem_it.vpos; +} + /* Produce the line-number glyphs for the current glyph_row. If IT->glyph_row is non-NULL, populate the row with the produced glyphs. */ @@ -20750,42 +20782,47 @@ maybe_produce_line_number (struct it *it) ptrdiff_t start_from, bytepos; ptrdiff_t this_line; bool first_time = false; + void *itdata = bidi_shelve_cache (); - /* FIXME: Maybe reuse the data in it->w->base_line_number. */ - if (!last_line) - { - start_from = BEGV; - if (!it->lnum_bytepos) - first_time = true; - } + if (EQ (Vdisplay_line_numbers, Qvisual)) + this_line = display_count_lines_visually (it->w, it->current.pos); else - start_from = it->lnum_bytepos; - - /* Paranoia: what if someone changes the narrowing since the last - time display_line was called? Shouldn't really happen, but who - knows what some crazy Lisp invoked by :eval could do? */ - if (!(BEGV_BYTE <= start_from && start_from < ZV_BYTE)) { - last_line = 0; - start_from = BEGV_BYTE; - } + if (!last_line) + { + /* FIXME: Maybe reuse the data in it->w->base_line_number. */ + start_from = BEGV; + if (!it->lnum_bytepos) + first_time = true; + } + else + start_from = it->lnum_bytepos; - this_line = - last_line + display_count_lines (start_from, - IT_BYTEPOS (*it), IT_CHARPOS (*it), - &bytepos); - eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); - eassert (bytepos == IT_BYTEPOS (*it)); + /* Paranoia: what if someone changes the narrowing since the + last time display_line was called? Shouldn't really happen, + but who knows what some crazy Lisp invoked by :eval could do? */ + if (!(BEGV_BYTE <= start_from && start_from < ZV_BYTE)) + { + last_line = 0; + start_from = BEGV_BYTE; + } - /* Record the line number information. */ - if (this_line != last_line || !last_line) - { - it->lnum = this_line; - it->lnum_bytepos = IT_BYTEPOS (*it); + this_line = + last_line + display_count_lines (start_from, + IT_BYTEPOS (*it), IT_CHARPOS (*it), + &bytepos); + eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); + eassert (bytepos == IT_BYTEPOS (*it)); + + /* Record the line number information. */ + if (this_line != last_line || !last_line) + { + it->lnum = this_line; + it->lnum_bytepos = IT_BYTEPOS (*it); + } } /* Produce the glyphs for the line number. */ - void *itdata = bidi_shelve_cache (); struct it tem_it; char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1]; bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false; @@ -20795,11 +20832,12 @@ maybe_produce_line_number (struct it *it) = merge_faces (it->f, Qline_number_current_line, 0, DEFAULT_FACE_ID); /* Compute point's line number if needed. */ if ((EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual) || lnum_face_id != current_lnum_face_id) && !it->pt_lnum) { ptrdiff_t ignored; - if (PT_BYTE > it->lnum_bytepos) + if (PT_BYTE > it->lnum_bytepos && !EQ (Vdisplay_line_numbers, Qvisual)) it->pt_lnum = this_line + display_count_lines (it->lnum_bytepos, PT_BYTE, PT, &ignored); @@ -20819,7 +20857,10 @@ maybe_produce_line_number (struct it *it) matrix. */ ptrdiff_t max_lnum; - max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + if (EQ (Vdisplay_line_numbers, Qvisual)) + max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1; + else + max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; max_lnum = max (1, max_lnum); it->lnum_width = log10 (max_lnum) + 1; } @@ -20827,11 +20868,14 @@ maybe_produce_line_number (struct it *it) } if (EQ (Vdisplay_line_numbers, Qrelative)) lnum_offset = it->pt_lnum; + else if (EQ (Vdisplay_line_numbers, Qvisual)) + lnum_offset = 0; /* Under 'relative', display the absolute line number for the current line, as displaying zero gives zero useful information. */ ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset); - if (EQ (Vdisplay_line_numbers, Qrelative) + if ((EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual)) && lnum_to_display == 0) lnum_to_display = it->pt_lnum + 1; /* In L2R rows we need to append the blank separator, in R2L @@ -20872,8 +20916,9 @@ maybe_produce_line_number (struct it *it) tem_it.face_id = lnum_face_id; if (beyond_zv /* Don't display the same line number more than once. */ - || it->continuation_lines_width > 0 - || (this_line == last_line && !first_time)) + && (!EQ (Vdisplay_line_numbers, Qvisual) + && (it->continuation_lines_width > 0 + || (this_line == last_line && !first_time)))) tem_it.c = tem_it.char_to_display = ' '; else tem_it.c = tem_it.char_to_display = *p; @@ -32494,6 +32539,7 @@ after each newline that comes from buffer text. */); DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); DEFSYM (Qrelative, "relative"); + DEFSYM (Qvisual, "visual"); DEFVAR_LISP ("display-line-number-width", Vdisplay_line_number_width, doc: /* Minimum width of space reserved for line number display. @@ -32502,6 +32548,8 @@ even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); Vdisplay_line_number_width = Qnil; + DEFSYM (Qdisplay_line_number_width, "display-line-number-width"); + Fmake_variable_buffer_local (Qdisplay_line_number_width); DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); -- cgit v1.2.1 From 71e31ac839b05d01486d728d4da9a8daaf1ae240 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Jun 2017 19:46:50 +0300 Subject: Support default-text-properties * src/xdisp.c (should_produce_line_number): Call get-char-property at ZV as well, to support default-text-properties. --- src/xdisp.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 67266fdf315..ef2e2646b2c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21000,15 +21000,17 @@ should_produce_line_number (struct it *it) #endif /* If the character at current position has a non-nil special - property, disable line numbers for this row. For ZV, we need to - use a special algorithm that only supports empty overlays at that - point, because get-char-property always returns nil for ZV. */ - Lisp_Object val; - if (IT_CHARPOS (*it) >= ZV) + property, disable line numbers for this row. This is for + packages such as company-mode, which need this for their tricky + layout, where line numbers get in the way. */ + Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)), + Qdisplay_line_numbers_disable, + it->window); + /* For ZV, we need to also look in empty overlays at that point, + because get-char-property always returns nil for ZV, except if + the property is in 'default-text-properties'. */ + if (NILP (val) && IT_CHARPOS (*it) >= ZV) val = disable_line_numbers_overlay_at_eob (); - else - val = Fget_char_property (make_number (IT_CHARPOS (*it)), - Qdisplay_line_numbers_disable, it->window); return NILP (val) ? true : false; } -- cgit v1.2.1 From 5b9b49492b9c024bd07b83ef6e5d095af6b8fdd0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Jun 2017 21:09:55 +0300 Subject: Minor fixes * src/xdisp.c (maybe_produce_line_number): Fix bug that caused line numbers to be displayed in empty lines beyond ZV. (x_produce_glyphs): Start fixing TAB display in truncated lines. --- src/xdisp.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index ef2e2646b2c..bbf30504844 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20916,7 +20916,7 @@ maybe_produce_line_number (struct it *it) tem_it.face_id = lnum_face_id; if (beyond_zv /* Don't display the same line number more than once. */ - && (!EQ (Vdisplay_line_numbers, Qvisual) + || (!EQ (Vdisplay_line_numbers, Qvisual) && (it->continuation_lines_width > 0 || (this_line == last_line && !first_time)))) tem_it.c = tem_it.char_to_display = ' '; @@ -27996,19 +27996,22 @@ x_produce_glyphs (struct it *it) { int tab_width = it->tab_width * font->space_width; int x = it->current_x + it->continuation_lines_width; + int x0 = x; /* Adjust for line numbers. Kludge alert: the "2" below is because we add 2 blanks to the actual line number. */ if (!NILP (Vdisplay_line_numbers)) - x -= (it->lnum_width + 2 - it->w->hscroll) * font->space_width; + x -= (it->lnum_width + 2) * font->space_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; + if (!NILP (Vdisplay_line_numbers)) + next_tab_x += (it->lnum_width + 2) * font->space_width; /* If the distance from the current position to the next tab stop is less than a space character width, use the tab stop after that. */ - if (next_tab_x - x < font->space_width) + if (next_tab_x - x0 < font->space_width) next_tab_x += tab_width; - it->pixel_width = next_tab_x - x; + it->pixel_width = next_tab_x - x0; it->nglyphs = 1; if (FONT_TOO_HIGH (font)) { -- cgit v1.2.1 From dfe1c820d3dca6673aba911a4a37969bbabd0486 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 11:43:49 +0300 Subject: Fix TAB display when the line-number face uses a smaller/larger font * src/dispextern.h (struct it): New member lnum_pixel_width. * src/xdisp.c (maybe_produce_line_number): Compute the width of the line-number display in pixels. (x_produce_glyphs): Use it->lnum_pixel_width instead of a kludge that used it->lnum_width and made assumptions about pixel width. --- src/dispextern.h | 5 +++-- src/xdisp.c | 9 +++++---- 2 files changed, 8 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/dispextern.h b/src/dispextern.h index 08e5caa893b..84a27169ea1 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2667,9 +2667,10 @@ struct it /* The byte position corresponding to lnum. */ ptrdiff_t lnum_bytepos; - /* The width in columns needed for display of the line numbers, or - zero if not computed. */ + /* The width, in columns and in pixels, needed for display of the + line numbers, or zero if not computed. */ int lnum_width; + int lnum_pixel_width; /* The line number of point's line, or zero if not computed yet. */ ptrdiff_t pt_lnum; diff --git a/src/xdisp.c b/src/xdisp.c index bbf30504844..3fc5f29d0c4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20938,6 +20938,8 @@ maybe_produce_line_number (struct it *it) } } + /* Record the width in pixels we need for the line number display. */ + it->lnum_pixel_width = tem_it.current_x; /* Copy the produced glyphs into IT's glyph_row. */ struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA]; struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA]; @@ -27997,13 +27999,12 @@ x_produce_glyphs (struct it *it) int tab_width = it->tab_width * font->space_width; int x = it->current_x + it->continuation_lines_width; int x0 = x; - /* Adjust for line numbers. Kludge alert: the "2" below - is because we add 2 blanks to the actual line number. */ + /* Adjust for line numbers, if needed. */ if (!NILP (Vdisplay_line_numbers)) - x -= (it->lnum_width + 2) * font->space_width; + x -= it->lnum_pixel_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; if (!NILP (Vdisplay_line_numbers)) - next_tab_x += (it->lnum_width + 2) * font->space_width; + next_tab_x += it->lnum_pixel_width; /* If the distance from the current position to the next tab stop is less than a space character width, use the -- cgit v1.2.1 From a06dd3b9187489b61f08256d9e9a07745302dc4e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 12:24:13 +0300 Subject: Fix hscrolling with line numbers on TTY frames * src/xdisp.c (hscroll_window_tree): Correct the X offset calculations on TTY frames. * src/term.c (produce_glyphs): Use it->lnum_pixel_width instead of a kludge using it->lnum_width. --- src/term.c | 10 ++++++---- src/xdisp.c | 9 ++++++++- 2 files changed, 14 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/term.c b/src/term.c index 46d8bff73cc..00a272c3b0b 100644 --- a/src/term.c +++ b/src/term.c @@ -1584,14 +1584,16 @@ produce_glyphs (struct it *it) { int absolute_x = (it->current_x + it->continuation_lines_width); - /* Adjust for line numbers. Kludge alert: the "2" below is - because we add 2 blanks to the actual line number. */ + int x0 = absolute_x; + /* Adjust for line numbers. */ if (!NILP (Vdisplay_line_numbers)) - absolute_x -= it->lnum_width + 2 - it->w->hscroll; + absolute_x -= it->lnum_pixel_width; int next_tab_x = (((1 + absolute_x + it->tab_width - 1) / it->tab_width) * it->tab_width); + if (!NILP (Vdisplay_line_numbers)) + next_tab_x += it->lnum_pixel_width; int nspaces; /* If part of the TAB has been displayed on the previous line @@ -1599,7 +1601,7 @@ produce_glyphs (struct it *it) been incremented already by the part that fitted on the continued line. So, we will get the right number of spaces here. */ - nspaces = next_tab_x - absolute_x; + nspaces = next_tab_x - x0; if (it->glyph_row) { diff --git a/src/xdisp.c b/src/xdisp.c index 3fc5f29d0c4..26b19eb44fb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13100,6 +13100,12 @@ hscroll_window_tree (Lisp_Object window) } } } + if (cursor_row->truncated_on_left_p) + { + /* On TTY frames, don't count the left truncation glyph. */ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)); + } text_area_width = window_box_width (w, TEXT_AREA); @@ -28004,7 +28010,8 @@ x_produce_glyphs (struct it *it) x -= it->lnum_pixel_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; if (!NILP (Vdisplay_line_numbers)) - next_tab_x += it->lnum_pixel_width; + next_tab_x += (it->lnum_pixel_width + - it->w->hscroll * font->space_width); /* If the distance from the current position to the next tab stop is less than a space character width, use the -- cgit v1.2.1 From 0e4f2e01af1f4c51b958057d86e28c04cdefddb4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 15:55:51 +0300 Subject: Speed up the visual-mode relative line numbers * src/xdisp.c (display_count_lines_visually): Introduce a shortcut: if a relative line number was already calculated for this iterator object, just increase it instead of the expensive call to move_it_to. Argument list changed to pass a pointer to the iterator object. (maybe_produce_line_number): Adjust for change in signature of display_count_lines_visually. Record the relative line number and the corresponding byte position in the iterator object also in the 'visual' mode. --- src/xdisp.c | 61 ++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 25 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 26b19eb44fb..5c6aea19697 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20749,33 +20749,44 @@ find_row_edges (struct it *it, struct glyph_row *row, row->maxpos = it->current.pos; } -/* Count the number of screen lines in window W between character - position CHARPOS and the line showing that window's point. */ +/* Count the number of screen lines in window IT->w between character + position IT_CHARPOS(*IT) and the line showing that window's point. */ static ptrdiff_t -display_count_lines_visually (struct window *w, struct text_pos pos) +display_count_lines_visually (struct it *it) { struct it tem_it; ptrdiff_t to; struct text_pos from; - ptrdiff_t count = SPECPDL_INDEX (); - if (CHARPOS (pos) <= PT) - { - from = pos; - to = PT; - } + /* If we already calculated a relative line number, use that. This + trick relies on the fact that visual lines (a.k.a. "glyph rows") + are laid out sequentially, one by one, for each sequence of calls + to display_line or other similar function that follows a call to + init_iterator. */ + if (it->lnum_bytepos > 0) + return it->lnum + 1; else { - SET_TEXT_POS (from, PT, PT_BYTE); - to = CHARPOS (pos); + ptrdiff_t count = SPECPDL_INDEX (); + + if (IT_CHARPOS (*it) <= PT) + { + from = it->current.pos; + to = PT; + } + else + { + SET_TEXT_POS (from, PT, PT_BYTE); + to = IT_CHARPOS (*it); + } + start_display (&tem_it, it->w, from); + /* Need to disable visual mode temporarily, since otherwise the + call to move_it_to will cause infinite recursion. */ + specbind (Qdisplay_line_numbers, Qrelative); + move_it_to (&tem_it, to, -1, -1, -1, MOVE_TO_POS); + unbind_to (count, Qnil); + return IT_CHARPOS (*it) <= PT ? -tem_it.vpos : tem_it.vpos; } - start_display (&tem_it, w, from); - /* Need to disable visual mode temporarily, since otherwise the call - to move_it_to will cause infionite recursion. */ - specbind (Qdisplay_line_numbers, Qrelative); - move_it_to (&tem_it, to, -1, -1, -1, MOVE_TO_POS); - unbind_to (count, Qnil); - return CHARPOS (pos) <= PT ? -tem_it.vpos : tem_it.vpos; } /* Produce the line-number glyphs for the current glyph_row. If @@ -20791,7 +20802,7 @@ maybe_produce_line_number (struct it *it) void *itdata = bidi_shelve_cache (); if (EQ (Vdisplay_line_numbers, Qvisual)) - this_line = display_count_lines_visually (it->w, it->current.pos); + this_line = display_count_lines_visually (it); else { if (!last_line) @@ -20819,13 +20830,13 @@ maybe_produce_line_number (struct it *it) &bytepos); eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); eassert (bytepos == IT_BYTEPOS (*it)); + } - /* Record the line number information. */ - if (this_line != last_line || !last_line) - { - it->lnum = this_line; - it->lnum_bytepos = IT_BYTEPOS (*it); - } + /* Record the line number information. */ + if (this_line != last_line || !it->lnum_bytepos) + { + it->lnum = this_line; + it->lnum_bytepos = IT_BYTEPOS (*it); } /* Produce the glyphs for the line number. */ -- cgit v1.2.1 From 7a762fbbfc1c05be8de3d253251f5e7b32da2c73 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 16:37:57 +0300 Subject: Support displaying zero as the number of the current line * src/xdisp.c (syms_of_xdisp) : New variable. : Doc fix. (maybe_produce_line_number): Support nil value of display-line-numbers-current-absolute. * lisp/cus-start.el (standard): Add customization form for display-line-numbers-current-absolute. * etc/NEWS: Document recently introduced features. --- src/xdisp.c | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 5c6aea19697..7851487e74e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20874,7 +20874,13 @@ maybe_produce_line_number (struct it *it) matrix. */ ptrdiff_t max_lnum; - if (EQ (Vdisplay_line_numbers, Qvisual)) + if (NILP (Vdisplay_line_numbers_current_absolute) + && (EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual))) + /* We subtract one more because the current line is always + zero in this mode. */ + max_lnum = it->w->desired_matrix->nrows - 2; + else if (EQ (Vdisplay_line_numbers, Qvisual)) max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1; else max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; @@ -20889,11 +20895,12 @@ maybe_produce_line_number (struct it *it) lnum_offset = 0; /* Under 'relative', display the absolute line number for the - current line, as displaying zero gives zero useful information. */ + current line, unless the user requests otherwise. */ ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset); if ((EQ (Vdisplay_line_numbers, Qrelative) || EQ (Vdisplay_line_numbers, Qvisual)) - && lnum_to_display == 0) + && lnum_to_display == 0 + && !NILP (Vdisplay_line_numbers_current_absolute)) lnum_to_display = it->pt_lnum + 1; /* In L2R rows we need to append the blank separator, in R2L rows we need to prepend it. But this function is usually @@ -32557,8 +32564,10 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, doc: /* Non-nil means display line numbers. -Line numbers are displayed before each non-continuation line, i.e. -after each newline that comes from buffer text. */); +By default, line numbers are displayed before each non-continuation +line that displays buffer text, i.e. after each newline that came +from buffer text. However, if the value is `visual', every screen +line will have a number. */); Vdisplay_line_numbers = Qnil; DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); @@ -32575,6 +32584,13 @@ Any other value is treated as nil. */); DEFSYM (Qdisplay_line_number_width, "display-line-number-width"); Fmake_variable_buffer_local (Qdisplay_line_number_width); + DEFVAR_LISP ("display-line-numbers-current-absolute", + Vdisplay_line_numbers_current_absolute, + doc: /* Non-nil means display absolute number of current line. +This variable has effect only when `display-line-numbers' is +either `relative' or `visual'. */); + Vdisplay_line_numbers_current_absolute = Qt; + DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); inhibit_eval_during_redisplay = false; -- cgit v1.2.1 From e83b128a8195e5c63f12832decf70c2953821dc0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 17:33:06 +0300 Subject: Add documentation for display-line-numbers * doc/emacs/custom.texi (Init Rebinding): * doc/emacs/modes.texi (Minor Modes): Remove references to linum-mode. * doc/emacs/display.texi (Display Custom): Describe the line-number display. (Optional Mode Line): Fix the index entry to not conflict with that in "Display Custom". * doc/emacs/basic.texi (Position Info): Add cross-reference to "Display Custom", for line-number display. * src/xdisp.c (syms_of_xdisp): : Mention display-line-numbers-disable in the doc string. * lisp/cus-start.el (standard): Fix lst change. --- src/xdisp.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 7851487e74e..bcd7d33332f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32567,7 +32567,12 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); By default, line numbers are displayed before each non-continuation line that displays buffer text, i.e. after each newline that came from buffer text. However, if the value is `visual', every screen -line will have a number. */); +line will have a number. + +Lisp programs can disable display of a line number of a particular +screen line by putting the `display-line-numbers-disable' text +property or overlay property on the first visible character of +that line. */); Vdisplay_line_numbers = Qnil; DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); -- cgit v1.2.1 From a9be5a768b6c06e74a386c474aba8125dfc8ed86 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Jun 2017 22:48:36 +0300 Subject: Fix relative-number display with non-nil display-line-number-width * src/xdisp.c (maybe_produce_line_number): Don't treat a zero value of display-line-number-width as acceptable. Handle the case of 'relative' with display-line-number-width non-nil and smaller than the absolute line number requires. Reported by Alex . --- src/xdisp.c | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index bcd7d33332f..aeccac2cb16 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20867,26 +20867,23 @@ maybe_produce_line_number (struct it *it) { if (NATNUMP (Vdisplay_line_number_width)) it->lnum_width = XFASTINT (Vdisplay_line_number_width); + + /* Max line number to be displayed cannot be more than the one + corresponding to the last row of the desired matrix. */ + ptrdiff_t max_lnum; + + if (NILP (Vdisplay_line_numbers_current_absolute) + && (EQ (Vdisplay_line_numbers, Qrelative) + || EQ (Vdisplay_line_numbers, Qvisual))) + /* We subtract one more because the current line is always + zero in this mode. */ + max_lnum = it->w->desired_matrix->nrows - 2; + else if (EQ (Vdisplay_line_numbers, Qvisual)) + max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1; else - { - /* Max line number to be displayed cannot be more than - the one corresponding to the last row of the desired - matrix. */ - ptrdiff_t max_lnum; - - if (NILP (Vdisplay_line_numbers_current_absolute) - && (EQ (Vdisplay_line_numbers, Qrelative) - || EQ (Vdisplay_line_numbers, Qvisual))) - /* We subtract one more because the current line is always - zero in this mode. */ - max_lnum = it->w->desired_matrix->nrows - 2; - else if (EQ (Vdisplay_line_numbers, Qvisual)) - max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1; - else - max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; - max_lnum = max (1, max_lnum); - it->lnum_width = log10 (max_lnum) + 1; - } + max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos; + max_lnum = max (1, max_lnum); + it->lnum_width = max (it->lnum_width, log10 (max_lnum) + 1); eassert (it->lnum_width > 0); } if (EQ (Vdisplay_line_numbers, Qrelative)) -- cgit v1.2.1 From fb62728b7afa7024d4ca01e6f89b0267231cf607 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 1 Jul 2017 10:22:45 +0300 Subject: Avoid slow redisplay under 'visual' mode of line numbers * src/xdisp.c (display_count_lines_visually): Avoid very slow redisplay when this function is invoked very far from point. Reported by Alex . --- src/xdisp.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index aeccac2cb16..7bbe9d9ca3e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20783,7 +20783,14 @@ display_count_lines_visually (struct it *it) /* Need to disable visual mode temporarily, since otherwise the call to move_it_to will cause infinite recursion. */ specbind (Qdisplay_line_numbers, Qrelative); - move_it_to (&tem_it, to, -1, -1, -1, MOVE_TO_POS); + /* Some redisplay optimizations could invoke us very far from + PT, which will make the caller painfully slow. There should + be no need to go too far beyond the window's bottom, as any + such optimization will fail to show point anyway. */ + move_it_to (&tem_it, to, -1, + tem_it.last_visible_y + + (SCROLL_LIMIT + 10) * FRAME_LINE_HEIGHT (tem_it.f), + -1, MOVE_TO_POS | MOVE_TO_Y); unbind_to (count, Qnil); return IT_CHARPOS (*it) <= PT ? -tem_it.vpos : tem_it.vpos; } -- cgit v1.2.1 From b5ce3100a8549df519d6f2b577fe7c3acf90cb40 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 1 Jul 2017 16:00:18 +0300 Subject: Improve display of tabs with line numbers * src/xdisp.c (x_produce_glyphs): Improve calculation of next tab stop in hscrolled lines. Prevent aborts in compute_line_metrics. --- src/xdisp.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 7bbe9d9ca3e..47b81414630 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28028,18 +28028,19 @@ x_produce_glyphs (struct it *it) int x = it->current_x + it->continuation_lines_width; int x0 = x; /* Adjust for line numbers, if needed. */ - if (!NILP (Vdisplay_line_numbers)) + if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width) x -= it->lnum_pixel_width; int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; - if (!NILP (Vdisplay_line_numbers)) - next_tab_x += (it->lnum_pixel_width - - it->w->hscroll * font->space_width); /* If the distance from the current position to the next tab stop is less than a space character width, use the tab stop after that. */ if (next_tab_x - x0 < font->space_width) next_tab_x += tab_width; + if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width) + next_tab_x += (it->lnum_pixel_width + - ((it->w->hscroll * font->space_width) + % tab_width)); it->pixel_width = next_tab_x - x0; it->nglyphs = 1; -- cgit v1.2.1 From 4c9353a5840b285631a86a5bad2b48ea6276abf3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 2 Jul 2017 18:01:39 +0300 Subject: Avoid off-by-one errors in column C-n/C-p calculations * src/indent.c (Fvertical_motion): Help C-n/C-p estimate correctly the width used up by line numbers by looking near the window-start point. --- src/indent.c | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/indent.c b/src/indent.c index adecc3622a8..2cacfbbe3c0 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2068,9 +2068,26 @@ whether or not it is currently displayed in some window. */) start_x = window_column_x (w, window, start_col, cur_col); } - itdata = bidi_shelve_cache (); + /* When displaying line numbers, we need to prime IT's + lnum_width with the value calculated at window's start, since + that's what normal window redisplay does. Otherwise C-n/C-p + will sometimes err by one column. */ + int lnum_width = 0; + if (!NILP (Vdisplay_line_numbers) + && !EQ (Vdisplay_line_numbers, Qvisual)) + { + struct text_pos wstart; + SET_TEXT_POS_FROM_MARKER (wstart, w->start); + itdata = bidi_shelve_cache (); + start_display (&it, w, wstart); + move_it_by_lines (&it, 1); + lnum_width = it.lnum_width; + bidi_unshelve_cache (itdata, 0); + } SET_TEXT_POS (pt, PT, PT_BYTE); + itdata = bidi_shelve_cache (); start_display (&it, w, pt); + it.lnum_width = lnum_width; first_x = it.first_visible_x; it_start = IT_CHARPOS (it); -- cgit v1.2.1 From 52bfb7d4d6595302b5261ff810951e0b3281352c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 3 Jul 2017 18:57:01 +0300 Subject: Avoid errors in vertical-motion when buffer is narrowed * src/indent.c (Fvertical_motion): If need to start from window-start, and it is outside of the accessible portion, temporarily widen the buffer. This avoids errors in evil-mode. Reported by James Nguyen . --- src/indent.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src') diff --git a/src/indent.c b/src/indent.c index 2cacfbbe3c0..70351f90466 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2077,11 +2077,24 @@ whether or not it is currently displayed in some window. */) && !EQ (Vdisplay_line_numbers, Qvisual)) { struct text_pos wstart; + bool saved_restriction = false; + ptrdiff_t count1 = SPECPDL_INDEX (); SET_TEXT_POS_FROM_MARKER (wstart, w->start); itdata = bidi_shelve_cache (); + /* We must start from window's start point, but it could be + outside the accessible region. */ + if (wstart.charpos < BEGV || wstart.charpos > ZV) + { + record_unwind_protect (save_restriction_restore, + save_restriction_save ()); + Fwiden (); + saved_restriction = true; + } start_display (&it, w, wstart); move_it_by_lines (&it, 1); lnum_width = it.lnum_width; + if (saved_restriction) + unbind_to (count1, Qnil); bidi_unshelve_cache (itdata, 0); } SET_TEXT_POS (pt, PT, PT_BYTE); -- cgit v1.2.1 From d5f8a3d03f6c0c98f3280d55a2d88ddb40aa1f3e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 4 Jul 2017 18:43:03 +0300 Subject: Fix display of current line number in visual mode * src/xdisp.c (maybe_produce_line_number): Fix visual-mode display of current line when line-number-current-line face was customized. Reported by Filipe Silva . --- src/xdisp.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 47b81414630..312ee10f280 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20938,7 +20938,10 @@ maybe_produce_line_number (struct it *it) default face for the blank field beyond ZV. */ if (beyond_zv) tem_it.face_id = it->base_face_id; - else if (lnum_face_id != current_lnum_face_id && this_line == it->pt_lnum) + else if (lnum_face_id != current_lnum_face_id + && (EQ (Vdisplay_line_numbers, Qvisual) + ? this_line == 0 + : this_line == it->pt_lnum)) tem_it.face_id = current_lnum_face_id; else tem_it.face_id = lnum_face_id; -- cgit v1.2.1 From 25bc3911615d1160d47287c023545c6e0587739f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 6 Jul 2017 20:22:16 +0300 Subject: Implement line numbers that disregard narrowing * src/xdisp.c (display_count_lines_logically): New function, counts line numbers disregarding narrowing. Suggested by Andy Moreton . (maybe_produce_line_number): Call display_count_lines_logically instead of display_count_lines. Adapt BEGV, ZV, etc. to display-line-numbers-widen. (syms_of_xdisp) : New buffer-local variable. * lisp/cus-start.el (standard): Provide a customization form for display-line-numbers-widen. * lisp/frame.el: Add display-line-numbers-widen, display-line-numbers-current-absolute, and display-line-number-width to the list of variables that should trigger redisplay of the current buffer. * doc/emacs/display.texi (Display Custom): Document display-line-numbers-widen. --- src/xdisp.c | 49 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 312ee10f280..92ce1451867 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20749,6 +20749,24 @@ find_row_edges (struct it *it, struct glyph_row *row, row->maxpos = it->current.pos; } +/* Like display_count_lines, but capable of counting outside of the + current narrowed region. */ +static ptrdiff_t +display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte, + ptrdiff_t count, ptrdiff_t *byte_pos_ptr) +{ + if (!display_line_numbers_widen || (BEGV == BEG && ZV == Z)) + return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); + + ptrdiff_t val; + ptrdiff_t pdl_count = SPECPDL_INDEX (); + record_unwind_protect (save_restriction_restore, save_restriction_save ()); + Fwiden (); + val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); + unbind_to (pdl_count, Qnil); + return val; +} + /* Count the number of screen lines in window IT->w between character position IT_CHARPOS(*IT) and the line showing that window's point. */ static ptrdiff_t @@ -20806,6 +20824,9 @@ maybe_produce_line_number (struct it *it) ptrdiff_t start_from, bytepos; ptrdiff_t this_line; bool first_time = false; + ptrdiff_t beg = display_line_numbers_widen ? BEG : BEGV; + ptrdiff_t beg_byte = display_line_numbers_widen ? BEG_BYTE : BEGV_BYTE; + ptrdiff_t z_byte = display_line_numbers_widen ? Z_BYTE : ZV_BYTE; void *itdata = bidi_shelve_cache (); if (EQ (Vdisplay_line_numbers, Qvisual)) @@ -20815,7 +20836,7 @@ maybe_produce_line_number (struct it *it) if (!last_line) { /* FIXME: Maybe reuse the data in it->w->base_line_number. */ - start_from = BEGV; + start_from = beg; if (!it->lnum_bytepos) first_time = true; } @@ -20825,17 +20846,17 @@ maybe_produce_line_number (struct it *it) /* Paranoia: what if someone changes the narrowing since the last time display_line was called? Shouldn't really happen, but who knows what some crazy Lisp invoked by :eval could do? */ - if (!(BEGV_BYTE <= start_from && start_from < ZV_BYTE)) + if (!(beg_byte <= start_from && start_from < z_byte)) { last_line = 0; - start_from = BEGV_BYTE; + start_from = beg_byte; } this_line = - last_line + display_count_lines (start_from, - IT_BYTEPOS (*it), IT_CHARPOS (*it), - &bytepos); - eassert (this_line > 0 || (this_line == 0 && start_from == BEGV_BYTE)); + last_line + display_count_lines_logically (start_from, + IT_BYTEPOS (*it), + IT_CHARPOS (*it), &bytepos); + eassert (this_line > 0 || (this_line == 0 && start_from == beg_byte)); eassert (bytepos == IT_BYTEPOS (*it)); } @@ -20863,11 +20884,11 @@ maybe_produce_line_number (struct it *it) ptrdiff_t ignored; if (PT_BYTE > it->lnum_bytepos && !EQ (Vdisplay_line_numbers, Qvisual)) it->pt_lnum = - this_line + display_count_lines (it->lnum_bytepos, PT_BYTE, PT, - &ignored); + this_line + display_count_lines_logically (it->lnum_bytepos, PT_BYTE, + PT, &ignored); else - it->pt_lnum = display_count_lines (BEGV_BYTE, PT_BYTE, PT, - &ignored); + it->pt_lnum = display_count_lines_logically (beg_byte, PT_BYTE, PT, + &ignored); } /* Compute the required width if needed. */ if (!it->lnum_width) @@ -32604,6 +32625,12 @@ This variable has effect only when `display-line-numbers' is either `relative' or `visual'. */); Vdisplay_line_numbers_current_absolute = Qt; + DEFVAR_BOOL ("display-line-numbers-widen", display_line_numbers_widen, + doc: /* Non-nil means display line numbers disregarding any narrowing. */); + display_line_numbers_widen = false; + DEFSYM (Qdisplay_line_numbers_widen, "display-line-numbers-widen"); + Fmake_variable_buffer_local (Qdisplay_line_numbers_widen); + DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, doc: /* Non-nil means don't eval Lisp during redisplay. */); inhibit_eval_during_redisplay = false; -- cgit v1.2.1 From 4caf65d4de591089c82ccf542a31ea5009a3c717 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 7 Jul 2017 12:21:10 +0300 Subject: Fix vertical-motion across the place where line-number width changes * src/indent.c (line_number_display_width): New function, refactored from line-number width calculations in vertical-motion. (Fvertical_motion): Call line_number_display_width when the width of line-number display is needed. (Fline_number_display_width): New defun. (syms_of_indent): Defsubr it. * doc/lispref/display.texi (Size of Displayed Text): Document line-number-display-width. * etc/NEWS: Mention line-number-display-width. * lisp/simple.el (last--line-number-width): New internal variable. (line-move-visual): Use it to adjust temporary-goal-column when line-number display changes its width. --- src/indent.c | 84 ++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 22 deletions(-) (limited to 'src') diff --git a/src/indent.c b/src/indent.c index 70351f90466..ba936509934 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1947,6 +1947,59 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, -1, hscroll, 0, w); } +/* Return the width taken by line-number display in window W. */ +static void +line_number_display_width (struct window *w, int *width, int *pixel_width) +{ + if (NILP (Vdisplay_line_numbers)) + { + *width = 0; + *pixel_width = 0; + } + else + { + struct it it; + struct text_pos wstart; + bool saved_restriction = false; + ptrdiff_t count = SPECPDL_INDEX (); + SET_TEXT_POS_FROM_MARKER (wstart, w->start); + void *itdata = bidi_shelve_cache (); + /* We must start from window's start point, but it could be + outside the accessible region. */ + if (wstart.charpos < BEGV || wstart.charpos > ZV) + { + record_unwind_protect (save_restriction_restore, + save_restriction_save ()); + Fwiden (); + saved_restriction = true; + } + start_display (&it, w, wstart); + move_it_by_lines (&it, 1); + *width = it.lnum_width; + *pixel_width = it.lnum_pixel_width; + if (saved_restriction) + unbind_to (count, Qnil); + bidi_unshelve_cache (itdata, 0); + } +} + +DEFUN ("line-number-display-width", Fline_number_display_width, + Sline_number_display_width, 0, 1, 0, + doc: /* Return the width used for displaying line numbers in the selected window. +If optional argument PIXELWISE is non-nil, return the width in pixels, +otherwise return the width in columns of the face used to display +line numbers, `line-number'. */) + (Lisp_Object pixelwise) +{ + int width, pixel_width; + line_number_display_width (XWINDOW (selected_window), &width, &pixel_width); + if (!NILP (pixelwise)) + return make_number (pixel_width); + /* FIXME: The "+ 2" part knows that we add a blank on each side of + the line number when producing glyphs for display. */ + return make_number (width + 2); +} + /* In window W (derived from WINDOW), return x coordinate for column COL (derived from COLUMN). */ static int @@ -2073,30 +2126,10 @@ whether or not it is currently displayed in some window. */) that's what normal window redisplay does. Otherwise C-n/C-p will sometimes err by one column. */ int lnum_width = 0; + int lnum_pixel_width = 0; if (!NILP (Vdisplay_line_numbers) && !EQ (Vdisplay_line_numbers, Qvisual)) - { - struct text_pos wstart; - bool saved_restriction = false; - ptrdiff_t count1 = SPECPDL_INDEX (); - SET_TEXT_POS_FROM_MARKER (wstart, w->start); - itdata = bidi_shelve_cache (); - /* We must start from window's start point, but it could be - outside the accessible region. */ - if (wstart.charpos < BEGV || wstart.charpos > ZV) - { - record_unwind_protect (save_restriction_restore, - save_restriction_save ()); - Fwiden (); - saved_restriction = true; - } - start_display (&it, w, wstart); - move_it_by_lines (&it, 1); - lnum_width = it.lnum_width; - if (saved_restriction) - unbind_to (count1, Qnil); - bidi_unshelve_cache (itdata, 0); - } + line_number_display_width (w, &lnum_width, &lnum_pixel_width); SET_TEXT_POS (pt, PT, PT_BYTE); itdata = bidi_shelve_cache (); start_display (&it, w, pt); @@ -2277,6 +2310,12 @@ whether or not it is currently displayed in some window. */) an addition to the hscroll amount. */ if (lcols_given) { + /* If we are displaying line numbers, we could cross the + line where the width of the line-number display changes, + in which case we need to fix up the pixel coordinate + accordingly. */ + if (lnum_pixel_width > 0) + to_x += it.lnum_pixel_width - lnum_pixel_width; move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X); /* If we find ourselves in the middle of an overlay string which includes a newline after current string position, @@ -2322,6 +2361,7 @@ syms_of_indent (void) defsubr (&Sindent_to); defsubr (&Scurrent_column); defsubr (&Smove_to_column); + defsubr (&Sline_number_display_width); defsubr (&Svertical_motion); defsubr (&Scompute_motion); } -- cgit v1.2.1 From 13786d5e7d0aa0a37d7f81d1a1b82eddd3472796 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 7 Jul 2017 17:30:06 +0300 Subject: Exclude blank columns from value of line-number-display-width * src/indent.c (Fline_number_display_width): Don't add 2 to the number of columns we return, to make this consistent with display-line-number-width. --- src/indent.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'src') diff --git a/src/indent.c b/src/indent.c index ba936509934..4c6dacd2042 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1995,9 +1995,7 @@ line numbers, `line-number'. */) line_number_display_width (XWINDOW (selected_window), &width, &pixel_width); if (!NILP (pixelwise)) return make_number (pixel_width); - /* FIXME: The "+ 2" part knows that we add a blank on each side of - the line number when producing glyphs for display. */ - return make_number (width + 2); + return make_number (width); } /* In window W (derived from WINDOW), return x coordinate for column -- cgit v1.2.1 From d2832063c3c5490c931da2f395b8b56116b0192b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 7 Jul 2017 18:08:00 -0700 Subject: Fix ungetc bug when reading an encoding error * src/lread.c (readchar, read_emacs_mule_char): Fix off-by-one error when reading an encoding error from a file, e.g., a symbol in an .elc file whose name is "\360\220\200\360". --- src/lread.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/lread.c b/src/lread.c index 7c554ba8536..44eaf13996a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -340,14 +340,13 @@ readchar (Lisp_Object readcharfun, bool *multibyte) len = BYTES_BY_CHAR_HEAD (c); while (i < len) { - c = (*readbyte) (-1, readcharfun); + buf[i++] = c = (*readbyte) (-1, readcharfun); if (c < 0 || ! TRAILING_CODE_P (c)) { - while (--i > 1) + for (i -= c < 0; 0 < --i; ) (*readbyte) (buf[i], readcharfun); return BYTE8_TO_CHAR (buf[0]); } - buf[i++] = c; } return STRING_CHAR (buf); } @@ -530,14 +529,13 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea buf[i++] = c; while (i < len) { - c = (*readbyte) (-1, readcharfun); + buf[i++] = c = (*readbyte) (-1, readcharfun); if (c < 0xA0) { - while (--i > 1) + for (i -= c < 0; 0 < --i; ) (*readbyte) (buf[i], readcharfun); return BYTE8_TO_CHAR (buf[0]); } - buf[i++] = c; } if (len == 2) -- cgit v1.2.1 From 1628305811247bd652099dad92f6498fc244d8dc Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 7 Jul 2017 18:12:16 -0700 Subject: Avoid ungetc when loading charset maps from files * src/charset.c (read_hex): New args LOOKAHEAD and TERMINATOR, replacing the old EOF. All callers changed. This avoids the need to call ungetc. --- src/charset.c | 90 ++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 49 insertions(+), 41 deletions(-) (limited to 'src') diff --git a/src/charset.c b/src/charset.c index 9c3b8db2a53..6ce2f902c81 100644 --- a/src/charset.c +++ b/src/charset.c @@ -407,44 +407,49 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, /* Read a hexadecimal number (preceded by "0x") from the file FP while - paying attention to comment character '#'. */ + paying attention to comment character '#'. LOOKAHEAD is the + lookahead byte if it is nonnegative. Store into *TERMINATOR the + input byte after the number, or EOF if an end-of-file or input + error occurred. Set *OVERFLOW if the number overflows. */ static unsigned -read_hex (FILE *fp, bool *eof, bool *overflow) +read_hex (FILE *fp, int lookahead, int *terminator, bool *overflow) { - int c; - unsigned n; + int c = lookahead < 0 ? getc_unlocked (fp) : lookahead; - while ((c = getc_unlocked (fp)) != EOF) + while (true) { if (c == '#') - { - while ((c = getc_unlocked (fp)) != EOF && c != '\n'); - } + do + c = getc_unlocked (fp); + while (0 <= c && c != '\n'); else if (c == '0') { - if ((c = getc_unlocked (fp)) == EOF || c == 'x') + c = getc_unlocked (fp); + if (c < 0 || c == 'x') break; } - } - if (c == EOF) - { - *eof = 1; - return 0; - } - n = 0; - while (true) - { - c = getc_unlocked (fp); - int digit = char_hexdigit (c); - if (digit < 0) + if (c < 0) break; - if (INT_LEFT_SHIFT_OVERFLOW (n, 4)) - *overflow = 1; - n = (n << 4) + digit; + c = getc_unlocked (fp); } - if (c != EOF) - ungetc (c, fp); + + unsigned n = 0; + bool v = false; + + if (0 <= c) + while (true) + { + c = getc_unlocked (fp); + int digit = char_hexdigit (c); + if (digit < 0) + break; + v |= INT_LEFT_SHIFT_OVERFLOW (n, 4); + n = (n << 4) + digit; + } + + *terminator = c; + *overflow |= v; return n; } @@ -499,23 +504,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, memset (entries, 0, sizeof (struct charset_map_entries)); n_entries = 0; - while (1) + int ch = -1; + while (true) { - unsigned from, to, c; - int idx; - bool eof = 0, overflow = 0; - - from = read_hex (fp, &eof, &overflow); - if (eof) + bool overflow = false; + unsigned from = read_hex (fp, ch, &ch, &overflow), to; + if (ch < 0) break; - if (getc_unlocked (fp) == '-') - to = read_hex (fp, &eof, &overflow); + if (ch == '-') + { + to = read_hex (fp, -1, &ch, &overflow); + if (ch < 0) + break; + } else - to = from; - if (eof) - break; - c = read_hex (fp, &eof, &overflow); - if (eof) + { + to = from; + ch = -1; + } + unsigned c = read_hex (fp, ch, &ch, &overflow); + if (ch < 0) break; if (overflow) @@ -530,7 +538,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, memset (entries, 0, sizeof (struct charset_map_entries)); n_entries = 0; } - idx = n_entries; + int idx = n_entries; entries->entry[idx].from = from; entries->entry[idx].to = to; entries->entry[idx].c = c; -- cgit v1.2.1 From b8ead34f5df92b771520f4d090ff6cde49ca5705 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 7 Jul 2017 18:12:16 -0700 Subject: Fix more ungetc bugs with encoding errors * src/lread.c (infile): New variable, replacing ... (instream): ... this. All uses changed. (readbyte_from_stdio): New function, which deals with lookahead. (readbyte_from_file, Fget_file_char): Use it. (Fget_file_char): When misused, signal an error instead of relying on undefined behavior. (close_infile_unwind): New function. (Fload): Use it. (readevalloop): 2nd arg is now struct infile *, not FILE *. All callers changed. (read1): Handle lookahead when copying doc strings with encoding errors. --- src/lread.c | 100 ++++++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 71 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/lread.c b/src/lread.c index 44eaf13996a..8e7cd3c5510 100644 --- a/src/lread.c +++ b/src/lread.c @@ -103,8 +103,20 @@ static Lisp_Object read_objects_map; (to reduce allocations), or nil. */ static Lisp_Object read_objects_completed; -/* File for get_file_char to read from. Use by load. */ -static FILE *instream; +/* File and lookahead for get-file-char and get-emacs-mule-file-char + to read from. Used by Fload. */ +static struct infile +{ + /* The input stream. */ + FILE *stream; + + /* Lookahead byte count. */ + signed char lookahead; + + /* Lookahead bytes, in reverse order. Keep these here because it is + not portable to ungetc more than one byte at a time. */ + unsigned char buf[MAX_MULTIBYTE_LENGTH - 1]; +} *infile; /* For use within read-from-string (this reader is non-reentrant!!) */ static ptrdiff_t read_from_string_index; @@ -149,7 +161,7 @@ static Lisp_Object Vloads_in_progress; static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), Lisp_Object); -static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, +static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); @@ -361,8 +373,9 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n) if (FROM_FILE_P (readcharfun)) { block_input (); /* FIXME: Not sure if it's needed. */ - fseek (instream, n, SEEK_CUR); + fseek (infile->stream, n - infile->lookahead, SEEK_CUR); unblock_input (); + infile->lookahead = 0; } else { /* We're not reading directly from a file. In that case, it's difficult @@ -384,8 +397,9 @@ skip_dyn_eof (Lisp_Object readcharfun) if (FROM_FILE_P (readcharfun)) { block_input (); /* FIXME: Not sure if it's needed. */ - fseek (instream, 0, SEEK_END); + fseek (infile->stream, 0, SEEK_END); unblock_input (); + infile->lookahead = 0; } else while (READCHAR >= 0); @@ -458,15 +472,13 @@ readbyte_for_lambda (int c, Lisp_Object readcharfun) static int -readbyte_from_file (int c, Lisp_Object readcharfun) +readbyte_from_stdio (void) { - if (c >= 0) - { - block_input (); - ungetc (c, instream); - unblock_input (); - return 0; - } + if (infile->lookahead) + return infile->buf[--infile->lookahead]; + + int c; + FILE *instream = infile->stream; block_input (); @@ -485,6 +497,19 @@ readbyte_from_file (int c, Lisp_Object readcharfun) return (c == EOF ? -1 : c); } +static int +readbyte_from_file (int c, Lisp_Object readcharfun) +{ + if (c >= 0) + { + eassert (infile->lookahead < sizeof infile->buf); + infile->buf[infile->lookahead++] = c; + return 0; + } + + return readbyte_from_stdio (); +} + static int readbyte_from_string (int c, Lisp_Object readcharfun) { @@ -507,7 +532,7 @@ readbyte_from_string (int c, Lisp_Object readcharfun) } -/* Read one non-ASCII character from INSTREAM. The character is +/* Read one non-ASCII character from INFILE. The character is encoded in `emacs-mule' and the first byte is already read in C. */ @@ -777,11 +802,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, doc: /* Don't use this yourself. */) (void) { - register Lisp_Object val; - block_input (); - XSETINT (val, getc_unlocked (instream)); - unblock_input (); - return val; + if (!infile) + error ("get-file-char misused"); + return make_number (readbyte_from_stdio ()); } @@ -1026,6 +1049,15 @@ suffix_p (Lisp_Object string, const char *suffix) return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix); } +static void +close_infile_unwind (void *arg) +{ + FILE *stream = arg; + eassert (infile->stream == stream); + infile = NULL; + fclose (stream); +} + DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try @@ -1345,7 +1377,7 @@ Return t if the file exists and loads successfully. */) } if (! stream) report_file_error ("Opening stdio stream", file); - set_unwind_protect_ptr (fd_index, fclose_unwind, stream); + set_unwind_protect_ptr (fd_index, close_infile_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); @@ -1368,19 +1400,23 @@ Return t if the file exists and loads successfully. */) specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); - instream = stream; + struct infile input; + input.stream = stream; + input.lookahead = 0; + infile = &input; + if (lisp_file_lexically_bound_p (Qget_file_char)) Fset (Qlexical_binding, Qt); if (! version || version >= 22) - readevalloop (Qget_file_char, stream, hist_file_name, + readevalloop (Qget_file_char, &input, hist_file_name, 0, Qnil, Qnil, Qnil, Qnil); else { /* We can't handle a file which was compiled with byte-compile-dynamic by older version of Emacs. */ specbind (Qload_force_doc_strings, Qt); - readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, + readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name, 0, Qnil, Qnil, Qnil, Qnil); } unbind_to (count, Qnil); @@ -1811,7 +1847,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) static void readevalloop (Lisp_Object readcharfun, - FILE *stream, + struct infile *infile0, Lisp_Object sourcename, bool printflag, Lisp_Object unibyte, Lisp_Object readfun, @@ -1911,7 +1947,7 @@ readevalloop (Lisp_Object readcharfun, if (b && first_sexp) whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b)); - instream = stream; + infile = infile0; read_next: c = READCHAR; if (c == ';') @@ -2001,7 +2037,7 @@ readevalloop (Lisp_Object readcharfun, } build_load_history (sourcename, - stream || whole_buffer); + infile0 || whole_buffer); unbind_to (count, Qnil); } @@ -2941,11 +2977,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) saved_doc_string_size = nskip + extra; } - saved_doc_string_position = file_tell (instream); + FILE *instream = infile->stream; + saved_doc_string_position = (file_tell (instream) + - infile->lookahead); - /* Copy that many characters into saved_doc_string. */ + /* Copy that many bytes into saved_doc_string. */ + i = 0; + for (int n = min (nskip, infile->lookahead); 0 < n; n--) + saved_doc_string[i++] + = c = infile->buf[--infile->lookahead]; block_input (); - for (i = 0; i < nskip && c >= 0; i++) + for (; i < nskip && 0 <= c; i++) saved_doc_string[i] = c = getc_unlocked (instream); unblock_input (); -- cgit v1.2.1 From 92307cb05d8b0d05dab7981f30c13962f8050eb0 Mon Sep 17 00:00:00 2001 From: Alexander Kuleshov Date: Sat, 8 Jul 2017 11:15:52 +0300 Subject: Avoid compiler warnings in xdisp.c debugging code * src/xdisp.c (dump_glyph, dump_glyph_row, Fdump_glyph_matrix): Use pD directives for ptrdiff_t values instead of pI, to avoid compilation warnings on 64-bit hosts. (Bug#27597) --- src/xdisp.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index fad23bfdc9d..5df2dd18311 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19149,7 +19149,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) || glyph->type == GLYPHLESS_GLYPH) { fprintf (stderr, - " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", + " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], (glyph->type == CHAR_GLYPH ? 'C' @@ -19174,7 +19174,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) else if (glyph->type == STRETCH_GLYPH) { fprintf (stderr, - " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", + " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], 'S', glyph->charpos, @@ -19195,7 +19195,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) else if (glyph->type == IMAGE_GLYPH) { fprintf (stderr, - " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", + " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", glyph - row->glyphs[TEXT_AREA], 'I', glyph->charpos, @@ -19216,7 +19216,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) else if (glyph->type == COMPOSITE_GLYPH) { fprintf (stderr, - " %5"pD"d %c %9"pI"d %c %3d 0x%06x", + " %5"pD"d %c %9"pD"d %c %3d 0x%06x", glyph - row->glyphs[TEXT_AREA], '+', glyph->charpos, @@ -19277,7 +19277,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs) fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n"); fprintf (stderr, "==============================================================================\n"); - fprintf (stderr, "%3d %9"pI"d %9"pI"d %4d %1.1d%1.1d%1.1d%1.1d\ + fprintf (stderr, "%3d %9"pD"d %9"pD"d %4d %1.1d%1.1d%1.1d%1.1d\ %1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n", vpos, MATRIX_ROW_START_CHARPOS (row), @@ -19306,7 +19306,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs) fprintf (stderr, " %9"pD"d %9"pD"d\t%5d\n", row->start.overlay_string_index, row->end.overlay_string_index, row->continuation_lines_width); - fprintf (stderr, " %9"pI"d %9"pI"d\n", + fprintf (stderr, " %9"pD"d %9"pD"d\n", CHARPOS (row->start.string_pos), CHARPOS (row->end.string_pos)); fprintf (stderr, " %9d %9d\n", row->start.dpvec_index, @@ -19383,7 +19383,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */) struct window *w = XWINDOW (selected_window); struct buffer *buffer = XBUFFER (w->contents); - fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n", + fprintf (stderr, "PT = %"pD"d, BEGV = %"pD"d. ZV = %"pD"d\n", BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer)); fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n", w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos); -- cgit v1.2.1 From b7dab24b7953f7a31b806f83e15043c94aaa7745 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 4 Jul 2017 22:50:46 +0200 Subject: Module assertions: check for garbage collections It's technically possible to write a user pointer finalizer that calls into Emacs module functions. This would be disastrous because it would allow arbitrary Lisp code to run during garbage collection. Therefore extend the module assertions to check for this case. * src/emacs-module.c (module_assert_thread): Also check whether a garbage collection is in progress. * test/data/emacs-module/mod-test.c (invalid_finalizer) (Fmod_test_invalid_finalizer): New test module functions. (emacs_module_init): Register new test function. * test/src/emacs-module-tests.el (module--test-assertion) (module--with-temp-directory): New helper macros. (module--test-assertions--load-non-live-object): Rename existing unit test, use helper macros. (module--test-assertions--call-emacs-from-gc): New unit test. --- src/emacs-module.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/emacs-module.c b/src/emacs-module.c index 7b1a402eeff..b80aa23abce 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -817,9 +817,11 @@ in_current_thread (void) static void module_assert_thread (void) { - if (! module_assertions || in_current_thread ()) + if (! module_assertions || (in_current_thread () && ! gc_in_progress)) return; - module_abort ("Module function called from outside the current Lisp thread"); + module_abort (gc_in_progress ? + "Module function called during garbage collection" : + "Module function called from outside the current Lisp thread"); } static void -- cgit v1.2.1 From e15784fbbbd11f3c5edd5d64aa5529e7afbf2ec1 Mon Sep 17 00:00:00 2001 From: Alexander Kuleshov Date: Sun, 9 Jul 2017 09:11:57 +0200 Subject: Define internal_border_parts for window systems only (Bug#27615) * src/keyboard.c: (internal_border_parts): Define only when HAVE_WINDOW_SYSTEM is enabled. (Bug#27615) --- src/keyboard.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/keyboard.c b/src/keyboard.c index 9e90899c569..804af85dad9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5127,6 +5127,7 @@ static short const scroll_bar_parts[] = { SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) }; +#ifdef HAVE_WINDOW_SYSTEM /* An array of symbol indexes of internal border parts, indexed by an enum internal_border_part value. Note that Qnil corresponds to internal_border_part_none and should not appear in Lisp events. */ @@ -5137,6 +5138,7 @@ static short const internal_border_parts[] = { SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge), SYMBOL_INDEX (Qbottom_left_corner) }; +#endif /* A vector, indexed by button number, giving the down-going location of currently depressed buttons, both scroll bar and non-scroll bar. -- cgit v1.2.1 From b2aef8122ad1404854728615ca03a7f3cd3f93a3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 9 Jul 2017 13:43:45 +0200 Subject: ; * src/emacs-module.c (module_assert_thread): Simplify. --- src/emacs-module.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/emacs-module.c b/src/emacs-module.c index b80aa23abce..c5e56b1344c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -817,11 +817,13 @@ in_current_thread (void) static void module_assert_thread (void) { - if (! module_assertions || (in_current_thread () && ! gc_in_progress)) + if (!module_assertions) return; - module_abort (gc_in_progress ? - "Module function called during garbage collection" : - "Module function called from outside the current Lisp thread"); + if (!in_current_thread ()) + module_abort ("Module function called from outside " + "the current Lisp thread"); + if (gc_in_progress) + module_abort ("Module function called during garbage collection"); } static void -- cgit v1.2.1 From 83218cf4c34c3593b4d58bd68d1f280cb3e6634b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 9 Jul 2017 17:37:23 +0300 Subject: Speed up display of line numbers for very large buffers * src/xdisp.c (maybe_produce_line_number): Speed up line counting using values cached by mode-line display of line numbers. (Bug#27622) --- src/xdisp.c | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 5df2dd18311..28ed7685236 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20823,7 +20823,6 @@ maybe_produce_line_number (struct it *it) ptrdiff_t start_from, bytepos; ptrdiff_t this_line; bool first_time = false; - ptrdiff_t beg = display_line_numbers_widen ? BEG : BEGV; ptrdiff_t beg_byte = display_line_numbers_widen ? BEG_BYTE : BEGV_BYTE; ptrdiff_t z_byte = display_line_numbers_widen ? Z_BYTE : ZV_BYTE; void *itdata = bidi_shelve_cache (); @@ -20834,8 +20833,21 @@ maybe_produce_line_number (struct it *it) { if (!last_line) { - /* FIXME: Maybe reuse the data in it->w->base_line_number. */ - start_from = beg; + /* If possible, reuse data cached by line-number-mode. */ + if (it->w->base_line_number > 0 + && it->w->base_line_pos > 0 + && it->w->base_line_pos <= IT_CHARPOS (*it) + /* line-number-mode always displays narrowed line + numbers, so we cannot use its data if the user wants + line numbers that disregard narrowing. */ + && !(display_line_numbers_widen + && (BEG_BYTE != BEGV_BYTE || Z_BYTE != ZV_BYTE))) + { + start_from = CHAR_TO_BYTE (it->w->base_line_pos); + last_line = it->w->base_line_number - 1; + } + else + start_from = beg_byte; if (!it->lnum_bytepos) first_time = true; } @@ -20845,7 +20857,7 @@ maybe_produce_line_number (struct it *it) /* Paranoia: what if someone changes the narrowing since the last time display_line was called? Shouldn't really happen, but who knows what some crazy Lisp invoked by :eval could do? */ - if (!(beg_byte <= start_from && start_from < z_byte)) + if (!(beg_byte <= start_from && start_from <= z_byte)) { last_line = 0; start_from = beg_byte; -- cgit v1.2.1 From 51b29de1593c88ad801597ed840814616d16ef37 Mon Sep 17 00:00:00 2001 From: Saulius Menkevičius Date: Sun, 9 Jul 2017 21:16:17 +0300 Subject: Avoid crashes on MS-Windows starting 64-bit .NET executables * src/w32proc.c (w32_executable_type): Don't assume that the import directory in a DLL will always be non-NULL. (Bug#27527) Copyright-paperwork-exempt: yes --- src/w32proc.c | 63 ++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 34 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/w32proc.c b/src/w32proc.c index 0aa248a6f7b..76af55f9985 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1622,38 +1622,43 @@ w32_executable_type (char * filename, /* Look for Cygwin DLL in the DLL import list. */ IMAGE_DATA_DIRECTORY import_dir = data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT]; - IMAGE_IMPORT_DESCRIPTOR * imports = - RVA_TO_PTR (import_dir.VirtualAddress, - rva_to_section (import_dir.VirtualAddress, - nt_header), - executable); - for ( ; imports->Name; imports++) - { - IMAGE_SECTION_HEADER * section = - rva_to_section (imports->Name, nt_header); - char * dllname = RVA_TO_PTR (imports->Name, section, - executable); - - /* The exact name of the Cygwin DLL has changed with - various releases, but hopefully this will be - reasonably future-proof. */ - if (strncmp (dllname, "cygwin", 6) == 0) - { - *is_cygnus_app = TRUE; - break; - } - else if (strncmp (dllname, "msys-", 5) == 0) + /* Import directory can be missing in .NET DLLs. */ + if (import_dir.VirtualAddress != 0) + { + IMAGE_IMPORT_DESCRIPTOR * imports = + RVA_TO_PTR (import_dir.VirtualAddress, + rva_to_section (import_dir.VirtualAddress, + nt_header), + executable); + + for ( ; imports->Name; imports++) { - /* This catches both MSYS 1.x and MSYS2 - executables (the DLL name is msys-1.0.dll and - msys-2.0.dll, respectively). There doesn't - seem to be a reason to distinguish between - the two, for now. */ - *is_msys_app = TRUE; - break; + IMAGE_SECTION_HEADER * section = + rva_to_section (imports->Name, nt_header); + char * dllname = RVA_TO_PTR (imports->Name, section, + executable); + + /* The exact name of the Cygwin DLL has changed with + various releases, but hopefully this will be + reasonably future-proof. */ + if (strncmp (dllname, "cygwin", 6) == 0) + { + *is_cygnus_app = TRUE; + break; + } + else if (strncmp (dllname, "msys-", 5) == 0) + { + /* This catches both MSYS 1.x and MSYS2 + executables (the DLL name is msys-1.0.dll and + msys-2.0.dll, respectively). There doesn't + seem to be a reason to distinguish between + the two, for now. */ + *is_msys_app = TRUE; + break; + } } - } + } } } } -- cgit v1.2.1 From 22af69906cca871fdb893e06d6f10dbbab4518e6 Mon Sep 17 00:00:00 2001 From: Valentin Gatien-Baron Date: Mon, 10 Jul 2017 00:08:52 +0200 Subject: Fix bug in module_free_global_ref (Bug#27587) * src/emacs-module.c (module_free_global_ref): Actually remove entry from hash table. Copyright-paperwork-exempt: yes --- src/emacs-module.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/emacs-module.c b/src/emacs-module.c index c5e56b1344c..ba996982604 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -328,7 +328,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) set_hash_value_slot (h, i, value); } else - hash_remove_from_table (h, value); + hash_remove_from_table (h, obj); } if (module_assertions) -- cgit v1.2.1 From 81131ff26fe2a36c2ed0a4853d85af3bcb8bbdb1 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 10 Jul 2017 00:28:50 +0200 Subject: Re-add a useful assertion * src/emacs-module.c (module_free_global_ref): Re-add assertion that the reference count is zero. This assertion was removed in commit 8afaa1321f8088bfb877fe4b6676e8517adb0bb7, but it's not included in the test performed by XFASTINT before, because the previous reference count could have been zero already in the case of a buggy implementation. This assertion might have detected Bug#27587. --- src/emacs-module.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/emacs-module.c b/src/emacs-module.c index ba996982604..7e0ba3c16c1 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -328,7 +328,10 @@ module_free_global_ref (emacs_env *env, emacs_value ref) set_hash_value_slot (h, i, value); } else - hash_remove_from_table (h, obj); + { + eassert (refcount == 0); + hash_remove_from_table (h, obj); + } } if (module_assertions) -- cgit v1.2.1 From ce6773aad5c71f6c486244a6fc9fcb69fc99784d Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 10 Jul 2017 00:33:30 +0200 Subject: Minor simplification of module_free_global_ref * src/emacs-module.c (module_free_global_ref): Remove unused variable 'hashcode'. Inline variable 'value' that's only used once. --- src/emacs-module.c | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/emacs-module.c b/src/emacs-module.c index 7e0ba3c16c1..ad6c8fb0104 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -315,18 +315,13 @@ module_free_global_ref (emacs_env *env, emacs_value ref) MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object obj = value_to_lisp (ref); - EMACS_UINT hashcode; - ptrdiff_t i = hash_lookup (h, obj, &hashcode); + ptrdiff_t i = hash_lookup (h, obj, NULL); if (i >= 0) { - Lisp_Object value = HASH_VALUE (h, i); - EMACS_INT refcount = XFASTINT (value) - 1; + EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1; if (refcount > 0) - { - value = make_natnum (refcount); - set_hash_value_slot (h, i, value); - } + set_hash_value_slot (h, i, make_natnum (refcount)); else { eassert (refcount == 0); -- cgit v1.2.1 From 083940a93df17c6e50d6523e30d56ca3d179f688 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 9 Jul 2017 16:04:02 -0700 Subject: Fix core dump in substitute-object-in-subtree Without this fix, (substitute-object-in-subtree #0=(#0# 'a) 'a) would dump core, since the C code would recurse indefinitely through the infinite structure. This patch adds an argument to the function, and renames it to lread--substitute-object-in-subtree as the function is not general-purpose and should not be relied on by outside code. See Bug#23660. * src/intervals.c (traverse_intervals_noorder): ARG is now void *, not Lisp_Object, so that callers need not cons unnecessarily. All callers changed. Also, remove related #if-0 code that was “temporary” in the early 1990s and has not been compilable for some time. * src/lread.c (struct subst): New type, for substitution closure data. (seen_list): Remove this static var, as this info is now part of struct subst. All uses removed. (Flread__substitute_object_in_subtree): Rename from Fsubstitute_object_in_subtree, and give it a 3rd arg so that it doesn’t dump core when called from the top level with an already-cyclic structure. All callers changed. (SUBSTITUTE): Remove. All callers expanded and then simplified. (substitute_object_recurse): Take a single argument SUBST rather than a pair OBJECT and PLACEHOLDER, so that its address can be passed around as part of a closure; this avoids the need for an AUTO_CONS call. All callers changed. If the COMPLETED component is t, treat every subobject as potentially circular. (substitute_in_interval): Take a struct subst * rather than a Lisp_Object, for the closure data. All callers changed. * test/src/lread-tests.el (lread-lread--substitute-object-in-subtree): New test, to check that the core dump does not reoccur. --- src/alloc.c | 4 +-- src/intervals.c | 66 ++-------------------------------- src/intervals.h | 3 +- src/lread.c | 110 +++++++++++++++++++++++--------------------------------- src/print.c | 6 ++-- 5 files changed, 53 insertions(+), 136 deletions(-) (limited to 'src') diff --git a/src/alloc.c b/src/alloc.c index ac3de83b2b6..2d785d5b9a4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1553,7 +1553,7 @@ make_interval (void) /* Mark Lisp objects in interval I. */ static void -mark_interval (register INTERVAL i, Lisp_Object dummy) +mark_interval (INTERVAL i, void *dummy) { /* Intervals should never be shared. So, if extra internal checking is enabled, GC aborts if it seems to have visited an interval twice. */ @@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy) #define MARK_INTERVAL_TREE(i) \ do { \ if (i && !i->gcmarkbit) \ - traverse_intervals_noorder (i, mark_interval, Qnil); \ + traverse_intervals_noorder (i, mark_interval, NULL); \ } while (0) /*********************************************************************** diff --git a/src/intervals.c b/src/intervals.c index d17d80ac865..0089ecb8dde 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) Pass FUNCTION two args: an interval, and ARG. */ void -traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) +traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *), + void *arg) { /* Minimize stack usage. */ while (tree) @@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position, } } -#if 0 - -static int icount; -static int idepth; -static int zero_length; - -/* These functions are temporary, for debugging purposes only. */ - -INTERVAL search_interval, found_interval; - -void -check_for_interval (INTERVAL i) -{ - if (i == search_interval) - { - found_interval = i; - icount++; - } -} - -INTERVAL -search_for_interval (INTERVAL i, INTERVAL tree) -{ - icount = 0; - search_interval = i; - found_interval = NULL; - traverse_intervals_noorder (tree, &check_for_interval, Qnil); - return found_interval; -} - -static void -inc_interval_count (INTERVAL i) -{ - icount++; - if (LENGTH (i) == 0) - zero_length++; - if (depth > idepth) - idepth = depth; -} - -int -count_intervals (INTERVAL i) -{ - icount = 0; - idepth = 0; - zero_length = 0; - traverse_intervals_noorder (i, &inc_interval_count, Qnil); - - return icount; -} - -static INTERVAL -root_interval (INTERVAL interval) -{ - register INTERVAL i = interval; - - while (! ROOT_INTERVAL_P (i)) - i = INTERVAL_PARENT (i); - - return i; -} -#endif - /* Assuming that a left child exists, perform the following operation: A B diff --git a/src/intervals.h b/src/intervals.h index a0da6f37801..9140e0c17ab 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t, void (*) (INTERVAL, Lisp_Object), Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, - void (*) (INTERVAL, Lisp_Object), - Lisp_Object); + void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); extern INTERVAL find_interval (INTERVAL, ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index 8e7cd3c5510..4d1a27d1c1d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -595,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea } +/* An in-progress substitution of OBJECT for PLACEHOLDER. */ +struct subst +{ + Lisp_Object object; + Lisp_Object placeholder; + + /* Hash table of subobjects of OBJECT that might be circular. If + Qt, all such objects might be circular. */ + Lisp_Object completed; + + /* List of subobjects of OBJECT that have already been visited. */ + Lisp_Object seen; +}; + static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object read0 (Lisp_Object); @@ -603,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool); static Lisp_Object read_list (bool, Lisp_Object); static Lisp_Object read_vector (Lisp_Object, bool); -static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, - Lisp_Object); -static void substitute_in_interval (INTERVAL, Lisp_Object); +static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); +static void substitute_in_interval (INTERVAL, void *); /* Get a character from the tty. */ @@ -3107,7 +3120,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Fsubstitute_object_in_subtree (tem, placeholder); + Flread__substitute_object_in_subtree + (tem, placeholder, read_objects_completed); /* ...and #n# will use the real value from now on. */ i = hash_lookup (h, number, &hash); @@ -3513,26 +3527,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } } - -/* List of nodes we've seen during substitute_object_in_subtree. */ -static Lisp_Object seen_list; - -DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, - Ssubstitute_object_in_subtree, 2, 2, 0, - doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */) - (Lisp_Object object, Lisp_Object placeholder) +DEFUN ("lread--substitute-object-in-subtree", + Flread__substitute_object_in_subtree, + Slread__substitute_object_in_subtree, 3, 3, 0, + doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT. +COMPLETED is a hash table of objects that might be circular, or is t +if any object might be circular. */) + (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed) { - Lisp_Object check_object; - - /* We haven't seen any objects when we start. */ - seen_list = Qnil; - - /* Make all the substitutions. */ - check_object - = substitute_object_recurse (object, placeholder, object); - - /* Clear seen_list because we're done with it. */ - seen_list = Qnil; + struct subst subst = { object, placeholder, completed, Qnil }; + Lisp_Object check_object = substitute_object_recurse (&subst, object); /* The returned object here is expected to always eq the original. */ @@ -3541,26 +3545,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, return Qnil; } -/* Feval doesn't get called from here, so no gc protection is needed. */ -#define SUBSTITUTE(get_val, set_val) \ - do { \ - Lisp_Object old_value = get_val; \ - Lisp_Object true_value \ - = substitute_object_recurse (object, placeholder, \ - old_value); \ - \ - if (!EQ (old_value, true_value)) \ - { \ - set_val; \ - } \ - } while (0) - static Lisp_Object -substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) +substitute_object_recurse (struct subst *subst, Lisp_Object subtree) { /* If we find the placeholder, return the target object. */ - if (EQ (placeholder, subtree)) - return object; + if (EQ (subst->placeholder, subtree)) + return subst->object; /* For common object types that can't contain other objects, don't bother looking them up; we're done. */ @@ -3570,15 +3560,16 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj return subtree; /* If we've been to this node before, don't explore it again. */ - if (!EQ (Qnil, Fmemq (subtree, seen_list))) + if (!EQ (Qnil, Fmemq (subtree, subst->seen))) return subtree; /* If this node can be the entry point to a cycle, remember that we've seen it. It can only be such an entry point if it was made by #n=, which means that we can find it as a value in - read_objects_completed. */ - if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0) - seen_list = Fcons (subtree, seen_list); + COMPLETED. */ + if (EQ (subst->completed, Qt) + || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0) + subst->seen = Fcons (subtree, subst->seen); /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ @@ -3605,19 +3596,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj if (SUB_CHAR_TABLE_P (subtree)) i = 2; for ( ; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); + ASET (subtree, i, + substitute_object_recurse (subst, AREF (subtree, i))); return subtree; } case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } + XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree))); + XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree))); + return subtree; case Lisp_String: { @@ -3625,11 +3612,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj substitute_in_interval contains part of the logic. */ INTERVAL root_interval = string_intervals (subtree); - AUTO_CONS (arg, object, placeholder); - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); - + substitute_in_interval, subst); return subtree; } @@ -3641,12 +3625,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Helper function for substitute_object_recurse. */ static void -substitute_in_interval (INTERVAL interval, Lisp_Object arg) +substitute_in_interval (INTERVAL interval, void *arg) { - Lisp_Object object = Fcar (arg); - Lisp_Object placeholder = Fcdr (arg); - - SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value)); + set_interval_plist (interval, + substitute_object_recurse (arg, interval->plist)); } @@ -4744,7 +4726,7 @@ syms_of_lread (void) { defsubr (&Sread); defsubr (&Sread_from_string); - defsubr (&Ssubstitute_object_in_subtree); + defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); @@ -5057,8 +5039,6 @@ that are loaded before your customizations are read! */); read_objects_map = Qnil; staticpro (&read_objects_completed); read_objects_completed = Qnil; - staticpro (&seen_list); - seen_list = Qnil; Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); diff --git a/src/print.c b/src/print.c index 50c75d7712c..b6ea3ff62a5 100644 --- a/src/print.c +++ b/src/print.c @@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname) static void print (Lisp_Object, Lisp_Object, bool); static void print_preprocess (Lisp_Object); -static void print_preprocess_string (INTERVAL, Lisp_Object); +static void print_preprocess_string (INTERVAL, void *); static void print_object (Lisp_Object, Lisp_Object, bool); DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, @@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj) case Lisp_String: /* A string may have text properties, which can be circular. */ traverse_intervals_noorder (string_intervals (obj), - print_preprocess_string, Qnil); + print_preprocess_string, NULL); break; case Lisp_Cons: @@ -1263,7 +1263,7 @@ Fills `print-number-table'. */) } static void -print_preprocess_string (INTERVAL interval, Lisp_Object arg) +print_preprocess_string (INTERVAL interval, void *arg) { print_preprocess (interval->plist); } -- cgit v1.2.1 From 0bece6c6815cc59e181817a2765a4ea752f34f56 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Fri, 7 Jul 2017 21:21:55 +0200 Subject: Add an optional testfn parameter to assoc * src/fns.c (assoc): New optional testfn parameter used for comparison when provided. * test/src/fns-tests.el (test-assoc-testfn): Add tests for the new 'testfn' parameter. * src/buffer.c: * src/coding.c: * src/dbusbind.c: * src/font.c: * src/fontset.c: * src/gfilenotify.c: * src/image.c: * src/keymap.c: * src/process.c: * src/w32fns.c: * src/w32font.c: * src/w32notify.c: * src/w32term.c: * src/xdisp.c: * src/xfont.c: Add a third argument to Fassoc calls. * etc/NEWS: * doc/lispref/lists.texi: Document the new 'testfn' parameter. --- src/buffer.c | 2 +- src/coding.c | 6 +++--- src/dbusbind.c | 6 +++--- src/fns.c | 15 ++++++++++----- src/font.c | 2 +- src/fontset.c | 2 +- src/gfilenotify.c | 2 +- src/image.c | 2 +- src/keymap.c | 2 +- src/process.c | 2 +- src/w32fns.c | 2 +- src/w32font.c | 2 +- src/w32notify.c | 4 ++-- src/w32term.c | 2 +- src/xdisp.c | 6 +++--- src/xfont.c | 3 ++- 16 files changed, 33 insertions(+), 27 deletions(-) (limited to 'src') diff --git a/src/buffer.c b/src/buffer.c index 780e4d7a7d6..e0972aac33c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1164,7 +1164,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, BVAR (buf, local_var_alist)); + result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil); if (!NILP (result)) { if (blv->fwd) diff --git a/src/coding.c b/src/coding.c index 5682fc015ad..50ad206be69 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10539,7 +10539,7 @@ usage: (define-coding-system-internal ...) */) ASET (this_spec, 2, this_eol_type); Fputhash (this_name, this_spec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (this_name, Vcoding_system_list); - val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (this_name), Qnil), @@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */) Fputhash (name, spec_vec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (name, Vcoding_system_list); - val = Fassoc (Fsymbol_name (name), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil), Vcoding_system_alist); @@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, Fputhash (alias, spec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (alias, Vcoding_system_list); - val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil), Vcoding_system_alist); diff --git a/src/dbusbind.c b/src/dbusbind.c index d2460fd886e..0d9d3e514fd 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -955,7 +955,7 @@ xd_get_connection_address (Lisp_Object bus) DBusConnection *connection; Lisp_Object val; - val = CDR_SAFE (Fassoc (bus, xd_registered_buses)); + val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil)); if (NILP (val)) XD_SIGNAL2 (build_string ("No connection to bus"), bus); else @@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus) Lisp_Object busobj; /* Check whether we are connected. */ - val = Fassoc (bus, xd_registered_buses); + val = Fassoc (bus, xd_registered_buses, Qnil); if (NILP (val)) return; @@ -1127,7 +1127,7 @@ this connection to those buses. */) xd_close_bus (bus); /* Check, whether we are still connected. */ - val = Fassoc (bus, xd_registered_buses); + val = Fassoc (bus, xd_registered_buses, Qnil); if (!NILP (val)) { connection = xd_get_connection_address (bus); diff --git a/src/fns.c b/src/fns.c index 6610d2a6d0e..f0e10e311f5 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1417,17 +1417,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list) return Qnil; } -DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, - doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. -The value is actually the first element of LIST whose car equals KEY. */) - (Lisp_Object key, Lisp_Object list) +DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0, + doc: /* Return non-nil if KEY is equal to the car of an element of LIST. +The value is actually the first element of LIST whose car equals KEY. + +Equality is defined by TESTFN if non-nil or by `equal' if nil. */) + (Lisp_Object key, Lisp_Object list, Lisp_Object testfn) { Lisp_Object tail = list; FOR_EACH_TAIL (tail) { Lisp_Object car = XCAR (tail); if (CONSP (car) - && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + && (NILP (testfn) + ? (EQ (XCAR (car), key) || !NILP (Fequal + (XCAR (car), key))) + : !NILP (call2 (testfn, XCAR (car), key)))) return car; } CHECK_LIST_END (tail, list); diff --git a/src/font.c b/src/font.c index 5a3f271ef85..a5e5b6a5b9d 100644 --- a/src/font.c +++ b/src/font.c @@ -1893,7 +1893,7 @@ otf_tag_symbol (OTF_Tag tag) static OTF * otf_open (Lisp_Object file) { - Lisp_Object val = Fassoc (file, otf_list); + Lisp_Object val = Fassoc (file, otf_list, Qnil); OTF *otf; if (! NILP (val)) diff --git a/src/fontset.c b/src/fontset.c index 850558b08a0..74018060b85 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1186,7 +1186,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern) { tem = Frassoc (name, Vfontset_alias_alist); if (NILP (tem)) - tem = Fassoc (name, Vfontset_alias_alist); + tem = Fassoc (name, Vfontset_alias_alist, Qnil); if (CONSP (tem) && STRINGP (XCAR (tem))) name = XCAR (tem); else if (name_pattern == 0) diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 285a253733d..fa4854c664d 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -266,7 +266,7 @@ reason. Removing the watch by calling `gfile-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); + Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (NILP (watch_object)) return Qnil; else diff --git a/src/image.c b/src/image.c index 91749fb8733..1426e309445 100644 --- a/src/image.c +++ b/src/image.c @@ -4231,7 +4231,7 @@ xpm_load_image (struct frame *f, color_val = Qnil; if (!NILP (color_symbols) && !NILP (symbol_color)) { - Lisp_Object specified_color = Fassoc (symbol_color, color_symbols); + Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil); if (CONSP (specified_color) && STRINGP (XCDR (specified_color))) { diff --git a/src/keymap.c b/src/keymap.c index b568f47cba7..db9aa7cbf38 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1292,7 +1292,7 @@ silly_event_symbol_error (Lisp_Object c) base = XCAR (parsed); name = Fsymbol_name (base); /* This alist includes elements such as ("RET" . "\\r"). */ - assoc = Fassoc (name, exclude_keys); + assoc = Fassoc (name, exclude_keys, Qnil); if (! NILP (assoc)) { diff --git a/src/process.c b/src/process.c index abd017bb907..19009515336 100644 --- a/src/process.c +++ b/src/process.c @@ -951,7 +951,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, if (PROCESSP (name)) return name; CHECK_STRING (name); - return Fcdr (Fassoc (name, Vprocess_alist)); + return Fcdr (Fassoc (name, Vprocess_alist, Qnil)); } /* This is how commands for the user decode process arguments. It diff --git a/src/w32fns.c b/src/w32fns.c index b0842b5ee6c..457599fce0e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -467,7 +467,7 @@ if the entry is new. */) block_input (); /* replace existing entry in w32-color-map or add new entry. */ - entry = Fassoc (name, Vw32_color_map); + entry = Fassoc (name, Vw32_color_map, Qnil); if (NILP (entry)) { entry = Fcons (name, rgb); diff --git a/src/w32font.c b/src/w32font.c index 67d2f6d666d..314d7acdcc6 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1627,7 +1627,7 @@ x_to_w32_charset (char * lpcs) Format of each entry is (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)). */ - this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist); + this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil); if (NILP (this_entry)) { diff --git a/src/w32notify.c b/src/w32notify.c index 25205816bae..e8bdef8bdd3 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -642,7 +642,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) /* Remove the watch object from watch list. Do this before freeing the object, do that even if we fail to free it, watch_list is kept free of junk. */ - watch_object = Fassoc (watch_descriptor, watch_list); + watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (!NILP (watch_object)) { watch_list = Fdelete (watch_object, watch_list); @@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the watch by calling `w32notify-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); + Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (!NILP (watch_object)) { diff --git a/src/w32term.c b/src/w32term.c index c37805cb6ca..0f7bb9337f6 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6110,7 +6110,7 @@ x_calc_absolute_position (struct frame *f) list = CDR(list); - geometry = Fassoc (Qgeometry, attributes); + geometry = Fassoc (Qgeometry, attributes, Qnil); if (!NILP (geometry)) { monitor_left = Fnth (make_number (1), geometry); diff --git a/src/xdisp.c b/src/xdisp.c index 28ed7685236..abca6a8137a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -23314,7 +23314,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, props = oprops; } - aelt = Fassoc (elt, mode_line_proptrans_alist); + aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil); if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt)))) { /* AELT is what we want. Move it to the front @@ -28788,7 +28788,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg) /* By default, set up the blink-off state depending on the on-state. */ - tem = Fassoc (arg, Vblink_cursor_alist); + tem = Fassoc (arg, Vblink_cursor_alist, Qnil); if (!NILP (tem)) { FRAME_BLINK_OFF_CURSOR (f) @@ -28926,7 +28926,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Cursor is blinked off, so determine how to "toggle" it. */ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ - if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) + if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor))) return get_specified_cursor_type (XCDR (alt_cursor), width); /* Then see if frame has specified a specific blink off cursor type. */ diff --git a/src/xfont.c b/src/xfont.c index b73596ce7ce..85fccf0dafd 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -505,7 +505,8 @@ xfont_list (struct frame *f, Lisp_Object spec) Lisp_Object alter; if ((alter = Fassoc (SYMBOL_NAME (registry), - Vface_alternative_font_registry_alist), + Vface_alternative_font_registry_alist, + Qnil), CONSP (alter))) { /* Pointer to REGISTRY-ENCODING field. */ -- cgit v1.2.1 From 373cef5fe19d72c3549495e566e3ac0996215f14 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 11 Jul 2017 18:08:46 +0300 Subject: Improve documentation of display-line-numbers * src/xdisp.c (syms_of_xdisp) : Improve the doc string. Suggested by Alex . --- src/xdisp.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index abca6a8137a..eb7a9e5f09a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32686,7 +32686,12 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, doc: /* Non-nil means display line numbers. -By default, line numbers are displayed before each non-continuation +If the value is t, display absolute line numbers starting at the +beginning of the current narrowing, or at buffer beginning. +If the value is `relative', display line numbers relative to the +line showing point. +The value `visual' counts screen lines rather than physical line: +by default, line numbers are displayed before each non-continuation line that displays buffer text, i.e. after each newline that came from buffer text. However, if the value is `visual', every screen line will have a number. -- cgit v1.2.1 From 10b876b25b5c65014c5d7f996ae3368ea8fd11b2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 11 Jul 2017 18:11:33 +0300 Subject: ; * src/xdisp.c (syms_of_xdisp) : Copyedits. --- src/xdisp.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index eb7a9e5f09a..91e9d8abcee 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32690,11 +32690,11 @@ If the value is t, display absolute line numbers starting at the beginning of the current narrowing, or at buffer beginning. If the value is `relative', display line numbers relative to the line showing point. -The value `visual' counts screen lines rather than physical line: -by default, line numbers are displayed before each non-continuation -line that displays buffer text, i.e. after each newline that came -from buffer text. However, if the value is `visual', every screen -line will have a number. +The value `visual' countse lative screen lines rather than +physical line: by default, line numbers are displayed before each +non-continuation line that displays buffer text, i.e. after each +newline that came from buffer text. However, if the value is `visual', +every screen line will have a number. Lisp programs can disable display of a line number of a particular screen line by putting the `display-line-numbers-disable' text -- cgit v1.2.1 From 4ddff36f6a19492894296e1a2d89c362bf879906 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 12 Jul 2017 17:49:21 +0300 Subject: Avoid assertion violations in close_infile_unwind * src/lread.c (close_infile_unwind): A temporary band-aid solution for bug#27642: allow 'infile' be NULL. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/lread.c b/src/lread.c index 4d1a27d1c1d..fe5de382677 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1066,7 +1066,7 @@ static void close_infile_unwind (void *arg) { FILE *stream = arg; - eassert (infile->stream == stream); + eassert (infile == NULL || infile->stream == stream); infile = NULL; fclose (stream); } -- cgit v1.2.1 From 01a98e918de8b6e3cc8664dd99f02715dc41854b Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Wed, 12 Jul 2017 17:35:31 +0200 Subject: Minor tweaks of new line number display variables * src/xdisp.c (Vdisplay_line_numbers): Tweak doc-string. (Vdisplay_line_number_width): Rename to Vdisplay_line_numbers_width. (maybe_produce_line_number): Comply with above rename. * lisp/cus-start.el (standard): * lisp/frame.el (top-level): * etc/NEWS: Comply with renaming of `display-line-number-width' to `display-line-numbers-width'. --- src/xdisp.c | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 91e9d8abcee..6b0532d95f5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20904,8 +20904,8 @@ maybe_produce_line_number (struct it *it) /* Compute the required width if needed. */ if (!it->lnum_width) { - if (NATNUMP (Vdisplay_line_number_width)) - it->lnum_width = XFASTINT (Vdisplay_line_number_width); + if (NATNUMP (Vdisplay_line_numbers_width)) + it->lnum_width = XFASTINT (Vdisplay_line_numbers_width); /* Max line number to be displayed cannot be more than the one corresponding to the last row of the desired matrix. */ @@ -32686,35 +32686,38 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, doc: /* Non-nil means display line numbers. -If the value is t, display absolute line numbers starting at the -beginning of the current narrowing, or at buffer beginning. -If the value is `relative', display line numbers relative to the -line showing point. -The value `visual' countse lative screen lines rather than -physical line: by default, line numbers are displayed before each -non-continuation line that displays buffer text, i.e. after each -newline that came from buffer text. However, if the value is `visual', -every screen line will have a number. +If the value is t, display the absolute number of each line of a buffer +shown in a window. Absolute line numbers count from the beginning of +the current narrowing, or from buffer beginning. If the value is +`relative', display for each line not containing the window's point its +relative number instead, i.e. the number of the line relative to the +line showing the window's point. + +In either case, line numbers are displayed at the beginning of each +non-continuation line that displays buffer text, i.e. after each newline +character that comes from the buffer. The value `visual' is like +`relative' but counts screen lines instead of buffer lines. In practice +this means that continuation lines count as well when calculating the +relative number of a line. Lisp programs can disable display of a line number of a particular -screen line by putting the `display-line-numbers-disable' text -property or overlay property on the first visible character of -that line. */); +buffer line by putting the `display-line-numbers-disable' text property +or overlay property on the first visible character of that line. */); Vdisplay_line_numbers = Qnil; DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); DEFSYM (Qrelative, "relative"); DEFSYM (Qvisual, "visual"); - DEFVAR_LISP ("display-line-number-width", Vdisplay_line_number_width, + DEFVAR_LISP ("display-line-numbers-width", Vdisplay_line_numbers_width, doc: /* Minimum width of space reserved for line number display. A positive number means reserve that many columns for line numbers, even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); - Vdisplay_line_number_width = Qnil; - DEFSYM (Qdisplay_line_number_width, "display-line-number-width"); - Fmake_variable_buffer_local (Qdisplay_line_number_width); + Vdisplay_line_numbers_width = Qnil; + DEFSYM (Qdisplay_line_numbers_width, "display-line-number-width"); + Fmake_variable_buffer_local (Qdisplay_line_numbers_width); DEFVAR_LISP ("display-line-numbers-current-absolute", Vdisplay_line_numbers_current_absolute, -- cgit v1.2.1 From 6fa3176ccae2bd8dcf082b80063c4e2148f5e8fd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 14 Jul 2017 10:53:36 +0300 Subject: Prevent display corruption when display-line-numbers is set * src/xdisp.c (try_window_reusing_current_matrix): If giving up due to display-line-numbers, clear the window's desired glyph matrix before returning, as the following call to try_window will call display_line, which expects rows of the desired matrix cleared. (Bug#27668) --- src/xdisp.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 6b0532d95f5..85b9eae36d1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17655,6 +17655,9 @@ try_window_reusing_current_matrix (struct window *w) if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row)) return false; + /* Clear the desired matrix for the display below. */ + clear_glyph_matrix (w->desired_matrix); + /* Give up if line numbers are being displayed, because reusing the current matrix might use the wrong width for line-number display. */ @@ -17667,9 +17670,6 @@ try_window_reusing_current_matrix (struct window *w) start = start_row->minpos; start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix); - /* Clear the desired matrix for the display below. */ - clear_glyph_matrix (w->desired_matrix); - if (CHARPOS (new_start) <= CHARPOS (start)) { /* Don't use this method if the display starts with an ellipsis -- cgit v1.2.1 From 037d8bdfeb905f0f1f49c5c7ab2deba13c9c6617 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 14 Jul 2017 11:00:25 +0300 Subject: Add assertion related to display-line-numbers * src/xdisp.c (maybe_produce_line_number): Add assertion for the condition regarding IT->glyph_row->used[TEXT_AREA] expected by the code. (Bug#27668) --- src/xdisp.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 85b9eae36d1..2aceb89c003 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21009,6 +21009,8 @@ maybe_produce_line_number (struct it *it) struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; + eassert (it->glyph_row == NULL || it->glyph_row->used[TEXT_AREA] == 0); + for ( ; g < e; g++) { it->current_x += g->pixel_width; -- cgit v1.2.1 From 9dee1c884eb50ba282eb9dd2495c5269add25963 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 14 Jul 2017 04:54:05 -0700 Subject: Improve stack-overflow heuristic on GNU/Linux Problem reported by Steve Kemp (Bug#27585). * src/eval.c (near_C_stack_top): Remove. All uses replaced by current_thread->stack_top. (record_in_backtrace): Set current_thread->stack_top. This is for when the Lisp interpreter calls itself. * src/lread.c (read1): Set current_thread->stack_top. This is for recursive s-expression reads. * src/print.c (print_object): Set current_thread->stack_top. This is for recursive s-expression printing. * src/thread.c (mark_one_thread): Get stack top first. * src/thread.h (struct thread_state.stack_top): Now void *, not char *. --- src/eval.c | 9 +-------- src/lisp.h | 1 - src/lread.c | 1 + src/print.c | 2 +- src/sysdep.c | 2 +- src/thread.c | 10 ++++++---- src/thread.h | 10 ++++++++-- 7 files changed, 18 insertions(+), 17 deletions(-) (limited to 'src') diff --git a/src/eval.c b/src/eval.c index 8f293c9d300..e5900382dee 100644 --- a/src/eval.c +++ b/src/eval.c @@ -213,13 +213,6 @@ backtrace_next (union specbinding *pdl) return pdl; } -/* Return a pointer to somewhere near the top of the C stack. */ -void * -near_C_stack_top (void) -{ - return backtrace_args (backtrace_top ()); -} - void init_eval_once (void) { @@ -2090,7 +2083,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; specpdl_ptr->bt.debug_on_exit = false; specpdl_ptr->bt.function = function; - specpdl_ptr->bt.args = args; + current_thread->stack_top = specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; grow_specpdl (); diff --git a/src/lisp.h b/src/lisp.h index f5cb6c75706..1e8ef7a449a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3874,7 +3874,6 @@ extern Lisp_Object vformat_string (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); extern void un_autoload (Lisp_Object); extern Lisp_Object call_debugger (Lisp_Object arg); -extern void *near_C_stack_top (void); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index fe5de382677..901e40b3489 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2676,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) bool uninterned_symbol = false; bool multibyte; char stackbuf[MAX_ALLOCA]; + current_thread->stack_top = stackbuf; *pch = 0; diff --git a/src/print.c b/src/print.c index b6ea3ff62a5..12edf015892 100644 --- a/src/print.c +++ b/src/print.c @@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 40))]; - + current_thread->stack_top = buf; maybe_quit (); /* Detect circularities and truncate them. */ diff --git a/src/sysdep.c b/src/sysdep.c index b52236769e0..db99f53299c 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1772,7 +1772,7 @@ stack_overflow (siginfo_t *siginfo) /* The known top and bottom of the stack. The actual stack may extend a bit beyond these boundaries. */ char *bot = stack_bottom; - char *top = near_C_stack_top (); + char *top = current_thread->stack_top; /* Log base 2 of the stack heuristic ratio. This ratio is the size of the known stack divided by the size of the guard area past the diff --git a/src/thread.c b/src/thread.c index e3787971a53..1f7ced386d3 100644 --- a/src/thread.c +++ b/src/thread.c @@ -595,14 +595,15 @@ thread_select (select_func *func, int max_fds, fd_set *rfds, static void mark_one_thread (struct thread_state *thread) { - struct handler *handler; - Lisp_Object tem; + /* Get the stack top now, in case mark_specpdl changes it. */ + void *stack_top = thread->stack_top; mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr); - mark_stack (thread->m_stack_bottom, thread->stack_top); + mark_stack (thread->m_stack_bottom, stack_top); - for (handler = thread->m_handlerlist; handler; handler = handler->next) + for (struct handler *handler = thread->m_handlerlist; + handler; handler = handler->next) { mark_object (handler->tag_or_ch); mark_object (handler->val); @@ -610,6 +611,7 @@ mark_one_thread (struct thread_state *thread) if (thread->m_current_buffer) { + Lisp_Object tem; XSETBUFFER (tem, thread->m_current_buffer); mark_object (tem); } diff --git a/src/thread.h b/src/thread.h index 9e94de5c175..52b16f1ba83 100644 --- a/src/thread.h +++ b/src/thread.h @@ -62,8 +62,14 @@ struct thread_state char *m_stack_bottom; #define stack_bottom (current_thread->m_stack_bottom) - /* An address near the top of the stack. */ - char *stack_top; + /* The address of an object near the C stack top, used to determine + which words need to be scanned by the garbage collector. This is + also used to detect heuristically whether segmentation violation + address indicates stack overflow, as opposed to some internal + error in Emacs. If the C function F calls G which calls H which + calls ... F, then at least one of the functions in the chain + should set this to the address of a local variable. */ + void *stack_top; struct catchtag *m_catchlist; #define catchlist (current_thread->m_catchlist) -- cgit v1.2.1 From 583995c62dd424775dda33d5134ce04bee2ae685 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Fri, 14 Jul 2017 11:04:19 -0400 Subject: GnuTLS HMAC and symmetric cipher support * etc/NEWS: Add news for new feature. * doc/lispref/text.texi (GnuTLS Cryptography): Add documentation. * configure.ac: Add macros HAVE_GNUTLS3_DIGEST, HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_AEAD, HAVE_GNUTLS3_HMAC. * src/fns.c (Fsecure_hash_algorithms): Add function to list supported `secure-hash' algorithms. (extract_data_from_object): Add data extraction function that can operate on buffers and strings. (secure_hash): Use it. (Fsecure_hash): Mention `secure-hash-algorithms'. * src/gnutls.h: Include gnutls/crypto.h. * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead) (gnutls_symmetric, Fgnutls_symmetric_encrypt, Fgnutls_symmetric_decrypt) (Fgnutls_macs, Fgnutls_digests, Fgnutls_hash_mac, Fgnutls_hash_digest) (Fgnutls_available_p): Implement GnuTLS cryptographic integration. * test/lisp/net/gnutls-tests.el: Add tests. --- src/fns.c | 134 +++++++++--- src/gnutls.c | 674 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- src/gnutls.h | 4 + src/lisp.h | 3 + 4 files changed, 786 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/fns.c b/src/fns.c index f0e10e311f5..8b7fc0f89d8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -35,12 +35,17 @@ along with GNU Emacs. If not, see . */ #include "intervals.h" #include "window.h" #include "puresize.h" +#include "gnutls.h" static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); +static Lisp_Object +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */ @@ -4740,22 +4745,47 @@ make_digest_string (Lisp_Object digest, int digest_size) return digest; } -/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ +DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, + Ssecure_hash_algorithms, 0, 0, 0, + doc: /* Return a list of all the supported `secure_hash' algorithms. */) + (void) +{ + return listn (CONSTYPE_HEAP, 6, + Qmd5, + Qsha1, + Qsha224, + Qsha256, + Qsha384, + Qsha512); +} -static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, - Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, - Lisp_Object binary) +/* Extract data from a string or a buffer. SPEC is a list of +(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as +specified with `secure-hash' and in Info node +`(elisp)Format of GnuTLS Cryptography Inputs'. */ +const char* +extract_data_from_object (Lisp_Object spec, + ptrdiff_t *start_byte, + ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; + ptrdiff_t size, start_char = 0, end_char = 0; register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; - int digest_size; - void *(*hash_func) (const char *, size_t, void *); - Lisp_Object digest; - CHECK_SYMBOL (algorithm); + Lisp_Object object = XCAR (spec); + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil; if (STRINGP (object)) { @@ -4786,12 +4816,12 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, size = SCHARS (object); validate_subarray (object, start, end, size, &start_char, &end_char); - start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); - end_byte = (end_char == size - ? SBYTES (object) - : string_char_to_byte (object, end_char)); + *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); + *end_byte = (end_char == size + ? SBYTES (object) + : string_char_to_byte (object, end_char)); } - else + else if (BUFFERP (object)) { struct buffer *prev = current_buffer; @@ -4892,10 +4922,56 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); - start_byte = 0; - end_byte = SBYTES (object); + *start_byte = 0; + *end_byte = SBYTES (object); + } + else if (EQ (object, Qiv_auto)) + { +#ifdef HAVE_GNUTLS3 + // Format: (iv-auto REQUIRED-LENGTH) + + if (! INTEGERP (start)) + error ("Without a length, iv-auto can't be used. See manual."); + else + { + /* Make sure the value of "start" doesn't change. */ + size_t start_hold = XUINT (start); + object = make_uninit_string (start_hold); + gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); + + *start_byte = 0; + *end_byte = start_hold; + } +#else + error ("GnuTLS integration is not available, so iv-auto can't be used."); +#endif } + return SSDATA (object); +} + + +/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ + +static Lisp_Object +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary) +{ + ptrdiff_t start_byte, end_byte; + int digest_size; + void *(*hash_func) (const char *, size_t, void *); + Lisp_Object digest; + + CHECK_SYMBOL (algorithm); + + Lisp_Object spec = list5 (object, start, end, coding_system, noerror); + + const char* input = extract_data_from_object (spec, &start_byte, &end_byte); + + if (input == NULL) + error ("secure_hash: failed to extract data from object, aborting!"); + if (EQ (algorithm, Qmd5)) { digest_size = MD5_DIGEST_SIZE; @@ -4933,7 +5009,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, hexified value */ digest = make_uninit_string (digest_size * 2); - hash_func (SSDATA (object) + start_byte, + hash_func (input + start_byte, end_byte - start_byte, SSDATA (digest)); @@ -4984,6 +5060,8 @@ The two optional arguments START and END are positions specifying for which part of OBJECT to compute the hash. If nil or omitted, uses the whole OBJECT. +The full list of algorithms can be obtained with `secure-hash-algorithms'. + If BINARY is non-nil, returns a string in binary form. */) (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) { @@ -5031,13 +5109,6 @@ disregarding any coding systems. If nil, use the current buffer. */ ) void syms_of_fns (void) { - DEFSYM (Qmd5, "md5"); - DEFSYM (Qsha1, "sha1"); - DEFSYM (Qsha224, "sha224"); - DEFSYM (Qsha256, "sha256"); - DEFSYM (Qsha384, "sha384"); - DEFSYM (Qsha512, "sha512"); - /* Hash table stuff. */ DEFSYM (Qhash_table_p, "hash-table-p"); DEFSYM (Qeq, "eq"); @@ -5074,6 +5145,18 @@ syms_of_fns (void) defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + /* Crypto and hashing stuff. */ + DEFSYM (Qiv_auto, "iv-auto"); + + DEFSYM (Qmd5, "md5"); + DEFSYM (Qsha1, "sha1"); + DEFSYM (Qsha224, "sha224"); + DEFSYM (Qsha256, "sha256"); + DEFSYM (Qsha384, "sha384"); + DEFSYM (Qsha512, "sha512"); + + /* Miscellaneous stuff. */ + DEFSYM (Qstring_lessp, "string-lessp"); DEFSYM (Qprovide, "provide"); DEFSYM (Qrequire, "require"); @@ -5192,6 +5275,7 @@ this variable. */); defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); + defsubr (&Ssecure_hash_algorithms); defsubr (&Ssecure_hash); defsubr (&Sbuffer_hash); defsubr (&Slocale_info); diff --git a/src/gnutls.c b/src/gnutls.c index 2078ad88f28..7a4e92f0d3f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "process.h" #include "gnutls.h" #include "coding.h" +#include "buffer.h" #ifdef HAVE_GNUTLS @@ -1697,24 +1698,660 @@ This function may also return `gnutls-e-again', or #endif /* HAVE_GNUTLS */ +#ifdef HAVE_GNUTLS3 + +DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, + doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. +The alist key is the cipher name. */) + (void) +{ + Lisp_Object ciphers = Qnil; + + const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list (); + for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + { + const gnutls_cipher_algorithm_t gca = gciphers[pos]; + + Lisp_Object cp = listn (CONSTYPE_HEAP, 15, + /* A symbol representing the cipher */ + intern (gnutls_cipher_get_name (gca)), + /* The internally meaningful cipher ID */ + QCcipher_id, + make_number (gca), + /* The type (vs. other GnuTLS objects). */ + QCtype, + Qgnutls_type_cipher, + /* The tag size (nonzero means AEAD). */ + QCcipher_aead_capable, + (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt, + /* The tag size (nonzero means AEAD). */ + QCcipher_tagsize, + make_number (gnutls_cipher_get_tag_size (gca)), + /* The block size */ + QCcipher_blocksize, + make_number (gnutls_cipher_get_block_size (gca)), + /* The key size */ + QCcipher_keysize, + make_number (gnutls_cipher_get_key_size (gca)), + /* IV size */ + QCcipher_ivsize, + make_number (gnutls_cipher_get_iv_size (gca))); + + ciphers = Fcons (cp, ciphers); + } + + return ciphers; +} + +static Lisp_Object +gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, + Lisp_Object cipher, + const char* kdata, size_t ksize, + const char* vdata, size_t vsize, + const char* idata, size_t isize, + Lisp_Object aead_auth) +{ +#ifdef HAVE_GNUTLS3_AEAD + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + int ret = GNUTLS_E_SUCCESS; + Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); + + gnutls_aead_cipher_hd_t acipher; + gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize }; + ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + size_t storage_length = isize + gnutls_cipher_get_tag_size (gca); + USE_SAFE_ALLOCA; + unsigned char *storage = SAFE_ALLOCA (storage_length); + + const char* aead_auth_data = NULL; + size_t aead_auth_size = 0; + + if (!NILP (aead_auth)) + { + if (BUFFERP (aead_auth) || STRINGP (aead_auth)) + aead_auth = list1 (aead_auth); + + CHECK_CONS (aead_auth); + + ptrdiff_t astart_byte, aend_byte; + const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); + + if (adata == NULL) + error ("GnuTLS AEAD cipher auth extraction failed"); + + aead_auth_data = adata; + aead_auth_size = aend_byte - astart_byte; + } + + size_t expected_remainder = 0; + + if (!encrypting) + expected_remainder = gnutls_cipher_get_tag_size (gca); + + if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0) + error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a " + "multiple of the required %ld plus the expected tag remainder %ld", + gnutls_cipher_get_name (gca), desc, + (long) isize, (long) gnutls_cipher_get_block_size (gca), + (long) expected_remainder); + + if (encrypting) + ret = gnutls_aead_cipher_encrypt (acipher, + vdata, vsize, + aead_auth_data, aead_auth_size, + gnutls_cipher_get_tag_size (gca), + idata, isize, + storage, &storage_length); + else + ret = gnutls_aead_cipher_decrypt (acipher, + vdata, vsize, + aead_auth_data, aead_auth_size, + gnutls_cipher_get_tag_size (gca), + idata, isize, + storage, &storage_length); + + if (ret < GNUTLS_E_SUCCESS) + { + memset (storage, 0, storage_length); + SAFE_FREE (); + gnutls_aead_cipher_deinit (acipher); + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS AEAD cipher %s %sion failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + gnutls_aead_cipher_deinit (acipher); + + Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length); + memset (storage, 0, storage_length); + SAFE_FREE (); + return list2 (output, actual_iv); +#else + error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca); +#endif +} + +static Lisp_Object +gnutls_symmetric (bool encrypting, Lisp_Object cipher, + Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) +{ + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (iv) || STRINGP (iv)) + iv = list1 (iv); + + CHECK_CONS (iv); + + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (cipher)) + cipher = intern (SSDATA (cipher)); + + if (SYMBOLP (cipher)) + info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); + else if (INTEGERP (cipher)) + gca = XINT (cipher); + else + info = cipher; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCcipher_id); + if (INTEGERP (v)) + gca = XINT (v); + } + + if (gca == GNUTLS_CIPHER_UNKNOWN) + error ("GnuTLS cipher was invalid or not found"); + + ptrdiff_t kstart_byte, kend_byte; + const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + + if (kdata == NULL) + error ("GnuTLS cipher key extraction failed"); + + if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) + error ("GnuTLS cipher %s/%s key length %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + + ptrdiff_t vstart_byte, vend_byte; + const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); + + if (vdata == NULL) + error ("GnuTLS cipher IV extraction failed"); + + if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) + error ("GnuTLS cipher %s/%s IV length %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + + Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte); + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + + if (idata == NULL) + error ("GnuTLS cipher input extraction failed"); + + /* Is this an AEAD cipher? */ + if (gnutls_cipher_get_tag_size (gca) > 0) + { + Lisp_Object aead_output = + gnutls_symmetric_aead (encrypting, gca, cipher, + kdata, kend_byte - kstart_byte, + vdata, vend_byte - vstart_byte, + idata, iend_byte - istart_byte, + aead_auth); + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + return aead_output; + } + + if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) + error ("GnuTLS cipher %s/%s input block length %ld was not a multiple " + "of the required %ld", + gnutls_cipher_get_name (gca), desc, + iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + + gnutls_cipher_hd_t hcipher; + gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + + ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + /* Note that this will not support streaming block mode. */ + gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte); + + /* + * GnuTLS docs: "For the supported ciphers the encrypted data length + * will equal the plaintext size." + */ + size_t storage_length = iend_byte - istart_byte; + Lisp_Object storage = make_uninit_string (storage_length); + + if (encrypting) + ret = gnutls_cipher_encrypt2 (hcipher, + idata, iend_byte - istart_byte, + SSDATA (storage), storage_length); + else + ret = gnutls_cipher_decrypt2 (hcipher, + idata, iend_byte - istart_byte, + SSDATA (storage), storage_length); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_cipher_deinit (hcipher); + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS cipher %s %sion failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + gnutls_cipher_deinit (hcipher); + + return list2 (storage, actual_iv); +} + +DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0, + doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The IV and INPUT and the optional AEAD_AUTH can be +specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. +The CIPHER may be a string or symbol matching a key in that alist, or +a plist with the `:cipher-id' numeric property, or the number itself. + +AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with +:cipher-aead-capable set to t. AEAD_AUTH can be supplied for +these AEAD ciphers, but it may still be omitted (nil) as well. */) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) +{ + return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); +} + +DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0, + doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The IV and INPUT and the optional AEAD_AUTH can be +specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. +The CIPHER may be a string or symbol matching a key in that alist, or +a plist with the `:cipher-id' numeric property, or the number itself. + +AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with +:cipher-aead-capable set to t. AEAD_AUTH can be supplied for +these AEAD ciphers, but it may still be omitted (nil) as well. */) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) +{ + return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); +} + +DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, + doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists. + +Use the value of the alist (extract it with `alist-get' for instance) +with `gnutls-hash-mac'. The alist key is the mac-algorithm method +name. */) + (void) +{ + Lisp_Object mac_algorithms = Qnil; + const gnutls_mac_algorithm_t* macs = gnutls_mac_list (); + for (size_t pos = 0; macs[pos] != 0; pos++) + { + const gnutls_mac_algorithm_t gma = macs[pos]; + + const char* name = gnutls_mac_get_name (gma); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, + /* A symbol representing the mac-algorithm. */ + intern (name), + /* The internally meaningful mac-algorithm ID. */ + QCmac_algorithm_id, + make_number (gma), + /* The type (vs. other GnuTLS objects). */ + QCtype, + Qgnutls_type_mac_algorithm, + /* The output length. */ + QCmac_algorithm_length, + make_number (gnutls_hmac_get_len (gma)), + /* The key size. */ + QCmac_algorithm_keysize, + make_number (gnutls_mac_get_key_size (gma)), + /* The nonce size. */ + QCmac_algorithm_noncesize, + make_number (gnutls_mac_get_nonce_size (gma))); + mac_algorithms = Fcons (mp, mac_algorithms); + } + + return mac_algorithms; +} + +DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, + doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists. + +Use the value of the alist (extract it with `alist-get' for instance) +with `gnutls-hash-digest'. The alist key is the digest-algorithm +method name. */) + (void) +{ + Lisp_Object digest_algorithms = Qnil; + const gnutls_digest_algorithm_t* digests = gnutls_digest_list (); + for (size_t pos = 0; digests[pos] != 0; pos++) + { + const gnutls_digest_algorithm_t gda = digests[pos]; + + const char* name = gnutls_digest_get_name (gda); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, + /* A symbol representing the digest-algorithm. */ + intern (name), + /* The internally meaningful digest-algorithm ID. */ + QCdigest_algorithm_id, + make_number (gda), + QCtype, + Qgnutls_type_digest_algorithm, + /* The digest length. */ + QCdigest_algorithm_length, + make_number (gnutls_hash_get_len (gda))); + + digest_algorithms = Fcons (mp, digest_algorithms); + } + + return digest_algorithms; +} + +DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0, + doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The INPUT can be specified as a buffer or string or in other +ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of MAC algorithms can be obtained with `gnutls-macs`. The +HASH-METHOD may be a string or symbol matching a key in that alist, or +a plist with the `:mac-algorithm-id' numeric property, or the number +itself. */) + (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) +{ + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (hash_method)) + hash_method = intern (SSDATA (hash_method)); + + if (SYMBOLP (hash_method)) + info = XCDR (Fassq (hash_method, Fgnutls_macs ())); + else if (INTEGERP (hash_method)) + gma = XINT (hash_method); + else + info = hash_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); + if (INTEGERP (v)) + gma = XINT (v); + } + + if (gma == GNUTLS_MAC_UNKNOWN) + error ("GnuTLS MAC-method was invalid or not found"); + + ptrdiff_t kstart_byte, kend_byte; + const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + gnutls_hmac_hd_t hmac; + ret = gnutls_hmac_init (&hmac, gma, + kdata + kstart_byte, kend_byte - kstart_byte); + + if (kdata == NULL) + error ("GnuTLS MAC key extraction failed"); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS MAC %s initialization failed: %s", + gnutls_mac_get_name (gma), str); + } + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + if (idata == NULL) + error ("GnuTLS MAC input extraction failed"); + + size_t digest_length = gnutls_hmac_get_len (gma); + Lisp_Object digest = make_uninit_string (digest_length); + + ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_hmac_deinit (hmac, NULL); + + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS MAC %s application failed: %s", + gnutls_mac_get_name (gma), str); + } + + gnutls_hmac_output (hmac, SSDATA (digest)); + gnutls_hmac_deinit (hmac, NULL); + + return digest; +} + +DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, + doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. + +Returns nil on error. + +The INPUT can be specified as a buffer or string or in other +ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of digest algorithms can be obtained with `gnutls-digests`. +The DIGEST-METHOD may be a string or symbol matching a key in that +alist, or a plist with the `:digest-algorithm-id' numeric property, or +the number itself. */) + (Lisp_Object digest_method, Lisp_Object input) +{ + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (digest_method)) + digest_method = intern (SSDATA (digest_method)); + + if (SYMBOLP (digest_method)) + info = XCDR (Fassq (digest_method, Fgnutls_digests ())); + else if (INTEGERP (digest_method)) + gda = XINT (digest_method); + else + info = digest_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); + if (INTEGERP (v)) + gda = XINT (v); + } + + if (gda == GNUTLS_DIG_UNKNOWN) + error ("GnuTLS digest-method was invalid or not found"); + + gnutls_hash_hd_t hash; + ret = gnutls_hash_init (&hash, gda); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS digest initialization failed: %s", str); + } + + size_t digest_length = gnutls_hash_get_len (gda); + Lisp_Object digest = make_uninit_string (digest_length); + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + if (idata == NULL) + error ("GnuTLS digest input extraction failed"); + + ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_hash_deinit (hash, NULL); + + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS digest application failed: %s", str); + } + + gnutls_hash_output (hash, SSDATA (digest)); + gnutls_hash_deinit (hash, NULL); + + return digest; +} + +#endif + DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, - doc: /* Return t if GnuTLS is available in this instance of Emacs. */) + doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. + +...if supported : then... +GnuTLS 3 or higher : the list will contain 'gnutls3. +GnuTLS MACs : the list will contain 'macs. +GnuTLS digests : the list will contain 'digests. +GnuTLS symmetric ciphers: the list will contain 'ciphers. +GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */) (void) { #ifdef HAVE_GNUTLS + Lisp_Object capabilities = Qnil; + +#ifdef HAVE_GNUTLS3 + + capabilities = Fcons (intern("gnutls3"), capabilities); + +#ifdef HAVE_GNUTLS3_DIGEST + capabilities = Fcons (intern("digests"), capabilities); +#endif + +#ifdef HAVE_GNUTLS3_CIPHER + capabilities = Fcons (intern("ciphers"), capabilities); + +#ifdef HAVE_GNUTLS3_AEAD + capabilities = Fcons (intern("AEAD-ciphers"), capabilities); +#endif + +#ifdef HAVE_GNUTLS3_HMAC + capabilities = Fcons (intern("macs"), capabilities); +#endif + +#endif + +#endif + # ifdef WINDOWSNT Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); if (CONSP (found)) - return XCDR (found); + return XCDR (found); // TODO: use capabilities. else { Lisp_Object status; - status = init_gnutls_functions () ? Qt : Qnil; + // TODO: should the capabilities be dynamic here? + status = init_gnutls_functions () ? capabilities : Qnil; Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); return status; } # else /* !WINDOWSNT */ - return Qt; + return capabilities; # endif /* !WINDOWSNT */ #else /* !HAVE_GNUTLS */ return Qnil; @@ -1753,6 +2390,27 @@ syms_of_gnutls (void) DEFSYM (QCverify_flags, ":verify-flags"); DEFSYM (QCverify_error, ":verify-error"); + DEFSYM (QCcipher_id, ":cipher-id"); + DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable"); + DEFSYM (QCcipher_blocksize, ":cipher-blocksize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_tagsize, ":cipher-tagsize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_ivsize, ":cipher-ivsize"); + + DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id"); + DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize"); + DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize"); + DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length"); + + DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id"); + DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length"); + + DEFSYM (QCtype, ":type"); + DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher"); + DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm"); + DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm"); + DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, make_number (GNUTLS_E_INTERRUPTED)); @@ -1780,6 +2438,14 @@ syms_of_gnutls (void) defsubr (&Sgnutls_peer_status); defsubr (&Sgnutls_peer_status_warning_describe); + defsubr (&Sgnutls_ciphers); + defsubr (&Sgnutls_macs); + defsubr (&Sgnutls_digests); + defsubr (&Sgnutls_hash_mac); + defsubr (&Sgnutls_hash_digest); + defsubr (&Sgnutls_symmetric_encrypt); + defsubr (&Sgnutls_symmetric_decrypt); + DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, doc: /* Logging level used by the GnuTLS functions. Set this larger than 0 to get debug output in the *Messages* buffer. diff --git a/src/gnutls.h b/src/gnutls.h index 3c84023cd4e..981d59410bb 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -23,6 +23,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef HAVE_GNUTLS3 +#include +#endif + #include "lisp.h" /* This limits the attempts to handshake per process (connection). It diff --git a/src/lisp.h b/src/lisp.h index 1e8ef7a449a..a5134a9532c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,6 +3386,9 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); +extern const char* extract_data_from_object (Lisp_Object spec, + ptrdiff_t *start_byte, + ptrdiff_t *end_byte); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, -- cgit v1.2.1 From 389fb2aebf01fb786e5b18ab87953c90c15279ff Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 14 Jul 2017 22:00:55 +0300 Subject: Fix the MS-Windows build due to added GnuTLS functions * src/gnutls.c [WINDOWSNT]: Add DEF_DLL_FN for new functions. (init_gnutls_functions) [WINDOWSNT]: Add LOAD_DLL_FN for new functions. Add #define redirections for new functions. (gnutls_symmetric_aead): Fix format specs to be more portable when printing ptrdiff_t arguments. * src/fns.c (gnutls_rnd) [WINDOWSNT]: Redirect to w32_gnutls_rnd wrapper. * src/gnutls.h [WINDOWSNT]: Add prototype for w32_gnutls_rnd. * test/lisp/net/gnutls-tests.el (gnutls-tests-tested-macs) (gnutls-tests-tested-digests, gnutls-tests-tested-ciphers): Call gnutls-available-p, otherwise GnuTLS functions might not be loaded from the DLL on MS-Windows. --- src/fns.c | 4 ++ src/gnutls.c | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- src/gnutls.h | 1 + 3 files changed, 123 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/fns.c b/src/fns.c index 8b7fc0f89d8..b678a482bbc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -37,6 +37,10 @@ along with GNU Emacs. If not, see . */ #include "puresize.h" #include "gnutls.h" +#ifdef WINDOWSNT +# define gnutls_rnd w32_gnutls_rnd +#endif + static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; diff --git a/src/gnutls.c b/src/gnutls.c index 7a4e92f0d3f..761fe7df3ac 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -172,6 +172,51 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); +# if (GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3) +DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); +DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); +DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_init, + (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, + const gnutls_datum_t *, const gnutls_datum_t *)); +DEF_DLL_FN (int, gnutls_aead_cipher_init, + (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, + const gnutls_datum_t *)); +DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_aead_cipher_encrypt, + (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, + size_t, size_t, const void *, size_t, void *, size_t *)); +DEF_DLL_FN (int, gnutls_aead_cipher_decrypt, + (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, + size_t, size_t, const void *, size_t, void *, size_t *)); +DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); +DEF_DLL_FN (int, gnutls_cipher_encrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_cipher_decrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); +DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); +DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +DEF_DLL_FN (int, gnutls_hmac_init, + (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); +DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); +DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); +DEF_DLL_FN (int, gnutls_hash_init, + (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); +DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *)); +DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); +DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); +DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); +DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); +# endif + static bool init_gnutls_functions (void) @@ -256,6 +301,38 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_get_name); LOAD_DLL_FN (library, gnutls_mac_get); LOAD_DLL_FN (library, gnutls_mac_get_name); +# if GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3 + LOAD_DLL_FN (library, gnutls_rnd); + LOAD_DLL_FN (library, gnutls_cipher_list); + LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); + LOAD_DLL_FN (library, gnutls_cipher_get_key_size); + LOAD_DLL_FN (library, gnutls_cipher_get_block_size); + LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); + LOAD_DLL_FN (library, gnutls_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); + LOAD_DLL_FN (library, gnutls_cipher_set_iv); + LOAD_DLL_FN (library, gnutls_cipher_encrypt2); + LOAD_DLL_FN (library, gnutls_cipher_decrypt2); + LOAD_DLL_FN (library, gnutls_cipher_deinit); + LOAD_DLL_FN (library, gnutls_mac_list); + LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); + LOAD_DLL_FN (library, gnutls_mac_get_key_size); + LOAD_DLL_FN (library, gnutls_digest_list); + LOAD_DLL_FN (library, gnutls_digest_get_name); + LOAD_DLL_FN (library, gnutls_hmac_init); + LOAD_DLL_FN (library, gnutls_hmac_get_len); + LOAD_DLL_FN (library, gnutls_hmac); + LOAD_DLL_FN (library, gnutls_hmac_deinit); + LOAD_DLL_FN (library, gnutls_hmac_output); + LOAD_DLL_FN (library, gnutls_hash_init); + LOAD_DLL_FN (library, gnutls_hash_get_len); + LOAD_DLL_FN (library, gnutls_hash); + LOAD_DLL_FN (library, gnutls_hash_deinit); + LOAD_DLL_FN (library, gnutls_hash_output); +# endif max_log_level = global_gnutls_log_level; @@ -333,6 +410,44 @@ init_gnutls_functions (void) # define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version # define gnutls_x509_crt_import fn_gnutls_x509_crt_import # define gnutls_x509_crt_init fn_gnutls_x509_crt_init +# define gnutls_rnd fn_gnutls_rnd +# define gnutls_cipher_list fn_gnutls_cipher_list +# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size +# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size +# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size +# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size +# define gnutls_cipher_init fn_gnutls_cipher_init +# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt +# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt +# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init +# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit +# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv +# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 +# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 +# define gnutls_cipher_deinit fn_gnutls_cipher_deinit +# define gnutls_mac_list fn_gnutls_mac_list +# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size +# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size +# define gnutls_digest_list fn_gnutls_digest_list +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# define gnutls_hmac_init fn_gnutls_hmac_init +# define gnutls_hmac_get_len fn_gnutls_hmac_get_len +# define gnutls_hmac fn_gnutls_hmac +# define gnutls_hmac_deinit fn_gnutls_hmac_deinit +# define gnutls_hmac_output fn_gnutls_hmac_output +# define gnutls_hash_init fn_gnutls_hash_init +# define gnutls_hash_get_len fn_gnutls_hash_get_len +# define gnutls_hash fn_gnutls_hash +# define gnutls_hash_deinit fn_gnutls_hash_deinit +# define gnutls_hash_output fn_gnutls_hash_output + +/* This wrapper is called from fns.c, which doesn't know about the + LOAD_DLL_FN stuff above. */ +int +w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len) +{ + return gnutls_rnd (level, data, len); +} #endif @@ -1899,7 +2014,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, error ("GnuTLS cipher key extraction failed"); if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) - error ("GnuTLS cipher %s/%s key length %ld was not equal to " + error ("GnuTLS cipher %s/%s key length %" pD "d was not equal to " "the required %ld", gnutls_cipher_get_name (gca), desc, kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); @@ -1911,7 +2026,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, error ("GnuTLS cipher IV extraction failed"); if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) - error ("GnuTLS cipher %s/%s IV length %ld was not equal to " + error ("GnuTLS cipher %s/%s IV length %" pD "d was not equal to " "the required %ld", gnutls_cipher_get_name (gca), desc, vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); @@ -1939,7 +2054,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, } if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS cipher %s/%s input block length %ld was not a multiple " + error ("GnuTLS cipher %s/%s input block length %" pD "d was not a multiple " "of the required %ld", gnutls_cipher_get_name (gca), desc, iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); diff --git a/src/gnutls.h b/src/gnutls.h index 981d59410bb..3ec86a8892d 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -86,6 +86,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte); extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state); #ifdef WINDOWSNT extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); +extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t); #endif extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); extern Lisp_Object emacs_gnutls_global_init (void); -- cgit v1.2.1 From 05b8b866993b957f5fd575846cf8ea3035e60f7e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 14 Jul 2017 16:18:37 -0700 Subject: GnuTLS integer-overflow and style fixes This tweaks the recently-added GnuTLS improvements so that they avoid some integer-overflow problems and follow typical Emacs style a bit better. * configure.ac (HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD) (HAVE_GNUTLS3_CIPHER): Use AC_CACHE_CHECK so that the configure-time results are displayed. * src/fns.c (extract_data_from_object): Return char *, not char const *, since one gnutls caller wants a non-const pointer. Use CONSP rather than !NILP when testing for conses. Use CAR_SAFE instead of rolling our own code. Prefer signed types to unsigned when either will do. Report problems for lengths out of range, instead of silently mishandling them. * src/gnutls.c (emacs_gnutls_strerror): New function, to simplify callers. All callers of gnutls_sterror changed. (Fgnutls_boot): Check for integers out of range rather than silently truncating them. (gnutls_symmetric_aead): Check for integer overflow in size calculations. (gnutls_symmetric_aead, Fgnutls_macs, Fgnutls_digests): Prefer signed to unsigned integers where either will do. (gnutls_symmetric_aead, gnutls_symmetric): Work even if ptrdiff_t is wider than ‘long’. (gnutls_symmetric, Fgnutls_hash_mac, Fgnutls_hash_digest): Check for integer overflow in algorithm selection. --- src/fns.c | 49 +++--- src/gnutls.c | 489 ++++++++++++++++++++++++++--------------------------------- src/lisp.h | 4 +- 3 files changed, 237 insertions(+), 305 deletions(-) (limited to 'src') diff --git a/src/fns.c b/src/fns.c index b678a482bbc..fb1296bc6f0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -46,10 +46,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); -static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, - Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, - Lisp_Object binary); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */ @@ -4767,29 +4763,24 @@ DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, (BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as specified with `secure-hash' and in Info node `(elisp)Format of GnuTLS Cryptography Inputs'. */ -const char* +char * extract_data_from_object (Lisp_Object spec, ptrdiff_t *start_byte, ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, end_char = 0; - register EMACS_INT b, e; - register struct buffer *bp; - EMACS_INT temp; + Lisp_Object object = XCAR (spec); - Lisp_Object object = XCAR (spec); + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object start = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object end = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object coding_system = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil; - - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object noerror = CAR_SAFE (spec); if (STRINGP (object)) { @@ -4817,7 +4808,7 @@ extract_data_from_object (Lisp_Object spec, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); - size = SCHARS (object); + ptrdiff_t size = SCHARS (object), start_char, end_char; validate_subarray (object, start, end, size, &start_char, &end_char); *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); @@ -4828,12 +4819,13 @@ extract_data_from_object (Lisp_Object spec, else if (BUFFERP (object)) { struct buffer *prev = current_buffer; + EMACS_INT b, e; record_unwind_current_buffer (); CHECK_BUFFER (object); - bp = XBUFFER (object); + struct buffer *bp = XBUFFER (object); set_buffer_internal (bp); if (NILP (start)) @@ -4853,7 +4845,11 @@ extract_data_from_object (Lisp_Object spec, } if (b > e) - temp = b, b = e, e = temp; + { + EMACS_INT temp = b; + b = e; + e = temp; + } if (!(BEGV <= b && e <= ZV)) args_out_of_range (start, end); @@ -4932,14 +4928,13 @@ extract_data_from_object (Lisp_Object spec, else if (EQ (object, Qiv_auto)) { #ifdef HAVE_GNUTLS3 - // Format: (iv-auto REQUIRED-LENGTH) + /* Format: (iv-auto REQUIRED-LENGTH). */ - if (! INTEGERP (start)) + if (! NATNUMP (start)) error ("Without a length, iv-auto can't be used. See manual."); else { - /* Make sure the value of "start" doesn't change. */ - size_t start_hold = XUINT (start); + EMACS_INT start_hold = XFASTINT (start); object = make_uninit_string (start_hold); gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); @@ -4971,7 +4966,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object spec = list5 (object, start, end, coding_system, noerror); - const char* input = extract_data_from_object (spec, &start_byte, &end_byte); + const char *input = extract_data_from_object (spec, &start_byte, &end_byte); if (input == NULL) error ("secure_hash: failed to extract data from object, aborting!"); diff --git a/src/gnutls.c b/src/gnutls.c index 761fe7df3ac..5717b3075c1 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -672,6 +672,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) } } +static char const * +emacs_gnutls_strerror (int err) +{ + char const *str = gnutls_strerror (err); + return str ? str : "unknown"; +} + /* Report a GnuTLS error to the user. Return true if the error code was successfully handled. */ static bool @@ -680,7 +687,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) int max_log_level = 0; bool ret; - const char *str; /* TODO: use a Lisp_Object generated by gnutls_make_error? */ if (err >= 0) @@ -692,9 +698,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ - str = gnutls_strerror (err); - if (!str) - str = "unknown"; + char const *str = emacs_gnutls_strerror (err); if (gnutls_error_is_fatal (err)) { @@ -708,11 +712,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) #endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); - ret = 0; + ret = false; } else { - ret = 1; + ret = true; switch (err) { @@ -900,7 +904,7 @@ usage: (gnutls-error-string ERROR) */) if (! TYPE_RANGED_INTEGERP (int, err)) return build_string ("Not an error symbol or code"); - return build_string (gnutls_strerror (XINT (err))); + return build_string (emacs_gnutls_strerror (XINT (err))); } DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, @@ -1592,9 +1596,9 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_x509_cred = x509_cred; verify_flags = Fplist_get (proplist, QCverify_flags); - if (NUMBERP (verify_flags)) + if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags)) { - gnutls_verify_flags = XINT (verify_flags); + gnutls_verify_flags = XFASTINT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) @@ -1818,39 +1822,32 @@ This function may also return `gnutls-e-again', or DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. The alist key is the cipher name. */) - (void) + (void) { Lisp_Object ciphers = Qnil; - const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list (); - for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); + for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { - const gnutls_cipher_algorithm_t gca = gciphers[pos]; - - Lisp_Object cp = listn (CONSTYPE_HEAP, 15, - /* A symbol representing the cipher */ - intern (gnutls_cipher_get_name (gca)), - /* The internally meaningful cipher ID */ - QCcipher_id, - make_number (gca), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_cipher, - /* The tag size (nonzero means AEAD). */ - QCcipher_aead_capable, - (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt, - /* The tag size (nonzero means AEAD). */ - QCcipher_tagsize, - make_number (gnutls_cipher_get_tag_size (gca)), - /* The block size */ - QCcipher_blocksize, - make_number (gnutls_cipher_get_block_size (gca)), - /* The key size */ - QCcipher_keysize, - make_number (gnutls_cipher_get_key_size (gca)), - /* IV size */ - QCcipher_ivsize, - make_number (gnutls_cipher_get_iv_size (gca))); + gnutls_cipher_algorithm_t gca = gciphers[pos]; + Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); + + Lisp_Object cp + = listn (CONSTYPE_HEAP, 15, cipher_symbol, + QCcipher_id, make_number (gca), + QCtype, Qgnutls_type_cipher, + QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt, + QCcipher_tagsize, make_number (cipher_tag_size), + + QCcipher_blocksize, + make_number (gnutls_cipher_get_block_size (gca)), + + QCcipher_keysize, + make_number (gnutls_cipher_get_key_size (gca)), + + QCcipher_ivsize, + make_number (gnutls_cipher_get_iv_size (gca))); ciphers = Fcons (cp, ciphers); } @@ -1861,36 +1858,35 @@ The alist key is the cipher name. */) static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, - const char* kdata, size_t ksize, - const char* vdata, size_t vsize, - const char* idata, size_t isize, + const char *kdata, ptrdiff_t ksize, + const char *vdata, ptrdiff_t vsize, + const char *idata, ptrdiff_t isize, Lisp_Object aead_auth) { #ifdef HAVE_GNUTLS3_AEAD - const char* desc = (encrypting ? "encrypt" : "decrypt"); - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); gnutls_aead_cipher_hd_t acipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize }; - ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); + gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize }; + int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } - - size_t storage_length = isize + gnutls_cipher_get_tag_size (gca); + error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); + ptrdiff_t tagged_size; + if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size) + || SIZE_MAX < tagged_size) + memory_full (SIZE_MAX); + size_t storage_length = tagged_size; USE_SAFE_ALLOCA; - unsigned char *storage = SAFE_ALLOCA (storage_length); + char *storage = SAFE_ALLOCA (storage_length); - const char* aead_auth_data = NULL; - size_t aead_auth_size = 0; + const char *aead_auth_data = NULL; + ptrdiff_t aead_auth_size = 0; if (!NILP (aead_auth)) { @@ -1900,8 +1896,8 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, CHECK_CONS (aead_auth); ptrdiff_t astart_byte, aend_byte; - const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); - + const char *adata + = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); if (adata == NULL) error ("GnuTLS AEAD cipher auth extraction failed"); @@ -1909,53 +1905,38 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, aead_auth_size = aend_byte - astart_byte; } - size_t expected_remainder = 0; - - if (!encrypting) - expected_remainder = gnutls_cipher_get_tag_size (gca); + ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size; + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); - if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a " - "multiple of the required %ld plus the expected tag remainder %ld", + if (isize < expected_remainder + || (isize - expected_remainder) % cipher_block_size != 0) + error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d " + "is not %"pD"d greater than a multiple of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - (long) isize, (long) gnutls_cipher_get_block_size (gca), - (long) expected_remainder); - - if (encrypting) - ret = gnutls_aead_cipher_encrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); - else - ret = gnutls_aead_cipher_decrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); + isize, expected_remainder, cipher_block_size); + + ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt) + (acipher, vdata, vsize, aead_auth_data, aead_auth_size, + cipher_tag_size, idata, isize, storage, &storage_length)); if (ret < GNUTLS_E_SUCCESS) { memset (storage, 0, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS AEAD cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_aead_cipher_deinit (acipher); - Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length); + Lisp_Object output = make_unibyte_string (storage, storage_length); memset (storage, 0, storage_length); SAFE_FREE (); return list2 (output, actual_iv); #else - error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca); + printmax_t print_gca = gca; + error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca); #endif } @@ -1980,9 +1961,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, CHECK_CONS (iv); - const char* desc = (encrypting ? "encrypt" : "decrypt"); - - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; @@ -1992,7 +1971,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (SYMBOLP (cipher)) info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); - else if (INTEGERP (cipher)) + else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) gca = XINT (cipher); else info = cipher; @@ -2000,41 +1979,44 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCcipher_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v)) gca = XINT (v); } - if (gca == GNUTLS_CIPHER_UNKNOWN) - error ("GnuTLS cipher was invalid or not found"); + ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); + if (key_size == 0) + error ("GnuTLS cipher is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS cipher key extraction failed"); - if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) - error ("GnuTLS cipher %s/%s key length %" pD "d was not equal to " - "the required %ld", + if (kend_byte - kstart_byte != key_size) + error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + kend_byte - kstart_byte, key_size); ptrdiff_t vstart_byte, vend_byte; - const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); + char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); if (vdata == NULL) error ("GnuTLS cipher IV extraction failed"); - if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) - error ("GnuTLS cipher %s/%s IV length %" pD "d was not equal to " - "the required %ld", + ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca); + if (vend_byte - vstart_byte != iv_size) + error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + vend_byte - vstart_byte, iv_size); Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS cipher input extraction failed"); @@ -2053,44 +2035,34 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return aead_output; } - if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS cipher %s/%s input block length %" pD "d was not a multiple " - "of the required %ld", + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); + if ((iend_byte - istart_byte) % cipher_block_size != 0) + error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple " + "of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + iend_byte - istart_byte, cipher_block_size); gnutls_cipher_hd_t hcipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + gnutls_datum_t key_datum + = { (unsigned char *) kdata, kend_byte - kstart_byte }; - ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); + int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } + error ("GnuTLS cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); /* Note that this will not support streaming block mode. */ - gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte); + gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte); - /* - * GnuTLS docs: "For the supported ciphers the encrypted data length - * will equal the plaintext size." - */ - size_t storage_length = iend_byte - istart_byte; + /* GnuTLS docs: "For the supported ciphers the encrypted data length + will equal the plaintext size." */ + ptrdiff_t storage_length = iend_byte - istart_byte; Lisp_Object storage = make_uninit_string (storage_length); - if (encrypting) - ret = gnutls_cipher_encrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); - else - ret = gnutls_cipher_decrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); + ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2) + (hcipher, idata, iend_byte - istart_byte, + SSDATA (storage), storage_length)); if (STRINGP (XCAR (key))) Fclear_string (XCAR (key)); @@ -2098,11 +2070,8 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (ret < GNUTLS_E_SUCCESS) { gnutls_cipher_deinit (hcipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_cipher_deinit (hcipher); @@ -2110,41 +2079,46 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return list2 (storage, actual_iv); } -DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, + Sgnutls_symmetric_encrypt, 4, 5, 0, doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or -a plist with the `:cipher-id' numeric property, or the number itself. +a plist with the :cipher-id numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); } -DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, + Sgnutls_symmetric_decrypt, 4, 5, 0, doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or @@ -2153,7 +2127,8 @@ a plist with the `:cipher-id' numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); } @@ -2164,32 +2139,26 @@ DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-mac'. The alist key is the mac-algorithm method name. */) - (void) + (void) { Lisp_Object mac_algorithms = Qnil; - const gnutls_mac_algorithm_t* macs = gnutls_mac_list (); - for (size_t pos = 0; macs[pos] != 0; pos++) + const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); + for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { const gnutls_mac_algorithm_t gma = macs[pos]; - const char* name = gnutls_mac_get_name (gma); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, - /* A symbol representing the mac-algorithm. */ - intern (name), - /* The internally meaningful mac-algorithm ID. */ - QCmac_algorithm_id, - make_number (gma), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_mac_algorithm, - /* The output length. */ + const char *name = gnutls_mac_get_name (gma); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, intern (name), + QCmac_algorithm_id, make_number (gma), + QCtype, Qgnutls_type_mac_algorithm, + QCmac_algorithm_length, make_number (gnutls_hmac_get_len (gma)), - /* The key size. */ + QCmac_algorithm_keysize, make_number (gnutls_mac_get_key_size (gma)), - /* The nonce size. */ + QCmac_algorithm_noncesize, make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); @@ -2204,25 +2173,20 @@ DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-digest'. The alist key is the digest-algorithm method name. */) - (void) + (void) { Lisp_Object digest_algorithms = Qnil; - const gnutls_digest_algorithm_t* digests = gnutls_digest_list (); - for (size_t pos = 0; digests[pos] != 0; pos++) + const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); + for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { const gnutls_digest_algorithm_t gda = digests[pos]; - const char* name = gnutls_digest_get_name (gda); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, - /* A symbol representing the digest-algorithm. */ - intern (name), - /* The internally meaningful digest-algorithm ID. */ - QCdigest_algorithm_id, - make_number (gda), - QCtype, - Qgnutls_type_digest_algorithm, - /* The digest length. */ + const char *name = gnutls_digest_get_name (gda); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, intern (name), + QCdigest_algorithm_id, make_number (gda), + QCtype, Qgnutls_type_digest_algorithm, + QCdigest_algorithm_length, make_number (gnutls_hash_get_len (gda))); @@ -2235,11 +2199,11 @@ method name. */) DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0, doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2248,7 +2212,7 @@ The alist of MAC algorithms can be obtained with `gnutls-macs`. The HASH-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:mac-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) + (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); @@ -2260,8 +2224,6 @@ itself. */) CHECK_CONS (key); - int ret = GNUTLS_E_SUCCESS; - gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; Lisp_Object info = Qnil; @@ -2270,7 +2232,7 @@ itself. */) if (SYMBOLP (hash_method)) info = XCDR (Fassq (hash_method, Fgnutls_macs ())); - else if (INTEGERP (hash_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) gma = XINT (hash_method); else info = hash_method; @@ -2278,37 +2240,32 @@ itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v)) gma = XINT (v); } - if (gma == GNUTLS_MAC_UNKNOWN) - error ("GnuTLS MAC-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hmac_get_len (gma); + if (digest_length == 0) + error ("GnuTLS MAC-method is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); - gnutls_hmac_hd_t hmac; - ret = gnutls_hmac_init (&hmac, gma, - kdata + kstart_byte, kend_byte - kstart_byte); - + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS MAC key extraction failed"); + gnutls_hmac_hd_t hmac; + int ret = gnutls_hmac_init (&hmac, gma, + kdata + kstart_byte, kend_byte - kstart_byte); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS MAC %s initialization failed: %s", - gnutls_mac_get_name (gma), str); - } + error ("GnuTLS MAC %s initialization failed: %s", + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS MAC input extraction failed"); - size_t digest_length = gnutls_hmac_get_len (gma); Lisp_Object digest = make_uninit_string (digest_length); ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte); @@ -2319,12 +2276,8 @@ itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hmac_deinit (hmac, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS MAC %s application failed: %s", - gnutls_mac_get_name (gma), str); + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); } gnutls_hmac_output (hmac, SSDATA (digest)); @@ -2336,7 +2289,7 @@ itself. */) DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. -Returns nil on error. +Return nil on error. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2345,15 +2298,13 @@ The alist of digest algorithms can be obtained with `gnutls-digests`. The DIGEST-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:digest-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object digest_method, Lisp_Object input) + (Lisp_Object digest_method, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); CHECK_CONS (input); - int ret = GNUTLS_E_SUCCESS; - gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN; Lisp_Object info = Qnil; @@ -2362,7 +2313,7 @@ the number itself. */) if (SYMBOLP (digest_method)) info = XCDR (Fassq (digest_method, Fgnutls_digests ())); - else if (INTEGERP (digest_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) gda = XINT (digest_method); else info = digest_method; @@ -2370,29 +2321,26 @@ the number itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v)) gda = XINT (v); } - if (gda == GNUTLS_DIG_UNKNOWN) - error ("GnuTLS digest-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hash_get_len (gda); + if (digest_length == 0) + error ("GnuTLS digest-method is invalid or not found"); gnutls_hash_hd_t hash; - ret = gnutls_hash_init (&hash, gda); + int ret = gnutls_hash_init (&hash, gda); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest initialization failed: %s", str); - } + error ("GnuTLS digest initialization failed: %s", + emacs_gnutls_strerror (ret)); - size_t digest_length = gnutls_hash_get_len (gda); Lisp_Object digest = make_uninit_string (digest_length); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS digest input extraction failed"); @@ -2401,11 +2349,8 @@ the number itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hash_deinit (hash, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest application failed: %s", str); + error ("GnuTLS digest application failed: %s", + emacs_gnutls_strerror (ret)); } gnutls_hash_output (hash, SSDATA (digest)); @@ -2420,57 +2365,51 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. ...if supported : then... -GnuTLS 3 or higher : the list will contain 'gnutls3. -GnuTLS MACs : the list will contain 'macs. -GnuTLS digests : the list will contain 'digests. -GnuTLS symmetric ciphers: the list will contain 'ciphers. -GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */) - (void) +GnuTLS 3 or higher : the list will contain `gnutls3'. +GnuTLS MACs : the list will contain `macs'. +GnuTLS digests : the list will contain `digests'. +GnuTLS symmetric ciphers: the list will contain `ciphers'. +GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) + (void) { -#ifdef HAVE_GNUTLS - Lisp_Object capabilities = Qnil; +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); /* TODO: use capabilities. */ + else + { + Lisp_Object status; + /* TODO: should the capabilities be dynamic here? */ + status = init_gnutls_functions () ? capabilities : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); + return status; + } +#else -#ifdef HAVE_GNUTLS3 + Lisp_Object capabilities = Qnil; +# ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); -#ifdef HAVE_GNUTLS3_DIGEST +# ifdef HAVE_GNUTLS3_DIGEST capabilities = Fcons (intern("digests"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_CIPHER +# ifdef HAVE_GNUTLS3_CIPHER capabilities = Fcons (intern("ciphers"), capabilities); -#ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS3_AEAD capabilities = Fcons (intern("AEAD-ciphers"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_HMAC +# ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); -#endif - -#endif - -#endif +# endif +# endif +# endif -# ifdef WINDOWSNT - Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); - if (CONSP (found)) - return XCDR (found); // TODO: use capabilities. - else - { - Lisp_Object status; - // TODO: should the capabilities be dynamic here? - status = init_gnutls_functions () ? capabilities : Qnil; - Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); - return status; - } -# else /* !WINDOWSNT */ return capabilities; -# endif /* !WINDOWSNT */ -#else /* !HAVE_GNUTLS */ - return Qnil; -#endif /* !HAVE_GNUTLS */ +#endif } void diff --git a/src/lisp.h b/src/lisp.h index a5134a9532c..9464bf8559f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,9 +3386,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); -extern const char* extract_data_from_object (Lisp_Object spec, - ptrdiff_t *start_byte, - ptrdiff_t *end_byte); +extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, -- cgit v1.2.1 From ae56c9674b4668ded392c66d46aa22db902ddd71 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 15 Jul 2017 02:45:19 +0200 Subject: Make combinations of :width/:max-height image specs work reliably * doc/lispref/display.texi (ImageMagick Images): Document :width/:max-height combinations (etc) (bug #25583). * src/image.c (compute_image_size): Handle :width/:max-height (etc) combinations consistently (by letting "max" win and preserve ratio). * test/manual/image-size-tests.el (image-size-tests): Add tests for :width/:max-height (etc) combinations. --- src/image.c | 97 ++++++++++++++++++++++++++++--------------------------------- 1 file changed, 45 insertions(+), 52 deletions(-) (limited to 'src') diff --git a/src/image.c b/src/image.c index 1426e309445..69a529e8c35 100644 --- a/src/image.c +++ b/src/image.c @@ -8086,83 +8086,76 @@ compute_image_size (size_t width, size_t height, int *d_width, int *d_height) { Lisp_Object value; - int desired_width, desired_height; + int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1; double scale = 1; value = image_spec_value (spec, QCscale, NULL); if (NUMBERP (value)) scale = XFLOATINT (value); + value = image_spec_value (spec, QCmax_width, NULL); + if (NATNUMP (value)) + max_width = min (XFASTINT (value), INT_MAX); + + value = image_spec_value (spec, QCmax_height, NULL); + if (NATNUMP (value)) + max_height = min (XFASTINT (value), INT_MAX); + /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the unspecified should be calculated from the specified to preserve aspect ratio. */ value = image_spec_value (spec, QCwidth, NULL); - desired_width = NATNUMP (value) ? - min (XFASTINT (value) * scale, INT_MAX) : -1; - value = image_spec_value (spec, QCheight, NULL); - desired_height = NATNUMP (value) ? - min (XFASTINT (value) * scale, INT_MAX) : -1; - - width = width * scale; - height = height * scale; - - if (desired_width == -1) + if (NATNUMP (value)) { - value = image_spec_value (spec, QCmax_width, NULL); - if (NATNUMP (value)) - { - int max_width = min (XFASTINT (value), INT_MAX); - if (max_width < width) - { - /* The image is wider than :max-width. */ - desired_width = max_width; - if (desired_height == -1) - { - desired_height = scale_image_size (desired_width, - width, height); - value = image_spec_value (spec, QCmax_height, NULL); - if (NATNUMP (value)) - { - int max_height = min (XFASTINT (value), INT_MAX); - if (max_height < desired_height) - { - desired_height = max_height; - desired_width = scale_image_size (desired_height, - height, width); - } - } - } - } - } + desired_width = min (XFASTINT (value) * scale, INT_MAX); + /* :width overrides :max-width. */ + max_width = -1; } - if (desired_height == -1) + value = image_spec_value (spec, QCheight, NULL); + if (NATNUMP (value)) { - value = image_spec_value (spec, QCmax_height, NULL); - if (NATNUMP (value)) - { - int max_height = min (XFASTINT (value), INT_MAX); - if (max_height < height) - desired_height = max_height; - } + desired_height = min (XFASTINT (value) * scale, INT_MAX); + /* :height overrides :max-height. */ + max_height = -1; } + /* If we have both width/height set explicitly, we skip past all the + aspect ratio-preserving computations below. */ + if (desired_width != -1 && desired_height != -1) + goto out; + + width = width * scale; + height = height * scale; + if (desired_width != -1 && desired_height == -1) - /* w known, calculate h. */ + /* Width known, calculate height. */ desired_height = scale_image_size (desired_width, width, height); - - if (desired_width == -1 && desired_height != -1) - /* h known, calculate w. */ + else if (desired_width == -1 && desired_height != -1) + /* Height known, calculate width. */ desired_width = scale_image_size (desired_height, height, width); - - /* We have no width/height settings, so just apply the scale. */ - if (desired_width == -1 && desired_height == -1) + else { desired_width = width; desired_height = height; } + if (max_width != -1 && desired_width > max_width) + { + /* The image is wider than :max-width. */ + desired_width = max_width; + desired_height = scale_image_size (desired_width, width, height); + } + + if (max_height != -1 && desired_height > max_height) + { + /* The image is higher than :max-height. */ + desired_height = max_height; + desired_width = scale_image_size (desired_height, height, width); + } + + out: *d_width = desired_width; *d_height = desired_height; } -- cgit v1.2.1 From 511fe21b88f7468a5232434b556f886fa985a5aa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 15 Jul 2017 03:21:07 +0200 Subject: src/image.c (compute_image_size): Remove superfluous checks. * src/image.c (compute_image_size): Remove superfluous checks. --- src/image.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/image.c b/src/image.c index 69a529e8c35..76a19a68b0d 100644 --- a/src/image.c +++ b/src/image.c @@ -8129,10 +8129,10 @@ compute_image_size (size_t width, size_t height, width = width * scale; height = height * scale; - if (desired_width != -1 && desired_height == -1) + if (desired_width != -1) /* Width known, calculate height. */ desired_height = scale_image_size (desired_width, width, height); - else if (desired_width == -1 && desired_height != -1) + else if (desired_height != -1) /* Height known, calculate width. */ desired_width = scale_image_size (desired_height, height, width); else -- cgit v1.2.1 From 55d65682ab81ee6e7ca12f4902a6f8799782cd23 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 15 Jul 2017 10:43:38 +0300 Subject: Fix the MS-Windows build broken in gnutls.c * src/gnutls.c (Fgnutls_available_p) [WINDOWSNT]: Move the DLL loading code to after 'capabilities' has been calculated. Remove redundant comments. --- src/gnutls.c | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 5717b3075c1..deffbd4b053 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -449,7 +449,7 @@ w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len) return gnutls_rnd (level, data, len); } -#endif +#endif /* WINDOWSNT */ /* Report memory exhaustion if ERR is an out-of-memory indication. */ @@ -549,7 +549,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) return err; } } -#endif +#endif /* !WINDOWSNT */ static int emacs_gnutls_handshake (struct Lisp_Process *proc) @@ -2359,7 +2359,7 @@ the number itself. */) return digest; } -#endif +#endif /* HAVE_GNUTLS3 */ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. @@ -2372,20 +2372,6 @@ GnuTLS symmetric ciphers: the list will contain `ciphers'. GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) (void) { -#ifdef WINDOWSNT - Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); - if (CONSP (found)) - return XCDR (found); /* TODO: use capabilities. */ - else - { - Lisp_Object status; - /* TODO: should the capabilities be dynamic here? */ - status = init_gnutls_functions () ? capabilities : Qnil; - Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); - return status; - } -#else - Lisp_Object capabilities = Qnil; # ifdef HAVE_GNUTLS3 @@ -2405,10 +2391,24 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) # ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); # endif -# endif -# endif +# endif /* HAVE_GNUTLS3_CIPHER */ +# endif /* HAVE_GNUTLS3 */ + +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); + else + { + Lisp_Object status; + status = init_gnutls_functions () ? capabilities : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); + return status; + } +#else /* !WINDOWSNT */ return capabilities; + #endif } -- cgit v1.2.1 From d23f38e31d0adf102526b5b4291a20581418b8eb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 15 Jul 2017 11:33:22 +0300 Subject: Rearrange MS-Windows code that dynamically loads GnuTLS functions * src/gnutls.c [WINDOWSNT]: Reorganize definitions and loading of functions using the same preprocessing directives as in the code. --- src/gnutls.c | 98 ++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 62 insertions(+), 36 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index deffbd4b053..0fc5d90c3ac 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -172,8 +172,14 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); -# if (GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3) +# ifdef HAVE_GNUTLS3 DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); +DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); +DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); +DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +# ifdef HAVE_GNUTLS3_CIPHER DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); @@ -182,6 +188,13 @@ DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (int, gnutls_cipher_init, (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *, const gnutls_datum_t *)); +DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); +DEF_DLL_FN (int, gnutls_cipher_encrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_cipher_decrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +# ifdef HAVE_GNUTLS3_AEAD DEF_DLL_FN (int, gnutls_aead_cipher_init, (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *)); @@ -192,30 +205,25 @@ DEF_DLL_FN (int, gnutls_aead_cipher_encrypt, DEF_DLL_FN (int, gnutls_aead_cipher_decrypt, (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, size_t, size_t, const void *, size_t, void *, size_t *)); -DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); -DEF_DLL_FN (int, gnutls_cipher_encrypt2, - (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); -DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); -DEF_DLL_FN (int, gnutls_cipher_decrypt2, - (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); -DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); -DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); -DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); -DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); -DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +# endif /* HAVE_GNUTLS3_AEAD */ +# ifdef HAVE_GNUTLS3_HMAC DEF_DLL_FN (int, gnutls_hmac_init, (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); -DEF_DLL_FN (int, gnutls_hash_init, - (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *)); +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST + DEF_DLL_FN (int, gnutls_hash_init, + (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); -# endif +# endif /* HAVE_GNUTLS3_DIGEST */ +# endif /* HAVE_GNUTLS3 */ static bool @@ -301,38 +309,46 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_get_name); LOAD_DLL_FN (library, gnutls_mac_get); LOAD_DLL_FN (library, gnutls_mac_get_name); -# if GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3 +# ifdef HAVE_GNUTLS3 LOAD_DLL_FN (library, gnutls_rnd); + LOAD_DLL_FN (library, gnutls_mac_list); + LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); + LOAD_DLL_FN (library, gnutls_mac_get_key_size); + LOAD_DLL_FN (library, gnutls_digest_list); + LOAD_DLL_FN (library, gnutls_digest_get_name); +# ifdef HAVE_GNUTLS3_CIPHER LOAD_DLL_FN (library, gnutls_cipher_list); LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); LOAD_DLL_FN (library, gnutls_cipher_get_key_size); LOAD_DLL_FN (library, gnutls_cipher_get_block_size); LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); LOAD_DLL_FN (library, gnutls_cipher_init); - LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); - LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); - LOAD_DLL_FN (library, gnutls_aead_cipher_init); - LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); LOAD_DLL_FN (library, gnutls_cipher_set_iv); LOAD_DLL_FN (library, gnutls_cipher_encrypt2); - LOAD_DLL_FN (library, gnutls_cipher_decrypt2); LOAD_DLL_FN (library, gnutls_cipher_deinit); - LOAD_DLL_FN (library, gnutls_mac_list); - LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); - LOAD_DLL_FN (library, gnutls_mac_get_key_size); - LOAD_DLL_FN (library, gnutls_digest_list); - LOAD_DLL_FN (library, gnutls_digest_get_name); + LOAD_DLL_FN (library, gnutls_cipher_decrypt2); +# ifdef HAVE_GNUTLS3_AEAD + LOAD_DLL_FN (library, gnutls_aead_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); + LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); +# endif +# ifdef HAVE_GNUTLS3_HMAC LOAD_DLL_FN (library, gnutls_hmac_init); LOAD_DLL_FN (library, gnutls_hmac_get_len); LOAD_DLL_FN (library, gnutls_hmac); LOAD_DLL_FN (library, gnutls_hmac_deinit); LOAD_DLL_FN (library, gnutls_hmac_output); +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST LOAD_DLL_FN (library, gnutls_hash_init); LOAD_DLL_FN (library, gnutls_hash_get_len); LOAD_DLL_FN (library, gnutls_hash); LOAD_DLL_FN (library, gnutls_hash_deinit); LOAD_DLL_FN (library, gnutls_hash_output); -# endif +# endif +# endif /* HAVE_GNUTLS3 */ max_log_level = global_gnutls_log_level; @@ -410,36 +426,46 @@ init_gnutls_functions (void) # define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version # define gnutls_x509_crt_import fn_gnutls_x509_crt_import # define gnutls_x509_crt_init fn_gnutls_x509_crt_init +# ifdef HAVE_GNUTLS3 # define gnutls_rnd fn_gnutls_rnd +# define gnutls_mac_list fn_gnutls_mac_list +# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size +# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size +# define gnutls_digest_list fn_gnutls_digest_list +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# ifdef HAVE_GNUTLS3_CIPHER # define gnutls_cipher_list fn_gnutls_cipher_list # define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size # define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size # define gnutls_cipher_init fn_gnutls_cipher_init -# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt -# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt -# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init -# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit # define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv # define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 # define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 # define gnutls_cipher_deinit fn_gnutls_cipher_deinit -# define gnutls_mac_list fn_gnutls_mac_list -# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size -# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# define gnutls_digest_list fn_gnutls_digest_list -# define gnutls_digest_get_name fn_gnutls_digest_get_name +# ifdef HAVE_GNUTLS3_AEAD +# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt +# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt +# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init +# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit +# endif /* HAVE_GNUTLS3_AEAD */ +# ifdef HAVE_GNUTLS3_HMAC # define gnutls_hmac_init fn_gnutls_hmac_init # define gnutls_hmac_get_len fn_gnutls_hmac_get_len # define gnutls_hmac fn_gnutls_hmac # define gnutls_hmac_deinit fn_gnutls_hmac_deinit # define gnutls_hmac_output fn_gnutls_hmac_output +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST # define gnutls_hash_init fn_gnutls_hash_init # define gnutls_hash_get_len fn_gnutls_hash_get_len # define gnutls_hash fn_gnutls_hash # define gnutls_hash_deinit fn_gnutls_hash_deinit # define gnutls_hash_output fn_gnutls_hash_output +# endif +# endif /* HAVE_GNUTLS3 */ /* This wrapper is called from fns.c, which doesn't know about the LOAD_DLL_FN stuff above. */ -- cgit v1.2.1 From 178e0df2c283fa00f0aa8df0e321b846d3d8d47f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 15 Jul 2017 14:03:44 +0300 Subject: Fix compilation of gnutls.c with older GnuTLS * src/gnutrls.c (syms_of_gnutls): Condition some defsubr's on HAVE_GNUTLS3, to avoid compilation errors when GnuTLS v3.X is not available. Reported by Colin Baxter . --- src/gnutls.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 0fc5d90c3ac..7dff0a4cddc 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2518,6 +2518,7 @@ syms_of_gnutls (void) defsubr (&Sgnutls_peer_status); defsubr (&Sgnutls_peer_status_warning_describe); +#ifdef HAVE_GNUTLS3 defsubr (&Sgnutls_ciphers); defsubr (&Sgnutls_macs); defsubr (&Sgnutls_digests); @@ -2525,6 +2526,7 @@ syms_of_gnutls (void) defsubr (&Sgnutls_hash_digest); defsubr (&Sgnutls_symmetric_encrypt); defsubr (&Sgnutls_symmetric_decrypt); +#endif DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, doc: /* Logging level used by the GnuTLS functions. -- cgit v1.2.1 From cc78d5339ce8b9c2c5bf38b89fa9ea3ba748fdd4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 15 Jul 2017 14:41:44 +0300 Subject: Improve some GnuTL error messages * src/gnutls.c (gnutls_symmetric_aead, gnutls_symmetric): * src/fns.c (Fsecure_hash_algorithms): Fix error messages. --- src/fns.c | 4 ++-- src/gnutls.c | 16 ++++++++++++---- 2 files changed, 14 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/fns.c b/src/fns.c index fb1296bc6f0..d849618f2b7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4931,7 +4931,7 @@ extract_data_from_object (Lisp_Object spec, /* Format: (iv-auto REQUIRED-LENGTH). */ if (! NATNUMP (start)) - error ("Without a length, iv-auto can't be used. See manual."); + error ("Without a length, `iv-auto' can't be used; see ELisp manual"); else { EMACS_INT start_hold = XFASTINT (start); @@ -4942,7 +4942,7 @@ extract_data_from_object (Lisp_Object spec, *end_byte = start_hold; } #else - error ("GnuTLS integration is not available, so iv-auto can't be used."); + error ("GnuTLS is not available, so `iv-auto' can't be used"); #endif } diff --git a/src/gnutls.c b/src/gnutls.c index 7dff0a4cddc..5e14a3af333 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1950,8 +1950,12 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, memset (storage, 0, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); - error ("GnuTLS AEAD cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + if (encrypting) + error ("GnuTLS AEAD cipher %s encryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + else + error ("GnuTLS AEAD cipher %s decryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); } gnutls_aead_cipher_deinit (acipher); @@ -2096,8 +2100,12 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (ret < GNUTLS_E_SUCCESS) { gnutls_cipher_deinit (hcipher); - error ("GnuTLS cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + if (encrypting) + error ("GnuTLS cipher %s encryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + else + error ("GnuTLS cipher %s decryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); } gnutls_cipher_deinit (hcipher); -- cgit v1.2.1 From b30ee0c9225bad6e3fd0b511a6c5d9a64b8fd66a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 15 Jul 2017 16:54:12 +0300 Subject: Avoid link errors with older versions of GnuTLS * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead) (Fgnutls_macs, Fgnutls_digests): Conditionally compile code that calls GnuTLS functions which might be unavailable in older versions of GnuTLS. --- src/gnutls.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 5e14a3af333..e6f01a9cfe1 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1852,6 +1852,7 @@ The alist key is the cipher name. */) { Lisp_Object ciphers = Qnil; +#ifdef HAVE_GNUTLS3_CIPHER const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { @@ -1877,6 +1878,7 @@ The alist key is the cipher name. */) ciphers = Fcons (cp, ciphers); } +#endif return ciphers; } @@ -2176,6 +2178,7 @@ name. */) (void) { Lisp_Object mac_algorithms = Qnil; +#ifdef HAVE_GNUTLS3_HMAC const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { @@ -2197,6 +2200,7 @@ name. */) make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); } +#endif return mac_algorithms; } @@ -2210,6 +2214,7 @@ method name. */) (void) { Lisp_Object digest_algorithms = Qnil; +#ifdef HAVE_GNUTLS3_DIGEST const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { @@ -2226,6 +2231,7 @@ method name. */) digest_algorithms = Fcons (mp, digest_algorithms); } +#endif return digest_algorithms; } -- cgit v1.2.1 From 30444c695ae4d1184c4b6bc994c00b7b1af5ab4a Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 15 Jul 2017 21:57:18 +0100 Subject: Fix some frame handling issues on NS * lisp/frame.el (mouse-absolute-pixel-position): Use new NS function. * src/nsfns.m (Sns_mouse_absolute_pixel_position): New function. * src/nsterm.m (x_make_frame_visible): Re-establish parent-child relationship if it's broken. --- src/nsfns.m | 20 ++++++++++++++++++++ src/nsterm.m | 18 ++++++++++++++++++ 2 files changed, 38 insertions(+) (limited to 'src') diff --git a/src/nsfns.m b/src/nsfns.m index 68eba8b6a2e..36748cebb8b 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3080,6 +3080,25 @@ The coordinates X and Y are interpreted in pixels relative to a position return Qnil; } +DEFUN ("ns-mouse-absolute-pixel-position", + Fns_mouse_absolute_pixel_position, + Sns_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the +coordinates of the mouse cursor position in pixels relative to a +position (0, 0) of the selected frame's terminal. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + EmacsView *view = FRAME_NS_VIEW (f); + NSScreen *screen = [[view window] screen]; + NSPoint pt = [NSEvent mouseLocation]; + + return Fcons(make_number(pt.x - screen.frame.origin.x), + make_number(screen.frame.size.height - + (pt.y - screen.frame.origin.y))); +} + /* ========================================================================== Class implementations @@ -3269,6 +3288,7 @@ be used as the image of the icon representing the frame. */); defsubr (&Sns_frame_list_z_order); defsubr (&Sns_frame_restack); defsubr (&Sns_set_mouse_absolute_pixel_position); + defsubr (&Sns_mouse_absolute_pixel_position); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); diff --git a/src/nsterm.m b/src/nsterm.m index bf83550b3d7..a3c7031331a 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1570,6 +1570,7 @@ x_make_frame_visible (struct frame *f) if (!FRAME_VISIBLE_P (f)) { EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; SET_FRAME_VISIBLE (f, 1); ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f)); @@ -1586,6 +1587,23 @@ x_make_frame_visible (struct frame *f) [view handleFS]; unblock_input (); } + + /* Making a frame invisible seems to break the parent->child + relationship, so reinstate it. */ + if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL) + { + NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + + block_input (); + [parent addChildWindow: window + ordered: NSWindowAbove]; + unblock_input (); + + /* If the parent frame moved while the child frame was + invisible, the child frame's position won't have been + updated. Make sure it's in the right place now. */ + x_set_offset(f, f->left_pos, f->top_pos, 0); + } } } -- cgit v1.2.1 From 59f6972134f312863dc761bf66a954a8036d0d86 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 16 Jul 2017 16:22:33 -0700 Subject: Use explicit_bzero to clear GnuTLS keys * admin/merge-gnulib (GNULIB_MODULES): Add explicit_bzero. * lib/explicit_bzero.c, m4/explicit_bzero.m4: New files. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * src/gnutls.c (clear_storage): New function. (gnutls_symmetric_aead): Use it instead of memset. --- src/gnutls.c | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index e6f01a9cfe1..7d19f90fbb8 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1883,6 +1883,22 @@ The alist key is the cipher name. */) return ciphers; } +/* Zero out STORAGE (even if it will become inaccessible. It has + STORAGE_LENGTH bytes. The goal is to improve security a bit, in + case an Emacs module or some buggy part of Emacs attempts to + inspect STORAGE later to retrieve a secret. + + Calls to this function document when storage containing a secret is + known to go out of scope. This function is not guaranteed to erase + the secret, as copies of STORAGE may well be accessible elsewhere + on the machine. */ + +static void +clear_storage (void *storage, ptrdiff_t storage_length) +{ + explicit_bzero (storage, storage_length); +} + static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, @@ -1949,7 +1965,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, if (ret < GNUTLS_E_SUCCESS) { - memset (storage, 0, storage_length); + clear_storage (storage, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); if (encrypting) @@ -1963,7 +1979,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, gnutls_aead_cipher_deinit (acipher); Lisp_Object output = make_unibyte_string (storage, storage_length); - memset (storage, 0, storage_length); + clear_storage (storage, storage_length); SAFE_FREE (); return list2 (output, actual_iv); #else -- cgit v1.2.1 From b740b02d2311cb5a3dd61767f824f3bfa770184e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 16 Jul 2017 16:22:33 -0700 Subject: Use memset, not bzero * src/ftcrfont.c (ftcrfont_glyph_extents): Use memset instead of the (less-portable) bzero. --- src/ftcrfont.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/ftcrfont.c b/src/ftcrfont.c index d72005771ec..9b592e6a740 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -81,9 +81,9 @@ ftcrfont_glyph_extents (struct font *font, ftcrfont_info->metrics = xrealloc (ftcrfont_info->metrics, sizeof (struct font_metrics *) * (row + 1)); - bzero (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, - (sizeof (struct font_metrics *) - * (row + 1 - ftcrfont_info->metrics_nrows))); + memset (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 0, + (sizeof (struct font_metrics *) + * (row + 1 - ftcrfont_info->metrics_nrows))); ftcrfont_info->metrics_nrows = row + 1; } if (ftcrfont_info->metrics[row] == NULL) -- cgit v1.2.1 From 8250a20f9dd6c53ee1891c16a24c746110f594f6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 16 Jul 2017 17:27:03 -0700 Subject: * src/gnutls.c: Restore some comments. --- src/gnutls.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 7d19f90fbb8..bcccd7ffd37 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1857,7 +1857,10 @@ The alist key is the cipher name. */) for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { gnutls_cipher_algorithm_t gca = gciphers[pos]; + + /* A symbol representing the GnuTLS cipher. */ Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); Lisp_Object cp @@ -2200,9 +2203,10 @@ name. */) { const gnutls_mac_algorithm_t gma = macs[pos]; - const char *name = gnutls_mac_get_name (gma); + /* A symbol representing the GnuTLS MAC algorithm. */ + Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma)); - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, intern (name), + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol, QCmac_algorithm_id, make_number (gma), QCtype, Qgnutls_type_mac_algorithm, @@ -2236,9 +2240,10 @@ method name. */) { const gnutls_digest_algorithm_t gda = digests[pos]; - const char *name = gnutls_digest_get_name (gda); + /* A symbol representing the GnuTLS digest algorithm. */ + Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda)); - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, intern (name), + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol, QCdigest_algorithm_id, make_number (gda), QCtype, Qgnutls_type_digest_algorithm, -- cgit v1.2.1 From b7072318334ff84dfe525e7863f1119236979395 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 17 Jul 2017 09:00:55 +0200 Subject: Have Fgnutls_available_p return Qnil when GNUTLS is undefined * src/gnutls.c (Fgnutls_available_p): Return Qnil when GNUTLS is undefined to allow --with-gnutls=no builds to proceed. --- src/gnutls.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index bcccd7ffd37..9fbaea2f405 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2435,6 +2435,8 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) { Lisp_Object capabilities = Qnil; +#ifdef HAVE_GNUTLS + # ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); @@ -2470,7 +2472,11 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) return capabilities; -#endif +#endif /* WINDOWSNT */ + +#else /* !HAVE_GNUTLS */ + return Qnil; +#endif /* HAVE_GNUTLS */ } void -- cgit v1.2.1 From d7f7fef1c1cdef206860a7075873de7d6c521d8d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 17 Jul 2017 17:50:37 +0300 Subject: Allow user control on what starts and ends a paragraph for bidi * src/buffer.h (struct buffer): New members bidi_paragraph_separate_re_ and bidi_paragraph_start_re_. * src/buffer.c (bset_bidi_paragraph_start_re) (bset_bidi_paragraph_separate_re): New setters/ (Fbuffer_swap_text): Swap the values of bidi-paragraph-start-re and bidi-paragraph-separate-re. (init_buffer_once): Init the values of bidi-paragraph-start-re and bidi-paragraph-separate-re. (syms_of_buffer) : New per-buffer variables. * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start): Support bidi-paragraph-start-re and bidi-paragraph-separate-re. (bidi_move_to_visually_next): Handle correctly the case when the separator matches an empty string. (Bug#27526) * doc/emacs/mule.texi (Bidirectional Editing): * doc/lispref/display.texi (Bidirectional Display): Document bidi-paragraph-start-re and bidi-paragraph-separate-re. * etc/NEWS: Mention bidi-paragraph-start-re and bidi-paragraph-separate-re. --- src/bidi.c | 29 ++++++++++++++++++++++------- src/buffer.c | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/buffer.h | 6 ++++++ 3 files changed, 87 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/bidi.c b/src/bidi.c index e34da778ba0..763797488b0 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -1448,8 +1448,14 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos) Lisp_Object start_re; ptrdiff_t val; - sep_re = paragraph_separate_re; - start_re = paragraph_start_re; + if (STRINGP (BVAR (current_buffer, bidi_paragraph_separate_re))) + sep_re = BVAR (current_buffer, bidi_paragraph_separate_re); + else + sep_re = paragraph_separate_re; + if (STRINGP (BVAR (current_buffer, bidi_paragraph_start_re))) + start_re = BVAR (current_buffer, bidi_paragraph_start_re); + else + start_re = paragraph_start_re; val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil); if (val < 0) @@ -1523,7 +1529,10 @@ bidi_paragraph_cache_on_off (void) static ptrdiff_t bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) { - Lisp_Object re = paragraph_start_re; + Lisp_Object re = + STRINGP (BVAR (current_buffer, bidi_paragraph_start_re)) + ? BVAR (current_buffer, bidi_paragraph_start_re) + : paragraph_start_re; ptrdiff_t limit = ZV, limit_byte = ZV_BYTE; struct region_cache *bpc = bidi_paragraph_cache_on_off (); ptrdiff_t n = 0, oldpos = pos, next; @@ -3498,10 +3507,16 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it) if (sep_len >= 0) { bidi_it->new_paragraph = 1; - /* Record the buffer position of the last character of the - paragraph separator. */ - bidi_it->separator_limit - = bidi_it->charpos + bidi_it->nchars + sep_len; + /* Record the buffer position of the last character of + the paragraph separator. If the paragraph separator + is an empty string (e.g., the regex is "^"), the + newline that precedes the end of the paragraph is + that last character. */ + if (sep_len > 0) + bidi_it->separator_limit + = bidi_it->charpos + bidi_it->nchars + sep_len; + else + bidi_it->separator_limit = bidi_it->charpos; } } } diff --git a/src/buffer.c b/src/buffer.c index e0972aac33c..649ddbe1839 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -173,6 +173,16 @@ bset_bidi_display_reordering (struct buffer *b, Lisp_Object val) b->bidi_display_reordering_ = val; } static void +bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val) +{ + b->bidi_paragraph_start_re_ = val; +} +static void +bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val) +{ + b->bidi_paragraph_separate_re_ = val; +} +static void bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) { b->buffer_file_coding_system_ = val; @@ -2322,6 +2332,8 @@ results, see Info node `(elisp)Swapping Text'. */) swapfield_ (enable_multibyte_characters, Lisp_Object); swapfield_ (bidi_display_reordering, Lisp_Object); swapfield_ (bidi_paragraph_direction, Lisp_Object); + swapfield_ (bidi_paragraph_separate_re, Lisp_Object); + swapfield_ (bidi_paragraph_start_re, Lisp_Object); /* FIXME: Not sure what we should do with these *_marker fields. Hopefully they're just nil anyway. */ swapfield_ (pt_marker, Lisp_Object); @@ -5121,6 +5133,8 @@ init_buffer_once (void) XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; @@ -5202,6 +5216,8 @@ init_buffer_once (void) bset_ctl_arrow (&buffer_defaults, Qt); bset_bidi_display_reordering (&buffer_defaults, Qt); bset_bidi_paragraph_direction (&buffer_defaults, Qnil); + bset_bidi_paragraph_start_re (&buffer_defaults, Qnil); + bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil); bset_cursor_type (&buffer_defaults, Qt); bset_extra_line_spacing (&buffer_defaults, Qnil); bset_cursor_in_non_selected_windows (&buffer_defaults, Qt); @@ -5616,6 +5632,49 @@ This variable is never applied to a way of decoding a file while reading it. */ &BVAR (current_buffer, bidi_display_reordering), Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); + DEFVAR_PER_BUFFER ("bidi-paragraph-start-re", + &BVAR (current_buffer, bidi_paragraph_start_re), Qnil, + doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs. + +The value of nil means to use empty lines as lines that start and +separate paragraphs. + +When Emacs displays bidirectional text, it by default computes +the base paragraph direction separately for each paragraph. +Setting this variable changes the places where paragraph base +direction is recomputed. + +The regexp is always matched after a newline, so it is best to +anchor it by beginning it with a "^". + +If you change the value of this variable, be sure to change +the value of `bidi-paragraph-separate-re' accordingly. For +example, to have a single newline behave as a paragraph separator, +set both these variables to "^". + +See also `bidi-paragraph-direction'. */); + + DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re", + &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil, + doc: /* If non-nil, a regexp matching a line that separates paragraphs. + +The value of nil means to use empty lines as paragraph separators. + +When Emacs displays bidirectional text, it by default computes +the base paragraph direction separately for each paragraph. +Setting this variable changes the places where paragraph base +direction is recomputed. + +The regexp is always matched after a newline, so it is best to +anchor it by beginning it with a "^". + +If you change the value of this variable, be sure to change +the value of `bidi-paragraph-start-re' accordingly. For +example, to have a single newline behave as a paragraph separator, +set both these variables to "^". + +See also `bidi-paragraph-direction'. */); + DEFVAR_PER_BUFFER ("bidi-paragraph-direction", &BVAR (current_buffer, bidi_paragraph_direction), Qnil, doc: /* If non-nil, forces directionality of text paragraphs in the buffer. diff --git a/src/buffer.h b/src/buffer.h index be270fe4823..46ca6aa7384 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -611,6 +611,12 @@ struct buffer direction dynamically for each paragraph. */ Lisp_Object bidi_paragraph_direction_; + /* If non-nil, a regular expression for bidi paragraph separator. */ + Lisp_Object bidi_paragraph_separate_re_; + + /* If non-nil, a regular expression for bidi paragraph start. */ + Lisp_Object bidi_paragraph_start_re_; + /* Non-nil means do selective display; see doc string in syms_of_buffer (buffer.c) for details. */ Lisp_Object selective_display_; -- cgit v1.2.1 From 4198b4d985db77ad6ae372fa048250e93de5013c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 16 Jul 2017 16:42:26 +0200 Subject: Get positions of menus and tooltips right on HiDPI * src/gtkutil.c (xg_get_scale): New function. (xg_show_tooltip): Use it. * src/xmenu.c (create_and_show_popup_menu): Put menus in the right place. --- src/gtkutil.c | 11 ++++++++++- src/gtkutil.h | 1 + src/xmenu.c | 5 +++++ 3 files changed, 16 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index 2d4abefa969..255091559e9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,6 +204,14 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +/* Scaling/HiDPI functions. */ +int +xg_get_scale (struct frame *f) +{ + if (FRAME_VISIBLE_P (f) && FRAME_GTK_WIDGET (f)) + return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); + return 1; +} /* Close display DPY. */ @@ -724,7 +732,8 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y) if (x->ttip_window) { block_input (); - gtk_window_move (x->ttip_window, root_x, root_y); + gtk_window_move (x->ttip_window, root_x / xg_get_scale (f), + root_y / xg_get_scale (f)); gtk_widget_show_all (GTK_WIDGET (x->ttip_window)); unblock_input (); } diff --git a/src/gtkutil.h b/src/gtkutil.h index 0abcb06bc71..a252cbef99c 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f, extern void xg_frame_set_char_size (struct frame *f, int width, int height); extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); +extern int xg_get_scale (struct frame *f); extern void xg_display_open (char *display_name, Display **dpy); extern void xg_display_close (Display *dpy); extern GdkCursor * xg_create_default_cursor (Display *dpy); diff --git a/src/xmenu.c b/src/xmenu.c index 6c8a0c506cc..64df151b289 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1271,6 +1271,11 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Child of win. */ &dummy_window); +#ifdef HAVE_GTK3 + /* Use window scaling factor to adjust position for hidpi screens. */ + x /= xg_get_scale (f); + y /= xg_get_scale (f); +#endif unblock_input (); popup_x_y.x = x; popup_x_y.y = y; -- cgit v1.2.1 From 36cf0791ba75ee16dfbedfe437567ec6dd945b8a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 16 Jul 2017 16:50:57 +0200 Subject: Remove usage of the GDK_SCALE variable * src/gtkutil.c (xg_get_gdk_scale): Remove. (xg_get_default_scrollbar_height) (xg_get_default_scrollbar_width): Pass in a frame to check for scaling. (xg_frame_set_char_size): Use the API for querying scale instead of looking at the GDK_SCALE variable. (xg_get_default_scrollbar_width): Ditto. (xg_get_default_scrollbar_height): Ditto. (xg_update_scrollbar_pos): Ditto. * src/xfns.c (x_set_scroll_bar_default_height): Pass in the frame to get the width. --- src/gtkutil.c | 35 ++++++++--------------------------- src/gtkutil.h | 4 ++-- src/xfns.c | 4 ++-- 3 files changed, 12 insertions(+), 31 deletions(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index 255091559e9..ccc42773217 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -845,21 +845,6 @@ xg_set_geometry (struct frame *f) } } -static int -xg_get_gdk_scale (void) -{ - const char *sscale = getenv ("GDK_SCALE"); - - if (sscale) - { - long scale = atol (sscale); - if (0 < scale) - return min (scale, INT_MAX); - } - - return 1; -} - /* Function to handle resize of our frame. As we have a Gtk+ tool bar and a Gtk+ menu bar, we get resize events for the edit part of the frame only. We let Gtk+ deal with the Gtk+ parts. @@ -921,12 +906,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height) /* Do this before resize, as we don't know yet if we will be resized. */ x_clear_under_internal_border (f); - if (FRAME_VISIBLE_P (f)) - { - int scale = xg_get_gdk_scale (); - totalheight /= scale; - totalwidth /= scale; - } + totalheight /= xg_get_scale (f); + totalwidth /= xg_get_scale (f); x_wm_set_size_hint (f, 0, 0); @@ -1352,7 +1333,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) int min_rows = 0, min_cols = 0; int win_gravity = f->win_gravity; Lisp_Object fs_state, frame; - int scale = xg_get_gdk_scale (); + int scale = xg_get_scale (f); /* Don't set size hints during initialization; that apparently leads to a race condition. See the thread at @@ -3668,16 +3649,16 @@ update_theme_scrollbar_height (void) } int -xg_get_default_scrollbar_width (void) +xg_get_default_scrollbar_width (struct frame *f) { - return scroll_bar_width_for_theme * xg_get_gdk_scale (); + return scroll_bar_width_for_theme * xg_get_scale (f); } int -xg_get_default_scrollbar_height (void) +xg_get_default_scrollbar_height (struct frame *f) { /* Apparently there's no default height for themes. */ - return scroll_bar_width_for_theme * xg_get_gdk_scale (); + return scroll_bar_width_for_theme * xg_get_scale (f); } /* Return the scrollbar id for X Window WID on display DPY. @@ -3867,7 +3848,7 @@ xg_update_scrollbar_pos (struct frame *f, GtkWidget *wfixed = f->output_data.x->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); gint msl; - int scale = xg_get_gdk_scale (); + int scale = xg_get_scale (f); top /= scale; left /= scale; diff --git a/src/gtkutil.h b/src/gtkutil.h index a252cbef99c..f0f2981418c 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -143,8 +143,8 @@ extern void xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole); extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); -extern int xg_get_default_scrollbar_width (void); -extern int xg_get_default_scrollbar_height (void); +extern int xg_get_default_scrollbar_width (struct frame *f); +extern int xg_get_default_scrollbar_height (struct frame *f); extern void update_frame_tool_bar (struct frame *f); extern void free_frame_tool_bar (struct frame *f); diff --git a/src/xfns.c b/src/xfns.c index d8bf9747191..2f8c9c25416 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2062,7 +2062,7 @@ x_set_scroll_bar_default_width (struct frame *f) int unit = FRAME_COLUMN_WIDTH (f); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK - int minw = xg_get_default_scrollbar_width (); + int minw = xg_get_default_scrollbar_width (f); #else int minw = 16; #endif @@ -2083,7 +2083,7 @@ x_set_scroll_bar_default_height (struct frame *f) int height = FRAME_LINE_HEIGHT (f); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK - int min_height = xg_get_default_scrollbar_height (); + int min_height = xg_get_default_scrollbar_height (f); #else int min_height = 16; #endif -- cgit v1.2.1 From b04132754e845d84e7e1b5c8bca581c64200aa64 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 16 Jul 2017 16:54:51 +0200 Subject: Always return the GDK scale * src/gtkutil.c (xg_get_scale): Return the GDK scale always. --- src/gtkutil.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index ccc42773217..6c9e069001e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -208,7 +208,7 @@ xg_display_open (char *display_name, Display **dpy) int xg_get_scale (struct frame *f) { - if (FRAME_VISIBLE_P (f) && FRAME_GTK_WIDGET (f)) + if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); return 1; } -- cgit v1.2.1 From 552c90edb8cbf673b9a7d07ea39338585fce904a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 16 Jul 2017 17:31:54 +0200 Subject: Make scaling work (?) on pre-GTK3 systems * src/gtkutil.c (xg_get_gdk_scale): Reinstate function. (xg_get_scale): Use it on non-GTK3 systems. --- src/gtkutil.c | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index 6c9e069001e..dddf8b1c25c 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,13 +204,30 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +static int +xg_get_gdk_scale (void) +{ + const char *sscale = getenv ("GDK_SCALE"); + + if (sscale) + { + long scale = atol (sscale); + if (0 < scale) + return min (scale, INT_MAX); + } + + return 1; +} + /* Scaling/HiDPI functions. */ int xg_get_scale (struct frame *f) { +#ifdef HAVE_GTK3 if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); - return 1; +#endif + return xg_get_gdk_scale (); } /* Close display DPY. */ -- cgit v1.2.1 From 727b3df056d978c05bb5dbce5cef715b3b7c31db Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 16 Jul 2017 17:32:43 +0200 Subject: Move comments around --- src/gtkutil.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index dddf8b1c25c..03319726f09 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,6 +204,7 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +/* Scaling/HiDPI functions. */ static int xg_get_gdk_scale (void) { @@ -219,7 +220,6 @@ xg_get_gdk_scale (void) return 1; } -/* Scaling/HiDPI functions. */ int xg_get_scale (struct frame *f) { -- cgit v1.2.1 From 1a62721f2d82f7a35a9fc84864f6df0ede2c05c5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 18 Jul 2017 00:37:03 -0700 Subject: Port gnutls.c to older (buggier?) GnuTLS Problem reported for GnuTLS 3.2.1 by Glenn Morris in: http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00716.html http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00742.html Although I don't see how this bug can occur with vanilla GnuTLS 3.2.1, perhaps hydra was using a modified GnuTLS. * src/gnutls.c (Fgnutls_ciphers): Don't assume GNUTLS_CIPHER_NULL is at the end of the list returned by gnutls_cipher_list, or that the earlier ciphers all have non-null names. --- src/gnutls.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 9fbaea2f405..e406d665190 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1854,12 +1854,17 @@ The alist key is the cipher name. */) #ifdef HAVE_GNUTLS3_CIPHER const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); - for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++) { gnutls_cipher_algorithm_t gca = gciphers[pos]; + if (gca == GNUTLS_CIPHER_NULL) + continue; + char const *cipher_name = gnutls_cipher_get_name (gca); + if (!cipher_name) + continue; /* A symbol representing the GnuTLS cipher. */ - Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + Lisp_Object cipher_symbol = intern (cipher_name); ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); -- cgit v1.2.1 From 742caff3b80b199020ea3d66b5f162cc43ec6174 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 18 Jul 2017 15:31:28 +0200 Subject: Don't use gtk_widget_get_scale_factor on old GTK3 versions * src/gtkutil.c (xg_get_scale): gtk_widget_get_scale_factor is only present since GTK 3.10. --- src/gtkutil.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/gtkutil.c b/src/gtkutil.c index 03319726f09..0c8395efe9b 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -223,7 +223,7 @@ xg_get_gdk_scale (void) int xg_get_scale (struct frame *f) { -#ifdef HAVE_GTK3 +#if GTK_CHECK_VERSION (3, 10, 0) if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); #endif -- cgit v1.2.1 From a20f4f02c69544fdc23be9b61bad3387476e102d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 18 Jul 2017 17:25:30 +0300 Subject: Fix indentation when display-line-numbers is non-nil * src/xdisp.c (x_produce_glyphs): Fix a typo in deciding whether to go one more tab stop to display a TAB. (Bug#27743) --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 2aceb89c003..a3bc5a5fccd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28082,7 +28082,7 @@ x_produce_glyphs (struct it *it) /* If the distance from the current position to the next tab stop is less than a space character width, use the tab stop after that. */ - if (next_tab_x - x0 < font->space_width) + if (next_tab_x - x < font->space_width) next_tab_x += tab_width; if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width) next_tab_x += (it->lnum_pixel_width -- cgit v1.2.1 From c2049489090141311bf8f460bf366d9784950861 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 18 Jul 2017 19:13:58 +0300 Subject: Avoid infloop due to Eshell's "smart" redisplay * src/xdisp.c (pos_visible_p): Save and restore the window's mode-line and header-line height. (Bug#27752) --- src/xdisp.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index a3bc5a5fccd..c415bf2131f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1326,6 +1326,15 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, if (charpos >= 0 && CHARPOS (top) > charpos) return visible_p; + /* Some Lisp hook could call us in the middle of redisplaying this + very window. If, by some bad luck, we are retrying redisplay + because we found that the mode-line height and/or header-line + height needs to be updated, the assignment of mode_line_height + and header_line_height below could disrupt that, due to the + selected/nonselected window dance during mode-line display, and + we could infloop. Avoid that. */ + int prev_mode_line_height = w->mode_line_height; + int prev_header_line_height = w->header_line_height; /* Compute exact mode line heights. */ if (window_wants_mode_line (w)) { @@ -1672,6 +1681,10 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll); #endif + /* Restore potentially overwritten values. */ + w->mode_line_height = prev_mode_line_height; + w->header_line_height = prev_header_line_height; + return visible_p; } -- cgit v1.2.1 From eda9aa0d314ca8e8919d4c17927aa86290449f8d Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Wed, 19 Jul 2017 21:21:40 +0200 Subject: * src/gnutls.c (clear_storage): Define only if needed. --- src/gnutls.c | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index e406d665190..7c988408528 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1891,6 +1891,8 @@ The alist key is the cipher name. */) return ciphers; } +#ifdef HAVE_GNUTLS3_AEAD + /* Zero out STORAGE (even if it will become inaccessible. It has STORAGE_LENGTH bytes. The goal is to improve security a bit, in case an Emacs module or some buggy part of Emacs attempts to @@ -1907,6 +1909,8 @@ clear_storage (void *storage, ptrdiff_t storage_length) explicit_bzero (storage, storage_length); } +#endif /* HAVE_GNUTLS3_AEAD */ + static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, -- cgit v1.2.1 From 9c6cacd338c90180bc377cae923c716c1dc3d14c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 20 Jul 2017 16:25:11 +0300 Subject: Fix hscrolling calculations when display-line-numbers is set * src/xdisp.c (move_it_in_display_line_to): Account for line numbers in hscrolled lines. (Bug#27756) --- src/xdisp.c | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index c415bf2131f..3e5657ffe6f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8631,6 +8631,7 @@ move_it_in_display_line_to (struct it *it, ptrdiff_t closest_pos UNINIT; ptrdiff_t prev_pos = IT_CHARPOS (*it); bool saw_smaller_pos = prev_pos < to_charpos; + bool line_number_pending = false; /* Don't produce glyphs in produce_glyphs. */ saved_glyph_row = it->glyph_row; @@ -8682,9 +8683,13 @@ move_it_in_display_line_to (struct it *it, if (it->hpos == 0) { /* If line numbers are being displayed, produce a line number. */ - if (should_produce_line_number (it) - && it->current_x == it->first_visible_x) - maybe_produce_line_number (it); + if (should_produce_line_number (it)) + { + if (it->current_x == it->first_visible_x) + maybe_produce_line_number (it); + else + line_number_pending = true; + } /* If there's a line-/wrap-prefix, handle it. */ if (it->method == GET_FROM_BUFFER) handle_line_prefix (it); @@ -9055,6 +9060,15 @@ move_it_in_display_line_to (struct it *it, if (new_x > it->first_visible_x) { + /* If we have reached the visible portion of the + screen line, produce the line number if needed. */ + if (line_number_pending) + { + line_number_pending = false; + it->current_x = it->first_visible_x; + maybe_produce_line_number (it); + it->current_x += new_x - it->first_visible_x; + } /* Glyph is visible. Increment number of glyphs that would be displayed. */ ++it->hpos; -- cgit v1.2.1 From ffde1e9b9e9aa763e18f009e0d54345f509134db Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 20 Jul 2017 16:21:57 -0700 Subject: Simplify recent gnutls.c changes * src/gnutls.c (clear_storage) [HAVE_GNUTLS3_AEAD]: Remove. All uses replaced by calls to explicit_bzero; that’s clear enough. (gnutls_symmetric_aead) [HAVE_GNUTLS3_AEAD]: Simplify by coalescing duplicate actions. There is no need to invoke SAFE_FREE before calling ‘error’. --- src/gnutls.c | 45 ++++++++++----------------------------------- 1 file changed, 10 insertions(+), 35 deletions(-) (limited to 'src') diff --git a/src/gnutls.c b/src/gnutls.c index 7c988408528..59694074e16 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1891,26 +1891,6 @@ The alist key is the cipher name. */) return ciphers; } -#ifdef HAVE_GNUTLS3_AEAD - -/* Zero out STORAGE (even if it will become inaccessible. It has - STORAGE_LENGTH bytes. The goal is to improve security a bit, in - case an Emacs module or some buggy part of Emacs attempts to - inspect STORAGE later to retrieve a secret. - - Calls to this function document when storage containing a secret is - known to go out of scope. This function is not guaranteed to erase - the secret, as copies of STORAGE may well be accessible elsewhere - on the machine. */ - -static void -clear_storage (void *storage, ptrdiff_t storage_length) -{ - explicit_bzero (storage, storage_length); -} - -#endif /* HAVE_GNUTLS3_AEAD */ - static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, @@ -1975,23 +1955,18 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, (acipher, vdata, vsize, aead_auth_data, aead_auth_size, cipher_tag_size, idata, isize, storage, &storage_length)); - if (ret < GNUTLS_E_SUCCESS) - { - clear_storage (storage, storage_length); - SAFE_FREE (); - gnutls_aead_cipher_deinit (acipher); - if (encrypting) - error ("GnuTLS AEAD cipher %s encryption failed: %s", - gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); - else - error ("GnuTLS AEAD cipher %s decryption failed: %s", - gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); - } - + Lisp_Object output; + if (GNUTLS_E_SUCCESS <= ret) + output = make_unibyte_string (storage, storage_length); + explicit_bzero (storage, storage_length); gnutls_aead_cipher_deinit (acipher); - Lisp_Object output = make_unibyte_string (storage, storage_length); - clear_storage (storage, storage_length); + if (ret < GNUTLS_E_SUCCESS) + error ((encrypting + ? "GnuTLS AEAD cipher %s encryption failed: %s" + : "GnuTLS AEAD cipher %s decryption failed: %s"), + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + SAFE_FREE (); return list2 (output, actual_iv); #else -- cgit v1.2.1 From ebb78a7bfa3e6a87cfb53f1f2b17fc2f61add595 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sat, 22 Jul 2017 12:16:08 +0300 Subject: Add a minor mode interface for display-line-numbers * lisp/cus-start.el: Use the new display-line-numbers group. * lisp/display-line-numbers.el: New file. * doc/emacs/custom.texi (Init Rebinding): Re-add entry that used to belong to linum-mode. * doc/emacs/modes.texi (Minor Modes): Summarize the mode. * etc/NEWS: Document display-line-numbers-mode and its customization variables, and mention that display-line-numbers-width is buffer-local. * src/xdisp.c (syms_of_xdisp) : Fix a typo. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/xdisp.c b/src/xdisp.c index 3e5657ffe6f..422912e57a6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32745,7 +32745,7 @@ even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); Vdisplay_line_numbers_width = Qnil; - DEFSYM (Qdisplay_line_numbers_width, "display-line-number-width"); + DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width"); Fmake_variable_buffer_local (Qdisplay_line_numbers_width); DEFVAR_LISP ("display-line-numbers-current-absolute", -- cgit v1.2.1 From 8b18911a5c7c6c8a15b3cff12a4376ba68205e1c Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 7 Jun 2017 19:59:09 -0400 Subject: Signal error for symbol names with strange quotes (Bug#2967) * src/lread.c (read1): Signal an error when a symbol starts with a non-escaped quote-like character. * test/src/lread-tests.el (lread-tests--funny-quote-symbols): New test. * etc/NEWS: Announce change. --- src/lread.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'src') diff --git a/src/lread.c b/src/lread.c index 901e40b3489..dbaadce4b40 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3479,6 +3479,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (! NILP (result)) return unbind_to (count, result); } + if (!quoted && multibyte) + { + int ch = STRING_CHAR ((unsigned char *) read_buffer); + switch (ch) + { + case 0x2018: /* LEFT SINGLE QUOTATION MARK */ + case 0x2019: /* RIGHT SINGLE QUOTATION MARK */ + case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x201C: /* LEFT DOUBLE QUOTATION MARK */ + case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */ + case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x301E: /* DOUBLE PRIME QUOTATION MARK */ + case 0xFF02: /* FULLWIDTH QUOTATION MARK */ + case 0xFF07: /* FULLWIDTH APOSTROPHE */ + xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"), + CALLN (Fstring, make_number (ch))); + } + } { Lisp_Object result; ptrdiff_t nbytes = p - read_buffer; -- cgit v1.2.1 From 2c87aab57946b95d67b664259f30e64468d08544 Mon Sep 17 00:00:00 2001 From: Charles A. Roelli Date: Mon, 10 Jul 2017 21:08:14 +0200 Subject: Enable GUI Emacs without 'make install' on macOS (Bug #27645) * nextstep/INSTALL: Correct it, and mention that Emacs can be run from 'src/emacs'. * src/nsterm.m (applicationDidFinishLaunching:): When Emacs is launched outside of a macOS application bundle, change its activation policy from the default 'prohibited' to 'regular'. ; * etc/NEWS: Mention the change on macOS. --- src/nsterm.m | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src') diff --git a/src/nsterm.m b/src/nsterm.m index a3c7031331a..36d906a7cec 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5497,6 +5497,19 @@ ns_term_shutdown (int sig) object:nil]; #endif +#ifdef NS_IMPL_COCOA + if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) { + /* Set the app's activation policy to regular when we run outside + of a bundle. This is already done for us by Info.plist when we + run inside a bundle. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular]; + [NSApp setApplicationIconImage: + [EmacsImage + allocInitFromFile: + build_string("icons/hicolor/128x128/apps/emacs.png")]]; + } +#endif + ns_send_appdefined (-2); } -- cgit v1.2.1 From 7a4d9f6304cffa39642507609605bcbfa40d4675 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Tue, 25 Jul 2017 01:12:50 +0200 Subject: Properly align global lispsym * lib-src/make-docfile.c (close_emacs_globals): Wrap struct Lisp_Symbols inside struct. * src/alloc.c (sweep_symbols): Update use of lispsym. * src/lisp.h (builtin_lisp_symbol): Likewise. --- src/alloc.c | 2 +- src/lisp.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/alloc.c b/src/alloc.c index 2d785d5b9a4..2cee6462564 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6943,7 +6943,7 @@ sweep_symbols (void) symbol_free_list = NULL; for (int i = 0; i < ARRAYELTS (lispsym); i++) - lispsym[i].gcmarkbit = 0; + lispsym[i].s.gcmarkbit = 0; for (sblk = symbol_block; sblk; sblk = *sprev) { diff --git a/src/lisp.h b/src/lisp.h index 9464bf8559f..cffaf954b3b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -838,13 +838,13 @@ make_lisp_symbol (struct Lisp_Symbol *sym) INLINE Lisp_Object builtin_lisp_symbol (int index) { - return make_lisp_symbol (lispsym + index); + return make_lisp_symbol (&lispsym[index].s); } INLINE void (CHECK_SYMBOL) (Lisp_Object x) { - lisp_h_CHECK_SYMBOL (x); + lisp_h_CHECK_SYMBOL (x); } /* In the size word of a vector, this bit means the vector has been marked. */ -- cgit v1.2.1