#!/bin/sh
# the next line restarts using wish \
exec /usr/pkg/bin/wish "$0" "--" "$@"

#                                                 #
#     EWIPE : Extended WIPE (Editor for WIPE)     #
#                                                 #
#   Copyright (C) 1997-2000  Hiromasa Sekishita   #
#                                                 #
#              This program conforms              #
#      GNU GENERAL PUBLIC LICENSE Version 2.      # 
#                                                 #

#              EWIPE Version 1.2.0                #

#                                                 #
#  If you want to use this program in the         # 
#  other directory, please change the path as     #
#  follows.                                       #
#    ex.                                          #
#     set PATH /usr/local/lib/ewipe               #
#                                                 #
#  (Japanese)                                     #
#  ewipe のあるディレクトリ以外から使う場合       #
#  には、次の部分を設定を変更して下さい。         #
#   例：                                          #
#     set PATH /usr/local/lib/ewipe               #
#                                                 #

set PATH /usr/pkg/share/ewipe

###################################################

# setting ewipe path

if {[info exists env(EWIPEPATH)]} {
    set PATH $env(EWIPEPATH)
}
lappend auto_path $PATH

# Tcl/Tk version check

if {[info tclversion] < 7.6} {
    puts stderr "EWIPE requires Tcl7.6/Tk4.2"
    exit
}

# check arguments for ewipe

proc argvcheck {} {
    global version
    global filename
    global filedir
    global argc argv
    global pwd
    global Viewmode 
    global Option

    for {set i 0} {$i < $argc} {incr i} {
        set argi [lindex $argv $i]
        switch -regexp -- $argi {
            {^-(V|[Vv]ersion)$} {
                puts stderr "EWIPE Version $version"
                exit
            }
            {^-(h|help)$} {
                puts stderr "Usage: ewipe \[option\] \[filename\]"
                puts stderr ""
                puts stderr "  -v, -view                 View Mode"
                puts stderr "  -V, -Version, -version    show version\
			infomation"
		puts stderr "  -e                        for English" 
                puts stderr "  -h, -help                 show this help"
		exit
            }
            {^-(v|view)$} {
                incr i
                if {$argc <= $i} {
                    puts stderr "ewipe: option \`$argi\' requires a filename"
                    exit
                }
		set filename [lindex $argv $i]
		if {[file exists $filename] != 1} {
		    puts stderr "ewipe: Can't find \`$filename\'"
		    exit
		} else {
		    set Viewmode 1
		    set filedir [file dirname $filename]
		    if {[catch {cd $filedir}] == 1} {
			puts stderr "ewipe: no such directory \`$filedir\'"
			exit
		    }
		    set filedir [pwd]
		    cd $pwd
		    break
		}
            }
            {^-e$} {
		set Option(LANG) eng
            }
            {^-} {
                puts stderr "ewipe: unknown option \`$argi\'"
		puts stderr "Try \`ewipe -h\' or \`ewipe -help\` for more\
			information."
                exit
	    }
            default {
                set filename $argi
		if {[file isdirectory $filename] == 1} {
		    puts stderr "ewipe: \`$filename\' is a directory"
		    exit
		}
		set filedir [file dirname $filename]
		if {[catch {cd $filedir}] == 1} {
		    puts stderr "ewipe: no such directory \`$filedir\'"
		    exit
		}
		set filedir [pwd]
		cd $pwd
                break
            }
        }
    }
    readfile
}

# ファイル読込み

proc readfile {} {
    global filename
    global docpages
    global docpagesorg
    global tcl_platform
    global Option

    set docpages {}
    set docpagesorg {}

    wm title . "EWIPE - $filename"
    if {[file exists $filename] != 1} {return}
    set file [open $filename r]
    while {![eof $file]} {
        set line [gets $file]
	if {$line == "option:"} {
	    set err 1
	    while {![eof $file]} {
		set line "[gets $file]"
		if {$line == ":end"} {set err 0; break}
		setoption $line
	    }
	} else {
	    append docpages "$line\n"
	}
    }
    close $file

    if {$Option(LANG) == "eng"} {
	set Option(lang) eng
    }
    if {[catch {llength $docpages}] == 1} {
	puts stderr "unmatched error \`\{\' or \`\}\'"
	set docpages {}
    }
    set docpagesorg $docpages

    if {$tcl_platform(platform) == "windows"} {
	set kcode {}
	catch {set kcode [kanji code $docpages]}
	if {$kcode == "EUC"} {
	    set docpages [kanji conversion EUC SJIS $docpages]
	}
    }
}

# 設定ファイル読み込み

proc readdotfile {} {
    global Option
    global env
    
    # デフォルト設定
    set Option(lang) eng        ;# 表示言語 (jpn:日本語  eng:英語)
    set Option(pagen) 0         ;# ページ番号表示 (for Viewer) (0:off  1:on)
    set Option(time) 0          ;# 時間表示 (0:off  1:on)
    set Option(timemode) 1      ;# 時間の表示方法 (0: 時刻  1:経過時間)
    set Option(pathtype) 1      ;# パスの形式 (0:絶対パス  1:相対パス)
    set Option(htmlcolor) 0     ;# HTML 出力時の文字色 (0:モノクロ  1:カラー)
    set Option(htmlfont) 0      ;# HTML 出力時の文字の大きさ (0:普通  1:大)
    set Option(viewersize) 0    ;# Viewer サイズ (0:640x480  1:800x600)
    set Option(vredraw) 0       ;# Viewer の自動再描画 (0:off  1:on)
    set Option(saveoptions) 1   ;# オプションの保存 (0:off  1:on)
    set Option(background) {}   ;# 背景
    set Option(bgtype) 0        ;# 背景の表示方法 (0:通常  1:背景を埋める)
    set Option(titletype) 0     ;# タイトルの形式 (0 - 1)
    set Option(pointer) normal  ;# ポインタの名前
    set Option(pointerfg) white ;# ポインタの前景色
    set Option(pointerbg) black ;# ポインタの背景色
    set Option(penleft) white   ;# 左のペンの色
    set Option(penright) red    ;# 右のペンの色
    set Option(backup) 1        ;# バックアップファイル作成 (0:しない  1:する) 
    set Option(startpage) {}
    set Option(LANG) jpn        ;#
    
    set filename "$env(HOME)/.ewipe"
    if {[file exists $filename] != 1} {return}
    
    set file [open $filename r]
    while {![eof $file]} {
        set str "[gets $file]"

        if {$str == "startpage:"} {
	    set err 1
	    while {![eof $file]} {
		set str "[gets $file]"
		if {$str == ":end"} {set err 0; break}
		append Option(startpage) "$str\n"
	    }
	    if {$err == 1} {
		set Option(startpage) {}
	    }
	} elseif {$str == "option:"} {
	    set err 1
	    while {![eof $file]} {
		set str "[gets $file]"
		if {$str == ":end"} {set err 0; break}
		setoption $str
	    }
	}
    }
    close $file
}

# オプション設定

proc setoption {str} {
    global Option
    set str0 [lindex $str 0]
    set str1 [lindex $str 1]
    
    switch $str0 {
	lang {
	    if {$str1 == "jpn" || $str1 == "eng"} {
		set Option(lang) $str1
	    }
	}
	pagen {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(pagen) $str1
	    }
	}
	time {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(time) $str1
	    }
	}
	timemode {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(timemode) $str1
	    }
	}
	pathtype {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(pathtype) $str1
	    }
	}
	htmlcolor {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(htmlcolor) $str1
	    }
	}
	htmlfont {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(htmlfont) $str1
	    }
	}
	viewersize {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(viewersize) $str1
	    }
	}
	vredraw {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(vredraw) $str1
	    }
	}
	vredraw {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(saveoptions) $str1
	    }
	}
	background {
	    set Option(background) $str1
	}
	bgtype {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(bgtype) $str1
	    }
	}
	titletype {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(titletype) $str1
	    }
	}
	pointer {
	    set Option(pointer) $str1
	}
	pointerfg {
	    set Option(pointerfg) $str1
	}
	pointerbg {
	    set Option(pointerbg) $str1
	}
	penleft {
	    set Option(penleft) $str1
	}
	penright {
	    set Option(penright) $str1
	}
	backup {
	    if {$str1 == 0 || $str1 == 1} {
		set Option(backup) $str1
	    }
	}
    }
}

# ビューウィンドウ表示

proc call_viewer {mode} {
    global Option
    global Viewmode
    global cp
    
    if {$mode == "view"} {
	wm withdraw .
	if {[winfo exists .view] == 0} {
	    viewer $cp
	} else {
	    view_showcanvas $cp
	}
    } elseif {$mode == "normal"} {
	if {$Viewmode == 0} {
	    if {[winfo exists .view] == 0} {
		viewer $cp
	    } else {
		view_showcanvas $cp
	    }
	}
    } elseif {$mode == "pagen"} {
	if {[winfo exists .view] == 1} {
	    if {$Option(pagen) == 1} {
		set Option(pagen) 0
	    } else {
		set Option(pagen) 1
	    }
	    show_pagen
	}
    } elseif {$mode == "time"} {
	if {[winfo exists .view] == 1} {
	    if {$Option(time) == 1} {
		set Option(time) 0
	    } else {
		set Option(time) 1
	    }
	    toggle_time
	}
    }
}

# 新規作成

proc new {} {
    global filename
    global docpages
    global docpagesorg
    global message
    global Option
    
    if {$docpages != $docpagesorg} {
        set result [tk_dialog .d New $message(load) warning \
		0 $message(ok) $message(no)]
        if {$result == 1} {return}
    }
    set filename {}
    wm title . "EWIPE"
    init
    changelang $Option(lang)
    changesize
    if {[winfo exists .view] == 1} {
	resetview 0
    }
}

# 読込み

proc load {} {
    global filename
    global filedir
    global docpages
    global docpagesorg
    global maxp
    global cursor
    global mode
    global message
    global pwd
    global Option
    
    if {$docpages != $docpagesorg} {
        set result [tk_dialog .d Load $message(load) warning \
		0 $message(ok) $message(no)]
        if {$result == 1} {return}
    }
    set oldname $filename

    set filename [fileDialog . Load open wipe $pwd {}]
    if {$filename == {}} {
	set filename $oldname
	return
    }
    set filedir [file dirname $filename]

    init
    readfile
    set maxp [llength $docpages]
    changelang $Option(lang)
    changesize
    if {[winfo exists .view] == 1} {
	resetview 0
    }
}

# 保存

proc save {} {
    global docpages
    global docpagesorg
    global filename
    global message
    global pwd
    global Option
    
    set oldname $filename

    if {$filename == {}} {set filename $pwd}
    set filename [fileDialog . Save save wipe $filename *.ewp]
    if {$filename == {}} {
	set filename $oldname
	return 0
    }
    if {[file exists $filename] && $Option(backup) == 1} {
	exec cp $filename $filename~
    }
    set file [open $filename w]
    output $file
    close $file
    wm title . "EWIPE - $filename"
    set docpagesorg $docpages
    return 1
}

# 初期化

proc init {} {
    global docpages
    global docpagesorg
    global cp
    global maxp
    global cursor
    global mode
    global clip
    global Option
    
    set cp 0
    set cursor {}
    set clip(line) {}
    set clip(page) {}
    ctrlbutton disabled
    
    readdotfile
    if {$Option(startpage) == {}} {
        set docpages {}
    } else {
        set docpages $Option(startpage)
    }
    set docpagesorg $docpages
    set maxp [llength $docpages]
    set mode page
}

# 出力
 
proc output {fd} {
    global commandlist
    global docpages
    global Option

    if {$Option(saveoptions) == 1} {
	puts $fd "option:"
	puts $fd "  lang $Option(lang)"
	puts $fd "  pagen $Option(pagen)"
	puts $fd "  time $Option(time)"
	puts $fd "  timemode $Option(timemode)"
	puts $fd "  pathtype $Option(pathtype)"
	puts $fd "  htmlcolor $Option(htmlcolor)"
	puts $fd "  htmlfont $Option(htmlfont)"
	puts $fd "  viewersize $Option(viewersize)"
	puts $fd "  vredraw $Option(vredraw)"
	puts $fd "  saveoptions $Option(saveoptions)"
	puts $fd "  background $Option(background)"
	puts $fd "  bgtype $Option(bgtype)"
	puts $fd "  titletype $Option(titletype)"
	puts $fd "  pointer $Option(pointer)"
	puts $fd "  pointerfg $Option(pointerfg)"
	puts $fd "  pointerbg $Option(pointerbg)"
	puts $fd "  penleft $Option(penleft)"
	puts $fd "  penright $Option(penright)"
	puts $fd ":end\n"
    }

    foreach i $docpages {
	puts $fd "{"
	foreach j $i {
	    set str0 [lindex $j 0]
	    if {[lsearch $commandlist $str0] != -1} {
		set str1 [lindex $j 1]
		set str2 [lindex $j 2]
		set str3 [lindex $j 3]
		if {$str3 != {}} {
		    set str $str0
		    lappend str $str1
		    lappend str $str2
		    lappend str $str3
		    puts $fd "    \{$str\}"
		} elseif {$str2 != {}} {
		    set str $str0
		    lappend str $str1
		    lappend str $str2
		    puts $fd "    \{$str\}"
		} else {
		    set str $str0
		    lappend str $str1
		    puts $fd "    \{$str\}"
		}
	    } else {
		puts $fd "    {$j}"
	    }
	}
	puts $fd "}\n"
    }
}

