*** tkdic.org	Mon Jun 23 13:35:55 1997
--- tkdic	Mon Sep  8 22:07:41 1997
***************
*** 8,13 ****
--- 8,32 ----
  # license or royalty fees, to use, copy, modify, and distribute this
  # software and documentations for *any* purpose.
  set tkdic(version) {$Id: tkdic,v 1.2 1997/06/23 04:35:25 taguchi Exp $}
+ 
+ #
+ # [1997/09/08] OSHIRO Naoki.
+ #   ・選択された辞書の URL 表示を日本語表示にした．
+ #   ・上記に伴い tkdic(server) の構造を変更 {URL 日本語名}．
+ #   ・サーバ選択を辞書選択として File メニューから独立させ，選択を容易にした．
+ #   ・「候補」という表記の削除．
+ #   ・「結果」表記へ現在の辞書名を付記．
+ #   ・起動時に選択する辞書 ID を指定できるようにした．
+ #   ・検索語エントリの幅縮小，ダブルクリックによる項目消去をバインド．
+ #   ・検索語エントリにフォーカスを掛けた．
+ #   ・クリアボタンの付加．全表示項目を消去する．
+ #   ・URL が変わっても検索語はクリアされないようにした．
+ #   ・検索語ヒストリの付加（本当は検索語だけではなくフレームも含めたヒストリが望ましいだろう）．
+ #   ・メッセージ表示を右端へ寄せた．
+ #   ・TkDic_serchWordBody の誤記訂正．
+ #   ・TkDic_clear にテキストウィジェットの status 制御付加．
+ #
+ 
  # ###
  # 起動部
  # ###
***************
*** 30,51 ****
  
  # menu ボタン生成
  menubutton .mbar.file -menu .mbar.file.menu -text "File" -underline 0
  menubutton .mbar.edit -menu .mbar.edit.menu -text "Edit" -underline 0
  menubutton .mbar.help -menu .mbar.help.menu -text "Help" -underline 0
  pack .mbar.file -side left
  pack .mbar.edit -side left
  pack .mbar.help -side right
  
  # file メニュー
  menu .mbar.file.menu
! .mbar.file.menu add cascade -label {Server} -underline 0 \
!     -menu .mbar.file.menu.server
! .mbar.file.menu add separator
  .mbar.file.menu add command -label {Exit} -underline 0 \
      -command {TkDic_quit}
  
  menu .mbar.file.menu.server
  
  menu .mbar.help.menu
  .mbar.help.menu add command -label {About} -underline 0 \
      -command {TkDic_about}
--- 49,75 ----
  
  # menu ボタン生成
  menubutton .mbar.file -menu .mbar.file.menu -text "File" -underline 0
+ menubutton .mbar.dicsel -menu .mbar.dicsel.menu -text "Dictionary" -underline 0
  menubutton .mbar.edit -menu .mbar.edit.menu -text "Edit" -underline 0
  menubutton .mbar.help -menu .mbar.help.menu -text "Help" -underline 0
+ 
  pack .mbar.file -side left
  pack .mbar.edit -side left
+ pack .mbar.dicsel -side left
  pack .mbar.help -side right
  
  # file メニュー
  menu .mbar.file.menu
! #.mbar.file.menu add cascade -label {Server} -underline 0 \
! #    -menu .mbar.file.menu.server
! #.mbar.file.menu add separator
  .mbar.file.menu add command -label {Exit} -underline 0 \
      -command {TkDic_quit}
  
  menu .mbar.file.menu.server
  
+ menu .mbar.dicsel.menu
+ 
  menu .mbar.help.menu
  .mbar.help.menu add command -label {About} -underline 0 \
      -command {TkDic_about}
***************
*** 58,76 ****
  # 単語入力部
  frame .word.entry
  label .word.entry.l -text "検索語:"
