summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c6
-rw-r--r--src/bidi.c29
-rw-r--r--src/buffer.c88
-rw-r--r--src/buffer.h6
-rw-r--r--src/charset.c90
-rw-r--r--src/coding.c6
-rw-r--r--src/dbusbind.c6
-rw-r--r--src/dispextern.h22
-rw-r--r--src/emacs-module.c22
-rw-r--r--src/eval.c9
-rw-r--r--src/fns.c160
-rw-r--r--src/font.c2
-rw-r--r--src/fontset.c2
-rw-r--r--src/ftcrfont.c6
-rw-r--r--src/gfilenotify.c2
-rw-r--r--src/gnutls.c811
-rw-r--r--src/gnutls.h5
-rw-r--r--src/gtkutil.c63
-rw-r--r--src/gtkutil.h5
-rw-r--r--src/image.c99
-rw-r--r--src/indent.c70
-rw-r--r--src/intervals.c66
-rw-r--r--src/intervals.h3
-rw-r--r--src/keyboard.c2
-rw-r--r--src/keymap.c2
-rw-r--r--src/lisp.h7
-rw-r--r--src/lread.c239
-rw-r--r--src/nsfns.m20
-rw-r--r--src/nsterm.m31
-rw-r--r--src/print.c8
-rw-r--r--src/process.c2
-rw-r--r--src/sysdep.c2
-rw-r--r--src/term.c8
-rw-r--r--src/thread.c10
-rw-r--r--src/thread.h10
-rw-r--r--src/w32fns.c2
-rw-r--r--src/w32font.c2
-rw-r--r--src/w32notify.c4
-rw-r--r--src/w32proc.c63
-rw-r--r--src/w32term.c2
-rw-r--r--src/xdisp.c620
-rw-r--r--src/xfns.c4
-rw-r--r--src/xfont.c3
-rw-r--r--src/xmenu.c5
44 files changed, 2145 insertions, 479 deletions
diff --git a/src/alloc.c b/src/alloc.c
index ac3de83b2b6..2cee6462564 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1553,7 +1553,7 @@ make_interval (void)
/* Mark Lisp objects in interval I. */
static void
-mark_interval (register INTERVAL i, Lisp_Object dummy)
+mark_interval (INTERVAL i, void *dummy)
{
/* Intervals should never be shared. So, if extra internal checking is
enabled, GC aborts if it seems to have visited an interval twice. */
@@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
#define MARK_INTERVAL_TREE(i) \
do { \
if (i && !i->gcmarkbit) \
- traverse_intervals_noorder (i, mark_interval, Qnil); \
+ traverse_intervals_noorder (i, mark_interval, NULL); \
} while (0)
/***********************************************************************
@@ -6943,7 +6943,7 @@ sweep_symbols (void)
symbol_free_list = NULL;
for (int i = 0; i < ARRAYELTS (lispsym); i++)
- lispsym[i].gcmarkbit = 0;
+ lispsym[i].s.gcmarkbit = 0;
for (sblk = symbol_block; sblk; sblk = *sprev)
{
diff --git a/src/bidi.c b/src/bidi.c
index e34da778ba0..763797488b0 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1448,8 +1448,14 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
Lisp_Object start_re;
ptrdiff_t val;
- sep_re = paragraph_separate_re;
- start_re = paragraph_start_re;
+ if (STRINGP (BVAR (current_buffer, bidi_paragraph_separate_re)))
+ sep_re = BVAR (current_buffer, bidi_paragraph_separate_re);
+ else
+ sep_re = paragraph_separate_re;
+ if (STRINGP (BVAR (current_buffer, bidi_paragraph_start_re)))
+ start_re = BVAR (current_buffer, bidi_paragraph_start_re);
+ else
+ start_re = paragraph_start_re;
val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil);
if (val < 0)
@@ -1523,7 +1529,10 @@ bidi_paragraph_cache_on_off (void)
static ptrdiff_t
bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
- Lisp_Object re = paragraph_start_re;
+ Lisp_Object re =
+ STRINGP (BVAR (current_buffer, bidi_paragraph_start_re))
+ ? BVAR (current_buffer, bidi_paragraph_start_re)
+ : paragraph_start_re;
ptrdiff_t limit = ZV, limit_byte = ZV_BYTE;
struct region_cache *bpc = bidi_paragraph_cache_on_off ();
ptrdiff_t n = 0, oldpos = pos, next;
@@ -3498,10 +3507,16 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
if (sep_len >= 0)
{
bidi_it->new_paragraph = 1;
- /* Record the buffer position of the last character of the
- paragraph separator. */
- bidi_it->separator_limit
- = bidi_it->charpos + bidi_it->nchars + sep_len;
+ /* Record the buffer position of the last character of
+ the paragraph separator. If the paragraph separator
+ is an empty string (e.g., the regex is "^"), the
+ newline that precedes the end of the paragraph is
+ that last character. */
+ if (sep_len > 0)
+ bidi_it->separator_limit
+ = bidi_it->charpos + bidi_it->nchars + sep_len;
+ else
+ bidi_it->separator_limit = bidi_it->charpos;
}
}
}
diff --git a/src/buffer.c b/src/buffer.c
index 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)
b->bidi_display_reordering_ = val;
}
static void
+bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val)
+{
+ b->bidi_paragraph_start_re_ = val;
+}
+static void
+bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val)
+{
+ b->bidi_paragraph_separate_re_ = val;
+}
+static void
bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
{
b->buffer_file_coding_system_ = val;
@@ -1164,7 +1174,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
{ /* Look in local_var_alist. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
- result = Fassoc (variable, BVAR (buf, local_var_alist));
+ result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
if (!NILP (result))
{
if (blv->fwd)
@@ -2322,6 +2332,8 @@ results, see Info node `(elisp)Swapping Text'. */)
swapfield_ (enable_multibyte_characters, Lisp_Object);
swapfield_ (bidi_display_reordering, Lisp_Object);
swapfield_ (bidi_paragraph_direction, Lisp_Object);
+ swapfield_ (bidi_paragraph_separate_re, Lisp_Object);
+ swapfield_ (bidi_paragraph_start_re, Lisp_Object);
/* FIXME: Not sure what we should do with these *_marker fields.
Hopefully they're just nil anyway. */
swapfield_ (pt_marker, Lisp_Object);
@@ -3054,6 +3066,33 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
return i < n;
}
+/* Return the value of the 'display-line-numbers-disable' property at
+ EOB, if there's an overlay at ZV with a non-nil value of that property. */
+Lisp_Object
+disable_line_numbers_overlay_at_eob (void)
+{
+ ptrdiff_t n, i, size;
+ Lisp_Object *v, tem = Qnil;
+ Lisp_Object vbuf[10];
+ USE_SAFE_ALLOCA;
+
+ size = ARRAYELTS (vbuf);
+ v = vbuf;
+ n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
+ if (n > size)
+ {
+ SAFE_NALLOCA (v, 1, n);
+ overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
+ }
+
+ for (i = 0; i < n; ++i)
+ if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
+ !NILP (tem)))
+ break;
+
+ SAFE_FREE ();
+ return tem;
+}
/* Fast function to just test if we're at an overlay boundary. */
@@ -5094,6 +5133,8 @@ init_buffer_once (void)
XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
+ XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx;
+ XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
/* Make this one a permanent local. */
buffer_permanent_local_flags[idx++] = 1;
@@ -5175,6 +5216,8 @@ init_buffer_once (void)
bset_ctl_arrow (&buffer_defaults, Qt);
bset_bidi_display_reordering (&buffer_defaults, Qt);
bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
+ bset_bidi_paragraph_start_re (&buffer_defaults, Qnil);
+ bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil);
bset_cursor_type (&buffer_defaults, Qt);
bset_extra_line_spacing (&buffer_defaults, Qnil);
bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
@@ -5589,6 +5632,49 @@ This variable is never applied to a way of decoding a file while reading it. */
&BVAR (current_buffer, bidi_display_reordering), Qnil,
doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
+ DEFVAR_PER_BUFFER ("bidi-paragraph-start-re",
+ &BVAR (current_buffer, bidi_paragraph_start_re), Qnil,
+ doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs.
+
+The value of nil means to use empty lines as lines that start and
+separate paragraphs.
+
+When Emacs displays bidirectional text, it by default computes
+the base paragraph direction separately for each paragraph.
+Setting this variable changes the places where paragraph base
+direction is recomputed.
+
+The regexp is always matched after a newline, so it is best to
+anchor it by beginning it with a "^".
+
+If you change the value of this variable, be sure to change
+the value of `bidi-paragraph-separate-re' accordingly. For
+example, to have a single newline behave as a paragraph separator,
+set both these variables to "^".
+
+See also `bidi-paragraph-direction'. */);
+
+ DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re",
+ &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil,
+ doc: /* If non-nil, a regexp matching a line that separates paragraphs.
+
+The value of nil means to use empty lines as paragraph separators.
+
+When Emacs displays bidirectional text, it by default computes
+the base paragraph direction separately for each paragraph.
+Setting this variable changes the places where paragraph base
+direction is recomputed.
+
+The regexp is always matched after a newline, so it is best to
+anchor it by beginning it with a "^".
+
+If you change the value of this variable, be sure to change
+the value of `bidi-paragraph-start-re' accordingly. For
+example, to have a single newline behave as a paragraph separator,
+set both these variables to "^".
+
+See also `bidi-paragraph-direction'. */);
+
DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
&BVAR (current_buffer, bidi_paragraph_direction), Qnil,
doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
diff --git a/src/buffer.h b/src/buffer.h
index be270fe4823..46ca6aa7384 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -611,6 +611,12 @@ struct buffer
direction dynamically for each paragraph. */
Lisp_Object bidi_paragraph_direction_;
+ /* If non-nil, a regular expression for bidi paragraph separator. */
+ Lisp_Object bidi_paragraph_separate_re_;
+
+ /* If non-nil, a regular expression for bidi paragraph start. */
+ Lisp_Object bidi_paragraph_start_re_;
+
/* Non-nil means do selective display;
see doc string in syms_of_buffer (buffer.c) for details. */
Lisp_Object selective_display_;
diff --git a/src/charset.c b/src/charset.c
index 9c3b8db2a53..6ce2f902c81 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -407,44 +407,49 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
/* Read a hexadecimal number (preceded by "0x") from the file FP while
- paying attention to comment character '#'. */
+ paying attention to comment character '#'. LOOKAHEAD is the
+ lookahead byte if it is nonnegative. Store into *TERMINATOR the
+ input byte after the number, or EOF if an end-of-file or input
+ error occurred. Set *OVERFLOW if the number overflows. */
static unsigned
-read_hex (FILE *fp, bool *eof, bool *overflow)
+read_hex (FILE *fp, int lookahead, int *terminator, bool *overflow)
{
- int c;
- unsigned n;
+ int c = lookahead < 0 ? getc_unlocked (fp) : lookahead;
- while ((c = getc_unlocked (fp)) != EOF)
+ while (true)
{
if (c == '#')
- {
- while ((c = getc_unlocked (fp)) != EOF && c != '\n');
- }
+ do
+ c = getc_unlocked (fp);
+ while (0 <= c && c != '\n');
else if (c == '0')
{
- if ((c = getc_unlocked (fp)) == EOF || c == 'x')
+ c = getc_unlocked (fp);
+ if (c < 0 || c == 'x')
break;
}
- }
- if (c == EOF)
- {
- *eof = 1;
- return 0;
- }
- n = 0;
- while (true)
- {
- c = getc_unlocked (fp);
- int digit = char_hexdigit (c);
- if (digit < 0)
+ if (c < 0)
break;
- if (INT_LEFT_SHIFT_OVERFLOW (n, 4))
- *overflow = 1;
- n = (n << 4) + digit;
+ c = getc_unlocked (fp);
}
- if (c != EOF)
- ungetc (c, fp);
+
+ unsigned n = 0;
+ bool v = false;
+
+ if (0 <= c)
+ while (true)
+ {
+ c = getc_unlocked (fp);
+ int digit = char_hexdigit (c);
+ if (digit < 0)
+ break;
+ v |= INT_LEFT_SHIFT_OVERFLOW (n, 4);
+ n = (n << 4) + digit;
+ }
+
+ *terminator = c;
+ *overflow |= v;
return n;
}
@@ -499,23 +504,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
- while (1)
+ int ch = -1;
+ while (true)
{
- unsigned from, to, c;
- int idx;
- bool eof = 0, overflow = 0;
-
- from = read_hex (fp, &eof, &overflow);
- if (eof)
+ bool overflow = false;
+ unsigned from = read_hex (fp, ch, &ch, &overflow), to;
+ if (ch < 0)
break;
- if (getc_unlocked (fp) == '-')
- to = read_hex (fp, &eof, &overflow);
+ if (ch == '-')
+ {
+ to = read_hex (fp, -1, &ch, &overflow);
+ if (ch < 0)
+ break;
+ }
else
- to = from;
- if (eof)
- break;
- c = read_hex (fp, &eof, &overflow);
- if (eof)
+ {
+ to = from;
+ ch = -1;
+ }
+ unsigned c = read_hex (fp, ch, &ch, &overflow);
+ if (ch < 0)
break;
if (overflow)
@@ -530,7 +538,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
}
- idx = n_entries;
+ int idx = n_entries;
entries->entry[idx].from = from;
entries->entry[idx].to = to;
entries->entry[idx].c = c;
diff --git a/src/coding.c b/src/coding.c
index 5682fc015ad..50ad206be69 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10539,7 +10539,7 @@ usage: (define-coding-system-internal ...) */)
ASET (this_spec, 2, this_eol_type);
Fputhash (this_name, this_spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist
= Fcons (Fcons (Fsymbol_name (this_name), Qnil),
@@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */)
Fputhash (name, spec_vec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (name, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
Vcoding_system_alist);
@@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
Fputhash (alias, spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (alias, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
Vcoding_system_alist);
diff --git a/src/dbusbind.c b/src/dbusbind.c
index d2460fd886e..0d9d3e514fd 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -955,7 +955,7 @@ xd_get_connection_address (Lisp_Object bus)
DBusConnection *connection;
Lisp_Object val;
- val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
+ val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil));
if (NILP (val))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
@@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus)
Lisp_Object busobj;
/* Check whether we are connected. */
- val = Fassoc (bus, xd_registered_buses);
+ val = Fassoc (bus, xd_registered_buses, Qnil);
if (NILP (val))
return;
@@ -1127,7 +1127,7 @@ this connection to those buses. */)
xd_close_bus (bus);
/* Check, whether we are still connected. */
- val = Fassoc (bus, xd_registered_buses);
+ val = Fassoc (bus, xd_registered_buses, Qnil);
if (!NILP (val))
{
connection = xd_get_connection_address (bus);
diff --git a/src/dispextern.h b/src/dispextern.h
index 8644ce26d13..1df769a8f99 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -384,6 +384,7 @@ struct glyph
glyph standing for newline at end of line 0
empty space after the end of the line -1
overlay arrow on a TTY -1
+ glyph displaying line number -1
glyph at EOB that ends in a newline -1
left truncation glyphs: -1
right truncation/continuation glyphs next buffer position
@@ -2537,7 +2538,12 @@ struct it
Do NOT use !BUFFERP (it.object) as a test whether we are
iterating over a string; use STRINGP (it.string) instead.
- Position is the current iterator position in object. */
+ Position is the current iterator position in object.
+
+ The 'position's CHARPOS is copied to glyph->charpos of the glyph
+ produced by PRODUCE_GLYPHS, so any artificial value documented
+ under 'struct glyph's 'charpos' member can also be found in the
+ 'position' member here. */
Lisp_Object object;
struct text_pos position;
@@ -2621,6 +2627,20 @@ struct it
coordinate is past first_visible_x. */
int hpos;
+ /* Current line number, zero-based. */
+ ptrdiff_t lnum;
+
+ /* The byte position corresponding to lnum. */
+ ptrdiff_t lnum_bytepos;
+
+ /* The width, in columns and in pixels, needed for display of the
+ line numbers, or zero if not computed. */
+ int lnum_width;
+ int lnum_pixel_width;
+
+ /* The line number of point's line, or zero if not computed yet. */
+ ptrdiff_t pt_lnum;
+
/* Left fringe bitmap number (enum fringe_bitmap_type). */
unsigned left_user_fringe_bitmap : FRINGE_ID_BITS;
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)
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object obj = value_to_lisp (ref);
- EMACS_UINT hashcode;
- ptrdiff_t i = hash_lookup (h, obj, &hashcode);
+ ptrdiff_t i = hash_lookup (h, obj, NULL);
if (i >= 0)
{
- Lisp_Object value = HASH_VALUE (h, i);
- EMACS_INT refcount = XFASTINT (value) - 1;
+ EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1;
if (refcount > 0)
+ set_hash_value_slot (h, i, make_natnum (refcount));
+ else
{
- value = make_natnum (refcount);
- set_hash_value_slot (h, i, value);
+ eassert (refcount == 0);
+ hash_remove_from_table (h, obj);
}
- else
- hash_remove_from_table (h, value);
}
if (module_assertions)
@@ -817,9 +815,13 @@ in_current_thread (void)
static void
module_assert_thread (void)
{
- if (! module_assertions || in_current_thread ())
+ if (!module_assertions)
return;
- module_abort ("Module function called from outside the current Lisp thread");
+ if (!in_current_thread ())
+ module_abort ("Module function called from outside "
+ "the current Lisp thread");
+ if (gc_in_progress)
+ module_abort ("Module function called during garbage collection");
}
static void
diff --git a/src/eval.c b/src/eval.c
index 8f293c9d300..e5900382dee 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -213,13 +213,6 @@ backtrace_next (union specbinding *pdl)
return pdl;
}
-/* Return a pointer to somewhere near the top of the C stack. */
-void *
-near_C_stack_top (void)
-{
- return backtrace_args (backtrace_top ());
-}
-
void
init_eval_once (void)
{
@@ -2090,7 +2083,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
specpdl_ptr->bt.debug_on_exit = false;
specpdl_ptr->bt.function = function;
- specpdl_ptr->bt.args = args;
+ current_thread->stack_top = specpdl_ptr->bt.args = args;
specpdl_ptr->bt.nargs = nargs;
grow_specpdl ();
diff --git a/src/fns.c b/src/fns.c
index 6610d2a6d0e..d849618f2b7 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -35,6 +35,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "window.h"
#include "puresize.h"
+#include "gnutls.h"
+
+#ifdef WINDOWSNT
+# define gnutls_rnd w32_gnutls_rnd
+#endif
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
Lisp_Object *restrict, Lisp_Object *restrict);
@@ -1417,17 +1422,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list)
return Qnil;
}
-DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
- doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
-The value is actually the first element of LIST whose car equals KEY. */)
- (Lisp_Object key, Lisp_Object list)
+DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
+ doc: /* Return non-nil if KEY is equal to the car of an element of LIST.
+The value is actually the first element of LIST whose car equals KEY.
+
+Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
+ (Lisp_Object key, Lisp_Object list, Lisp_Object testfn)
{
Lisp_Object tail = list;
FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
if (CONSP (car)
- && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
+ && (NILP (testfn)
+ ? (EQ (XCAR (car), key) || !NILP (Fequal
+ (XCAR (car), key)))
+ : !NILP (call2 (testfn, XCAR (car), key))))
return car;
}
CHECK_LIST_END (tail, list);
@@ -4735,22 +4745,42 @@ make_digest_string (Lisp_Object digest, int digest_size)
return digest;
}
-/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
+DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms,
+ Ssecure_hash_algorithms, 0, 0, 0,
+ doc: /* Return a list of all the supported `secure_hash' algorithms. */)
+ (void)
+{
+ return listn (CONSTYPE_HEAP, 6,
+ Qmd5,
+ Qsha1,
+ Qsha224,
+ Qsha256,
+ Qsha384,
+ Qsha512);
+}
-static Lisp_Object
-secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
- Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
- Lisp_Object binary)
+/* Extract data from a string or a buffer. SPEC is a list of
+(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as
+specified with `secure-hash' and in Info node
+`(elisp)Format of GnuTLS Cryptography Inputs'. */
+char *
+extract_data_from_object (Lisp_Object spec,
+ ptrdiff_t *start_byte,
+ ptrdiff_t *end_byte)
{
- ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte;
- register EMACS_INT b, e;
- register struct buffer *bp;
- EMACS_INT temp;
- int digest_size;
- void *(*hash_func) (const char *, size_t, void *);
- Lisp_Object digest;
+ Lisp_Object object = XCAR (spec);
- CHECK_SYMBOL (algorithm);
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object start = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object end = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object coding_system = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object noerror = CAR_SAFE (spec);
if (STRINGP (object))
{
@@ -4778,23 +4808,24 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
- size = SCHARS (object);
+ ptrdiff_t size = SCHARS (object), start_char, end_char;
validate_subarray (object, start, end, size, &start_char, &end_char);
- start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
- end_byte = (end_char == size
- ? SBYTES (object)
- : string_char_to_byte (object, end_char));
+ *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
+ *end_byte = (end_char == size
+ ? SBYTES (object)
+ : string_char_to_byte (object, end_char));
}
- else
+ else if (BUFFERP (object))
{
struct buffer *prev = current_buffer;
+ EMACS_INT b, e;
record_unwind_current_buffer ();
CHECK_BUFFER (object);
- bp = XBUFFER (object);
+ struct buffer *bp = XBUFFER (object);
set_buffer_internal (bp);
if (NILP (start))
@@ -4814,7 +4845,11 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
}
if (b > e)
- temp = b, b = e, e = temp;
+ {
+ EMACS_INT temp = b;
+ b = e;
+ e = temp;
+ }
if (!(BEGV <= b && e <= ZV))
args_out_of_range (start, end);
@@ -4887,10 +4922,55 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
- start_byte = 0;
- end_byte = SBYTES (object);
+ *start_byte = 0;
+ *end_byte = SBYTES (object);
+ }
+ else if (EQ (object, Qiv_auto))
+ {
+#ifdef HAVE_GNUTLS3
+ /* Format: (iv-auto REQUIRED-LENGTH). */
+
+ if (! NATNUMP (start))
+ error ("Without a length, `iv-auto' can't be used; see ELisp manual");
+ else
+ {
+ EMACS_INT start_hold = XFASTINT (start);
+ object = make_uninit_string (start_hold);
+ gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);
+
+ *start_byte = 0;
+ *end_byte = start_hold;
+ }
+#else
+ error ("GnuTLS is not available, so `iv-auto' can't be used");
+#endif
}
+ return SSDATA (object);
+}
+
+
+/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
+
+static Lisp_Object
+secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
+ Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
+ Lisp_Object binary)
+{
+ ptrdiff_t start_byte, end_byte;
+ int digest_size;
+ void *(*hash_func) (const char *, size_t, void *);
+ Lisp_Object digest;
+
+ CHECK_SYMBOL (algorithm);
+
+ Lisp_Object spec = list5 (object, start, end, coding_system, noerror);
+
+ const char *input = extract_data_from_object (spec, &start_byte, &end_byte);
+
+ if (input == NULL)
+ error ("secure_hash: failed to extract data from object, aborting!");
+
if (EQ (algorithm, Qmd5))
{
digest_size = MD5_DIGEST_SIZE;
@@ -4928,7 +5008,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
hexified value */
digest = make_uninit_string (digest_size * 2);
- hash_func (SSDATA (object) + start_byte,
+ hash_func (input + start_byte,
end_byte - start_byte,
SSDATA (digest));
@@ -4979,6 +5059,8 @@ The two optional arguments START and END are positions specifying for
which part of OBJECT to compute the hash. If nil or omitted, uses the
whole OBJECT.
+The full list of algorithms can be obtained with `secure-hash-algorithms'.
+
If BINARY is non-nil, returns a string in binary form. */)
(Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
{
@@ -5026,13 +5108,6 @@ disregarding any coding systems. If nil, use the current buffer. */ )
void
syms_of_fns (void)
{
- DEFSYM (Qmd5, "md5");
- DEFSYM (Qsha1, "sha1");
- DEFSYM (Qsha224, "sha224");
- DEFSYM (Qsha256, "sha256");
- DEFSYM (Qsha384, "sha384");
- DEFSYM (Qsha512, "sha512");
-
/* Hash table stuff. */
DEFSYM (Qhash_table_p, "hash-table-p");
DEFSYM (Qeq, "eq");
@@ -5069,6 +5144,18 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
+ /* Crypto and hashing stuff. */
+ DEFSYM (Qiv_auto, "iv-auto");
+
+ DEFSYM (Qmd5, "md5");
+ DEFSYM (Qsha1, "sha1");
+ DEFSYM (Qsha224, "sha224");
+ DEFSYM (Qsha256, "sha256");
+ DEFSYM (Qsha384, "sha384");
+ DEFSYM (Qsha512, "sha512");
+
+ /* Miscellaneous stuff. */
+
DEFSYM (Qstring_lessp, "string-lessp");
DEFSYM (Qprovide, "provide");
DEFSYM (Qrequire, "require");
@@ -5187,6 +5274,7 @@ this variable. */);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
+ defsubr (&Ssecure_hash_algorithms);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
diff --git a/src/font.c b/src/font.c
index 5a3f271ef85..a5e5b6a5b9d 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1893,7 +1893,7 @@ otf_tag_symbol (OTF_Tag tag)
static OTF *
otf_open (Lisp_Object file)
{
- Lisp_Object val = Fassoc (file, otf_list);
+ Lisp_Object val = Fassoc (file, otf_list, Qnil);
OTF *otf;
if (! NILP (val))
diff --git a/src/fontset.c b/src/fontset.c
index 850558b08a0..74018060b85 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1186,7 +1186,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern)
{
tem = Frassoc (name, Vfontset_alias_alist);
if (NILP (tem))
- tem = Fassoc (name, Vfontset_alias_alist);
+ tem = Fassoc (name, Vfontset_alias_alist, Qnil);
if (CONSP (tem) && STRINGP (XCAR (tem)))
name = XCAR (tem);
else if (name_pattern == 0)
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index d72005771ec..9b592e6a740 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -81,9 +81,9 @@ ftcrfont_glyph_extents (struct font *font,
ftcrfont_info->metrics =
xrealloc (ftcrfont_info->metrics,
sizeof (struct font_metrics *) * (row + 1));
- bzero (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows,
- (sizeof (struct font_metrics *)
- * (row + 1 - ftcrfont_info->metrics_nrows)));
+ memset (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 0,
+ (sizeof (struct font_metrics *)
+ * (row + 1 - ftcrfont_info->metrics_nrows)));
ftcrfont_info->metrics_nrows = row + 1;
}
if (ftcrfont_info->metrics[row] == NULL)
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 285a253733d..fa4854c664d 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -266,7 +266,7 @@ reason. Removing the watch by calling `gfile-rm-watch' also makes it
invalid. */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
+ Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (NILP (watch_object))
return Qnil;
else
diff --git a/src/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/>. */
#include "process.h"
#include "gnutls.h"
#include "coding.h"
+#include "buffer.h"
#ifdef HAVE_GNUTLS
@@ -171,6 +172,59 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
+# ifdef HAVE_GNUTLS3
+DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
+DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
+DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
+DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
+# ifdef HAVE_GNUTLS3_CIPHER
+DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
+DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_init,
+ (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
+ const gnutls_datum_t *, const gnutls_datum_t *));
+DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t));
+DEF_DLL_FN (int, gnutls_cipher_encrypt2,
+ (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
+DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
+DEF_DLL_FN (int, gnutls_cipher_decrypt2,
+ (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
+# ifdef HAVE_GNUTLS3_AEAD
+DEF_DLL_FN (int, gnutls_aead_cipher_init,
+ (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
+ const gnutls_datum_t *));
+DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t));
+DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
+ (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
+ size_t, size_t, const void *, size_t, void *, size_t *));
+DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
+ (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
+ size_t, size_t, const void *, size_t, void *, size_t *));
+# endif /* HAVE_GNUTLS3_AEAD */
+# ifdef HAVE_GNUTLS3_HMAC
+DEF_DLL_FN (int, gnutls_hmac_init,
+ (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
+DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
+DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
+DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
+# endif /* HAVE_GNUTLS3_HMAC */
+# endif /* HAVE_GNUTLS3_CIPHER */
+# ifdef HAVE_GNUTLS3_DIGEST
+ DEF_DLL_FN (int, gnutls_hash_init,
+ (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
+DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
+DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
+DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
+DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
+# endif /* HAVE_GNUTLS3_DIGEST */
+# endif /* HAVE_GNUTLS3 */
+
static bool
init_gnutls_functions (void)
@@ -255,6 +309,46 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
+# ifdef HAVE_GNUTLS3
+ LOAD_DLL_FN (library, gnutls_rnd);
+ LOAD_DLL_FN (library, gnutls_mac_list);
+ LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
+ LOAD_DLL_FN (library, gnutls_mac_get_key_size);
+ LOAD_DLL_FN (library, gnutls_digest_list);
+ LOAD_DLL_FN (library, gnutls_digest_get_name);
+# ifdef HAVE_GNUTLS3_CIPHER
+ LOAD_DLL_FN (library, gnutls_cipher_list);
+ LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
+ LOAD_DLL_FN (library, gnutls_cipher_init);
+ LOAD_DLL_FN (library, gnutls_cipher_set_iv);
+ LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
+ LOAD_DLL_FN (library, gnutls_cipher_deinit);
+ LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
+# ifdef HAVE_GNUTLS3_AEAD
+ LOAD_DLL_FN (library, gnutls_aead_cipher_init);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
+# endif
+# ifdef HAVE_GNUTLS3_HMAC
+ LOAD_DLL_FN (library, gnutls_hmac_init);
+ LOAD_DLL_FN (library, gnutls_hmac_get_len);
+ LOAD_DLL_FN (library, gnutls_hmac);
+ LOAD_DLL_FN (library, gnutls_hmac_deinit);
+ LOAD_DLL_FN (library, gnutls_hmac_output);
+# endif /* HAVE_GNUTLS3_HMAC */
+# endif /* HAVE_GNUTLS3_CIPHER */
+# ifdef HAVE_GNUTLS3_DIGEST
+ LOAD_DLL_FN (library, gnutls_hash_init);
+ LOAD_DLL_FN (library, gnutls_hash_get_len);
+ LOAD_DLL_FN (library, gnutls_hash);
+ LOAD_DLL_FN (library, gnutls_hash_deinit);
+ LOAD_DLL_FN (library, gnutls_hash_output);
+# endif
+# endif /* HAVE_GNUTLS3 */
max_log_level = global_gnutls_log_level;
@@ -332,8 +426,56 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
+# ifdef HAVE_GNUTLS3
+# define gnutls_rnd fn_gnutls_rnd
+# define gnutls_mac_list fn_gnutls_mac_list
+# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
+# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
+# define gnutls_digest_list fn_gnutls_digest_list
+# define gnutls_digest_get_name fn_gnutls_digest_get_name
+# ifdef HAVE_GNUTLS3_CIPHER
+# define gnutls_cipher_list fn_gnutls_cipher_list
+# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
+# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
+# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
+# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
+# define gnutls_cipher_init fn_gnutls_cipher_init
+# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
+# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
+# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
+# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
+# ifdef HAVE_GNUTLS3_AEAD
+# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
+# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
+# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
+# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
+# endif /* HAVE_GNUTLS3_AEAD */
+# ifdef HAVE_GNUTLS3_HMAC
+# define gnutls_hmac_init fn_gnutls_hmac_init
+# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
+# define gnutls_hmac fn_gnutls_hmac
+# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
+# define gnutls_hmac_output fn_gnutls_hmac_output
+# endif /* HAVE_GNUTLS3_HMAC */
+# endif /* HAVE_GNUTLS3_CIPHER */
+# ifdef HAVE_GNUTLS3_DIGEST
+# define gnutls_hash_init fn_gnutls_hash_init
+# define gnutls_hash_get_len fn_gnutls_hash_get_len
+# define gnutls_hash fn_gnutls_hash
+# define gnutls_hash_deinit fn_gnutls_hash_deinit
+# define gnutls_hash_output fn_gnutls_hash_output
+# endif
+# endif /* HAVE_GNUTLS3 */
+
+/* This wrapper is called from fns.c, which doesn't know about the
+ LOAD_DLL_FN stuff above. */
+int
+w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
+{
+ return gnutls_rnd (level, data, len);
+}
-#endif
+#endif /* WINDOWSNT */
/* Report memory exhaustion if ERR is an out-of-memory indication. */
@@ -433,7 +575,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
return err;
}
}
-#endif
+#endif /* !WINDOWSNT */
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -556,6 +698,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
}
}
+static char const *
+emacs_gnutls_strerror (int err)
+{
+ char const *str = gnutls_strerror (err);
+ return str ? str : "unknown";
+}
+
/* Report a GnuTLS error to the user.
Return true if the error code was successfully handled. */
static bool
@@ -564,7 +713,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
int max_log_level = 0;
bool ret;
- const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
@@ -576,9 +724,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
/* TODO: use gnutls-error-fatalp and gnutls-error-string. */
- str = gnutls_strerror (err);
- if (!str)
- str = "unknown";
+ char const *str = emacs_gnutls_strerror (err);
if (gnutls_error_is_fatal (err))
{
@@ -592,11 +738,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
#endif
GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
- ret = 0;
+ ret = false;
}
else
{
- ret = 1;
+ ret = true;
switch (err)
{
@@ -784,7 +930,7 @@ usage: (gnutls-error-string ERROR) */)
if (! TYPE_RANGED_INTEGERP (int, err))
return build_string ("Not an error symbol or code");
- return build_string (gnutls_strerror (XINT (err)));
+ return build_string (emacs_gnutls_strerror (XINT (err)));
}
DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -1476,9 +1622,9 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
verify_flags = Fplist_get (proplist, QCverify_flags);
- if (NUMBERP (verify_flags))
+ if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags))
{
- gnutls_verify_flags = XINT (verify_flags);
+ gnutls_verify_flags = XFASTINT (verify_flags);
GNUTLS_LOG (2, max_log_level, "setting verification flags");
}
else if (NILP (verify_flags))
@@ -1697,28 +1843,624 @@ This function may also return `gnutls-e-again', or
#endif /* HAVE_GNUTLS */
+#ifdef HAVE_GNUTLS3
+
+DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0,
+ doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists.
+The alist key is the cipher name. */)
+ (void)
+{
+ Lisp_Object ciphers = Qnil;
+
+#ifdef HAVE_GNUTLS3_CIPHER
+ const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
+ for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
+ {
+ gnutls_cipher_algorithm_t gca = gciphers[pos];
+ if (gca == GNUTLS_CIPHER_NULL)
+ continue;
+ char const *cipher_name = gnutls_cipher_get_name (gca);
+ if (!cipher_name)
+ continue;
+
+ /* A symbol representing the GnuTLS cipher. */
+ Lisp_Object cipher_symbol = intern (cipher_name);
+
+ ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
+
+ Lisp_Object cp
+ = listn (CONSTYPE_HEAP, 15, cipher_symbol,
+ QCcipher_id, make_number (gca),
+ QCtype, Qgnutls_type_cipher,
+ QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt,
+ QCcipher_tagsize, make_number (cipher_tag_size),
+
+ QCcipher_blocksize,
+ make_number (gnutls_cipher_get_block_size (gca)),
+
+ QCcipher_keysize,
+ make_number (gnutls_cipher_get_key_size (gca)),
+
+ QCcipher_ivsize,
+ make_number (gnutls_cipher_get_iv_size (gca)));
+
+ ciphers = Fcons (cp, ciphers);
+ }
+#endif
+
+ return ciphers;
+}
+
+static Lisp_Object
+gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
+ Lisp_Object cipher,
+ const char *kdata, ptrdiff_t ksize,
+ const char *vdata, ptrdiff_t vsize,
+ const char *idata, ptrdiff_t isize,
+ Lisp_Object aead_auth)
+{
+#ifdef HAVE_GNUTLS3_AEAD
+
+ const char *desc = encrypting ? "encrypt" : "decrypt";
+ Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
+
+ gnutls_aead_cipher_hd_t acipher;
+ gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize };
+ int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
+ gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
+
+ ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
+ ptrdiff_t tagged_size;
+ if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size)
+ || SIZE_MAX < tagged_size)
+ memory_full (SIZE_MAX);
+ size_t storage_length = tagged_size;
+ USE_SAFE_ALLOCA;
+ char *storage = SAFE_ALLOCA (storage_length);
+
+ const char *aead_auth_data = NULL;
+ ptrdiff_t aead_auth_size = 0;
+
+ if (!NILP (aead_auth))
+ {
+ if (BUFFERP (aead_auth) || STRINGP (aead_auth))
+ aead_auth = list1 (aead_auth);
+
+ CHECK_CONS (aead_auth);
+
+ ptrdiff_t astart_byte, aend_byte;
+ const char *adata
+ = extract_data_from_object (aead_auth, &astart_byte, &aend_byte);
+ if (adata == NULL)
+ error ("GnuTLS AEAD cipher auth extraction failed");
+
+ aead_auth_data = adata;
+ aead_auth_size = aend_byte - astart_byte;
+ }
+
+ ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
+ ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
+
+ if (isize < expected_remainder
+ || (isize - expected_remainder) % cipher_block_size != 0)
+ error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d "
+ "is not %"pD"d greater than a multiple of the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ isize, expected_remainder, cipher_block_size);
+
+ ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt)
+ (acipher, vdata, vsize, aead_auth_data, aead_auth_size,
+ cipher_tag_size, idata, isize, storage, &storage_length));
+
+ Lisp_Object output;
+ if (GNUTLS_E_SUCCESS <= ret)
+ output = make_unibyte_string (storage, storage_length);
+ explicit_bzero (storage, storage_length);
+ gnutls_aead_cipher_deinit (acipher);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ((encrypting
+ ? "GnuTLS AEAD cipher %s encryption failed: %s"
+ : "GnuTLS AEAD cipher %s decryption failed: %s"),
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+
+ SAFE_FREE ();
+ return list2 (output, actual_iv);
+#else
+ printmax_t print_gca = gca;
+ error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca);
+#endif
+}
+
+static Lisp_Object
+gnutls_symmetric (bool encrypting, Lisp_Object cipher,
+ Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ if (BUFFERP (key) || STRINGP (key))
+ key = list1 (key);
+
+ CHECK_CONS (key);
+
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ if (BUFFERP (iv) || STRINGP (iv))
+ iv = list1 (iv);
+
+ CHECK_CONS (iv);
+
+
+ const char *desc = encrypting ? "encrypt" : "decrypt";
+
+ gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (cipher))
+ cipher = intern (SSDATA (cipher));
+
+ if (SYMBOLP (cipher))
+ info = XCDR (Fassq (cipher, Fgnutls_ciphers ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher))
+ gca = XINT (cipher);
+ else
+ info = cipher;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCcipher_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v))
+ gca = XINT (v);
+ }
+
+ ptrdiff_t key_size = gnutls_cipher_get_key_size (gca);
+ if (key_size == 0)
+ error ("GnuTLS cipher is invalid or not found");
+
+ ptrdiff_t kstart_byte, kend_byte;
+ const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
+
+ if (kdata == NULL)
+ error ("GnuTLS cipher key extraction failed");
+
+ if (kend_byte - kstart_byte != key_size)
+ error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to "
+ "the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ kend_byte - kstart_byte, key_size);
+
+ ptrdiff_t vstart_byte, vend_byte;
+ char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte);
+
+ if (vdata == NULL)
+ error ("GnuTLS cipher IV extraction failed");
+
+ ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca);
+ if (vend_byte - vstart_byte != iv_size)
+ error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to "
+ "the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ vend_byte - vstart_byte, iv_size);
+
+ Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte);
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+
+ if (idata == NULL)
+ error ("GnuTLS cipher input extraction failed");
+
+ /* Is this an AEAD cipher? */
+ if (gnutls_cipher_get_tag_size (gca) > 0)
+ {
+ Lisp_Object aead_output =
+ gnutls_symmetric_aead (encrypting, gca, cipher,
+ kdata, kend_byte - kstart_byte,
+ vdata, vend_byte - vstart_byte,
+ idata, iend_byte - istart_byte,
+ aead_auth);
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+ return aead_output;
+ }
+
+ ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
+ if ((iend_byte - istart_byte) % cipher_block_size != 0)
+ error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple "
+ "of the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ iend_byte - istart_byte, cipher_block_size);
+
+ gnutls_cipher_hd_t hcipher;
+ gnutls_datum_t key_datum
+ = { (unsigned char *) kdata, kend_byte - kstart_byte };
+
+ int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS cipher %s/%s initialization failed: %s",
+ gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
+
+ /* Note that this will not support streaming block mode. */
+ gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte);
+
+ /* GnuTLS docs: "For the supported ciphers the encrypted data length
+ will equal the plaintext size." */
+ ptrdiff_t storage_length = iend_byte - istart_byte;
+ Lisp_Object storage = make_uninit_string (storage_length);
+
+ ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2)
+ (hcipher, idata, iend_byte - istart_byte,
+ SSDATA (storage), storage_length));
+
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_cipher_deinit (hcipher);
+ if (encrypting)
+ error ("GnuTLS cipher %s encryption failed: %s",
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+ else
+ error ("GnuTLS cipher %s decryption failed: %s",
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_cipher_deinit (hcipher);
+
+ return list2 (storage, actual_iv);
+}
+
+DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt,
+ Sgnutls_symmetric_encrypt, 4, 5, 0,
+ doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The IV and INPUT and the optional AEAD_AUTH can be specified as a
+buffer or string or in other ways (see Info node `(elisp)Format of
+GnuTLS Cryptography Inputs').
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
+The CIPHER may be a string or symbol matching a key in that alist, or
+a plist with the :cipher-id numeric property, or the number itself.
+
+AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
+:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
+these AEAD ciphers, but it may still be omitted (nil) as well. */)
+ (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ return gnutls_symmetric (true, cipher, key, iv, input, aead_auth);
+}
+
+DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt,
+ Sgnutls_symmetric_decrypt, 4, 5, 0,
+ doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The IV and INPUT and the optional AEAD_AUTH can be specified as a
+buffer or string or in other ways (see Info node `(elisp)Format of
+GnuTLS Cryptography Inputs').
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
+The CIPHER may be a string or symbol matching a key in that alist, or
+a plist with the `:cipher-id' numeric property, or the number itself.
+
+AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
+:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
+these AEAD ciphers, but it may still be omitted (nil) as well. */)
+ (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ return gnutls_symmetric (false, cipher, key, iv, input, aead_auth);
+}
+
+DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0,
+ doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists.
+
+Use the value of the alist (extract it with `alist-get' for instance)
+with `gnutls-hash-mac'. The alist key is the mac-algorithm method
+name. */)
+ (void)
+{
+ Lisp_Object mac_algorithms = Qnil;
+#ifdef HAVE_GNUTLS3_HMAC
+ const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
+ for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
+ {
+ const gnutls_mac_algorithm_t gma = macs[pos];
+
+ /* A symbol representing the GnuTLS MAC algorithm. */
+ Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma));
+
+ Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol,
+ QCmac_algorithm_id, make_number (gma),
+ QCtype, Qgnutls_type_mac_algorithm,
+
+ QCmac_algorithm_length,
+ make_number (gnutls_hmac_get_len (gma)),
+
+ QCmac_algorithm_keysize,
+ make_number (gnutls_mac_get_key_size (gma)),
+
+ QCmac_algorithm_noncesize,
+ make_number (gnutls_mac_get_nonce_size (gma)));
+ mac_algorithms = Fcons (mp, mac_algorithms);
+ }
+#endif
+
+ return mac_algorithms;
+}
+
+DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0,
+ doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists.
+
+Use the value of the alist (extract it with `alist-get' for instance)
+with `gnutls-hash-digest'. The alist key is the digest-algorithm
+method name. */)
+ (void)
+{
+ Lisp_Object digest_algorithms = Qnil;
+#ifdef HAVE_GNUTLS3_DIGEST
+ const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
+ for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
+ {
+ const gnutls_digest_algorithm_t gda = digests[pos];
+
+ /* A symbol representing the GnuTLS digest algorithm. */
+ Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda));
+
+ Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol,
+ QCdigest_algorithm_id, make_number (gda),
+ QCtype, Qgnutls_type_digest_algorithm,
+
+ QCdigest_algorithm_length,
+ make_number (gnutls_hash_get_len (gda)));
+
+ digest_algorithms = Fcons (mp, digest_algorithms);
+ }
+#endif
+
+ return digest_algorithms;
+}
+
+DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0,
+ doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The INPUT can be specified as a buffer or string or in other
+ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
+
+The alist of MAC algorithms can be obtained with `gnutls-macs`. The
+HASH-METHOD may be a string or symbol matching a key in that alist, or
+a plist with the `:mac-algorithm-id' numeric property, or the number
+itself. */)
+ (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input)
+{
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ if (BUFFERP (key) || STRINGP (key))
+ key = list1 (key);
+
+ CHECK_CONS (key);
+
+ gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (hash_method))
+ hash_method = intern (SSDATA (hash_method));
+
+ if (SYMBOLP (hash_method))
+ info = XCDR (Fassq (hash_method, Fgnutls_macs ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method))
+ gma = XINT (hash_method);
+ else
+ info = hash_method;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v))
+ gma = XINT (v);
+ }
+
+ ptrdiff_t digest_length = gnutls_hmac_get_len (gma);
+ if (digest_length == 0)
+ error ("GnuTLS MAC-method is invalid or not found");
+
+ ptrdiff_t kstart_byte, kend_byte;
+ const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
+ if (kdata == NULL)
+ error ("GnuTLS MAC key extraction failed");
+
+ gnutls_hmac_hd_t hmac;
+ int ret = gnutls_hmac_init (&hmac, gma,
+ kdata + kstart_byte, kend_byte - kstart_byte);
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS MAC %s initialization failed: %s",
+ gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+ if (idata == NULL)
+ error ("GnuTLS MAC input extraction failed");
+
+ Lisp_Object digest = make_uninit_string (digest_length);
+
+ ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte);
+
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hmac_deinit (hmac, NULL);
+ error ("GnuTLS MAC %s application failed: %s",
+ gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_hmac_output (hmac, SSDATA (digest));
+ gnutls_hmac_deinit (hmac, NULL);
+
+ return digest;
+}
+
+DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
+ doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string.
+
+Return nil on error.
+
+The INPUT can be specified as a buffer or string or in other
+ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
+
+The alist of digest algorithms can be obtained with `gnutls-digests`.
+The DIGEST-METHOD may be a string or symbol matching a key in that
+alist, or a plist with the `:digest-algorithm-id' numeric property, or
+the number itself. */)
+ (Lisp_Object digest_method, Lisp_Object input)
+{
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (digest_method))
+ digest_method = intern (SSDATA (digest_method));
+
+ if (SYMBOLP (digest_method))
+ info = XCDR (Fassq (digest_method, Fgnutls_digests ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method))
+ gda = XINT (digest_method);
+ else
+ info = digest_method;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v))
+ gda = XINT (v);
+ }
+
+ ptrdiff_t digest_length = gnutls_hash_get_len (gda);
+ if (digest_length == 0)
+ error ("GnuTLS digest-method is invalid or not found");
+
+ gnutls_hash_hd_t hash;
+ int ret = gnutls_hash_init (&hash, gda);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS digest initialization failed: %s",
+ emacs_gnutls_strerror (ret));
+
+ Lisp_Object digest = make_uninit_string (digest_length);
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+ if (idata == NULL)
+ error ("GnuTLS digest input extraction failed");
+
+ ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hash_deinit (hash, NULL);
+ error ("GnuTLS digest application failed: %s",
+ emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_hash_output (hash, SSDATA (digest));
+ gnutls_hash_deinit (hash, NULL);
+
+ return digest;
+}
+
+#endif /* HAVE_GNUTLS3 */
+
DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
- doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
- (void)
+ doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs.
+
+...if supported : then...
+GnuTLS 3 or higher : the list will contain `gnutls3'.
+GnuTLS MACs : the list will contain `macs'.
+GnuTLS digests : the list will contain `digests'.
+GnuTLS symmetric ciphers: the list will contain `ciphers'.
+GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */)
+ (void)
{
+ Lisp_Object capabilities = Qnil;
+
#ifdef HAVE_GNUTLS
-# ifdef WINDOWSNT
+
+# ifdef HAVE_GNUTLS3
+ capabilities = Fcons (intern("gnutls3"), capabilities);
+
+# ifdef HAVE_GNUTLS3_DIGEST
+ capabilities = Fcons (intern("digests"), capabilities);
+# endif
+
+# ifdef HAVE_GNUTLS3_CIPHER
+ capabilities = Fcons (intern("ciphers"), capabilities);
+
+# ifdef HAVE_GNUTLS3_AEAD
+ capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
+# endif
+
+# ifdef HAVE_GNUTLS3_HMAC
+ capabilities = Fcons (intern("macs"), capabilities);
+# endif
+# endif /* HAVE_GNUTLS3_CIPHER */
+# endif /* HAVE_GNUTLS3 */
+
+#ifdef WINDOWSNT
Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
else
{
Lisp_Object status;
- status = init_gnutls_functions () ? Qt : Qnil;
+ status = init_gnutls_functions () ? capabilities : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
return status;
}
-# else /* !WINDOWSNT */
- return Qt;
-# endif /* !WINDOWSNT */
+#else /* !WINDOWSNT */
+
+ return capabilities;
+
+#endif /* WINDOWSNT */
+
#else /* !HAVE_GNUTLS */
return Qnil;
-#endif /* !HAVE_GNUTLS */
+#endif /* HAVE_GNUTLS */
}
void
@@ -1753,6 +2495,27 @@ syms_of_gnutls (void)
DEFSYM (QCverify_flags, ":verify-flags");
DEFSYM (QCverify_error, ":verify-error");
+ DEFSYM (QCcipher_id, ":cipher-id");
+ DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
+ DEFSYM (QCcipher_blocksize, ":cipher-blocksize");
+ DEFSYM (QCcipher_keysize, ":cipher-keysize");
+ DEFSYM (QCcipher_tagsize, ":cipher-tagsize");
+ DEFSYM (QCcipher_keysize, ":cipher-keysize");
+ DEFSYM (QCcipher_ivsize, ":cipher-ivsize");
+
+ DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id");
+ DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize");
+ DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize");
+ DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length");
+
+ DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id");
+ DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length");
+
+ DEFSYM (QCtype, ":type");
+ DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher");
+ DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm");
+ DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm");
+
DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
make_number (GNUTLS_E_INTERRUPTED));
@@ -1780,6 +2543,16 @@ syms_of_gnutls (void)
defsubr (&Sgnutls_peer_status);
defsubr (&Sgnutls_peer_status_warning_describe);
+#ifdef HAVE_GNUTLS3
+ defsubr (&Sgnutls_ciphers);
+ defsubr (&Sgnutls_macs);
+ defsubr (&Sgnutls_digests);
+ defsubr (&Sgnutls_hash_mac);
+ defsubr (&Sgnutls_hash_digest);
+ defsubr (&Sgnutls_symmetric_encrypt);
+ defsubr (&Sgnutls_symmetric_decrypt);
+#endif
+
DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
doc: /* Logging level used by the GnuTLS functions.
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/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
+#ifdef HAVE_GNUTLS3
+#include <gnutls/crypto.h>
+#endif
+
#include "lisp.h"
/* 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);
extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state);
#ifdef WINDOWSNT
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
+extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t);
#endif
extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
extern Lisp_Object emacs_gnutls_global_init (void);
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)
*dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL;
}
+/* Scaling/HiDPI functions. */
+static int
+xg_get_gdk_scale (void)
+{
+ const char *sscale = getenv ("GDK_SCALE");
+
+ if (sscale)
+ {
+ long scale = atol (sscale);
+ if (0 < scale)
+ return min (scale, INT_MAX);
+ }
+
+ return 1;
+}
+
+int
+xg_get_scale (struct frame *f)
+{
+#if GTK_CHECK_VERSION (3, 10, 0)
+ if (FRAME_GTK_WIDGET (f))
+ return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f));
+#endif
+ return xg_get_gdk_scale ();
+}
/* Close display DPY. */
@@ -724,7 +749,8 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y)
if (x->ttip_window)
{
block_input ();
- gtk_window_move (x->ttip_window, root_x, root_y);
+ gtk_window_move (x->ttip_window, root_x / xg_get_scale (f),
+ root_y / xg_get_scale (f));
gtk_widget_show_all (GTK_WIDGET (x->ttip_window));
unblock_input ();
}
@@ -836,21 +862,6 @@ xg_set_geometry (struct frame *f)
}
}
-static int
-xg_get_gdk_scale (void)
-{
- const char *sscale = getenv ("GDK_SCALE");
-
- if (sscale)
- {
- long scale = atol (sscale);
- if (0 < scale)
- return min (scale, INT_MAX);
- }
-
- return 1;
-}
-
/* Function to handle resize of our frame. As we have a Gtk+ tool bar
and a Gtk+ menu bar, we get resize events for the edit part of the
frame only. We let Gtk+ deal with the Gtk+ parts.
@@ -912,12 +923,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
/* Do this before resize, as we don't know yet if we will be resized. */
x_clear_under_internal_border (f);
- if (FRAME_VISIBLE_P (f))
- {
- int scale = xg_get_gdk_scale ();
- totalheight /= scale;
- totalwidth /= scale;
- }
+ totalheight /= xg_get_scale (f);
+ totalwidth /= xg_get_scale (f);
x_wm_set_size_hint (f, 0, 0);
@@ -1343,7 +1350,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position)
int min_rows = 0, min_cols = 0;
int win_gravity = f->win_gravity;
Lisp_Object fs_state, frame;
- int scale = xg_get_gdk_scale ();
+ int scale = xg_get_scale (f);
/* Don't set size hints during initialization; that apparently leads
to a race condition. See the thread at
@@ -3659,16 +3666,16 @@ update_theme_scrollbar_height (void)
}
int
-xg_get_default_scrollbar_width (void)
+xg_get_default_scrollbar_width (struct frame *f)
{
- return scroll_bar_width_for_theme * xg_get_gdk_scale ();
+ return scroll_bar_width_for_theme * xg_get_scale (f);
}
int
-xg_get_default_scrollbar_height (void)
+xg_get_default_scrollbar_height (struct frame *f)
{
/* Apparently there's no default height for themes. */
- return scroll_bar_width_for_theme * xg_get_gdk_scale ();
+ return scroll_bar_width_for_theme * xg_get_scale (f);
}
/* Return the scrollbar id for X Window WID on display DPY.
@@ -3858,7 +3865,7 @@ xg_update_scrollbar_pos (struct frame *f,
GtkWidget *wfixed = f->output_data.x->edit_widget;
GtkWidget *wparent = gtk_widget_get_parent (wscroll);
gint msl;
- int scale = xg_get_gdk_scale ();
+ int scale = xg_get_scale (f);
top /= scale;
left /= scale;
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 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,
int position,
int whole);
extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *);
-extern int xg_get_default_scrollbar_width (void);
-extern int xg_get_default_scrollbar_height (void);
+extern int xg_get_default_scrollbar_width (struct frame *f);
+extern int xg_get_default_scrollbar_height (struct frame *f);
extern void update_frame_tool_bar (struct frame *f);
extern void free_frame_tool_bar (struct frame *f);
@@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f,
extern void xg_frame_set_char_size (struct frame *f, int width, int height);
extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc);
+extern int xg_get_scale (struct frame *f);
extern void xg_display_open (char *display_name, Display **dpy);
extern void xg_display_close (Display *dpy);
extern GdkCursor * xg_create_default_cursor (Display *dpy);
diff --git a/src/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,
color_val = Qnil;
if (!NILP (color_symbols) && !NILP (symbol_color))
{
- Lisp_Object specified_color = Fassoc (symbol_color, color_symbols);
+ Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil);
if (CONSP (specified_color) && STRINGP (XCDR (specified_color)))
{
@@ -8086,83 +8086,76 @@ compute_image_size (size_t width, size_t height,
int *d_width, int *d_height)
{
Lisp_Object value;
- int desired_width, desired_height;
+ int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1;
double scale = 1;
value = image_spec_value (spec, QCscale, NULL);
if (NUMBERP (value))
scale = XFLOATINT (value);
+ value = image_spec_value (spec, QCmax_width, NULL);
+ if (NATNUMP (value))
+ max_width = min (XFASTINT (value), INT_MAX);
+
+ value = image_spec_value (spec, QCmax_height, NULL);
+ if (NATNUMP (value))
+ max_height = min (XFASTINT (value), INT_MAX);
+
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (spec, QCwidth, NULL);
- desired_width = NATNUMP (value) ?
- min (XFASTINT (value) * scale, INT_MAX) : -1;
+ if (NATNUMP (value))
+ {
+ desired_width = min (XFASTINT (value) * scale, INT_MAX);
+ /* :width overrides :max-width. */
+ max_width = -1;
+ }
+
value = image_spec_value (spec, QCheight, NULL);
- desired_height = NATNUMP (value) ?
- min (XFASTINT (value) * scale, INT_MAX) : -1;
+ if (NATNUMP (value))
+ {
+ desired_height = min (XFASTINT (value) * scale, INT_MAX);
+ /* :height overrides :max-height. */
+ max_height = -1;
+ }
+
+ /* If we have both width/height set explicitly, we skip past all the
+ aspect ratio-preserving computations below. */
+ if (desired_width != -1 && desired_height != -1)
+ goto out;
width = width * scale;
height = height * scale;
- if (desired_width == -1)
+ if (desired_width != -1)
+ /* Width known, calculate height. */
+ desired_height = scale_image_size (desired_width, width, height);
+ else if (desired_height != -1)
+ /* Height known, calculate width. */
+ desired_width = scale_image_size (desired_height, height, width);
+ else
{
- value = image_spec_value (spec, QCmax_width, NULL);
- if (NATNUMP (value))
- {
- int max_width = min (XFASTINT (value), INT_MAX);
- if (max_width < width)
- {
- /* The image is wider than :max-width. */
- desired_width = max_width;
- if (desired_height == -1)
- {
- desired_height = scale_image_size (desired_width,
- width, height);
- value = image_spec_value (spec, QCmax_height, NULL);
- if (NATNUMP (value))
- {
- int max_height = min (XFASTINT (value), INT_MAX);
- if (max_height < desired_height)
- {
- desired_height = max_height;
- desired_width = scale_image_size (desired_height,
- height, width);
- }
- }
- }
- }
- }
+ desired_width = width;
+ desired_height = height;
}
- if (desired_height == -1)
+ if (max_width != -1 && desired_width > max_width)
{
- value = image_spec_value (spec, QCmax_height, NULL);
- if (NATNUMP (value))
- {
- int max_height = min (XFASTINT (value), INT_MAX);
- if (max_height < height)
- desired_height = max_height;
- }
+ /* The image is wider than :max-width. */
+ desired_width = max_width;
+ desired_height = scale_image_size (desired_width, width, height);
}
- if (desired_width != -1 && desired_height == -1)
- /* w known, calculate h. */
- desired_height = scale_image_size (desired_width, width, height);
-
- if (desired_width == -1 && desired_height != -1)
- /* h known, calculate w. */
- desired_width = scale_image_size (desired_height, height, width);
-
- /* We have no width/height settings, so just apply the scale. */
- if (desired_width == -1 && desired_height == -1)
+ if (max_height != -1 && desired_height > max_height)
{
- desired_width = width;
- desired_height = height;
+ /* The image is higher than :max-height. */
+ desired_height = max_height;
+ desired_width = scale_image_size (desired_height, height, width);
}
+ out:
*d_width = desired_width;
*d_height = desired_height;
}
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,
-1, hscroll, 0, w);
}
+/* Return the width taken by line-number display in window W. */
+static void
+line_number_display_width (struct window *w, int *width, int *pixel_width)
+{
+ if (NILP (Vdisplay_line_numbers))
+ {
+ *width = 0;
+ *pixel_width = 0;
+ }
+ else
+ {
+ struct it it;
+ struct text_pos wstart;
+ bool saved_restriction = false;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ SET_TEXT_POS_FROM_MARKER (wstart, w->start);
+ void *itdata = bidi_shelve_cache ();
+ /* We must start from window's start point, but it could be
+ outside the accessible region. */
+ if (wstart.charpos < BEGV || wstart.charpos > ZV)
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fwiden ();
+ saved_restriction = true;
+ }
+ start_display (&it, w, wstart);
+ move_it_by_lines (&it, 1);
+ *width = it.lnum_width;
+ *pixel_width = it.lnum_pixel_width;
+ if (saved_restriction)
+ unbind_to (count, Qnil);
+ bidi_unshelve_cache (itdata, 0);
+ }
+}
+
+DEFUN ("line-number-display-width", Fline_number_display_width,
+ Sline_number_display_width, 0, 1, 0,
+ doc: /* Return the width used for displaying line numbers in the selected window.
+If optional argument PIXELWISE is non-nil, return the width in pixels,
+otherwise return the width in columns of the face used to display
+line numbers, `line-number'. */)
+ (Lisp_Object pixelwise)
+{
+ int width, pixel_width;
+ line_number_display_width (XWINDOW (selected_window), &width, &pixel_width);
+ if (!NILP (pixelwise))
+ return make_number (pixel_width);
+ return make_number (width);
+}
+
/* In window W (derived from WINDOW), return x coordinate for column
COL (derived from COLUMN). */
static int
@@ -2068,9 +2119,19 @@ whether or not it is currently displayed in some window. */)
start_x = window_column_x (w, window, start_col, cur_col);
}
- itdata = bidi_shelve_cache ();
+ /* When displaying line numbers, we need to prime IT's
+ lnum_width with the value calculated at window's start, since
+ that's what normal window redisplay does. Otherwise C-n/C-p
+ will sometimes err by one column. */
+ int lnum_width = 0;
+ int lnum_pixel_width = 0;
+ if (!NILP (Vdisplay_line_numbers)
+ && !EQ (Vdisplay_line_numbers, Qvisual))
+ line_number_display_width (w, &lnum_width, &lnum_pixel_width);
SET_TEXT_POS (pt, PT, PT_BYTE);
+ itdata = bidi_shelve_cache ();
start_display (&it, w, pt);
+ it.lnum_width = lnum_width;
first_x = it.first_visible_x;
it_start = IT_CHARPOS (it);
@@ -2247,6 +2308,12 @@ whether or not it is currently displayed in some window. */)
an addition to the hscroll amount. */
if (lcols_given)
{
+ /* If we are displaying line numbers, we could cross the
+ line where the width of the line-number display changes,
+ in which case we need to fix up the pixel coordinate
+ accordingly. */
+ if (lnum_pixel_width > 0)
+ to_x += it.lnum_pixel_width - lnum_pixel_width;
move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
/* If we find ourselves in the middle of an overlay string
which includes a newline after current string position,
@@ -2292,6 +2359,7 @@ syms_of_indent (void)
defsubr (&Sindent_to);
defsubr (&Scurrent_column);
defsubr (&Smove_to_column);
+ defsubr (&Sline_number_display_width);
defsubr (&Svertical_motion);
defsubr (&Scompute_motion);
}
diff --git a/src/intervals.c b/src/intervals.c
index d17d80ac865..0089ecb8dde 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1)
Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
+traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *),
+ void *arg)
{
/* Minimize stack usage. */
while (tree)
@@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position,
}
}
-#if 0
-
-static int icount;
-static int idepth;
-static int zero_length;
-
-/* These functions are temporary, for debugging purposes only. */
-
-INTERVAL search_interval, found_interval;
-
-void
-check_for_interval (INTERVAL i)
-{
- if (i == search_interval)
- {
- found_interval = i;
- icount++;
- }
-}
-
-INTERVAL
-search_for_interval (INTERVAL i, INTERVAL tree)
-{
- icount = 0;
- search_interval = i;
- found_interval = NULL;
- traverse_intervals_noorder (tree, &check_for_interval, Qnil);
- return found_interval;
-}
-
-static void
-inc_interval_count (INTERVAL i)
-{
- icount++;
- if (LENGTH (i) == 0)
- zero_length++;
- if (depth > idepth)
- idepth = depth;
-}
-
-int
-count_intervals (INTERVAL i)
-{
- icount = 0;
- idepth = 0;
- zero_length = 0;
- traverse_intervals_noorder (i, &inc_interval_count, Qnil);
-
- return icount;
-}
-
-static INTERVAL
-root_interval (INTERVAL interval)
-{
- register INTERVAL i = interval;
-
- while (! ROOT_INTERVAL_P (i))
- i = INTERVAL_PARENT (i);
-
- return i;
-}
-#endif
-
/* Assuming that a left child exists, perform the following operation:
A B
diff --git a/src/intervals.h b/src/intervals.h
index a0da6f37801..9140e0c17ab 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
extern void traverse_intervals_noorder (INTERVAL,
- void (*) (INTERVAL, Lisp_Object),
- Lisp_Object);
+ void (*) (INTERVAL, void *), void *);
extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
diff --git a/src/keyboard.c b/src/keyboard.c
index 9e90899c569..804af85dad9 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -5127,6 +5127,7 @@ static short const scroll_bar_parts[] = {
SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
};
+#ifdef HAVE_WINDOW_SYSTEM
/* An array of symbol indexes of internal border parts, indexed by an enum
internal_border_part value. Note that Qnil corresponds to
internal_border_part_none and should not appear in Lisp events. */
@@ -5137,6 +5138,7 @@ static short const internal_border_parts[] = {
SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
SYMBOL_INDEX (Qbottom_left_corner)
};
+#endif
/* A vector, indexed by button number, giving the down-going location
of currently depressed buttons, both scroll bar and non-scroll bar.
diff --git a/src/keymap.c b/src/keymap.c
index b568f47cba7..db9aa7cbf38 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1292,7 +1292,7 @@ silly_event_symbol_error (Lisp_Object c)
base = XCAR (parsed);
name = Fsymbol_name (base);
/* This alist includes elements such as ("RET" . "\\r"). */
- assoc = Fassoc (name, exclude_keys);
+ assoc = Fassoc (name, exclude_keys, Qnil);
if (! NILP (assoc))
{
diff --git a/src/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)
INLINE Lisp_Object
builtin_lisp_symbol (int index)
{
- return make_lisp_symbol (lispsym + index);
+ return make_lisp_symbol (&lispsym[index].s);
}
INLINE void
(CHECK_SYMBOL) (Lisp_Object x)
{
- lisp_h_CHECK_SYMBOL (x);
+ lisp_h_CHECK_SYMBOL (x);
}
/* In the size word of a vector, this bit means the vector has been marked. */
@@ -3386,6 +3386,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
+extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
@@ -3874,7 +3875,6 @@ extern Lisp_Object vformat_string (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
-extern void *near_C_stack_top (void);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
@@ -3965,6 +3965,7 @@ extern void syms_of_editfns (void);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
+extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
extern _Noreturn void nsberror (Lisp_Object);
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
diff --git a/src/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;
(to reduce allocations), or nil. */
static Lisp_Object read_objects_completed;
-/* File for get_file_char to read from. Use by load. */
-static FILE *instream;
+/* File and lookahead for get-file-char and get-emacs-mule-file-char
+ to read from. Used by Fload. */
+static struct infile
+{
+ /* The input stream. */
+ FILE *stream;
+
+ /* Lookahead byte count. */
+ signed char lookahead;
+
+ /* Lookahead bytes, in reverse order. Keep these here because it is
+ not portable to ungetc more than one byte at a time. */
+ unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
+} *infile;
/* For use within read-from-string (this reader is non-reentrant!!) */
static ptrdiff_t read_from_string_index;
@@ -149,7 +161,7 @@ static Lisp_Object Vloads_in_progress;
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
-static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
+static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
@@ -340,14 +352,13 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
len = BYTES_BY_CHAR_HEAD (c);
while (i < len)
{
- c = (*readbyte) (-1, readcharfun);
+ buf[i++] = c = (*readbyte) (-1, readcharfun);
if (c < 0 || ! TRAILING_CODE_P (c))
{
- while (--i > 1)
+ for (i -= c < 0; 0 < --i; )
(*readbyte) (buf[i], readcharfun);
return BYTE8_TO_CHAR (buf[0]);
}
- buf[i++] = c;
}
return STRING_CHAR (buf);
}
@@ -362,8 +373,9 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
if (FROM_FILE_P (readcharfun))
{
block_input (); /* FIXME: Not sure if it's needed. */
- fseek (instream, n, SEEK_CUR);
+ fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
unblock_input ();
+ infile->lookahead = 0;
}
else
{ /* We're not reading directly from a file. In that case, it's difficult
@@ -385,8 +397,9 @@ skip_dyn_eof (Lisp_Object readcharfun)
if (FROM_FILE_P (readcharfun))
{
block_input (); /* FIXME: Not sure if it's needed. */
- fseek (instream, 0, SEEK_END);
+ fseek (infile->stream, 0, SEEK_END);
unblock_input ();
+ infile->lookahead = 0;
}
else
while (READCHAR >= 0);
@@ -459,15 +472,13 @@ readbyte_for_lambda (int c, Lisp_Object readcharfun)
static int
-readbyte_from_file (int c, Lisp_Object readcharfun)
+readbyte_from_stdio (void)
{
- if (c >= 0)
- {
- block_input ();
- ungetc (c, instream);
- unblock_input ();
- return 0;
- }
+ if (infile->lookahead)
+ return infile->buf[--infile->lookahead];
+
+ int c;
+ FILE *instream = infile->stream;
block_input ();
@@ -487,6 +498,19 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
}
static int
+readbyte_from_file (int c, Lisp_Object readcharfun)
+{
+ if (c >= 0)
+ {
+ eassert (infile->lookahead < sizeof infile->buf);
+ infile->buf[infile->lookahead++] = c;
+ return 0;
+ }
+
+ return readbyte_from_stdio ();
+}
+
+static int
readbyte_from_string (int c, Lisp_Object readcharfun)
{
Lisp_Object string = XCAR (readcharfun);
@@ -508,7 +532,7 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
}
-/* Read one non-ASCII character from INSTREAM. The character is
+/* Read one non-ASCII character from INFILE. The character is
encoded in `emacs-mule' and the first byte is already read in
C. */
@@ -530,14 +554,13 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
buf[i++] = c;
while (i < len)
{
- c = (*readbyte) (-1, readcharfun);
+ buf[i++] = c = (*readbyte) (-1, readcharfun);
if (c < 0xA0)
{
- while (--i > 1)
+ for (i -= c < 0; 0 < --i; )
(*readbyte) (buf[i], readcharfun);
return BYTE8_TO_CHAR (buf[0]);
}
- buf[i++] = c;
}
if (len == 2)
@@ -572,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
}
+/* An in-progress substitution of OBJECT for PLACEHOLDER. */
+struct subst
+{
+ Lisp_Object object;
+ Lisp_Object placeholder;
+
+ /* Hash table of subobjects of OBJECT that might be circular. If
+ Qt, all such objects might be circular. */
+ Lisp_Object completed;
+
+ /* List of subobjects of OBJECT that have already been visited. */
+ Lisp_Object seen;
+};
+
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
@@ -580,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool);
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
-static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void substitute_in_interval (INTERVAL, Lisp_Object);
+static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
+static void substitute_in_interval (INTERVAL, void *);
/* Get a character from the tty. */
@@ -779,11 +815,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
doc: /* Don't use this yourself. */)
(void)
{
- register Lisp_Object val;
- block_input ();
- XSETINT (val, getc_unlocked (instream));
- unblock_input ();
- return val;
+ if (!infile)
+ error ("get-file-char misused");
+ return make_number (readbyte_from_stdio ());
}
@@ -1028,6 +1062,15 @@ suffix_p (Lisp_Object string, const char *suffix)
return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
}
+static void
+close_infile_unwind (void *arg)
+{
+ FILE *stream = arg;
+ eassert (infile == NULL || infile->stream == stream);
+ infile = NULL;
+ fclose (stream);
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el', then try
@@ -1347,7 +1390,7 @@ Return t if the file exists and loads successfully. */)
}
if (! stream)
report_file_error ("Opening stdio stream", file);
- set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
+ set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@@ -1370,19 +1413,23 @@ Return t if the file exists and loads successfully. */)
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
- instream = stream;
+ struct infile input;
+ input.stream = stream;
+ input.lookahead = 0;
+ infile = &input;
+
if (lisp_file_lexically_bound_p (Qget_file_char))
Fset (Qlexical_binding, Qt);
if (! version || version >= 22)
- readevalloop (Qget_file_char, stream, hist_file_name,
+ readevalloop (Qget_file_char, &input, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
else
{
/* We can't handle a file which was compiled with
byte-compile-dynamic by older version of Emacs. */
specbind (Qload_force_doc_strings, Qt);
- readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
+ readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
}
unbind_to (count, Qnil);
@@ -1813,7 +1860,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
static void
readevalloop (Lisp_Object readcharfun,
- FILE *stream,
+ struct infile *infile0,
Lisp_Object sourcename,
bool printflag,
Lisp_Object unibyte, Lisp_Object readfun,
@@ -1913,7 +1960,7 @@ readevalloop (Lisp_Object readcharfun,
if (b && first_sexp)
whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
- instream = stream;
+ infile = infile0;
read_next:
c = READCHAR;
if (c == ';')
@@ -2003,7 +2050,7 @@ readevalloop (Lisp_Object readcharfun,
}
build_load_history (sourcename,
- stream || whole_buffer);
+ infile0 || whole_buffer);
unbind_to (count, Qnil);
}
@@ -2629,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
bool uninterned_symbol = false;
bool multibyte;
char stackbuf[MAX_ALLOCA];
+ current_thread->stack_top = stackbuf;
*pch = 0;
@@ -2943,11 +2991,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
saved_doc_string_size = nskip + extra;
}
- saved_doc_string_position = file_tell (instream);
+ FILE *instream = infile->stream;
+ saved_doc_string_position = (file_tell (instream)
+ - infile->lookahead);
- /* Copy that many characters into saved_doc_string. */
+ /* Copy that many bytes into saved_doc_string. */
+ i = 0;
+ for (int n = min (nskip, infile->lookahead); 0 < n; n--)
+ saved_doc_string[i++]
+ = c = infile->buf[--infile->lookahead];
block_input ();
- for (i = 0; i < nskip && c >= 0; i++)
+ for (; i < nskip && 0 <= c; i++)
saved_doc_string[i] = c = getc_unlocked (instream);
unblock_input ();
@@ -3067,7 +3121,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
else
{
- Fsubstitute_object_in_subtree (tem, placeholder);
+ Flread__substitute_object_in_subtree
+ (tem, placeholder, read_objects_completed);
/* ...and #n# will use the real value from now on. */
i = hash_lookup (h, number, &hash);
@@ -3424,6 +3479,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (! NILP (result))
return unbind_to (count, result);
}
+ if (!quoted && multibyte)
+ {
+ int ch = STRING_CHAR ((unsigned char *) read_buffer);
+ switch (ch)
+ {
+ case 0x2018: /* LEFT SINGLE QUOTATION MARK */
+ case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
+ case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
+ case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
+ case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
+ case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
+ case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
+ case 0xFF02: /* FULLWIDTH QUOTATION MARK */
+ case 0xFF07: /* FULLWIDTH APOSTROPHE */
+ xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
+ CALLN (Fstring, make_number (ch)));
+ }
+ }
{
Lisp_Object result;
ptrdiff_t nbytes = p - read_buffer;
@@ -3473,26 +3546,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
}
-
-/* List of nodes we've seen during substitute_object_in_subtree. */
-static Lisp_Object seen_list;
-
-DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
- Ssubstitute_object_in_subtree, 2, 2, 0,
- doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */)
- (Lisp_Object object, Lisp_Object placeholder)
+DEFUN ("lread--substitute-object-in-subtree",
+ Flread__substitute_object_in_subtree,
+ Slread__substitute_object_in_subtree, 3, 3, 0,
+ doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
+COMPLETED is a hash table of objects that might be circular, or is t
+if any object might be circular. */)
+ (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed)
{
- Lisp_Object check_object;
-
- /* We haven't seen any objects when we start. */
- seen_list = Qnil;
-
- /* Make all the substitutions. */
- check_object
- = substitute_object_recurse (object, placeholder, object);
-
- /* Clear seen_list because we're done with it. */
- seen_list = Qnil;
+ struct subst subst = { object, placeholder, completed, Qnil };
+ Lisp_Object check_object = substitute_object_recurse (&subst, object);
/* The returned object here is expected to always eq the
original. */
@@ -3501,26 +3564,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
return Qnil;
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
-#define SUBSTITUTE(get_val, set_val) \
- do { \
- Lisp_Object old_value = get_val; \
- Lisp_Object true_value \
- = substitute_object_recurse (object, placeholder, \
- old_value); \
- \
- if (!EQ (old_value, true_value)) \
- { \
- set_val; \
- } \
- } while (0)
-
static Lisp_Object
-substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
+substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
{
/* If we find the placeholder, return the target object. */
- if (EQ (placeholder, subtree))
- return object;
+ if (EQ (subst->placeholder, subtree))
+ return subst->object;
/* For common object types that can't contain other objects, don't
bother looking them up; we're done. */
@@ -3530,15 +3579,16 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
return subtree;
/* If we've been to this node before, don't explore it again. */
- if (!EQ (Qnil, Fmemq (subtree, seen_list)))
+ if (!EQ (Qnil, Fmemq (subtree, subst->seen)))
return subtree;
/* If this node can be the entry point to a cycle, remember that
we've seen it. It can only be such an entry point if it was made
by #n=, which means that we can find it as a value in
- read_objects_completed. */
- if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0)
- seen_list = Fcons (subtree, seen_list);
+ COMPLETED. */
+ if (EQ (subst->completed, Qt)
+ || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
+ subst->seen = Fcons (subtree, subst->seen);
/* Recurse according to subtree's type.
Every branch must return a Lisp_Object. */
@@ -3565,19 +3615,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
if (SUB_CHAR_TABLE_P (subtree))
i = 2;
for ( ; i < length; i++)
- SUBSTITUTE (AREF (subtree, i),
- ASET (subtree, i, true_value));
+ ASET (subtree, i,
+ substitute_object_recurse (subst, AREF (subtree, i)));
return subtree;
}
case Lisp_Cons:
- {
- SUBSTITUTE (XCAR (subtree),
- XSETCAR (subtree, true_value));
- SUBSTITUTE (XCDR (subtree),
- XSETCDR (subtree, true_value));
- return subtree;
- }
+ XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)));
+ XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)));
+ return subtree;
case Lisp_String:
{
@@ -3585,11 +3631,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
substitute_in_interval contains part of the logic. */
INTERVAL root_interval = string_intervals (subtree);
- AUTO_CONS (arg, object, placeholder);
-
traverse_intervals_noorder (root_interval,
- &substitute_in_interval, arg);
-
+ substitute_in_interval, subst);
return subtree;
}
@@ -3601,12 +3644,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
/* Helper function for substitute_object_recurse. */
static void
-substitute_in_interval (INTERVAL interval, Lisp_Object arg)
+substitute_in_interval (INTERVAL interval, void *arg)
{
- Lisp_Object object = Fcar (arg);
- Lisp_Object placeholder = Fcdr (arg);
-
- SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
+ set_interval_plist (interval,
+ substitute_object_recurse (arg, interval->plist));
}
@@ -4704,7 +4745,7 @@ syms_of_lread (void)
{
defsubr (&Sread);
defsubr (&Sread_from_string);
- defsubr (&Ssubstitute_object_in_subtree);
+ defsubr (&Slread__substitute_object_in_subtree);
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sunintern);
@@ -5017,8 +5058,6 @@ that are loaded before your customizations are read! */);
read_objects_map = Qnil;
staticpro (&read_objects_completed);
read_objects_completed = Qnil;
- staticpro (&seen_list);
- seen_list = Qnil;
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
diff --git a/src/nsfns.m b/src/nsfns.m
index 68eba8b6a2e..36748cebb8b 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -3080,6 +3080,25 @@ The coordinates X and Y are interpreted in pixels relative to a position
return Qnil;
}
+DEFUN ("ns-mouse-absolute-pixel-position",
+ Fns_mouse_absolute_pixel_position,
+ Sns_mouse_absolute_pixel_position, 0, 0, 0,
+ doc: /* Return absolute position of mouse cursor in pixels.
+The position is returned as a cons cell (X . Y) of the
+coordinates of the mouse cursor position in pixels relative to a
+position (0, 0) of the selected frame's terminal. */)
+ (void)
+{
+ struct frame *f = SELECTED_FRAME ();
+ EmacsView *view = FRAME_NS_VIEW (f);
+ NSScreen *screen = [[view window] screen];
+ NSPoint pt = [NSEvent mouseLocation];
+
+ return Fcons(make_number(pt.x - screen.frame.origin.x),
+ make_number(screen.frame.size.height -
+ (pt.y - screen.frame.origin.y)));
+}
+
/* ==========================================================================
Class implementations
@@ -3269,6 +3288,7 @@ be used as the image of the icon representing the frame. */);
defsubr (&Sns_frame_list_z_order);
defsubr (&Sns_frame_restack);
defsubr (&Sns_set_mouse_absolute_pixel_position);
+ defsubr (&Sns_mouse_absolute_pixel_position);
defsubr (&Sx_display_mm_width);
defsubr (&Sx_display_mm_height);
defsubr (&Sx_display_screens);
diff --git a/src/nsterm.m b/src/nsterm.m
index bf83550b3d7..36d906a7cec 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1570,6 +1570,7 @@ x_make_frame_visible (struct frame *f)
if (!FRAME_VISIBLE_P (f))
{
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *window = [view window];
SET_FRAME_VISIBLE (f, 1);
ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1586,6 +1587,23 @@ x_make_frame_visible (struct frame *f)
[view handleFS];
unblock_input ();
}
+
+ /* Making a frame invisible seems to break the parent->child
+ relationship, so reinstate it. */
+ if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL)
+ {
+ NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
+
+ block_input ();
+ [parent addChildWindow: window
+ ordered: NSWindowAbove];
+ unblock_input ();
+
+ /* If the parent frame moved while the child frame was
+ invisible, the child frame's position won't have been
+ updated. Make sure it's in the right place now. */
+ x_set_offset(f, f->left_pos, f->top_pos, 0);
+ }
}
}
@@ -5479,6 +5497,19 @@ ns_term_shutdown (int sig)
object:nil];
#endif
+#ifdef NS_IMPL_COCOA
+ if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) {
+ /* Set the app's activation policy to regular when we run outside
+ of a bundle. This is already done for us by Info.plist when we
+ run inside a bundle. */
+ [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular];
+ [NSApp setApplicationIconImage:
+ [EmacsImage
+ allocInitFromFile:
+ build_string("icons/hicolor/128x128/apps/emacs.png")]];
+ }
+#endif
+
ns_send_appdefined (-2);
}
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)
static void print (Lisp_Object, Lisp_Object, bool);
static void print_preprocess (Lisp_Object);
-static void print_preprocess_string (INTERVAL, Lisp_Object);
+static void print_preprocess_string (INTERVAL, void *);
static void print_object (Lisp_Object, Lisp_Object, bool);
DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
@@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj)
case Lisp_String:
/* A string may have text properties, which can be circular. */
traverse_intervals_noorder (string_intervals (obj),
- print_preprocess_string, Qnil);
+ print_preprocess_string, NULL);
break;
case Lisp_Cons:
@@ -1263,7 +1263,7 @@ Fills `print-number-table'. */)
}
static void
-print_preprocess_string (INTERVAL interval, Lisp_Object arg)
+print_preprocess_string (INTERVAL interval, void *arg)
{
print_preprocess (interval->plist);
}
@@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
40))];
-
+ current_thread->stack_top = buf;
maybe_quit ();
/* Detect circularities and truncate them. */
diff --git a/src/process.c b/src/process.c
index abd017bb907..19009515336 100644
--- a/src/process.c
+++ b/src/process.c
@@ -951,7 +951,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
if (PROCESSP (name))
return name;
CHECK_STRING (name);
- return Fcdr (Fassoc (name, Vprocess_alist));
+ return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
}
/* This is how commands for the user decode process arguments. It
diff --git a/src/sysdep.c b/src/sysdep.c
index b52236769e0..db99f53299c 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1772,7 +1772,7 @@ stack_overflow (siginfo_t *siginfo)
/* The known top and bottom of the stack. The actual stack may
extend a bit beyond these boundaries. */
char *bot = stack_bottom;
- char *top = near_C_stack_top ();
+ char *top = current_thread->stack_top;
/* Log base 2 of the stack heuristic ratio. This ratio is the size
of the known stack divided by the size of the guard area past the
diff --git a/src/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)
{
int absolute_x = (it->current_x
+ it->continuation_lines_width);
+ int x0 = absolute_x;
+ /* Adjust for line numbers. */
+ if (!NILP (Vdisplay_line_numbers))
+ absolute_x -= it->lnum_pixel_width;
int next_tab_x
= (((1 + absolute_x + it->tab_width - 1)
/ it->tab_width)
* it->tab_width);
+ if (!NILP (Vdisplay_line_numbers))
+ next_tab_x += it->lnum_pixel_width;
int nspaces;
/* If part of the TAB has been displayed on the previous line
@@ -1596,7 +1602,7 @@ produce_glyphs (struct it *it)
been incremented already by the part that fitted on the
continued line. So, we will get the right number of spaces
here. */
- nspaces = next_tab_x - absolute_x;
+ nspaces = next_tab_x - x0;
if (it->glyph_row)
{
diff --git a/src/thread.c b/src/thread.c
index e3787971a53..1f7ced386d3 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -595,14 +595,15 @@ thread_select (select_func *func, int max_fds, fd_set *rfds,
static void
mark_one_thread (struct thread_state *thread)
{
- struct handler *handler;
- Lisp_Object tem;
+ /* Get the stack top now, in case mark_specpdl changes it. */
+ void *stack_top = thread->stack_top;
mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
- mark_stack (thread->m_stack_bottom, thread->stack_top);
+ mark_stack (thread->m_stack_bottom, stack_top);
- for (handler = thread->m_handlerlist; handler; handler = handler->next)
+ for (struct handler *handler = thread->m_handlerlist;
+ handler; handler = handler->next)
{
mark_object (handler->tag_or_ch);
mark_object (handler->val);
@@ -610,6 +611,7 @@ mark_one_thread (struct thread_state *thread)
if (thread->m_current_buffer)
{
+ Lisp_Object tem;
XSETBUFFER (tem, thread->m_current_buffer);
mark_object (tem);
}
diff --git a/src/thread.h b/src/thread.h
index 9e94de5c175..52b16f1ba83 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -62,8 +62,14 @@ struct thread_state
char *m_stack_bottom;
#define stack_bottom (current_thread->m_stack_bottom)
- /* An address near the top of the stack. */
- char *stack_top;
+ /* The address of an object near the C stack top, used to determine
+ which words need to be scanned by the garbage collector. This is
+ also used to detect heuristically whether segmentation violation
+ address indicates stack overflow, as opposed to some internal
+ error in Emacs. If the C function F calls G which calls H which
+ calls ... F, then at least one of the functions in the chain
+ should set this to the address of a local variable. */
+ void *stack_top;
struct catchtag *m_catchlist;
#define catchlist (current_thread->m_catchlist)
diff --git a/src/w32fns.c b/src/w32fns.c
index b0842b5ee6c..457599fce0e 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -467,7 +467,7 @@ if the entry is new. */)
block_input ();
/* replace existing entry in w32-color-map or add new entry. */
- entry = Fassoc (name, Vw32_color_map);
+ entry = Fassoc (name, Vw32_color_map, Qnil);
if (NILP (entry))
{
entry = Fcons (name, rgb);
diff --git a/src/w32font.c b/src/w32font.c
index 67d2f6d666d..314d7acdcc6 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1627,7 +1627,7 @@ x_to_w32_charset (char * lpcs)
Format of each entry is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
*/
- this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
+ this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
if (NILP (this_entry))
{
diff --git a/src/w32notify.c b/src/w32notify.c
index 25205816bae..e8bdef8bdd3 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -642,7 +642,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */)
/* Remove the watch object from watch list. Do this before freeing
the object, do that even if we fail to free it, watch_list is
kept free of junk. */
- watch_object = Fassoc (watch_descriptor, watch_list);
+ watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{
watch_list = Fdelete (watch_object, watch_list);
@@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the
watch by calling `w32notify-rm-watch' also makes it invalid. */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
+ Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{
diff --git a/src/w32proc.c b/src/w32proc.c
index 0aa248a6f7b..76af55f9985 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1622,38 +1622,43 @@ w32_executable_type (char * filename,
/* Look for Cygwin DLL in the DLL import list. */
IMAGE_DATA_DIRECTORY import_dir =
data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
- IMAGE_IMPORT_DESCRIPTOR * imports =
- RVA_TO_PTR (import_dir.VirtualAddress,
- rva_to_section (import_dir.VirtualAddress,
- nt_header),
- executable);
- for ( ; imports->Name; imports++)
- {
- IMAGE_SECTION_HEADER * section =
- rva_to_section (imports->Name, nt_header);
- char * dllname = RVA_TO_PTR (imports->Name, section,
- executable);
-
- /* The exact name of the Cygwin DLL has changed with
- various releases, but hopefully this will be
- reasonably future-proof. */
- if (strncmp (dllname, "cygwin", 6) == 0)
- {
- *is_cygnus_app = TRUE;
- break;
- }
- else if (strncmp (dllname, "msys-", 5) == 0)
+ /* Import directory can be missing in .NET DLLs. */
+ if (import_dir.VirtualAddress != 0)
+ {
+ IMAGE_IMPORT_DESCRIPTOR * imports =
+ RVA_TO_PTR (import_dir.VirtualAddress,
+ rva_to_section (import_dir.VirtualAddress,
+ nt_header),
+ executable);
+
+ for ( ; imports->Name; imports++)
{
- /* This catches both MSYS 1.x and MSYS2
- executables (the DLL name is msys-1.0.dll and
- msys-2.0.dll, respectively). There doesn't
- seem to be a reason to distinguish between
- the two, for now. */
- *is_msys_app = TRUE;
- break;
+ IMAGE_SECTION_HEADER * section =
+ rva_to_section (imports->Name, nt_header);
+ char * dllname = RVA_TO_PTR (imports->Name, section,
+ executable);
+
+ /* The exact name of the Cygwin DLL has changed with
+ various releases, but hopefully this will be
+ reasonably future-proof. */
+ if (strncmp (dllname, "cygwin", 6) == 0)
+ {
+ *is_cygnus_app = TRUE;
+ break;
+ }
+ else if (strncmp (dllname, "msys-", 5) == 0)
+ {
+ /* This catches both MSYS 1.x and MSYS2
+ executables (the DLL name is msys-1.0.dll and
+ msys-2.0.dll, respectively). There doesn't
+ seem to be a reason to distinguish between
+ the two, for now. */
+ *is_msys_app = TRUE;
+ break;
+ }
}
- }
+ }
}
}
}
diff --git a/src/w32term.c b/src/w32term.c
index c37805cb6ca..0f7bb9337f6 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -6110,7 +6110,7 @@ x_calc_absolute_position (struct frame *f)
list = CDR(list);
- geometry = Fassoc (Qgeometry, attributes);
+ geometry = Fassoc (Qgeometry, attributes, Qnil);
if (!NILP (geometry))
{
monitor_left = Fnth (make_number (1), geometry);
diff --git a/src/xdisp.c b/src/xdisp.c
index 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/>. */
#include <stdio.h>
#include <stdlib.h>
#include <limits.h>
+#include <math.h>
#include "lisp.h"
#include "atimer.h"
@@ -324,7 +325,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#endif
-#define INFINITY 10000000
+#define DISP_INFINITY 10000000
/* Holds the list (error). */
static Lisp_Object list_of_error;
@@ -832,6 +833,8 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool);
static bool update_menu_bar (struct frame *, bool, bool);
static bool try_window_reusing_current_matrix (struct window *);
static int try_window_id (struct window *);
+static void maybe_produce_line_number (struct it *);
+static bool should_produce_line_number (struct it *);
static bool display_line (struct it *, int);
static int display_mode_lines (struct window *);
static int display_mode_line (struct window *, enum face_id, Lisp_Object);
@@ -843,6 +846,8 @@ static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t *);
+static void pint2str (register char *, register int, register ptrdiff_t);
+
static int display_string (const char *, Lisp_Object, Lisp_Object,
ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int);
static void compute_line_metrics (struct it *);
@@ -1321,6 +1326,15 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
if (charpos >= 0 && CHARPOS (top) > charpos)
return visible_p;
+ /* Some Lisp hook could call us in the middle of redisplaying this
+ very window. If, by some bad luck, we are retrying redisplay
+ because we found that the mode-line height and/or header-line
+ height needs to be updated, the assignment of mode_line_height
+ and header_line_height below could disrupt that, due to the
+ selected/nonselected window dance during mode-line display, and
+ we could infloop. Avoid that. */
+ int prev_mode_line_height = w->mode_line_height;
+ int prev_header_line_height = w->header_line_height;
/* Compute exact mode line heights. */
if (window_wants_mode_line (w))
{
@@ -1667,6 +1681,10 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll);
#endif
+ /* Restore potentially overwritten values. */
+ w->mode_line_height = prev_mode_line_height;
+ w->header_line_height = prev_header_line_height;
+
return visible_p;
}
@@ -6764,7 +6782,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
FIELD_WIDTH < 0 means infinite field width. This is useful for
padding with `-' at the end of a mode line. */
if (field_width < 0)
- field_width = INFINITY;
+ field_width = DISP_INFINITY;
/* Implementation note: We deliberately don't enlarge
it->bidi_it.string.schars here to fit it->end_charpos, because
the bidi iterator cannot produce characters out of thin air. */
@@ -8613,6 +8631,7 @@ move_it_in_display_line_to (struct it *it,
ptrdiff_t closest_pos UNINIT;
ptrdiff_t prev_pos = IT_CHARPOS (*it);
bool saw_smaller_pos = prev_pos < to_charpos;
+ bool line_number_pending = false;
/* Don't produce glyphs in produce_glyphs. */
saved_glyph_row = it->glyph_row;
@@ -8661,9 +8680,20 @@ move_it_in_display_line_to (struct it *it,
|| (it->method == GET_FROM_DISPLAY_VECTOR \
&& it->dpvec + it->current.dpvec_index + 1 >= it->dpend)))
- /* If there's a line-/wrap-prefix, handle it. */
- if (it->hpos == 0 && it->method == GET_FROM_BUFFER)
- handle_line_prefix (it);
+ if (it->hpos == 0)
+ {
+ /* If line numbers are being displayed, produce a line number. */
+ if (should_produce_line_number (it))
+ {
+ if (it->current_x == it->first_visible_x)
+ maybe_produce_line_number (it);
+ else
+ line_number_pending = true;
+ }
+ /* If there's a line-/wrap-prefix, handle it. */
+ if (it->method == GET_FROM_BUFFER)
+ handle_line_prefix (it);
+ }
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
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,
if (new_x > it->first_visible_x)
{
+ /* If we have reached the visible portion of the
+ screen line, produce the line number if needed. */
+ if (line_number_pending)
+ {
+ line_number_pending = false;
+ it->current_x = it->first_visible_x;
+ maybe_produce_line_number (it);
+ it->current_x += new_x - it->first_visible_x;
+ }
/* Glyph is visible. Increment number of glyphs that
would be displayed. */
++it->hpos;
@@ -13069,6 +13108,43 @@ hscroll_window_tree (Lisp_Object window)
}
bool row_r2l_p = cursor_row->reversed_p;
bool hscl = hscrolling_current_line_p (w);
+ int x_offset = 0;
+ /* When line numbers are displayed, we need to account for
+ the horizontal space they consume. */
+ if (!NILP (Vdisplay_line_numbers))
+ {
+ struct glyph *g;
+ if (!row_r2l_p)
+ {
+ for (g = cursor_row->glyphs[TEXT_AREA];
+ g < cursor_row->glyphs[TEXT_AREA]
+ + cursor_row->used[TEXT_AREA];
+ g++)
+ {
+ if (!(NILP (g->object) && g->charpos < 0))
+ break;
+ x_offset += g->pixel_width;
+ }
+ }
+ else
+ {
+ for (g = cursor_row->glyphs[TEXT_AREA]
+ + cursor_row->used[TEXT_AREA];
+ g > cursor_row->glyphs[TEXT_AREA];
+ g--)
+ {
+ if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0))
+ break;
+ x_offset += (g - 1)->pixel_width;
+ }
+ }
+ }
+ if (cursor_row->truncated_on_left_p)
+ {
+ /* On TTY frames, don't count the left truncation glyph. */
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f));
+ }
text_area_width = window_box_width (w, TEXT_AREA);
@@ -13101,7 +13177,7 @@ hscroll_window_tree (Lisp_Object window)
inside the left margin and the window is already
hscrolled. */
&& ((!row_r2l_p
- && ((w->hscroll && w->cursor.x <= h_margin)
+ && ((w->hscroll && w->cursor.x <= h_margin + x_offset)
|| (cursor_row->enabled_p
&& cursor_row->truncated_on_right_p
&& (w->cursor.x >= text_area_width - h_margin))))
@@ -13119,7 +13195,8 @@ hscroll_window_tree (Lisp_Object window)
&& cursor_row->truncated_on_right_p
&& w->cursor.x <= h_margin)
|| (w->hscroll
- && (w->cursor.x >= text_area_width - h_margin))))
+ && (w->cursor.x >= (text_area_width - h_margin
+ - x_offset)))))
/* This last condition is needed when moving
vertically from an hscrolled line to a short line
that doesn't need to be hscrolled. If we omit
@@ -13150,7 +13227,7 @@ hscroll_window_tree (Lisp_Object window)
if (hscl)
it.first_visible_x = window_hscroll_limited (w, it.f)
* FRAME_COLUMN_WIDTH (it.f);
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS);
/* If the line ends in an overlay string with a newline,
we might infloop, because displaying the window will
@@ -14796,15 +14873,12 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
while (glyph > end + 1
&& NILP (glyph->object)
&& glyph->charpos < 0)
- {
- --glyph;
- x -= glyph->pixel_width;
- }
+ --glyph;
if (NILP (glyph->object) && glyph->charpos < 0)
--glyph;
/* By default, in reversed rows we put the cursor on the
rightmost (first in the reading order) glyph. */
- for (g = end + 1; g < glyph; g++)
+ for (x = 0, g = end + 1; g < glyph; g++)
x += g->pixel_width;
while (end < glyph
&& NILP ((end + 1)->object)
@@ -15835,7 +15909,7 @@ compute_window_start_on_continuation_line (struct window *w)
So, we're looking for the display line start with the
minimum distance from the old window start. */
pos_before_pt = pos = it.current.pos;
- min_distance = INFINITY;
+ min_distance = DISP_INFINITY;
while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))),
distance < min_distance)
{
@@ -15941,6 +16015,17 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
&& !windows_or_buffers_changed
&& !f->cursor_type_changed
&& NILP (Vshow_trailing_whitespace)
+ /* When display-line-numbers is in relative mode, moving point
+ requires to redraw the entire window. */
+ && !EQ (Vdisplay_line_numbers, Qrelative)
+ && !EQ (Vdisplay_line_numbers, Qvisual)
+ /* When the current line number should be displayed in a
+ distinct face, moving point cannot be handled in optimized
+ way as below. */
+ && !(!NILP (Vdisplay_line_numbers)
+ && NILP (Finternal_lisp_face_equal_p (Qline_number,
+ Qline_number_current_line,
+ w->frame)))
/* This code is not used for mini-buffer for the sake of the case
of redisplaying to replace an echo area message; since in
that case the mini-buffer contents per se are usually
@@ -16788,10 +16873,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
XBUFFER (w->contents)->text->redisplay = false;
safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil));
- if (w->redisplay || XBUFFER (w->contents)->text->redisplay)
+ if (w->redisplay || XBUFFER (w->contents)->text->redisplay
+ || ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual))
+ && row != MATRIX_FIRST_TEXT_ROW (w->desired_matrix)))
{
- /* pre-redisplay-function made changes (e.g. move the region)
- that require another round of redisplay. */
+ /* Either pre-redisplay-function made changes (e.g. move
+ the region), or we moved point in a window that is
+ under display-line-numbers = relative mode. We need
+ another round of redisplay. */
clear_glyph_matrix (w->desired_matrix);
if (!try_window (window, startp, 0))
goto need_larger_matrices;
@@ -17592,15 +17682,21 @@ try_window_reusing_current_matrix (struct window *w)
if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row))
return false;
+ /* Clear the desired matrix for the display below. */
+ clear_glyph_matrix (w->desired_matrix);
+
+ /* Give up if line numbers are being displayed, because reusing the
+ current matrix might use the wrong width for line-number
+ display. */
+ if (!NILP (Vdisplay_line_numbers))
+ return false;
+
/* The variable new_start now holds the new window start. The old
start `start' can be determined from the current matrix. */
SET_TEXT_POS_FROM_MARKER (new_start, w->start);
start = start_row->minpos;
start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix);
- /* Clear the desired matrix for the display below. */
- clear_glyph_matrix (w->desired_matrix);
-
if (CHARPOS (new_start) <= CHARPOS (start))
{
/* Don't use this method if the display starts with an ellipsis
@@ -18423,6 +18519,16 @@ try_window_id (struct window *w)
if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing)))
GIVE_UP (23);
+ /* Give up if display-line-numbers is in relative mode, or when the
+ current line's number needs to be displayed in a distinct face. */
+ if (EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)
+ || (!NILP (Vdisplay_line_numbers)
+ && NILP (Finternal_lisp_face_equal_p (Qline_number,
+ Qline_number_current_line,
+ w->frame))))
+ GIVE_UP (24);
+
/* Make sure beg_unchanged and end_unchanged are up to date. Do it
only if buffer has really changed. The reason is that the gap is
initially at Z for freshly visited files. The code below would
@@ -19070,7 +19176,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
|| glyph->type == GLYPHLESS_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
(glyph->type == CHAR_GLYPH
? 'C'
@@ -19095,7 +19201,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == STRETCH_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'S',
glyph->charpos,
@@ -19116,7 +19222,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == IMAGE_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'I',
glyph->charpos,
@@ -19137,7 +19243,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == COMPOSITE_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x",
glyph - row->glyphs[TEXT_AREA],
'+',
glyph->charpos,
@@ -19198,7 +19304,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n");
fprintf (stderr, "==============================================================================\n");
- fprintf (stderr, "%3d %9"pI"d %9"pI"d %4d %1.1d%1.1d%1.1d%1.1d\
+ fprintf (stderr, "%3d %9"pD"d %9"pD"d %4d %1.1d%1.1d%1.1d%1.1d\
%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n",
vpos,
MATRIX_ROW_START_CHARPOS (row),
@@ -19227,7 +19333,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
fprintf (stderr, " %9"pD"d %9"pD"d\t%5d\n", row->start.overlay_string_index,
row->end.overlay_string_index,
row->continuation_lines_width);
- fprintf (stderr, " %9"pI"d %9"pI"d\n",
+ fprintf (stderr, " %9"pD"d %9"pD"d\n",
CHARPOS (row->start.string_pos),
CHARPOS (row->end.string_pos));
fprintf (stderr, " %9d %9d\n", row->start.dpvec_index,
@@ -19304,7 +19410,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */)
struct window *w = XWINDOW (selected_window);
struct buffer *buffer = XBUFFER (w->contents);
- fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n",
+ fprintf (stderr, "PT = %"pD"d, BEGV = %"pD"d. ZV = %"pD"d\n",
BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer));
fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n",
w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
@@ -20669,6 +20775,366 @@ find_row_edges (struct it *it, struct glyph_row *row,
row->maxpos = it->current.pos;
}
+/* Like display_count_lines, but capable of counting outside of the
+ current narrowed region. */
+static ptrdiff_t
+display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte,
+ ptrdiff_t count, ptrdiff_t *byte_pos_ptr)
+{
+ if (!display_line_numbers_widen || (BEGV == BEG && ZV == Z))
+ return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
+
+ ptrdiff_t val;
+ ptrdiff_t pdl_count = SPECPDL_INDEX ();
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+ Fwiden ();
+ val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
+ unbind_to (pdl_count, Qnil);
+ return val;
+}
+
+/* Count the number of screen lines in window IT->w between character
+ position IT_CHARPOS(*IT) and the line showing that window's point. */
+static ptrdiff_t
+display_count_lines_visually (struct it *it)
+{
+ struct it tem_it;
+ ptrdiff_t to;
+ struct text_pos from;
+
+ /* If we already calculated a relative line number, use that. This
+ trick relies on the fact that visual lines (a.k.a. "glyph rows")
+ are laid out sequentially, one by one, for each sequence of calls
+ to display_line or other similar function that follows a call to
+ init_iterator. */
+ if (it->lnum_bytepos > 0)
+ return it->lnum + 1;
+ else
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ if (IT_CHARPOS (*it) <= PT)
+ {
+ from = it->current.pos;
+ to = PT;
+ }
+ else
+ {
+ SET_TEXT_POS (from, PT, PT_BYTE);
+ to = IT_CHARPOS (*it);
+ }
+ start_display (&tem_it, it->w, from);
+ /* Need to disable visual mode temporarily, since otherwise the
+ call to move_it_to will cause infinite recursion. */
+ specbind (Qdisplay_line_numbers, Qrelative);
+ /* Some redisplay optimizations could invoke us very far from
+ PT, which will make the caller painfully slow. There should
+ be no need to go too far beyond the window's bottom, as any
+ such optimization will fail to show point anyway. */
+ move_it_to (&tem_it, to, -1,
+ tem_it.last_visible_y
+ + (SCROLL_LIMIT + 10) * FRAME_LINE_HEIGHT (tem_it.f),
+ -1, MOVE_TO_POS | MOVE_TO_Y);
+ unbind_to (count, Qnil);
+ return IT_CHARPOS (*it) <= PT ? -tem_it.vpos : tem_it.vpos;
+ }
+}
+
+/* Produce the line-number glyphs for the current glyph_row. If
+ IT->glyph_row is non-NULL, populate the row with the produced
+ glyphs. */
+static void
+maybe_produce_line_number (struct it *it)
+{
+ ptrdiff_t last_line = it->lnum;
+ ptrdiff_t start_from, bytepos;
+ ptrdiff_t this_line;
+ bool first_time = false;
+ ptrdiff_t beg_byte = display_line_numbers_widen ? BEG_BYTE : BEGV_BYTE;
+ ptrdiff_t z_byte = display_line_numbers_widen ? Z_BYTE : ZV_BYTE;
+ void *itdata = bidi_shelve_cache ();
+
+ if (EQ (Vdisplay_line_numbers, Qvisual))
+ this_line = display_count_lines_visually (it);
+ else
+ {
+ if (!last_line)
+ {
+ /* If possible, reuse data cached by line-number-mode. */
+ if (it->w->base_line_number > 0
+ && it->w->base_line_pos > 0
+ && it->w->base_line_pos <= IT_CHARPOS (*it)
+ /* line-number-mode always displays narrowed line
+ numbers, so we cannot use its data if the user wants
+ line numbers that disregard narrowing. */
+ && !(display_line_numbers_widen
+ && (BEG_BYTE != BEGV_BYTE || Z_BYTE != ZV_BYTE)))
+ {
+ start_from = CHAR_TO_BYTE (it->w->base_line_pos);
+ last_line = it->w->base_line_number - 1;
+ }
+ else
+ start_from = beg_byte;
+ if (!it->lnum_bytepos)
+ first_time = true;
+ }
+ else
+ start_from = it->lnum_bytepos;
+
+ /* Paranoia: what if someone changes the narrowing since the
+ last time display_line was called? Shouldn't really happen,
+ but who knows what some crazy Lisp invoked by :eval could do? */
+ if (!(beg_byte <= start_from && start_from <= z_byte))
+ {
+ last_line = 0;
+ start_from = beg_byte;
+ }
+
+ this_line =
+ last_line + display_count_lines_logically (start_from,
+ IT_BYTEPOS (*it),
+ IT_CHARPOS (*it), &bytepos);
+ eassert (this_line > 0 || (this_line == 0 && start_from == beg_byte));
+ eassert (bytepos == IT_BYTEPOS (*it));
+ }
+
+ /* Record the line number information. */
+ if (this_line != last_line || !it->lnum_bytepos)
+ {
+ it->lnum = this_line;
+ it->lnum_bytepos = IT_BYTEPOS (*it);
+ }
+
+ /* Produce the glyphs for the line number. */
+ struct it tem_it;
+ char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1];
+ bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false;
+ ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */
+ int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID);
+ int current_lnum_face_id
+ = merge_faces (it->f, Qline_number_current_line, 0, DEFAULT_FACE_ID);
+ /* Compute point's line number if needed. */
+ if ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)
+ || lnum_face_id != current_lnum_face_id)
+ && !it->pt_lnum)
+ {
+ ptrdiff_t ignored;
+ if (PT_BYTE > it->lnum_bytepos && !EQ (Vdisplay_line_numbers, Qvisual))
+ it->pt_lnum =
+ this_line + display_count_lines_logically (it->lnum_bytepos, PT_BYTE,
+ PT, &ignored);
+ else
+ it->pt_lnum = display_count_lines_logically (beg_byte, PT_BYTE, PT,
+ &ignored);
+ }
+ /* Compute the required width if needed. */
+ if (!it->lnum_width)
+ {
+ if (NATNUMP (Vdisplay_line_numbers_width))
+ it->lnum_width = XFASTINT (Vdisplay_line_numbers_width);
+
+ /* Max line number to be displayed cannot be more than the one
+ corresponding to the last row of the desired matrix. */
+ ptrdiff_t max_lnum;
+
+ if (NILP (Vdisplay_line_numbers_current_absolute)
+ && (EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)))
+ /* We subtract one more because the current line is always
+ zero in this mode. */
+ max_lnum = it->w->desired_matrix->nrows - 2;
+ else if (EQ (Vdisplay_line_numbers, Qvisual))
+ max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1;
+ else
+ max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos;
+ max_lnum = max (1, max_lnum);
+ it->lnum_width = max (it->lnum_width, log10 (max_lnum) + 1);
+ eassert (it->lnum_width > 0);
+ }
+ if (EQ (Vdisplay_line_numbers, Qrelative))
+ lnum_offset = it->pt_lnum;
+ else if (EQ (Vdisplay_line_numbers, Qvisual))
+ lnum_offset = 0;
+
+ /* Under 'relative', display the absolute line number for the
+ current line, unless the user requests otherwise. */
+ ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset);
+ if ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual))
+ && lnum_to_display == 0
+ && !NILP (Vdisplay_line_numbers_current_absolute))
+ lnum_to_display = it->pt_lnum + 1;
+ /* In L2R rows we need to append the blank separator, in R2L
+ rows we need to prepend it. But this function is usually
+ called when no display elements were produced from the
+ following line, so the paragraph direction might be unknown.
+ Therefore we cheat and add 2 blanks, one on either side. */
+ pint2str (lnum_buf, it->lnum_width + 1, lnum_to_display);
+ strcat (lnum_buf, " ");
+
+ /* Setup for producing the glyphs. */
+ init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row,
+ /* FIXME: Use specialized face. */
+ DEFAULT_FACE_ID);
+ scratch_glyph_row.reversed_p = false;
+ scratch_glyph_row.used[TEXT_AREA] = 0;
+ SET_TEXT_POS (tem_it.position, 0, 0);
+ tem_it.avoid_cursor_p = true;
+ tem_it.bidi_p = true;
+ tem_it.bidi_it.type = WEAK_EN;
+ /* According to UAX#9, EN goes up 2 levels in L2R paragraph and
+ 1 level in R2L paragraphs. Emulate that, assuming we are in
+ an L2R paragraph. */
+ tem_it.bidi_it.resolved_level = 2;
+
+ /* Produce glyphs for the line number in a scratch glyph_row. */
+ int n_glyphs_before;
+ for (const char *p = lnum_buf; *p; p++)
+ {
+ /* For continuation lines and lines after ZV, instead of a line
+ number, produce a blank prefix of the same width. Use the
+ default face for the blank field beyond ZV. */
+ if (beyond_zv)
+ tem_it.face_id = it->base_face_id;
+ else if (lnum_face_id != current_lnum_face_id
+ && (EQ (Vdisplay_line_numbers, Qvisual)
+ ? this_line == 0
+ : this_line == it->pt_lnum))
+ tem_it.face_id = current_lnum_face_id;
+ else
+ tem_it.face_id = lnum_face_id;
+ if (beyond_zv
+ /* Don't display the same line number more than once. */
+ || (!EQ (Vdisplay_line_numbers, Qvisual)
+ && (it->continuation_lines_width > 0
+ || (this_line == last_line && !first_time))))
+ tem_it.c = tem_it.char_to_display = ' ';
+ else
+ tem_it.c = tem_it.char_to_display = *p;
+ tem_it.len = 1;
+ n_glyphs_before = scratch_glyph_row.used[TEXT_AREA];
+ /* Make sure these glyphs will have a "position" of -1. */
+ SET_TEXT_POS (tem_it.position, -1, -1);
+ PRODUCE_GLYPHS (&tem_it);
+
+ /* Stop producing glyphs if we don't have enough space on
+ this line. FIXME: should we refrain from producing the
+ line number at all in that case? */
+ if (tem_it.current_x > tem_it.last_visible_x)
+ {
+ scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before;
+ break;
+ }
+ }
+
+ /* Record the width in pixels we need for the line number display. */
+ it->lnum_pixel_width = tem_it.current_x;
+ /* Copy the produced glyphs into IT's glyph_row. */
+ struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA];
+ struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA];
+ struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL;
+ short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL;
+
+ eassert (it->glyph_row == NULL || it->glyph_row->used[TEXT_AREA] == 0);
+
+ for ( ; g < e; g++)
+ {
+ it->current_x += g->pixel_width;
+ /* The following is important when this function is called
+ from move_it_in_display_line_to: HPOS is incremented only
+ when we are in the visible portion of the glyph row. */
+ if (it->current_x > it->first_visible_x)
+ it->hpos++;
+ if (p)
+ {
+ *p++ = *g;
+ (*u)++;
+ }
+ }
+
+ /* Update IT's metrics due to glyphs produced for line numbers. */
+ if (it->glyph_row)
+ {
+ struct glyph_row *row = it->glyph_row;
+
+ it->max_ascent = max (row->ascent, tem_it.max_ascent);
+ it->max_descent = max (row->height - row->ascent, tem_it.max_descent);
+ it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent);
+ it->max_phys_descent = max (row->phys_height - row->phys_ascent,
+ tem_it.max_phys_descent);
+ }
+ else
+ {
+ it->max_ascent = max (it->max_ascent, tem_it.max_ascent);
+ it->max_descent = max (it->max_descent, tem_it.max_descent);
+ it->max_phys_ascent = max (it->max_phys_ascent, tem_it.max_phys_ascent);
+ it->max_phys_descent = max (it->max_phys_descent, tem_it.max_phys_descent);
+ }
+
+ bidi_unshelve_cache (itdata, false);
+}
+
+/* Return true if this glyph row needs a line number to be produced
+ for it. */
+static bool
+should_produce_line_number (struct it *it)
+{
+ if (NILP (Vdisplay_line_numbers))
+ return false;
+
+ /* Don't display line numbers in minibuffer windows. */
+ if (MINI_WINDOW_P (it->w))
+ return false;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Don't display line number in tooltip frames. */
+ if (FRAMEP (tip_frame) && EQ (WINDOW_FRAME (it->w), tip_frame))
+ return false;
+#endif
+
+ /* If the character at current position has a non-nil special
+ property, disable line numbers for this row. This is for
+ packages such as company-mode, which need this for their tricky
+ layout, where line numbers get in the way. */
+ Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)),
+ Qdisplay_line_numbers_disable,
+ it->window);
+ /* For ZV, we need to also look in empty overlays at that point,
+ because get-char-property always returns nil for ZV, except if
+ the property is in 'default-text-properties'. */
+ if (NILP (val) && IT_CHARPOS (*it) >= ZV)
+ val = disable_line_numbers_overlay_at_eob ();
+ return NILP (val) ? true : false;
+}
+
+/* Return true if ROW has no glyphs except those inserted by the
+ display engine. This is needed for indicate-empty-lines and
+ similar features when the glyph row starts with glyphs which didn't
+ come from buffer or string. */
+static bool
+row_text_area_empty (struct glyph_row *row)
+{
+ if (!row->reversed_p)
+ {
+ for (struct glyph *g = row->glyphs[TEXT_AREA];
+ g < row->glyphs[TEXT_AREA] + row->used[TEXT_AREA];
+ g++)
+ if (!NILP (g->object) || g->charpos > 0)
+ return false;
+ }
+ else
+ {
+ for (struct glyph *g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1;
+ g > row->glyphs[TEXT_AREA];
+ g--)
+ if (!NILP ((g - 1)->object) || (g - 1)->charpos > 0)
+ return false;
+ }
+
+ return true;
+}
+
/* Construct the glyph row IT->glyph_row in the desired matrix of
IT->w from text at the current position of IT. See dispextern.h
for an overview of struct it. Value is true if
@@ -20739,6 +21205,8 @@ display_line (struct it *it, int cursor_vpos)
(window_hscroll_limited (it->w, it->f) - it->w->min_hscroll)
* FRAME_COLUMN_WIDTH (it->f);
+ bool line_number_needed = should_produce_line_number (it);
+
/* Move over display elements that are not visible because we are
hscrolled. This may stop at an x-position < first_visible_x
if the first glyph is partially visible or if we hit a line end. */
@@ -20774,9 +21242,17 @@ display_line (struct it *it, int cursor_vpos)
are hscrolled to the left of the left edge of the window. */
min_pos = CHARPOS (this_line_min_pos);
min_bpos = BYTEPOS (this_line_min_pos);
+
+ /* Produce line number, if needed. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
}
else if (it->area == TEXT_AREA)
{
+ /* Line numbers should precede the line-prefix or wrap-prefix. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
+
/* We only do this when not calling move_it_in_display_line_to
above, because that function calls itself handle_line_prefix. */
handle_line_prefix (it);
@@ -20838,6 +21314,7 @@ display_line (struct it *it, int cursor_vpos)
buffer reached. */
if (!get_next_display_element (it))
{
+ bool row_has_glyphs = false;
/* Maybe add a space at the end of this line that is used to
display the cursor there under X. Set the charpos of the
first glyph of blank lines not corresponding to any text
@@ -20846,14 +21323,17 @@ display_line (struct it *it, int cursor_vpos)
row->exact_window_width_line_p = true;
else if ((append_space_for_newline (it, true)
&& row->used[TEXT_AREA] == 1)
- || row->used[TEXT_AREA] == 0)
+ || row->used[TEXT_AREA] == 0
+ || (row_has_glyphs = row_text_area_empty (row)))
{
row->glyphs[TEXT_AREA]->charpos = -1;
- row->displays_text_p = false;
+ /* Don't reset the displays_text_p flag if we are
+ displaying line numbers or line-prefix. */
+ if (!row_has_glyphs)
+ row->displays_text_p = false;
if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines))
- && (!MINI_WINDOW_P (it->w)
- || (minibuf_level && EQ (it->window, minibuf_window))))
+ && (!MINI_WINDOW_P (it->w)))
row->indicate_empty_line_p = true;
}
@@ -20935,6 +21415,10 @@ display_line (struct it *it, int cursor_vpos)
process the prefix now. */
if (it->area == TEXT_AREA && pending_handle_line_prefix)
{
+ /* Line numbers should precede the line-prefix or wrap-prefix. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
+
pending_handle_line_prefix = false;
handle_line_prefix (it);
}
@@ -22006,7 +22490,7 @@ Value is the new character position of point. */)
reach point, in order to start from its X coordinate. So we
need to disregard the window's horizontal extent in that case. */
if (it.line_wrap == TRUNCATE)
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
if (it.cmp_it.id < 0
&& it.method == GET_FROM_STRING
@@ -22099,7 +22583,7 @@ Value is the new character position of point. */)
{
start_display (&it, w, pt);
if (it.line_wrap == TRUNCATE)
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
reseat_at_previous_visible_line_start (&it);
it.current_x = it.current_y = it.hpos = 0;
if (pt_vpos != 0)
@@ -22859,7 +23343,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
props = oprops;
}
- aelt = Fassoc (elt, mode_line_proptrans_alist);
+ aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil);
if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
{
/* AELT is what we want. Move it to the front
@@ -27616,6 +28100,10 @@ x_produce_glyphs (struct it *it)
{
int tab_width = it->tab_width * font->space_width;
int x = it->current_x + it->continuation_lines_width;
+ int x0 = x;
+ /* Adjust for line numbers, if needed. */
+ if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
+ x -= it->lnum_pixel_width;
int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
/* If the distance from the current position to the next tab
@@ -27623,8 +28111,12 @@ x_produce_glyphs (struct it *it)
tab stop after that. */
if (next_tab_x - x < font->space_width)
next_tab_x += tab_width;
+ if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
+ next_tab_x += (it->lnum_pixel_width
+ - ((it->w->hscroll * font->space_width)
+ % tab_width));
- it->pixel_width = next_tab_x - x;
+ it->pixel_width = next_tab_x - x0;
it->nglyphs = 1;
if (FONT_TOO_HIGH (font))
{
@@ -28325,7 +28817,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg)
/* By default, set up the blink-off state depending on the on-state. */
- tem = Fassoc (arg, Vblink_cursor_alist);
+ tem = Fassoc (arg, Vblink_cursor_alist, Qnil);
if (!NILP (tem))
{
FRAME_BLINK_OFF_CURSOR (f)
@@ -28463,7 +28955,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
/* Cursor is blinked off, so determine how to "toggle" it. */
/* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */
- if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor)))
+ if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor)))
return get_specified_cursor_type (XCDR (alt_cursor), width);
/* Then see if frame has specified a specific blink off cursor type. */
@@ -31708,6 +32200,12 @@ They are still logged to the *Messages* buffer. */);
/* Name of the face used to highlight trailing whitespace. */
DEFSYM (Qtrailing_whitespace, "trailing-whitespace");
+ /* Names of the faces used to display line numbers. */
+ DEFSYM (Qline_number, "line-number");
+ DEFSYM (Qline_number_current_line, "line-number-current-line");
+ /* Name of a text property which disables line-number display. */
+ DEFSYM (Qdisplay_line_numbers_disable, "display-line-numbers-disable");
+
/* Name and number of the face used to highlight escape glyphs. */
DEFSYM (Qescape_glyph, "escape-glyph");
@@ -32215,6 +32713,54 @@ To add a prefix to continuation lines, use `wrap-prefix'. */);
DEFSYM (Qline_prefix, "line-prefix");
Fmake_variable_buffer_local (Qline_prefix);
+ DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers,
+ doc: /* Non-nil means display line numbers.
+If the value is t, display the absolute number of each line of a buffer
+shown in a window. Absolute line numbers count from the beginning of
+the current narrowing, or from buffer beginning. If the value is
+`relative', display for each line not containing the window's point its
+relative number instead, i.e. the number of the line relative to the
+line showing the window's point.
+
+In either case, line numbers are displayed at the beginning of each
+non-continuation line that displays buffer text, i.e. after each newline
+character that comes from the buffer. The value `visual' is like
+`relative' but counts screen lines instead of buffer lines. In practice
+this means that continuation lines count as well when calculating the
+relative number of a line.
+
+Lisp programs can disable display of a line number of a particular
+buffer line by putting the `display-line-numbers-disable' text property
+or overlay property on the first visible character of that line. */);
+ Vdisplay_line_numbers = Qnil;
+ DEFSYM (Qdisplay_line_numbers, "display-line-numbers");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers);
+ DEFSYM (Qrelative, "relative");
+ DEFSYM (Qvisual, "visual");
+
+ DEFVAR_LISP ("display-line-numbers-width", Vdisplay_line_numbers_width,
+ doc: /* Minimum width of space reserved for line number display.
+A positive number means reserve that many columns for line numbers,
+even if the actual number needs less space.
+The default value of nil means compute the space dynamically.
+Any other value is treated as nil. */);
+ Vdisplay_line_numbers_width = Qnil;
+ DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers_width);
+
+ DEFVAR_LISP ("display-line-numbers-current-absolute",
+ Vdisplay_line_numbers_current_absolute,
+ doc: /* Non-nil means display absolute number of current line.
+This variable has effect only when `display-line-numbers' is
+either `relative' or `visual'. */);
+ Vdisplay_line_numbers_current_absolute = Qt;
+
+ DEFVAR_BOOL ("display-line-numbers-widen", display_line_numbers_widen,
+ doc: /* Non-nil means display line numbers disregarding any narrowing. */);
+ display_line_numbers_widen = false;
+ DEFSYM (Qdisplay_line_numbers_widen, "display-line-numbers-widen");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers_widen);
+
DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay,
doc: /* Non-nil means don't eval Lisp during redisplay. */);
inhibit_eval_during_redisplay = false;
diff --git a/src/xfns.c b/src/xfns.c
index d8bf9747191..2f8c9c25416 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -2062,7 +2062,7 @@ x_set_scroll_bar_default_width (struct frame *f)
int unit = FRAME_COLUMN_WIDTH (f);
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
- int minw = xg_get_default_scrollbar_width ();
+ int minw = xg_get_default_scrollbar_width (f);
#else
int minw = 16;
#endif
@@ -2083,7 +2083,7 @@ x_set_scroll_bar_default_height (struct frame *f)
int height = FRAME_LINE_HEIGHT (f);
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
- int min_height = xg_get_default_scrollbar_height ();
+ int min_height = xg_get_default_scrollbar_height (f);
#else
int min_height = 16;
#endif
diff --git a/src/xfont.c b/src/xfont.c
index b73596ce7ce..85fccf0dafd 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -505,7 +505,8 @@ xfont_list (struct frame *f, Lisp_Object spec)
Lisp_Object alter;
if ((alter = Fassoc (SYMBOL_NAME (registry),
- Vface_alternative_font_registry_alist),
+ Vface_alternative_font_registry_alist,
+ Qnil),
CONSP (alter)))
{
/* Pointer to REGISTRY-ENCODING field. */
diff --git a/src/xmenu.c b/src/xmenu.c
index 6c8a0c506cc..64df151b289 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1271,6 +1271,11 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv,
/* Child of win. */
&dummy_window);
+#ifdef HAVE_GTK3
+ /* Use window scaling factor to adjust position for hidpi screens. */
+ x /= xg_get_scale (f);
+ y /= xg_get_scale (f);
+#endif
unblock_input ();
popup_x_y.x = x;
popup_x_y.y = y;
View Lorry Controller Status