# HTML 出力
 
proc outputHTML {} {
    global commandlist
    global docpages
    global message
    global Option
    global pwd
    
    set htmlfile [fileDialog . "Save as HTML" save html $pwd *.html]
    if {$htmlfile == {}} {
	return 0
    }

    if {$Option(lang) == "jpn"} {
	set contents "目次"
	set next "次ページ"
	set prev "前ページ"
    } elseif {$Option(lang) == "eng"} {
	set contents "Table of Contents"
	set next "next"
	set prev "prev"
    }
    set list [split [string trim $htmlfile "/"] "/"]
    set s [expr [llength $list] - 1]
    set file [split [lindex $list $s] "."]
    set htmlname [lindex $file 0]

    set fd [open $htmlfile w]

    puts $fd "<HTML>\n<HEAD>"
    puts $fd "  <TITLE>$htmlname</TITLE>"
    puts $fd "</HEAD>"

    puts $fd "<BODY "
    if {$Option(background) != {}} {
        puts $fd "BACKGROUND=\"$Option(background)\" "
    } elseif {$Option(htmlcolor) == 1} {
        puts $fd "BGCOLOR=\"#27408B\" "
    }
    if {$Option(htmlcolor) == 1} {
	puts $fd "TEXT=\"#FFFFFF\" ALINK=\"#FFFF00\" VLINK=\"#C0C0C0\" LINK=\"#E0E0E0\">"
    } else {
	puts $fd ">"
    }
    puts $fd "<A NAME=\"contents\"></A>"
    puts $fd "<H1>$contents</H1>"
    puts $fd "<OL>"
    set page 1
    foreach i $docpages {
	set label [lindex [lindex $i 0] 0]
	if {[lsearch $commandlist $label] != -1} {
	    if {$label != "text" && $label != "textbox"} {
		set title [lindex [lindex $i 0] 1]
	    } else {
		set title {}
	    }
	} else {
	    set title {}
	}
	puts $fd "  <A HREF=\"#page-$page\"><LI>$title</A>"
	incr page
    }
    puts $fd "</OL>"
    puts $fd "<HR>\n<P>"
    puts $fd "<CENTER>"
    puts $fd "  <A HREF=\"#page-1\">\[$next\]</A>"
    puts $fd "</CENTER>\n<P>"
    
    set maxpage [llength $docpages]
    set page 1
    foreach i $docpages {
	puts $fd "<A NAME=\"page-$page\"></A>"
	puts $fd "<HR NOSHADE>\n<P>"
	if {$Option(htmlcolor) == 1} {
	    puts $fd "<FONT COLOR=\"#00FF00\">"
	} else {
	    puts $fd "<FONT COLOR=\"#FF0000\">"
	}
	puts $fd "  <DIV ALIGN=\"RIGHT\">page $page / $maxpage</DIV>"
	puts $fd "</FONT>\n<P>"

	if {$Option(htmlfont) == 1} {
	    puts $fd "<FONT SIZE = 5>\n<P>"
	}

	foreach j $i {
	    if {[lindex $j 0] == "move"} {
		set j [lindex $j 1]
	    }
	    set str0 [lindex [lindex $j 0] 0]
	    set str1 [lindex $j 1]
	    set str2 [lindex $j 2]

	    set colormode 0
	    if {$Option(htmlcolor) == 1} {
		set color [name2rgb $str2 r]
		if {$color != -1} {
		    set colormode 1
		    puts $fd "<FONT COLOR=\"$color\">"
		}
	    }
	    
	    switch $str0 {
		title {
		    puts $fd "<CENTER>"
		    if {$Option(htmlcolor) == 1} {
			puts $fd "<FONT COLOR=\"#FFFF00\">"
		    }
		    puts $fd "<H1>$str1</H1>"
		    if {$str2 != {}} {
			if {$Option(htmlfont) == 1} {
			    puts $fd "    <H1>$str2</H1>"
			} else {
			    puts $fd "    <H2>$str2</H2>"
			}
		    }
		    if {$Option(htmlcolor) == 1} {
			puts $fd "</FONT>"
		    }
		    puts $fd "</CENTER>"
		}
		item {
		    puts $fd "<UL>"
		    puts $fd "  <LI>$str1"
		    puts $fd "</UL>"
		}
		subitem {
		    puts $fd "<UL>"
		    puts $fd "  <UL>"
		    puts $fd "    <LI>$str1"
		    puts $fd "  </UL>"
		    puts $fd "</UL>"
		}
		subsubitem {
		    puts $fd "<UL>"
		    puts $fd "  <UL>"
		    puts $fd "    <UL>"
		    puts $fd "      <LI>$str1"
		    puts $fd "    </UL>"
		    puts $fd "  </UL>"
		    puts $fd "</UL>"
		}
		subsubsubitem {
		    puts $fd "<UL>"
		    puts $fd "  <UL>"
		    puts $fd "    <UL>"
		    puts $fd "      <UL>"
		    puts $fd "        <LI>$str1"
		    puts $fd "      </UL>"
		    puts $fd "    </UL>"
		    puts $fd "  </UL>"
		    puts $fd "</UL>"
		}
		left {
		    puts $fd "$str1<P>"
		}
		center {
		    puts $fd "<CENTER>"
		    puts $fd "  $str1<P>"
		    puts $fd "</CENTER>"
		}
		right {
		    puts $fd "<DIV ALIGN=\"RIGHT\">"
		    puts $fd "  $str1"
		    puts $fd "</DIV>"
		}
		pict {
		    puts $fd "<CENTER>"
		    puts $fd "  <IMG SRC=\"$str1\" ALT=\"$str1\"></P>"
		    puts $fd "</CENTER>"
		}
		animation {
		    set str1 [lindex $str1 0]
		    puts $fd "<CENTER>"
		    puts $fd "  <IMG SRC=\"$str1\" ALT=\"$str1\"></P>"
		    puts $fd "</CENTER>"
		}
		pp {
		    puts $fd "$str1<P>"
		}
		rp {
		    puts $fd "<DIV ALIGN=\"RIGHT\">"
		    puts $fd "  $str1"
		    puts $fd "</DIV>"
		}
		symbol {
		    if {$str1 == "uparrow"} {
			    puts $fd "<CENTER>↑</CENTER><P>"
		    } elseif {$str1 == "downarrow"} {
			puts $fd "<CENTER>↓</CENTER><P>"
		    } elseif {$str1 == "updownarrow"} {
			puts $fd "<CENTER>↑↓</CENTER><P>"
		    } elseif {$str1 == "cdot"} {
			puts $fd "<CENTER>・</CENTER><P>"
		    } elseif {$str1 == "vdots"} {
			puts $fd "<CENTER>：</CENTER><P>"
		    }
		}
		text {
                    puts $fd "<PRE>"
		    set str1 [string trim $str1 "\n"]
		    set strlist [split $str1 "\n"]
		    foreach i $strlist {
			puts $fd "$i<BR>"
		    }
                    puts $fd "</PRE>"
		    puts $fd "<P>"
		}
		textbox {
                    puts $fd "<PRE>"
		    set str1 [string trim $str1 "\n"]
		    set strlist [split $str1 "\n"]
		    foreach i $strlist {
			puts $fd "  $i<BR>"
		    }
                    puts $fd "</PRE>"
		    puts $fd "<P>"
		}
		message {
		    set str1 [string trim $str1 "\n"]
		    set strlist [split $str1 "\n"]
		    foreach i $strlist {
			puts $fd "  $i<BR>"
		    }
		    puts $fd "<P>"
		}
		label {
		    puts $fd "<CENTER>"
		    puts $fd "  $str2<P>"
		    puts $fd "</CENTER>"
		}
                table {
                    puts $fd "<DIV ALIGN=\"CENTER\"><TABLE BORDER>"
                    set define [lindex $str1 0]
                    set define [view_cutcode $define]
                    set col [expr [llength $define] * 2 + 1] 
                    set line [llength $str1]
		    
                    for {set i 0} {$i < [llength $define]} {incr i} {
                        switch -exact [lindex $define $i] {
                            l {set align($i) "left"}
                            c {set align($i) "center"}
                            r {set align($i) "right"}
                        }
                    }

                    for {set i 2} {$i < $line} {incr i 2} {
                        puts $fd " <TR>"
                        set textlist [lindex $str1 $i]
                        if {$textlist != {}} { 
                            for {set j 1} {$j < $col} {incr j 2} {
                                set column 1
                                set nextj $j
                                if {[lindex $textlist [expr $j + 1]] == "_"} {
                                    for {set k [expr $j + 1]} \
                                            {[lindex $textlist $k] == "_" && $k < $col} \
                                            {incr k 2} {
                                        incr column
                                    }
                                    set nextj [expr $k + 1]
                                }
                                set data [lindex $textlist $j]
                                set pos [expr $j / 2]
                                puts $fd "  <TD COLSPAN=\"$column\" ALIGN=\"$align($pos)\">$data</TD>"
                                set j $nextj
                            }
                        }
                        puts $fd " </TR>"
                    }
                    puts $fd "</TABLE></DIV>"
                }
	    }
	    if {$colormode == 1} {
		puts $fd "</FONT>"
	    }
	}

	if {$Option(htmlfont) == 1} {
	    puts $fd "</FONT>\n<P>"
	}

	puts $fd "<P>\n<HR>\n<P>"
	puts $fd "<CENTER>"
	puts $fd "  <A HREF=\"#page-[expr $page-1]\">\[ $prev \]</A>"
	puts $fd "  <A HREF=\"#contents\">\[ $contents \]</A>"
	if {$page < $maxpage} {
	    puts $fd "  <A HREF=\"#page-[expr $page+1]\">\[ $next \]</A>"
	}
	puts $fd "</CENTER>"
	incr page
	puts $fd "<P>"
    }
    puts $fd "</BODY>\n</HTML>"

    close $fd
}

# mgp 形式データ出力
 
