From: Chong Yidong Date: Fri, 17 Aug 2012 09:10:31 +0000 (+0800) Subject: Allow face-remapping using :font, and use it in mouse-appearance-menu. X-Git-Tag: emacs-24.2.90~633 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=383dcbf97748f1a4ef57f8af4f5780501ba78216;p=emacs.git Allow face-remapping using :font, and use it in mouse-appearance-menu. * 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 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2bc154b1610..8fa6b4c6b47 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-08-17 Chong Yidong + + * mouse.el (mouse-appearance-menu): If x-select-font returns a + font spec, set the font directly (Bug#3228). + 2012-08-17 Martin Rudalics * window.el (delete-window): Fix last fix. diff --git a/lisp/mouse.el b/lisp/mouse.el index 589bbd67b1b..4ea84288f69 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -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. diff --git a/src/ChangeLog b/src/ChangeLog index 84d6920b3ea..72a11c177c4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2012-08-17 Chong Yidong + + * 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 Do not use memcpy for copying intervals. diff --git a/src/xfaces.c b/src/xfaces.c index 7491802466d..8c6542ee725 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -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