aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMichael R. Mauger2017-07-24 22:15:04 -0400
committerMichael R. Mauger2017-07-24 22:15:04 -0400
commitdf1a71272e5cdd10b511e2ffd702ca50ddd8a773 (patch)
tree9b9ac725394ee80891e2bff57b6407d0e491e71a /src
parenteb27fc4d49e8c914cd0e6a8a2d02159601542141 (diff)
parent32daa3cb54523006c88717cbeac87964cd687a1b (diff)
downloademacs-df1a71272e5cdd10b511e2ffd702ca50ddd8a773.tar.gz
emacs-df1a71272e5cdd10b511e2ffd702ca50ddd8a773.zip
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c6
-rw-r--r--src/bidi.c29
-rw-r--r--src/buffer.c88
-rw-r--r--src/buffer.h6
-rw-r--r--src/charset.c90
-rw-r--r--src/coding.c6
-rw-r--r--src/dbusbind.c6
-rw-r--r--src/dispextern.h22
-rw-r--r--src/emacs-module.c22
-rw-r--r--src/eval.c9
-rw-r--r--src/fns.c160
-rw-r--r--src/font.c2
-rw-r--r--src/fontset.c2
-rw-r--r--src/ftcrfont.c6
-rw-r--r--src/gfilenotify.c2
-rw-r--r--src/gnutls.c811
-rw-r--r--src/gnutls.h5
-rw-r--r--src/gtkutil.c63
-rw-r--r--src/gtkutil.h5
-rw-r--r--src/image.c99
-rw-r--r--src/indent.c70
-rw-r--r--src/intervals.c66
-rw-r--r--src/intervals.h3
-rw-r--r--src/keyboard.c2
-rw-r--r--src/keymap.c2
-rw-r--r--src/lisp.h7
-rw-r--r--src/lread.c239
-rw-r--r--src/nsfns.m20
-rw-r--r--src/nsterm.m31
-rw-r--r--src/print.c8
-rw-r--r--src/process.c2
-rw-r--r--src/sysdep.c2
-rw-r--r--src/term.c8
-rw-r--r--src/thread.c10
-rw-r--r--src/thread.h10
-rw-r--r--src/w32fns.c2
-rw-r--r--src/w32font.c2
-rw-r--r--src/w32notify.c4
-rw-r--r--src/w32proc.c63
-rw-r--r--src/w32term.c2
-rw-r--r--src/xdisp.c620
-rw-r--r--src/xfns.c4
-rw-r--r--src/xfont.c3
-rw-r--r--src/xmenu.c5
44 files changed, 2145 insertions, 479 deletions
diff --git a/src/alloc.c b/src/alloc.c
index ac3de83b2b6..2cee6462564 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1553,7 +1553,7 @@ make_interval (void)
1553/* Mark Lisp objects in interval I. */ 1553/* Mark Lisp objects in interval I. */
1554 1554
1555static void 1555static void
1556mark_interval (register INTERVAL i, Lisp_Object dummy) 1556mark_interval (INTERVAL i, void *dummy)
1557{ 1557{
1558 /* Intervals should never be shared. So, if extra internal checking is 1558 /* Intervals should never be shared. So, if extra internal checking is
1559 enabled, GC aborts if it seems to have visited an interval twice. */ 1559 enabled, GC aborts if it seems to have visited an interval twice. */
@@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
1567#define MARK_INTERVAL_TREE(i) \ 1567#define MARK_INTERVAL_TREE(i) \
1568 do { \ 1568 do { \
1569 if (i && !i->gcmarkbit) \ 1569 if (i && !i->gcmarkbit) \
1570 traverse_intervals_noorder (i, mark_interval, Qnil); \ 1570 traverse_intervals_noorder (i, mark_interval, NULL); \
1571 } while (0) 1571 } while (0)
1572 1572
1573/*********************************************************************** 1573/***********************************************************************
@@ -6943,7 +6943,7 @@ sweep_symbols (void)
6943 symbol_free_list = NULL; 6943 symbol_free_list = NULL;
6944 6944
6945 for (int i = 0; i < ARRAYELTS (lispsym); i++) 6945 for (int i = 0; i < ARRAYELTS (lispsym); i++)
6946 lispsym[i].gcmarkbit = 0; 6946 lispsym[i].s.gcmarkbit = 0;
6947 6947
6948 for (sblk = symbol_block; sblk; sblk = *sprev) 6948 for (sblk = symbol_block; sblk; sblk = *sprev)
6949 { 6949 {
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)
1448 Lisp_Object start_re; 1448 Lisp_Object start_re;
1449 ptrdiff_t val; 1449 ptrdiff_t val;
1450 1450
1451 sep_re = paragraph_separate_re; 1451 if (STRINGP (BVAR (current_buffer, bidi_paragraph_separate_re)))
1452 start_re = paragraph_start_re; 1452 sep_re = BVAR (current_buffer, bidi_paragraph_separate_re);
1453 else
1454 sep_re = paragraph_separate_re;
1455 if (STRINGP (BVAR (current_buffer, bidi_paragraph_start_re)))
1456 start_re = BVAR (current_buffer, bidi_paragraph_start_re);
1457 else
1458 start_re = paragraph_start_re;
1453 1459
1454 val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil); 1460 val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil);
1455 if (val < 0) 1461 if (val < 0)
@@ -1523,7 +1529,10 @@ bidi_paragraph_cache_on_off (void)
1523static ptrdiff_t 1529static ptrdiff_t
1524bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) 1530bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
1525{ 1531{
1526 Lisp_Object re = paragraph_start_re; 1532 Lisp_Object re =
1533 STRINGP (BVAR (current_buffer, bidi_paragraph_start_re))
1534 ? BVAR (current_buffer, bidi_paragraph_start_re)
1535 : paragraph_start_re;
1527 ptrdiff_t limit = ZV, limit_byte = ZV_BYTE; 1536 ptrdiff_t limit = ZV, limit_byte = ZV_BYTE;
1528 struct region_cache *bpc = bidi_paragraph_cache_on_off (); 1537 struct region_cache *bpc = bidi_paragraph_cache_on_off ();
1529 ptrdiff_t n = 0, oldpos = pos, next; 1538 ptrdiff_t n = 0, oldpos = pos, next;
@@ -3498,10 +3507,16 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
3498 if (sep_len >= 0) 3507 if (sep_len >= 0)
3499 { 3508 {
3500 bidi_it->new_paragraph = 1; 3509 bidi_it->new_paragraph = 1;
3501 /* Record the buffer position of the last character of the 3510 /* Record the buffer position of the last character of
3502 paragraph separator. */ 3511 the paragraph separator. If the paragraph separator
3503 bidi_it->separator_limit 3512 is an empty string (e.g., the regex is "^"), the
3504 = bidi_it->charpos + bidi_it->nchars + sep_len; 3513 newline that precedes the end of the paragraph is
3514 that last character. */
3515 if (sep_len > 0)
3516 bidi_it->separator_limit
3517 = bidi_it->charpos + bidi_it->nchars + sep_len;
3518 else
3519 bidi_it->separator_limit = bidi_it->charpos;
3505 } 3520 }
3506 } 3521 }
3507 } 3522 }
diff --git a/src/buffer.c b/src/buffer.c
index 80dbd3318dc..649ddbe1839 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -173,6 +173,16 @@ bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
173 b->bidi_display_reordering_ = val; 173 b->bidi_display_reordering_ = val;
174} 174}
175static void 175static void
176bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val)
177{
178 b->bidi_paragraph_start_re_ = val;
179}
180static void
181bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val)
182{
183 b->bidi_paragraph_separate_re_ = val;
184}
185static void
176bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) 186bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
177{ 187{
178 b->buffer_file_coding_system_ = val; 188 b->buffer_file_coding_system_ = val;
@@ -1164,7 +1174,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1164 { /* Look in local_var_alist. */ 1174 { /* Look in local_var_alist. */
1165 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); 1175 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1166 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ 1176 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
1167 result = Fassoc (variable, BVAR (buf, local_var_alist)); 1177 result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
1168 if (!NILP (result)) 1178 if (!NILP (result))
1169 { 1179 {
1170 if (blv->fwd) 1180 if (blv->fwd)
@@ -2322,6 +2332,8 @@ results, see Info node `(elisp)Swapping Text'. */)
2322 swapfield_ (enable_multibyte_characters, Lisp_Object); 2332 swapfield_ (enable_multibyte_characters, Lisp_Object);
2323 swapfield_ (bidi_display_reordering, Lisp_Object); 2333 swapfield_ (bidi_display_reordering, Lisp_Object);
2324 swapfield_ (bidi_paragraph_direction, Lisp_Object); 2334 swapfield_ (bidi_paragraph_direction, Lisp_Object);
2335 swapfield_ (bidi_paragraph_separate_re, Lisp_Object);
2336 swapfield_ (bidi_paragraph_start_re, Lisp_Object);
2325 /* FIXME: Not sure what we should do with these *_marker fields. 2337 /* FIXME: Not sure what we should do with these *_marker fields.
2326 Hopefully they're just nil anyway. */ 2338 Hopefully they're just nil anyway. */
2327 swapfield_ (pt_marker, Lisp_Object); 2339 swapfield_ (pt_marker, Lisp_Object);
@@ -3054,6 +3066,33 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
3054 return i < n; 3066 return i < n;
3055} 3067}
3056 3068
3069/* Return the value of the 'display-line-numbers-disable' property at
3070 EOB, if there's an overlay at ZV with a non-nil value of that property. */
3071Lisp_Object
3072disable_line_numbers_overlay_at_eob (void)
3073{
3074 ptrdiff_t n, i, size;
3075 Lisp_Object *v, tem = Qnil;
3076 Lisp_Object vbuf[10];
3077 USE_SAFE_ALLOCA;
3078
3079 size = ARRAYELTS (vbuf);
3080 v = vbuf;
3081 n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
3082 if (n > size)
3083 {
3084 SAFE_NALLOCA (v, 1, n);
3085 overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
3086 }
3087
3088 for (i = 0; i < n; ++i)
3089 if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
3090 !NILP (tem)))
3091 break;
3092
3093 SAFE_FREE ();
3094 return tem;
3095}
3057 3096
3058 3097
3059/* Fast function to just test if we're at an overlay boundary. */ 3098/* Fast function to just test if we're at an overlay boundary. */
@@ -5094,6 +5133,8 @@ init_buffer_once (void)
5094 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; 5133 XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
5095 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; 5134 XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
5096 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; 5135 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
5136 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx;
5137 XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx;
5097 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); 5138 XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
5098 /* Make this one a permanent local. */ 5139 /* Make this one a permanent local. */
5099 buffer_permanent_local_flags[idx++] = 1; 5140 buffer_permanent_local_flags[idx++] = 1;
@@ -5175,6 +5216,8 @@ init_buffer_once (void)
5175 bset_ctl_arrow (&buffer_defaults, Qt); 5216 bset_ctl_arrow (&buffer_defaults, Qt);
5176 bset_bidi_display_reordering (&buffer_defaults, Qt); 5217 bset_bidi_display_reordering (&buffer_defaults, Qt);
5177 bset_bidi_paragraph_direction (&buffer_defaults, Qnil); 5218 bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
5219 bset_bidi_paragraph_start_re (&buffer_defaults, Qnil);
5220 bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil);
5178 bset_cursor_type (&buffer_defaults, Qt); 5221 bset_cursor_type (&buffer_defaults, Qt);
5179 bset_extra_line_spacing (&buffer_defaults, Qnil); 5222 bset_extra_line_spacing (&buffer_defaults, Qnil);
5180 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt); 5223 bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
@@ -5589,6 +5632,49 @@ This variable is never applied to a way of decoding a file while reading it. */
5589 &BVAR (current_buffer, bidi_display_reordering), Qnil, 5632 &BVAR (current_buffer, bidi_display_reordering), Qnil,
5590 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); 5633 doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
5591 5634
5635 DEFVAR_PER_BUFFER ("bidi-paragraph-start-re",
5636 &BVAR (current_buffer, bidi_paragraph_start_re), Qnil,
5637 doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs.
5638
5639The value of nil means to use empty lines as lines that start and
5640separate paragraphs.
5641
5642When Emacs displays bidirectional text, it by default computes
5643the base paragraph direction separately for each paragraph.
5644Setting this variable changes the places where paragraph base
5645direction is recomputed.
5646
5647The regexp is always matched after a newline, so it is best to
5648anchor it by beginning it with a "^".
5649
5650If you change the value of this variable, be sure to change
5651the value of `bidi-paragraph-separate-re' accordingly. For
5652example, to have a single newline behave as a paragraph separator,
5653set both these variables to "^".
5654
5655See also `bidi-paragraph-direction'. */);
5656
5657 DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re",
5658 &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil,
5659 doc: /* If non-nil, a regexp matching a line that separates paragraphs.
5660
5661The value of nil means to use empty lines as paragraph separators.
5662
5663When Emacs displays bidirectional text, it by default computes
5664the base paragraph direction separately for each paragraph.
5665Setting this variable changes the places where paragraph base
5666direction is recomputed.
5667
5668The regexp is always matched after a newline, so it is best to
5669anchor it by beginning it with a "^".
5670
5671If you change the value of this variable, be sure to change
5672the value of `bidi-paragraph-start-re' accordingly. For
5673example, to have a single newline behave as a paragraph separator,
5674set both these variables to "^".
5675
5676See also `bidi-paragraph-direction'. */);
5677
5592 DEFVAR_PER_BUFFER ("bidi-paragraph-direction", 5678 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5593 &BVAR (current_buffer, bidi_paragraph_direction), Qnil, 5679 &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
5594 doc: /* If non-nil, forces directionality of text paragraphs in the buffer. 5680 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
611 direction dynamically for each paragraph. */ 611 direction dynamically for each paragraph. */
612 Lisp_Object bidi_paragraph_direction_; 612 Lisp_Object bidi_paragraph_direction_;
613 613
614 /* If non-nil, a regular expression for bidi paragraph separator. */
615 Lisp_Object bidi_paragraph_separate_re_;
616
617 /* If non-nil, a regular expression for bidi paragraph start. */
618 Lisp_Object bidi_paragraph_start_re_;
619
614 /* Non-nil means do selective display; 620 /* Non-nil means do selective display;
615 see doc string in syms_of_buffer (buffer.c) for details. */ 621 see doc string in syms_of_buffer (buffer.c) for details. */
616 Lisp_Object selective_display_; 622 Lisp_Object selective_display_;
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,
407 407
408 408
409/* Read a hexadecimal number (preceded by "0x") from the file FP while 409/* Read a hexadecimal number (preceded by "0x") from the file FP while
410 paying attention to comment character '#'. */ 410 paying attention to comment character '#'. LOOKAHEAD is the
411 lookahead byte if it is nonnegative. Store into *TERMINATOR the
412 input byte after the number, or EOF if an end-of-file or input
413 error occurred. Set *OVERFLOW if the number overflows. */
411 414
412static unsigned 415static unsigned
413read_hex (FILE *fp, bool *eof, bool *overflow) 416read_hex (FILE *fp, int lookahead, int *terminator, bool *overflow)
414{ 417{
415 int c; 418 int c = lookahead < 0 ? getc_unlocked (fp) : lookahead;
416 unsigned n;
417 419
418 while ((c = getc_unlocked (fp)) != EOF) 420 while (true)
419 { 421 {
420 if (c == '#') 422 if (c == '#')
421 { 423 do
422 while ((c = getc_unlocked (fp)) != EOF && c != '\n'); 424 c = getc_unlocked (fp);
423 } 425 while (0 <= c && c != '\n');
424 else if (c == '0') 426 else if (c == '0')
425 { 427 {
426 if ((c = getc_unlocked (fp)) == EOF || c == 'x') 428 c = getc_unlocked (fp);
429 if (c < 0 || c == 'x')
427 break; 430 break;
428 } 431 }
429 } 432 if (c < 0)
430 if (c == EOF)
431 {
432 *eof = 1;
433 return 0;
434 }
435 n = 0;
436 while (true)
437 {
438 c = getc_unlocked (fp);
439 int digit = char_hexdigit (c);
440 if (digit < 0)
441 break; 433 break;
442 if (INT_LEFT_SHIFT_OVERFLOW (n, 4)) 434 c = getc_unlocked (fp);
443 *overflow = 1;
444 n = (n << 4) + digit;
445 } 435 }
446 if (c != EOF) 436
447 ungetc (c, fp); 437 unsigned n = 0;
438 bool v = false;
439
440 if (0 <= c)
441 while (true)
442 {
443 c = getc_unlocked (fp);
444 int digit = char_hexdigit (c);
445 if (digit < 0)
446 break;
447 v |= INT_LEFT_SHIFT_OVERFLOW (n, 4);
448 n = (n << 4) + digit;
449 }
450
451 *terminator = c;
452 *overflow |= v;
448 return n; 453 return n;
449} 454}
450 455
@@ -499,23 +504,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
499 memset (entries, 0, sizeof (struct charset_map_entries)); 504 memset (entries, 0, sizeof (struct charset_map_entries));
500 505
501 n_entries = 0; 506 n_entries = 0;
502 while (1) 507 int ch = -1;
508 while (true)
503 { 509 {
504 unsigned from, to, c; 510 bool overflow = false;
505 int idx; 511 unsigned from = read_hex (fp, ch, &ch, &overflow), to;
506 bool eof = 0, overflow = 0; 512 if (ch < 0)
507
508 from = read_hex (fp, &eof, &overflow);
509 if (eof)
510 break; 513 break;
511 if (getc_unlocked (fp) == '-') 514 if (ch == '-')
512 to = read_hex (fp, &eof, &overflow); 515 {
516 to = read_hex (fp, -1, &ch, &overflow);
517 if (ch < 0)
518 break;
519 }
513 else 520 else
514 to = from; 521 {
515 if (eof) 522 to = from;
516 break; 523 ch = -1;
517 c = read_hex (fp, &eof, &overflow); 524 }
518 if (eof) 525 unsigned c = read_hex (fp, ch, &ch, &overflow);
526 if (ch < 0)
519 break; 527 break;
520 528
521 if (overflow) 529 if (overflow)
@@ -530,7 +538,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
530 memset (entries, 0, sizeof (struct charset_map_entries)); 538 memset (entries, 0, sizeof (struct charset_map_entries));
531 n_entries = 0; 539 n_entries = 0;
532 } 540 }
533 idx = n_entries; 541 int idx = n_entries;
534 entries->entry[idx].from = from; 542 entries->entry[idx].from = from;
535 entries->entry[idx].to = to; 543 entries->entry[idx].to = to;
536 entries->entry[idx].c = c; 544 entries->entry[idx].c = c;
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 ...) */)
10539 ASET (this_spec, 2, this_eol_type); 10539 ASET (this_spec, 2, this_eol_type);
10540 Fputhash (this_name, this_spec, Vcoding_system_hash_table); 10540 Fputhash (this_name, this_spec, Vcoding_system_hash_table);
10541 Vcoding_system_list = Fcons (this_name, Vcoding_system_list); 10541 Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
10542 val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist); 10542 val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil);
10543 if (NILP (val)) 10543 if (NILP (val))
10544 Vcoding_system_alist 10544 Vcoding_system_alist
10545 = Fcons (Fcons (Fsymbol_name (this_name), Qnil), 10545 = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
@@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */)
10554 10554
10555 Fputhash (name, spec_vec, Vcoding_system_hash_table); 10555 Fputhash (name, spec_vec, Vcoding_system_hash_table);
10556 Vcoding_system_list = Fcons (name, Vcoding_system_list); 10556 Vcoding_system_list = Fcons (name, Vcoding_system_list);
10557 val = Fassoc (Fsymbol_name (name), Vcoding_system_alist); 10557 val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil);
10558 if (NILP (val)) 10558 if (NILP (val))
10559 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil), 10559 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
10560 Vcoding_system_alist); 10560 Vcoding_system_alist);
@@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
10662 10662
10663 Fputhash (alias, spec, Vcoding_system_hash_table); 10663 Fputhash (alias, spec, Vcoding_system_hash_table);
10664 Vcoding_system_list = Fcons (alias, Vcoding_system_list); 10664 Vcoding_system_list = Fcons (alias, Vcoding_system_list);
10665 val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist); 10665 val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil);
10666 if (NILP (val)) 10666 if (NILP (val))
10667 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil), 10667 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
10668 Vcoding_system_alist); 10668 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)
955 DBusConnection *connection; 955 DBusConnection *connection;
956 Lisp_Object val; 956 Lisp_Object val;
957 957
958 val = CDR_SAFE (Fassoc (bus, xd_registered_buses)); 958 val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil));
959 if (NILP (val)) 959 if (NILP (val))
960 XD_SIGNAL2 (build_string ("No connection to bus"), bus); 960 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
961 else 961 else
@@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus)
1057 Lisp_Object busobj; 1057 Lisp_Object busobj;
1058 1058
1059 /* Check whether we are connected. */ 1059 /* Check whether we are connected. */
1060 val = Fassoc (bus, xd_registered_buses); 1060 val = Fassoc (bus, xd_registered_buses, Qnil);
1061 if (NILP (val)) 1061 if (NILP (val))
1062 return; 1062 return;
1063 1063
@@ -1127,7 +1127,7 @@ this connection to those buses. */)
1127 xd_close_bus (bus); 1127 xd_close_bus (bus);
1128 1128
1129 /* Check, whether we are still connected. */ 1129 /* Check, whether we are still connected. */
1130 val = Fassoc (bus, xd_registered_buses); 1130 val = Fassoc (bus, xd_registered_buses, Qnil);
1131 if (!NILP (val)) 1131 if (!NILP (val))
1132 { 1132 {
1133 connection = xd_get_connection_address (bus); 1133 connection = xd_get_connection_address (bus);
diff --git a/src/dispextern.h b/src/dispextern.h
index 8644ce26d13..1df769a8f99 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -384,6 +384,7 @@ struct glyph
384 glyph standing for newline at end of line 0 384 glyph standing for newline at end of line 0
385 empty space after the end of the line -1 385 empty space after the end of the line -1
386 overlay arrow on a TTY -1 386 overlay arrow on a TTY -1
387 glyph displaying line number -1
387 glyph at EOB that ends in a newline -1 388 glyph at EOB that ends in a newline -1
388 left truncation glyphs: -1 389 left truncation glyphs: -1
389 right truncation/continuation glyphs next buffer position 390 right truncation/continuation glyphs next buffer position
@@ -2537,7 +2538,12 @@ struct it
2537 Do NOT use !BUFFERP (it.object) as a test whether we are 2538 Do NOT use !BUFFERP (it.object) as a test whether we are
2538 iterating over a string; use STRINGP (it.string) instead. 2539 iterating over a string; use STRINGP (it.string) instead.
2539 2540
2540 Position is the current iterator position in object. */ 2541 Position is the current iterator position in object.
2542
2543 The 'position's CHARPOS is copied to glyph->charpos of the glyph
2544 produced by PRODUCE_GLYPHS, so any artificial value documented
2545 under 'struct glyph's 'charpos' member can also be found in the
2546 'position' member here. */
2541 Lisp_Object object; 2547 Lisp_Object object;
2542 struct text_pos position; 2548 struct text_pos position;
2543 2549
@@ -2621,6 +2627,20 @@ struct it
2621 coordinate is past first_visible_x. */ 2627 coordinate is past first_visible_x. */
2622 int hpos; 2628 int hpos;
2623 2629
2630 /* Current line number, zero-based. */
2631 ptrdiff_t lnum;
2632
2633 /* The byte position corresponding to lnum. */
2634 ptrdiff_t lnum_bytepos;
2635
2636 /* The width, in columns and in pixels, needed for display of the
2637 line numbers, or zero if not computed. */
2638 int lnum_width;
2639 int lnum_pixel_width;
2640
2641 /* The line number of point's line, or zero if not computed yet. */
2642 ptrdiff_t pt_lnum;
2643
2624 /* Left fringe bitmap number (enum fringe_bitmap_type). */ 2644 /* Left fringe bitmap number (enum fringe_bitmap_type). */
2625 unsigned left_user_fringe_bitmap : FRINGE_ID_BITS; 2645 unsigned left_user_fringe_bitmap : FRINGE_ID_BITS;
2626 2646
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 7b1a402eeff..ad6c8fb0104 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -315,20 +315,18 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
315 MODULE_FUNCTION_BEGIN (); 315 MODULE_FUNCTION_BEGIN ();
316 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); 316 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
317 Lisp_Object obj = value_to_lisp (ref); 317 Lisp_Object obj = value_to_lisp (ref);
318 EMACS_UINT hashcode; 318 ptrdiff_t i = hash_lookup (h, obj, NULL);
319 ptrdiff_t i = hash_lookup (h, obj, &hashcode);
320 319
321 if (i >= 0) 320 if (i >= 0)
322 { 321 {
323 Lisp_Object value = HASH_VALUE (h, i); 322 EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1;
324 EMACS_INT refcount = XFASTINT (value) - 1;
325 if (refcount > 0) 323 if (refcount > 0)
324 set_hash_value_slot (h, i, make_natnum (refcount));
325 else
326 { 326 {
327 value = make_natnum (refcount); 327 eassert (refcount == 0);
328 set_hash_value_slot (h, i, value); 328 hash_remove_from_table (h, obj);
329 } 329 }
330 else
331 hash_remove_from_table (h, value);
332 } 330 }
333 331
334 if (module_assertions) 332 if (module_assertions)
@@ -817,9 +815,13 @@ in_current_thread (void)
817static void 815static void
818module_assert_thread (void) 816module_assert_thread (void)
819{ 817{
820 if (! module_assertions || in_current_thread ()) 818 if (!module_assertions)
821 return; 819 return;
822 module_abort ("Module function called from outside the current Lisp thread"); 820 if (!in_current_thread ())
821 module_abort ("Module function called from outside "
822 "the current Lisp thread");
823 if (gc_in_progress)
824 module_abort ("Module function called during garbage collection");
823} 825}
824 826
825static void 827static void
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)
213 return pdl; 213 return pdl;
214} 214}
215 215
216/* Return a pointer to somewhere near the top of the C stack. */
217void *
218near_C_stack_top (void)
219{
220 return backtrace_args (backtrace_top ());
221}
222
223void 216void
224init_eval_once (void) 217init_eval_once (void)
225{ 218{
@@ -2090,7 +2083,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
2090 specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; 2083 specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
2091 specpdl_ptr->bt.debug_on_exit = false; 2084 specpdl_ptr->bt.debug_on_exit = false;
2092 specpdl_ptr->bt.function = function; 2085 specpdl_ptr->bt.function = function;
2093 specpdl_ptr->bt.args = args; 2086 current_thread->stack_top = specpdl_ptr->bt.args = args;
2094 specpdl_ptr->bt.nargs = nargs; 2087 specpdl_ptr->bt.nargs = nargs;
2095 grow_specpdl (); 2088 grow_specpdl ();
2096 2089
diff --git a/src/fns.c b/src/fns.c
index 6610d2a6d0e..d849618f2b7 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -35,6 +35,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
35#include "intervals.h" 35#include "intervals.h"
36#include "window.h" 36#include "window.h"
37#include "puresize.h" 37#include "puresize.h"
38#include "gnutls.h"
39
40#ifdef WINDOWSNT
41# define gnutls_rnd w32_gnutls_rnd
42#endif
38 43
39static void sort_vector_copy (Lisp_Object, ptrdiff_t, 44static void sort_vector_copy (Lisp_Object, ptrdiff_t,
40 Lisp_Object *restrict, Lisp_Object *restrict); 45 Lisp_Object *restrict, Lisp_Object *restrict);
@@ -1417,17 +1422,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list)
1417 return Qnil; 1422 return Qnil;
1418} 1423}
1419 1424
1420DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, 1425DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
1421 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. 1426 doc: /* Return non-nil if KEY is equal to the car of an element of LIST.
1422The value is actually the first element of LIST whose car equals KEY. */) 1427The value is actually the first element of LIST whose car equals KEY.
1423 (Lisp_Object key, Lisp_Object list) 1428
1429Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
1430 (Lisp_Object key, Lisp_Object list, Lisp_Object testfn)
1424{ 1431{
1425 Lisp_Object tail = list; 1432 Lisp_Object tail = list;
1426 FOR_EACH_TAIL (tail) 1433 FOR_EACH_TAIL (tail)
1427 { 1434 {
1428 Lisp_Object car = XCAR (tail); 1435 Lisp_Object car = XCAR (tail);
1429 if (CONSP (car) 1436 if (CONSP (car)
1430 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) 1437 && (NILP (testfn)
1438 ? (EQ (XCAR (car), key) || !NILP (Fequal
1439 (XCAR (car), key)))
1440 : !NILP (call2 (testfn, XCAR (car), key))))
1431 return car; 1441 return car;
1432 } 1442 }
1433 CHECK_LIST_END (tail, list); 1443 CHECK_LIST_END (tail, list);
@@ -4735,22 +4745,42 @@ make_digest_string (Lisp_Object digest, int digest_size)
4735 return digest; 4745 return digest;
4736} 4746}
4737 4747
4738/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ 4748DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms,
4749 Ssecure_hash_algorithms, 0, 0, 0,
4750 doc: /* Return a list of all the supported `secure_hash' algorithms. */)
4751 (void)
4752{
4753 return listn (CONSTYPE_HEAP, 6,
4754 Qmd5,
4755 Qsha1,
4756 Qsha224,
4757 Qsha256,
4758 Qsha384,
4759 Qsha512);
4760}
4739 4761
4740static Lisp_Object 4762/* Extract data from a string or a buffer. SPEC is a list of
4741secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, 4763(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as
4742 Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, 4764specified with `secure-hash' and in Info node
4743 Lisp_Object binary) 4765`(elisp)Format of GnuTLS Cryptography Inputs'. */
4766char *
4767extract_data_from_object (Lisp_Object spec,
4768 ptrdiff_t *start_byte,
4769 ptrdiff_t *end_byte)
4744{ 4770{
4745 ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; 4771 Lisp_Object object = XCAR (spec);
4746 register EMACS_INT b, e;
4747 register struct buffer *bp;
4748 EMACS_INT temp;
4749 int digest_size;
4750 void *(*hash_func) (const char *, size_t, void *);
4751 Lisp_Object digest;
4752 4772
4753 CHECK_SYMBOL (algorithm); 4773 if (CONSP (spec)) spec = XCDR (spec);
4774 Lisp_Object start = CAR_SAFE (spec);
4775
4776 if (CONSP (spec)) spec = XCDR (spec);
4777 Lisp_Object end = CAR_SAFE (spec);
4778
4779 if (CONSP (spec)) spec = XCDR (spec);
4780 Lisp_Object coding_system = CAR_SAFE (spec);
4781
4782 if (CONSP (spec)) spec = XCDR (spec);
4783 Lisp_Object noerror = CAR_SAFE (spec);
4754 4784
4755 if (STRINGP (object)) 4785 if (STRINGP (object))
4756 { 4786 {
@@ -4778,23 +4808,24 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4778 if (STRING_MULTIBYTE (object)) 4808 if (STRING_MULTIBYTE (object))
4779 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); 4809 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
4780 4810
4781 size = SCHARS (object); 4811 ptrdiff_t size = SCHARS (object), start_char, end_char;
4782 validate_subarray (object, start, end, size, &start_char, &end_char); 4812 validate_subarray (object, start, end, size, &start_char, &end_char);
4783 4813
4784 start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); 4814 *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
4785 end_byte = (end_char == size 4815 *end_byte = (end_char == size
4786 ? SBYTES (object) 4816 ? SBYTES (object)
4787 : string_char_to_byte (object, end_char)); 4817 : string_char_to_byte (object, end_char));
4788 } 4818 }
4789 else 4819 else if (BUFFERP (object))
4790 { 4820 {
4791 struct buffer *prev = current_buffer; 4821 struct buffer *prev = current_buffer;
4822 EMACS_INT b, e;
4792 4823
4793 record_unwind_current_buffer (); 4824 record_unwind_current_buffer ();
4794 4825
4795 CHECK_BUFFER (object); 4826 CHECK_BUFFER (object);
4796 4827
4797 bp = XBUFFER (object); 4828 struct buffer *bp = XBUFFER (object);
4798 set_buffer_internal (bp); 4829 set_buffer_internal (bp);
4799 4830
4800 if (NILP (start)) 4831 if (NILP (start))
@@ -4814,7 +4845,11 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4814 } 4845 }
4815 4846
4816 if (b > e) 4847 if (b > e)
4817 temp = b, b = e, e = temp; 4848 {
4849 EMACS_INT temp = b;
4850 b = e;
4851 e = temp;
4852 }
4818 4853
4819 if (!(BEGV <= b && e <= ZV)) 4854 if (!(BEGV <= b && e <= ZV))
4820 args_out_of_range (start, end); 4855 args_out_of_range (start, end);
@@ -4887,10 +4922,55 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4887 4922
4888 if (STRING_MULTIBYTE (object)) 4923 if (STRING_MULTIBYTE (object))
4889 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); 4924 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
4890 start_byte = 0; 4925 *start_byte = 0;
4891 end_byte = SBYTES (object); 4926 *end_byte = SBYTES (object);
4927 }
4928 else if (EQ (object, Qiv_auto))
4929 {
4930#ifdef HAVE_GNUTLS3
4931 /* Format: (iv-auto REQUIRED-LENGTH). */
4932
4933 if (! NATNUMP (start))
4934 error ("Without a length, `iv-auto' can't be used; see ELisp manual");
4935 else
4936 {
4937 EMACS_INT start_hold = XFASTINT (start);
4938 object = make_uninit_string (start_hold);
4939 gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);
4940
4941 *start_byte = 0;
4942 *end_byte = start_hold;
4943 }
4944#else
4945 error ("GnuTLS is not available, so `iv-auto' can't be used");
4946#endif
4892 } 4947 }
4893 4948
4949 return SSDATA (object);
4950}
4951
4952
4953/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
4954
4955static Lisp_Object
4956secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4957 Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
4958 Lisp_Object binary)
4959{
4960 ptrdiff_t start_byte, end_byte;
4961 int digest_size;
4962 void *(*hash_func) (const char *, size_t, void *);
4963 Lisp_Object digest;
4964
4965 CHECK_SYMBOL (algorithm);
4966
4967 Lisp_Object spec = list5 (object, start, end, coding_system, noerror);
4968
4969 const char *input = extract_data_from_object (spec, &start_byte, &end_byte);
4970
4971 if (input == NULL)
4972 error ("secure_hash: failed to extract data from object, aborting!");
4973
4894 if (EQ (algorithm, Qmd5)) 4974 if (EQ (algorithm, Qmd5))
4895 { 4975 {
4896 digest_size = MD5_DIGEST_SIZE; 4976 digest_size = MD5_DIGEST_SIZE;
@@ -4928,7 +5008,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4928 hexified value */ 5008 hexified value */
4929 digest = make_uninit_string (digest_size * 2); 5009 digest = make_uninit_string (digest_size * 2);
4930 5010
4931 hash_func (SSDATA (object) + start_byte, 5011 hash_func (input + start_byte,
4932 end_byte - start_byte, 5012 end_byte - start_byte,
4933 SSDATA (digest)); 5013 SSDATA (digest));
4934 5014
@@ -4979,6 +5059,8 @@ The two optional arguments START and END are positions specifying for
4979which part of OBJECT to compute the hash. If nil or omitted, uses the 5059which part of OBJECT to compute the hash. If nil or omitted, uses the
4980whole OBJECT. 5060whole OBJECT.
4981 5061
5062The full list of algorithms can be obtained with `secure-hash-algorithms'.
5063
4982If BINARY is non-nil, returns a string in binary form. */) 5064If BINARY is non-nil, returns a string in binary form. */)
4983 (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) 5065 (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
4984{ 5066{
@@ -5026,13 +5108,6 @@ disregarding any coding systems. If nil, use the current buffer. */ )
5026void 5108void
5027syms_of_fns (void) 5109syms_of_fns (void)
5028{ 5110{
5029 DEFSYM (Qmd5, "md5");
5030 DEFSYM (Qsha1, "sha1");
5031 DEFSYM (Qsha224, "sha224");
5032 DEFSYM (Qsha256, "sha256");
5033 DEFSYM (Qsha384, "sha384");
5034 DEFSYM (Qsha512, "sha512");
5035
5036 /* Hash table stuff. */ 5111 /* Hash table stuff. */
5037 DEFSYM (Qhash_table_p, "hash-table-p"); 5112 DEFSYM (Qhash_table_p, "hash-table-p");
5038 DEFSYM (Qeq, "eq"); 5113 DEFSYM (Qeq, "eq");
@@ -5069,6 +5144,18 @@ syms_of_fns (void)
5069 defsubr (&Smaphash); 5144 defsubr (&Smaphash);
5070 defsubr (&Sdefine_hash_table_test); 5145 defsubr (&Sdefine_hash_table_test);
5071 5146
5147 /* Crypto and hashing stuff. */
5148 DEFSYM (Qiv_auto, "iv-auto");
5149
5150 DEFSYM (Qmd5, "md5");
5151 DEFSYM (Qsha1, "sha1");
5152 DEFSYM (Qsha224, "sha224");
5153 DEFSYM (Qsha256, "sha256");
5154 DEFSYM (Qsha384, "sha384");
5155 DEFSYM (Qsha512, "sha512");
5156
5157 /* Miscellaneous stuff. */
5158
5072 DEFSYM (Qstring_lessp, "string-lessp"); 5159 DEFSYM (Qstring_lessp, "string-lessp");
5073 DEFSYM (Qprovide, "provide"); 5160 DEFSYM (Qprovide, "provide");
5074 DEFSYM (Qrequire, "require"); 5161 DEFSYM (Qrequire, "require");
@@ -5187,6 +5274,7 @@ this variable. */);
5187 defsubr (&Sbase64_encode_string); 5274 defsubr (&Sbase64_encode_string);
5188 defsubr (&Sbase64_decode_string); 5275 defsubr (&Sbase64_decode_string);
5189 defsubr (&Smd5); 5276 defsubr (&Smd5);
5277 defsubr (&Ssecure_hash_algorithms);
5190 defsubr (&Ssecure_hash); 5278 defsubr (&Ssecure_hash);
5191 defsubr (&Sbuffer_hash); 5279 defsubr (&Sbuffer_hash);
5192 defsubr (&Slocale_info); 5280 defsubr (&Slocale_info);
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)
1893static OTF * 1893static OTF *
1894otf_open (Lisp_Object file) 1894otf_open (Lisp_Object file)
1895{ 1895{
1896 Lisp_Object val = Fassoc (file, otf_list); 1896 Lisp_Object val = Fassoc (file, otf_list, Qnil);
1897 OTF *otf; 1897 OTF *otf;
1898 1898
1899 if (! NILP (val)) 1899 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)
1186 { 1186 {
1187 tem = Frassoc (name, Vfontset_alias_alist); 1187 tem = Frassoc (name, Vfontset_alias_alist);
1188 if (NILP (tem)) 1188 if (NILP (tem))
1189 tem = Fassoc (name, Vfontset_alias_alist); 1189 tem = Fassoc (name, Vfontset_alias_alist, Qnil);
1190 if (CONSP (tem) && STRINGP (XCAR (tem))) 1190 if (CONSP (tem) && STRINGP (XCAR (tem)))
1191 name = XCAR (tem); 1191 name = XCAR (tem);
1192 else if (name_pattern == 0) 1192 else if (name_pattern == 0)
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,
81 ftcrfont_info->metrics = 81 ftcrfont_info->metrics =
82 xrealloc (ftcrfont_info->metrics, 82 xrealloc (ftcrfont_info->metrics,
83 sizeof (struct font_metrics *) * (row + 1)); 83 sizeof (struct font_metrics *) * (row + 1));
84 bzero (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 84 memset (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 0,
85 (sizeof (struct font_metrics *) 85 (sizeof (struct font_metrics *)
86 * (row + 1 - ftcrfont_info->metrics_nrows))); 86 * (row + 1 - ftcrfont_info->metrics_nrows)));
87 ftcrfont_info->metrics_nrows = row + 1; 87 ftcrfont_info->metrics_nrows = row + 1;
88 } 88 }
89 if (ftcrfont_info->metrics[row] == NULL) 89 if (ftcrfont_info->metrics[row] == NULL)
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
266invalid. */) 266invalid. */)
267 (Lisp_Object watch_descriptor) 267 (Lisp_Object watch_descriptor)
268{ 268{
269 Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); 269 Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
270 if (NILP (watch_object)) 270 if (NILP (watch_object))
271 return Qnil; 271 return Qnil;
272 else 272 else
diff --git a/src/gnutls.c b/src/gnutls.c
index 2078ad88f28..59694074e16 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24#include "process.h" 24#include "process.h"
25#include "gnutls.h" 25#include "gnutls.h"
26#include "coding.h" 26#include "coding.h"
27#include "buffer.h"
27 28
28#ifdef HAVE_GNUTLS 29#ifdef HAVE_GNUTLS
29 30
@@ -171,6 +172,59 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
171DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); 172DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
172DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); 173DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
173 174
175# ifdef HAVE_GNUTLS3
176DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
177DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
178DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
179DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
180DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
181DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
182# ifdef HAVE_GNUTLS3_CIPHER
183DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
184DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
185DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
186DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t));
187DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
188DEF_DLL_FN (int, gnutls_cipher_init,
189 (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
190 const gnutls_datum_t *, const gnutls_datum_t *));
191DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t));
192DEF_DLL_FN (int, gnutls_cipher_encrypt2,
193 (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
194DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
195DEF_DLL_FN (int, gnutls_cipher_decrypt2,
196 (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
197# ifdef HAVE_GNUTLS3_AEAD
198DEF_DLL_FN (int, gnutls_aead_cipher_init,
199 (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
200 const gnutls_datum_t *));
201DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t));
202DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
203 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
204 size_t, size_t, const void *, size_t, void *, size_t *));
205DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
206 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
207 size_t, size_t, const void *, size_t, void *, size_t *));
208# endif /* HAVE_GNUTLS3_AEAD */
209# ifdef HAVE_GNUTLS3_HMAC
210DEF_DLL_FN (int, gnutls_hmac_init,
211 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
212DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
213DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
214DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
215DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
216# endif /* HAVE_GNUTLS3_HMAC */
217# endif /* HAVE_GNUTLS3_CIPHER */
218# ifdef HAVE_GNUTLS3_DIGEST
219 DEF_DLL_FN (int, gnutls_hash_init,
220 (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
221DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
222DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
223DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
224DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
225# endif /* HAVE_GNUTLS3_DIGEST */
226# endif /* HAVE_GNUTLS3 */
227
174 228
175static bool 229static bool
176init_gnutls_functions (void) 230init_gnutls_functions (void)
@@ -255,6 +309,46 @@ init_gnutls_functions (void)
255 LOAD_DLL_FN (library, gnutls_cipher_get_name); 309 LOAD_DLL_FN (library, gnutls_cipher_get_name);
256 LOAD_DLL_FN (library, gnutls_mac_get); 310 LOAD_DLL_FN (library, gnutls_mac_get);
257 LOAD_DLL_FN (library, gnutls_mac_get_name); 311 LOAD_DLL_FN (library, gnutls_mac_get_name);
312# ifdef HAVE_GNUTLS3
313 LOAD_DLL_FN (library, gnutls_rnd);
314 LOAD_DLL_FN (library, gnutls_mac_list);
315 LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
316 LOAD_DLL_FN (library, gnutls_mac_get_key_size);
317 LOAD_DLL_FN (library, gnutls_digest_list);
318 LOAD_DLL_FN (library, gnutls_digest_get_name);
319# ifdef HAVE_GNUTLS3_CIPHER
320 LOAD_DLL_FN (library, gnutls_cipher_list);
321 LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
322 LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
323 LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
324 LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
325 LOAD_DLL_FN (library, gnutls_cipher_init);
326 LOAD_DLL_FN (library, gnutls_cipher_set_iv);
327 LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
328 LOAD_DLL_FN (library, gnutls_cipher_deinit);
329 LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
330# ifdef HAVE_GNUTLS3_AEAD
331 LOAD_DLL_FN (library, gnutls_aead_cipher_init);
332 LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
333 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
334 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
335# endif
336# ifdef HAVE_GNUTLS3_HMAC
337 LOAD_DLL_FN (library, gnutls_hmac_init);
338 LOAD_DLL_FN (library, gnutls_hmac_get_len);
339 LOAD_DLL_FN (library, gnutls_hmac);
340 LOAD_DLL_FN (library, gnutls_hmac_deinit);
341 LOAD_DLL_FN (library, gnutls_hmac_output);
342# endif /* HAVE_GNUTLS3_HMAC */
343# endif /* HAVE_GNUTLS3_CIPHER */
344# ifdef HAVE_GNUTLS3_DIGEST
345 LOAD_DLL_FN (library, gnutls_hash_init);
346 LOAD_DLL_FN (library, gnutls_hash_get_len);
347 LOAD_DLL_FN (library, gnutls_hash);
348 LOAD_DLL_FN (library, gnutls_hash_deinit);
349 LOAD_DLL_FN (library, gnutls_hash_output);
350# endif
351# endif /* HAVE_GNUTLS3 */
258 352
259 max_log_level = global_gnutls_log_level; 353 max_log_level = global_gnutls_log_level;
260 354
@@ -332,8 +426,56 @@ init_gnutls_functions (void)
332# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version 426# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
333# define gnutls_x509_crt_import fn_gnutls_x509_crt_import 427# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
334# define gnutls_x509_crt_init fn_gnutls_x509_crt_init 428# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
429# ifdef HAVE_GNUTLS3
430# define gnutls_rnd fn_gnutls_rnd
431# define gnutls_mac_list fn_gnutls_mac_list
432# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
433# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
434# define gnutls_digest_list fn_gnutls_digest_list
435# define gnutls_digest_get_name fn_gnutls_digest_get_name
436# ifdef HAVE_GNUTLS3_CIPHER
437# define gnutls_cipher_list fn_gnutls_cipher_list
438# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
439# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
440# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
441# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
442# define gnutls_cipher_init fn_gnutls_cipher_init
443# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
444# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
445# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
446# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
447# ifdef HAVE_GNUTLS3_AEAD
448# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
449# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
450# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
451# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
452# endif /* HAVE_GNUTLS3_AEAD */
453# ifdef HAVE_GNUTLS3_HMAC
454# define gnutls_hmac_init fn_gnutls_hmac_init
455# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
456# define gnutls_hmac fn_gnutls_hmac
457# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
458# define gnutls_hmac_output fn_gnutls_hmac_output
459# endif /* HAVE_GNUTLS3_HMAC */
460# endif /* HAVE_GNUTLS3_CIPHER */
461# ifdef HAVE_GNUTLS3_DIGEST
462# define gnutls_hash_init fn_gnutls_hash_init
463# define gnutls_hash_get_len fn_gnutls_hash_get_len
464# define gnutls_hash fn_gnutls_hash
465# define gnutls_hash_deinit fn_gnutls_hash_deinit
466# define gnutls_hash_output fn_gnutls_hash_output
467# endif
468# endif /* HAVE_GNUTLS3 */
469
470/* This wrapper is called from fns.c, which doesn't know about the
471 LOAD_DLL_FN stuff above. */
472int
473w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
474{
475 return gnutls_rnd (level, data, len);
476}
335 477
336#endif 478#endif /* WINDOWSNT */
337 479
338 480
339/* Report memory exhaustion if ERR is an out-of-memory indication. */ 481/* Report memory exhaustion if ERR is an out-of-memory indication. */
@@ -433,7 +575,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
433 return err; 575 return err;
434 } 576 }
435} 577}
436#endif 578#endif /* !WINDOWSNT */
437 579
438static int 580static int
439emacs_gnutls_handshake (struct Lisp_Process *proc) 581emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -556,6 +698,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
556 } 698 }
557} 699}
558 700
701static char const *
702emacs_gnutls_strerror (int err)
703{
704 char const *str = gnutls_strerror (err);
705 return str ? str : "unknown";
706}
707
559/* Report a GnuTLS error to the user. 708/* Report a GnuTLS error to the user.
560 Return true if the error code was successfully handled. */ 709 Return true if the error code was successfully handled. */
561static bool 710static bool
@@ -564,7 +713,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
564 int max_log_level = 0; 713 int max_log_level = 0;
565 714
566 bool ret; 715 bool ret;
567 const char *str;
568 716
569 /* TODO: use a Lisp_Object generated by gnutls_make_error? */ 717 /* TODO: use a Lisp_Object generated by gnutls_make_error? */
570 if (err >= 0) 718 if (err >= 0)
@@ -576,9 +724,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
576 724
577 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ 725 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */
578 726
579 str = gnutls_strerror (err); 727 char const *str = emacs_gnutls_strerror (err);
580 if (!str)
581 str = "unknown";
582 728
583 if (gnutls_error_is_fatal (err)) 729 if (gnutls_error_is_fatal (err))
584 { 730 {
@@ -592,11 +738,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
592#endif 738#endif
593 739
594 GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); 740 GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
595 ret = 0; 741 ret = false;
596 } 742 }
597 else 743 else
598 { 744 {
599 ret = 1; 745 ret = true;
600 746
601 switch (err) 747 switch (err)
602 { 748 {
@@ -784,7 +930,7 @@ usage: (gnutls-error-string ERROR) */)
784 if (! TYPE_RANGED_INTEGERP (int, err)) 930 if (! TYPE_RANGED_INTEGERP (int, err))
785 return build_string ("Not an error symbol or code"); 931 return build_string ("Not an error symbol or code");
786 932
787 return build_string (gnutls_strerror (XINT (err))); 933 return build_string (emacs_gnutls_strerror (XINT (err)));
788} 934}
789 935
790DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, 936DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -1476,9 +1622,9 @@ one trustfile (usually a CA bundle). */)
1476 XPROCESS (proc)->gnutls_x509_cred = x509_cred; 1622 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
1477 1623
1478 verify_flags = Fplist_get (proplist, QCverify_flags); 1624 verify_flags = Fplist_get (proplist, QCverify_flags);
1479 if (NUMBERP (verify_flags)) 1625 if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags))
1480 { 1626 {
1481 gnutls_verify_flags = XINT (verify_flags); 1627 gnutls_verify_flags = XFASTINT (verify_flags);
1482 GNUTLS_LOG (2, max_log_level, "setting verification flags"); 1628 GNUTLS_LOG (2, max_log_level, "setting verification flags");
1483 } 1629 }
1484 else if (NILP (verify_flags)) 1630 else if (NILP (verify_flags))
@@ -1697,28 +1843,624 @@ This function may also return `gnutls-e-again', or
1697 1843
1698#endif /* HAVE_GNUTLS */ 1844#endif /* HAVE_GNUTLS */
1699 1845
1846#ifdef HAVE_GNUTLS3
1847
1848DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0,
1849 doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists.
1850The alist key is the cipher name. */)
1851 (void)
1852{
1853 Lisp_Object ciphers = Qnil;
1854
1855#ifdef HAVE_GNUTLS3_CIPHER
1856 const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
1857 for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
1858 {
1859 gnutls_cipher_algorithm_t gca = gciphers[pos];
1860 if (gca == GNUTLS_CIPHER_NULL)
1861 continue;
1862 char const *cipher_name = gnutls_cipher_get_name (gca);
1863 if (!cipher_name)
1864 continue;
1865
1866 /* A symbol representing the GnuTLS cipher. */
1867 Lisp_Object cipher_symbol = intern (cipher_name);
1868
1869 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
1870
1871 Lisp_Object cp
1872 = listn (CONSTYPE_HEAP, 15, cipher_symbol,
1873 QCcipher_id, make_number (gca),
1874 QCtype, Qgnutls_type_cipher,
1875 QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt,
1876 QCcipher_tagsize, make_number (cipher_tag_size),
1877
1878 QCcipher_blocksize,
1879 make_number (gnutls_cipher_get_block_size (gca)),
1880
1881 QCcipher_keysize,
1882 make_number (gnutls_cipher_get_key_size (gca)),
1883
1884 QCcipher_ivsize,
1885 make_number (gnutls_cipher_get_iv_size (gca)));
1886
1887 ciphers = Fcons (cp, ciphers);
1888 }
1889#endif
1890
1891 return ciphers;
1892}
1893
1894static Lisp_Object
1895gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
1896 Lisp_Object cipher,
1897 const char *kdata, ptrdiff_t ksize,
1898 const char *vdata, ptrdiff_t vsize,
1899 const char *idata, ptrdiff_t isize,
1900 Lisp_Object aead_auth)
1901{
1902#ifdef HAVE_GNUTLS3_AEAD
1903
1904 const char *desc = encrypting ? "encrypt" : "decrypt";
1905 Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
1906
1907 gnutls_aead_cipher_hd_t acipher;
1908 gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize };
1909 int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum);
1910
1911 if (ret < GNUTLS_E_SUCCESS)
1912 error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
1913 gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
1914
1915 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
1916 ptrdiff_t tagged_size;
1917 if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size)
1918 || SIZE_MAX < tagged_size)
1919 memory_full (SIZE_MAX);
1920 size_t storage_length = tagged_size;
1921 USE_SAFE_ALLOCA;
1922 char *storage = SAFE_ALLOCA (storage_length);
1923
1924 const char *aead_auth_data = NULL;
1925 ptrdiff_t aead_auth_size = 0;
1926
1927 if (!NILP (aead_auth))
1928 {
1929 if (BUFFERP (aead_auth) || STRINGP (aead_auth))
1930 aead_auth = list1 (aead_auth);
1931
1932 CHECK_CONS (aead_auth);
1933
1934 ptrdiff_t astart_byte, aend_byte;
1935 const char *adata
1936 = extract_data_from_object (aead_auth, &astart_byte, &aend_byte);
1937 if (adata == NULL)
1938 error ("GnuTLS AEAD cipher auth extraction failed");
1939
1940 aead_auth_data = adata;
1941 aead_auth_size = aend_byte - astart_byte;
1942 }
1943
1944 ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
1945 ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
1946
1947 if (isize < expected_remainder
1948 || (isize - expected_remainder) % cipher_block_size != 0)
1949 error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d "
1950 "is not %"pD"d greater than a multiple of the required %"pD"d"),
1951 gnutls_cipher_get_name (gca), desc,
1952 isize, expected_remainder, cipher_block_size);
1953
1954 ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt)
1955 (acipher, vdata, vsize, aead_auth_data, aead_auth_size,
1956 cipher_tag_size, idata, isize, storage, &storage_length));
1957
1958 Lisp_Object output;
1959 if (GNUTLS_E_SUCCESS <= ret)
1960 output = make_unibyte_string (storage, storage_length);
1961 explicit_bzero (storage, storage_length);
1962 gnutls_aead_cipher_deinit (acipher);
1963
1964 if (ret < GNUTLS_E_SUCCESS)
1965 error ((encrypting
1966 ? "GnuTLS AEAD cipher %s encryption failed: %s"
1967 : "GnuTLS AEAD cipher %s decryption failed: %s"),
1968 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
1969
1970 SAFE_FREE ();
1971 return list2 (output, actual_iv);
1972#else
1973 printmax_t print_gca = gca;
1974 error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca);
1975#endif
1976}
1977
1978static Lisp_Object
1979gnutls_symmetric (bool encrypting, Lisp_Object cipher,
1980 Lisp_Object key, Lisp_Object iv,
1981 Lisp_Object input, Lisp_Object aead_auth)
1982{
1983 if (BUFFERP (key) || STRINGP (key))
1984 key = list1 (key);
1985
1986 CHECK_CONS (key);
1987
1988 if (BUFFERP (input) || STRINGP (input))
1989 input = list1 (input);
1990
1991 CHECK_CONS (input);
1992
1993 if (BUFFERP (iv) || STRINGP (iv))
1994 iv = list1 (iv);
1995
1996 CHECK_CONS (iv);
1997
1998
1999 const char *desc = encrypting ? "encrypt" : "decrypt";
2000
2001 gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
2002
2003 Lisp_Object info = Qnil;
2004 if (STRINGP (cipher))
2005 cipher = intern (SSDATA (cipher));
2006
2007 if (SYMBOLP (cipher))
2008 info = XCDR (Fassq (cipher, Fgnutls_ciphers ()));
2009 else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher))
2010 gca = XINT (cipher);
2011 else
2012 info = cipher;
2013
2014 if (!NILP (info) && CONSP (info))
2015 {
2016 Lisp_Object v = Fplist_get (info, QCcipher_id);
2017 if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v))
2018 gca = XINT (v);
2019 }
2020
2021 ptrdiff_t key_size = gnutls_cipher_get_key_size (gca);
2022 if (key_size == 0)
2023 error ("GnuTLS cipher is invalid or not found");
2024
2025 ptrdiff_t kstart_byte, kend_byte;
2026 const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
2027
2028 if (kdata == NULL)
2029 error ("GnuTLS cipher key extraction failed");
2030
2031 if (kend_byte - kstart_byte != key_size)
2032 error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to "
2033 "the required %"pD"d"),
2034 gnutls_cipher_get_name (gca), desc,
2035 kend_byte - kstart_byte, key_size);
2036
2037 ptrdiff_t vstart_byte, vend_byte;
2038 char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte);
2039
2040 if (vdata == NULL)
2041 error ("GnuTLS cipher IV extraction failed");
2042
2043 ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca);
2044 if (vend_byte - vstart_byte != iv_size)
2045 error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to "
2046 "the required %"pD"d"),
2047 gnutls_cipher_get_name (gca), desc,
2048 vend_byte - vstart_byte, iv_size);
2049
2050 Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte);
2051
2052 ptrdiff_t istart_byte, iend_byte;
2053 const char *idata
2054 = extract_data_from_object (input, &istart_byte, &iend_byte);
2055
2056 if (idata == NULL)
2057 error ("GnuTLS cipher input extraction failed");
2058
2059 /* Is this an AEAD cipher? */
2060 if (gnutls_cipher_get_tag_size (gca) > 0)
2061 {
2062 Lisp_Object aead_output =
2063 gnutls_symmetric_aead (encrypting, gca, cipher,
2064 kdata, kend_byte - kstart_byte,
2065 vdata, vend_byte - vstart_byte,
2066 idata, iend_byte - istart_byte,
2067 aead_auth);
2068 if (STRINGP (XCAR (key)))
2069 Fclear_string (XCAR (key));
2070 return aead_output;
2071 }
2072
2073 ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
2074 if ((iend_byte - istart_byte) % cipher_block_size != 0)
2075 error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple "
2076 "of the required %"pD"d"),
2077 gnutls_cipher_get_name (gca), desc,
2078 iend_byte - istart_byte, cipher_block_size);
2079
2080 gnutls_cipher_hd_t hcipher;
2081 gnutls_datum_t key_datum
2082 = { (unsigned char *) kdata, kend_byte - kstart_byte };
2083
2084 int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL);
2085
2086 if (ret < GNUTLS_E_SUCCESS)
2087 error ("GnuTLS cipher %s/%s initialization failed: %s",
2088 gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
2089
2090 /* Note that this will not support streaming block mode. */
2091 gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte);
2092
2093 /* GnuTLS docs: "For the supported ciphers the encrypted data length
2094 will equal the plaintext size." */
2095 ptrdiff_t storage_length = iend_byte - istart_byte;
2096 Lisp_Object storage = make_uninit_string (storage_length);
2097
2098 ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2)
2099 (hcipher, idata, iend_byte - istart_byte,
2100 SSDATA (storage), storage_length));
2101
2102 if (STRINGP (XCAR (key)))
2103 Fclear_string (XCAR (key));
2104
2105 if (ret < GNUTLS_E_SUCCESS)
2106 {
2107 gnutls_cipher_deinit (hcipher);
2108 if (encrypting)
2109 error ("GnuTLS cipher %s encryption failed: %s",
2110 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
2111 else
2112 error ("GnuTLS cipher %s decryption failed: %s",
2113 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
2114 }
2115
2116 gnutls_cipher_deinit (hcipher);
2117
2118 return list2 (storage, actual_iv);
2119}
2120
2121DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt,
2122 Sgnutls_symmetric_encrypt, 4, 5, 0,
2123 doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
2124
2125Return nil on error.
2126
2127The KEY can be specified as a buffer or string or in other ways (see
2128Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
2129will be wiped after use if it's a string.
2130
2131The IV and INPUT and the optional AEAD_AUTH can be specified as a
2132buffer or string or in other ways (see Info node `(elisp)Format of
2133GnuTLS Cryptography Inputs').
2134
2135The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
2136The CIPHER may be a string or symbol matching a key in that alist, or
2137a plist with the :cipher-id numeric property, or the number itself.
2138
2139AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
2140:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
2141these AEAD ciphers, but it may still be omitted (nil) as well. */)
2142 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
2143 Lisp_Object input, Lisp_Object aead_auth)
2144{
2145 return gnutls_symmetric (true, cipher, key, iv, input, aead_auth);
2146}
2147
2148DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt,
2149 Sgnutls_symmetric_decrypt, 4, 5, 0,
2150 doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
2151
2152Return nil on error.
2153
2154The KEY can be specified as a buffer or string or in other ways (see
2155Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
2156will be wiped after use if it's a string.
2157
2158The IV and INPUT and the optional AEAD_AUTH can be specified as a
2159buffer or string or in other ways (see Info node `(elisp)Format of
2160GnuTLS Cryptography Inputs').
2161
2162The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
2163The CIPHER may be a string or symbol matching a key in that alist, or
2164a plist with the `:cipher-id' numeric property, or the number itself.
2165
2166AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
2167:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
2168these AEAD ciphers, but it may still be omitted (nil) as well. */)
2169 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
2170 Lisp_Object input, Lisp_Object aead_auth)
2171{
2172 return gnutls_symmetric (false, cipher, key, iv, input, aead_auth);
2173}
2174
2175DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0,
2176 doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists.
2177
2178Use the value of the alist (extract it with `alist-get' for instance)
2179with `gnutls-hash-mac'. The alist key is the mac-algorithm method
2180name. */)
2181 (void)
2182{
2183 Lisp_Object mac_algorithms = Qnil;
2184#ifdef HAVE_GNUTLS3_HMAC
2185 const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
2186 for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
2187 {
2188 const gnutls_mac_algorithm_t gma = macs[pos];
2189
2190 /* A symbol representing the GnuTLS MAC algorithm. */
2191 Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma));
2192
2193 Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol,
2194 QCmac_algorithm_id, make_number (gma),
2195 QCtype, Qgnutls_type_mac_algorithm,
2196
2197 QCmac_algorithm_length,
2198 make_number (gnutls_hmac_get_len (gma)),
2199
2200 QCmac_algorithm_keysize,
2201 make_number (gnutls_mac_get_key_size (gma)),
2202
2203 QCmac_algorithm_noncesize,
2204 make_number (gnutls_mac_get_nonce_size (gma)));
2205 mac_algorithms = Fcons (mp, mac_algorithms);
2206 }
2207#endif
2208
2209 return mac_algorithms;
2210}
2211
2212DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0,
2213 doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists.
2214
2215Use the value of the alist (extract it with `alist-get' for instance)
2216with `gnutls-hash-digest'. The alist key is the digest-algorithm
2217method name. */)
2218 (void)
2219{
2220 Lisp_Object digest_algorithms = Qnil;
2221#ifdef HAVE_GNUTLS3_DIGEST
2222 const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
2223 for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
2224 {
2225 const gnutls_digest_algorithm_t gda = digests[pos];
2226
2227 /* A symbol representing the GnuTLS digest algorithm. */
2228 Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda));
2229
2230 Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol,
2231 QCdigest_algorithm_id, make_number (gda),
2232 QCtype, Qgnutls_type_digest_algorithm,
2233
2234 QCdigest_algorithm_length,
2235 make_number (gnutls_hash_get_len (gda)));
2236
2237 digest_algorithms = Fcons (mp, digest_algorithms);
2238 }
2239#endif
2240
2241 return digest_algorithms;
2242}
2243
2244DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0,
2245 doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string.
2246
2247Return nil on error.
2248
2249The KEY can be specified as a buffer or string or in other ways (see
2250Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
2251will be wiped after use if it's a string.
2252
2253The INPUT can be specified as a buffer or string or in other
2254ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2255
2256The alist of MAC algorithms can be obtained with `gnutls-macs`. The
2257HASH-METHOD may be a string or symbol matching a key in that alist, or
2258a plist with the `:mac-algorithm-id' numeric property, or the number
2259itself. */)
2260 (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input)
2261{
2262 if (BUFFERP (input) || STRINGP (input))
2263 input = list1 (input);
2264
2265 CHECK_CONS (input);
2266
2267 if (BUFFERP (key) || STRINGP (key))
2268 key = list1 (key);
2269
2270 CHECK_CONS (key);
2271
2272 gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
2273
2274 Lisp_Object info = Qnil;
2275 if (STRINGP (hash_method))
2276 hash_method = intern (SSDATA (hash_method));
2277
2278 if (SYMBOLP (hash_method))
2279 info = XCDR (Fassq (hash_method, Fgnutls_macs ()));
2280 else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method))
2281 gma = XINT (hash_method);
2282 else
2283 info = hash_method;
2284
2285 if (!NILP (info) && CONSP (info))
2286 {
2287 Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
2288 if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v))
2289 gma = XINT (v);
2290 }
2291
2292 ptrdiff_t digest_length = gnutls_hmac_get_len (gma);
2293 if (digest_length == 0)
2294 error ("GnuTLS MAC-method is invalid or not found");
2295
2296 ptrdiff_t kstart_byte, kend_byte;
2297 const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
2298 if (kdata == NULL)
2299 error ("GnuTLS MAC key extraction failed");
2300
2301 gnutls_hmac_hd_t hmac;
2302 int ret = gnutls_hmac_init (&hmac, gma,
2303 kdata + kstart_byte, kend_byte - kstart_byte);
2304 if (ret < GNUTLS_E_SUCCESS)
2305 error ("GnuTLS MAC %s initialization failed: %s",
2306 gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
2307
2308 ptrdiff_t istart_byte, iend_byte;
2309 const char *idata
2310 = extract_data_from_object (input, &istart_byte, &iend_byte);
2311 if (idata == NULL)
2312 error ("GnuTLS MAC input extraction failed");
2313
2314 Lisp_Object digest = make_uninit_string (digest_length);
2315
2316 ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte);
2317
2318 if (STRINGP (XCAR (key)))
2319 Fclear_string (XCAR (key));
2320
2321 if (ret < GNUTLS_E_SUCCESS)
2322 {
2323 gnutls_hmac_deinit (hmac, NULL);
2324 error ("GnuTLS MAC %s application failed: %s",
2325 gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
2326 }
2327
2328 gnutls_hmac_output (hmac, SSDATA (digest));
2329 gnutls_hmac_deinit (hmac, NULL);
2330
2331 return digest;
2332}
2333
2334DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
2335 doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string.
2336
2337Return nil on error.
2338
2339The INPUT can be specified as a buffer or string or in other
2340ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2341
2342The alist of digest algorithms can be obtained with `gnutls-digests`.
2343The DIGEST-METHOD may be a string or symbol matching a key in that
2344alist, or a plist with the `:digest-algorithm-id' numeric property, or
2345the number itself. */)
2346 (Lisp_Object digest_method, Lisp_Object input)
2347{
2348 if (BUFFERP (input) || STRINGP (input))
2349 input = list1 (input);
2350
2351 CHECK_CONS (input);
2352
2353 gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
2354
2355 Lisp_Object info = Qnil;
2356 if (STRINGP (digest_method))
2357 digest_method = intern (SSDATA (digest_method));
2358
2359 if (SYMBOLP (digest_method))
2360 info = XCDR (Fassq (digest_method, Fgnutls_digests ()));
2361 else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method))
2362 gda = XINT (digest_method);
2363 else
2364 info = digest_method;
2365
2366 if (!NILP (info) && CONSP (info))
2367 {
2368 Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
2369 if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v))
2370 gda = XINT (v);
2371 }
2372
2373 ptrdiff_t digest_length = gnutls_hash_get_len (gda);
2374 if (digest_length == 0)
2375 error ("GnuTLS digest-method is invalid or not found");
2376
2377 gnutls_hash_hd_t hash;
2378 int ret = gnutls_hash_init (&hash, gda);
2379
2380 if (ret < GNUTLS_E_SUCCESS)
2381 error ("GnuTLS digest initialization failed: %s",
2382 emacs_gnutls_strerror (ret));
2383
2384 Lisp_Object digest = make_uninit_string (digest_length);
2385
2386 ptrdiff_t istart_byte, iend_byte;
2387 const char *idata
2388 = extract_data_from_object (input, &istart_byte, &iend_byte);
2389 if (idata == NULL)
2390 error ("GnuTLS digest input extraction failed");
2391
2392 ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte);
2393
2394 if (ret < GNUTLS_E_SUCCESS)
2395 {
2396 gnutls_hash_deinit (hash, NULL);
2397 error ("GnuTLS digest application failed: %s",
2398 emacs_gnutls_strerror (ret));
2399 }
2400
2401 gnutls_hash_output (hash, SSDATA (digest));
2402 gnutls_hash_deinit (hash, NULL);
2403
2404 return digest;
2405}
2406
2407#endif /* HAVE_GNUTLS3 */
2408
1700DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, 2409DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
1701 doc: /* Return t if GnuTLS is available in this instance of Emacs. */) 2410 doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs.
1702 (void) 2411
2412...if supported : then...
2413GnuTLS 3 or higher : the list will contain `gnutls3'.
2414GnuTLS MACs : the list will contain `macs'.
2415GnuTLS digests : the list will contain `digests'.
2416GnuTLS symmetric ciphers: the list will contain `ciphers'.
2417GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */)
2418 (void)
1703{ 2419{
2420 Lisp_Object capabilities = Qnil;
2421
1704#ifdef HAVE_GNUTLS 2422#ifdef HAVE_GNUTLS
1705# ifdef WINDOWSNT 2423
2424# ifdef HAVE_GNUTLS3
2425 capabilities = Fcons (intern("gnutls3"), capabilities);
2426
2427# ifdef HAVE_GNUTLS3_DIGEST
2428 capabilities = Fcons (intern("digests"), capabilities);
2429# endif
2430
2431# ifdef HAVE_GNUTLS3_CIPHER
2432 capabilities = Fcons (intern("ciphers"), capabilities);
2433
2434# ifdef HAVE_GNUTLS3_AEAD
2435 capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
2436# endif
2437
2438# ifdef HAVE_GNUTLS3_HMAC
2439 capabilities = Fcons (intern("macs"), capabilities);
2440# endif
2441# endif /* HAVE_GNUTLS3_CIPHER */
2442# endif /* HAVE_GNUTLS3 */
2443
2444#ifdef WINDOWSNT
1706 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); 2445 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
1707 if (CONSP (found)) 2446 if (CONSP (found))
1708 return XCDR (found); 2447 return XCDR (found);
1709 else 2448 else
1710 { 2449 {
1711 Lisp_Object status; 2450 Lisp_Object status;
1712 status = init_gnutls_functions () ? Qt : Qnil; 2451 status = init_gnutls_functions () ? capabilities : Qnil;
1713 Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); 2452 Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
1714 return status; 2453 return status;
1715 } 2454 }
1716# else /* !WINDOWSNT */ 2455#else /* !WINDOWSNT */
1717 return Qt; 2456
1718# endif /* !WINDOWSNT */ 2457 return capabilities;
2458
2459#endif /* WINDOWSNT */
2460
1719#else /* !HAVE_GNUTLS */ 2461#else /* !HAVE_GNUTLS */
1720 return Qnil; 2462 return Qnil;
1721#endif /* !HAVE_GNUTLS */ 2463#endif /* HAVE_GNUTLS */
1722} 2464}
1723 2465
1724void 2466void
@@ -1753,6 +2495,27 @@ syms_of_gnutls (void)
1753 DEFSYM (QCverify_flags, ":verify-flags"); 2495 DEFSYM (QCverify_flags, ":verify-flags");
1754 DEFSYM (QCverify_error, ":verify-error"); 2496 DEFSYM (QCverify_error, ":verify-error");
1755 2497
2498 DEFSYM (QCcipher_id, ":cipher-id");
2499 DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
2500 DEFSYM (QCcipher_blocksize, ":cipher-blocksize");
2501 DEFSYM (QCcipher_keysize, ":cipher-keysize");
2502 DEFSYM (QCcipher_tagsize, ":cipher-tagsize");
2503 DEFSYM (QCcipher_keysize, ":cipher-keysize");
2504 DEFSYM (QCcipher_ivsize, ":cipher-ivsize");
2505
2506 DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id");
2507 DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize");
2508 DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize");
2509 DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length");
2510
2511 DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id");
2512 DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length");
2513
2514 DEFSYM (QCtype, ":type");
2515 DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher");
2516 DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm");
2517 DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm");
2518
1756 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); 2519 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1757 Fput (Qgnutls_e_interrupted, Qgnutls_code, 2520 Fput (Qgnutls_e_interrupted, Qgnutls_code,
1758 make_number (GNUTLS_E_INTERRUPTED)); 2521 make_number (GNUTLS_E_INTERRUPTED));
@@ -1780,6 +2543,16 @@ syms_of_gnutls (void)
1780 defsubr (&Sgnutls_peer_status); 2543 defsubr (&Sgnutls_peer_status);
1781 defsubr (&Sgnutls_peer_status_warning_describe); 2544 defsubr (&Sgnutls_peer_status_warning_describe);
1782 2545
2546#ifdef HAVE_GNUTLS3
2547 defsubr (&Sgnutls_ciphers);
2548 defsubr (&Sgnutls_macs);
2549 defsubr (&Sgnutls_digests);
2550 defsubr (&Sgnutls_hash_mac);
2551 defsubr (&Sgnutls_hash_digest);
2552 defsubr (&Sgnutls_symmetric_encrypt);
2553 defsubr (&Sgnutls_symmetric_decrypt);
2554#endif
2555
1783 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, 2556 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1784 doc: /* Logging level used by the GnuTLS functions. 2557 doc: /* Logging level used by the GnuTLS functions.
1785Set this larger than 0 to get debug output in the *Messages* buffer. 2558Set this larger than 0 to get debug output in the *Messages* buffer.
diff --git a/src/gnutls.h b/src/gnutls.h
index 3c84023cd4e..3ec86a8892d 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -23,6 +23,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23#include <gnutls/gnutls.h> 23#include <gnutls/gnutls.h>
24#include <gnutls/x509.h> 24#include <gnutls/x509.h>
25 25
26#ifdef HAVE_GNUTLS3
27#include <gnutls/crypto.h>
28#endif
29
26#include "lisp.h" 30#include "lisp.h"
27 31
28/* This limits the attempts to handshake per process (connection). It 32/* This limits the attempts to handshake per process (connection). It
@@ -82,6 +86,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte);
82extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state); 86extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state);
83#ifdef WINDOWSNT 87#ifdef WINDOWSNT
84extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); 88extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
89extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t);
85#endif 90#endif
86extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); 91extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
87extern Lisp_Object emacs_gnutls_global_init (void); 92extern Lisp_Object emacs_gnutls_global_init (void);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 2d4abefa969..0c8395efe9b 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -204,6 +204,31 @@ xg_display_open (char *display_name, Display **dpy)
204 *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; 204 *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL;
205} 205}
206 206
207/* Scaling/HiDPI functions. */
208static int
209xg_get_gdk_scale (void)
210{
211 const char *sscale = getenv ("GDK_SCALE");
212
213 if (sscale)
214 {
215 long scale = atol (sscale);
216 if (0 < scale)
217 return min (scale, INT_MAX);
218 }
219
220 return 1;
221}
222
223int
224xg_get_scale (struct frame *f)
225{
226#if GTK_CHECK_VERSION (3, 10, 0)
227 if (FRAME_GTK_WIDGET (f))
228 return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f));
229#endif
230 return xg_get_gdk_scale ();
231}
207 232
208/* Close display DPY. */ 233/* Close display DPY. */
209 234
@@ -724,7 +749,8 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y)
724 if (x->ttip_window) 749 if (x->ttip_window)
725 { 750 {
726 block_input (); 751 block_input ();
727 gtk_window_move (x->ttip_window, root_x, root_y); 752 gtk_window_move (x->ttip_window, root_x / xg_get_scale (f),
753 root_y / xg_get_scale (f));
728 gtk_widget_show_all (GTK_WIDGET (x->ttip_window)); 754 gtk_widget_show_all (GTK_WIDGET (x->ttip_window));
729 unblock_input (); 755 unblock_input ();
730 } 756 }
@@ -836,21 +862,6 @@ xg_set_geometry (struct frame *f)
836 } 862 }
837} 863}
838 864
839static int
840xg_get_gdk_scale (void)
841{
842 const char *sscale = getenv ("GDK_SCALE");
843
844 if (sscale)
845 {
846 long scale = atol (sscale);
847 if (0 < scale)
848 return min (scale, INT_MAX);
849 }
850
851 return 1;
852}
853
854/* Function to handle resize of our frame. As we have a Gtk+ tool bar 865/* Function to handle resize of our frame. As we have a Gtk+ tool bar
855 and a Gtk+ menu bar, we get resize events for the edit part of the 866 and a Gtk+ menu bar, we get resize events for the edit part of the
856 frame only. We let Gtk+ deal with the Gtk+ parts. 867 frame only. We let Gtk+ deal with the Gtk+ parts.
@@ -912,12 +923,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
912 /* Do this before resize, as we don't know yet if we will be resized. */ 923 /* Do this before resize, as we don't know yet if we will be resized. */
913 x_clear_under_internal_border (f); 924 x_clear_under_internal_border (f);
914 925
915 if (FRAME_VISIBLE_P (f)) 926 totalheight /= xg_get_scale (f);
916 { 927 totalwidth /= xg_get_scale (f);
917 int scale = xg_get_gdk_scale ();
918 totalheight /= scale;
919 totalwidth /= scale;
920 }
921 928
922 x_wm_set_size_hint (f, 0, 0); 929 x_wm_set_size_hint (f, 0, 0);
923 930
@@ -1343,7 +1350,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position)
1343 int min_rows = 0, min_cols = 0; 1350 int min_rows = 0, min_cols = 0;
1344 int win_gravity = f->win_gravity; 1351 int win_gravity = f->win_gravity;
1345 Lisp_Object fs_state, frame; 1352 Lisp_Object fs_state, frame;
1346 int scale = xg_get_gdk_scale (); 1353 int scale = xg_get_scale (f);
1347 1354
1348 /* Don't set size hints during initialization; that apparently leads 1355 /* Don't set size hints during initialization; that apparently leads
1349 to a race condition. See the thread at 1356 to a race condition. See the thread at
@@ -3659,16 +3666,16 @@ update_theme_scrollbar_height (void)
3659} 3666}
3660 3667
3661int 3668int
3662xg_get_default_scrollbar_width (void) 3669xg_get_default_scrollbar_width (struct frame *f)
3663{ 3670{
3664 return scroll_bar_width_for_theme * xg_get_gdk_scale (); 3671 return scroll_bar_width_for_theme * xg_get_scale (f);
3665} 3672}
3666 3673
3667int 3674int
3668xg_get_default_scrollbar_height (void) 3675xg_get_default_scrollbar_height (struct frame *f)
3669{ 3676{
3670 /* Apparently there's no default height for themes. */ 3677 /* Apparently there's no default height for themes. */
3671 return scroll_bar_width_for_theme * xg_get_gdk_scale (); 3678 return scroll_bar_width_for_theme * xg_get_scale (f);
3672} 3679}
3673 3680
3674/* Return the scrollbar id for X Window WID on display DPY. 3681/* Return the scrollbar id for X Window WID on display DPY.
@@ -3858,7 +3865,7 @@ xg_update_scrollbar_pos (struct frame *f,
3858 GtkWidget *wfixed = f->output_data.x->edit_widget; 3865 GtkWidget *wfixed = f->output_data.x->edit_widget;
3859 GtkWidget *wparent = gtk_widget_get_parent (wscroll); 3866 GtkWidget *wparent = gtk_widget_get_parent (wscroll);
3860 gint msl; 3867 gint msl;
3861 int scale = xg_get_gdk_scale (); 3868 int scale = xg_get_scale (f);
3862 3869
3863 top /= scale; 3870 top /= scale;
3864 left /= scale; 3871 left /= scale;
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 0abcb06bc71..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,
143 int position, 143 int position,
144 int whole); 144 int whole);
145extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); 145extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *);
146extern int xg_get_default_scrollbar_width (void); 146extern int xg_get_default_scrollbar_width (struct frame *f);
147extern int xg_get_default_scrollbar_height (void); 147extern int xg_get_default_scrollbar_height (struct frame *f);
148 148
149extern void update_frame_tool_bar (struct frame *f); 149extern void update_frame_tool_bar (struct frame *f);
150extern void free_frame_tool_bar (struct frame *f); 150extern void free_frame_tool_bar (struct frame *f);
@@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f,
156extern void xg_frame_set_char_size (struct frame *f, int width, int height); 156extern void xg_frame_set_char_size (struct frame *f, int width, int height);
157extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); 157extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc);
158 158
159extern int xg_get_scale (struct frame *f);
159extern void xg_display_open (char *display_name, Display **dpy); 160extern void xg_display_open (char *display_name, Display **dpy);
160extern void xg_display_close (Display *dpy); 161extern void xg_display_close (Display *dpy);
161extern GdkCursor * xg_create_default_cursor (Display *dpy); 162extern GdkCursor * xg_create_default_cursor (Display *dpy);
diff --git a/src/image.c b/src/image.c
index 91749fb8733..76a19a68b0d 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4231,7 +4231,7 @@ xpm_load_image (struct frame *f,
4231 color_val = Qnil; 4231 color_val = Qnil;
4232 if (!NILP (color_symbols) && !NILP (symbol_color)) 4232 if (!NILP (color_symbols) && !NILP (symbol_color))
4233 { 4233 {
4234 Lisp_Object specified_color = Fassoc (symbol_color, color_symbols); 4234 Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil);
4235 4235
4236 if (CONSP (specified_color) && STRINGP (XCDR (specified_color))) 4236 if (CONSP (specified_color) && STRINGP (XCDR (specified_color)))
4237 { 4237 {
@@ -8086,83 +8086,76 @@ compute_image_size (size_t width, size_t height,
8086 int *d_width, int *d_height) 8086 int *d_width, int *d_height)
8087{ 8087{
8088 Lisp_Object value; 8088 Lisp_Object value;
8089 int desired_width, desired_height; 8089 int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1;
8090 double scale = 1; 8090 double scale = 1;
8091 8091
8092 value = image_spec_value (spec, QCscale, NULL); 8092 value = image_spec_value (spec, QCscale, NULL);
8093 if (NUMBERP (value)) 8093 if (NUMBERP (value))
8094 scale = XFLOATINT (value); 8094 scale = XFLOATINT (value);
8095 8095
8096 value = image_spec_value (spec, QCmax_width, NULL);
8097 if (NATNUMP (value))
8098 max_width = min (XFASTINT (value), INT_MAX);
8099
8100 value = image_spec_value (spec, QCmax_height, NULL);
8101 if (NATNUMP (value))
8102 max_height = min (XFASTINT (value), INT_MAX);
8103
8096 /* If width and/or height is set in the display spec assume we want 8104 /* If width and/or height is set in the display spec assume we want
8097 to scale to those values. If either h or w is unspecified, the 8105 to scale to those values. If either h or w is unspecified, the
8098 unspecified should be calculated from the specified to preserve 8106 unspecified should be calculated from the specified to preserve
8099 aspect ratio. */ 8107 aspect ratio. */
8100 value = image_spec_value (spec, QCwidth, NULL); 8108 value = image_spec_value (spec, QCwidth, NULL);
8101 desired_width = NATNUMP (value) ? 8109 if (NATNUMP (value))
8102 min (XFASTINT (value) * scale, INT_MAX) : -1; 8110 {
8111 desired_width = min (XFASTINT (value) * scale, INT_MAX);
8112 /* :width overrides :max-width. */
8113 max_width = -1;
8114 }
8115
8103 value = image_spec_value (spec, QCheight, NULL); 8116 value = image_spec_value (spec, QCheight, NULL);
8104 desired_height = NATNUMP (value) ? 8117 if (NATNUMP (value))
8105 min (XFASTINT (value) * scale, INT_MAX) : -1; 8118 {
8119 desired_height = min (XFASTINT (value) * scale, INT_MAX);
8120 /* :height overrides :max-height. */
8121 max_height = -1;
8122 }
8123
8124 /* If we have both width/height set explicitly, we skip past all the
8125 aspect ratio-preserving computations below. */
8126 if (desired_width != -1 && desired_height != -1)
8127 goto out;
8106 8128
8107 width = width * scale; 8129 width = width * scale;
8108 height = height * scale; 8130 height = height * scale;
8109 8131
8110 if (desired_width == -1) 8132 if (desired_width != -1)
8133 /* Width known, calculate height. */
8134 desired_height = scale_image_size (desired_width, width, height);
8135 else if (desired_height != -1)
8136 /* Height known, calculate width. */
8137 desired_width = scale_image_size (desired_height, height, width);
8138 else
8111 { 8139 {
8112 value = image_spec_value (spec, QCmax_width, NULL); 8140 desired_width = width;
8113 if (NATNUMP (value)) 8141 desired_height = height;
8114 {
8115 int max_width = min (XFASTINT (value), INT_MAX);
8116 if (max_width < width)
8117 {
8118 /* The image is wider than :max-width. */
8119 desired_width = max_width;
8120 if (desired_height == -1)
8121 {
8122 desired_height = scale_image_size (desired_width,
8123 width, height);
8124 value = image_spec_value (spec, QCmax_height, NULL);
8125 if (NATNUMP (value))
8126 {
8127 int max_height = min (XFASTINT (value), INT_MAX);
8128 if (max_height < desired_height)
8129 {
8130 desired_height = max_height;
8131 desired_width = scale_image_size (desired_height,
8132 height, width);
8133 }
8134 }
8135 }
8136 }
8137 }
8138 } 8142 }
8139 8143
8140 if (desired_height == -1) 8144 if (max_width != -1 && desired_width > max_width)
8141 { 8145 {
8142 value = image_spec_value (spec, QCmax_height, NULL); 8146 /* The image is wider than :max-width. */
8143 if (NATNUMP (value)) 8147 desired_width = max_width;
8144 { 8148 desired_height = scale_image_size (desired_width, width, height);
8145 int max_height = min (XFASTINT (value), INT_MAX);
8146 if (max_height < height)
8147 desired_height = max_height;
8148 }
8149 } 8149 }
8150 8150
8151 if (desired_width != -1 && desired_height == -1) 8151 if (max_height != -1 && desired_height > max_height)
8152 /* w known, calculate h. */
8153 desired_height = scale_image_size (desired_width, width, height);
8154
8155 if (desired_width == -1 && desired_height != -1)
8156 /* h known, calculate w. */
8157 desired_width = scale_image_size (desired_height, height, width);
8158
8159 /* We have no width/height settings, so just apply the scale. */
8160 if (desired_width == -1 && desired_height == -1)
8161 { 8152 {
8162 desired_width = width; 8153 /* The image is higher than :max-height. */
8163 desired_height = height; 8154 desired_height = max_height;
8155 desired_width = scale_image_size (desired_height, height, width);
8164 } 8156 }
8165 8157
8158 out:
8166 *d_width = desired_width; 8159 *d_width = desired_width;
8167 *d_height = desired_height; 8160 *d_height = desired_height;
8168} 8161}
diff --git a/src/indent.c b/src/indent.c
index adecc3622a8..4c6dacd2042 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1947,6 +1947,57 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
1947 -1, hscroll, 0, w); 1947 -1, hscroll, 0, w);
1948} 1948}
1949 1949
1950/* Return the width taken by line-number display in window W. */
1951static void
1952line_number_display_width (struct window *w, int *width, int *pixel_width)
1953{
1954 if (NILP (Vdisplay_line_numbers))
1955 {
1956 *width = 0;
1957 *pixel_width = 0;
1958 }
1959 else
1960 {
1961 struct it it;
1962 struct text_pos wstart;
1963 bool saved_restriction = false;
1964 ptrdiff_t count = SPECPDL_INDEX ();
1965 SET_TEXT_POS_FROM_MARKER (wstart, w->start);
1966 void *itdata = bidi_shelve_cache ();
1967 /* We must start from window's start point, but it could be
1968 outside the accessible region. */
1969 if (wstart.charpos < BEGV || wstart.charpos > ZV)
1970 {
1971 record_unwind_protect (save_restriction_restore,
1972 save_restriction_save ());
1973 Fwiden ();
1974 saved_restriction = true;
1975 }
1976 start_display (&it, w, wstart);
1977 move_it_by_lines (&it, 1);
1978 *width = it.lnum_width;
1979 *pixel_width = it.lnum_pixel_width;
1980 if (saved_restriction)
1981 unbind_to (count, Qnil);
1982 bidi_unshelve_cache (itdata, 0);
1983 }
1984}
1985
1986DEFUN ("line-number-display-width", Fline_number_display_width,
1987 Sline_number_display_width, 0, 1, 0,
1988 doc: /* Return the width used for displaying line numbers in the selected window.
1989If optional argument PIXELWISE is non-nil, return the width in pixels,
1990otherwise return the width in columns of the face used to display
1991line numbers, `line-number'. */)
1992 (Lisp_Object pixelwise)
1993{
1994 int width, pixel_width;
1995 line_number_display_width (XWINDOW (selected_window), &width, &pixel_width);
1996 if (!NILP (pixelwise))
1997 return make_number (pixel_width);
1998 return make_number (width);
1999}
2000
1950/* In window W (derived from WINDOW), return x coordinate for column 2001/* In window W (derived from WINDOW), return x coordinate for column
1951 COL (derived from COLUMN). */ 2002 COL (derived from COLUMN). */
1952static int 2003static int
@@ -2068,9 +2119,19 @@ whether or not it is currently displayed in some window. */)
2068 start_x = window_column_x (w, window, start_col, cur_col); 2119 start_x = window_column_x (w, window, start_col, cur_col);
2069 } 2120 }
2070 2121
2071 itdata = bidi_shelve_cache (); 2122 /* When displaying line numbers, we need to prime IT's
2123 lnum_width with the value calculated at window's start, since
2124 that's what normal window redisplay does. Otherwise C-n/C-p
2125 will sometimes err by one column. */
2126 int lnum_width = 0;
2127 int lnum_pixel_width = 0;
2128 if (!NILP (Vdisplay_line_numbers)
2129 && !EQ (Vdisplay_line_numbers, Qvisual))
2130 line_number_display_width (w, &lnum_width, &lnum_pixel_width);
2072 SET_TEXT_POS (pt, PT, PT_BYTE); 2131 SET_TEXT_POS (pt, PT, PT_BYTE);
2132 itdata = bidi_shelve_cache ();
2073 start_display (&it, w, pt); 2133 start_display (&it, w, pt);
2134 it.lnum_width = lnum_width;
2074 first_x = it.first_visible_x; 2135 first_x = it.first_visible_x;
2075 it_start = IT_CHARPOS (it); 2136 it_start = IT_CHARPOS (it);
2076 2137
@@ -2247,6 +2308,12 @@ whether or not it is currently displayed in some window. */)
2247 an addition to the hscroll amount. */ 2308 an addition to the hscroll amount. */
2248 if (lcols_given) 2309 if (lcols_given)
2249 { 2310 {
2311 /* If we are displaying line numbers, we could cross the
2312 line where the width of the line-number display changes,
2313 in which case we need to fix up the pixel coordinate
2314 accordingly. */
2315 if (lnum_pixel_width > 0)
2316 to_x += it.lnum_pixel_width - lnum_pixel_width;
2250 move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X); 2317 move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
2251 /* If we find ourselves in the middle of an overlay string 2318 /* If we find ourselves in the middle of an overlay string
2252 which includes a newline after current string position, 2319 which includes a newline after current string position,
@@ -2292,6 +2359,7 @@ syms_of_indent (void)
2292 defsubr (&Sindent_to); 2359 defsubr (&Sindent_to);
2293 defsubr (&Scurrent_column); 2360 defsubr (&Scurrent_column);
2294 defsubr (&Smove_to_column); 2361 defsubr (&Smove_to_column);
2362 defsubr (&Sline_number_display_width);
2295 defsubr (&Svertical_motion); 2363 defsubr (&Svertical_motion);
2296 defsubr (&Scompute_motion); 2364 defsubr (&Scompute_motion);
2297} 2365}
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)
224 Pass FUNCTION two args: an interval, and ARG. */ 224 Pass FUNCTION two args: an interval, and ARG. */
225 225
226void 226void
227traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) 227traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *),
228 void *arg)
228{ 229{
229 /* Minimize stack usage. */ 230 /* Minimize stack usage. */
230 while (tree) 231 while (tree)
@@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position,
257 } 258 }
258} 259}
259 260
260#if 0
261
262static int icount;
263static int idepth;
264static int zero_length;
265
266/* These functions are temporary, for debugging purposes only. */
267
268INTERVAL search_interval, found_interval;
269
270void
271check_for_interval (INTERVAL i)
272{
273 if (i == search_interval)
274 {
275 found_interval = i;
276 icount++;
277 }
278}
279
280INTERVAL
281search_for_interval (INTERVAL i, INTERVAL tree)
282{
283 icount = 0;
284 search_interval = i;
285 found_interval = NULL;
286 traverse_intervals_noorder (tree, &check_for_interval, Qnil);
287 return found_interval;
288}
289
290static void
291inc_interval_count (INTERVAL i)
292{
293 icount++;
294 if (LENGTH (i) == 0)
295 zero_length++;
296 if (depth > idepth)
297 idepth = depth;
298}
299
300int
301count_intervals (INTERVAL i)
302{
303 icount = 0;
304 idepth = 0;
305 zero_length = 0;
306 traverse_intervals_noorder (i, &inc_interval_count, Qnil);
307
308 return icount;
309}
310
311static INTERVAL
312root_interval (INTERVAL interval)
313{
314 register INTERVAL i = interval;
315
316 while (! ROOT_INTERVAL_P (i))
317 i = INTERVAL_PARENT (i);
318
319 return i;
320}
321#endif
322
323/* Assuming that a left child exists, perform the following operation: 261/* Assuming that a left child exists, perform the following operation:
324 262
325 A B 263 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,
242 void (*) (INTERVAL, Lisp_Object), 242 void (*) (INTERVAL, Lisp_Object),
243 Lisp_Object); 243 Lisp_Object);
244extern void traverse_intervals_noorder (INTERVAL, 244extern void traverse_intervals_noorder (INTERVAL,
245 void (*) (INTERVAL, Lisp_Object), 245 void (*) (INTERVAL, void *), void *);
246 Lisp_Object);
247extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); 246extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
248extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); 247extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
249extern INTERVAL find_interval (INTERVAL, ptrdiff_t); 248extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
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[] = {
5127 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) 5127 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
5128}; 5128};
5129 5129
5130#ifdef HAVE_WINDOW_SYSTEM
5130/* An array of symbol indexes of internal border parts, indexed by an enum 5131/* An array of symbol indexes of internal border parts, indexed by an enum
5131 internal_border_part value. Note that Qnil corresponds to 5132 internal_border_part value. Note that Qnil corresponds to
5132 internal_border_part_none and should not appear in Lisp events. */ 5133 internal_border_part_none and should not appear in Lisp events. */
@@ -5137,6 +5138,7 @@ static short const internal_border_parts[] = {
5137 SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge), 5138 SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
5138 SYMBOL_INDEX (Qbottom_left_corner) 5139 SYMBOL_INDEX (Qbottom_left_corner)
5139}; 5140};
5141#endif
5140 5142
5141/* A vector, indexed by button number, giving the down-going location 5143/* A vector, indexed by button number, giving the down-going location
5142 of currently depressed buttons, both scroll bar and non-scroll bar. 5144 of currently depressed buttons, both scroll bar and non-scroll bar.
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)
1292 base = XCAR (parsed); 1292 base = XCAR (parsed);
1293 name = Fsymbol_name (base); 1293 name = Fsymbol_name (base);
1294 /* This alist includes elements such as ("RET" . "\\r"). */ 1294 /* This alist includes elements such as ("RET" . "\\r"). */
1295 assoc = Fassoc (name, exclude_keys); 1295 assoc = Fassoc (name, exclude_keys, Qnil);
1296 1296
1297 if (! NILP (assoc)) 1297 if (! NILP (assoc))
1298 { 1298 {
diff --git a/src/lisp.h b/src/lisp.h
index ff8dde2b825..cffaf954b3b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -838,13 +838,13 @@ make_lisp_symbol (struct Lisp_Symbol *sym)
838INLINE Lisp_Object 838INLINE Lisp_Object
839builtin_lisp_symbol (int index) 839builtin_lisp_symbol (int index)
840{ 840{
841 return make_lisp_symbol (lispsym + index); 841 return make_lisp_symbol (&lispsym[index].s);
842} 842}
843 843
844INLINE void 844INLINE void
845(CHECK_SYMBOL) (Lisp_Object x) 845(CHECK_SYMBOL) (Lisp_Object x)
846{ 846{
847 lisp_h_CHECK_SYMBOL (x); 847 lisp_h_CHECK_SYMBOL (x);
848} 848}
849 849
850/* In the size word of a vector, this bit means the vector has been marked. */ 850/* In the size word of a vector, this bit means the vector has been marked. */
@@ -3386,6 +3386,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
3386extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; 3386extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
3387extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); 3387extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
3388extern void sweep_weak_hash_tables (void); 3388extern void sweep_weak_hash_tables (void);
3389extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
3389EMACS_UINT hash_string (char const *, ptrdiff_t); 3390EMACS_UINT hash_string (char const *, ptrdiff_t);
3390EMACS_UINT sxhash (Lisp_Object, int); 3391EMACS_UINT sxhash (Lisp_Object, int);
3391Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, 3392Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
@@ -3874,7 +3875,6 @@ extern Lisp_Object vformat_string (const char *, va_list)
3874 ATTRIBUTE_FORMAT_PRINTF (1, 0); 3875 ATTRIBUTE_FORMAT_PRINTF (1, 0);
3875extern void un_autoload (Lisp_Object); 3876extern void un_autoload (Lisp_Object);
3876extern Lisp_Object call_debugger (Lisp_Object arg); 3877extern Lisp_Object call_debugger (Lisp_Object arg);
3877extern void *near_C_stack_top (void);
3878extern void init_eval_once (void); 3878extern void init_eval_once (void);
3879extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); 3879extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
3880extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); 3880extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
@@ -3965,6 +3965,7 @@ extern void syms_of_editfns (void);
3965 3965
3966/* Defined in buffer.c. */ 3966/* Defined in buffer.c. */
3967extern bool mouse_face_overlay_overlaps (Lisp_Object); 3967extern bool mouse_face_overlay_overlaps (Lisp_Object);
3968extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
3968extern _Noreturn void nsberror (Lisp_Object); 3969extern _Noreturn void nsberror (Lisp_Object);
3969extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t); 3970extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
3970extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); 3971extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
diff --git a/src/lread.c b/src/lread.c
index 7c554ba8536..dbaadce4b40 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -103,8 +103,20 @@ static Lisp_Object read_objects_map;
103 (to reduce allocations), or nil. */ 103 (to reduce allocations), or nil. */
104static Lisp_Object read_objects_completed; 104static Lisp_Object read_objects_completed;
105 105
106/* File for get_file_char to read from. Use by load. */ 106/* File and lookahead for get-file-char and get-emacs-mule-file-char
107static FILE *instream; 107 to read from. Used by Fload. */
108static struct infile
109{
110 /* The input stream. */
111 FILE *stream;
112
113 /* Lookahead byte count. */
114 signed char lookahead;
115
116 /* Lookahead bytes, in reverse order. Keep these here because it is
117 not portable to ungetc more than one byte at a time. */
118 unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
119} *infile;
108 120
109/* For use within read-from-string (this reader is non-reentrant!!) */ 121/* For use within read-from-string (this reader is non-reentrant!!) */
110static ptrdiff_t read_from_string_index; 122static ptrdiff_t read_from_string_index;
@@ -149,7 +161,7 @@ static Lisp_Object Vloads_in_progress;
149static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), 161static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
150 Lisp_Object); 162 Lisp_Object);
151 163
152static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, 164static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
153 Lisp_Object, Lisp_Object, 165 Lisp_Object, Lisp_Object,
154 Lisp_Object, Lisp_Object); 166 Lisp_Object, Lisp_Object);
155 167
@@ -340,14 +352,13 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
340 len = BYTES_BY_CHAR_HEAD (c); 352 len = BYTES_BY_CHAR_HEAD (c);
341 while (i < len) 353 while (i < len)
342 { 354 {
343 c = (*readbyte) (-1, readcharfun); 355 buf[i++] = c = (*readbyte) (-1, readcharfun);
344 if (c < 0 || ! TRAILING_CODE_P (c)) 356 if (c < 0 || ! TRAILING_CODE_P (c))
345 { 357 {
346 while (--i > 1) 358 for (i -= c < 0; 0 < --i; )
347 (*readbyte) (buf[i], readcharfun); 359 (*readbyte) (buf[i], readcharfun);
348 return BYTE8_TO_CHAR (buf[0]); 360 return BYTE8_TO_CHAR (buf[0]);
349 } 361 }
350 buf[i++] = c;
351 } 362 }
352 return STRING_CHAR (buf); 363 return STRING_CHAR (buf);
353} 364}
@@ -362,8 +373,9 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
362 if (FROM_FILE_P (readcharfun)) 373 if (FROM_FILE_P (readcharfun))
363 { 374 {
364 block_input (); /* FIXME: Not sure if it's needed. */ 375 block_input (); /* FIXME: Not sure if it's needed. */
365 fseek (instream, n, SEEK_CUR); 376 fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
366 unblock_input (); 377 unblock_input ();
378 infile->lookahead = 0;
367 } 379 }
368 else 380 else
369 { /* We're not reading directly from a file. In that case, it's difficult 381 { /* We're not reading directly from a file. In that case, it's difficult
@@ -385,8 +397,9 @@ skip_dyn_eof (Lisp_Object readcharfun)
385 if (FROM_FILE_P (readcharfun)) 397 if (FROM_FILE_P (readcharfun))
386 { 398 {
387 block_input (); /* FIXME: Not sure if it's needed. */ 399 block_input (); /* FIXME: Not sure if it's needed. */
388 fseek (instream, 0, SEEK_END); 400 fseek (infile->stream, 0, SEEK_END);
389 unblock_input (); 401 unblock_input ();
402 infile->lookahead = 0;
390 } 403 }
391 else 404 else
392 while (READCHAR >= 0); 405 while (READCHAR >= 0);
@@ -459,15 +472,13 @@ readbyte_for_lambda (int c, Lisp_Object readcharfun)
459 472
460 473
461static int 474static int
462readbyte_from_file (int c, Lisp_Object readcharfun) 475readbyte_from_stdio (void)
463{ 476{
464 if (c >= 0) 477 if (infile->lookahead)
465 { 478 return infile->buf[--infile->lookahead];
466 block_input (); 479
467 ungetc (c, instream); 480 int c;
468 unblock_input (); 481 FILE *instream = infile->stream;
469 return 0;
470 }
471 482
472 block_input (); 483 block_input ();
473 484
@@ -487,6 +498,19 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
487} 498}
488 499
489static int 500static int
501readbyte_from_file (int c, Lisp_Object readcharfun)
502{
503 if (c >= 0)
504 {
505 eassert (infile->lookahead < sizeof infile->buf);
506 infile->buf[infile->lookahead++] = c;
507 return 0;
508 }
509
510 return readbyte_from_stdio ();
511}
512
513static int
490readbyte_from_string (int c, Lisp_Object readcharfun) 514readbyte_from_string (int c, Lisp_Object readcharfun)
491{ 515{
492 Lisp_Object string = XCAR (readcharfun); 516 Lisp_Object string = XCAR (readcharfun);
@@ -508,7 +532,7 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
508} 532}
509 533
510 534
511/* Read one non-ASCII character from INSTREAM. The character is 535/* Read one non-ASCII character from INFILE. The character is
512 encoded in `emacs-mule' and the first byte is already read in 536 encoded in `emacs-mule' and the first byte is already read in
513 C. */ 537 C. */
514 538
@@ -530,14 +554,13 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
530 buf[i++] = c; 554 buf[i++] = c;
531 while (i < len) 555 while (i < len)
532 { 556 {
533 c = (*readbyte) (-1, readcharfun); 557 buf[i++] = c = (*readbyte) (-1, readcharfun);
534 if (c < 0xA0) 558 if (c < 0xA0)
535 { 559 {
536 while (--i > 1) 560 for (i -= c < 0; 0 < --i; )
537 (*readbyte) (buf[i], readcharfun); 561 (*readbyte) (buf[i], readcharfun);
538 return BYTE8_TO_CHAR (buf[0]); 562 return BYTE8_TO_CHAR (buf[0]);
539 } 563 }
540 buf[i++] = c;
541 } 564 }
542 565
543 if (len == 2) 566 if (len == 2)
@@ -572,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
572} 595}
573 596
574 597
598/* An in-progress substitution of OBJECT for PLACEHOLDER. */
599struct subst
600{
601 Lisp_Object object;
602 Lisp_Object placeholder;
603
604 /* Hash table of subobjects of OBJECT that might be circular. If
605 Qt, all such objects might be circular. */
606 Lisp_Object completed;
607
608 /* List of subobjects of OBJECT that have already been visited. */
609 Lisp_Object seen;
610};
611
575static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, 612static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
576 Lisp_Object); 613 Lisp_Object);
577static Lisp_Object read0 (Lisp_Object); 614static Lisp_Object read0 (Lisp_Object);
@@ -580,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool);
580static Lisp_Object read_list (bool, Lisp_Object); 617static Lisp_Object read_list (bool, Lisp_Object);
581static Lisp_Object read_vector (Lisp_Object, bool); 618static Lisp_Object read_vector (Lisp_Object, bool);
582 619
583static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, 620static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
584 Lisp_Object); 621static void substitute_in_interval (INTERVAL, void *);
585static void substitute_in_interval (INTERVAL, Lisp_Object);
586 622
587 623
588/* Get a character from the tty. */ 624/* Get a character from the tty. */
@@ -779,11 +815,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
779 doc: /* Don't use this yourself. */) 815 doc: /* Don't use this yourself. */)
780 (void) 816 (void)
781{ 817{
782 register Lisp_Object val; 818 if (!infile)
783 block_input (); 819 error ("get-file-char misused");
784 XSETINT (val, getc_unlocked (instream)); 820 return make_number (readbyte_from_stdio ());
785 unblock_input ();
786 return val;
787} 821}
788 822
789 823
@@ -1028,6 +1062,15 @@ suffix_p (Lisp_Object string, const char *suffix)
1028 return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix); 1062 return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
1029} 1063}
1030 1064
1065static void
1066close_infile_unwind (void *arg)
1067{
1068 FILE *stream = arg;
1069 eassert (infile == NULL || infile->stream == stream);
1070 infile = NULL;
1071 fclose (stream);
1072}
1073
1031DEFUN ("load", Fload, Sload, 1, 5, 0, 1074DEFUN ("load", Fload, Sload, 1, 5, 0,
1032 doc: /* Execute a file of Lisp code named FILE. 1075 doc: /* Execute a file of Lisp code named FILE.
1033First try FILE with `.elc' appended, then try with `.el', then try 1076First try FILE with `.elc' appended, then try with `.el', then try
@@ -1347,7 +1390,7 @@ Return t if the file exists and loads successfully. */)
1347 } 1390 }
1348 if (! stream) 1391 if (! stream)
1349 report_file_error ("Opening stdio stream", file); 1392 report_file_error ("Opening stdio stream", file);
1350 set_unwind_protect_ptr (fd_index, fclose_unwind, stream); 1393 set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
1351 1394
1352 if (! NILP (Vpurify_flag)) 1395 if (! NILP (Vpurify_flag))
1353 Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); 1396 Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@@ -1370,19 +1413,23 @@ Return t if the file exists and loads successfully. */)
1370 specbind (Qinhibit_file_name_operation, Qnil); 1413 specbind (Qinhibit_file_name_operation, Qnil);
1371 specbind (Qload_in_progress, Qt); 1414 specbind (Qload_in_progress, Qt);
1372 1415
1373 instream = stream; 1416 struct infile input;
1417 input.stream = stream;
1418 input.lookahead = 0;
1419 infile = &input;
1420
1374 if (lisp_file_lexically_bound_p (Qget_file_char)) 1421 if (lisp_file_lexically_bound_p (Qget_file_char))
1375 Fset (Qlexical_binding, Qt); 1422 Fset (Qlexical_binding, Qt);
1376 1423
1377 if (! version || version >= 22) 1424 if (! version || version >= 22)
1378 readevalloop (Qget_file_char, stream, hist_file_name, 1425 readevalloop (Qget_file_char, &input, hist_file_name,
1379 0, Qnil, Qnil, Qnil, Qnil); 1426 0, Qnil, Qnil, Qnil, Qnil);
1380 else 1427 else
1381 { 1428 {
1382 /* We can't handle a file which was compiled with 1429 /* We can't handle a file which was compiled with
1383 byte-compile-dynamic by older version of Emacs. */ 1430 byte-compile-dynamic by older version of Emacs. */
1384 specbind (Qload_force_doc_strings, Qt); 1431 specbind (Qload_force_doc_strings, Qt);
1385 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, 1432 readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
1386 0, Qnil, Qnil, Qnil, Qnil); 1433 0, Qnil, Qnil, Qnil, Qnil);
1387 } 1434 }
1388 unbind_to (count, Qnil); 1435 unbind_to (count, Qnil);
@@ -1813,7 +1860,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
1813 1860
1814static void 1861static void
1815readevalloop (Lisp_Object readcharfun, 1862readevalloop (Lisp_Object readcharfun,
1816 FILE *stream, 1863 struct infile *infile0,
1817 Lisp_Object sourcename, 1864 Lisp_Object sourcename,
1818 bool printflag, 1865 bool printflag,
1819 Lisp_Object unibyte, Lisp_Object readfun, 1866 Lisp_Object unibyte, Lisp_Object readfun,
@@ -1913,7 +1960,7 @@ readevalloop (Lisp_Object readcharfun,
1913 if (b && first_sexp) 1960 if (b && first_sexp)
1914 whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b)); 1961 whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
1915 1962
1916 instream = stream; 1963 infile = infile0;
1917 read_next: 1964 read_next:
1918 c = READCHAR; 1965 c = READCHAR;
1919 if (c == ';') 1966 if (c == ';')
@@ -2003,7 +2050,7 @@ readevalloop (Lisp_Object readcharfun,
2003 } 2050 }
2004 2051
2005 build_load_history (sourcename, 2052 build_load_history (sourcename,
2006 stream || whole_buffer); 2053 infile0 || whole_buffer);
2007 2054
2008 unbind_to (count, Qnil); 2055 unbind_to (count, Qnil);
2009} 2056}
@@ -2629,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2629 bool uninterned_symbol = false; 2676 bool uninterned_symbol = false;
2630 bool multibyte; 2677 bool multibyte;
2631 char stackbuf[MAX_ALLOCA]; 2678 char stackbuf[MAX_ALLOCA];
2679 current_thread->stack_top = stackbuf;
2632 2680
2633 *pch = 0; 2681 *pch = 0;
2634 2682
@@ -2943,11 +2991,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2943 saved_doc_string_size = nskip + extra; 2991 saved_doc_string_size = nskip + extra;
2944 } 2992 }
2945 2993
2946 saved_doc_string_position = file_tell (instream); 2994 FILE *instream = infile->stream;
2995 saved_doc_string_position = (file_tell (instream)
2996 - infile->lookahead);
2947 2997
2948 /* Copy that many characters into saved_doc_string. */ 2998 /* Copy that many bytes into saved_doc_string. */
2999 i = 0;
3000 for (int n = min (nskip, infile->lookahead); 0 < n; n--)
3001 saved_doc_string[i++]
3002 = c = infile->buf[--infile->lookahead];
2949 block_input (); 3003 block_input ();
2950 for (i = 0; i < nskip && c >= 0; i++) 3004 for (; i < nskip && 0 <= c; i++)
2951 saved_doc_string[i] = c = getc_unlocked (instream); 3005 saved_doc_string[i] = c = getc_unlocked (instream);
2952 unblock_input (); 3006 unblock_input ();
2953 3007
@@ -3067,7 +3121,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
3067 } 3121 }
3068 else 3122 else
3069 { 3123 {
3070 Fsubstitute_object_in_subtree (tem, placeholder); 3124 Flread__substitute_object_in_subtree
3125 (tem, placeholder, read_objects_completed);
3071 3126
3072 /* ...and #n# will use the real value from now on. */ 3127 /* ...and #n# will use the real value from now on. */
3073 i = hash_lookup (h, number, &hash); 3128 i = hash_lookup (h, number, &hash);
@@ -3424,6 +3479,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
3424 if (! NILP (result)) 3479 if (! NILP (result))
3425 return unbind_to (count, result); 3480 return unbind_to (count, result);
3426 } 3481 }
3482 if (!quoted && multibyte)
3483 {
3484 int ch = STRING_CHAR ((unsigned char *) read_buffer);
3485 switch (ch)
3486 {
3487 case 0x2018: /* LEFT SINGLE QUOTATION MARK */
3488 case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
3489 case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
3490 case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
3491 case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
3492 case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
3493 case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
3494 case 0xFF02: /* FULLWIDTH QUOTATION MARK */
3495 case 0xFF07: /* FULLWIDTH APOSTROPHE */
3496 xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
3497 CALLN (Fstring, make_number (ch)));
3498 }
3499 }
3427 { 3500 {
3428 Lisp_Object result; 3501 Lisp_Object result;
3429 ptrdiff_t nbytes = p - read_buffer; 3502 ptrdiff_t nbytes = p - read_buffer;
@@ -3473,26 +3546,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
3473 } 3546 }
3474} 3547}
3475 3548
3476 3549DEFUN ("lread--substitute-object-in-subtree",
3477/* List of nodes we've seen during substitute_object_in_subtree. */ 3550 Flread__substitute_object_in_subtree,
3478static Lisp_Object seen_list; 3551 Slread__substitute_object_in_subtree, 3, 3, 0,
3479 3552 doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
3480DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, 3553COMPLETED is a hash table of objects that might be circular, or is t
3481 Ssubstitute_object_in_subtree, 2, 2, 0, 3554if any object might be circular. */)
3482 doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */) 3555 (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed)
3483 (Lisp_Object object, Lisp_Object placeholder)
3484{ 3556{
3485 Lisp_Object check_object; 3557 struct subst subst = { object, placeholder, completed, Qnil };
3486 3558 Lisp_Object check_object = substitute_object_recurse (&subst, object);
3487 /* We haven't seen any objects when we start. */
3488 seen_list = Qnil;
3489
3490 /* Make all the substitutions. */
3491 check_object
3492 = substitute_object_recurse (object, placeholder, object);
3493
3494 /* Clear seen_list because we're done with it. */
3495 seen_list = Qnil;
3496 3559
3497 /* The returned object here is expected to always eq the 3560 /* The returned object here is expected to always eq the
3498 original. */ 3561 original. */
@@ -3501,26 +3564,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
3501 return Qnil; 3564 return Qnil;
3502} 3565}
3503 3566
3504/* Feval doesn't get called from here, so no gc protection is needed. */
3505#define SUBSTITUTE(get_val, set_val) \
3506 do { \
3507 Lisp_Object old_value = get_val; \
3508 Lisp_Object true_value \
3509 = substitute_object_recurse (object, placeholder, \
3510 old_value); \
3511 \
3512 if (!EQ (old_value, true_value)) \
3513 { \
3514 set_val; \
3515 } \
3516 } while (0)
3517
3518static Lisp_Object 3567static Lisp_Object
3519substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) 3568substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
3520{ 3569{
3521 /* If we find the placeholder, return the target object. */ 3570 /* If we find the placeholder, return the target object. */
3522 if (EQ (placeholder, subtree)) 3571 if (EQ (subst->placeholder, subtree))
3523 return object; 3572 return subst->object;
3524 3573
3525 /* For common object types that can't contain other objects, don't 3574 /* For common object types that can't contain other objects, don't
3526 bother looking them up; we're done. */ 3575 bother looking them up; we're done. */
@@ -3530,15 +3579,16 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
3530 return subtree; 3579 return subtree;
3531 3580
3532 /* If we've been to this node before, don't explore it again. */ 3581 /* If we've been to this node before, don't explore it again. */
3533 if (!EQ (Qnil, Fmemq (subtree, seen_list))) 3582 if (!EQ (Qnil, Fmemq (subtree, subst->seen)))
3534 return subtree; 3583 return subtree;
3535 3584
3536 /* If this node can be the entry point to a cycle, remember that 3585 /* If this node can be the entry point to a cycle, remember that
3537 we've seen it. It can only be such an entry point if it was made 3586 we've seen it. It can only be such an entry point if it was made
3538 by #n=, which means that we can find it as a value in 3587 by #n=, which means that we can find it as a value in
3539 read_objects_completed. */ 3588 COMPLETED. */
3540 if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0) 3589 if (EQ (subst->completed, Qt)
3541 seen_list = Fcons (subtree, seen_list); 3590 || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
3591 subst->seen = Fcons (subtree, subst->seen);
3542 3592
3543 /* Recurse according to subtree's type. 3593 /* Recurse according to subtree's type.
3544 Every branch must return a Lisp_Object. */ 3594 Every branch must return a Lisp_Object. */
@@ -3565,19 +3615,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
3565 if (SUB_CHAR_TABLE_P (subtree)) 3615 if (SUB_CHAR_TABLE_P (subtree))
3566 i = 2; 3616 i = 2;
3567 for ( ; i < length; i++) 3617 for ( ; i < length; i++)
3568 SUBSTITUTE (AREF (subtree, i), 3618 ASET (subtree, i,
3569 ASET (subtree, i, true_value)); 3619 substitute_object_recurse (subst, AREF (subtree, i)));
3570 return subtree; 3620 return subtree;
3571 } 3621 }
3572 3622
3573 case Lisp_Cons: 3623 case Lisp_Cons:
3574 { 3624 XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)));
3575 SUBSTITUTE (XCAR (subtree), 3625 XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)));
3576 XSETCAR (subtree, true_value)); 3626 return subtree;
3577 SUBSTITUTE (XCDR (subtree),
3578 XSETCDR (subtree, true_value));
3579 return subtree;
3580 }
3581 3627
3582 case Lisp_String: 3628 case Lisp_String:
3583 { 3629 {
@@ -3585,11 +3631,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
3585 substitute_in_interval contains part of the logic. */ 3631 substitute_in_interval contains part of the logic. */
3586 3632
3587 INTERVAL root_interval = string_intervals (subtree); 3633 INTERVAL root_interval = string_intervals (subtree);
3588 AUTO_CONS (arg, object, placeholder);
3589
3590 traverse_intervals_noorder (root_interval, 3634 traverse_intervals_noorder (root_interval,
3591 &substitute_in_interval, arg); 3635 substitute_in_interval, subst);
3592
3593 return subtree; 3636 return subtree;
3594 } 3637 }
3595 3638
@@ -3601,12 +3644,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
3601 3644
3602/* Helper function for substitute_object_recurse. */ 3645/* Helper function for substitute_object_recurse. */
3603static void 3646static void
3604substitute_in_interval (INTERVAL interval, Lisp_Object arg) 3647substitute_in_interval (INTERVAL interval, void *arg)
3605{ 3648{
3606 Lisp_Object object = Fcar (arg); 3649 set_interval_plist (interval,
3607 Lisp_Object placeholder = Fcdr (arg); 3650 substitute_object_recurse (arg, interval->plist));
3608
3609 SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
3610} 3651}
3611 3652
3612 3653
@@ -4704,7 +4745,7 @@ syms_of_lread (void)
4704{ 4745{
4705 defsubr (&Sread); 4746 defsubr (&Sread);
4706 defsubr (&Sread_from_string); 4747 defsubr (&Sread_from_string);
4707 defsubr (&Ssubstitute_object_in_subtree); 4748 defsubr (&Slread__substitute_object_in_subtree);
4708 defsubr (&Sintern); 4749 defsubr (&Sintern);
4709 defsubr (&Sintern_soft); 4750 defsubr (&Sintern_soft);
4710 defsubr (&Sunintern); 4751 defsubr (&Sunintern);
@@ -5017,8 +5058,6 @@ that are loaded before your customizations are read! */);
5017 read_objects_map = Qnil; 5058 read_objects_map = Qnil;
5018 staticpro (&read_objects_completed); 5059 staticpro (&read_objects_completed);
5019 read_objects_completed = Qnil; 5060 read_objects_completed = Qnil;
5020 staticpro (&seen_list);
5021 seen_list = Qnil;
5022 5061
5023 Vloads_in_progress = Qnil; 5062 Vloads_in_progress = Qnil;
5024 staticpro (&Vloads_in_progress); 5063 staticpro (&Vloads_in_progress);
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
3080 return Qnil; 3080 return Qnil;
3081} 3081}
3082 3082
3083DEFUN ("ns-mouse-absolute-pixel-position",
3084 Fns_mouse_absolute_pixel_position,
3085 Sns_mouse_absolute_pixel_position, 0, 0, 0,
3086 doc: /* Return absolute position of mouse cursor in pixels.
3087The position is returned as a cons cell (X . Y) of the
3088coordinates of the mouse cursor position in pixels relative to a
3089position (0, 0) of the selected frame's terminal. */)
3090 (void)
3091{
3092 struct frame *f = SELECTED_FRAME ();
3093 EmacsView *view = FRAME_NS_VIEW (f);
3094 NSScreen *screen = [[view window] screen];
3095 NSPoint pt = [NSEvent mouseLocation];
3096
3097 return Fcons(make_number(pt.x - screen.frame.origin.x),
3098 make_number(screen.frame.size.height -
3099 (pt.y - screen.frame.origin.y)));
3100}
3101
3083/* ========================================================================== 3102/* ==========================================================================
3084 3103
3085 Class implementations 3104 Class implementations
@@ -3269,6 +3288,7 @@ be used as the image of the icon representing the frame. */);
3269 defsubr (&Sns_frame_list_z_order); 3288 defsubr (&Sns_frame_list_z_order);
3270 defsubr (&Sns_frame_restack); 3289 defsubr (&Sns_frame_restack);
3271 defsubr (&Sns_set_mouse_absolute_pixel_position); 3290 defsubr (&Sns_set_mouse_absolute_pixel_position);
3291 defsubr (&Sns_mouse_absolute_pixel_position);
3272 defsubr (&Sx_display_mm_width); 3292 defsubr (&Sx_display_mm_width);
3273 defsubr (&Sx_display_mm_height); 3293 defsubr (&Sx_display_mm_height);
3274 defsubr (&Sx_display_screens); 3294 defsubr (&Sx_display_screens);
diff --git a/src/nsterm.m b/src/nsterm.m
index bf83550b3d7..36d906a7cec 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1570,6 +1570,7 @@ x_make_frame_visible (struct frame *f)
1570 if (!FRAME_VISIBLE_P (f)) 1570 if (!FRAME_VISIBLE_P (f))
1571 { 1571 {
1572 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); 1572 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
1573 NSWindow *window = [view window];
1573 1574
1574 SET_FRAME_VISIBLE (f, 1); 1575 SET_FRAME_VISIBLE (f, 1);
1575 ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f)); 1576 ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1586,6 +1587,23 @@ x_make_frame_visible (struct frame *f)
1586 [view handleFS]; 1587 [view handleFS];
1587 unblock_input (); 1588 unblock_input ();
1588 } 1589 }
1590
1591 /* Making a frame invisible seems to break the parent->child
1592 relationship, so reinstate it. */
1593 if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL)
1594 {
1595 NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
1596
1597 block_input ();
1598 [parent addChildWindow: window
1599 ordered: NSWindowAbove];
1600 unblock_input ();
1601
1602 /* If the parent frame moved while the child frame was
1603 invisible, the child frame's position won't have been
1604 updated. Make sure it's in the right place now. */
1605 x_set_offset(f, f->left_pos, f->top_pos, 0);
1606 }
1589 } 1607 }
1590} 1608}
1591 1609
@@ -5479,6 +5497,19 @@ ns_term_shutdown (int sig)
5479 object:nil]; 5497 object:nil];
5480#endif 5498#endif
5481 5499
5500#ifdef NS_IMPL_COCOA
5501 if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) {
5502 /* Set the app's activation policy to regular when we run outside
5503 of a bundle. This is already done for us by Info.plist when we
5504 run inside a bundle. */
5505 [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular];
5506 [NSApp setApplicationIconImage:
5507 [EmacsImage
5508 allocInitFromFile:
5509 build_string("icons/hicolor/128x128/apps/emacs.png")]];
5510 }
5511#endif
5512
5482 ns_send_appdefined (-2); 5513 ns_send_appdefined (-2);
5483} 5514}
5484 5515
diff --git a/src/print.c b/src/print.c
index 50c75d7712c..12edf015892 100644
--- a/src/print.c
+++ b/src/print.c
@@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname)
566 566
567static void print (Lisp_Object, Lisp_Object, bool); 567static void print (Lisp_Object, Lisp_Object, bool);
568static void print_preprocess (Lisp_Object); 568static void print_preprocess (Lisp_Object);
569static void print_preprocess_string (INTERVAL, Lisp_Object); 569static void print_preprocess_string (INTERVAL, void *);
570static void print_object (Lisp_Object, Lisp_Object, bool); 570static void print_object (Lisp_Object, Lisp_Object, bool);
571 571
572DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, 572DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
@@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj)
1214 case Lisp_String: 1214 case Lisp_String:
1215 /* A string may have text properties, which can be circular. */ 1215 /* A string may have text properties, which can be circular. */
1216 traverse_intervals_noorder (string_intervals (obj), 1216 traverse_intervals_noorder (string_intervals (obj),
1217 print_preprocess_string, Qnil); 1217 print_preprocess_string, NULL);
1218 break; 1218 break;
1219 1219
1220 case Lisp_Cons: 1220 case Lisp_Cons:
@@ -1263,7 +1263,7 @@ Fills `print-number-table'. */)
1263} 1263}
1264 1264
1265static void 1265static void
1266print_preprocess_string (INTERVAL interval, Lisp_Object arg) 1266print_preprocess_string (INTERVAL interval, void *arg)
1267{ 1267{
1268 print_preprocess (interval->plist); 1268 print_preprocess (interval->plist);
1269} 1269}
@@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1748 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), 1748 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
1749 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 1749 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
1750 40))]; 1750 40))];
1751 1751 current_thread->stack_top = buf;
1752 maybe_quit (); 1752 maybe_quit ();
1753 1753
1754 /* Detect circularities and truncate them. */ 1754 /* Detect circularities and truncate them. */
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,
951 if (PROCESSP (name)) 951 if (PROCESSP (name))
952 return name; 952 return name;
953 CHECK_STRING (name); 953 CHECK_STRING (name);
954 return Fcdr (Fassoc (name, Vprocess_alist)); 954 return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
955} 955}
956 956
957/* This is how commands for the user decode process arguments. It 957/* This is how commands for the user decode process arguments. It
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)
1772 /* The known top and bottom of the stack. The actual stack may 1772 /* The known top and bottom of the stack. The actual stack may
1773 extend a bit beyond these boundaries. */ 1773 extend a bit beyond these boundaries. */
1774 char *bot = stack_bottom; 1774 char *bot = stack_bottom;
1775 char *top = near_C_stack_top (); 1775 char *top = current_thread->stack_top;
1776 1776
1777 /* Log base 2 of the stack heuristic ratio. This ratio is the size 1777 /* Log base 2 of the stack heuristic ratio. This ratio is the size
1778 of the known stack divided by the size of the guard area past the 1778 of the known stack divided by the size of the guard area past the
diff --git a/src/term.c b/src/term.c
index 3d7f4ada0b9..87a412666d0 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1585,10 +1585,16 @@ produce_glyphs (struct it *it)
1585 { 1585 {
1586 int absolute_x = (it->current_x 1586 int absolute_x = (it->current_x
1587 + it->continuation_lines_width); 1587 + it->continuation_lines_width);
1588 int x0 = absolute_x;
1589 /* Adjust for line numbers. */
1590 if (!NILP (Vdisplay_line_numbers))
1591 absolute_x -= it->lnum_pixel_width;
1588 int next_tab_x 1592 int next_tab_x
1589 = (((1 + absolute_x + it->tab_width - 1) 1593 = (((1 + absolute_x + it->tab_width - 1)
1590 / it->tab_width) 1594 / it->tab_width)
1591 * it->tab_width); 1595 * it->tab_width);
1596 if (!NILP (Vdisplay_line_numbers))
1597 next_tab_x += it->lnum_pixel_width;
1592 int nspaces; 1598 int nspaces;
1593 1599
1594 /* If part of the TAB has been displayed on the previous line 1600 /* If part of the TAB has been displayed on the previous line
@@ -1596,7 +1602,7 @@ produce_glyphs (struct it *it)
1596 been incremented already by the part that fitted on the 1602 been incremented already by the part that fitted on the
1597 continued line. So, we will get the right number of spaces 1603 continued line. So, we will get the right number of spaces
1598 here. */ 1604 here. */
1599 nspaces = next_tab_x - absolute_x; 1605 nspaces = next_tab_x - x0;
1600 1606
1601 if (it->glyph_row) 1607 if (it->glyph_row)
1602 { 1608 {
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,
595static void 595static void
596mark_one_thread (struct thread_state *thread) 596mark_one_thread (struct thread_state *thread)
597{ 597{
598 struct handler *handler; 598 /* Get the stack top now, in case mark_specpdl changes it. */
599 Lisp_Object tem; 599 void *stack_top = thread->stack_top;
600 600
601 mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr); 601 mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
602 602
603 mark_stack (thread->m_stack_bottom, thread->stack_top); 603 mark_stack (thread->m_stack_bottom, stack_top);
604 604
605 for (handler = thread->m_handlerlist; handler; handler = handler->next) 605 for (struct handler *handler = thread->m_handlerlist;
606 handler; handler = handler->next)
606 { 607 {
607 mark_object (handler->tag_or_ch); 608 mark_object (handler->tag_or_ch);
608 mark_object (handler->val); 609 mark_object (handler->val);
@@ -610,6 +611,7 @@ mark_one_thread (struct thread_state *thread)
610 611
611 if (thread->m_current_buffer) 612 if (thread->m_current_buffer)
612 { 613 {
614 Lisp_Object tem;
613 XSETBUFFER (tem, thread->m_current_buffer); 615 XSETBUFFER (tem, thread->m_current_buffer);
614 mark_object (tem); 616 mark_object (tem);
615 } 617 }
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
62 char *m_stack_bottom; 62 char *m_stack_bottom;
63#define stack_bottom (current_thread->m_stack_bottom) 63#define stack_bottom (current_thread->m_stack_bottom)
64 64
65 /* An address near the top of the stack. */ 65 /* The address of an object near the C stack top, used to determine
66 char *stack_top; 66 which words need to be scanned by the garbage collector. This is
67 also used to detect heuristically whether segmentation violation
68 address indicates stack overflow, as opposed to some internal
69 error in Emacs. If the C function F calls G which calls H which
70 calls ... F, then at least one of the functions in the chain
71 should set this to the address of a local variable. */
72 void *stack_top;
67 73
68 struct catchtag *m_catchlist; 74 struct catchtag *m_catchlist;
69#define catchlist (current_thread->m_catchlist) 75#define catchlist (current_thread->m_catchlist)
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. */)
467 block_input (); 467 block_input ();
468 468
469 /* replace existing entry in w32-color-map or add new entry. */ 469 /* replace existing entry in w32-color-map or add new entry. */
470 entry = Fassoc (name, Vw32_color_map); 470 entry = Fassoc (name, Vw32_color_map, Qnil);
471 if (NILP (entry)) 471 if (NILP (entry))
472 { 472 {
473 entry = Fcons (name, rgb); 473 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)
1627 Format of each entry is 1627 Format of each entry is
1628 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)). 1628 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
1629 */ 1629 */
1630 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist); 1630 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
1631 1631
1632 if (NILP (this_entry)) 1632 if (NILP (this_entry))
1633 { 1633 {
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'. */)
642 /* Remove the watch object from watch list. Do this before freeing 642 /* Remove the watch object from watch list. Do this before freeing
643 the object, do that even if we fail to free it, watch_list is 643 the object, do that even if we fail to free it, watch_list is
644 kept free of junk. */ 644 kept free of junk. */
645 watch_object = Fassoc (watch_descriptor, watch_list); 645 watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
646 if (!NILP (watch_object)) 646 if (!NILP (watch_object))
647 { 647 {
648 watch_list = Fdelete (watch_object, watch_list); 648 watch_list = Fdelete (watch_object, watch_list);
@@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the
679watch by calling `w32notify-rm-watch' also makes it invalid. */) 679watch by calling `w32notify-rm-watch' also makes it invalid. */)
680 (Lisp_Object watch_descriptor) 680 (Lisp_Object watch_descriptor)
681{ 681{
682 Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); 682 Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
683 683
684 if (!NILP (watch_object)) 684 if (!NILP (watch_object))
685 { 685 {
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,
1622 /* Look for Cygwin DLL in the DLL import list. */ 1622 /* Look for Cygwin DLL in the DLL import list. */
1623 IMAGE_DATA_DIRECTORY import_dir = 1623 IMAGE_DATA_DIRECTORY import_dir =
1624 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT]; 1624 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
1625 IMAGE_IMPORT_DESCRIPTOR * imports =
1626 RVA_TO_PTR (import_dir.VirtualAddress,
1627 rva_to_section (import_dir.VirtualAddress,
1628 nt_header),
1629 executable);
1630 1625
1631 for ( ; imports->Name; imports++) 1626 /* Import directory can be missing in .NET DLLs. */
1632 { 1627 if (import_dir.VirtualAddress != 0)
1633 IMAGE_SECTION_HEADER * section = 1628 {
1634 rva_to_section (imports->Name, nt_header); 1629 IMAGE_IMPORT_DESCRIPTOR * imports =
1635 char * dllname = RVA_TO_PTR (imports->Name, section, 1630 RVA_TO_PTR (import_dir.VirtualAddress,
1636 executable); 1631 rva_to_section (import_dir.VirtualAddress,
1637 1632 nt_header),
1638 /* The exact name of the Cygwin DLL has changed with 1633 executable);
1639 various releases, but hopefully this will be 1634
1640 reasonably future-proof. */ 1635 for ( ; imports->Name; imports++)
1641 if (strncmp (dllname, "cygwin", 6) == 0)
1642 {
1643 *is_cygnus_app = TRUE;
1644 break;
1645 }
1646 else if (strncmp (dllname, "msys-", 5) == 0)
1647 { 1636 {
1648 /* This catches both MSYS 1.x and MSYS2 1637 IMAGE_SECTION_HEADER * section =
1649 executables (the DLL name is msys-1.0.dll and 1638 rva_to_section (imports->Name, nt_header);
1650 msys-2.0.dll, respectively). There doesn't 1639 char * dllname = RVA_TO_PTR (imports->Name, section,
1651 seem to be a reason to distinguish between 1640 executable);
1652 the two, for now. */ 1641
1653 *is_msys_app = TRUE; 1642 /* The exact name of the Cygwin DLL has changed with
1654 break; 1643 various releases, but hopefully this will be
1644 reasonably future-proof. */
1645 if (strncmp (dllname, "cygwin", 6) == 0)
1646 {
1647 *is_cygnus_app = TRUE;
1648 break;
1649 }
1650 else if (strncmp (dllname, "msys-", 5) == 0)
1651 {
1652 /* This catches both MSYS 1.x and MSYS2
1653 executables (the DLL name is msys-1.0.dll and
1654 msys-2.0.dll, respectively). There doesn't
1655 seem to be a reason to distinguish between
1656 the two, for now. */
1657 *is_msys_app = TRUE;
1658 break;
1659 }
1655 } 1660 }
1656 } 1661 }
1657 } 1662 }
1658 } 1663 }
1659 } 1664 }
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)
6110 6110
6111 list = CDR(list); 6111 list = CDR(list);
6112 6112
6113 geometry = Fassoc (Qgeometry, attributes); 6113 geometry = Fassoc (Qgeometry, attributes, Qnil);
6114 if (!NILP (geometry)) 6114 if (!NILP (geometry))
6115 { 6115 {
6116 monitor_left = Fnth (make_number (1), geometry); 6116 monitor_left = Fnth (make_number (1), geometry);
diff --git a/src/xdisp.c b/src/xdisp.c
index 1c316fa4932..422912e57a6 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -290,6 +290,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
290#include <stdio.h> 290#include <stdio.h>
291#include <stdlib.h> 291#include <stdlib.h>
292#include <limits.h> 292#include <limits.h>
293#include <math.h>
293 294
294#include "lisp.h" 295#include "lisp.h"
295#include "atimer.h" 296#include "atimer.h"
@@ -324,7 +325,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
324#define FRAME_X_OUTPUT(f) ((f)->output_data.x) 325#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
325#endif 326#endif
326 327
327#define INFINITY 10000000 328#define DISP_INFINITY 10000000
328 329
329/* Holds the list (error). */ 330/* Holds the list (error). */
330static Lisp_Object list_of_error; 331static Lisp_Object list_of_error;
@@ -832,6 +833,8 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool);
832static bool update_menu_bar (struct frame *, bool, bool); 833static bool update_menu_bar (struct frame *, bool, bool);
833static bool try_window_reusing_current_matrix (struct window *); 834static bool try_window_reusing_current_matrix (struct window *);
834static int try_window_id (struct window *); 835static int try_window_id (struct window *);
836static void maybe_produce_line_number (struct it *);
837static bool should_produce_line_number (struct it *);
835static bool display_line (struct it *, int); 838static bool display_line (struct it *, int);
836static int display_mode_lines (struct window *); 839static int display_mode_lines (struct window *);
837static int display_mode_line (struct window *, enum face_id, Lisp_Object); 840static int display_mode_line (struct window *, enum face_id, Lisp_Object);
@@ -843,6 +846,8 @@ static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
843static void display_menu_bar (struct window *); 846static void display_menu_bar (struct window *);
844static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t, 847static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
845 ptrdiff_t *); 848 ptrdiff_t *);
849static void pint2str (register char *, register int, register ptrdiff_t);
850
846static int display_string (const char *, Lisp_Object, Lisp_Object, 851static int display_string (const char *, Lisp_Object, Lisp_Object,
847 ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int); 852 ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int);
848static void compute_line_metrics (struct it *); 853static void compute_line_metrics (struct it *);
@@ -1321,6 +1326,15 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
1321 if (charpos >= 0 && CHARPOS (top) > charpos) 1326 if (charpos >= 0 && CHARPOS (top) > charpos)
1322 return visible_p; 1327 return visible_p;
1323 1328
1329 /* Some Lisp hook could call us in the middle of redisplaying this
1330 very window. If, by some bad luck, we are retrying redisplay
1331 because we found that the mode-line height and/or header-line
1332 height needs to be updated, the assignment of mode_line_height
1333 and header_line_height below could disrupt that, due to the
1334 selected/nonselected window dance during mode-line display, and
1335 we could infloop. Avoid that. */
1336 int prev_mode_line_height = w->mode_line_height;
1337 int prev_header_line_height = w->header_line_height;
1324 /* Compute exact mode line heights. */ 1338 /* Compute exact mode line heights. */
1325 if (window_wants_mode_line (w)) 1339 if (window_wants_mode_line (w))
1326 { 1340 {
@@ -1667,6 +1681,10 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
1667 fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll); 1681 fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll);
1668#endif 1682#endif
1669 1683
1684 /* Restore potentially overwritten values. */
1685 w->mode_line_height = prev_mode_line_height;
1686 w->header_line_height = prev_header_line_height;
1687
1670 return visible_p; 1688 return visible_p;
1671} 1689}
1672 1690
@@ -6764,7 +6782,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
6764 FIELD_WIDTH < 0 means infinite field width. This is useful for 6782 FIELD_WIDTH < 0 means infinite field width. This is useful for
6765 padding with `-' at the end of a mode line. */ 6783 padding with `-' at the end of a mode line. */
6766 if (field_width < 0) 6784 if (field_width < 0)
6767 field_width = INFINITY; 6785 field_width = DISP_INFINITY;
6768 /* Implementation note: We deliberately don't enlarge 6786 /* Implementation note: We deliberately don't enlarge
6769 it->bidi_it.string.schars here to fit it->end_charpos, because 6787 it->bidi_it.string.schars here to fit it->end_charpos, because
6770 the bidi iterator cannot produce characters out of thin air. */ 6788 the bidi iterator cannot produce characters out of thin air. */
@@ -8613,6 +8631,7 @@ move_it_in_display_line_to (struct it *it,
8613 ptrdiff_t closest_pos UNINIT; 8631 ptrdiff_t closest_pos UNINIT;
8614 ptrdiff_t prev_pos = IT_CHARPOS (*it); 8632 ptrdiff_t prev_pos = IT_CHARPOS (*it);
8615 bool saw_smaller_pos = prev_pos < to_charpos; 8633 bool saw_smaller_pos = prev_pos < to_charpos;
8634 bool line_number_pending = false;
8616 8635
8617 /* Don't produce glyphs in produce_glyphs. */ 8636 /* Don't produce glyphs in produce_glyphs. */
8618 saved_glyph_row = it->glyph_row; 8637 saved_glyph_row = it->glyph_row;
@@ -8661,9 +8680,20 @@ move_it_in_display_line_to (struct it *it,
8661 || (it->method == GET_FROM_DISPLAY_VECTOR \ 8680 || (it->method == GET_FROM_DISPLAY_VECTOR \
8662 && it->dpvec + it->current.dpvec_index + 1 >= it->dpend))) 8681 && it->dpvec + it->current.dpvec_index + 1 >= it->dpend)))
8663 8682
8664 /* If there's a line-/wrap-prefix, handle it. */ 8683 if (it->hpos == 0)
8665 if (it->hpos == 0 && it->method == GET_FROM_BUFFER) 8684 {
8666 handle_line_prefix (it); 8685 /* If line numbers are being displayed, produce a line number. */
8686 if (should_produce_line_number (it))
8687 {
8688 if (it->current_x == it->first_visible_x)
8689 maybe_produce_line_number (it);
8690 else
8691 line_number_pending = true;
8692 }
8693 /* If there's a line-/wrap-prefix, handle it. */
8694 if (it->method == GET_FROM_BUFFER)
8695 handle_line_prefix (it);
8696 }
8667 8697
8668 if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) 8698 if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
8669 SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); 8699 SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it));
@@ -9030,6 +9060,15 @@ move_it_in_display_line_to (struct it *it,
9030 9060
9031 if (new_x > it->first_visible_x) 9061 if (new_x > it->first_visible_x)
9032 { 9062 {
9063 /* If we have reached the visible portion of the
9064 screen line, produce the line number if needed. */
9065 if (line_number_pending)
9066 {
9067 line_number_pending = false;
9068 it->current_x = it->first_visible_x;
9069 maybe_produce_line_number (it);
9070 it->current_x += new_x - it->first_visible_x;
9071 }
9033 /* Glyph is visible. Increment number of glyphs that 9072 /* Glyph is visible. Increment number of glyphs that
9034 would be displayed. */ 9073 would be displayed. */
9035 ++it->hpos; 9074 ++it->hpos;
@@ -13069,6 +13108,43 @@ hscroll_window_tree (Lisp_Object window)
13069 } 13108 }
13070 bool row_r2l_p = cursor_row->reversed_p; 13109 bool row_r2l_p = cursor_row->reversed_p;
13071 bool hscl = hscrolling_current_line_p (w); 13110 bool hscl = hscrolling_current_line_p (w);
13111 int x_offset = 0;
13112 /* When line numbers are displayed, we need to account for
13113 the horizontal space they consume. */
13114 if (!NILP (Vdisplay_line_numbers))
13115 {
13116 struct glyph *g;
13117 if (!row_r2l_p)
13118 {
13119 for (g = cursor_row->glyphs[TEXT_AREA];
13120 g < cursor_row->glyphs[TEXT_AREA]
13121 + cursor_row->used[TEXT_AREA];
13122 g++)
13123 {
13124 if (!(NILP (g->object) && g->charpos < 0))
13125 break;
13126 x_offset += g->pixel_width;
13127 }
13128 }
13129 else
13130 {
13131 for (g = cursor_row->glyphs[TEXT_AREA]
13132 + cursor_row->used[TEXT_AREA];
13133 g > cursor_row->glyphs[TEXT_AREA];
13134 g--)
13135 {
13136 if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0))
13137 break;
13138 x_offset += (g - 1)->pixel_width;
13139 }
13140 }
13141 }
13142 if (cursor_row->truncated_on_left_p)
13143 {
13144 /* On TTY frames, don't count the left truncation glyph. */
13145 struct frame *f = XFRAME (WINDOW_FRAME (w));
13146 x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f));
13147 }
13072 13148
13073 text_area_width = window_box_width (w, TEXT_AREA); 13149 text_area_width = window_box_width (w, TEXT_AREA);
13074 13150
@@ -13101,7 +13177,7 @@ hscroll_window_tree (Lisp_Object window)
13101 inside the left margin and the window is already 13177 inside the left margin and the window is already
13102 hscrolled. */ 13178 hscrolled. */
13103 && ((!row_r2l_p 13179 && ((!row_r2l_p
13104 && ((w->hscroll && w->cursor.x <= h_margin) 13180 && ((w->hscroll && w->cursor.x <= h_margin + x_offset)
13105 || (cursor_row->enabled_p 13181 || (cursor_row->enabled_p
13106 && cursor_row->truncated_on_right_p 13182 && cursor_row->truncated_on_right_p
13107 && (w->cursor.x >= text_area_width - h_margin)))) 13183 && (w->cursor.x >= text_area_width - h_margin))))
@@ -13119,7 +13195,8 @@ hscroll_window_tree (Lisp_Object window)
13119 && cursor_row->truncated_on_right_p 13195 && cursor_row->truncated_on_right_p
13120 && w->cursor.x <= h_margin) 13196 && w->cursor.x <= h_margin)
13121 || (w->hscroll 13197 || (w->hscroll
13122 && (w->cursor.x >= text_area_width - h_margin)))) 13198 && (w->cursor.x >= (text_area_width - h_margin
13199 - x_offset)))))
13123 /* This last condition is needed when moving 13200 /* This last condition is needed when moving
13124 vertically from an hscrolled line to a short line 13201 vertically from an hscrolled line to a short line
13125 that doesn't need to be hscrolled. If we omit 13202 that doesn't need to be hscrolled. If we omit
@@ -13150,7 +13227,7 @@ hscroll_window_tree (Lisp_Object window)
13150 if (hscl) 13227 if (hscl)
13151 it.first_visible_x = window_hscroll_limited (w, it.f) 13228 it.first_visible_x = window_hscroll_limited (w, it.f)
13152 * FRAME_COLUMN_WIDTH (it.f); 13229 * FRAME_COLUMN_WIDTH (it.f);
13153 it.last_visible_x = INFINITY; 13230 it.last_visible_x = DISP_INFINITY;
13154 move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS); 13231 move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS);
13155 /* If the line ends in an overlay string with a newline, 13232 /* If the line ends in an overlay string with a newline,
13156 we might infloop, because displaying the window will 13233 we might infloop, because displaying the window will
@@ -14796,15 +14873,12 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
14796 while (glyph > end + 1 14873 while (glyph > end + 1
14797 && NILP (glyph->object) 14874 && NILP (glyph->object)
14798 && glyph->charpos < 0) 14875 && glyph->charpos < 0)
14799 { 14876 --glyph;
14800 --glyph;
14801 x -= glyph->pixel_width;
14802 }
14803 if (NILP (glyph->object) && glyph->charpos < 0) 14877 if (NILP (glyph->object) && glyph->charpos < 0)
14804 --glyph; 14878 --glyph;
14805 /* By default, in reversed rows we put the cursor on the 14879 /* By default, in reversed rows we put the cursor on the
14806 rightmost (first in the reading order) glyph. */ 14880 rightmost (first in the reading order) glyph. */
14807 for (g = end + 1; g < glyph; g++) 14881 for (x = 0, g = end + 1; g < glyph; g++)
14808 x += g->pixel_width; 14882 x += g->pixel_width;
14809 while (end < glyph 14883 while (end < glyph
14810 && NILP ((end + 1)->object) 14884 && NILP ((end + 1)->object)
@@ -15835,7 +15909,7 @@ compute_window_start_on_continuation_line (struct window *w)
15835 So, we're looking for the display line start with the 15909 So, we're looking for the display line start with the
15836 minimum distance from the old window start. */ 15910 minimum distance from the old window start. */
15837 pos_before_pt = pos = it.current.pos; 15911 pos_before_pt = pos = it.current.pos;
15838 min_distance = INFINITY; 15912 min_distance = DISP_INFINITY;
15839 while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))), 15913 while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))),
15840 distance < min_distance) 15914 distance < min_distance)
15841 { 15915 {
@@ -15941,6 +16015,17 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
15941 && !windows_or_buffers_changed 16015 && !windows_or_buffers_changed
15942 && !f->cursor_type_changed 16016 && !f->cursor_type_changed
15943 && NILP (Vshow_trailing_whitespace) 16017 && NILP (Vshow_trailing_whitespace)
16018 /* When display-line-numbers is in relative mode, moving point
16019 requires to redraw the entire window. */
16020 && !EQ (Vdisplay_line_numbers, Qrelative)
16021 && !EQ (Vdisplay_line_numbers, Qvisual)
16022 /* When the current line number should be displayed in a
16023 distinct face, moving point cannot be handled in optimized
16024 way as below. */
16025 && !(!NILP (Vdisplay_line_numbers)
16026 && NILP (Finternal_lisp_face_equal_p (Qline_number,
16027 Qline_number_current_line,
16028 w->frame)))
15944 /* This code is not used for mini-buffer for the sake of the case 16029 /* This code is not used for mini-buffer for the sake of the case
15945 of redisplaying to replace an echo area message; since in 16030 of redisplaying to replace an echo area message; since in
15946 that case the mini-buffer contents per se are usually 16031 that case the mini-buffer contents per se are usually
@@ -16788,10 +16873,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16788 XBUFFER (w->contents)->text->redisplay = false; 16873 XBUFFER (w->contents)->text->redisplay = false;
16789 safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil)); 16874 safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil));
16790 16875
16791 if (w->redisplay || XBUFFER (w->contents)->text->redisplay) 16876 if (w->redisplay || XBUFFER (w->contents)->text->redisplay
16877 || ((EQ (Vdisplay_line_numbers, Qrelative)
16878 || EQ (Vdisplay_line_numbers, Qvisual))
16879 && row != MATRIX_FIRST_TEXT_ROW (w->desired_matrix)))
16792 { 16880 {
16793 /* pre-redisplay-function made changes (e.g. move the region) 16881 /* Either pre-redisplay-function made changes (e.g. move
16794 that require another round of redisplay. */ 16882 the region), or we moved point in a window that is
16883 under display-line-numbers = relative mode. We need
16884 another round of redisplay. */
16795 clear_glyph_matrix (w->desired_matrix); 16885 clear_glyph_matrix (w->desired_matrix);
16796 if (!try_window (window, startp, 0)) 16886 if (!try_window (window, startp, 0))
16797 goto need_larger_matrices; 16887 goto need_larger_matrices;
@@ -17592,15 +17682,21 @@ try_window_reusing_current_matrix (struct window *w)
17592 if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row)) 17682 if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row))
17593 return false; 17683 return false;
17594 17684
17685 /* Clear the desired matrix for the display below. */
17686 clear_glyph_matrix (w->desired_matrix);
17687
17688 /* Give up if line numbers are being displayed, because reusing the
17689 current matrix might use the wrong width for line-number
17690 display. */
17691 if (!NILP (Vdisplay_line_numbers))
17692 return false;
17693
17595 /* The variable new_start now holds the new window start. The old 17694 /* The variable new_start now holds the new window start. The old
17596 start `start' can be determined from the current matrix. */ 17695 start `start' can be determined from the current matrix. */
17597 SET_TEXT_POS_FROM_MARKER (new_start, w->start); 17696 SET_TEXT_POS_FROM_MARKER (new_start, w->start);
17598 start = start_row->minpos; 17697 start = start_row->minpos;
17599 start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix); 17698 start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix);
17600 17699
17601 /* Clear the desired matrix for the display below. */
17602 clear_glyph_matrix (w->desired_matrix);
17603
17604 if (CHARPOS (new_start) <= CHARPOS (start)) 17700 if (CHARPOS (new_start) <= CHARPOS (start))
17605 { 17701 {
17606 /* Don't use this method if the display starts with an ellipsis 17702 /* Don't use this method if the display starts with an ellipsis
@@ -18423,6 +18519,16 @@ try_window_id (struct window *w)
18423 if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing))) 18519 if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing)))
18424 GIVE_UP (23); 18520 GIVE_UP (23);
18425 18521
18522 /* Give up if display-line-numbers is in relative mode, or when the
18523 current line's number needs to be displayed in a distinct face. */
18524 if (EQ (Vdisplay_line_numbers, Qrelative)
18525 || EQ (Vdisplay_line_numbers, Qvisual)
18526 || (!NILP (Vdisplay_line_numbers)
18527 && NILP (Finternal_lisp_face_equal_p (Qline_number,
18528 Qline_number_current_line,
18529 w->frame))))
18530 GIVE_UP (24);
18531
18426 /* Make sure beg_unchanged and end_unchanged are up to date. Do it 18532 /* Make sure beg_unchanged and end_unchanged are up to date. Do it
18427 only if buffer has really changed. The reason is that the gap is 18533 only if buffer has really changed. The reason is that the gap is
18428 initially at Z for freshly visited files. The code below would 18534 initially at Z for freshly visited files. The code below would
@@ -19070,7 +19176,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19070 || glyph->type == GLYPHLESS_GLYPH) 19176 || glyph->type == GLYPHLESS_GLYPH)
19071 { 19177 {
19072 fprintf (stderr, 19178 fprintf (stderr,
19073 " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", 19179 " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
19074 glyph - row->glyphs[TEXT_AREA], 19180 glyph - row->glyphs[TEXT_AREA],
19075 (glyph->type == CHAR_GLYPH 19181 (glyph->type == CHAR_GLYPH
19076 ? 'C' 19182 ? 'C'
@@ -19095,7 +19201,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19095 else if (glyph->type == STRETCH_GLYPH) 19201 else if (glyph->type == STRETCH_GLYPH)
19096 { 19202 {
19097 fprintf (stderr, 19203 fprintf (stderr,
19098 " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", 19204 " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
19099 glyph - row->glyphs[TEXT_AREA], 19205 glyph - row->glyphs[TEXT_AREA],
19100 'S', 19206 'S',
19101 glyph->charpos, 19207 glyph->charpos,
@@ -19116,7 +19222,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19116 else if (glyph->type == IMAGE_GLYPH) 19222 else if (glyph->type == IMAGE_GLYPH)
19117 { 19223 {
19118 fprintf (stderr, 19224 fprintf (stderr,
19119 " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n", 19225 " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
19120 glyph - row->glyphs[TEXT_AREA], 19226 glyph - row->glyphs[TEXT_AREA],
19121 'I', 19227 'I',
19122 glyph->charpos, 19228 glyph->charpos,
@@ -19137,7 +19243,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
19137 else if (glyph->type == COMPOSITE_GLYPH) 19243 else if (glyph->type == COMPOSITE_GLYPH)
19138 { 19244 {
19139 fprintf (stderr, 19245 fprintf (stderr,
19140 " %5"pD"d %c %9"pI"d %c %3d 0x%06x", 19246 " %5"pD"d %c %9"pD"d %c %3d 0x%06x",
19141 glyph - row->glyphs[TEXT_AREA], 19247 glyph - row->glyphs[TEXT_AREA],
19142 '+', 19248 '+',
19143 glyph->charpos, 19249 glyph->charpos,
@@ -19198,7 +19304,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
19198 fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n"); 19304 fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n");
19199 fprintf (stderr, "==============================================================================\n"); 19305 fprintf (stderr, "==============================================================================\n");
19200 19306
19201 fprintf (stderr, "%3d %9"pI"d %9"pI"d %4d %1.1d%1.1d%1.1d%1.1d\ 19307 fprintf (stderr, "%3d %9"pD"d %9"pD"d %4d %1.1d%1.1d%1.1d%1.1d\
19202%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n", 19308%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n",
19203 vpos, 19309 vpos,
19204 MATRIX_ROW_START_CHARPOS (row), 19310 MATRIX_ROW_START_CHARPOS (row),
@@ -19227,7 +19333,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
19227 fprintf (stderr, " %9"pD"d %9"pD"d\t%5d\n", row->start.overlay_string_index, 19333 fprintf (stderr, " %9"pD"d %9"pD"d\t%5d\n", row->start.overlay_string_index,
19228 row->end.overlay_string_index, 19334 row->end.overlay_string_index,
19229 row->continuation_lines_width); 19335 row->continuation_lines_width);
19230 fprintf (stderr, " %9"pI"d %9"pI"d\n", 19336 fprintf (stderr, " %9"pD"d %9"pD"d\n",
19231 CHARPOS (row->start.string_pos), 19337 CHARPOS (row->start.string_pos),
19232 CHARPOS (row->end.string_pos)); 19338 CHARPOS (row->end.string_pos));
19233 fprintf (stderr, " %9d %9d\n", row->start.dpvec_index, 19339 fprintf (stderr, " %9d %9d\n", row->start.dpvec_index,
@@ -19304,7 +19410,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */)
19304 struct window *w = XWINDOW (selected_window); 19410 struct window *w = XWINDOW (selected_window);
19305 struct buffer *buffer = XBUFFER (w->contents); 19411 struct buffer *buffer = XBUFFER (w->contents);
19306 19412
19307 fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n", 19413 fprintf (stderr, "PT = %"pD"d, BEGV = %"pD"d. ZV = %"pD"d\n",
19308 BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer)); 19414 BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer));
19309 fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n", 19415 fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n",
19310 w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos); 19416 w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
@@ -20669,6 +20775,366 @@ find_row_edges (struct it *it, struct glyph_row *row,
20669 row->maxpos = it->current.pos; 20775 row->maxpos = it->current.pos;
20670} 20776}
20671 20777
20778/* Like display_count_lines, but capable of counting outside of the
20779 current narrowed region. */
20780static ptrdiff_t
20781display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte,
20782 ptrdiff_t count, ptrdiff_t *byte_pos_ptr)
20783{
20784 if (!display_line_numbers_widen || (BEGV == BEG && ZV == Z))
20785 return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
20786
20787 ptrdiff_t val;
20788 ptrdiff_t pdl_count = SPECPDL_INDEX ();
20789 record_unwind_protect (save_restriction_restore, save_restriction_save ());
20790 Fwiden ();
20791 val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
20792 unbind_to (pdl_count, Qnil);
20793 return val;
20794}
20795
20796/* Count the number of screen lines in window IT->w between character
20797 position IT_CHARPOS(*IT) and the line showing that window's point. */
20798static ptrdiff_t
20799display_count_lines_visually (struct it *it)
20800{
20801 struct it tem_it;
20802 ptrdiff_t to;
20803 struct text_pos from;
20804
20805 /* If we already calculated a relative line number, use that. This
20806 trick relies on the fact that visual lines (a.k.a. "glyph rows")
20807 are laid out sequentially, one by one, for each sequence of calls
20808 to display_line or other similar function that follows a call to
20809 init_iterator. */
20810 if (it->lnum_bytepos > 0)
20811 return it->lnum + 1;
20812 else
20813 {
20814 ptrdiff_t count = SPECPDL_INDEX ();
20815
20816 if (IT_CHARPOS (*it) <= PT)
20817 {
20818 from = it->current.pos;
20819 to = PT;
20820 }
20821 else
20822 {
20823 SET_TEXT_POS (from, PT, PT_BYTE);
20824 to = IT_CHARPOS (*it);
20825 }
20826 start_display (&tem_it, it->w, from);
20827 /* Need to disable visual mode temporarily, since otherwise the
20828 call to move_it_to will cause infinite recursion. */
20829 specbind (Qdisplay_line_numbers, Qrelative);
20830 /* Some redisplay optimizations could invoke us very far from
20831 PT, which will make the caller painfully slow. There should
20832 be no need to go too far beyond the window's bottom, as any
20833 such optimization will fail to show point anyway. */
20834 move_it_to (&tem_it, to, -1,
20835 tem_it.last_visible_y
20836 + (SCROLL_LIMIT + 10) * FRAME_LINE_HEIGHT (tem_it.f),
20837 -1, MOVE_TO_POS | MOVE_TO_Y);
20838 unbind_to (count, Qnil);
20839 return IT_CHARPOS (*it) <= PT ? -tem_it.vpos : tem_it.vpos;
20840 }
20841}
20842
20843/* Produce the line-number glyphs for the current glyph_row. If
20844 IT->glyph_row is non-NULL, populate the row with the produced
20845 glyphs. */
20846static void
20847maybe_produce_line_number (struct it *it)
20848{
20849 ptrdiff_t last_line = it->lnum;
20850 ptrdiff_t start_from, bytepos;
20851 ptrdiff_t this_line;
20852 bool first_time = false;
20853 ptrdiff_t beg_byte = display_line_numbers_widen ? BEG_BYTE : BEGV_BYTE;
20854 ptrdiff_t z_byte = display_line_numbers_widen ? Z_BYTE : ZV_BYTE;
20855 void *itdata = bidi_shelve_cache ();
20856
20857 if (EQ (Vdisplay_line_numbers, Qvisual))
20858 this_line = display_count_lines_visually (it);
20859 else
20860 {
20861 if (!last_line)
20862 {
20863 /* If possible, reuse data cached by line-number-mode. */
20864 if (it->w->base_line_number > 0
20865 && it->w->base_line_pos > 0
20866 && it->w->base_line_pos <= IT_CHARPOS (*it)
20867 /* line-number-mode always displays narrowed line
20868 numbers, so we cannot use its data if the user wants
20869 line numbers that disregard narrowing. */
20870 && !(display_line_numbers_widen
20871 && (BEG_BYTE != BEGV_BYTE || Z_BYTE != ZV_BYTE)))
20872 {
20873 start_from = CHAR_TO_BYTE (it->w->base_line_pos);
20874 last_line = it->w->base_line_number - 1;
20875 }
20876 else
20877 start_from = beg_byte;
20878 if (!it->lnum_bytepos)
20879 first_time = true;
20880 }
20881 else
20882 start_from = it->lnum_bytepos;
20883
20884 /* Paranoia: what if someone changes the narrowing since the
20885 last time display_line was called? Shouldn't really happen,
20886 but who knows what some crazy Lisp invoked by :eval could do? */
20887 if (!(beg_byte <= start_from && start_from <= z_byte))
20888 {
20889 last_line = 0;
20890 start_from = beg_byte;
20891 }
20892
20893 this_line =
20894 last_line + display_count_lines_logically (start_from,
20895 IT_BYTEPOS (*it),
20896 IT_CHARPOS (*it), &bytepos);
20897 eassert (this_line > 0 || (this_line == 0 && start_from == beg_byte));
20898 eassert (bytepos == IT_BYTEPOS (*it));
20899 }
20900
20901 /* Record the line number information. */
20902 if (this_line != last_line || !it->lnum_bytepos)
20903 {
20904 it->lnum = this_line;
20905 it->lnum_bytepos = IT_BYTEPOS (*it);
20906 }
20907
20908 /* Produce the glyphs for the line number. */
20909 struct it tem_it;
20910 char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1];
20911 bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false;
20912 ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */
20913 int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID);
20914 int current_lnum_face_id
20915 = merge_faces (it->f, Qline_number_current_line, 0, DEFAULT_FACE_ID);
20916 /* Compute point's line number if needed. */
20917 if ((EQ (Vdisplay_line_numbers, Qrelative)
20918 || EQ (Vdisplay_line_numbers, Qvisual)
20919 || lnum_face_id != current_lnum_face_id)
20920 && !it->pt_lnum)
20921 {
20922 ptrdiff_t ignored;
20923 if (PT_BYTE > it->lnum_bytepos && !EQ (Vdisplay_line_numbers, Qvisual))
20924 it->pt_lnum =
20925 this_line + display_count_lines_logically (it->lnum_bytepos, PT_BYTE,
20926 PT, &ignored);
20927 else
20928 it->pt_lnum = display_count_lines_logically (beg_byte, PT_BYTE, PT,
20929 &ignored);
20930 }
20931 /* Compute the required width if needed. */
20932 if (!it->lnum_width)
20933 {
20934 if (NATNUMP (Vdisplay_line_numbers_width))
20935 it->lnum_width = XFASTINT (Vdisplay_line_numbers_width);
20936
20937 /* Max line number to be displayed cannot be more than the one
20938 corresponding to the last row of the desired matrix. */
20939 ptrdiff_t max_lnum;
20940
20941 if (NILP (Vdisplay_line_numbers_current_absolute)
20942 && (EQ (Vdisplay_line_numbers, Qrelative)
20943 || EQ (Vdisplay_line_numbers, Qvisual)))
20944 /* We subtract one more because the current line is always
20945 zero in this mode. */
20946 max_lnum = it->w->desired_matrix->nrows - 2;
20947 else if (EQ (Vdisplay_line_numbers, Qvisual))
20948 max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1;
20949 else
20950 max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos;
20951 max_lnum = max (1, max_lnum);
20952 it->lnum_width = max (it->lnum_width, log10 (max_lnum) + 1);
20953 eassert (it->lnum_width > 0);
20954 }
20955 if (EQ (Vdisplay_line_numbers, Qrelative))
20956 lnum_offset = it->pt_lnum;
20957 else if (EQ (Vdisplay_line_numbers, Qvisual))
20958 lnum_offset = 0;
20959
20960 /* Under 'relative', display the absolute line number for the
20961 current line, unless the user requests otherwise. */
20962 ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset);
20963 if ((EQ (Vdisplay_line_numbers, Qrelative)
20964 || EQ (Vdisplay_line_numbers, Qvisual))
20965 && lnum_to_display == 0
20966 && !NILP (Vdisplay_line_numbers_current_absolute))
20967 lnum_to_display = it->pt_lnum + 1;
20968 /* In L2R rows we need to append the blank separator, in R2L
20969 rows we need to prepend it. But this function is usually
20970 called when no display elements were produced from the
20971 following line, so the paragraph direction might be unknown.
20972 Therefore we cheat and add 2 blanks, one on either side. */
20973 pint2str (lnum_buf, it->lnum_width + 1, lnum_to_display);
20974 strcat (lnum_buf, " ");
20975
20976 /* Setup for producing the glyphs. */
20977 init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row,
20978 /* FIXME: Use specialized face. */
20979 DEFAULT_FACE_ID);
20980 scratch_glyph_row.reversed_p = false;
20981 scratch_glyph_row.used[TEXT_AREA] = 0;
20982 SET_TEXT_POS (tem_it.position, 0, 0);
20983 tem_it.avoid_cursor_p = true;
20984 tem_it.bidi_p = true;
20985 tem_it.bidi_it.type = WEAK_EN;
20986 /* According to UAX#9, EN goes up 2 levels in L2R paragraph and
20987 1 level in R2L paragraphs. Emulate that, assuming we are in
20988 an L2R paragraph. */
20989 tem_it.bidi_it.resolved_level = 2;
20990
20991 /* Produce glyphs for the line number in a scratch glyph_row. */
20992 int n_glyphs_before;
20993 for (const char *p = lnum_buf; *p; p++)
20994 {
20995 /* For continuation lines and lines after ZV, instead of a line
20996 number, produce a blank prefix of the same width. Use the
20997 default face for the blank field beyond ZV. */
20998 if (beyond_zv)
20999 tem_it.face_id = it->base_face_id;
21000 else if (lnum_face_id != current_lnum_face_id
21001 && (EQ (Vdisplay_line_numbers, Qvisual)
21002 ? this_line == 0
21003 : this_line == it->pt_lnum))
21004 tem_it.face_id = current_lnum_face_id;
21005 else
21006 tem_it.face_id = lnum_face_id;
21007 if (beyond_zv
21008 /* Don't display the same line number more than once. */
21009 || (!EQ (Vdisplay_line_numbers, Qvisual)
21010 && (it->continuation_lines_width > 0
21011 || (this_line == last_line && !first_time))))
21012 tem_it.c = tem_it.char_to_display = ' ';
21013 else
21014 tem_it.c = tem_it.char_to_display = *p;
21015 tem_it.len = 1;
21016 n_glyphs_before = scratch_glyph_row.used[TEXT_AREA];
21017 /* Make sure these glyphs will have a "position" of -1. */
21018 SET_TEXT_POS (tem_it.position, -1, -1);
21019 PRODUCE_GLYPHS (&tem_it);
21020
21021 /* Stop producing glyphs if we don't have enough space on
21022 this line. FIXME: should we refrain from producing the
21023 line number at all in that case? */
21024 if (tem_it.current_x > tem_it.last_visible_x)
21025 {
21026 scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before;
21027 break;
21028 }
21029 }
21030
21031 /* Record the width in pixels we need for the line number display. */
21032 it->lnum_pixel_width = tem_it.current_x;
21033 /* Copy the produced glyphs into IT's glyph_row. */
21034 struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA];
21035 struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA];
21036 struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL;
21037 short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL;
21038
21039 eassert (it->glyph_row == NULL || it->glyph_row->used[TEXT_AREA] == 0);
21040
21041 for ( ; g < e; g++)
21042 {
21043 it->current_x += g->pixel_width;
21044 /* The following is important when this function is called
21045 from move_it_in_display_line_to: HPOS is incremented only
21046 when we are in the visible portion of the glyph row. */
21047 if (it->current_x > it->first_visible_x)
21048 it->hpos++;
21049 if (p)
21050 {
21051 *p++ = *g;
21052 (*u)++;
21053 }
21054 }
21055
21056 /* Update IT's metrics due to glyphs produced for line numbers. */
21057 if (it->glyph_row)
21058 {
21059 struct glyph_row *row = it->glyph_row;
21060
21061 it->max_ascent = max (row->ascent, tem_it.max_ascent);
21062 it->max_descent = max (row->height - row->ascent, tem_it.max_descent);
21063 it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent);
21064 it->max_phys_descent = max (row->phys_height - row->phys_ascent,
21065 tem_it.max_phys_descent);
21066 }
21067 else
21068 {
21069 it->max_ascent = max (it->max_ascent, tem_it.max_ascent);
21070 it->max_descent = max (it->max_descent, tem_it.max_descent);
21071 it->max_phys_ascent = max (it->max_phys_ascent, tem_it.max_phys_ascent);
21072 it->max_phys_descent = max (it->max_phys_descent, tem_it.max_phys_descent);
21073 }
21074
21075 bidi_unshelve_cache (itdata, false);
21076}
21077
21078/* Return true if this glyph row needs a line number to be produced
21079 for it. */
21080static bool
21081should_produce_line_number (struct it *it)
21082{
21083 if (NILP (Vdisplay_line_numbers))
21084 return false;
21085
21086 /* Don't display line numbers in minibuffer windows. */
21087 if (MINI_WINDOW_P (it->w))
21088 return false;
21089
21090#ifdef HAVE_WINDOW_SYSTEM
21091 /* Don't display line number in tooltip frames. */
21092 if (FRAMEP (tip_frame) && EQ (WINDOW_FRAME (it->w), tip_frame))
21093 return false;
21094#endif
21095
21096 /* If the character at current position has a non-nil special
21097 property, disable line numbers for this row. This is for
21098 packages such as company-mode, which need this for their tricky
21099 layout, where line numbers get in the way. */
21100 Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)),
21101 Qdisplay_line_numbers_disable,
21102 it->window);
21103 /* For ZV, we need to also look in empty overlays at that point,
21104 because get-char-property always returns nil for ZV, except if
21105 the property is in 'default-text-properties'. */
21106 if (NILP (val) && IT_CHARPOS (*it) >= ZV)
21107 val = disable_line_numbers_overlay_at_eob ();
21108 return NILP (val) ? true : false;
21109}
21110
21111/* Return true if ROW has no glyphs except those inserted by the
21112 display engine. This is needed for indicate-empty-lines and
21113 similar features when the glyph row starts with glyphs which didn't
21114 come from buffer or string. */
21115static bool
21116row_text_area_empty (struct glyph_row *row)
21117{
21118 if (!row->reversed_p)
21119 {
21120 for (struct glyph *g = row->glyphs[TEXT_AREA];
21121 g < row->glyphs[TEXT_AREA] + row->used[TEXT_AREA];
21122 g++)
21123 if (!NILP (g->object) || g->charpos > 0)
21124 return false;
21125 }
21126 else
21127 {
21128 for (struct glyph *g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1;
21129 g > row->glyphs[TEXT_AREA];
21130 g--)
21131 if (!NILP ((g - 1)->object) || (g - 1)->charpos > 0)
21132 return false;
21133 }
21134
21135 return true;
21136}
21137
20672/* Construct the glyph row IT->glyph_row in the desired matrix of 21138/* Construct the glyph row IT->glyph_row in the desired matrix of
20673 IT->w from text at the current position of IT. See dispextern.h 21139 IT->w from text at the current position of IT. See dispextern.h
20674 for an overview of struct it. Value is true if 21140 for an overview of struct it. Value is true if
@@ -20739,6 +21205,8 @@ display_line (struct it *it, int cursor_vpos)
20739 (window_hscroll_limited (it->w, it->f) - it->w->min_hscroll) 21205 (window_hscroll_limited (it->w, it->f) - it->w->min_hscroll)
20740 * FRAME_COLUMN_WIDTH (it->f); 21206 * FRAME_COLUMN_WIDTH (it->f);
20741 21207
21208 bool line_number_needed = should_produce_line_number (it);
21209
20742 /* Move over display elements that are not visible because we are 21210 /* Move over display elements that are not visible because we are
20743 hscrolled. This may stop at an x-position < first_visible_x 21211 hscrolled. This may stop at an x-position < first_visible_x
20744 if the first glyph is partially visible or if we hit a line end. */ 21212 if the first glyph is partially visible or if we hit a line end. */
@@ -20774,9 +21242,17 @@ display_line (struct it *it, int cursor_vpos)
20774 are hscrolled to the left of the left edge of the window. */ 21242 are hscrolled to the left of the left edge of the window. */
20775 min_pos = CHARPOS (this_line_min_pos); 21243 min_pos = CHARPOS (this_line_min_pos);
20776 min_bpos = BYTEPOS (this_line_min_pos); 21244 min_bpos = BYTEPOS (this_line_min_pos);
21245
21246 /* Produce line number, if needed. */
21247 if (line_number_needed)
21248 maybe_produce_line_number (it);
20777 } 21249 }
20778 else if (it->area == TEXT_AREA) 21250 else if (it->area == TEXT_AREA)
20779 { 21251 {
21252 /* Line numbers should precede the line-prefix or wrap-prefix. */
21253 if (line_number_needed)
21254 maybe_produce_line_number (it);
21255
20780 /* We only do this when not calling move_it_in_display_line_to 21256 /* We only do this when not calling move_it_in_display_line_to
20781 above, because that function calls itself handle_line_prefix. */ 21257 above, because that function calls itself handle_line_prefix. */
20782 handle_line_prefix (it); 21258 handle_line_prefix (it);
@@ -20838,6 +21314,7 @@ display_line (struct it *it, int cursor_vpos)
20838 buffer reached. */ 21314 buffer reached. */
20839 if (!get_next_display_element (it)) 21315 if (!get_next_display_element (it))
20840 { 21316 {
21317 bool row_has_glyphs = false;
20841 /* Maybe add a space at the end of this line that is used to 21318 /* Maybe add a space at the end of this line that is used to
20842 display the cursor there under X. Set the charpos of the 21319 display the cursor there under X. Set the charpos of the
20843 first glyph of blank lines not corresponding to any text 21320 first glyph of blank lines not corresponding to any text
@@ -20846,14 +21323,17 @@ display_line (struct it *it, int cursor_vpos)
20846 row->exact_window_width_line_p = true; 21323 row->exact_window_width_line_p = true;
20847 else if ((append_space_for_newline (it, true) 21324 else if ((append_space_for_newline (it, true)
20848 && row->used[TEXT_AREA] == 1) 21325 && row->used[TEXT_AREA] == 1)
20849 || row->used[TEXT_AREA] == 0) 21326 || row->used[TEXT_AREA] == 0
21327 || (row_has_glyphs = row_text_area_empty (row)))
20850 { 21328 {
20851 row->glyphs[TEXT_AREA]->charpos = -1; 21329 row->glyphs[TEXT_AREA]->charpos = -1;
20852 row->displays_text_p = false; 21330 /* Don't reset the displays_text_p flag if we are
21331 displaying line numbers or line-prefix. */
21332 if (!row_has_glyphs)
21333 row->displays_text_p = false;
20853 21334
20854 if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines)) 21335 if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines))
20855 && (!MINI_WINDOW_P (it->w) 21336 && (!MINI_WINDOW_P (it->w)))
20856 || (minibuf_level && EQ (it->window, minibuf_window))))
20857 row->indicate_empty_line_p = true; 21337 row->indicate_empty_line_p = true;
20858 } 21338 }
20859 21339
@@ -20935,6 +21415,10 @@ display_line (struct it *it, int cursor_vpos)
20935 process the prefix now. */ 21415 process the prefix now. */
20936 if (it->area == TEXT_AREA && pending_handle_line_prefix) 21416 if (it->area == TEXT_AREA && pending_handle_line_prefix)
20937 { 21417 {
21418 /* Line numbers should precede the line-prefix or wrap-prefix. */
21419 if (line_number_needed)
21420 maybe_produce_line_number (it);
21421
20938 pending_handle_line_prefix = false; 21422 pending_handle_line_prefix = false;
20939 handle_line_prefix (it); 21423 handle_line_prefix (it);
20940 } 21424 }
@@ -22006,7 +22490,7 @@ Value is the new character position of point. */)
22006 reach point, in order to start from its X coordinate. So we 22490 reach point, in order to start from its X coordinate. So we
22007 need to disregard the window's horizontal extent in that case. */ 22491 need to disregard the window's horizontal extent in that case. */
22008 if (it.line_wrap == TRUNCATE) 22492 if (it.line_wrap == TRUNCATE)
22009 it.last_visible_x = INFINITY; 22493 it.last_visible_x = DISP_INFINITY;
22010 22494
22011 if (it.cmp_it.id < 0 22495 if (it.cmp_it.id < 0
22012 && it.method == GET_FROM_STRING 22496 && it.method == GET_FROM_STRING
@@ -22099,7 +22583,7 @@ Value is the new character position of point. */)
22099 { 22583 {
22100 start_display (&it, w, pt); 22584 start_display (&it, w, pt);
22101 if (it.line_wrap == TRUNCATE) 22585 if (it.line_wrap == TRUNCATE)
22102 it.last_visible_x = INFINITY; 22586 it.last_visible_x = DISP_INFINITY;
22103 reseat_at_previous_visible_line_start (&it); 22587 reseat_at_previous_visible_line_start (&it);
22104 it.current_x = it.current_y = it.hpos = 0; 22588 it.current_x = it.current_y = it.hpos = 0;
22105 if (pt_vpos != 0) 22589 if (pt_vpos != 0)
@@ -22859,7 +23343,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
22859 props = oprops; 23343 props = oprops;
22860 } 23344 }
22861 23345
22862 aelt = Fassoc (elt, mode_line_proptrans_alist); 23346 aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil);
22863 if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt)))) 23347 if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
22864 { 23348 {
22865 /* AELT is what we want. Move it to the front 23349 /* AELT is what we want. Move it to the front
@@ -27616,6 +28100,10 @@ x_produce_glyphs (struct it *it)
27616 { 28100 {
27617 int tab_width = it->tab_width * font->space_width; 28101 int tab_width = it->tab_width * font->space_width;
27618 int x = it->current_x + it->continuation_lines_width; 28102 int x = it->current_x + it->continuation_lines_width;
28103 int x0 = x;
28104 /* Adjust for line numbers, if needed. */
28105 if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
28106 x -= it->lnum_pixel_width;
27619 int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width; 28107 int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
27620 28108
27621 /* If the distance from the current position to the next tab 28109 /* If the distance from the current position to the next tab
@@ -27623,8 +28111,12 @@ x_produce_glyphs (struct it *it)
27623 tab stop after that. */ 28111 tab stop after that. */
27624 if (next_tab_x - x < font->space_width) 28112 if (next_tab_x - x < font->space_width)
27625 next_tab_x += tab_width; 28113 next_tab_x += tab_width;
28114 if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
28115 next_tab_x += (it->lnum_pixel_width
28116 - ((it->w->hscroll * font->space_width)
28117 % tab_width));
27626 28118
27627 it->pixel_width = next_tab_x - x; 28119 it->pixel_width = next_tab_x - x0;
27628 it->nglyphs = 1; 28120 it->nglyphs = 1;
27629 if (FONT_TOO_HIGH (font)) 28121 if (FONT_TOO_HIGH (font))
27630 { 28122 {
@@ -28325,7 +28817,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg)
28325 28817
28326 /* By default, set up the blink-off state depending on the on-state. */ 28818 /* By default, set up the blink-off state depending on the on-state. */
28327 28819
28328 tem = Fassoc (arg, Vblink_cursor_alist); 28820 tem = Fassoc (arg, Vblink_cursor_alist, Qnil);
28329 if (!NILP (tem)) 28821 if (!NILP (tem))
28330 { 28822 {
28331 FRAME_BLINK_OFF_CURSOR (f) 28823 FRAME_BLINK_OFF_CURSOR (f)
@@ -28463,7 +28955,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
28463 /* Cursor is blinked off, so determine how to "toggle" it. */ 28955 /* Cursor is blinked off, so determine how to "toggle" it. */
28464 28956
28465 /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ 28957 /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */
28466 if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) 28958 if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor)))
28467 return get_specified_cursor_type (XCDR (alt_cursor), width); 28959 return get_specified_cursor_type (XCDR (alt_cursor), width);
28468 28960
28469 /* Then see if frame has specified a specific blink off cursor type. */ 28961 /* Then see if frame has specified a specific blink off cursor type. */
@@ -31708,6 +32200,12 @@ They are still logged to the *Messages* buffer. */);
31708 /* Name of the face used to highlight trailing whitespace. */ 32200 /* Name of the face used to highlight trailing whitespace. */
31709 DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); 32201 DEFSYM (Qtrailing_whitespace, "trailing-whitespace");
31710 32202
32203 /* Names of the faces used to display line numbers. */
32204 DEFSYM (Qline_number, "line-number");
32205 DEFSYM (Qline_number_current_line, "line-number-current-line");
32206 /* Name of a text property which disables line-number display. */
32207 DEFSYM (Qdisplay_line_numbers_disable, "display-line-numbers-disable");
32208
31711 /* Name and number of the face used to highlight escape glyphs. */ 32209 /* Name and number of the face used to highlight escape glyphs. */
31712 DEFSYM (Qescape_glyph, "escape-glyph"); 32210 DEFSYM (Qescape_glyph, "escape-glyph");
31713 32211
@@ -32215,6 +32713,54 @@ To add a prefix to continuation lines, use `wrap-prefix'. */);
32215 DEFSYM (Qline_prefix, "line-prefix"); 32713 DEFSYM (Qline_prefix, "line-prefix");
32216 Fmake_variable_buffer_local (Qline_prefix); 32714 Fmake_variable_buffer_local (Qline_prefix);
32217 32715
32716 DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers,
32717 doc: /* Non-nil means display line numbers.
32718If the value is t, display the absolute number of each line of a buffer
32719shown in a window. Absolute line numbers count from the beginning of
32720the current narrowing, or from buffer beginning. If the value is
32721`relative', display for each line not containing the window's point its
32722relative number instead, i.e. the number of the line relative to the
32723line showing the window's point.
32724
32725In either case, line numbers are displayed at the beginning of each
32726non-continuation line that displays buffer text, i.e. after each newline
32727character that comes from the buffer. The value `visual' is like
32728`relative' but counts screen lines instead of buffer lines. In practice
32729this means that continuation lines count as well when calculating the
32730relative number of a line.
32731
32732Lisp programs can disable display of a line number of a particular
32733buffer line by putting the `display-line-numbers-disable' text property
32734or overlay property on the first visible character of that line. */);
32735 Vdisplay_line_numbers = Qnil;
32736 DEFSYM (Qdisplay_line_numbers, "display-line-numbers");
32737 Fmake_variable_buffer_local (Qdisplay_line_numbers);
32738 DEFSYM (Qrelative, "relative");
32739 DEFSYM (Qvisual, "visual");
32740
32741 DEFVAR_LISP ("display-line-numbers-width", Vdisplay_line_numbers_width,
32742 doc: /* Minimum width of space reserved for line number display.
32743A positive number means reserve that many columns for line numbers,
32744even if the actual number needs less space.
32745The default value of nil means compute the space dynamically.
32746Any other value is treated as nil. */);
32747 Vdisplay_line_numbers_width = Qnil;
32748 DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width");
32749 Fmake_variable_buffer_local (Qdisplay_line_numbers_width);
32750
32751 DEFVAR_LISP ("display-line-numbers-current-absolute",
32752 Vdisplay_line_numbers_current_absolute,
32753 doc: /* Non-nil means display absolute number of current line.
32754This variable has effect only when `display-line-numbers' is
32755either `relative' or `visual'. */);
32756 Vdisplay_line_numbers_current_absolute = Qt;
32757
32758 DEFVAR_BOOL ("display-line-numbers-widen", display_line_numbers_widen,
32759 doc: /* Non-nil means display line numbers disregarding any narrowing. */);
32760 display_line_numbers_widen = false;
32761 DEFSYM (Qdisplay_line_numbers_widen, "display-line-numbers-widen");
32762 Fmake_variable_buffer_local (Qdisplay_line_numbers_widen);
32763
32218 DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, 32764 DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay,
32219 doc: /* Non-nil means don't eval Lisp during redisplay. */); 32765 doc: /* Non-nil means don't eval Lisp during redisplay. */);
32220 inhibit_eval_during_redisplay = false; 32766 inhibit_eval_during_redisplay = false;
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)
2062 int unit = FRAME_COLUMN_WIDTH (f); 2062 int unit = FRAME_COLUMN_WIDTH (f);
2063#ifdef USE_TOOLKIT_SCROLL_BARS 2063#ifdef USE_TOOLKIT_SCROLL_BARS
2064#ifdef USE_GTK 2064#ifdef USE_GTK
2065 int minw = xg_get_default_scrollbar_width (); 2065 int minw = xg_get_default_scrollbar_width (f);
2066#else 2066#else
2067 int minw = 16; 2067 int minw = 16;
2068#endif 2068#endif
@@ -2083,7 +2083,7 @@ x_set_scroll_bar_default_height (struct frame *f)
2083 int height = FRAME_LINE_HEIGHT (f); 2083 int height = FRAME_LINE_HEIGHT (f);
2084#ifdef USE_TOOLKIT_SCROLL_BARS 2084#ifdef USE_TOOLKIT_SCROLL_BARS
2085#ifdef USE_GTK 2085#ifdef USE_GTK
2086 int min_height = xg_get_default_scrollbar_height (); 2086 int min_height = xg_get_default_scrollbar_height (f);
2087#else 2087#else
2088 int min_height = 16; 2088 int min_height = 16;
2089#endif 2089#endif
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)
505 Lisp_Object alter; 505 Lisp_Object alter;
506 506
507 if ((alter = Fassoc (SYMBOL_NAME (registry), 507 if ((alter = Fassoc (SYMBOL_NAME (registry),
508 Vface_alternative_font_registry_alist), 508 Vface_alternative_font_registry_alist,
509 Qnil),
509 CONSP (alter))) 510 CONSP (alter)))
510 { 511 {
511 /* Pointer to REGISTRY-ENCODING field. */ 512 /* Pointer to REGISTRY-ENCODING field. */
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,
1271 1271
1272 /* Child of win. */ 1272 /* Child of win. */
1273 &dummy_window); 1273 &dummy_window);
1274#ifdef HAVE_GTK3
1275 /* Use window scaling factor to adjust position for hidpi screens. */
1276 x /= xg_get_scale (f);
1277 y /= xg_get_scale (f);
1278#endif
1274 unblock_input (); 1279 unblock_input ();
1275 popup_x_y.x = x; 1280 popup_x_y.x = x;
1276 popup_x_y.y = y; 1281 popup_x_y.y = y;