proc outputMGP {} {
    global commandlist
    global docpages
    global message
    global Option
    global pwd

    set mgpfile [fileDialog . "Save as MGP" save mgp $pwd *.mgp]
    if {$mgpfile == {}} {
        return 0
    }

    set list [split [string trim $mgpfile "/"] "/"]
    set s [expr [llength $list] - 1]
    set file [split [lindex $list $s] "."]
    set mgpname [lindex $file 0]

    set fd [open $mgpfile w]
    kanji outputCode $fd JIS

    puts $fd "%% This file is generated by EWIPE"
    puts $fd "%%"
    puts $fd {%include "default.mgp"}

    set maxpage [llength $docpages]
    set page 1

    foreach i $docpages {
	puts $fd "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
	puts $fd "%page"
	puts $fd {}

	set str [lindex $i 0]
	
	if {[lindex [lindex $str 0] 0] == "title"} {
	    puts $fd [lindex $str 1]
	    puts $fd {}
	    if {[lindex $str 2] != {}} {
		puts $fd {}
		puts $fd [lindex $str 2]
	    }
	} else {
	    puts $fd {}
	    puts $fd {}
	}
	set i [lreplace $i 0 0]

	foreach j $i {
	    set str0 [lindex [lindex $j 0] 0]
	    set str1 [lindex $j 1]
	    set str2 [lindex $j 2]
	    set str3 [lindex $j 3]
	    
	    switch $str0 {
		title {
		    puts $fd "%center"
		    puts $fd $str1
		    if {$str2 != {}} {
			puts $fd $str2
		    }
		    puts $fd "%left"
		}
		item {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "\t$str1"
		    e2m_endcolorsize $fd
		}
		subitem {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "\t\t$str1"
		    e2m_endcolorsize $fd
		}
		subsubitem {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "\t\t\t$str1"
		    e2m_endcolorsize $fd
		}
		subsubsubitem {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "        - $str1"
		    e2m_endcolorsize $fd
		}
		left {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "%left"
		    puts $fd $str1
		    e2m_endcolorsize $fd
		}
		center {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "%center"
		    puts $fd $str1
		    puts $fd "%left"
		    e2m_endcolorsize $fd
		}
		right {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "%right"
		    puts $fd $str1
		    puts $fd "%left"
		    e2m_endcolorsize $fd
		}
		pict {
		    puts $fd "%center"
		    puts $fd "%IMAGE \"$str1\""
		    puts $fd "%left"
		}
		pp {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "%left"
		    puts $fd $str1
		    e2m_endcolorsize $fd
		}
		rp {
		    e2m_colorsize $str2 $str3 $fd
		    puts $fd "%right"
		    puts $fd $str1
		    puts $fd "%left"
		    e2m_endcolorsize $fd
		}
		symbol {
		    if {$str1 == "uparrow"} {
			puts $fd "%center"
			puts $fd "↑"
			puts $fd "%left"
		    } elseif {$str1 == "downarrow"} {
			puts $fd "%center"
			puts $fd "↓"
			puts $fd "%left"
		    } elseif {$str1 == "updownarrow"} {
			puts $fd "%center"
			puts $fd "↑↓"
			puts $fd "%left"
		    } elseif {$str1 == "cdot"} {
			puts $fd "%center"
			puts $fd "・"
			puts $fd "%left"
		    } elseif {$str1 == "vdots"} {
			puts $fd "%center"
			puts $fd "："
			puts $fd "%left"
		    }
		}
		text {
		    puts $fd "%left"
		    puts $fd $str1
		}
		textbox {
		    puts $fd "%left"
		    puts $fd $str1
		}
		table {
		}
		animation {
		    puts $fd "%center"
		    set count 0
		    foreach k $str1 {
			if {$count == 0} {
			    puts $fd "%mark, image \"$k\""
			    puts $fd {}
			    incr count
			} elseif {$count == 1} {
			    puts $fd "%pause, again, mark, image \"$k\""
			    puts $fd {}
			    incr count
			} else {
			    if {$str2 == "-1"} { 
				puts $fd "%pause, again, mark, image \"$k\""
			    } else {
				puts $fd "%again, mark, image \"$k\""
			    }
			    puts $fd {}
			    incr count
			}
		    }
		    puts $fd "%left"
		}
		move {
		    e2m_colorsize [lindex $str1 2] [lindex $str1 3] $fd
		    if {$str2 == "nw" || $str2 == "w" || $str2 == "sw" || \
			    $str2 == "n" || $str2 == "s"} {
			puts $fd "%lcutin"
		    } else {
			puts $fd "%rcutin"
		    }
		    puts $fd [lindex $str1 1]
		    e2m_endcolorsize $fd
		}
		pause {
		    puts $fd "%pause"
		}
		exec {
		    puts $fd "%xsystem \"$str1\"" 
		}
		figure {
		}
		label {
		}
		message {
		}
		cleft {
		}
		prog {
		}
	    }
	}
    }
    close $fd
}

# フォントサイズ、色設定

proc e2m_colorsize {color size fd} {
    if {$size != ""} {
	set fsize [expr [lindex $size 0] / 3]
    } else {
	set fsize 7
    }
    if {$color == ""} {
	set color white
    }
    puts $fd "%SIZE $fsize,FORE \"$color\""
}

# デフォルト色設定

proc e2m_endcolorsize {fd} {
    puts $fd "%SIZE 7,FORE \"white\""
}

# 終了

proc exitewipe {} {
    global docpages
    global docpagesorg
    global message
    global view_ps
    global tcl_platform

    set s 1
    if {$docpages != {} && $docpages != $docpagesorg} {
        set result [tk_dialog .d Exit $message(exit) warning \
		0 $message(save) $message(no) $message(cancel)]
        if {$result == 0} {set s [save]}
        if {$result == 1} {set s 1}
        if {$result == 2} {return}
    }
    if {$s == 1} {
	if {$tcl_platform(platform) != "windows"} {
	    if {[info exists view_ps] == 1} {
		foreach i $view_ps(id) {
		    if {[lsearch [exec ps] [lindex $view_ps(id) $i]] == -1} {
			exec kill $i
		    }
		}
	    }
	}
	exit
    }
}

# ラベル作成

proc makelabel {label} {
    global docpages
    global cp
    global maxp
    global cursor
    global newcursor

    set cursor $newcursor
    set curpage [lindex $docpages $cp]
    set curpage [linsert $curpage $cursor "$label {}"]
    
    if {[lindex $docpages $cp] != {}} {
	set docpages [lreplace $docpages $cp $cp $curpage]
    } else {
	lappend docpages $curpage
	incr maxp
    }
    if {$label != "pause"} {
	resetpage
	edittext
    } else {
	insertpause
    }
}

# テキスト入力

proc inputtext {x y m} {
    global docpages
    global cp
    global maxp
    global lnum
    global cursor
    global newcursor
    global scrY
    global Option
    global tcl_platform

    if {[winfo exists .fe] == 1} {return}

    if {$y != {}} {
	set x [.fc.c canvasx $x]
	set y [.fc.c canvasy $y]

	set wy $lnum
	for {set i 0} {$i < $lnum} {incr i} {
	    if {$y < $scrY($i)} {
		set wy $i
		break
	    }
	}
	set newcursor $wy
    } else {
	if {$cursor == {}} {
	    set newcursor 0
	} else {
	    if {$m == 1} {
		set newcursor [expr $cursor + 1]
	    } else {
		set newcursor $cursor
	    }
	}
    }

    if {$newcursor == 0} {
	makelabel title
    } else {
	set x [winfo pointerx .]
	set y [winfo pointery .]
	
	.pmml post [expr $x - 5] [expr $y - 5]
	focus .pmml
	if {$tcl_platform(platform) == "windows"} {
	    update
	    tkwait visibility .pmml
	}
        bind .pmml <FocusOut> {
            .pmml unpost
        }
    }
}

# edit ボタン処理

proc edittext {} {
    global cursor

    if {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "   "} {
	return
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "title"} {
	changetitle
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "pict"} {
	changefile
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "symbol"} {
	update
	popupmenu symbol
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "table"} {
	changetable
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "animation"} {
	changeanimation
    } elseif {[lindex [.fc.c.lb1($cursor) configure -text] 4] == "pause"} {
	insertpause
    } else {
	changetext
    }
}

# テキスト変更

