### Copyright (C) 1995 Jeppe Buk (buk@imada.ou.dk)
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
###
### [Thu Jun 5 1997]
### Some messages (label, help,..) were Japanized by MOTOYAMA,mashio
### <moto@ba.mbn.or.jp>. If you want to use original messages, try this URL.
### Dotfile Generator's Page<http://www.imada.ou.dk/~buk/dotfile/>

proc fonts {} {
  # フォント
  Desc "部品別のフォント構成"
  ShortDesc "フォント構成"

  set tempWin [makeTempWindow Retrieving]
  label $tempWin.fonts -text "フォント解析中。お待ち下さい..."
  label $tempWin.fontsCount -text "0"
  pack $tempWin.fonts
  pack $tempWin.fontsCount
  update
  set fontsCount 0
  set names [getFonts]
  
  if {$names != {}} {
    # The fonts have been found
    set aliases {{No alias - use criterias above}}
    global trueNames
    set trueNames {}
    foreach var {fndry fmly wght slant swdth adstyl pxlsz ptSz resx \
		     resy spc avgWdth rgstry encdng} {
      set $var {}
    }
    
    foreach font $names {
      set fontNameList [split $font -]
      if {[llength $fontNameList] != 15} {
	# The font name is an alias
	if {[lsearch -exact $aliases $font] == -1} {
	  lappend aliases $font
	}
      } else {
	# The font name is a full X font name
	lappend trueNames $font
	set index 1
	foreach var {fndry fmly wght slant swdth adstyl pxlsz ptSz resx \
			 resy spc avgWdth rgstry encdng} {
	  if {[lsearch -exact [set $var] [lindex $fontNameList $index]] == -1} {
	    lappend $var [lindex $fontNameList $index]
	  }
	  incr index
	}
      }
      incr fontsCount
      if {[expr "$fontsCount % 10"] == 0} {
	$tempWin.fontsCount configure -text $fontsCount
	update
      }
    }
    foreach var {fndry fmly wght slant swdth adstyl spc rgstry encdng} {
      set $var "* [lsort [set $var]]"
    }
    foreach var {pxlsz ptSz resx resy avgWdth} {
      set $var [removeNonIntegers [set $var]]
      set $var "* [lsort -integer [set $var]]"
    }
    destroy $tempWin
    
    Label fontCategory -font --*-helvetica-medium-r-*-*-18-*-*-*-*-*-*-* \
	-help "このラベルはフォントを変更する部品を表示しています"\
        "\n右のスクロールバーで部品間を移動します"
    Line fontLine
    CheckBox fontCheck -text "倫理名照合" \
	-help "このオプションがチェックしてあれば、" \
	"選択したフォントの倫理名がシステムに存在するかどうかを検査します" \
	"\n尚、この検査には少々の時間が必要になります"
    CheckBox showFont -text "サンプル表示" \
        -help "クリックすると選択しているフォントのサンプルを表示します"
    Frame checkBoxes -entries {fontCheck showFont}
    Label currRegExpr -help "現在選択しているフォントの倫理名です"
    Label checkLabel -help "上の「倫理名照合」をチェックしてあれば、" \
	"選択したフォントの倫理名がシステムに存在するかどうかを検査します"
    foreach var {fndry fmly wght slant swdth adstyl pxlsz ptSz resx \
		     resy spc avgWdth rgstry encdng} {
      Label label_$var -text $var -help "これは $var のフォントです。"
      Menu menu_$var -entries [set $var] -help "これは $var のフォントです。"
      Frame frame_$var -entries "label_$var menu_$var" -orient top
    }
    Frame frame1 -entries {
      frame_fndry frame_fmly frame_wght frame_slant frame_swdth frame_adstyl \
	  frame_pxlsz}
    Frame frame2 -entries {
      frame_ptSz frame_resx frame_resy frame_spc frame_avgWdth frame_rgstry \
	  frame_encdng}
    
    ListBox aliasesBox -width 70 -text "エイリアス" -entries $aliases \
	-help "これらはフォントの別名です。上の指定方法が嫌ならば、" \
	"この中から一つ選んで下さい"
    
    ExtEntry fontsEntry -noscissor 1 -entries {
      fontCategory fontLine checkBoxes currRegExpr checkLabel frame1 \
	  frame2 aliasesBox} \
	-orient top \
	-default {
	  {"Choose menu font" 0 "-*-*-*-*-*-*-*-*-*-*-*-*-*-*" \
	       "Font match: not checked"}
	  {"Choose window font" 0 "-*-*-*-*-*-*-*-*-*-*-*-*-*-*" \
	       "Font match: not checked"}
	  {"Choose icon font" 0 "-*-*-*-*-*-*-*-*-*-*-*-*-*-*" \
	       "Font match: not checked"}
	  {"Choose pager font" 0 "-*-*-*-*-*-*-*-*-*-*-*-*-*-*" \
	       "Font match: not checked"}
	} \
	-maxentries 4 -count 1 \
	-help "このページは、メニュー、ウインドウ、アイコン、" \
	"インターナル・ページャで使用するフォントを設定します。" \
	"部品の選択は右のスクロールバーの移動で行います"
  } else {
    error "Could not execute 'xlsfonts' - update your PATH"
  }

  SaveVars trueNames
  
  Init {
  }
  
  Change {
    if {[string match "menu_*" $changeElm] == 1} {
      set regExpr {}
      foreach var {fndry fmly wght slant swdth adstyl pxlsz ptSz resx \
		       resy spc avgWdth rgstry encdng} {
	append regExpr -[set menu_${var}(name)]
      }
      set currRegExpr $regExpr
    }
    if {[string match "menu_*" $changeElm] == 1 || $changeElm == "fontCheck"} {
      if {$fontCheck == 1} {
	set match 0
	foreach font $trueNames {
	  if {[string match $currRegExpr $font] == 1} {
	    set match 1
	    break
	  }
	}
	if {$match == 0} {
	  set checkLabel "照合結果: 存在していません！"
	} else {
	  set checkLabel "照合結果: 存在しています"
	}
      } else {
	set checkLabel "照合結果: 現在この機能は無効です"
      }
    }
    if {$changeElm == "showFont" && $showFont == 1} {
      set showFont 0
      if {[winfo exists .fontSample] == 0} {
	toplevel .fontSample
	wm title .fontSample "Font sample"
	label .fontSample.sample
	pack .fontSample.sample
	button .fontSample.ok -text Close -command {destroy .fontSample}
	pack .fontSample.ok
      }
      if {$aliasesBox(name) == {} || $aliasesBox(index) == 0} {
	  set fontName $currRegExpr
	} else {
	  set fontName $aliasesBox(name)
	}
      .fontSample.sample configure \
	  -text "このフォントのサンプルです\n$fontName" \
	  -font $fontName
    }
  }
  
  Save {
    forevery fontsEntry {
      switch $fontCategory {
	"Choose menu font"   {set fontType Font}
	"Choose window font" {set fontType WindowFont}
	"Choose icon font"   {set fontType IconFont}
	"Choose pager font"  {set fontType PagerFont}
      }
      if {$currRegExpr != {-*-*-*-*-*-*-*-*-*-*-*-*-*-*} || \
	      $aliasesBox(name) != {} && $aliasesBox(index) != 0} {
	if {$aliasesBox(name) == {} || $aliasesBox(index) == 0} {
	  print "$fontType\t$currRegExpr"
	} else {
	  print "$fontType\t$aliasesBox(name)"
	}
      }
    }
  }
}
