unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: "Robert J. Chassell" <bob@rattlesnake.com>
Cc: emacs-devel@gnu.org
Subject: Re: Miles' patch still fixes xfaces.c
Date: Sat, 31 May 2003 21:43:09 +0000 (UTC)	[thread overview]
Message-ID: <m19ME85-000IeAC@rattlesnake.com> (raw)
In-Reply-To: <E19MCPA-0007d7-8f@fencepost.gnu.org> (message from Richard Stallman on Sat, 31 May 2003 15:52:40 -0400)

    Can you show me that fix?  Maybe we can change it not to crash.

Here it is:

------- Start of forwarded message -------
To: bob@rattlesnake.com
System-Type: i686-pc-linux-gnu
From: Miles Bader <miles@lsi.nec.co.jp>
Date: 18 Dec 2002 19:01:01 +0900
In-Reply-To: <buoisxtazqu.fsf@mcspd15.ucom.lsi.nec.co.jp>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
cc: emacs-devel@gnu.org
Subject: Re: Bold by moving pixels problem
Reply-To: Miles Bader <miles@gnu.org>


- --=-=-=

Here's an updated version of my patch, that uses a list of functions:



- --=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
  filename=realize-face-filter-20021218-0.patch
Content-Description: realize-face-filter-20021218-0.patch

2002-12-17  Miles Bader  <miles@gnu.org>

	* xfaces.c (Vrealize_face_filter_functions): New variable.
	(realize_face): If Vrealize_face_filter_functions has a non-nil
	value, use it to filter the face attributes before realization.
	Use new calling conventions for realize_x_face, realize_tty_face,
	and load_face_font.
	(realize_x_face, realize_tty_face): Add new argument FACE, and
	change return type to void.  Use FACE instead of creating our own.
	(load_face_font): Add a new argument ATTRS, and use it instead of
	FACE->lface.
	(syms_of_xfaces): Initialize Vrealize_face_filter_functions.

Index: src/xfaces.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xfaces.c,v
retrieving revision 1.266
diff -u -r1.266 xfaces.c
- --- src/xfaces.c	17 Nov 2002 23:51:19 -0000	1.266
+++ src/xfaces.c	18 Dec 2002 05:26:34 -0000
@@ -422,6 +422,13 @@
 
 Lisp_Object Vtty_defined_color_alist;
 
+/* A list of functions to perturb faces before final realization.
+   They are passed a lisp-vector containing all the attributes of the
+   fully-specified face, and can change any that they wish. */
+
+Lisp_Object Vrealize_face_filter_functions;
+
+
 /* Counter for calls to clear_face_cache.  If this counter reaches
    CLEAR_FONT_TABLE_COUNT, and a frame has more than
    CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed.  */
@@ -481,7 +488,7 @@
 static unsigned char *xstrlwr P_ ((unsigned char *));
 static void signal_error P_ ((char *, Lisp_Object));
 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
- -static void load_face_font P_ ((struct frame *, struct face *, int));
+static void load_face_font P_ ((struct frame *, struct face *, Lisp_Object *, int));
 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
 static void free_face_colors P_ ((struct frame *, struct face *));
 static int face_color_gray_p P_ ((struct frame *, char *));
@@ -502,10 +509,10 @@
 static int cmp_font_names P_ ((const void *, const void *));
 static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
 				      struct face *, int));
- -static struct face *realize_x_face P_ ((struct face_cache *,
- -					Lisp_Object *, int, struct face *));
- -static struct face *realize_tty_face P_ ((struct face_cache *,
- -					  Lisp_Object *, int));
+static void realize_x_face P_ ((struct face *, struct face_cache *,
+				Lisp_Object *, int, struct face *));
+static void realize_tty_face P_ ((struct face *, struct face_cache *,
+				  Lisp_Object *, int));
 static int realize_basic_faces P_ ((struct frame *));
 static int realize_default_face P_ ((struct frame *));
 static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
@@ -1245,14 +1252,15 @@
 
 #ifdef HAVE_WINDOW_SYSTEM
 
- -/* Load font of face FACE which is used on frame F to display
- -   character C.  The name of the font to load is determined by lface
- -   and fontset of FACE.  */
+/* Load font of face FACE with attributes ATTRS which is used on frame F to
+   display character C.  The name of the font to load is determined by
+   lface and fontset of FACE.  */
 
 static void
- -load_face_font (f, face, c)
+load_face_font (f, face, attrs, c)
      struct frame *f;
      struct face *face;
