Commit e3b8ddd5 authored by Jashank Jeremy's avatar Jashank Jeremy Committed by Lars Ingebrigtsen
Browse files

Speed up by storing frame faces in hash tables instead of alists

* src/frame.h (struct frame): Add face_hash_table, remove face_alist.
(fset_face_hash_table): New function.
(fset_face_alist): Remove.
* src/frame.c (make_frame): Initialize f->face_hash_table.
(Fmake_terminal_frame): Update to work with hash tables instead of
alists.
* src/xfaces.c (lface_from_face_name_no_resolve):
(Finternal_make_lisp_face):
(update_face_from_frame_parameter): Update to work with hash tables
instead of alists.
(Fframe_face_hash_table): New function.
(Fframe_face_alist): Move to faces.el as frame-face-alist.
(syms_of_xfaces): Add frame_face_hash_table.

* lisp/progmodes/elisp-mode.el (elisp--eval-defun-1):
* lisp/frame.el (frame-set-background-mode): Update to work with hash
tables instead of alists.
* lisp/faces.el (face-new-frame-defaults): Mark obsolete.
(face-list): Update to use face--new-frame-defaults.
(frame-face-alist): Moved here from src/xfaces.c.
(x-create-frame-with-faces): Update to handle subtle semantic change
to how frame faces propagate, which otherwise breaks frame creation
with reverse video enabled (bug#41200).

Reworked from a patch by Clément Pit-Claudel <clement.pitclaudel@live.com>.
parent e56ad2cb
Pipeline #11518 failed with stages
in 54 seconds
......@@ -926,7 +926,7 @@ See `custom-known-themes' for a list of known themes."
;; the value to a fake theme, `changed'. If the theme is
;; later disabled, we use this to bring back the old value.
;;
;; For faces, we just use `face-new-frame-defaults' to
;; For faces, we just use `face--new-frame-defaults' to
;; recompute when the theme is disabled.
(when (and (eq prop 'theme-value)
(boundp symbol))
......
......@@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
;;; Creation, copying.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(make-obsolete-variable 'face-new-frame-defaults
"use `face--new-frame-defaults' or `face-alist' instead." "28.1")
(defun frame-face-alist (&optional frame)
"Return an alist of frame-local faces defined on FRAME.
This alist is a copy of the contents of `frame--face-hash-table'.
For internal use only."
(declare (obsolete frame--face-hash-table "28.1"))
(let (faces)
(maphash (lambda (face spec)
(let ((face-id (car (gethash face face--new-frame-defaults))))
(push `(,face-id ,face . ,spec) faces)))
(frame--face-hash-table frame))
(mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
(mapcar #'car face-new-frame-defaults))
(let (faces)
(maphash (lambda (face spec)
(push `(,(car spec) . ,face) faces))
face--new-frame-defaults)
(mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
......@@ -2115,6 +2133,8 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
(dolist (face (nreverse (face-list)))
(face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
......@@ -2145,7 +2165,7 @@ the X resource \"reverseVideo\" is present, handle that."
(defun face-set-after-frame-default (frame &optional parameters)
"Initialize the frame-local faces of FRAME.
Calculate the face definitions using the face specs, custom theme
settings, X resources, and `face-new-frame-defaults'.
settings, X resources, and `face--new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
;; The `reverse' is so that `default' goes first.
......@@ -2154,7 +2174,7 @@ frame parameters in PARAMETERS."
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
;; Apply attributes specified by face-new-frame-defaults
;; Apply attributes specified by face--new-frame-defaults
(internal-merge-in-global-face face frame))
;; Don't let invalid specs prevent frame creation.
(error nil)))
......
......@@ -1231,7 +1231,7 @@ face specs for the new background mode."
;; during startup with -rv on the command
;; line for the initial frame, because frames
;; are not recorded in the pdump file.
(assq face (frame-face-alist frame))
(gethash face (frame--face-hash-table))
(face-spec-match-p face
(face-user-default-spec face)
frame)))
......
......@@ -1325,8 +1325,7 @@ Reinitialize the face according to the `defface' specification."
((eq (car form) 'custom-declare-face)
;; Reset the face.
(let ((face-symbol (eval (nth 1 form) lexical-binding)))
(setq face-new-frame-defaults
(assq-delete-all face-symbol face-new-frame-defaults))
(remhash face-symbol face--new-frame-defaults)
(put face-symbol 'face-defface-spec nil)
(put face-symbol 'face-override-spec nil))
form)
......
......@@ -1018,6 +1018,10 @@ make_frame (bool mini_p)
rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0);
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
fset_face_hash_table
(f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
DEFAULT_REHASH_THRESHOLD, Qnil, false));
if (mini_p)
{
mw->top_line = rw->total_lines;
......@@ -1326,7 +1330,7 @@ affects all frames on the same terminal device. */)
{
struct frame *f;
struct terminal *t = NULL;
Lisp_Object frame, tem;
Lisp_Object frame;
struct frame *sf = SELECTED_FRAME ();
#ifdef MSDOS
......@@ -1408,14 +1412,16 @@ affects all frames on the same terminal device. */)
store_in_alist (&parms, Qminibuffer, Qt);
Fmodify_frame_parameters (frame, parms);
/* Make the frame face alist be frame-specific, so that each
/* Make the frame face hash be frame-specific, so that each
frame could change its face definitions independently. */
fset_face_alist (f, Fcopy_alist (sf->face_alist));
/* Simple Fcopy_alist isn't enough, because we need the contents of
the vectors which are the CDRs of associations in face_alist to
fset_face_hash_table (f, Fcopy_hash_table (sf->face_hash_table));
/* Simple copy_hash_table isn't enough, because we need the contents of
the vectors which are the values in face_hash_table to
be copied as well. */
for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
ptrdiff_t idx = 0;
struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_hash_table);
for (idx = 0; idx < table->count; ++idx)
set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
f->can_set_window_size = true;
f->after_make_frame = true;
......
......@@ -158,8 +158,8 @@ struct frame
There are four additional elements of nil at the end, to terminate. */
Lisp_Object menu_bar_items;
/* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */
Lisp_Object face_alist;
/* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values. */
Lisp_Object face_hash_table;
/* A vector that records the entire structure of this frame's menu bar.
For the format of the data, see extensive comments in xmenu.c.
......@@ -672,9 +672,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
f->condemned_scroll_bars = val;
}
INLINE void
fset_face_alist (struct frame *f, Lisp_Object val)
fset_face_hash_table (struct frame *f, Lisp_Object val)
{
f->face_alist = val;
f->face_hash_table = val;
}
#if defined (HAVE_WINDOW_SYSTEM)
INLINE void
......
......@@ -95,9 +95,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
with the symbol `face' in slot 0, and a slot for each of the face
attributes mentioned above.
There is also a global face alist `Vface_new_frame_defaults'. Face
definitions from this list are used to initialize faces of newly
created frames.
There is also a global face map `Vface_new_frame_defaults',
containing conses of (FACE_ID . FACE_DEFINITION). Face definitions
from this table are used to initialize faces of newly created
frames.
A face doesn't have to specify all attributes. Those not specified
have a value of `unspecified'. Faces specifying all attributes but
......@@ -1965,13 +1966,11 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
Lisp_Object lface;
if (f)
lface = assq_no_quit (face_name, f->face_alist);
lface = Fgethash (face_name, f->face_hash_table, Qnil);
else
lface = assq_no_quit (face_name, Vface_new_frame_defaults);
lface = CDR (Fgethash (face_name, Vface_new_frame_defaults, Qnil));
if (CONSP (lface))
lface = XCDR (lface);
else if (signal_p)
if (signal_p && NILP (lface))
signal_error ("Invalid face", face_name);
check_lface (lface);
......@@ -2870,11 +2869,6 @@ Value is a vector of face attributes. */)
/* Add a global definition if there is none. */
if (NILP (global_lface))
{
global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
ASET (global_lface, 0, Qface);
Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
Vface_new_frame_defaults);
/* Assign the new Lisp face a unique ID. The mapping from Lisp
face id to Lisp face is given by the vector lface_id_to_name.
The mapping from Lisp face to Lisp face id is given by the
......@@ -2884,9 +2878,14 @@ Value is a vector of face attributes. */)
xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
sizeof *lface_id_to_name);
Lisp_Object face_id = make_fixnum (next_lface_id);
lface_id_to_name[next_lface_id] = face;
Fput (face, Qface, make_fixnum (next_lface_id));
Fput (face, Qface, face_id);
++next_lface_id;
global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
ASET (global_lface, 0, Qface);
Fputhash (face, Fcons (face_id, global_lface), Vface_new_frame_defaults);
}
else if (f == NULL)
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
......@@ -2899,7 +2898,7 @@ Value is a vector of face attributes. */)
{
lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
ASET (lface, 0, Qface);
fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
Fputhash (face, lface, f->face_hash_table);
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
......@@ -3060,7 +3059,7 @@ FRAME 0 means change the face on all frames, and change the default
f = NULL;
lface = lface_from_face_name (NULL, face, true);
/* When updating face-new-frame-defaults, we put :ignore-defface
/* When updating face--new-frame-defaults, we put :ignore-defface
where the caller wants `unspecified'. This forces the frame
defaults to ignore the defface value. Otherwise, the defface
will take effect, which is generally not what is intended.
......@@ -3645,7 +3644,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
/* If there are no faces yet, give up. This is the case when called
from Fx_create_frame, and we do the necessary things later in
face-set-after-frame-defaults. */
if (NILP (f->face_alist))
if (XFIXNAT (Fhash_table_count (f->face_hash_table)) == 0)
return;
if (EQ (param, Qforeground_color))
......@@ -4311,14 +4310,13 @@ If FRAME is omitted or nil, use the selected frame. */)
return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
}
DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
DEFUN ("frame--face-hash-table", Fframe_face_hash_table, Sframe_face_hash_table,
0, 1, 0,
doc: /* Return an alist of frame-local faces defined on FRAME.
doc: /* Return a hash table of frame-local faces defined on FRAME.
For internal use only. */)
(Lisp_Object frame)
{
return decode_live_frame (frame)->face_alist;
return decode_live_frame (frame)->face_hash_table;
}
......@@ -6835,30 +6833,32 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
#ifdef HAVE_PDUMPER
/* All the faces defined during loadup are recorded in
face-new-frame-defaults, with the last face first in the list. We
need to set next_lface_id to the next face ID number, so that any
new faces defined in this session will have face IDs different from
those defined during loadup. We also need to set up the
lface_id_to_name[] array for the faces that were defined during
loadup. */
face-new-frame-defaults. We need to set next_lface_id to the next
face ID number, so that any new faces defined in this session will
have face IDs different from those defined during loadup. We also
need to set up the lface_id_to_name[] array for the faces that were
defined during loadup. */
void
init_xfaces (void)
{
if (CONSP (Vface_new_frame_defaults))
int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults));
if (nfaces > 0)
{
/* Allocate the lface_id_to_name[] array. */
lface_id_to_name_size = next_lface_id =
XFIXNAT (Flength (Vface_new_frame_defaults));
lface_id_to_name_size = next_lface_id = nfaces;
lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
/* Store the faces. */
Lisp_Object tail;
int i = next_lface_id - 1;
for (tail = Vface_new_frame_defaults; CONSP (tail); tail = XCDR (tail))
struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults);
for (ptrdiff_t idx = 0; idx < nfaces; ++idx)
{
Lisp_Object lface = XCAR (tail);
eassert (i >= 0);
lface_id_to_name[i--] = XCAR (lface);
Lisp_Object lface = HASH_KEY (table, idx);
Lisp_Object face_id = CAR (HASH_VALUE (table, idx));
if (FIXNATP (face_id)) {
int id = XFIXNAT (face_id);
eassert (id >= 0);
lface_id_to_name[id] = lface;
}
}
}
face_attr_sym[0] = Qface;
......@@ -7014,7 +7014,7 @@ syms_of_xfaces (void)
defsubr (&Sinternal_copy_lisp_face);
defsubr (&Sinternal_merge_in_global_face);
defsubr (&Sface_font);
defsubr (&Sframe_face_alist);
defsubr (&Sframe_face_hash_table);
defsubr (&Sdisplay_supports_face_attributes_p);
defsubr (&Scolor_distance);
defsubr (&Sinternal_set_font_selection_order);
......@@ -7038,9 +7038,12 @@ This variable is intended for use only by code that evaluates
the "specifity" of a face specification and should be let-bound
only for this purpose. */);
DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
doc: /* List of global face definitions (for internal use only.) */);
Vface_new_frame_defaults = Qnil;
DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults,
doc: /* Hash table of global face definitions (for internal use only.) */);
Vface_new_frame_defaults =
/* 33 entries is enough to fit all basic faces */
make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
DEFAULT_REHASH_THRESHOLD, Qnil, false);
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
doc: /* Default stipple pattern used on monochrome displays.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment