set categories(rn) "更新履歴" set categories(cw) "Cygwin" set categories(ps) "PlayStation" set categories(com) "コミュニケーション" set categories(ai) "A.I." set categories(book) "蔵書目録" set categories(awking) "AWAKENING Project" set categories(awk) "AWK" set categories(net) ".net" set categories(os) "Operating System" set categories(tt) "立花 隆" set categories(perl) "Perl" set categories(ruby) "Ruby" set categories(tcl) "Tcl/Tk" set categories(python) "Python" set categories(prolog) "Prolog" set categories(php) "PHP" set categories(scr) "Script" set categories(java) "Java" set categories(linux) "Linux" set categories(printing) "Printing" set categories(hiroshima) "ひろしま" set categories(an) "ArrangeNote" set categories(qnx) "QNX" set categories(web) "Web Development" set categories(diary) "日記" set categories(scheme) "Scheme" set categories(tsn) "TS Network" set categories(tip) "Tips" set categories(col) "コラム" set categories(xml) "XML" set categories(vm) "VMware" set categories(freebsd) "FreeBSD" set categories(computing) "Computing" set categories(lang) "Languages" set categories(card) "カード" set categories(oo) "OpenOffice" set categories(sf) "SF" set categories(wbh) "WinBatchEh" set categories(dml) "日記マークアップ言語 dml" set categories(techip) "知的生産の技術" set categories(ont) "Ontology" set categories(nlp) "自然言語処理" set categories(hs) "Haystack" set categories(art) "芸術" set categories(robot) "ロボット" set categories(sony) "ソニー" set categories(ms) "マイクロソフト" set categories(win) "Windows" set categories(moz) "Mozilla" set categories(pc) "PC" set categories(mob) "Mobile" set categories(rdf) "RDF" set categories(sw) "Semantic Web" set categories(search) "Search" set categories(car) "Car" set categories(gg) "Google" set categories(w3c) "W3C" set categories(grid) "GRID" set categories(rwoi) "実世界指向インターフェース" set categories(svg) "SVG" set categories(char) "文字コード" set categories(ed) "Editor" set cgidir "C:/anhttpd" append cgidir $env(CGIDIR); set sw 0 if [catch {cd $cgidir} err] { puts stderr $err return } set files [glob -nocomplain {renewal_[0-9][0-9][0-9][0-9]_[0-9][0-9].xml}] lappend files renewal.xml foreach file $files { if [catch {open $file r} fileId] { puts stderr "Cannot open $file: $fileId" } else { fconfigure $fileId -encoding utf-8 set lines [split [read $fileId] \n] foreach line $lines { if [regexp {(.+)} $line match title] { continue } if [regexp {(.+)} $line match link] { set url $link if [regexp {^.+(\d{4})_(\d{2})\.html#([a-z]+)_(\d+)$} $link match year day catego date] { set linkary($date) "$url\t$year-$day\t$title\($catego\)" } elseif [regexp {^.+\.html#([a-z]+)_(\d+)$} $link match catego date] { set linkary($date) "$url\t今月\t$title\($catego\)" } set sw 0 } } } close $fileId } } wm title . "更新日記コンソール" frame .top -borderwidth 10 pack .top -side top -fill x menubutton .top.menub -text "マイ楽コピー" -menu .top.menub.menu -font {MS ゴシック 10 normal} -relief raised pack .top.menub -fill both -side left -expand yes set m .top.menub.menu menu $m -tearoff no $m add command -label "ハイパーリンク" -command {raku_hyperlink "hlink"} $m add command -label "引用" -command {raku_hyperlink "cite"} $m add separator $m add command -label "終了" -command exit menubutton .top.menub2 -text "記事リンク出力" -menu .top.menub2.menu -font "MS ゴシック 10 normal" -relief raised pack .top.menub2 -fill both -side left -expand yes set m2 .top.menub2.menu menu $m2 -tearoff no $m2 add command -label "終了" -command exit $m2 add separator foreach key [lsort -decreasing [array names linkary]] { set l1 [split $linkary($key) "\t"] set l1link [lindex $l1 0] set l1date [lindex $l1 1] set l1title [lindex $l1 2] $m2 add command -label "$l1date $l1title" -command "hyperlink $l1link \"$l1title\"" } menubutton .top.menub3 -text "記事カテゴリ出力" -menu .top.menub3.menu -font "MS ゴシック 10 normal" -relief raised pack .top.menub3 -fill both -side left -expand yes set m3 .top.menub3.menu menu $m3 -tearoff no $m3 add command -label "終了" -command exit $m3 add separator foreach key [lsort [array names categories]] { $m3 add command -label "$key => $categories($key)" -command "category $key" } proc raku_hyperlink { arg } { global inform set str [selection get -selection CLIPBOARD] set ary [split $str "\n"] set title [lindex $ary 0] set url [lindex $ary 1] set cite [lindex $ary 2] clipboard clear if { $arg == "hlink"} { clipboard append "$title" } elseif { $arg == "cite"} { clipboard append "

$title\n

\n$cite\n
" } return } proc hyperlink { l1link l1title } { global inform clipboard clear clipboard append "$l1title" return } proc category { key } { global inform clipboard clear clipboard append "c: $key\n" return }