procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow face-remapping using :font, and use it in mouse-appearance-menu.

Browse source 
* mouse.el (mouse-appearance-menu): If x-select-font returns a
font spec, set the font directly.

* xfaces.c (merge_face_vectors): If the target font specfies a
font spec, make the font's attributes take precedence over
directly-specified attributes.
(merge_face_ref): Recognize :font.

Fixes: debbugs:3228
This commit is contained in:
Chong Yidong 2012-08-17 17:10:31 +08:00
parent 0df648f986
commit 383dcbf977
4 changed files with 53 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -1,3 +1,8 @@
2012-08-17 Chong Yidong <cyd@gnu.org>
* mouse.el (mouse-appearance-menu): If x-select-font returns a
font spec, set the font directly (Bug#3228).
2012-08-17 Martin Rudalics <rudalics@gmx.at>
* window.el (delete-window): Fix last fix.

14
lisp/mouse.el
View file

@ -1951,12 +1951,14 @@ choose a font."
(choice
;; Either choice == 'x-select-font, or choice is a
;; symbol whose name is a font.
(buffer-face-mode-invoke (font-face-attributes
(if (eq choice 'x-select-font)
(x-select-font)
(symbol-name choice)))
t
(called-interactively-p 'interactive))))))))
(let ((font (if (eq choice 'x-select-font)
(x-select-font)
(symbol-name choice))))
(buffer-face-mode-invoke
(if (fontp font 'font-spec)
(list :font font)
(font-face-attributes font))
t (called-interactively-p 'interactive)))))))))
;;; Bindings for mouse commands.

7
src/ChangeLog
View file

@ -1,3 +1,10 @@
2012-08-17 Chong Yidong <cyd@gnu.org>
* xfaces.c (merge_face_vectors): If the target font specfies a
font spec, make the font's attributes take precedence over
directly-specified attributes.
(merge_face_ref): Recognize :font.
2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
Do not use memcpy for copying intervals.

51
src/xfaces.c
View file

@ -2281,6 +2281,7 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
struct named_merge_point *named_merge_points)
{
int i;
Lisp_Object font = Qnil;
/* If FROM inherits from some other faces, merge their attributes into
TO before merging FROM's direct attributes. Note that an :inherit
@ -2291,24 +2292,13 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
&& !NILP (from[LFACE_INHERIT_INDEX]))
merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points);
i = LFACE_FONT_INDEX;
if (!UNSPECIFIEDP (from[i]))
if (FONT_SPEC_P (from[LFACE_FONT_INDEX]))
{
if (!UNSPECIFIEDP (to[i]))
to[i] = merge_font_spec (from[i], to[i]);
if (!UNSPECIFIEDP (to[LFACE_FONT_INDEX]))
font = merge_font_spec (from[LFACE_FONT_INDEX], to[LFACE_FONT_INDEX]);
else
to[i] = copy_font_spec (from[i]);
if (! NILP (AREF (to[i], FONT_FOUNDRY_INDEX)))
to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FOUNDRY_INDEX));
if (! NILP (AREF (to[i], FONT_FAMILY_INDEX)))
to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FAMILY_INDEX));
if (! NILP (AREF (to[i], FONT_WEIGHT_INDEX)))
to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (to[i]);
if (! NILP (AREF (to[i], FONT_SLANT_INDEX)))
to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (to[i]);
if (! NILP (AREF (to[i], FONT_WIDTH_INDEX)))
to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (to[i]);
ASET (to[i], FONT_SIZE_INDEX, Qnil);
font = copy_font_spec (from[LFACE_FONT_INDEX]);
to[LFACE_FONT_INDEX] = font;
}
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@ -2319,8 +2309,7 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
to[i] = merge_face_heights (from[i], to[i], to[i]);
font_clear_prop (to, FONT_SIZE_INDEX);
}
else if (i != LFACE_FONT_INDEX
&& ! EQ (to[i], from[i]))
else if (i != LFACE_FONT_INDEX && ! EQ (to[i], from[i]))
{
to[i] = from[i];
if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
@ -2334,6 +2323,25 @@ merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to,
}
}
/* If FROM specifies a font spec, make its contents take precedence
over :family and other attributes. This is needed for face
remapping using :font to work. */
if (!NILP (font))
{
if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX));
if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX));
if (! NILP (AREF (font, FONT_WEIGHT_INDEX)))
to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (font);
if (! NILP (AREF (font, FONT_SLANT_INDEX)))
to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
ASET (font, FONT_SIZE_INDEX, Qnil);
}
/* TO is always an absolute face, which should inherit from nothing.
We blindly copy the :inherit attribute above and fix it up here. */
to[LFACE_INHERIT_INDEX] = Qnil;
@ -2575,6 +2583,13 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
else
err = 1;
}
else if (EQ (keyword, QCfont))
{
if (FONTP (value))
to[LFACE_FONT_INDEX] = value;
else
err = 1;
}
else if (EQ (keyword, QCinherit))
{
/* This is not really very useful; it's just like a