Very preliminary patch for controlling XFT fonts for message display

 I asked about this issue on exmh-users earlier today and then (sort
of encouraged by Brent Welch) hacked together this crude, probably
not really good TCL, and preliminary patch to do this. This patch
allows exmh to pick XFT fonts for MIME messages and so on in the
same way that it can currently do this for old XLFD fonts using
'*mime_<charset>-<style>_families' resources. I hope my hack work
can be useful to someone.

 How it works and what I changed:
- Mime_GetFont is split into two versions. The current one is preserved
  entirely intact as Mime_GetFont_XLFD and I wrote a new one as
  Mime_GetFont_XFT. Mime_GetFont is now a short proc that picks the right
  one to call.

- Mime_GetFont_XFT forms XFT font names in a relatively obvious way:
  family plus size converted to points plus one or both of 'bold' and
  'italic' if we were asked for either.
- I added utf-8 and iso-10646-1 to the list of character sets that just
  used the MIME default font.

- I didn't implement searching through a space-separated list of font
  families. At the time I skipped it I was operating under the impression
  that TK 8.5 supported the standard XFT 'font1,font2,font3' form of
  letting XFT do the lookup, but now that I test it doesn't seem to.
  That should be added (somehow, it interacts with other bits).

- I failed to resist the temptation to use a new font default scheme for
  Mime_GetFont_XFT. If
	*mime_<charset>_<style>_families
  does not result in a good font, it tries to look up
	*mime_default_<style>_families
  instead. If it fails for that, it uses the MIME default font.

  In theory my goal is to avoid having to override a large list of
  font choices for specific encodings, since an XFT font should normally
  be able to handle pretty much any character set.

I have exposed this change to moderate testing and it seems to at least
sort of work. However, I don't have many messages with odd character
sets that I'm convinced are a) properly MIME-assembled and b) things
that exmh can handle and decode properly, so I haven't tested a bunch
of stuff there.

(Most of the messages I have in odd character sets are spam, and who
knows what MIME and character set horrors are lurking there.)

There is also a minimal change to app-defaults that I believe I need to
get the mime_default-<style>_families feature to work right, but I'm not
sure I understand the app-defaults/X resources side of the MIME code
correctly. There's probably a better way to handle this issue (if it's a
desirable feature in general).

There is an additional unrelated bugfix in mime.tcl that I need; it
avoids trying to use tell on a pipe file descriptor. I included it
partly because it's what 'cvs -q diff -u' spat out and partly because it
changes the line numbers later in the file for the Mime_GetFont changes.

The diff from a hot off the 'cvs up' presses CVS version:
Index: app-defaults
===================================================================
RCS file: /cvsroot/exmh/exmh/lib/app-defaults,v
retrieving revision 1.47
diff -u -r1.47 app-defaults
--- app-defaults	24 Apr 2011 03:44:48 -0000	1.47
+++ app-defaults	18 May 2012 18:00:15 -0000
@@ -641,10 +641,14 @@
 ! fonts available
 ! mime_charset maps to a font which uses the charset.
 !
-*mimeCharsets: us-ascii iso-8859-1 iso-8859-8 iso-2022-jp koi8-r iso-8859-2 iso-10646-1 utf-8
+*mimeCharsets: us-ascii iso-8859-1 iso-8859-8 iso-2022-jp koi8-r iso-8859-2 iso-10646-1 utf-8 default
 !
 *mimeUCharsets:
 
+! This must be present in order to get the default thing going? <cks>
+*mime_default_registry:	iso10646
+*mime_default_encoding:	1
+
 !
 ! For each defined character set, we need to know the registry and
 ! encoding used to find the fonts.
