To search the Tcler's Wiki, please use http://wiki.tcl.tk/4%|%Search%|% 
----
[fr]: This is about retrieval or browsing the wiki pages, or at least some of them.

It goes without embedded links, instead the experimental client code below offers a text widget, to select short suffix strings step by step. The discriminating characters to type are displayed on yellow background.

Use Pos1 to return to startpage, backspace or arrow-left to step back.

Use the keyboard or click items, if no appropriate key is available.

Tab and space both select too.

To start, please type the initial letter of an arbitray word supposed in a wiki page title.

One exception: to find pages of category company|home|person, type a space first.
----
animation in Firefox, APNG Editor plugin
[http://www.taipu.de/demo/re_animation.png]
----
Screenshot with demos in action
[http://www.taipu.de/demo/titles.png]
----
 package r Tk
 package r http
 #set ::url T://www.taipu.de/f
 set ::url T://85.88.28.141/f
 regsub T $::url http ::url
 foreach k [winfo chi .] {
         catch {destroy $k} 
 }
 set ::tx [toplevel .index]
 wm title $::tx nore..
 frame $::tx.f
 set ::reaped_code ""
 label $::tx.f.l -text Select-Events:
 pack $::tx.f.l -side left
 set ::visit 1
 checkbutton $::tx.f.visit -variable ::visit -text "open page in browser"
 pack $::tx.f.visit -side left
 set ::rp 0
 checkbutton $::tx.f.reap -variable ::rp -text "reap & run Tk-code, possibly UNSECURE!" -fg red
 pack $::tx.f.reap -side left
 pack $::tx.f
 set ::z $::tx.t
 text $::z -ba lightgrey -wrap word -height 18
 pack $::z
 # fonts
 set ::pfo device
 set ::pfo_hot systemfixed
 set ::pfo_title system
 $::z tag con hot -for blue -ba yellow -fon $::pfo_hot
 $::z tag con norm -for black -ba white -fon $::pfo
 $::z tag con title -for black -ba \#9afb95 -fon $::pfo_title
 bind . <F1> {console show}
 wm title . taipudex
 . configure -bg bisque
 bind $::tx <Key-BackSpace> {ome}
 bind $::tx <Key-Left> {ome}
 bind $::tx <Key-Home> {woidle}
 bind $::z <Motion> {mola @%x,%y}
 bind $::z <1> {pu @%x,%y}
 bind $::z <Leave> {mola ""}
 bind $::tx <Key> {nore %A}
 
 # regex-patterns of unsecure commands
 set ::pAT_exec {\s*[\{\[]*\s*exe[c]{0,1}\s}
 set ::pAT_eval {\s*[\{\[]*\s*eva[l]{0,1}\s}
 set ::pAT_file {\s*[\{\[]*\s*fi(?:l|le){0,1}\s}
 set ::pAT_open {\s*[\{\[]*\s*ope[n]{0,1}\s}
 set ::pAT_load {\s*[\{\[]*\s*loa[d]{0,1}\s}
 set ::pAT_package {\s*[\{\[]*\s*packa(?:g|ge){0,1}\s}
 
 proc pu w {
         set char [$::z get $w]
         foreach tag [$::z tag names $w] {
                 if {[regexp ^tag $tag]} {
                         set char [string range $tag end end]
                         break
                 }        
         }
         set todo ""
         catch {set todo $::fmt($char)}
         if {[string le $todo]} {
                 eval $todo
         } else {
                 bell
         }
 }
 array set ::kept {} ;# cached queries
 array set ::fmt {} ;# actions for key event
 set ::prev [list] ;# previous display
 set ::act_h "" ;# active tag before
 set ::amole "" ;# after id, property pink set
 proc mola at {
         if {![string le $at]} {
                 catch {after cancel $::amole}
                 if {[string le $::act_h]} {
                         $::z tag con $::act_h -ba {}
                 }
                 set ::amole ""
         } else {
                 if {![string le $::amole]} {
                         set ::amole [after 150 [list amola $at]]
                 }
         } 
 }
 proc amola at {
         catch {
                 foreach tag [$::z tag names $at] {
                         if {[regexp ^tag $tag]} {
                                 $::z tag con $tag -ba pink
                                 if {![string equal $::act_h $tag]} {
                                         if {[string le $::act_h]} {
                                                 catch {$::z tag con $::act_h -ba {} }
                                                 set ::act_h $tag
                                                 break
                                         }
                                         set ::act_h $tag
                                 }
                         }
                 }
         }
         set ::amole ""
 }
 proc ome {} {
         set last [pop]
         zag $last $::kept($last) 0
 }
 proc nore {uc} {
         if {[string le $uc]} {
                 catch {
                         set afi $::fmt($uc)
                         if {[string le $afi]} {
                                 eval $afi
                         }
                 } err
         }
 }
 proc pop {} {
         set ::prev [lreplace $::prev end end]
         set res [lindex $::prev end]
         set ::prev [lreplace $::prev end end]
         return $res
 }
 proc push {x} {
         lappend ::prev $x
 }
 proc woidle {{x {}}} {
         # append minus to preserve trailing blank
         set q $x-
         set q [::http::mapReply $q]
         wm title $::tx nore..
         update idletasks
         if {[catch {set vast $::kept($x)}]} {
                 if {[catch {set t [time {set n [::http::geturl $::url -query x=$q]}] } err]} {
                         #puts err=$err
                         tk_messageBox -icon error -message $err -title "error on $::url"
                         return
                 }
                 set t [expr {[lindex $t 0]/1000}]\ msec
                 wm title $::tx $t
                 zag $x [::http::data $n] 1
                 http::cleanup $n
         } else {
                 wm title $::tx 0
                 zag $x $vast 0
         }
 }
 proc zag {prefix x save} {
         set ::title_l {}
         push $prefix
         if {$save} {
                 set ::kept($prefix) $x
         }
         $::z con -state normal
         $::z delete 1.0 end
         foreach tag [$::z tag names] {if {[regexp ^tag $tag]} {$::z tag delete $tag}}
         set ::a $x
         set nl2 [string first \n\n $x]
         set tlen 2
         if {[expr $nl2 > -1]} {
                 foreach pair [split [string range $x [expr {$nl2+2}] end] \n] {
                         foreach {k v} [split $pair \t] break
                         set ::titles($k) $v
                         set tmp [string le $v]
                         if {[expr {$tlen<$tmp}]} {set tlen $tmp}
                 }
                 incr nl2 -1
                 set x [string range $x 0 $nl2]
         } else {
                 regsub {\n$} $x {} x
         }
         set itemlist [split $x \n]
         set spaces ""
         set nl \n
         set h [lindex [$::z configure -height] end]
         set sep [expr {([llength $itemlist]<=$h) ? $nl : $spaces }]
         set longest 0
         set first_t 1
         array unset ::fmt
         foreach t $itemlist {
                 set clen [string le $t]
                 if {[expr {$clen>$longest}]} {set longest $clen}
                 set tagstart [$::z ind insert]
                 set tagend $tagstart
                 $::z ins end \ $prefix norm
                 set hc ""
                 if {$first_t} {
                         set first_t 0
                         if {[regexp {^ [0-9]+$} $t]} {
                                 set dis ""
                         } else {
                                 set dis [string range $t 0 0]
                         }
                 } else {
                         set dis [string range $t 0 0]
                 }
                 set rest [string range $t 1 end]
                 append hc $dis
                 $::z ins end $hc hot
                 set uniq 2
                 if {![regexp {\$$} $t]} {
                         set all [split $rest \t]
                         set ff [lindex $all end]
                         foreach {fin ff} [split $t \t] break
                         set fin [string range $fin 1 end]
                         foreach pg [split $ff +] {
                                 incr uniq -1
                                 if {$uniq==1} {
                                         if {![string eq $hc \t] } {
                                                 $::z ins end $fin\t  norm
                                         }
                                         $::z ins end \ $::titles($pg)\t title
                                 } else {
                                         $::z ins end $sep
                                         $::z ins end \t$::titles($pg)\t title
                                 }
                                 set tagend [$::z ind insert]
                         }
                         if {$uniq==1} {
                                 set ::fmt($hc) [list sho $pg $::titles($pg)]
                         }
                 } else {
                         set fin $t
                         set fin [string range $t 1 end-1]
                         set ::fmt($hc) [list woidle $prefix$hc$fin]
                         append fin \u2026
                         $::z ins end $fin\t norm
                         $::z ins end \t title
                         set tagend [$::z ind insert]
                 }
                 $::z ins end $sep
                 $::z tag add tag$hc $tagstart $tagend
         }
         incr longest 1
         incr tlen $tlen 
         $::z configure -tabs "[expr {$longest * [font measure $::pfo 0]}] left [expr {$tlen * [font measure $::pfo_title 0]}] right"
         $::z configure -state disabled
 }
 proc sho {idx title} {
         if {$::visit} {
                 if {[catch {lug http://wiki.tcl.tk/$idx} err]} {
                         tk_messageBox -icon error -message $err -title "error on starting browser"
                 }
         }
         if {$::rp} {
                 set ::reaped_code ""
                 reap $idx
                 if {[regexp {pack |grid } $::reaped_code]} {
                         # gui code found
                         set code $::reaped_code
                         set tk [regsub -all -line {^\s*package.*Tk\s*$} $code {} code]
                         regsub -all -line {^\s*console} $code {#console} code
                         # check unsecure commands
                         set crit [list]
                         foreach p [info vars ::pAT_*] {
                                 if {[regv $p code]} {
                                         lappend crit $p
                                 }
                         }
                         # disregarded glob|socket|wm 
                         # todo:
                         # maybe list package dependencies
                         # ask user, if to run anyway
                         if {[llength $crit]} {
                                 set in [::safe::interpCreate]
                                 ::safe::loadTk $in
                         } else {
                                 set in [interp create]
                         }
                         puts in=$in
                         append code \n[info body ::2top]\n
                         #puts code:<<$code>>
                         if {!$tk} {
                                 $in eval "package require Tk\n$code"
                         } else {
                                 $in eval "package require Tk\n$code"
                         }
                 }
         }
 }
 proc 2top {} {
         fore x [winfo chi .] {
                 if {[rege {Wish|Top} [winfo class $x]]} {
                         wm dei $x
                 }
         }
 }
 proc regv {pname text} {
         upvar $pname v
         upvar $text t
         return [regexp $v $t]
 }
 proc lug {url} {
         if {[regexp windo $::tcl_platform(platform)]} {
                 set exe $::env(ProgramFiles)
                 append exe /Mozilla\ Firefox/firefox.exe
                 exec $exe $url &
         } else {
                 exec iceweasel $url &
         }
 }
 woidle ""

 # from [http://wiki.tcl.tk/4718]
 if {![catch { package require nstcl-html }] &&
     ![catch { package require nstcl-http }]} {
     namespace import nstcl::*
 } else {
     package require http

     proc ns_geturl {url} {
         set conn [http::geturl $url]
         set html [http::data $conn]
         http::cleanup $conn
         return $html
     }

     proc ns_striphtml {-tags_only html} {
         regsub -all -- {<[^>]+>} $html "" html
         return $html ;# corrected a typo here
     }

     proc ns_urlencode {string} {
         set allowed_chars  {[a-zA-Z0-9]}
         set encoded_string ""

         foreach char [split $string ""] {
             if {[string match $allowed_chars $char]} {
                 append encoded_string $char
             } else {
                 scan $char %c ascii
                 append encoded_string %[format %02x $ascii]
             }
         }

         return $encoded_string
     }
 }

 proc output {data} {
     # we don't want to throw an error if stdout has been closed
     catch { puts $data }
 }

 proc reap {page} {
     package require htmlparse

     set url  http://wiki.tcl.tk/[ns_urlencode $page]
     set now  [clock format [clock seconds] -format "%e %b %Y, %H:%M" -gmt 1]
     set html [ns_geturl $url]

     # can't imagine why these characters would be in here, but just to be safe
     set html [string map [list \x00 "" \x0d ""] $html]
     set html [string map [list <pre> \x00 </pre> \x0d] $html]

     if {![regexp -nocase {<title>([^<]*)</title>} $html => title]} {
         set title "(no title!?)"
     }

     if {![regexp -nocase {<i>Updated on ([^G]+ GMT)} $html => updated]} {
         set updated "???"
     }

     output "#####"
     output "#"
     output "# \"$title\""
     output "#"
     output "# Tcl code harvested on:  $now GMT"
     output "# Wiki page last updated: $updated"
     output "#"
     output "#####"
     output \n

     set html [ns_striphtml -tags_only $html]

     foreach chunk [regexp -inline -all {\x00[^\x0d]+\x0d} $html] {
         set chunk [string range $chunk 1 end-1]
         set chunk [::htmlparse::mapEscapes $chunk]

         foreach line [split $chunk \n] {
             if {[string index $line 0] == " "} {
                 set line [string range $line 1 end]
             }

             output $line
         }
     }

     output \n
     output "# EOF"
     output \n
 }
 proc output s {
         append ::reaped_code $s\n
 }
 set ::reaped_code ""

----
!!!!!!
%| [Category Gui] | [Category Tcler's Wiki] |%
!!!!!!