+     Lisp_Object *attrs;
      int c;
 {
   struct font_info *font_info = NULL;
@@ -1262,7 +1270,7 @@
   face->font_info_id = -1;
   face->font = NULL;
 
- -  font_name = choose_face_font (f, face->lface, face->fontset, c,
+  font_name = choose_face_font (f, attrs, face->fontset, c,
 				&needs_overstrike);
   if (!font_name)
     return;
@@ -6678,6 +6686,11 @@
      int former_face_id;
 {
   struct face *face;
+  /* The set of attributes this face is know by to the user, as opposed to
+     the set actually used to render the face.  They're usually the same
+     as, but may be different if some attribute is changed by
+     realize-face-filter.  */
+  Lisp_Object *orig_attrs = attrs;
 
   /* LFACE must be fully specified.  */
   xassert (cache != NULL);
@@ -6691,41 +6704,70 @@
       free_realized_face (cache->f, former_face);
     }
 
+  if (CONSP (Vrealize_face_filter_functions))
+    {
+      /* Call these user-defined functions to perturb the face attributes
+	 before realization.  */
+      Lisp_Object filters, cycle_check;
+      Lisp_Object lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
+					Qunspecified);
+
+      bcopy (attrs, XVECTOR (lface)->contents,
+	     LFACE_VECTOR_SIZE * (sizeof *attrs));
+
+      cycle_check = Qnil;
+      for (filters = Vrealize_face_filter_functions;
+	   CONSP (filters);
+	   filters = XCDR (filters))
+	{
+	  safe_call1 (XCAR (filters), lface);
+	  cycle_check = CYCLE_CHECK (cycle_check, filters, 50);
+	  if (NILP (cycle_check))
+	    break;		/* cycle detected */
+	}
+
+      attrs = XVECTOR (lface)->contents;
+    }      
+
+  /* Allocate a new realized face.  */
+  face = make_realized_face (orig_attrs);
+
+  /* Fill it in.  */
   if (FRAME_WINDOW_P (cache->f))
- -    face = realize_x_face (cache, attrs, c, base_face);
+    realize_x_face (face, cache, attrs, c, base_face);
   else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
- -    face = realize_tty_face (cache, attrs, c);
+    realize_tty_face (face, cache, attrs, c);
   else
     abort ();
 
   /* Insert the new face.  */
- -  cache_face (cache, face, lface_hash (attrs));
+  cache_face (cache, face, lface_hash (orig_attrs));
 #ifdef HAVE_WINDOW_SYSTEM
   if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
- -    load_face_font (cache->f, face, c);
+    load_face_font (cache->f, face, attrs, c);
 #endif  /* HAVE_WINDOW_SYSTEM */
   return face;
 }
 
 
- -/* Realize the fully-specified face with attributes ATTRS in face
- -   cache CACHE for character C.  Do it for X frame CACHE->f.  If C is
- -   a multibyte character, BASE_FACE is a face that has the same
- -   attributes.  Otherwise, BASE_FACE is ignored.  If the new face
- -   doesn't share font with the default face, a fontname is allocated
- -   from the heap and set in `font_name' of the new face, but it is not
- -   yet loaded here.  Value is a pointer to the newly created realized
- -   face.  */
+/* Realize into FACE the fully-specified face with attributes ATTRS in face
+   cache CACHE for character C.  Do it for X frame CACHE->f.  If C is a
+   multibyte character, BASE_FACE is a face that has the same attributes.
+   Otherwise, BASE_FACE is ignored.  If the new face doesn't share font
+   with the default face, a fontname is allocated from the heap and set in
+   `font_name' of the new face, but it is not yet loaded here.  Value is a
+   pointer to the newly created realized face.  */
 
- -static struct face *
- -realize_x_face (cache, attrs, c, base_face)
+static void
+realize_x_face (face, cache, attrs, c, base_face)
+     struct face *face;
      struct face_cache *cache;
      Lisp_Object *attrs;
      int c;
      struct face *base_face;
 {
 #ifdef HAVE_WINDOW_SYSTEM
- -  struct face *face, *default_face;
+  struct face *default_face;
   struct frame *f;
   Lisp_Object stipple, overline, strike_through, box;
 
@@ -6733,9 +6775,6 @@
   xassert (SINGLE_BYTE_CHAR_P (c)
 	   || base_face);
 
- -  /* Allocate a new realized face.  */
- -  face = make_realized_face (attrs);
- -
   f = cache->f;
 
   /* If C is a multibyte character, we share all face attirbutes with
@@ -6751,7 +6790,7 @@
 
       /* to force realize_face to load font */
       face->font = NULL;
- -      return face;
+      return;
     }
 
   /* Now we are realizing a face for ASCII (and unibyte) characters.  */
@@ -6921,7 +6960,6 @@
     face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
 
   xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
- -  return face;
 #endif /* HAVE_WINDOW_SYSTEM */
 }
 
@@ -7012,17 +7050,16 @@
 }
 
 
- -/* Realize the fully-specified face with attributes ATTRS in face
- -   cache CACHE for character C.  Do it for TTY frame CACHE->f.  Value is a
- -   pointer to the newly created realized face.  */
+/* Realize into FACE the fully-specified face with attributes ATTRS in face
+   cache CACHE for character C.  Do it for TTY frame CACHE->f.  */
 