! entry .word.entry.e -textvariable tkdic(currentPattern)
  bind .word.entry.e <Return> {
      eval TkDic_searchPattern $tkdic(currentPattern) $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
  button .word.entry.b -text "辞書引き" -command {
      eval TkDic_searchPattern $tkdic(currentPattern) $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
! pack .word.entry.b -side right
  pack .word.entry.l -side left
! pack .word.entry.e -side left -fill x -expand true
  
  frame .word.list
! label .word.list.lb -text "候補:"
  listbox .word.list.l -selectmode single -yscrollcommand [list .word.list.s set]
  bind .word.list.l <1> {
      TkDic_searchWord [%W curselection] $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
--- 82,114 ----
  # 単語入力部
  frame .word.entry
  label .word.entry.l -text "検索語:"
! entry .word.entry.e -textvariable tkdic(currentPattern) -width 20
  bind .word.entry.e <Return> {
+     set tkdic(historyNo) -1
+     .word.entry.hb configure -state normal
+     .word.entry.hf configure -state disabled
      eval TkDic_searchPattern $tkdic(currentPattern) $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
+ bind .word.entry.e <Double-Button-1> {.word.entry.e delete 0 end}
  button .word.entry.b -text "辞書引き" -command {
+     set tkdic(historyNo) -1
+     .word.entry.hb configure -state normal
+     .word.entry.hf configure -state disabled
      eval TkDic_searchPattern $tkdic(currentPattern) $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
! button .word.entry.c -text "クリア" -command {TkDic_clear}
! button .word.entry.hb -text "後退" -command {TkDic_history -1} -state disabled
! button .word.entry.hf -text "前進" -command {TkDic_history 1} -state disabled
  pack .word.entry.l -side left
! pack .word.entry.e -side left -fill x -expand false
! pack .word.entry.b -side left
! pack .word.entry.c -side left
! pack .word.entry.hb -side left
! pack .word.entry.hf -side left
! focus .word.entry.e
  
  frame .word.list
! #label .word.list.lb -text "候補:"
  listbox .word.list.l -selectmode single -yscrollcommand [list .word.list.s set]
  bind .word.list.l <1> {
      TkDic_searchWord [%W curselection] $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
***************
*** 78,84 ****
  bindtags .word.list.l {Listbox .word.list.l . all}
  scrollbar .word.list.s -orient vertical \
      -command [list .word.list.l yview] 
! pack .word.list.lb -side top -anchor nw
  pack .word.list.s -side right -fill y
  pack .word.list.l -side left -fill both -expand true
  
--- 116,122 ----
  bindtags .word.list.l {Listbox .word.list.l . all}
  scrollbar .word.list.s -orient vertical \
      -command [list .word.list.l yview] 
! #pack .word.list.lb -side top -anchor nw
  pack .word.list.s -side right -fill y
  pack .word.list.l -side left -fill both -expand true
  
***************
*** 87,109 ****
      
  # 検索結果表示部
  label .text.lb -text "結果:"
! text .text.t -yscrollcommand [list .text.s set] -state disabled -cursor man
  .text.t tag configure INDEX -foreground blue -underline true
  .text.t tag bind INDEX <1> {
      TkDic_searchFrame "@%x,%y" $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
  scrollbar .text.s -orient vertical -command [list .text.t yview]
  frame .text.l
  label .text.l.bitmap
  label .text.l.text -anchor w
- pack .text.l.bitmap -side left
- pack .text.l.text -side right -fill x -expand true
  pack .text.lb -side top -anchor nw
  pack .text.l -side bottom -fill x
  pack .text.s -side right -fill y
  pack .text.t -fill both -expand true
  
  bind . <Destroy> TkDic_closeServer
  # ---------------------------------------------
  # GUI系プロシージャ群
  # ---------------------------------------------
--- 125,152 ----
      
  # 検索結果表示部
  label .text.lb -text "結果:"
! #text .text.t -yscrollcommand [list .text.s set] -state disabled -cursor man
! text .text.t -yscrollcommand [list .text.s set] -state disabled -cursor top_left_arrow -width 50
  .text.t tag configure INDEX -foreground blue -underline true
  .text.t tag bind INDEX <1> {
      TkDic_searchFrame "@%x,%y" $tkdic(currentServer) $tkdic(hostname) $tkdic(user)
  }
  scrollbar .text.s -orient vertical -command [list .text.t yview]
  frame .text.l
+ label .text.l.dicname -text "結果:"
  label .text.l.bitmap
  label .text.l.text -anchor w
  pack .text.lb -side top -anchor nw
+ #pack .text.l.dicname -side left
+ pack .text.l.text -side right -fill x -expand false
+ pack .text.l.bitmap -side right
  pack .text.l -side bottom -fill x
  pack .text.s -side right -fill y
  pack .text.t -fill both -expand true
  
  bind . <Destroy> TkDic_closeServer
+ bind . <Control-q> {TkDic_quit}
+ 
  # ---------------------------------------------
  # GUI系プロシージャ群
  # ---------------------------------------------
***************
*** 119,128 ****
  proc TkDic_initServMenu {m} {
      upvar \#0 tkdic tkdic
      catch {$m delete 0 end}; # delete all server items
!     set tkdic(currentServer) [lindex $tkdic(server) 0]
      foreach i $tkdic(server) {
! 	$m add radiobutton -label $i -variable tkdic(currentServer) \
! 	    -command {TkDic_clear}
      }
      return $tkdic(server)
  }
--- 162,180 ----
  proc TkDic_initServMenu {m} {
      upvar \#0 tkdic tkdic
      catch {$m delete 0 end}; # delete all server items
! puts "server:$tkdic(server)"
!     if {$tkdic(startId)<0} \
! 	    {puts "TkDic: Warning: Too small startId `$tkdic(startId)'."; set tkdic(startId) 0}
!     if {$tkdic(startId)>=[llength $tkdic(server)]} {\
! 	    puts "TkDic: Warning: Too large startId `$tkdic(startId)'."; \
! 	    set tkdic(startId) [expr [llength $tkdic(server)] - 1]}
!     set tkdic(currentServer) \
! 	    [lindex [lindex $tkdic(server) $tkdic(startId)] 0]
      foreach i $tkdic(server) {
! 	set k [lindex $i 0]
! 	set j [lindex $i 1]
! 	$m add radiobutton -label $j -value $k -variable tkdic(currentServer) \
! 	    -command {TkDic_change}
      }
      return $tkdic(server)
  }
***************
*** 137,143 ****
--- 189,210 ----
  proc TkDic_clear {} {
      .word.entry.e delete 0 end
      .word.list.l delete 0 end
+     .text.t configure -state normal ;# テキストウィジェットを挿入可に
      .text.t delete 0.0 end
+     .text.t configure -state disabled
+     TkDic_printMsg "クリア" info
+ }
+ 
+ # TkDic_change {}: 辞書の変更があった場合の処理
+ proc TkDic_change {} {
+     global tkdic
+     set cur $tkdic(currentServer)
+     set name ???
+     foreach i $tkdic(server) {
+ 	if {$cur==[lindex $i 0]} {set name [lindex $i 1]}
+     }
+     .text.lb configure -text "結果:$name"
+     TkDic_printMsg "辞書を設定しました．" info
  }
  
  # ###
***************
*** 145,155 ****
  # ###
  # tkdic(server): dserverのサーバ名，辞書名を URL 記法で記述したリスト
  # URL 表記は以下の通り
! # ndtp://サーバ名(:ポート名)/辞書名
  # ポート名は省略可であるが，辞書名は省略不可．
  set tkdic(server) {
!     {ndtp://localhost/chujiten/}
  }
  # tkdic(hostname): クライアントを動作させるマシンのホスト名
  if {[catch {info hostname} tkdic(hostname)]} {
      set tkdic(hostname) {}
--- 212,229 ----
  # ###
  # tkdic(server): dserverのサーバ名，辞書名を URL 記法で記述したリスト
  # URL 表記は以下の通り
! # ndtp://サーバ名(:ポート名)/辞書名 日本語名
  # ポート名は省略可であるが，辞書名は省略不可．
+ set tkdic(startId) 1
  set tkdic(server) {
!     {ndtp://localhost/chujiten/ 研究社中英和}
  }
+ 
+ puts "server: $tkdic(server)"
+ set tkdic(history) ""
+ set tkdic(historyNo) -1
+ set tkdic(historyMax) 20
+ 
  # tkdic(hostname): クライアントを動作させるマシンのホスト名
  if {[catch {info hostname} tkdic(hostname)]} {
      set tkdic(hostname) {}
***************
*** 170,176 ****
      catch [list source $rcfile]
  }
  
! TkDic_initServMenu .mbar.file.menu.server ;# メニューを初期化する
  # ---------------------------------------------
  # サーバ通信系プロシージャ群
  # ---------------------------------------------
--- 244,252 ----
      catch [list source $rcfile]
  }
  
! #TkDic_initServMenu .mbar.file.menu.server ;# メニューを初期化する
! TkDic_initServMenu .mbar.dicsel.menu ;# メニューを初期化する
! TkDic_change
  # ---------------------------------------------
  # サーバ通信系プロシージャ群
  # ---------------------------------------------
***************
*** 345,350 ****
--- 421,429 ----
      TkDic_sendln $tkdic(stream) "P$idx$pattern" ; # パターン検索実行
      set tkdic(currentEntries) {} ; # マッチするものを入れる
      $l delete 0 end ; # listbox をクリア
+     .text.t configure -state normal ;# テキストウィジェットを挿入可に
+     .text.t delete 0.0 end
+     .text.t configure -state disabled
      while {[set code [TkDic_parseResp [set ln [gets $tkdic(stream)]]]] != "end"} {
  	if {$code == "cont"} {
  	    $l insert end $ln ; update
***************
*** 359,364 ****
--- 438,445 ----
  	$l selection set 0
  	TkDic_closeServer 
  	TkDic_searchWord 0 $url $hostname $user; # とりあえず先頭の語を引く
+ 	if {$tkdic(historyNo) < 0} {\
+ 		TkDic_historyAdd $pattern $url $hostname $user}
      } else {
  	TkDic_printMsg "辞書にない単語でした" warning
      }
***************
*** 366,371 ****
--- 447,498 ----
      return true
  }
  
+ proc TkDic_history {direc} {
+     upvar \#0 tkdic tkdic
+ 
+     if {$tkdic(historyNo) == -1} {set tkdic(historyNo) 0}
+     set n [expr $tkdic(historyNo) - $direc]
+     set max [expr [llength $tkdic(history)] - 1]
+     if {$n < 0} {set n 0}
+     if {$n > $max} {set n $max}
+     set history [lindex $tkdic(history) $n]
+     .word.entry.e delete 0 end
+     .word.entry.e insert 0 [lindex $history 0]
+     set tkdic(currentServer) [lindex $history 1]
+     TkDic_change
+     set tkdic(historyNo) $n
+     eval TkDic_searchPattern $history
+     set f_state "normal"
+     set b_state "normal"
+     if {$n <= 0} {
+ 	    set f_state "disabled" 
+     } elseif {$n >= $max} {
+ 	    set b_state "disabled" 
+     } 
+     .word.entry.hf configure -state $f_state; 
+     .word.entry.hb configure -state $b_state; 
+ }
+ 
+ proc TkDic_historyAdd {pattern url hostname {user {}}} {
+     upvar \#0 tkdic tkdic
+ 
+     if {$tkdic(historyNo) != -1} {
+ 	TkDic_printMsg "History ID Error" error;
+     }
+     # 直前のヒストリと同じ場合は追加しない．
+     if {$pattern == [lindex [lindex $tkdic(history) 0] 0] &&
+         $url == [lindex [lindex $tkdic(history) 0] 1] &&
+         $hostname == [lindex [lindex $tkdic(history) 0] 2] &&
+         $user == [lindex [lindex $tkdic(history) 0] 3] 
+        } {return}
+     set max [expr [llength $tkdic(history)]]
+     if {$max>$tkdic(historyMax)} { # trim history
+ 	set tkdic(history) [lrange $tkdic(history) 0 $tkdic(historyMax)]
+     }
+     set tkdic(history) [linsert $tkdic(history) 0 [list $pattern $url $hostname $user]]
+     set n $tkdic(historyNo)
+     if {$n<0} {set n 0}
+ }
  
  # ### 単語を引く ###
  proc TkDic_searchWord {idx url hostname {user {}}} {
***************
*** 378,384 ****
      }
      TkDic_printMsg "単語を引きます" info
      TkDic_sendln $tkdic(stream) "S[lindex [lindex $tkdic(currentEntries) $idx] 1]" ; # 単語引きの実行
!     return [TkDic_serchWordBody]
  }
  
  proc TkDic_searchFrame {index url hostname {user {}}} {
--- 505,511 ----
      }
      TkDic_printMsg "単語を引きます" info
      TkDic_sendln $tkdic(stream) "S[lindex [lindex $tkdic(currentEntries) $idx] 1]" ; # 単語引きの実行
!     return [TkDic_searchWordBody]
  }
  
  proc TkDic_searchFrame {index url hostname {user {}}} {
***************
*** 404,413 ****
  	return false ; # 接続が切れていれば再接続．失敗したら帰る
      }
      TkDic_sendln $tkdic(stream) "S$frame"
!     return [TkDic_serchWordBody]
  }
  	
! proc TkDic_serchWordBody {} {
      upvar \#0 tkdic tkdic
      .text.t configure -state normal ;# テキストウィジェットを挿入可に
      .text.t delete 0.0 end ; # まずクリアする
--- 531,540 ----
  	return false ; # 接続が切れていれば再接続．失敗したら帰る
      }
      TkDic_sendln $tkdic(stream) "S$frame"
!     return [TkDic_searchWordBody]
  }
  	
! proc TkDic_searchWordBody {} {
      upvar \#0 tkdic tkdic
      .text.t configure -state normal ;# テキストウィジェットを挿入可に
      .text.t delete 0.0 end ; # まずクリアする
