diff options
| author | Michael R. Mauger | 2017-07-24 22:15:04 -0400 |
|---|---|---|
| committer | Michael R. Mauger | 2017-07-24 22:15:04 -0400 |
| commit | df1a71272e5cdd10b511e2ffd702ca50ddd8a773 (patch) | |
| tree | 9b9ac725394ee80891e2bff57b6407d0e491e71a /src | |
| parent | eb27fc4d49e8c914cd0e6a8a2d02159601542141 (diff) | |
| parent | 32daa3cb54523006c88717cbeac87964cd687a1b (diff) | |
| download | emacs-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.c | 6 | ||||
| -rw-r--r-- | src/bidi.c | 29 | ||||
| -rw-r--r-- | src/buffer.c | 88 | ||||
| -rw-r--r-- | src/buffer.h | 6 | ||||
| -rw-r--r-- | src/charset.c | 90 | ||||
| -rw-r--r-- | src/coding.c | 6 | ||||
| -rw-r--r-- | src/dbusbind.c | 6 | ||||
| -rw-r--r-- | src/dispextern.h | 22 | ||||
| -rw-r--r-- | src/emacs-module.c | 22 | ||||
| -rw-r--r-- | src/eval.c | 9 | ||||
| -rw-r--r-- | src/fns.c | 160 | ||||
| -rw-r--r-- | src/font.c | 2 | ||||
| -rw-r--r-- | src/fontset.c | 2 | ||||
| -rw-r--r-- | src/ftcrfont.c | 6 | ||||
| -rw-r--r-- | src/gfilenotify.c | 2 | ||||
| -rw-r--r-- | src/gnutls.c | 811 | ||||
| -rw-r--r-- | src/gnutls.h | 5 | ||||
| -rw-r--r-- | src/gtkutil.c | 63 | ||||
| -rw-r--r-- | src/gtkutil.h | 5 | ||||
| -rw-r--r-- | src/image.c | 99 | ||||
| -rw-r--r-- | src/indent.c | 70 | ||||
| -rw-r--r-- | src/intervals.c | 66 | ||||
| -rw-r--r-- | src/intervals.h | 3 | ||||
| -rw-r--r-- | src/keyboard.c | 2 | ||||
| -rw-r--r-- | src/keymap.c | 2 | ||||
| -rw-r--r-- | src/lisp.h | 7 | ||||
| -rw-r--r-- | src/lread.c | 239 | ||||
| -rw-r--r-- | src/nsfns.m | 20 | ||||
| -rw-r--r-- | src/nsterm.m | 31 | ||||
| -rw-r--r-- | src/print.c | 8 | ||||
| -rw-r--r-- | src/process.c | 2 | ||||
| -rw-r--r-- | src/sysdep.c | 2 | ||||
| -rw-r--r-- | src/term.c | 8 | ||||
| -rw-r--r-- | src/thread.c | 10 | ||||
| -rw-r--r-- | src/thread.h | 10 | ||||
| -rw-r--r-- | src/w32fns.c | 2 | ||||
| -rw-r--r-- | src/w32font.c | 2 | ||||
| -rw-r--r-- | src/w32notify.c | 4 | ||||
| -rw-r--r-- | src/w32proc.c | 63 | ||||
| -rw-r--r-- | src/w32term.c | 2 | ||||
| -rw-r--r-- | src/xdisp.c | 620 | ||||
| -rw-r--r-- | src/xfns.c | 4 | ||||
| -rw-r--r-- | src/xfont.c | 3 | ||||
| -rw-r--r-- | src/xmenu.c | 5 |
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 | ||
| 1555 | static void | 1555 | static void |
| 1556 | mark_interval (register INTERVAL i, Lisp_Object dummy) | 1556 | mark_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) | |||
| 1523 | static ptrdiff_t | 1529 | static ptrdiff_t |
| 1524 | bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) | 1530 | bidi_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 | } |
| 175 | static void | 175 | static void |
| 176 | bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val) | ||
| 177 | { | ||
| 178 | b->bidi_paragraph_start_re_ = val; | ||
| 179 | } | ||
| 180 | static void | ||
| 181 | bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val) | ||
| 182 | { | ||
| 183 | b->bidi_paragraph_separate_re_ = val; | ||
| 184 | } | ||
| 185 | static void | ||
| 176 | bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) | 186 | bset_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. */ | ||
| 3071 | Lisp_Object | ||
| 3072 | disable_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 | |||
| 5639 | The value of nil means to use empty lines as lines that start and | ||
| 5640 | separate paragraphs. | ||
| 5641 | |||
| 5642 | When Emacs displays bidirectional text, it by default computes | ||
| 5643 | the base paragraph direction separately for each paragraph. | ||
| 5644 | Setting this variable changes the places where paragraph base | ||
| 5645 | direction is recomputed. | ||
| 5646 | |||
| 5647 | The regexp is always matched after a newline, so it is best to | ||
| 5648 | anchor it by beginning it with a "^". | ||
| 5649 | |||
| 5650 | If you change the value of this variable, be sure to change | ||
| 5651 | the value of `bidi-paragraph-separate-re' accordingly. For | ||
| 5652 | example, to have a single newline behave as a paragraph separator, | ||
| 5653 | set both these variables to "^". | ||
| 5654 | |||
| 5655 | See 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 | |||
| 5661 | The value of nil means to use empty lines as paragraph separators. | ||
| 5662 | |||
| 5663 | When Emacs displays bidirectional text, it by default computes | ||
| 5664 | the base paragraph direction separately for each paragraph. | ||
| 5665 | Setting this variable changes the places where paragraph base | ||
| 5666 | direction is recomputed. | ||
| 5667 | |||
| 5668 | The regexp is always matched after a newline, so it is best to | ||
| 5669 | anchor it by beginning it with a "^". | ||
| 5670 | |||
| 5671 | If you change the value of this variable, be sure to change | ||
| 5672 | the value of `bidi-paragraph-start-re' accordingly. For | ||
| 5673 | example, to have a single newline behave as a paragraph separator, | ||
| 5674 | set both these variables to "^". | ||
| 5675 | |||
| 5676 | See 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 | ||
| 412 | static unsigned | 415 | static unsigned |
| 413 | read_hex (FILE *fp, bool *eof, bool *overflow) | 416 | read_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) | |||
| 817 | static void | 815 | static void |
| 818 | module_assert_thread (void) | 816 | module_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 | ||
| 825 | static void | 827 | static 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. */ | ||
| 217 | void * | ||
| 218 | near_C_stack_top (void) | ||
| 219 | { | ||
| 220 | return backtrace_args (backtrace_top ()); | ||
| 221 | } | ||
| 222 | |||
| 223 | void | 216 | void |
| 224 | init_eval_once (void) | 217 | init_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 | ||
| @@ -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 | ||
| 39 | static void sort_vector_copy (Lisp_Object, ptrdiff_t, | 44 | static 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 | ||
| 1420 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | 1425 | DEFUN ("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. |
| 1422 | The value is actually the first element of LIST whose car equals KEY. */) | 1427 | The value is actually the first element of LIST whose car equals KEY. |
| 1423 | (Lisp_Object key, Lisp_Object list) | 1428 | |
| 1429 | Equality 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. */ | 4748 | DEFUN ("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 | ||
| 4740 | static Lisp_Object | 4762 | /* Extract data from a string or a buffer. SPEC is a list of |
| 4741 | secure_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, | 4764 | specified with `secure-hash' and in Info node |
| 4743 | Lisp_Object binary) | 4765 | `(elisp)Format of GnuTLS Cryptography Inputs'. */ |
| 4766 | char * | ||
| 4767 | extract_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 | |||
| 4955 | static Lisp_Object | ||
| 4956 | secure_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 | |||
| 4979 | which part of OBJECT to compute the hash. If nil or omitted, uses the | 5059 | which part of OBJECT to compute the hash. If nil or omitted, uses the |
| 4980 | whole OBJECT. | 5060 | whole OBJECT. |
| 4981 | 5061 | ||
| 5062 | The full list of algorithms can be obtained with `secure-hash-algorithms'. | ||
| 5063 | |||
| 4982 | If BINARY is non-nil, returns a string in binary form. */) | 5064 | If 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. */ ) | |||
| 5026 | void | 5108 | void |
| 5027 | syms_of_fns (void) | 5109 | syms_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) | |||
| 1893 | static OTF * | 1893 | static OTF * |
| 1894 | otf_open (Lisp_Object file) | 1894 | otf_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 | |||
| 266 | invalid. */) | 266 | invalid. */) |
| 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, | |||
| 171 | DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); | 172 | DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); |
| 172 | DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); | 173 | DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); |
| 173 | 174 | ||
| 175 | # ifdef HAVE_GNUTLS3 | ||
| 176 | DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); | ||
| 177 | DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); | ||
| 178 | DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); | ||
| 179 | DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); | ||
| 180 | DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); | ||
| 181 | DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); | ||
| 182 | # ifdef HAVE_GNUTLS3_CIPHER | ||
| 183 | DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); | ||
| 184 | DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); | ||
| 185 | DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); | ||
| 186 | DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t)); | ||
| 187 | DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); | ||
| 188 | DEF_DLL_FN (int, gnutls_cipher_init, | ||
| 189 | (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, | ||
| 190 | const gnutls_datum_t *, const gnutls_datum_t *)); | ||
| 191 | DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); | ||
| 192 | DEF_DLL_FN (int, gnutls_cipher_encrypt2, | ||
| 193 | (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); | ||
| 194 | DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); | ||
| 195 | DEF_DLL_FN (int, gnutls_cipher_decrypt2, | ||
| 196 | (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); | ||
| 197 | # ifdef HAVE_GNUTLS3_AEAD | ||
| 198 | DEF_DLL_FN (int, gnutls_aead_cipher_init, | ||
| 199 | (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, | ||
| 200 | const gnutls_datum_t *)); | ||
| 201 | DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t)); | ||
| 202 | DEF_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 *)); | ||
| 205 | DEF_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 | ||
| 210 | DEF_DLL_FN (int, gnutls_hmac_init, | ||
| 211 | (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); | ||
| 212 | DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); | ||
| 213 | DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); | ||
| 214 | DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); | ||
| 215 | DEF_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)); | ||
| 221 | DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); | ||
| 222 | DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); | ||
| 223 | DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); | ||
| 224 | DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); | ||
| 225 | # endif /* HAVE_GNUTLS3_DIGEST */ | ||
| 226 | # endif /* HAVE_GNUTLS3 */ | ||
| 227 | |||
| 174 | 228 | ||
| 175 | static bool | 229 | static bool |
| 176 | init_gnutls_functions (void) | 230 | init_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. */ | ||
| 472 | int | ||
| 473 | w32_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 | ||
| 438 | static int | 580 | static int |
| 439 | emacs_gnutls_handshake (struct Lisp_Process *proc) | 581 | emacs_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 | ||
| 701 | static char const * | ||
| 702 | emacs_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. */ |
| 561 | static bool | 710 | static 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 | ||
| 790 | DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, | 936 | DEFUN ("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 | |||
| 1848 | DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, | ||
| 1849 | doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. | ||
| 1850 | The 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 | |||
| 1894 | static Lisp_Object | ||
| 1895 | gnutls_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 | |||
| 1978 | static Lisp_Object | ||
| 1979 | gnutls_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 | |||
| 2121 | DEFUN ("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 | |||
| 2125 | Return nil on error. | ||
| 2126 | |||
| 2127 | The KEY can be specified as a buffer or string or in other ways (see | ||
| 2128 | Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY | ||
| 2129 | will be wiped after use if it's a string. | ||
| 2130 | |||
| 2131 | The IV and INPUT and the optional AEAD_AUTH can be specified as a | ||
| 2132 | buffer or string or in other ways (see Info node `(elisp)Format of | ||
| 2133 | GnuTLS Cryptography Inputs'). | ||
| 2134 | |||
| 2135 | The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. | ||
| 2136 | The CIPHER may be a string or symbol matching a key in that alist, or | ||
| 2137 | a plist with the :cipher-id numeric property, or the number itself. | ||
| 2138 | |||
| 2139 | AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with | ||
| 2140 | :cipher-aead-capable set to t. AEAD_AUTH can be supplied for | ||
| 2141 | these 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 | |||
| 2148 | DEFUN ("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 | |||
| 2152 | Return nil on error. | ||
| 2153 | |||
| 2154 | The KEY can be specified as a buffer or string or in other ways (see | ||
| 2155 | Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY | ||
| 2156 | will be wiped after use if it's a string. | ||
| 2157 | |||
| 2158 | The IV and INPUT and the optional AEAD_AUTH can be specified as a | ||
| 2159 | buffer or string or in other ways (see Info node `(elisp)Format of | ||
| 2160 | GnuTLS Cryptography Inputs'). | ||
| 2161 | |||
| 2162 | The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. | ||
| 2163 | The CIPHER may be a string or symbol matching a key in that alist, or | ||
| 2164 | a plist with the `:cipher-id' numeric property, or the number itself. | ||
| 2165 | |||
| 2166 | AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with | ||
| 2167 | :cipher-aead-capable set to t. AEAD_AUTH can be supplied for | ||
| 2168 | these 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 | |||
| 2175 | DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, | ||
| 2176 | doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists. | ||
| 2177 | |||
| 2178 | Use the value of the alist (extract it with `alist-get' for instance) | ||
| 2179 | with `gnutls-hash-mac'. The alist key is the mac-algorithm method | ||
| 2180 | name. */) | ||
| 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 | |||
| 2212 | DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, | ||
| 2213 | doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists. | ||
| 2214 | |||
| 2215 | Use the value of the alist (extract it with `alist-get' for instance) | ||
| 2216 | with `gnutls-hash-digest'. The alist key is the digest-algorithm | ||
| 2217 | method 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 | |||
| 2244 | DEFUN ("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 | |||
| 2247 | Return nil on error. | ||
| 2248 | |||
| 2249 | The KEY can be specified as a buffer or string or in other ways (see | ||
| 2250 | Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY | ||
| 2251 | will be wiped after use if it's a string. | ||
| 2252 | |||
| 2253 | The INPUT can be specified as a buffer or string or in other | ||
| 2254 | ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). | ||
| 2255 | |||
| 2256 | The alist of MAC algorithms can be obtained with `gnutls-macs`. The | ||
| 2257 | HASH-METHOD may be a string or symbol matching a key in that alist, or | ||
| 2258 | a plist with the `:mac-algorithm-id' numeric property, or the number | ||
| 2259 | itself. */) | ||
| 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 | |||
| 2334 | DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, | ||
| 2335 | doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. | ||
| 2336 | |||
| 2337 | Return nil on error. | ||
| 2338 | |||
| 2339 | The INPUT can be specified as a buffer or string or in other | ||
| 2340 | ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). | ||
| 2341 | |||
| 2342 | The alist of digest algorithms can be obtained with `gnutls-digests`. | ||
| 2343 | The DIGEST-METHOD may be a string or symbol matching a key in that | ||
| 2344 | alist, or a plist with the `:digest-algorithm-id' numeric property, or | ||
| 2345 | the 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 | |||
| 1700 | DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, | 2409 | DEFUN ("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... | ||
| 2413 | GnuTLS 3 or higher : the list will contain `gnutls3'. | ||
| 2414 | GnuTLS MACs : the list will contain `macs'. | ||
| 2415 | GnuTLS digests : the list will contain `digests'. | ||
| 2416 | GnuTLS symmetric ciphers: the list will contain `ciphers'. | ||
| 2417 | GnuTLS 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 | ||
| 1724 | void | 2466 | void |
| @@ -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. |
| 1785 | Set this larger than 0 to get debug output in the *Messages* buffer. | 2558 | Set this larger than 0 to get debug output in the *Messages* buffer. |
diff --git a/src/gnutls.h b/src/gnutls.h index 3c84023cd4e..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); | |||
| 82 | extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state); | 86 | extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state); |
| 83 | #ifdef WINDOWSNT | 87 | #ifdef WINDOWSNT |
| 84 | extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); | 88 | extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); |
| 89 | extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t); | ||
| 85 | #endif | 90 | #endif |
| 86 | extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); | 91 | extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); |
| 87 | extern Lisp_Object emacs_gnutls_global_init (void); | 92 | extern 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. */ | ||
| 208 | static int | ||
| 209 | xg_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 | |||
| 223 | int | ||
| 224 | xg_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 | ||
| 839 | static int | ||
| 840 | xg_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 | ||
| 3661 | int | 3668 | int |
| 3662 | xg_get_default_scrollbar_width (void) | 3669 | xg_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 | ||
| 3667 | int | 3674 | int |
| 3668 | xg_get_default_scrollbar_height (void) | 3675 | xg_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); |
| 145 | extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); | 145 | extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); |
| 146 | extern int xg_get_default_scrollbar_width (void); | 146 | extern int xg_get_default_scrollbar_width (struct frame *f); |
| 147 | extern int xg_get_default_scrollbar_height (void); | 147 | extern int xg_get_default_scrollbar_height (struct frame *f); |
| 148 | 148 | ||
| 149 | extern void update_frame_tool_bar (struct frame *f); | 149 | extern void update_frame_tool_bar (struct frame *f); |
| 150 | extern void free_frame_tool_bar (struct frame *f); | 150 | extern void free_frame_tool_bar (struct frame *f); |
| @@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f, | |||
| 156 | extern void xg_frame_set_char_size (struct frame *f, int width, int height); | 156 | extern void xg_frame_set_char_size (struct frame *f, int width, int height); |
| 157 | extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); | 157 | extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); |
| 158 | 158 | ||
| 159 | extern int xg_get_scale (struct frame *f); | ||
| 159 | extern void xg_display_open (char *display_name, Display **dpy); | 160 | extern void xg_display_open (char *display_name, Display **dpy); |
| 160 | extern void xg_display_close (Display *dpy); | 161 | extern void xg_display_close (Display *dpy); |
| 161 | extern GdkCursor * xg_create_default_cursor (Display *dpy); | 162 | extern 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. */ | ||
| 1951 | static void | ||
| 1952 | line_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 | |||
| 1986 | DEFUN ("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. | ||
| 1989 | If optional argument PIXELWISE is non-nil, return the width in pixels, | ||
| 1990 | otherwise return the width in columns of the face used to display | ||
| 1991 | line 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). */ |
| 1952 | static int | 2003 | static 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 | ||
| 226 | void | 226 | void |
| 227 | traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) | 227 | traverse_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 | |||
| 262 | static int icount; | ||
| 263 | static int idepth; | ||
| 264 | static int zero_length; | ||
| 265 | |||
| 266 | /* These functions are temporary, for debugging purposes only. */ | ||
| 267 | |||
| 268 | INTERVAL search_interval, found_interval; | ||
| 269 | |||
| 270 | void | ||
| 271 | check_for_interval (INTERVAL i) | ||
| 272 | { | ||
| 273 | if (i == search_interval) | ||
| 274 | { | ||
| 275 | found_interval = i; | ||
| 276 | icount++; | ||
| 277 | } | ||
| 278 | } | ||
| 279 | |||
| 280 | INTERVAL | ||
| 281 | search_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 | |||
| 290 | static void | ||
| 291 | inc_interval_count (INTERVAL i) | ||
| 292 | { | ||
| 293 | icount++; | ||
| 294 | if (LENGTH (i) == 0) | ||
| 295 | zero_length++; | ||
| 296 | if (depth > idepth) | ||
| 297 | idepth = depth; | ||
| 298 | } | ||
| 299 | |||
| 300 | int | ||
| 301 | count_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 | |||
| 311 | static INTERVAL | ||
| 312 | root_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); |
| 244 | extern void traverse_intervals_noorder (INTERVAL, | 244 | extern void traverse_intervals_noorder (INTERVAL, |
| 245 | void (*) (INTERVAL, Lisp_Object), | 245 | void (*) (INTERVAL, void *), void *); |
| 246 | Lisp_Object); | ||
| 247 | extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); | 246 | extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); |
| 248 | extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); | 247 | extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); |
| 249 | extern INTERVAL find_interval (INTERVAL, ptrdiff_t); | 248 | extern 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) | |||
| 838 | INLINE Lisp_Object | 838 | INLINE Lisp_Object |
| 839 | builtin_lisp_symbol (int index) | 839 | builtin_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 | ||
| 844 | INLINE void | 844 | INLINE 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 }; | |||
| 3386 | extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; | 3386 | extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; |
| 3387 | extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); | 3387 | extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); |
| 3388 | extern void sweep_weak_hash_tables (void); | 3388 | extern void sweep_weak_hash_tables (void); |
| 3389 | extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); | ||
| 3389 | EMACS_UINT hash_string (char const *, ptrdiff_t); | 3390 | EMACS_UINT hash_string (char const *, ptrdiff_t); |
| 3390 | EMACS_UINT sxhash (Lisp_Object, int); | 3391 | EMACS_UINT sxhash (Lisp_Object, int); |
| 3391 | Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, | 3392 | Lisp_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); |
| 3875 | extern void un_autoload (Lisp_Object); | 3876 | extern void un_autoload (Lisp_Object); |
| 3876 | extern Lisp_Object call_debugger (Lisp_Object arg); | 3877 | extern Lisp_Object call_debugger (Lisp_Object arg); |
| 3877 | extern void *near_C_stack_top (void); | ||
| 3878 | extern void init_eval_once (void); | 3878 | extern void init_eval_once (void); |
| 3879 | extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); | 3879 | extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); |
| 3880 | extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); | 3880 | extern 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. */ |
| 3967 | extern bool mouse_face_overlay_overlaps (Lisp_Object); | 3967 | extern bool mouse_face_overlay_overlaps (Lisp_Object); |
| 3968 | extern Lisp_Object disable_line_numbers_overlay_at_eob (void); | ||
| 3968 | extern _Noreturn void nsberror (Lisp_Object); | 3969 | extern _Noreturn void nsberror (Lisp_Object); |
| 3969 | extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t); | 3970 | extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t); |
| 3970 | extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); | 3971 | extern 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. */ |
| 104 | static Lisp_Object read_objects_completed; | 104 | static 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 |
| 107 | static FILE *instream; | 107 | to read from. Used by Fload. */ |
| 108 | static 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!!) */ |
| 110 | static ptrdiff_t read_from_string_index; | 122 | static ptrdiff_t read_from_string_index; |
| @@ -149,7 +161,7 @@ static Lisp_Object Vloads_in_progress; | |||
| 149 | static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), | 161 | static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), |
| 150 | Lisp_Object); | 162 | Lisp_Object); |
| 151 | 163 | ||
| 152 | static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, | 164 | static 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 | ||
| 461 | static int | 474 | static int |
| 462 | readbyte_from_file (int c, Lisp_Object readcharfun) | 475 | readbyte_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 | ||
| 489 | static int | 500 | static int |
| 501 | readbyte_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 | |||
| 513 | static int | ||
| 490 | readbyte_from_string (int c, Lisp_Object readcharfun) | 514 | readbyte_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. */ | ||
| 599 | struct 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 | |||
| 575 | static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, | 612 | static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, |
| 576 | Lisp_Object); | 613 | Lisp_Object); |
| 577 | static Lisp_Object read0 (Lisp_Object); | 614 | static Lisp_Object read0 (Lisp_Object); |
| @@ -580,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool); | |||
| 580 | static Lisp_Object read_list (bool, Lisp_Object); | 617 | static Lisp_Object read_list (bool, Lisp_Object); |
| 581 | static Lisp_Object read_vector (Lisp_Object, bool); | 618 | static Lisp_Object read_vector (Lisp_Object, bool); |
| 582 | 619 | ||
| 583 | static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, | 620 | static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); |
| 584 | Lisp_Object); | 621 | static void substitute_in_interval (INTERVAL, void *); |
| 585 | static 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 | ||
| 1065 | static void | ||
| 1066 | close_infile_unwind (void *arg) | ||
| 1067 | { | ||
| 1068 | FILE *stream = arg; | ||
| 1069 | eassert (infile == NULL || infile->stream == stream); | ||
| 1070 | infile = NULL; | ||
| 1071 | fclose (stream); | ||
| 1072 | } | ||
| 1073 | |||
| 1031 | DEFUN ("load", Fload, Sload, 1, 5, 0, | 1074 | DEFUN ("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. |
| 1033 | First try FILE with `.elc' appended, then try with `.el', then try | 1076 | First 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 | ||
| 1814 | static void | 1861 | static void |
| 1815 | readevalloop (Lisp_Object readcharfun, | 1862 | readevalloop (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 | 3549 | DEFUN ("lread--substitute-object-in-subtree", | |
| 3477 | /* List of nodes we've seen during substitute_object_in_subtree. */ | 3550 | Flread__substitute_object_in_subtree, |
| 3478 | static 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. | |
| 3480 | DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, | 3553 | COMPLETED is a hash table of objects that might be circular, or is t |
| 3481 | Ssubstitute_object_in_subtree, 2, 2, 0, | 3554 | if 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 | |||
| 3518 | static Lisp_Object | 3567 | static Lisp_Object |
| 3519 | substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) | 3568 | substitute_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. */ |
| 3603 | static void | 3646 | static void |
| 3604 | substitute_in_interval (INTERVAL interval, Lisp_Object arg) | 3647 | substitute_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 | ||
| 3083 | DEFUN ("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. | ||
| 3087 | The position is returned as a cons cell (X . Y) of the | ||
| 3088 | coordinates of the mouse cursor position in pixels relative to a | ||
| 3089 | position (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 | ||
| 567 | static void print (Lisp_Object, Lisp_Object, bool); | 567 | static void print (Lisp_Object, Lisp_Object, bool); |
| 568 | static void print_preprocess (Lisp_Object); | 568 | static void print_preprocess (Lisp_Object); |
| 569 | static void print_preprocess_string (INTERVAL, Lisp_Object); | 569 | static void print_preprocess_string (INTERVAL, void *); |
| 570 | static void print_object (Lisp_Object, Lisp_Object, bool); | 570 | static void print_object (Lisp_Object, Lisp_Object, bool); |
| 571 | 571 | ||
| 572 | DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, | 572 | DEFUN ("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 | ||
| 1265 | static void | 1265 | static void |
| 1266 | print_preprocess_string (INTERVAL interval, Lisp_Object arg) | 1266 | print_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, | |||
| 595 | static void | 595 | static void |
| 596 | mark_one_thread (struct thread_state *thread) | 596 | mark_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 | |||
| 679 | watch by calling `w32notify-rm-watch' also makes it invalid. */) | 679 | watch 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). */ |
| 330 | static Lisp_Object list_of_error; | 331 | static Lisp_Object list_of_error; |
| @@ -832,6 +833,8 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool); | |||
| 832 | static bool update_menu_bar (struct frame *, bool, bool); | 833 | static bool update_menu_bar (struct frame *, bool, bool); |
| 833 | static bool try_window_reusing_current_matrix (struct window *); | 834 | static bool try_window_reusing_current_matrix (struct window *); |
| 834 | static int try_window_id (struct window *); | 835 | static int try_window_id (struct window *); |
| 836 | static void maybe_produce_line_number (struct it *); | ||
| 837 | static bool should_produce_line_number (struct it *); | ||
| 835 | static bool display_line (struct it *, int); | 838 | static bool display_line (struct it *, int); |
| 836 | static int display_mode_lines (struct window *); | 839 | static int display_mode_lines (struct window *); |
| 837 | static int display_mode_line (struct window *, enum face_id, Lisp_Object); | 840 | static 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 *); | |||
| 843 | static void display_menu_bar (struct window *); | 846 | static void display_menu_bar (struct window *); |
| 844 | static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t, | 847 | static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t, |
| 845 | ptrdiff_t *); | 848 | ptrdiff_t *); |
| 849 | static void pint2str (register char *, register int, register ptrdiff_t); | ||
| 850 | |||
| 846 | static int display_string (const char *, Lisp_Object, Lisp_Object, | 851 | static 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); |
| 848 | static void compute_line_metrics (struct it *); | 853 | static 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. */ | ||
| 20780 | static ptrdiff_t | ||
| 20781 | display_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. */ | ||
| 20798 | static ptrdiff_t | ||
| 20799 | display_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. */ | ||
| 20846 | static void | ||
| 20847 | maybe_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. */ | ||
| 21080 | static bool | ||
| 21081 | should_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. */ | ||
| 21115 | static bool | ||
| 21116 | row_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. | ||
| 32718 | If the value is t, display the absolute number of each line of a buffer | ||
| 32719 | shown in a window. Absolute line numbers count from the beginning of | ||
| 32720 | the current narrowing, or from buffer beginning. If the value is | ||
| 32721 | `relative', display for each line not containing the window's point its | ||
| 32722 | relative number instead, i.e. the number of the line relative to the | ||
| 32723 | line showing the window's point. | ||
| 32724 | |||
| 32725 | In either case, line numbers are displayed at the beginning of each | ||
| 32726 | non-continuation line that displays buffer text, i.e. after each newline | ||
| 32727 | character that comes from the buffer. The value `visual' is like | ||
| 32728 | `relative' but counts screen lines instead of buffer lines. In practice | ||
| 32729 | this means that continuation lines count as well when calculating the | ||
| 32730 | relative number of a line. | ||
| 32731 | |||
| 32732 | Lisp programs can disable display of a line number of a particular | ||
| 32733 | buffer line by putting the `display-line-numbers-disable' text property | ||
| 32734 | or 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. | ||
| 32743 | A positive number means reserve that many columns for line numbers, | ||
| 32744 | even if the actual number needs less space. | ||
| 32745 | The default value of nil means compute the space dynamically. | ||
| 32746 | Any 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. | ||
| 32754 | This variable has effect only when `display-line-numbers' is | ||
| 32755 | either `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; |