*** wipe.original/wipe Tue Aug 19 16:51:13 1997 --- wipe/wipe2 Fri Sep 5 16:27:04 1997 *************** *** 1,4 **** ! #!/pkg/root/bin/wish -f # # WIPE: Wide Instant Presentation Environment --- 1,4 ---- ! #!/usr/local/bin/wish -f # # WIPE: Wide Instant Presentation Environment *************** *** 7,13 **** # Copyright (c) 1995,1997 Kazumasa Utashiro # Internet Initiative Japan Inc. # ! # $Id: wipe,v 1.1 1997/03/21 18:18:14 utashiro Exp $ # option add *Font rk24 --- 7,13 ---- # Copyright (c) 1995,1997 Kazumasa Utashiro # Internet Initiative Japan Inc. # ! # $Id: wipe2,v 1.3 1997/09/05 07:27:04 ishioka Exp $ # option add *Font rk24 *************** *** 18,26 **** set bitmapdir /usr/X11/include/X11/bitmaps set docfilename $argv ! if [file exists ./tkform.tcl] { ! source tkform.tcl ! } bind . <1> "nextpage" bind . "nextpage" --- 18,33 ---- set bitmapdir /usr/X11/include/X11/bitmaps set docfilename $argv ! # tkform.tcl は /usr/local/lib/wipe にコピーし, ! # /usr/local/lib/wipe で tclsh を起動し、 ! # % auto_mkindex . *.tcl ! # とします。そのディレクトリを auto_path に追加することで ! # current になくても動作可能にする. ! # tkform.tcl ! #if [file exists /usr/local/lib/ewipe/tkform.tcl] { ! # source /usr/local/lib/ewipe/tkform.tcl ! #} ! lappend auto_path /usr/local/lib/wipe bind . <1> "nextpage" bind . "nextpage" *************** *** 32,53 **** bind . q "destroy ." wm maxsize . 2048 2048 ###################################################################### ! # フォーム定義とその結果を表示する proc progresult {path form} { global cw tkform $path PR { frame {-bd 1 -relief raised -bg aquamarine} top fill configure {label -bg lavender -bd 1 -relief raised} ! {label -text {フォーム定義} -anchor c} nofill program: {message -width $cw -text $form} fill ! {label -text {結果} -anchor c} nofill result: { tkform PR $form --- 39,79 ---- bind . q "destroy ." + # 始めと終りにジャンプ ishioka + bind . E "lastpage" + bind . B "firstpage" + + # [0-9]+g を有効にしたくて追加. ishioka + #bind . 0 "pushpage 0" + bind . 1 "pushpage 1" + bind . 2 "pushpage 2" + bind . 3 "pushpage 3" + bind . 4 "pushpage 4" + bind . 5 "pushpage 5" + bind . 6 "pushpage 6" + bind . 7 "pushpage 7" + bind . 8 "pushpage 8" + bind . 9 "pushpage 9" + bind . g "jump_pushed_page" + set pagepush 0 + wm maxsize . 2048 2048 + ###################################################################### ! # フォーム定義とその結果を表示する proc progresult {path form} { global cw tkform $path PR { frame {-bd 1 -relief raised -bg aquamarine} top fill configure {label -bg lavender -bd 1 -relief raised} ! {label -text {フォーム定義} -anchor c} nofill program: {message -width $cw -text $form} fill ! {label -text {結果} -anchor c} nofill result: { tkform PR $form *************** *** 108,114 **** regsub -all "\n\[ \t\]*" $text {} text frame $path -bd 0 -relief flat ! message $path.mark -text "◆" -fg $color pack $path.mark -side left -anchor n message $path.text -width [expr "$cw * 8/10"] -padx 0 -pady 0 -text $text -anchor w -fg $color --- 134,140 ---- regsub -all "¥n¥[ ¥t¥]*" $text {} text frame $path -bd 0 -relief flat ! message $path.mark -text "◆" -fg $color pack $path.mark -side left -anchor n message $path.text -width [expr "$cw * 8/10"] -padx 0 -pady 0 -text $text -anchor w -fg $color *************** *** 121,127 **** regsub -all "\n\[ \t\]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " ☆ " -fg $color message $path.text -width [expr "$cw * 15/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } --- 147,153 ---- regsub -all "¥n¥[ ¥t¥]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " ☆ " -fg $color message $path.text -width [expr "$cw * 15/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } *************** *** 132,138 **** regsub -all "\n\[ \t\]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " − " -fg $color message $path.text -width [expr "$cw * 14/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } --- 158,164 ---- regsub -all "¥n¥[ ¥t¥]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " − " -fg $color message $path.text -width [expr "$cw * 14/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } *************** *** 143,155 **** regsub -all "\n\[ \t\]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " ・ " -fg $color message $path.text -width [expr "$cw * 13/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } ! proc center {path text} { ! label $path -text $text } ###################################################################### --- 169,205 ---- regsub -all "¥n¥[ ¥t¥]*" $text {} text frame $path -bd 0 -relief flat ! label $path.mark -text " ・ " -fg $color message $path.text -width [expr "$cw * 13/20"] -padx 0 -pady 0 -text $text -fg $color pack $path.mark $path.text -side left -anchor nw } ! # 色指定可能に変更(ishioka) ! proc center {path text {color white}} { ! label $path -text $text -fg $color ! } ! ! # jpeg ファイルを表示するコマンド. サイズ調節できない.(ishioka) ! proc pict { path filename } { ! label $path -text $filename ! label $path.fname -text $filename ! image create photo $path.pict ! $path.pict read $filename ! label $path.image -image $path.pict ! # pack $path.fname $path.image -side top -anchor c ! pack $path.image -side top -anchor c ! } ! ! # 右詰めでText を表示する.(ishioka) ! proc rp { path text { color white}} { ! label $path -text $text -anchor e -fg $color ! } ! ! # ページ番号/総ページ数 を表示するコマンド. (ishioka) ! # 決った位置に出すとかいう事はできない. ! proc pagen { path { color yellow}} { ! global curpage docpages ! message $path -padx 0 -pady 0 -text "[expr $curpage + 1 ] / [llength $docpages]" -anchor e -fg $color -font 7x14 } ###################################################################### *************** *** 164,169 **** --- 214,245 ---- showpage [expr "$curpage - 1"] } + # [0-9]+g をしたくて追加. + proc lastpage {} { + global docpages + showpage [expr [llength $docpages] - 1] + } + + proc firstpage {} { + global docpages + showpage 0 + } + + proc pushpage {num} { + global pagepush + set pagepush [expr "$pagepush * 10 + $num"] + } + + proc jump_pushed_page {} { + global pagepush + if { $pagepush < 1 } { + return + } + showpage [expr "$pagepush - 1"] + set pagepush 0 + } + + proc showpage {page} { global curpage docpages windowlist P *************** *** 176,182 **** set windowlist \ [lreplace $windowlist $curpage $curpage [makewindow $curpage]] } ! showwindow [lindex $windowlist $curpage] } --- 252,258 ---- set windowlist \ [lreplace $windowlist $curpage $curpage [makewindow $curpage]] } ! showwindow [lindex $windowlist $curpage] } *************** *** 206,212 **** $P(canvas) itemconfigure $pageid -window $window } ! # ドキュメントファイルを読む read_docs ! # 最初のページを表示する showpage 0 --- 282,301 ---- $P(canvas) itemconfigure $pageid -window $window } ! # 「ページ番号/総ページ数」 を表示するボタンが欲しいな... ! # と思うが力がないので未完成. ! #proc showpages {pages} { ! # set form { ! # top fill ! # {left b[$pages]: {button -text $b}} ! # } ! # pack append . [tkform .number Button $form] {top fill} ! #} ! ! # ドキュメントファイルを読む read_docs ! ! #showpages $docpages ! ! # 最初のページを表示する showpage 0