Index: mime.tcl
===================================================================
RCS file: /cvsroot/exmh/exmh/lib/mime.tcl,v
retrieving revision 1.59
diff -u -r1.59 mime.tcl
--- mime.tcl	21 Apr 2011 07:45:22 -0000	1.59
+++ mime.tcl	18 May 2012 18:00:15 -0000
@@ -2137,7 +2137,7 @@
     return $subpart
 }
 proc MimeParseSingle {tkw part fileIO } {
-    global mimeHdr mime miscRE msg
+    global mimeHdr mime miscRE msg mhProfile
 
     set mimeHdr($part=1,color) $mimeHdr($part,color)
     set part $part=1
@@ -2202,7 +2202,14 @@
         #
         set firstLine ""
         while {! [eof $fileIO]} {
-            set firstLinePosition [tell $fileIO]
+	    # We cannot do this if we are using an exmhshowproc, because
+	    # then $fileIO is a pipe. We have to assume in this situation
+	    # that we will never need firstLinePosition; it's the best we
+	    # can do.
+            #set firstLinePosition [tell $fileIO]
+	    if {! [info exists mhProfile(exmhshowproc)]} {
+	      set firstLinePosition [tell $fileIO]
+	    }
             gets $fileIO firstLine
             if { ! [regexp {(?n)^\s*$} $firstLine ] } {
               break
@@ -2681,6 +2688,106 @@
     }
 }
 proc Mime_GetFont {w weight slant fontSet size charset} {
+    # should be some kind of one-time flag?
+    if {[catch {::tk::pkgconfig get fontsystem} xft]} {
+	return [Mime_GetFont_XLFD $w $weight $slant $fontSet $size $charset]
+    } else {
+	return [Mime_GetFont_XFT $w $weight $slant $fontSet $size $charset]
+    }
+}
+
+proc Mime_GetFont_XFT {w weight slant fontSet size charset} {
+    global mime
+
+    # Insure there is always a default MIME font set so we can skip
+    # duplicating this later.
+	if ![info exists mime(defaultFont)] {
+	    set mime(defaultFont) [option get $w font Font]
+	    if {[string length $mime(defaultFont)] == 0} {
+		set mime(defaultFont) fixed
+	    }
+	}
+
+    # Handle the most common situation, using an XLFD-like pattern to
+    # match things easily. Note that unlike the XLFD case, we match
+    # UTF-8 and Unicode as well since the normal default font can handle
+    # that (well, we assume in the XFD world).
+    if {[string match medium-r-plain-$mime(fontSize)-us-ascii \
+	    $weight-$slant-$fontSet-$size-$charset] || \
+	    [string match medium-r-plain-$mime(fontSize)-utf-8 \
+	    $weight-$slant-$fontSet-$size-$charset] || \
+	    [string match medium-r-plain-$mime(fontSize)-iso-10646-1 \
+	    $weight-$slant-$fontSet-$size-$charset] || \
+	    [string match medium-r-plain-$mime(fontSize)-iso-8859-1 \
+	    $weight-$slant-$fontSet-$size-$charset]} {
+	# Special case the most common situation
+	return $mime(defaultFont)
+    }
+
+    # size is in decipoints, we want it in points. we assume that this
+    # division will always work right.
+    set points [expr {$size / 10}]
+
+    # Determine additional properties of the font, which is one or both of
+    # italic and bold. If we are being asked for medium regular, we
+    # leave this stuff blank.
+    set adds ""
+    if {[string compare $slant i] == 0} {
+	set adds "italic"
+    }
+    if {[string compare $weight bold] == 0} {
+	set adds "$adds bold"
+    }
+
+    # determine family. Since XFT does its own searching, XFT users
+    # should just comma separate their list of alternates; we don't
+    # look at any space-separated value apart from the first.
+    set family $mime(family,$charset,$fontSet,1)
+    if {[string compare $family "*"] == 0} {
+	set family $mime(family,default,$fontSet,1)
+	if {[string compare $family "*"] == 0} {
+	    return $mime(defaultFont)
+	}
+    }
+
+    # We do not attempt to specifically ask XFT for a spacing for various
+    # reasons, including that people want to use proportional and/or fixed
+    # fonts for 'plain text'. This means that the XFT font name we want is
+    # simply (in Tk format):
+    #	$family $points $adds
+    #
+    # See http://www.tcl.tk/man/tcl8.5/TkCmd/font.htm
+    set font "$family $points $adds"
+
+    # Try to see if the font exists.
+    # Our search order is:
+    # - specific font for the charset in that style
+    # - default font for the style
+    # - global MIME default font, which we assume has all of the characters
+    #   needed these days.
+    # an XFT-enabled app-defaults file should ship with default font
+    # settings of
+    # 	*mime_default_{fixed,plain}_families: monospace
+    #	*mime_default_{title,proportional}_families: sans-serif
+    # ... or something like that.
+
+    $w tag add dummyTag end
+    if {[catch {$w tag configure dummyTag -font $font} err]} {
+	# That one wasn't any good; let's look for another one
+        # try the universal choice: *mime_default_<style>_families:
+	set family $mime(family,default,$fontSet,1)
+        set font "$family $points $adds"
+        if {[catch {$w tag configure dummyTag -font $font} err]} {
+	    # the best we can do is the default font
+	    return $mime(defaultFont)
+        } else {
+	    return $font
+        }
+    }
+    return $font
+}
+
+proc Mime_GetFont_XLFD {w weight slant fontSet size charset} {
     global mime
     # weight = {bold medium}
     # slant = {i r}

	- cks