- -static struct face *
- -realize_tty_face (cache, attrs, c)
+static void
+realize_tty_face (face, cache, attrs, c)
+     struct face *face;
      struct face_cache *cache;
      Lisp_Object *attrs;
      int c;
 {
- -  struct face *face;
   int weight, slant;
   int face_colors_defaulted = 0;
   struct frame *f = cache->f;
@@ -7030,8 +7067,6 @@
   /* Frame must be a termcap frame.  */
   xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
 
- -  /* Allocate a new realized face.  */
- -  face = make_realized_face (attrs);
   face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
 
   /* Map face attributes to TTY appearances.  We map slant to
@@ -7068,8 +7103,6 @@
       && face->background == FACE_TTY_DEFAULT_FG_COLOR
       && face->foreground == FACE_TTY_DEFAULT_BG_COLOR)
     face->tty_bold_p = 0;
- -
- -  return face;
 }
 
 
@@ -7670,6 +7703,14 @@
 Each element is a regular expression that matches names of fonts to
 ignore.  */);
   Vface_ignored_fonts = Qnil;
+
+  DEFVAR_LISP ("realize-face-filter-functions",
+	       &Vrealize_face_filter_functions,
+	       doc:/* A list of functions to perturb faces before final realization.
+They are passed a lisp-vector containing all the attributes of the
+fully-specified face, and can change any that they wish. */);
+  Vrealize_face_filter_functions = Qnil;
+
 
 #ifdef HAVE_WINDOW_SYSTEM
   defsubr (&Sbitmap_spec_p);

- --=-=-=



Also, here's a lisp file that implements some filters:



- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=relfilt.el
Content-Description: Some filters for face-realization

(defun lface-emulate-bold-with-color (lface)
  (if (memq (aref lface 4)
	    '(bold heavy extra-bold semi-bold ultra-bold))
      (let ((fg-vals (color-values (aref lface 8))))
	;; unboldify
	(aset lface 4 'normal)
	;; Tweak the fg color to indicate bold.
	(cond ((equal fg-vals '(65535 65535 65535))
	       (aset lface 8 "khaki"))
	      ((equal fg-vals '(0 0 0))
	       (aset lface 8 "orange4"))
	      (t
	       ;; intensify the color
	       (aset lface 8 (highlight-color (aref lface 8) 2 5000)))))))

(defun lface-replace-italic-with-underline (lface)
  (if (not (eq (aref lface 5) 'normal))
      (progn
	;; remove italics
	(aset lface 5 'normal)
	;; underline (we preserve an existing value, in case it's colored)
	(if (null (aref lface 6))
	    (aset lface 6 t)))))

(push 'lface-emulate-bold-with-color realize-face-filter-functions)
(push 'lface-replace-italic-with-underline realize-face-filter-functions)
(clear-face-cache)

;;; highlight-color function
(defconst highlight-color-dark-boost-limit 48000)
(defun highlight-color (color factor &optional delta)
 "Return a color which is lighter or darker than COLOR by FACTOR and DELTA."
 (let* ((old-rgb (if (stringp color) (color-values color) color))
	(red (car old-rgb))
	(green (cadr old-rgb))
	(blue (nth 2 old-rgb))
	(bright (/ (+ (* red 2) (* green 3) blue) 6)))
   (setq red (min 65535 (* red factor)))
   (setq green (min 65535 (* green factor)))
   (setq blue (min 65535 (* blue factor)))
   (when (and (< bright highlight-color-dark-boost-limit) delta)
     ;; Make an additive adjustment to NEW, because it's dark enough so
     ;; that scaling by FACTOR alone isn't enough.
     (let* ((dimness
	     ;; How far below the limit this color is (0 - 1, 1 being darker).
	     (- 1 (/ (float bright) highlight-color-dark-boost-limit)))
	    (min-delta
	     ;; The additive adjustment.
	     (* delta dimness factor 0.5)))
       (cond ((< factor 1)
	      (setq red (max 0 (- red min-delta)))
	      (setq green (max 0 (- green min-delta)))
	      (setq blue (max 0 (- blue min-delta))))
	     (t
	      (setq red (min 65535 (+ red min-delta)))
	      (setq green (min 65535 (+ green min-delta)))
	      (setq blue (min 65535 (+ blue min-delta)))))))
   (format "#%04X%04X%04X" red green blue)))

- --=-=-=



- -Miles
- -- 
I'm beginning to think that life is just one long Yoko Ono album; no rhyme
or reason, just a lot of incoherent shrieks and then it's over.  --Ian Wolff

- --=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel

- --=-=-=--
------- End of forwarded message -------

      reply	other threads:[~2003-05-31 21:43 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2003-05-26 20:27 Printing elisp char literals Stefan Monnier
2003-05-26 20:49 ` David Kastrup
2003-05-27 10:39   ` Stephen J. Turnbull
2003-05-27  0:02 ` Miles' patch still fixes xfaces.c Robert J. Chassell
2003-05-27 22:40   ` Richard Stallman
2003-05-28  0:46     ` Robert J. Chassell
2003-05-31 19:52       ` Richard Stallman
2003-05-31 21:43         ` Robert J. Chassell [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=m19ME85-000IeAC@rattlesnake.com \
    --to=bob@rattlesnake.com \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).