From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Miles Bader Newsgroups: gmane.emacs.devel Subject: Buffer-local faces Date: Mon, 3 May 2004 09:03:50 -0400 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040503130350.GA1929@fencepost> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1083590736 10106 80.91.224.253 (3 May 2004 13:25:36 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 3 May 2004 13:25:36 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Mon May 03 15:25:28 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BKdRo-0000me-00 for ; Mon, 03 May 2004 15:25:28 +0200 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1BKdRn-000880-00 for ; Mon, 03 May 2004 15:25:27 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BKdRY-00023v-DE for emacs-devel@quimby.gnus.org; Mon, 03 May 2004 09:25:12 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1BKdR3-0001rr-Rh for emacs-devel@gnu.org; Mon, 03 May 2004 09:24:41 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1BKdQQ-0001ef-Ht for emacs-devel@gnu.org; Mon, 03 May 2004 09:24:33 -0400 Original-Received: from [199.232.76.164] (helo=fencepost.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BKd6t-0004uu-FF for emacs-devel@gnu.org; Mon, 03 May 2004 09:03:51 -0400 Original-Received: from miles by fencepost.gnu.org with local (Exim 4.24) id 1BKd6s-00019G-Vn; Mon, 03 May 2004 09:03:50 -0400 Original-To: emacs-devel@gnu.org Content-Disposition: inline User-Agent: Mutt/1.3.28i Blat: Foop X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:22614 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:22614 [I'm resending this message as a previous version seems to have been eaten by the email system somewhere ... @#!$% anti-spam/virus filters no doubt...] I hacked up the buffer-local face implementation I talked about before. The user-interface is a variable called `face-remappings': Alist of face mappings. Each element is of the form: (FACE . NEW-FACE) or (FACE NEW-FACE MERGE-FACE...), which causes NEW-FACE to be used where FACE normally would. If present, MERGE-FACE... are merged during display with NEW-FACE. For instance, try evaluating the following: (set (make-local-variable 'face-remappings) '((default . italic))) It (should) work with other special faces like like mode-line, &c, too. Here's the patch: M src/xfaces.c M src/dispextern.h M src/fontset.c M src/xdisp.c * modified files *** orig/src/dispextern.h --- mod/src/dispextern.h *************** *** 2838,2843 **** --- 2838,2844 ---- int xstricmp P_ ((const unsigned char *, const unsigned char *)); int lookup_face P_ ((struct frame *, Lisp_Object *, int, struct face *)); int lookup_named_face P_ ((struct frame *, Lisp_Object, int)); + int lookup_basic_face P_ ((struct frame *, int)); int smaller_face P_ ((struct frame *, int, int)); int face_with_height P_ ((struct frame *, int, int)); int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int)); *************** *** 2854,2859 **** --- 2855,2862 ---- extern char unspecified_fg[], unspecified_bg[]; void free_realized_multibyte_face P_ ((struct frame *, int)); + extern Lisp_Object Vface_remappings; + /* Defined in xfns.c */ #ifdef HAVE_X_WINDOWS *** orig/src/fontset.c --- mod/src/fontset.c *************** *** 1252,1258 **** CHECK_NATNUM (ch); c = XINT (ch); f = XFRAME (selected_frame); ! face_id = DEFAULT_FACE_ID; } else { --- 1252,1258 ---- CHECK_NATNUM (ch); c = XINT (ch); f = XFRAME (selected_frame); ! face_id = lookup_basic_face (f, DEFAULT_FACE_ID); } else { *** orig/src/xdisp.c --- mod/src/xdisp.c *************** *** 2028,2033 **** --- 2028,2034 ---- enum face_id base_face_id; { int highlight_region_p; + enum face_id remapped_base_face_id = base_face_id; /* Some precondition checks. */ xassert (w != NULL && it != NULL); *************** *** 2044,2049 **** --- 2045,2054 ---- free_all_realized_faces (Qnil); } + /* Perhaps remap BASE_FACE_ID to a user-specified alternative. */ + if (! NILP (Vface_remappings)) + remapped_base_face_id = lookup_basic_face (XFRAME (w->frame), base_face_id); + /* Use one of the mode line rows of W's desired matrix if appropriate. */ if (row == NULL) *************** *** 2059,2065 **** bzero (it, sizeof *it); it->current.overlay_string_index = -1; it->current.dpvec_index = -1; ! it->base_face_id = base_face_id; it->string = Qnil; IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1; --- 2064,2070 ---- bzero (it, sizeof *it); it->current.overlay_string_index = -1; it->current.dpvec_index = -1; ! it->base_face_id = remapped_base_face_id; it->string = Qnil; IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1; *************** *** 2243,2253 **** { struct face *face; ! it->face_id = base_face_id; /* If we have a boxed mode line, make the first character appear with a left box line. */ ! face = FACE_FROM_ID (it->f, base_face_id); if (face->box != FACE_NO_BOX) it->start_of_box_run_p = 1; #ifdef HAVE_WINDOW_SYSTEM --- 2248,2258 ---- { struct face *face; ! it->face_id = remapped_base_face_id; /* If we have a boxed mode line, make the first character appear with a left box line. */ ! face = FACE_FROM_ID (it->f, remapped_base_face_id); if (face->box != FACE_NO_BOX) it->start_of_box_run_p = 1; #ifdef HAVE_WINDOW_SYSTEM *************** *** 3491,3497 **** /* Value is a multiple of the canonical char height. */ struct face *face; ! face = FACE_FROM_ID (it->f, DEFAULT_FACE_ID); new_height = (XFLOATINT (it->font_height) * XINT (face->lface[LFACE_HEIGHT_INDEX])); } --- 3496,3503 ---- /* Value is a multiple of the canonical char height. */ struct face *face; ! face = FACE_FROM_ID (it->f, ! lookup_basic_face (it->f, DEFAULT_FACE_ID)); new_height = (XFLOATINT (it->font_height) * XINT (face->lface[LFACE_HEIGHT_INDEX])); } *************** *** 3591,3597 **** || EQ (XCAR (prop), Qright_fringe)) && CONSP (XCDR (prop))) { ! unsigned face_id = DEFAULT_FACE_ID; /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ --- 3597,3603 ---- || EQ (XCAR (prop), Qright_fringe)) && CONSP (XCDR (prop))) { ! unsigned face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID); /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ *** orig/src/xfaces.c --- mod/src/xfaces.c *************** *** 400,405 **** --- 400,412 ---- Lisp_Object Vface_new_frame_defaults; + /* Alist of face mappings. Each element is either of the form + (FACE . NEW-FACE), or (FACE NEW-FACE MERGE-FACE...), + where FACE is the named used for lookups, and NEW-FACE is the name + that actually gets looked up. If present, MERGE-FACE... are merged + during display of FACE, with NEW-FACE. */ + Lisp_Object Vface_remappings; + /* The next ID to assign to Lisp faces. */ static int next_lface_id; *************** *** 3196,3213 **** for another face, return that face's definition. If SIGNAL_P is non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face ! name. */ static INLINE Lisp_Object ! lface_from_face_name (f, face_name, signal_p) struct frame *f; Lisp_Object face_name; int signal_p; { Lisp_Object lface; face_name = resolve_face_name (face_name); if (f) lface = assq_no_quit (face_name, f->face_alist); else --- 3203,3271 ---- for another face, return that face's definition. If SIGNAL_P is non-zero, signal an error if FACE_NAME is not a valid face name. If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face ! name. If ATTRS is non-zero, then it is a lisp-face vector, and ! successful lookups copy the lface vector into it, _along with any ! merges from face mappings_ (so in that cases, the returned lisp ! vector and the values in ATTRS may not be identical). CYCLE_CHECK ! is used internally to detect loops in face mapping; it can be Qnil ! when called from other places that are not involved in mutual ! recursion with this function. */ static INLINE Lisp_Object ! lface_from_face_name_with_attrs (f, face_name, attrs, signal_p, cycle_check) struct frame *f; Lisp_Object face_name; + Lisp_Object *attrs; int signal_p; + Lisp_Object cycle_check; { Lisp_Object lface; + Lisp_Object face_remapping; face_name = resolve_face_name (face_name); + /* See if SYMBOL has been remapped to some other face (usually this + is done buffer-locally). */ + face_remapping = assq_no_quit (face_name, Vface_remappings); + if (! NILP (face_remapping)) + { + /* Make sure we're not in an mapping loop. */ + cycle_check = CYCLE_CHECK (cycle_check, face_name, 15); + + if (! NILP (cycle_check)) + { + /* No cycle detected, lookup FACE_NAME's mapping instead. */ + Lisp_Object merges; + + face_remapping = XCDR (face_remapping); + + /* A mapping may also contain a list of `merge faces', which + we ignore in this function. */ + if (CONSP (face_remapping) && SYMBOLP (XCAR (face_remapping))) + { + merges = XCDR (face_remapping); + face_remapping = XCAR (face_remapping); + } + else + merges = Qnil; + + /* Recursively lookup FACE_REMAPPING, if it's not obviously bogus. */ + if (SYMBOLP (face_remapping) + && !NILP (face_remapping) + && !EQ (face_remapping, face_name)) + { + lface = lface_from_face_name_with_attrs (f, face_remapping, attrs, + signal_p, cycle_check); + + /* Merge in additional faces specified in the mapping. */ + if (attrs && !NILP (lface) && !NILP (merges)) + merge_face_inheritance (f, merges, attrs, cycle_check); + + return lface; + } + } + } + if (f) lface = assq_no_quit (face_name, f->face_alist); else *************** *** 3219,3227 **** --- 3277,3306 ---- signal_error ("Invalid face", face_name); check_lface (lface); + + if (attrs) + bcopy (XVECTOR (lface)->contents, attrs, LFACE_VECTOR_SIZE * sizeof *attrs); + return lface; } + /* Return the face definition of FACE_NAME on frame F. F null means + return the definition for new frames. FACE_NAME may be a string or + a symbol (apparently Emacs 20.2 allowed strings as face names in + face text properties; Ediff uses that). If FACE_NAME is an alias + for another face, return that face's definition. If SIGNAL_P is + non-zero, signal an error if FACE_NAME is not a valid face name. + If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face + name. */ + static INLINE Lisp_Object + lface_from_face_name (f, face_name, signal_p) + struct frame *f; + Lisp_Object face_name; + int signal_p; + { + return lface_from_face_name_with_attrs (f, face_name, 0, signal_p, Qnil); + } + /* Get face attributes of face FACE_NAME from frame-local faces on frame F. Store the resulting attributes in ATTRS which must point *************** *** 3237,3255 **** int signal_p; { Lisp_Object lface; ! int success_p; ! ! lface = lface_from_face_name (f, face_name, signal_p); ! if (!NILP (lface)) ! { ! bcopy (XVECTOR (lface)->contents, attrs, ! LFACE_VECTOR_SIZE * sizeof *attrs); ! success_p = 1; ! } ! else ! success_p = 0; ! ! return success_p; } --- 3316,3323 ---- int signal_p; { Lisp_Object lface; ! lface = lface_from_face_name_with_attrs (f, face_name, attrs, signal_p, Qnil); ! return !NILP (lface); } *************** *** 5779,5789 **** face couldn't be determined, which might happen if the default face isn't realized and cannot be realized. */ ! int ! lookup_named_face (f, symbol, c) struct frame *f; Lisp_Object symbol; int c; { Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; --- 5847,5858 ---- face couldn't be determined, which might happen if the default face isn't realized and cannot be realized. */ ! static int ! lookup_named_face_1 (f, symbol, c, signal_p) struct frame *f; Lisp_Object symbol; int c; + int signal_p; { Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; *************** *** 5796,5807 **** default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); } ! get_lface_attributes (f, symbol, symbol_attrs, 1); bcopy (default_face->lface, attrs, sizeof attrs); merge_face_vectors (f, symbol_attrs, attrs, Qnil); return lookup_face (f, attrs, c, NULL); } /* Return the ID of the realized ASCII face of Lisp face with ID LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */ --- 5865,5933 ---- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); } ! if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p)) ! return -1; ! bcopy (default_face->lface, attrs, sizeof attrs); merge_face_vectors (f, symbol_attrs, attrs, Qnil); + return lookup_face (f, attrs, c, NULL); } + /* Return the face id of the realized face for named face SYMBOL on + frame F suitable for displaying character C. Value is -1 if the + face couldn't be determined, which might happen if the default face + isn't realized and cannot be realized. */ + + int + lookup_named_face (f, symbol, c) + struct frame *f; + Lisp_Object symbol; + int c; + { + return lookup_named_face_1 (f, symbol, c); + } + + + /* Return the display face-id of the basic face who's canonical face-id + is FACE_ID. The return value will usually simply be FACE_ID, unless that + basic face has bee remapped via Vface_remappings. This function is + conservative: if something goes wrong, it will simply return FACE_ID + rather than signal an error. */ + + int + lookup_basic_face (f, face_id) + struct frame *f; + int face_id; + { + Lisp_Object name, mapping; + int remapped_face_id; + + if (NILP (Vface_remappings)) + return face_id; /* Nothing to do. */ + + switch (face_id) + { + case DEFAULT_FACE_ID: name = Qdefault; break; + case MODE_LINE_FACE_ID: name = Qmode_line; break; + case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break; + case HEADER_LINE_FACE_ID: name = Qheader_line; break; + + default: + return face_id; /* Give up. */ + } + + mapping = assq_no_quit (name, Vface_remappings); + if (NILP (mapping)) + return face_id; /* Give up. */ + + remapped_face_id = lookup_named_face_1 (f, name, 0, 0); + if (remapped_face_id < 0) + return face_id; /* Give up. */ + + return remapped_face_id; + } + /* Return the ID of the realized ASCII face of Lisp face with ID LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */ *************** *** 7372,7384 **** *endptr = endpos; ! default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); /* Optimize common cases where we can use the default face. */ if (noverlays == 0 && NILP (prop) && !(pos >= region_beg && pos < region_end)) ! return DEFAULT_FACE_ID; /* Begin with attributes from the default face. */ bcopy (default_face->lface, attrs, sizeof attrs); --- 7498,7515 ---- *endptr = endpos; ! ! /* Perhaps remap BASE_FACE_ID to a user-specified alternative. */ ! if (NILP (Vface_remappings)) ! default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); ! else ! default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID)); /* Optimize common cases where we can use the default face. */ if (noverlays == 0 && NILP (prop) && !(pos >= region_beg && pos < region_end)) ! return default_face->id; /* Begin with attributes from the default face. */ bcopy (default_face->lface, attrs, sizeof attrs); *************** *** 7839,7844 **** --- 7970,7985 ---- ignore. */); Vface_ignored_fonts = Qnil; + DEFVAR_LISP ("face-remappings", &Vface_remappings, + doc: /* Alist of face mappings. + Each element is of the form: + (FACE . NEW-FACE) + or + (FACE NEW-FACE MERGE-FACE...), + which causes NEW-FACE to be used where FACE normally would. + If present, MERGE-FACE... are merged during display with NEW-FACE. */); + Vface_remappings = Qnil; + DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist, doc: /* Alist of fonts vs the rescaling factors. Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where -Miles -- We are all lying in the gutter, but some of us are looking at the stars. -Oscar Wilde