proc changetext {} {
    global docpages
    global cp
    global cursor
    global message
    global str2 str3
    global deffonts
    global work

    set curpage [lindex $docpages $cp]
    set line [lindex $curpage $cursor]
    if {[lindex $line 0] == "move"} {
	set text [lindex [lindex $line 1] 1]
    } else {
	set text [lindex $line 1]
    }
    toplevel .fe
    wm title .fe edit

    text .fe.tt -width 56 -height 5
    frame .fe.fb1
    set str2 [lindex $line 2]
    if {$str2 == {}} {
	set str2 default
    }
    set str3 [lindex [lindex $line 3] 0]
    if {$str3 == {}} {
	set str3 default
    }
    tk_optionMenu .fe.fb1.mc str2 default white yellow green orange red \
	    skyblue gray
    eval [concat {tk_optionMenu .fe.fb1.mf str3 default} $deffonts]
    frame .fe.fb2
    button .fe.fb2.bo -text $message(ok) -command {
	set str1 [.fe.tt get 1.0 "end - 1 chars"]
	set str1 [string trim $str1 "\n"]
	destroy .fe
	set curpage [lindex $docpages $cp]
	set line [lindex $curpage $cursor]
	if {[lindex $line 0] == "move"} {
	    set str0 [lindex [lindex $line 1] 0]
	    set strd {}
	    lappend strd $str0
	    lappend strd $str1
	    set str2 [lindex [lindex $line 1] 2]
	    if {$str2 != {}} {
		lappend strd $str2
	    }
	    set str3 [lindex [lindex $line 1] 3]
	    if {$str3 != {}} {
		lappend strd $str3
	    }
	    set str [lindex $line 0]
	    lappend str $strd
 	    lappend str [lindex $line 2]
	    set curpage [lreplace $curpage $cursor $cursor $str]
	    set docpages [lreplace $docpages $cp $cp $curpage]
   	} else {
	    set str0 [lindex $line 0]
	    set str {}
	    lappend str $str0
	    lappend str $str1
	    # set str2 [lindex $line 2]
	    if {$str2 != "default"} {
		lappend str $str2
	    } else {
		if {$str3 != "default"} {
		    lappend str {}
		}
	    }
	    # set str3 [lindex $line 3]
	    if {$str3 != "default"} {
		lappend str $str3
	    }
	    set curpage [lreplace $curpage $cursor $cursor $str]
	    set docpages [lreplace $docpages $cp $cp $curpage]
	    
	    if {$str3 != "default"} {
		set work(fonts) $str3
		changefont {}
	    }
	}
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    button .fe.fb2.bc -text $message(cancel) -command {
	destroy .fe
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    pack .fe.fb1.mc .fe.fb1.mf -side left
    pack .fe.fb2.bo .fe.fb2.bc -side left
    if {[lindex $line 0] == "move"} {
	pack .fe.tt .fe.fb2
    } else {
	pack .fe.fb1 .fe.tt .fe.fb2
    }
    .fe.tt insert 1.0 $text

    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.tt
    update
    grab .fe
    tkwait window .fe
}

# タイトル変更

proc changetitle {} {
    global docpages
    global cp
    global cursor
    global message

    set curpage [lindex $docpages $cp]
    set text1 [lindex [lindex $curpage $cursor] 1]
    set text2 [lindex [lindex $curpage $cursor] 2]
    toplevel .fe
    wm title .fe title

    frame .fe.tt
    frame .fe.ts
    label .fe.tt.lb -text "  title  "
    label .fe.ts.lb -text "sub title"
    text .fe.tt.en -width 48 -height 2
    text .fe.ts.en -width 48 -height 2
    frame .fe.fb
    button .fe.fb.bo -text $message(ok) -command {
	set str1 [.fe.tt.en get 1.0 "end - 1 chars"]
	set str2 [.fe.ts.en get 1.0 "end - 1 chars"]
	set str1 [string trim $str1 "\n"]
	set str2 [string trim $str2 "\n"]
	destroy .fe
	set curpage [lindex $docpages $cp]
	if {$str2 == {}} {
	    set str title
	    lappend str $str1
	    set curpage [lreplace $curpage $cursor $cursor $str]
	} else {
	    set str title
	    lappend str $str1
	    lappend str $str2
	    set curpage [lreplace $curpage $cursor $cursor $str]
	}
	set docpages [lreplace $docpages $cp $cp $curpage]
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    button .fe.fb.bc -text $message(cancel) -command {
	destroy .fe
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    pack .fe.tt.lb .fe.tt.en -side left
    pack .fe.ts.lb .fe.ts.en -side left
    pack .fe.fb.bo .fe.fb.bc -side left
    pack .fe.tt .fe.ts .fe.fb
    .fe.tt.en insert 1.0 $text1
    .fe.ts.en insert 1.0 $text2

    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.tt.en
    update
    grab .fe
    tkwait window .fe
}

# ファイル変更

proc changefile {} {
    global filedir
    global docpages
    global cp
    global cursor
    global message
    global filedir
    global Option
    global pwd
    
    set curpage [lindex $docpages $cp]

    toplevel .fe
    wm title .fe pict

    entry .fe.en -width 60
    frame .fe.fb
    button .fe.fb.bo -text $message(ok) -command {
        set str1 [.fe.en get]
        destroy .fe
        if {$str1 == {}} {return}
        set curpage [lindex $docpages $cp]
        set str0 [lindex [lindex $curpage $cursor] 0]
	set str $str0
	lappend str $str1
        set curpage [lreplace $curpage $cursor $cursor $str]
        set docpages [lreplace $docpages $cp $cp $curpage]
        resetpage
        ctrlbutton normal
        ctrlcobutton $cursor
    }
    button .fe.fb.bb -text $message(browse) -command {
	set initfile [.fe.en get]
	if {[file exists $initfile] == 0} {
	    set initfile {}
	} else {
	    set afile [file tail $initfile]
	    cd [file dirname $initfile]
	    set adir [pwd]
	    cd $pwd
	    set initfile $adir/$afile
	}
	set fname [fileDialog .fe "Select GIF File" open image $initfile {}]
        if {$fname != ""} {
	    if {$Option(pathtype) == 1} {
		set fname [relativepath $filedir $fname] 
	    }
            .fe.en delete 0 end
            .fe.en insert 0 $fname
        }
    }
    button .fe.fb.bc -text $message(cancel) -command {
        destroy .fe
    }
    pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left
    pack .fe.en .fe.fb
    set text [lindex [lindex $curpage $cursor] 1]
    .fe.en insert 0 $text

    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.en
    update
    grab .fe
    tkwait window .fe
}

# animation 設定

proc changeanimation {} {
    global filedir
    global docpages
    global cp
    global cursor
    global message
    global filedir
    global Option
    global pwd
    
    set curpage [lindex $docpages $cp]
    
    toplevel .fe
    wm title .fe animation
    
    entry .fe.en -width 60
    frame .fe.fb
    button .fe.fb.bo -text $message(ok) -command {
        set str1 [.fe.en get]
        destroy .fe
        if {$str1 == {}} {return}
        set curpage [lindex $docpages $cp]
        set str0 [lindex [lindex $curpage $cursor] 0]
	set str $str0
	lappend str $str1
	set str2 [lindex [lindex $curpage $cursor] 2]
	if {$str2 != {}} {
	    lappend str $str2
	}
        set curpage [lreplace $curpage $cursor $cursor $str]
        set docpages [lreplace $docpages $cp $cp $curpage]
        resetpage
        ctrlbutton normal
        ctrlcobutton $cursor
    }
    button .fe.fb.bb -text $message(browse) -command {
	set initfile [lindex [.fe.en get] 0]
	if {[file exists $initfile] == 0} {
	    set initfile {}
	} else {
	    set afile [file tail $initfile]
	    cd [file dirname $initfile]
	    set adir [pwd]
	    cd $pwd
	    set initfile $adir/$afile
	}
	set fname [fileDialog .fe "Select GIF File" open image $initfile {}]
        if {$fname != ""} {
	    if {$Option(pathtype) == 1} {
		set fname [relativepath $filedir $fname] 
	    }
            .fe.en insert end "$fname "
        }
    }
    button .fe.fb.bc -text $message(cancel) -command {
        destroy .fe
    }
    pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left
    pack .fe.en .fe.fb
    set text [lindex [lindex $curpage $cursor] 1]
    .fe.en insert 0 $text

    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.en
    update
    grab .fe
    tkwait window .fe
}

# pause 挿入

proc insertpause {} {
    global docpages
    global cp
    global cursor
    
    set curpage [lindex $docpages $cp]
    set str pause
    set curpage [lreplace $curpage $cursor $cursor $str]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# 選択メニュー表示

proc popupmenu {select} {
    global tcl_platform
    
    set x [winfo pointerx .]
    set y [winfo pointery .]

    switch $select {
	label {
	    .pml post $x $y
	    focus .pml
	    if {$tcl_platform(platform) == "windows"} {
		update
		tkwait visibility .pml
	    }
	    bind .pml <FocusOut> {
		.pml unpost
	    }
	}
	color {
	    .pmc post $x $y
	    focus .pmc
	    if {$tcl_platform(platform) == "windows"} {
		update
		tkwait visibility .pmc
	    }
	    bind .pmc <FocusOut> {
		.pmc unpost
	    }
	}
	font {
	    .pmf post $x $y
	    focus .pmf
	    if {$tcl_platform(platform) == "windows"} {
		update
		tkwait visibility .pmf
	    }
	    bind .pmf <FocusOut> {
		.pmf unpost
	    }
	}
	symbol {
	    .pms post $x $y
	    focus .pms
	    if {$tcl_platform(platform) == "windows"} {
		update
		tkwait visibility .pms
	    }
	    bind .pms <FocusOut> {
		.pms unpost
	    }
	}
	attr {
	    .pma post $x $y
	    focus .pma
	    if {$tcl_platform(platform) == "windows"} {
		update
		tkwait visibility .pma
	    }
	    bind .pma <FocusOut> {
		.pma unpost
	    }
	}
    }
}

# 表作成

proc changetable {} {
    global docpages
    global cp
    global cursor
    
    set curpage [lindex $docpages $cp]
    set str1 [edittable [lindex [lindex $curpage $cursor] 1]]
    if {$str1 == {}} {return}
    
    set str table
    lappend str $str1
    set curpage [lreplace $curpage $cursor $cursor $str]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# ファイルダイアログ

proc fileDialog {w title operation type initfile ext} {
    set file ""
    if {$type == "image"} {
        set types {
            {"Image Files"   {.gif}       }
            {"All Files"     *            }
        }
    } elseif {$type == "html"} {
        set types {
            {"HTML Files"   {.html .htm}   }
            {"All Files"    *              }
	}
    } elseif {$type == "mgp"} {
        set types {
            {"MGP Files"   {.mgp}         }
            {"All Files"    *              }
	}
    } elseif {$type == "wipe"} {
        set types {
            {"EWIPE Files"   {.ewp .wipe}   }
            {"All Files"    *             }
	}
    } elseif {$type == {}} {
        set types {
            {"All Files"    *         }
	}
    }
    if {[file exists $initfile] == 1} {
	if {[file isfile $initfile]} {
	    set initd [file dirname $initfile]
	    if {$initd == "."} {set initd {}} 
	    set initf [file tail $initfile]
	} else {
	    set initd $initfile
	    set initf $ext
	}
    } else {
	set initd [file dirname $initfile]
	if {$initd == "."} {set initd {}} 
	set initf [file tail $initfile]
    }

    if {$operation == "open"} {
        set file [tk_getOpenFile -title $title -filetypes $types -parent $w \
		-initialdir $initd]
    } elseif {$operation == "save" } {
        set file [tk_getSaveFile -title $title -filetypes $types -parent $w \
                -initialdir $initd -initialfile $initf]
    }
    if {$file != ""} { 
	return $file
    }
}

# ラベル変更

proc changelabel {x} {
    global commandlist
    global docpages
    global cp
    global cursor
    
    .fc.c.lb1($cursor) configure -text $x
    set curpage [lindex $docpages $cp]

    set str [lindex [lindex $curpage $cursor] 0]

    if {[lsearch $commandlist $str] != -1} {
	if {$str != $x} {
	    set pattern [checklabel $str $x]
	} else {
	    set pattern 2
	}
	set str1 [lindex [lindex $curpage $cursor] 1]
	set str2 [lindex [lindex $curpage $cursor] 2]
	set str3 [lindex [lindex $curpage $cursor] 3]
	if {$pattern == 0} {
	    set str $x
	    lappend str {}
	} elseif {$pattern == 1} {
	    set str $x
	    lappend str $str1
	} elseif {$pattern == 2} {
	    set str $x
	    lappend str $str1
	    if {$str2 != {}} {
		lappend str $str2
	    }
	    if {$str3 != {}} {
		lappend str $str3
	    }
	}
    } else {
	set str $x
	lappend str {}
    }
    set curpage [lreplace $curpage $cursor $cursor $str]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# ラベルチェック

proc checklabel {old new} {
    if {$old == "title" || $old == "textbox"} {
	if {$new == "table" || $new == "pict" || $new == "symbol" \
		|| $new == "animation"} {
	    return 0
	} else {
	    return 1
	}
    } elseif {$old == "table" || $old == "pict"|| $old == "symbol" \
	    || $old == "animation"} {
	return 0
    } else {
	if {$new == "table" || $new == "pict" || $new == "symbol" \
		|| $new == "animation"} {
	    return 0
	} elseif {$new == "title" || $new == "textbox"} {
	    return 1
	} else {
	    return 2
	}
    }
}

# ラベル詳細設定

proc setlabelopt {} {
    global docpages
    global cp
    global cursor
    global message

    set curpage [lindex $docpages $cp]
    set line [lindex $curpage $cursor]
    set text [lindex [lindex $line 0] 1]

    toplevel .fe
    wm title .fe label
    
    text .fe.tt -width 40 -height 1
    frame .fe.fb
    button .fe.fb.bo -text $message(ok) -command {
	set str1 [.fe.tt get 1.0 "end - 1 chars"]
	set str1 [string trim $str1 "\n"]
	destroy .fe
	set curpage [lindex $docpages $cp]
	set line [lindex $curpage $cursor]
	set str0 [lindex [lindex $line 0] 0]
	set str $str0
	lappend str $str1
	set line [lreplace $line 0 0 $str]
	set curpage [lreplace $curpage $cursor $cursor $line]
	set docpages [lreplace $docpages $cp $cp $curpage]
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    button .fe.fb.bd -text $message(default) -command {
	destroy .fe
	set curpage [lindex $docpages $cp]
	set line [lindex $curpage $cursor]
	set str [lindex [lindex $line 0] 0]
	set line [lreplace $line 0 0 $str]
	set curpage [lreplace $curpage $cursor $cursor $line]
	set docpages [lreplace $docpages $cp $cp $curpage]
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    button .fe.fb.bc -text $message(cancel) -command {
	destroy .fe
	ctrlbutton normal
	ctrlcobutton $cursor
	resetpage
    }
    pack .fe.fb.bo .fe.fb.bd .fe.fb.bc -side left
    pack .fe.tt .fe.fb
    .fe.tt insert 1.0 $text
    
    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.tt
    update
    grab .fe
    tkwait window .fe
}

# アイテム変更
 
proc changeitem {x} {
    global docpages
    global cp
    global cursor
    
    set curpage [lindex $docpages $cp]
    set str [lindex [lindex $curpage $cursor] 0]
    set str0 [lindex [lindex $curpage $cursor] 0]
    set str1 [lindex [lindex $curpage $cursor] 2]
    set str $str0
    lappend str $x
    if {$str1 != {}} {
	lappend str $str1
    }
    set curpage [lreplace $curpage $cursor $cursor $str]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# 文字色変更

proc changecolor {x} {
    global docpages
    global cp
    global cursor

    set curpage [lindex $docpages $cp]
    set color [lindex [lindex $curpage $cursor] 2]
    if {$color == {}} {
	set color white
    }
    if {$x == "etc"} {
	set x [tk_chooseColor -initialcolor $color]
    }
    if {$x == {}} return
    set str0 [lindex [lindex $curpage $cursor] 0]
    set str1 [lindex [lindex $curpage $cursor] 1]
    set str3 [lindex [lindex $curpage $cursor] 3]
    if {$x == "white" && $str3 == {}} {
	set str {}
	lappend str $str0
	lappend str $str1
	set curpage [lreplace $curpage $cursor $cursor $str]
    } else {
	set str {}
	lappend str $str0
	lappend str $str1
	lappend str $x
	if {$str3 != {}} {
		lappend str $str3
	}
	set curpage [lreplace $curpage $cursor $cursor $str]
    }
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}


# フォントチェック

proc checkfont {} {
    global docpages
    global cp
    global cursor
    global work

    set curpage [lindex $docpages $cp]

    set str0 [lindex [lindex $curpage $cursor] 0]
    set str3 [lindex [lindex $curpage $cursor] 3]

    if {$str3 == {}} {
	if {$str0 == "text" || $str0 == "textbox"} {
	    set work(fonts) 16
	    set work(fontt) rm
	    set work(kfonts) 16
	    set work(kfontt) mc
	} else {
	    set work(fonts) 24
	    set work(fontt) rm
	    set work(kfonts) 24
	    set work(kfontt) mc
	}
    } else {
	set work(fonts) [lindex $str3 0]
	set work(fontt) [lindex $str3 1]
	set work(kfonts) [lindex $str3 2]
	set work(kfontt) [lindex $str3 3]
    }
}

# フォント変更

proc changefont {x} {
    global docpages
    global cp
    global cursor
    global work
    global Str
    global Str2
    global message

    set curpage [lindex $docpages $cp]
    set fontlist [lindex [lindex $curpage $cursor] 3]
    set work(fontt) [lindex $fontlist 1]
    set work(kfontt) [lindex $fontlist 3]
    set work(fontsold) [lindex $fontlist 0]
    set work(kfontsold) [lindex $fontlist 2]
    if {$x == "etc"} {
	toplevel .fe
	wm title .fe font
	
	frame .fe.en1
	frame .fe.en2
	label .fe.en1.lb -text "ascii font "
	label .fe.en2.lb -text "kanji font "
	entry .fe.en1.en -width 40
	entry .fe.en2.en -width 40
	frame .fe.fb
	button .fe.fb.bo -text $message(ok) -command {
	    set Str [.fe.en1.en get]
	    set Str2 [.fe.en2.en get]
    	    if {$Str == {} && $Str2 == {}} {return}
	    destroy .fe
	}
	button .fe.fb.bc -text $message(cancel) -command {
	    set Str {}
	    set Str2 {}
	    destroy .fe
	}
	pack .fe.en1.lb .fe.en1.en -side left
	pack .fe.en2.lb .fe.en2.en -side left
	pack .fe.fb.bo .fe.fb.bc -side left
	pack .fe.en1 .fe.en2 .fe.fb

	.fe.en1.en delete 0 end
	if {$work(fontsold) == "u"} {
	    .fe.en1.en insert 0 $work(fontt)
	}
	.fe.en2.en delete 0 end
	if {$work(kfontsold) == "u"} {
	    .fe.en2.en insert 0 $work(kfontt)
	}
	wm withdraw .fe
	update idletasks
	set wx [expr [winfo x .] + ([winfo width .] - \
	    [winfo reqwidth .fe]) / 2]
	set wy [expr [winfo y .] + ([winfo height .] - \
	    [winfo reqheight .fe])/2]
	
	wm geometry .fe +$wx+$wy
	wm deiconify .fe

	update
	focus .fe.en1.en
	grab .fe
	tkwait window .fe
    } else {
	set Str def
    }
    if {$Str == {} && $Str2 == {}} {
	return
    } else {
	if {$x == "etc"} {
	    set work(fonts) u
	    set work(fontt) $Str
	    set work(kfonts) u
	    set work(kfontt) $Str2
	} else {
	    set work(fontt) rm
	    set work(kfonts) $work(fonts)
	    set work(kfontt) mc
	}
    }
    set str0 [lindex [lindex $curpage $cursor] 0]
    set str1 [lindex [lindex $curpage $cursor] 1]
    set str2 [lindex [lindex $curpage $cursor] 2]

    set changed 0
    if {$str0 == "text" || $str0 == "textbox"} {
	if {$work(fonts) != 16} {
	    set changed 1
	}
    } else {
	if {$work(fonts) != 24} {
	    set changed 1
	}
    }
	
    if {$changed == 1} {
	set str3 "$work(fonts) $work(fontt) $work(kfonts) $work(kfontt)"
	set str {}
	lappend str $str0
	lappend str $str1
	if {$str2 == {}} {set str2 "white"}
	lappend str $str2
	lappend str $str3
    } else {
	set str {}
	lappend str $str0
	lappend str $str1
	if {$str2 != {} && $str2 != "white"} { 
	    lappend str $str2
	}
    }

    set curpage [lreplace $curpage $cursor $cursor $str]

    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# 属性変更

proc changeattr {x} {
    global docpages
    global cp
    global cursor

    set curpage [lindex $docpages $cp]
    set line [lindex $curpage $cursor]

    set str0 [lindex $line 0]
    if {$str0 == "move"} {
	set line [lindex $line 1]
    }

    if {$x != "none"} {
	set str0 [lindex $x 0]
	set str1 $line
	set str2 [lindex $x 1]
	set str $str0
	lappend str $str1
	lappend str $str2
    } else {
	set str $line
    }
    set curpage [lreplace $curpage $cursor $cursor $str]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
}

# 背景選択

proc selectbg {} {
    global message
    global filedir
    global Option
    global pwd

    toplevel .fe
    wm title .fe background
    
    entry .fe.en -width 60
    frame .fe.fb
    button .fe.fb.bo -text $message(ok) -command {
        set Option(background) [.fe.en get]
        destroy .fe
	changebg
    }
    button .fe.fb.bb -text $message(browse) -command {
	set initfile [.fe.en get]
	if {[file exists $initfile] == 0} {
	    set initfile $pwd
	} else {
	    set afile [file tail $initfile]
	    cd [file dirname $initfile]
	    set adir [pwd]
	    cd $pwd
	    set initfile $adir/$afile
	}
	set fname [fileDialog . "Select Background" open image $initfile {}]
	if {$fname != ""} {
	    if {$Option(pathtype) == 1} {
		set fname [relativepath $filedir $fname] 
	    }
            .fe.en delete 0 end
            .fe.en insert 0 $fname
	}
    }
    button .fe.fb.bc -text $message(cancel) -command {
        destroy .fe
    }
    pack .fe.fb.bo .fe.fb.bb .fe.fb.bc -side left
    pack .fe.en .fe.fb
    
    .fe.en insert 0 $Option(background)
    
    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]
    
    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.en
    update
    grab .fe
    tkwait window .fe
}

# 背景変更

proc changebg {} {
    global cp

    if {[winfo exists .view] == 1} {
	resetview $cp
    }
}

# 行削除・ページ削除

proc deleteline {} {
    global docpages
    global cp
    global maxp
    global cursor
    global mode
    global clip

    if {$mode == "page"} {
	set x $cursor
	set curpage [lindex $docpages $cp]
	set clip(line) [lindex $curpage $x]
	set curpage [lreplace $curpage $x $x]
	set docpages [lreplace $docpages $cp $cp $curpage]
	if {[lindex $docpages $cp] == {}} { 
	    set docpages [lreplace $docpages $cp $cp]
	    incr maxp -1
	    if {$maxp == 0} {
		set cp 0
	    } elseif {$cp >= $maxp} {
		set cp [expr $maxp - 1]
	    }
	}
	resetpage
    } elseif {$mode == "contents"} {
	set clip(page) [lindex $docpages $cursor]
	set docpages [lreplace $docpages $cursor $cursor]
	incr maxp -1
	showtitle
    }
}

# 行ペースト

proc pasteline {} {
    global docpages
    global lnum
    global cp
    global maxp
    global cursor
    global mode
    global clip

    if {$mode == "page"} {
	set curpage [lindex $docpages $cp]
	if {$clip(line) == {}} {return}
	set str $clip(line)
	set curpage [linsert $curpage $cursor $str]
	set docpages [lreplace $docpages $cp $cp $curpage]
	resetpage
	ctrlbutton normal
	ctrlcobutton $cursor
    } elseif {$mode == "contents"} {
	if {$clip(page) == {}} {return}
	set str $clip(page)
	set docpages [linsert $docpages $cursor $str]
	incr maxp
	showtitle
    }
}

# 行交換

proc exchangeline {s e} {
    global docpages
    global cp

    set curpage [lindex $docpages $cp]
    set sline [lindex $curpage $s]
    set eline [lindex $curpage $e]
    set curpage [lreplace $curpage $s $s]
    set curpage [linsert $curpage $s $eline]
    set curpage [lreplace $curpage $e $e]
    set curpage [linsert $curpage $e $sline]
    set docpages [lreplace $docpages $cp $cp $curpage]
    resetpage
}

# 移動

proc move {n} {
    global lnum
    global cursor
    global mode

    if {$mode == "page"} {
	if {$n == "up"} {
	    if {$cursor == 0} {return}
	    incr cursor -1
	    exchangeline [expr $cursor+1] $cursor
	} elseif {$n == "down"} {
	    if {$cursor == [expr $lnum-1]} {return}
	    incr cursor
	    exchangeline [expr $cursor-1] $cursor
	}
    } elseif {$mode == "contents"} {
	if {$n == "up"} {
	    if {$cursor == 0} {return}
	    incr cursor -1
	    exchangepage [expr $cursor+1] $cursor
	} elseif {$n == "down"} {
	    if {$cursor == [expr $lnum-1]} {return}
	    incr cursor
	    exchangepage [expr $cursor-1] $cursor
	}
    }
}

# ページ交換

proc exchangepage {s e} {
    global docpages
    global cp
    global cursor

    set spage [lindex $docpages $s]
    set epage [lindex $docpages $e]
    set docpages [lreplace $docpages $s $s]
    set docpages [linsert $docpages $s $epage]
    set docpages [lreplace $docpages $e $e]
    set docpages [linsert $docpages $e $spage]
    set cursor $e
    set cp $e
    showtitle
}

# ページ移動

proc movepage {s e} {
    global docpages
    global cp
    global cursor

    set spage [lindex $docpages $s]
    if {$s < $e} {
	set docpages [linsert $docpages $e $spage]
	set docpages [lreplace $docpages $s $s]
	set cursor [expr $e-1]
	set cp $cursor
    } else {
	set docpages [lreplace $docpages $s $s]
	set docpages [linsert $docpages $e $spage]
	set cursor $e
	set cp $cursor
    }
    showtitle
}

# ページ作成

proc createpage {m} {
    global docpages
    global cp
    global maxp
    global cursor

    if {[winfo exists .fe] == 1} {return}
    if {$maxp != 0} {
	if {$m == 1} {
	    incr cp
	}
	lappend curpage "title {}"
	set docpages [linsert $docpages $cp $curpage]
	incr maxp
    } else {
	set curpage {}
	set curpage [linsert $curpage 0 "title {}"]
	lappend docpages $curpage
	incr maxp
    }
    ctrlbutton normal
    set cursor 0
    resetpage
    ctrlbutton normal
    ctrlcobutton $cursor
    changetitle
}

# ページジャンプ

proc jumppage {} {
    global cp
    global maxp
    global cursor
    global mode

    set err 0
    set jp [.fb2.ep get]
    set jp [lindex [split $jp "/"] 0]
    if {[regexp {[a-z]+} $jp]} {
	set err 1
    }
    set jp [string trimleft $jp 0]
    if {$jp == {}} {set jp 0}
    if {[llength $jp] > 3} {
	set err 1
    }
    if {$err == 0} {
	set jp [expr $jp-1]
    }
    if {$jp >= 0 && $jp < $maxp && $err == 0} {
	set cp $jp
	if {$mode == "contents"} {
	    .fb2.bi configure -state normal
	    .fb2.ba configure -state normal
	    .fb2.bn configure -state normal
	    .fb2.bp configure -state normal
	    .fb2.bt configure -text index -command showtitle
	    set cursor {}
	    set mode page
	    ctrlbutton disabled
	}
	resetpage
    } else {
	resetpage
    }
}


# 次・前ページ表示

proc nextpage {n} {
    global cp
    global maxp
    global cursor

    if {$n == 1} {
    	if {$cp < [expr $maxp-1]} {
	    incr cp
	    set cursor {}
	    ctrlbutton disabled
	    initpage
	    showpage
	}
    } elseif {$n == -1} {
	if {$cp > 0} {
	    incr cp -1
	    set cursor {}
	    ctrlbutton disabled
	    initpage
	    showpage
	}
    }
}

# ページ再表示 

proc resetpage {} {
    global view_skip

    set view_skip 1 
    initpage
    showpage
}

# ページ初期化

proc initpage {} {
    global lnum
    global cp
    global maxp

    .fb2.ep delete 0 end
    if {$maxp == 0} {
	.fb2.ep insert 0 "0/0"
    } else {
	.fb2.ep insert 0 "[expr $cp+1]/[expr $maxp]"
    }
    for {set i 0} {$i < $lnum} {incr i} {
	if {[winfo exists .fc.c.lb1($i)]} {destroy .fc.c.lb1($i)}
	if {[winfo exists .fc.c.lb2($i)]} {destroy .fc.c.lb2($i)}
	if {[winfo exists .fc.c.titletext]} {destroy .fc.c.titletext}
    }
    .fc.c delete all
    set lnum 0
    focus .
}

# ウィンドウサイズ変更

proc changesize {} {
    global Option
    
    if {$Option(viewersize) == 1} {
	.fc.c configure -height 500
	wm geometry . {}
	wm minsize . 590 580
	wm maxsize . 640 620
    } else {
	.fc.c configure -height 400
	wm geometry . {}
	wm minsize . 590 480
	wm maxsize . 640 520
    }
    if {[winfo exists .view] == 1} {
	setval
	call_viewer normal
    }
    ctrlbutton disabled
    resetpage
}

# ページ表示

proc showpage {} {
    global commandlist
    global docpages
    global lnum
    global cp
    global maxp
    global cursor
    global mode
    global scrY
    global Id1 Id2
    global message
    global Option

    .fb2.bt configure -text $message(contents) -command showtitle
    set page [lindex $docpages $cp]    
    set scrY(0) 20

    set width 56
    set wlen 392
	
    foreach i $page {
	set line $i
	set str0 [lindex [lindex $line 0] 0]
	if {[lsearch $commandlist $str0] != -1} {
	    if {$str0 == "move"} {
		set text "move [lindex $line 2]"
		set line [lindex $line 1]
		set str0 [lindex $line 0]
		.fc.c create text 510 $scrY($lnum) -text $text \
			-anchor nw -fill yellow
	    }
	    if {$str0 == "text" || $str0 == "textbox" || $str0 == "table" \
		    || $str0 == "animation"} {
		set str1 [string range [lindex $line 1] 0 [expr $width - 1]]
	    } else {
		set str1 [lindex $line 1]
	    }
	    set color [lindex $line 2]
	    if {$str0 == "title"} {
		set color yellow
		set str2 [lindex $line 2]
		if {$str2 != {}} {
		    set str1 "$str1  -  $str2"
		}
	    }
	    if {$str0 == "animation"} {set color white}
	    if {$color == {}} {set color white}
	    regsub -all "\[\t\n\]" $str1 { } str1
	    regsub -all "\ +\ *" $str1 { } str1
	    set str1 [string trim $str1 { }]
	    set n [string length $str1]
	    set l [expr $n / ($width + 1) + 1]
	    label .fc.c.lb1($lnum) -width 10 -text $str0 \
		    -anchor w -bg RoyalBlue4 -fg white
	    label .fc.c.lb2($lnum) -relief raised -width $width -heigh $l \
		    -wraplength $wlen -text $str1 -justify left -anchor w \
		    -bg RoyalBlue4 -fg $color
	    .fc.c create window 10 $scrY($lnum) -window .fc.c.lb1($lnum) \
		    -anchor nw
	    .fc.c create window 100 $scrY($lnum) -window .fc.c.lb2($lnum) \
		    -anchor nw
	    set dy [expr 30 + ($l-1) * 15]
	} else {
	    set str [string range $line 0 [expr $width - 1]]
	    label .fc.c.lb1($lnum) -width 10 -text "   " \
		    -anchor w  -bg RoyalBlue4 -fg white
	    label .fc.c.lb2($lnum) -relief raised -width $width -height 1 \
		    -text $str -anchor nw -justify left -bg RoyalBlue4 \
		    -fg white
	    .fc.c create window 10 $scrY($lnum) -window .fc.c.lb1($lnum) \
		    -anchor nw
	    .fc.c create window 100 $scrY($lnum) -window .fc.c.lb2($lnum) \
		    -anchor nw
	    set dy 30
	}
	set Id1(.fc.c.lb1($lnum)) $lnum
	set Id2(.fc.c.lb2($lnum)) $lnum
	setbind $lnum $str0
  	incr lnum
	set scrY($lnum) [expr $scrY([expr $lnum-1]) + $dy]
    }

    .fc.c configure -scrollregion "0 0 560 [expr $scrY($lnum) + 10]"

    if {$cursor != {} && $cursor >= $lnum && $lnum != 0} {
	set cursor [expr $lnum -1]
	set mw .fc.c.lb2($cursor)
    }
    if {$lnum == 0} {
	set cursor {}
	ctrlbutton disabled
    }
    if {$cursor != {}} {
	.fc.c.lb2($cursor) configure -bg #A9A9A9
	.fc.c.lb1($cursor) configure -bg #A9A9A9
    }
    bind .fc.c <Double-Button-1> {
	inputtext %x %y 0
    }
    
    if {$Option(vredraw) == 1} {
	call_viewer normal
    }
    ctrlpabutton
}

# バインド設定

proc setbind {n label} {
    global docpages
    global cp
    global Id1
    global Id2
    global lnum

    bind .fc.c.lb1($n) <1> {
	set mw %W
	focus $mw
	if {$cursor == {}} {
	    $mw configure -bg #A9A9A9
	    .fc.c.lb2($Id1($mw)) configure -bg #A9A9A9
	    set cursor $Id1($mw)
	    ctrlbutton normal
	    ctrlcobutton $Id1($mw)
	} elseif {$cursor != $Id1($mw)} {
	    $mw configure -bg #A9A9A9
	    .fc.c.lb2($Id1($mw)) configure -bg #A9A9A9
	    .fc.c.lb2($cursor) configure -bg RoyalBlue4
	    .fc.c.lb1($cursor) configure -bg RoyalBlue4
	    set cursor $Id1($mw)
	    ctrlbutton normal	
	    ctrlcobutton $Id1($mw)
	}
    }
    bind .fc.c.lb1($n) <3> {
	set mw %W
	focus $mw
	if {$cursor == $Id1($mw)} {
	    set str [lindex [$mw configure -text] 4]
	    if {$str == "item" || $str == "subitem" || $str == "subsubitem" \
		    || $str == "subsubsubitem"} {
		if {[lindex [lindex [lindex $docpages $cp] $Id1($mw)] 0] \
			!= "move"} {
		    setlabelopt
		    return
		}
	    }
	    $mw configure -bg RoyalBlue4
	    .fc.c.lb2($Id1($mw)) configure -bg RoyalBlue4
	    set cursor {}
	    ctrlbutton disabled
	}
    }
    bind .fc.c.lb2($n) <1> {
	set mw %W
	focus $mw
	if {$cursor == {}} {
	    $mw configure -bg #A9A9A9
	    .fc.c.lb1($Id2($mw)) configure -bg #A9A9A9
	    set cursor $Id2($mw)
	    ctrlbutton normal
	    ctrlcobutton $Id2($mw)
	} elseif {$cursor != $Id2($mw)} {
	    $mw configure -bg #A9A9A9
	    .fc.c.lb1($Id2($mw)) configure -bg #A9A9A9
	    .fc.c.lb2($cursor) configure -bg RoyalBlue4
	    .fc.c.lb1($cursor) configure -bg RoyalBlue4
	    set cursor $Id2($mw)
	    ctrlbutton normal	
	    ctrlcobutton $Id2($mw)
	}
    }
    bind .fc.c.lb2($n) <3> {
	set mw %W
	focus $mw
	if {$cursor == $Id2($mw)} {
	    $mw configure -bg RoyalBlue4
	    .fc.c.lb1($Id2($mw)) configure -bg RoyalBlue4
	    set cursor {}
	    ctrlbutton disabled
	}
    }
    bind .fc.c.lb2($n) <Double-Button-1> {
	edittext
    }
    if {[lindex [lindex [lindex $docpages $cp] $n] 0] != "move"} {
	bind .fc.c.lb1($n) <Double-Button-1> {
	    popupmenu label
	}
    }
}

# タイトル表示

proc showtitle {} {
    global docpages
    global lnum
    global cp
    global maxp
    global cursor
    global mode
    global Id
    global message

    if {$maxp == 0} {
	.fb2.bp configure -state normal
	.fb2.bn configure -state normal
	.fb2.bi configure -state normal
	.fb2.ba configure -state normal
	.fb2.bt configure -text $message(contents) -command showtitle
	set cp 0
	set mode page
	ctrlbutton disabled
	resetpage
	return
    }
    if {$cp == $maxp} {set cp [expr $maxp - 1]}

    set mode contents
    set cursor $cp 
    ctrlbutton normal 
    .fb2.bp configure -state disabled
    .fb2.bn configure -state disabled
    .fb2.bi configure -state disabled
    .fb2.ba configure -state disabled
    .fb2.bt configure -text $message(page) -command {
	.fb2.bp configure -state normal
	.fb2.bn configure -state normal
	.fb2.bi configure -state normal
	.fb2.ba configure -state normal
	.fb2.bt configure -text $message(contents) -command showtitle
	set cp $cursor
	set cursor {}
	set mode page
	ctrlbutton disabled
	resetpage
	return
    }
    bind .fc.c <<Double-Button-1> ""
    initpage
    .fb2.ep delete 0 end
    .fb2.ep insert 0 [expr $cursor + 1]
    set p [llength $docpages]
    set col [expr ($p-1) / 10 + 1]
    set tw [expr 530 / $col]
    label .fc.c.titletext -width 54 -anchor w -bg black -fg white 
    .fc.c create window 60 20 -window .fc.c.titletext -anchor w
    foreach page $docpages {
        set str [lindex [lindex $page 0] 1]
	regsub -all "\[\t\n\]" $str { } str
	regsub -all "\ +\ *" $str { } str
	set str [string trim $str { }]
	label .fc.c.lb1($lnum) -relief raised -width [expr 68/$col-2] \
		-text $str -anchor w -bg white
	if {$p <= 50} {
	    .fc.c create text [expr $lnum/10 * $tw + 10] \
		    [expr 60+($lnum%10)*30] -text [expr $lnum+1] \
		    -anchor nw -fill white
	} else {
	    if {[expr $lnum % 10] == 0} {
		.fc.c create text [expr $lnum/10 * $tw + 30] 40 \
			-text [expr $lnum+1] -anchor nw -fill white
	    }
	}
	.fc.c create window [expr $lnum/10 * $tw + 30] \
		[expr 60+($lnum%10)*30] -window .fc.c.lb1($lnum) -anchor nw
	set Id(.fc.c.lb1($lnum)) $lnum
	bind .fc.c.lb1($lnum) <1> {
	    set mw %W
	    if {$Id($mw) != $cursor} {
		$mw configure -bg #A9A9A9
		.fc.c.lb1($cursor) configure -bg white
		set cursor $Id($mw)
		set cp $cursor
		.fb2.ep delete 0 end
		.fb2.ep insert 0 [expr $cp + 1]
		set str [lindex [lindex [lindex $docpages $cp] 0] 1]
		regsub -all "\[\t\n\]" $str { } str
		regsub -all "\ +\ *" $str { } str
		set str [string trim $str { }]
		.fc.c.titletext configure -text $str
	    }
	}
	bind .fc.c.lb1($lnum) <2> {
	    set mw %W	    
	    movepage $cursor $Id($mw)
	}
	bind .fc.c.lb1($lnum) <Double-Button-1> {
	    set mw %W	    
	    .fb2.bp configure -state normal
	    .fb2.bn configure -state normal
	    .fb2.ba configure -state normal
	    .fb2.bi configure -state normal
	    .fb2.bt configure -text index -command showtitle
	    set cp $cursor
	    set cursor {}
	    set mode page
	    ctrlbutton disabled
	    resetpage
	}
	incr lnum
    }
    if {$cursor >= $lnum && $lnum != 0} {
	set cursor [expr $lnum -1]
	set mw .fc.c.lb1($cursor)
    }
    if {$lnum == 0} {
	set cursor {}
	ctrlbutton disabled
    }

    if {$cursor != {}} {
	.fc.c.lb1($cursor) configure -bg #A9A9A9
	set str [lindex [lindex [lindex $docpages $cp] 0] 1]
	regsub -all "\[\t\n\]" $str { } str
	regsub -all "\ +\ *" $str { } str
	set str [string trim $str { }]
	.fc.c.titletext configure -text $str
    }
}

# ボタン状態制御

proc ctrlbutton {state} {
    global cursor
    global mode

    if {$mode == "page"} {
	.fb1.bl configure -state $state
	.fb1.bi configure -state normal
	.fb1.ba configure -state normal
	.fb1.be configure -state $state
	.fb1.bo configure -state $state
	.fb1.bf configure -state $state
	.fb1.bt configure -state $state
    } elseif {$mode == "contents"} { 
	.fb1.bl configure -state disabled
	.fb1.bi configure -state disabled
	.fb1.ba configure -state disabled
	.fb1.be configure -state disabled
	.fb1.bo configure -state disabled
	.fb1.bf configure -state disabled
	.fb1.bt configure -state disabled
    }
    .fb1.bc configure -state $state
    .fb1.bp configure -state $state
    .fb1.bu configure -state $state
    .fb1.bd configure -state $state 
}

# カラー変更ボタン & フォント変更ボタン制御

proc ctrlcobutton {n} {
    global docpages
    global cp

    set str [lindex [.fc.c.lb1($n) configure -text] 4]
    if {$str == "title" || $str == "pict" || $str == "textbox" \
	    || $str == "animation" || $str == "pause" \
	    || $str == "   "} {
	.fb1.bo configure -state disabled
    }
    if {$str == "title" || $str == "pict" || $str == "symbol" \
	    || $str == "animation" || $str == "pause" \
	    || $str == "   "} {
	.fb1.bf configure -state disabled
    }
    if {$str == "title" || $str == "pict" || $str == "symbol" \
	    || $str == "table" || $str == "animation" \
	    || $str == "text" || $str == "textbox" || $str == "pause" \
	    || $str == "   "} {
	.fb1.bt configure -state disabled
    }

    set str [lindex [lindex [lindex $docpages $cp] $n] 0]
    if {$str == "move"} {
	.fb1.bl configure -state disabled
	.fb1.bo configure -state disabled
	.fb1.bf configure -state disabled
    }
}

# ページ変更ボタン制御

proc ctrlpabutton {} {
    global cp
    global maxp

    if {$maxp == 0 || $maxp == 1} {
 	.fb2.bp configure -state disabled
 	.fb2.bn configure -state disabled
    } elseif {$cp == 0} {
 	.fb2.bp configure -state disabled
 	.fb2.bn configure -state normal
    } elseif {$cp == ($maxp-1)} {
 	.fb2.bp configure -state normal
 	.fb2.bn configure -state disabled
    } else {
 	.fb2.bp configure -state normal
 	.fb2.bn configure -state normal
    }
    if {$maxp == 0} {
	.fb2.bt configure -state disabled
    } else {
	.fb2.bt configure -state normal
    }
}

# Viewer の bind 制御

proc viewredraw {} {
    global Option

    if {[winfo exists .view] == 1} {
	view_setbind 1
    }
}

# メニューの制御

proc checkmenu {} {
    global Option
    
    if {$Option(background) == {}} {
	.fm.mbo.m entryconfigure 8 -state disabled
    } else {
	.fm.mbo.m entryconfigure 8 -state normal
    }
    if {$Option(LANG) == "eng"} {
	.fm.mbo.m entryconfigure 0 -state disabled
    } else {
	.fm.mbo.m entryconfigure 0 -state normal
    }
}

# 表示言語変更

proc changelang {lang} {
    global message
    global Option
    global deffonts
    global work

    set Option(lang) $lang

    if {$lang == "jpn"} {
	set message(page) "頁表示"
	set message(contents) " 目次 "

	set message(ok) 了解
	set message(cancel) キャンセル
	set message(no) いいえ
	set message(save) 保存
	set message(browse) 参照...
	set message(select) 選択
	set message(etc) その他
	set message(default) デフォルト
	set message(load) "編集中の内容は破棄されますがよろしいですか？"
	set message(exit) "終了する前にファイルに保存しますか？"

	# メニュー
	.fm.mbf configure -text ファイル
	.fm.mbf.m delete 0 end
	.fm.mbf.m add command -label 新規作成 -command new
	.fm.mbf.m add command -label 読込み -command load
	.fm.mbf.m add command -label 保存 -command save
	.fm.mbf.m add separator
	.fm.mbf.m add command -label "HTML 形式で保存" -command outputHTML
	.fm.mbf.m add command -label "MGP 形式で保存" -command outputMGP
	.fm.mbf.m add separator
	.fm.mbf.m add command -label "EWIPE について" -command aboutEWIPE
	.fm.mbf.m add separator
	.fm.mbf.m add command -label 終了 -command exitewipe

	.fm.mbo configure -text オプション
	.fm.mbo.m delete 0 end
	.fm.mbo.m add cascade -label 表示言語 -menu .fm.mbo.m.lang
	.fm.mbo.m.lang delete 0 end
	.fm.mbo.m.lang add command -label 日本語 -command "changelang jpn"
	.fm.mbo.m.lang add command -label 英語 -command "changelang eng"
	.fm.mbo.m add cascade -label パスのタイプ -menu .fm.mbo.m.path
	.fm.mbo.m.path delete 0 end
	.fm.mbo.m.path add radiobutton -label 絶対パス -value 0 \
		-variable Option(pathtype)
	.fm.mbo.m.path add radiobutton -label 相対パス -value 1 \
		-variable Option(pathtype)
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label ページ番号 -menu .fm.mbo.m.pnum
	.fm.mbo.m.pnum delete 0 end
	.fm.mbo.m.pnum add radiobutton -label off -value 0 \
		-variable Option(pagen) -command "call_viewer pagen"
	.fm.mbo.m.pnum add radiobutton -label on -value 1 \
		-variable Option(pagen) -command "call_viewer pagen"
	.fm.mbo.m add cascade -label "時間" -menu .fm.mbo.m.time
	.fm.mbo.m.time delete 0 end
	.fm.mbo.m.time add radiobutton -label off -value 0 \
		-variable Option(time) -command "call_viewer time"
	.fm.mbo.m.time add radiobutton -label on -value 1 \
		-variable Option(time) -command "call_viewer time"
	.fm.mbo.m add cascade -label "時間のタイプ" -menu .fm.mbo.m.timetype
	.fm.mbo.m.timetype delete 0 end
	.fm.mbo.m.timetype add radiobutton -label "時刻" -value 0 \
		-variable Option(timemode)
	.fm.mbo.m.timetype add radiobutton -label "経過時間" -value 1 \
		-variable Option(timemode)
	.fm.mbo.m add command -label ポインタ -command setpointer
	.fm.mbo.m add command -label "背景選択" -command selectbg
	.fm.mbo.m add cascade -label "背景のタイプ" -menu .fm.mbo.m.bgtype
	.fm.mbo.m.bgtype delete 0 end
	.fm.mbo.m.bgtype add radiobutton -label 普通 -value 0 \
		-variable Option(bgtype) -command changebg
	.fm.mbo.m.bgtype add radiobutton -label タイル -value 1 \
		-variable Option(bgtype) -command changebg
	.fm.mbo.m add cascade -label "タイトルのタイプ" \
		-menu .fm.mbo.m.titletype
	.fm.mbo.m.titletype delete 0 end
	.fm.mbo.m.titletype add radiobutton -label box -value 0 \
		-variable Option(titletype) \
		-command "set view_skip 1; call_viewer normal"
	.fm.mbo.m.titletype add radiobutton -label line -value 1 \
		-variable Option(titletype) \
		-command "set view_skip 1; call_viewer normal"
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "HTML カラー" -menu .fm.mbo.m.htmlc
	.fm.mbo.m.htmlc delete 0 end
	.fm.mbo.m.htmlc add radiobutton -label モノクロ -value 0 \
		-variable Option(htmlcolor)
	.fm.mbo.m.htmlc add radiobutton -label カラー -value 1 \
		-variable Option(htmlcolor)
	.fm.mbo.m add cascade -label "HTML サイズ" -menu .fm.mbo.m.htmls
	.fm.mbo.m.htmls delete 0 end
	.fm.mbo.m.htmls add radiobutton -label 普通 -value 0 \
		-variable Option(htmlfont)
	.fm.mbo.m.htmls add radiobutton -label 大 -value 1 \
		-variable Option(htmlfont)
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "Viewer サイズ" -menu .fm.mbo.m.vsize
	.fm.mbo.m.vsize delete 0 end
	.fm.mbo.m.vsize add radiobutton -label 640x480 -value 0 \
		-variable Option(viewersize) -command changesize 
	.fm.mbo.m.vsize add radiobutton -label 800x600 -value 1 \
		-variable Option(viewersize)  -command changesize
	.fm.mbo.m add cascade -label "Viewer 再描画" -menu .fm.mbo.m.view
	.fm.mbo.m.view delete 0 end
	.fm.mbo.m.view add radiobutton -label off -value 0 \
		-variable Option(vredraw) -command viewredraw
	.fm.mbo.m.view add radiobutton -label on -value 1 \
		-variable Option(vredraw) -command viewredraw
	.fm.mbo.m add command -label "View モード" -command "call_viewer view"
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "オプション保存" -menu .fm.mbo.m.save
	.fm.mbo.m.save delete 0 end
	.fm.mbo.m.save add radiobutton -label off -value 0 \
		-variable Option(saveoptions)
	.fm.mbo.m.save add radiobutton -label on -value 1 \
		-variable Option(saveoptions)

	# 編集コマンドボタン
	.fb1.bl configure -text ラベル
	.fb1.bi configure -text 挿入
	.fb1.ba configure -text 追加
	.fb1.bc configure -text 削除
	.fb1.bp configure -text 貼付
	.fb1.be configure -text 編集
	.fb1.bu configure -text 上
	.fb1.bd configure -text 下
	.fb1.bo configure -text 色
	.fb1.bf configure -text 文字 
	.fb1.bt configure -text 属性
   
	# ページ操作ボタン	
	.fb2.bv configure -text Viewer
	.fb2.bt configure -text $message(contents)
	.fb2.bp configure -text 前頁
	.fb2.bn configure -text 次頁
	.fb2.bi configure -text 頁挿入
	.fb2.ba configure -text 頁追加
    } elseif {$lang == "eng"} {
	set message(page) "  page  "
	set message(contents) "contents"

	set message(ok) Ok
	set message(cancel) Cancel
	set message(no) No
	set message(save) Save
	set message(browse) Browse...
	set message(select) Select
	set message(etc) etc
	set message(default) default
	set message(load) "File modified, do you want to load (new) ?"
	set message(exit) "Do you want to save before exit ?"

	# メニュー
	.fm.mbf configure -text File
	.fm.mbf.m delete 0 end
	.fm.mbf.m add command -label New -command new
	.fm.mbf.m add command -label Load -command load
	.fm.mbf.m add command -label Save -command save
	.fm.mbf.m add separator
	.fm.mbf.m add command -label "Save as HTML" -command outputHTML
	.fm.mbf.m add command -label "Save as MGP" -command outputMGP
	.fm.mbf.m add separator
	.fm.mbf.m add command -label "About EWIPE" -command aboutEWIPE
	.fm.mbf.m add separator
	.fm.mbf.m add command -label Exit -command exitewipe

	.fm.mbo configure -text Option
	.fm.mbo.m delete 0 end
	.fm.mbo.m add cascade -label Language -menu .fm.mbo.m.lang
	.fm.mbo.m.lang delete 0 end
	.fm.mbo.m.lang add command -label Japanese -command "changelang jpn"
	.fm.mbo.m.lang add command -label English -command "changelang eng"
	.fm.mbo.m add cascade -label "Path type" -menu .fm.mbo.m.path
	.fm.mbo.m.path delete 0 end
	.fm.mbo.m.path add radiobutton -label "absolute path" -value 0 \
		-variable Option(pathtype)
	.fm.mbo.m.path add radiobutton -label "relative path" -value 1 \
		-variable Option(pathtype)
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "Page number" -menu .fm.mbo.m.pnum
	.fm.mbo.m.pnum delete 0 end
	.fm.mbo.m.pnum add radiobutton -label off -value 0 \
		-variable Option(pagen) -command "call_viewer pagen"
	.fm.mbo.m.pnum add radiobutton -label on -value 1 \
		-variable Option(pagen) -command "call_viewer pagen"
	.fm.mbo.m add cascade -label "Time" -menu .fm.mbo.m.time
	.fm.mbo.m.time delete 0 end
	.fm.mbo.m.time add radiobutton -label off -value 0 \
		-variable Option(time) -command "call_viewer time"
	.fm.mbo.m.time add radiobutton -label on -value 1 \
		-variable Option(time) -command "call_viewer time"
	.fm.mbo.m add cascade -label "Time type" -menu .fm.mbo.m.timetype
	.fm.mbo.m.timetype delete 0 end
	.fm.mbo.m.timetype add radiobutton -label "time" -value 0 \
		-variable Option(timemode)
	.fm.mbo.m.timetype add radiobutton -label "passed time" -value 1 \
		-variable Option(timemode)
	.fm.mbo.m add command -label "Pointer" -command setpointer
	.fm.mbo.m add command -label "Select background" -command selectbg
	.fm.mbo.m add cascade -label "Background type" -menu .fm.mbo.m.bgtype
	.fm.mbo.m.bgtype delete 0 end
	.fm.mbo.m.bgtype add radiobutton -label normal -value 0 \
		-variable Option(bgtype) -command changebg
	.fm.mbo.m.bgtype add radiobutton -label tiled -value 1 \
		-variable Option(bgtype) -command changebg
	.fm.mbo.m add cascade -label "Title type" \
		-menu .fm.mbo.m.titletype
	.fm.mbo.m.titletype delete 0 end
	.fm.mbo.m.titletype add radiobutton -label box -value 0 \
		-variable Option(titletype) \
		-command "set view_skip 1; call_viewer normal"
	.fm.mbo.m.titletype add radiobutton -label line -value 1 \
		-variable Option(titletype) \
		-command "set view_skip 1; call_viewer normal"
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "HTML color" -menu .fm.mbo.m.htmlc
	.fm.mbo.m.htmlc delete 0 end
	.fm.mbo.m.htmlc add radiobutton -label Mono -value 0 \
		-variable Option(htmlcolor)
	.fm.mbo.m.htmlc add radiobutton -label Color -value 1 \
		-variable Option(htmlcolor)
	.fm.mbo.m add cascade -label "HTML size" -menu .fm.mbo.m.htmls
	.fm.mbo.m.htmls delete 0 end
	.fm.mbo.m.htmls add radiobutton -label Normal -value 0 \
		-variable Option(htmlfont)
	.fm.mbo.m.htmls add radiobutton -label Large -value 1 \
		-variable Option(htmlfont)
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "Viewer size" -menu .fm.mbo.m.vsize
	.fm.mbo.m.vsize delete 0 end
	.fm.mbo.m.vsize add radiobutton -label 640x480 -value 0 \
		-variable Option(viewersize) -command changesize
	.fm.mbo.m.vsize add radiobutton -label 800x600 -value 1 \
		-variable Option(viewersize) -command changesize
	.fm.mbo.m add cascade -label "Viewer redraw" -menu .fm.mbo.m.view
	.fm.mbo.m.view delete 0 end
	.fm.mbo.m.view add radiobutton -label off -value 0 \
		-variable Option(vredraw) -command viewredraw
	.fm.mbo.m.view add radiobutton -label on -value 1 \
		-variable Option(vredraw) -command viewredraw
	.fm.mbo.m add command -label "View mode" -command "call_viewer view"
	.fm.mbo.m add separator
	.fm.mbo.m add cascade -label "Save options" -menu .fm.mbo.m.save
	.fm.mbo.m.save delete 0 end
	.fm.mbo.m.save add radiobutton -label off -value 0 \
		-variable Option(saveoptions)
	.fm.mbo.m.save add radiobutton -label on -value 1 \
		-variable Option(saveoptions)

	# 編集コマンドボタン
	.fb1.bl configure -text label
	.fb1.bi configure -text insert
	.fb1.ba configure -text add
	.fb1.bc configure -text cut
	.fb1.bp configure -text paste
	.fb1.be configure -text edit
	.fb1.bu configure -text up
	.fb1.bd configure -text down
	.fb1.bo configure -text color
	.fb1.bf configure -text font
	.fb1.bt configure -text attr

	# ページ操作ボタン
	.fb2.bv configure -text Viewer
	.fb2.bt configure -text $message(contents)
	.fb2.bp configure -text prev
	.fb2.bn configure -text next
	.fb2.bi configure -text insertpage
	.fb2.ba configure -text addpage
    }

    .pml delete 0 end
    .pml add command -label title -command "changelabel title"
    .pml add command -label item -command "changelabel item"
    .pml add command -label subitem -command "changelabel subitem"
    .pml add command -label subsubitem -command "changelabel subsubitem"
    .pml add command -label subsubsubitem -command "changelabel subsubsubitem"
    .pml add separator
    .pml add command -label left -command "changelabel left"
    .pml add command -label center -command "changelabel center"
    .pml add command -label right -command "changelabel right"
    .pml add separator
    .pml add command -label pict -command "changelabel pict"
    .pml add command -label symbol -command "changelabel symbol"
    .pml add command -label text -command "changelabel text"
    .pml add command -label textbox -command "changelabel textbox"
    .pml add command -label table -command "changelabel table"
    .pml add command -label animation -command "changelabel animation"
    .pml add separator
    .pml add command -label $message(cancel)

    .pmml delete 0 end
    .pmml add command -label title -command "makelabel title"
    .pmml add command -label item -command "makelabel item"
    .pmml add command -label subitem -command "makelabel subitem"
    .pmml add command -label subsubitem -command "makelabel subsubitem"
    .pmml add command -label subsubsubitem -command "makelabel subsubsubitem"
    .pmml add separator
    .pmml add command -label left -command "makelabel left"
    .pmml add command -label center -command "makelabel center"
    .pmml add command -label right -command "makelabel right"
    .pmml add separator
    .pmml add command -label pict -command "makelabel pict"
    .pmml add command -label symbol -command "makelabel symbol"
    .pmml add command -label text -command "makelabel text"
    .pmml add command -label textbox -command "makelabel textbox"
    .pmml add command -label table -command "makelabel table"
    .pmml add command -label animation -command "makelabel animation"
    .pmml add separator
    .pmml add command -label pause -command "makelabel pause"
    .pmml add separator
    .pmml add command -label $message(cancel)
    
    .pmc delete 0 end
    .pmc add command -label white -command "changecolor white"
    .pmc add command -label yellow -command "changecolor yellow"
    .pmc add command -label green -command "changecolor green"
    .pmc add command -label orange -command "changecolor orange"
    .pmc add command -label red -command "changecolor red"
    .pmc add command -label skyblue -command "changecolor skyblue"
    .pmc add command -label gray -command "changecolor gray"
    .pmc add separator
    .pmc add command -label $message(etc) -command "changecolor etc"
    .pmc add separator
    .pmc add command -label $message(cancel)
    
    .pmf delete 0 end
    foreach i $deffonts {
	.pmf add radiobutton -label $i -variable work(fonts) \
		-value $i -command "changefont {}"
    }
    .pmf add separator
    .pmf add radiobutton -label $message(etc) -variable work(fonts) \
		-value u -command "changefont etc"
    .pmf add separator
    .pmf add command -label $message(cancel)
    
    .pms delete 0 end
    .pms add command -label downarrow -command "changeitem downarrow"
    .pms add command -label uparrow -command "changeitem uparrow"
    .pms add command -label updownarrow -command "changeitem updownarrow"
    .pms add command -label cdot -command "changeitem cdot"
    .pms add command -label vdots -command "changeitem vdots"
    .pms add separator
    .pms add command -label $message(cancel)

    .pma delete 0 end
    .pma add command -label none -command "changeattr none"
    .pma add separator
    .pma add command -label "move nw" -command "changeattr {move nw}"
    .pma add command -label "move n" -command "changeattr {move n}"
    .pma add command -label "move ne" -command "changeattr {move ne}"
    .pma add command -label "move w" -command "changeattr {move w}"
    .pma add command -label "move e" -command "changeattr {move e}"
    .pma add command -label "move sw" -command "changeattr {move sw}"
    .pma add command -label "move s" -command "changeattr {move s}"
    .pma add command -label "move se" -command "changeattr {move se}"
    .pma add separator
    .pma add command -label $message(cancel)
}

# 色名 ←→ RGB 形式変換 (mode  n:rgb → name  r:name → rgb)

proc name2rgb {color mode} {
    set colormap {{white #FFFFFF} {yellow #FFFF00} {green #00FF00} \
	    {orange #FFA500} {red #FF0000} {skyblue #88CEEB} \
	    {gray #BEBEBE} {RoyalBlue4 #27408B}}
    set rcolor -1
    
    if {$mode == "n"} {
	foreach i $colormap {
	    if {[lindex $i 1] == $color} {
		set rcolor [lindex $i 0]
		break
	    }
	}
    } elseif {$mode == "r"} {
	foreach i $colormap {
	    if {[lindex $i 0] == $color} {
		set rcolor [lindex $i 1]
		break
	    }
	}
    }
    return $rcolor
}

# absolute -> relative

proc relativepath {abspath absfile} {

    set pathlist [split $abspath "/"]
    set filelist [split $absfile "/"]
    
    for {set i 0} {$i < [expr [llength $pathlist] ]} {incr i} {
	lappend newlist ".."
    }
    for {set i 0} {$i < [llength $filelist]} {incr i} {
	if {[lindex $filelist $i] == [lindex $pathlist $i]} {
	    set newlist [lreplace $newlist 0 0]
	} else {
	    set p $i
	    break
	}
    }
    for {set i $p} {$i < [llength $filelist]} {incr i} {
	lappend newlist [lindex $filelist $i]
    }
    foreach i $newlist {
	append relpath "$i/"
    }
    set relpath [string trimright $relpath "/"]
    return $relpath
}

# EWIPE バージョン情報

proc aboutEWIPE {} {
    global message
    global version

    toplevel .fe
    wm title .fe "about EWIPE"

    frame .fe.ft -relief raised -borderwidth 2
    label .fe.ft.tt1 -text "EWIPE Version $version"
    label .fe.ft.tt2 -text "Copyright (C) 1997-2000 Hiromasa Sekishita"
    button .fe.bo -text $message(ok) -command {
	destroy .fe
    }
    pack .fe.ft.tt1 .fe.ft.tt2 -padx 5 -pady 5
    pack .fe.ft .fe.bo -padx 5 -pady 5

    wm withdraw .fe
    update idletasks
    set x [expr [winfo x .] + ([winfo width .] - [winfo reqwidth .fe]) / 2]
    set y [expr [winfo y .] + ([winfo height .] - [winfo reqheight .fe]) / 2]

    wm geometry .fe +$x+$y
    wm deiconify .fe

    focus .fe.bo
    update
    grab .fe
    tkwait window .fe
}

wm title . "EWIPE"

# メニュー

frame .fm -relief raised -bd 2
menubutton .fm.mbf -text File -menu .fm.mbf.m
menu .fm.mbf.m -tearoff 0
menubutton .fm.mbo -text Option -menu .fm.mbo.m
menu .fm.mbo.m -tearoff 0 -postcommand checkmenu
menu .fm.mbo.m.lang -tearoff 0
menu .fm.mbo.m.pnum -tearoff 0
menu .fm.mbo.m.time -tearoff 0
menu .fm.mbo.m.timetype -tearoff 0
menu .fm.mbo.m.path -tearoff 0
menu .fm.mbo.m.htmlc -tearoff 0
menu .fm.mbo.m.htmls -tearoff 0
menu .fm.mbo.m.vsize -tearoff 0
menu .fm.mbo.m.view -tearoff 0
menu .fm.mbo.m.save -tearoff 0
menu .fm.mbo.m.bgtype -tearoff 0
menu .fm.mbo.m.titletype -tearoff 0
pack .fm.mbf .fm.mbo -side left
pack .fm -side top -fill x

# 編集コマンドボタン
frame .fb1
button .fb1.bl -command "popupmenu label"
button .fb1.bi -command "inputtext {} {} 0"
button .fb1.ba -command "inputtext {} {} 1"
button .fb1.bc -command deleteline
button .fb1.bp -command pasteline
button .fb1.be -command edittext
button .fb1.bu -command "move up"
button .fb1.bd -command "move down"
button .fb1.bo -command "popupmenu color"
button .fb1.bf -command "popupmenu font"
button .fb1.bt -command "popupmenu attr"
pack .fb1.bl .fb1.bi .fb1.ba .fb1.bc .fb1.bp .fb1.be .fb1.bu \
	.fb1.bd .fb1.bo .fb1.bf .fb1.bt -side left

menu .pml -tearoff 0
menu .pmml -tearoff 0
menu .pmc -tearoff 0
menu .pmf -tearoff 0 -postcommand checkfont
menu .pms -tearoff 0
menu .pma -tearoff 0

# 表示画面
frame .fc
canvas .fc.c -height 400 -width 590 -bg RoyalBlue3 \
        -yscrollcommand ".fc.vs set" -scrollregion "0 0 590 400"
scrollbar .fc.vs -orient vertical -command ".fc.c yview"

pack .fc.c .fc.vs -side left -fill y


# ページ操作ボタン
frame .fb2
button .fb2.bv -command "call_viewer normal" 
button .fb2.bt -command showtitle
entry .fb2.ep -width 7 -justify center
button .fb2.bp -command "set view_skip 1; nextpage -1"
button .fb2.bn -command "set view_skip 1; nextpage 1"
button .fb2.bi -command "createpage 0"
button .fb2.ba -command "createpage 1"
pack .fb2.bv .fb2.bt .fb2.ep .fb2.bp .fb2.bn .fb2.bi .fb2.ba \
	-side left

pack .fb1 .fc .fb2 -fill x

# 初期設定
set commandlist {title item subitem subsubitem subsubsubitem \
	right center left pict symbol text textbox table \
	pp rp animation move pause}
set lnum 0                    ;# 行数
set cp 0                      ;# 表示しているページ
set cursor {}                 ;# 選択行
set clip(line) {}             ;# カット行記憶用 
set clip(page) {}             ;# カットページ記憶用
set pwd [pwd]                 ;# 起動ディレクトリ
set filedir [pwd]             ;# 編集ファイルディレクトリ
set Viewmode 0                ;# モード (1: Viewer only)
set view_skip 0

set version "1.2.0"           ;# EWIPE Version

readdotfile

set filename {}                ;# ファイル名
set docpages {}
if {$argv != ""} {
    argvcheck
}
definefont

if {$docpages == {}} {
    if {$Option(startpage) == {}} {
	set docpages {}
    } else {
	set docpages $Option(startpage)
    }
    set docpagesorg $docpages
}
set maxp [llength $docpages]  ;# ページ数
set mode page                 ;# 表示モード
changelang $Option(lang)      ;# 表示言語

changesize

if {$Viewmode == 1} {
    call_viewer view
}
ctrlbutton disabled
bind .fb2.ep <Any-Return> "jumppage" 



