|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
#######
#
# E-scripts on Tcl/Tk.
#
# Note 1: use the eev command (defined in eev.el) and the
# ee alias (in my .zshrc) to execute parts of this file.
# Executing this file as a whole makes no sense.
# An introduction to eev can be found here:
#
# (find-eev-quick-intro)
# http://angg.twu.net/eev-intros/find-eev-quick-intro.html
#
# Note 2: be VERY careful and make sure you understand what
# you're doing.
#
# Note 3: If you use a shell other than zsh things like |&
# and the for loops may not work.
#
# Note 4: I always run as root.
#
# Note 5: some parts are too old and don't work anymore. Some
# never worked.
#
# Note 6: the definitions for the find-xxxfile commands are on my
# .emacs.
#
# Note 7: if you see a strange command check my .zshrc -- it may
# be defined there as a function or an alias.
#
# Note 8: the sections without dates are always older than the
# sections with dates.
#
# This file is at <http://angg.twu.net/e/tcl.e>
# or at <http://angg.twu.net/e/tcl.e.html>.
# See also <http://angg.twu.net/emacs.html>,
# <http://angg.twu.net/.emacs[.html]>,
# <http://angg.twu.net/.zshrc[.html]>,
# <http://angg.twu.net/escripts.html>,
# and <http://angg.twu.net/>.
#
#######
# «.emacs» (to "emacs")
# «.single-step-wish» (to "single-step-wish")
# «.bullseye» (to "bullseye")
# «.debian» (to "debian")
# «.basic-principles» (to "basic-principles")
# «.6._Lists» (to "6._Lists")
# «.upvar» (to "upvar")
# «.uplevel» (to "uplevel")
# «.catch_code» (to "catch_code")
# «.eval» (to "eval")
# «.source» (to "source")
# «.info_complete» (to "info_complete")
# «.info_script» (to "info_script")
# «.tcl8.2-source» (to "tcl8.2-source")
# «.tclbook_dl_fix» (to "tclbook_dl_fix")
# «._tmp_tclbook.p1.txt» (to "_tmp_tclbook.p1.txt")
# «.tclbook» (to "tclbook")
# «.tkref» (to "tkref")
# «.cgi.tcl» (to "cgi.tcl")
# «.cgi.tcl:pkgIndex.tcl» (to "cgi.tcl:pkgIndex.tcl")
# «.blt» (to "blt")
# «.tuba» (to "tuba")
# «.et» (to "et")
# «.swig» (to "swig")
# «.list-vs-concat» (to "list-vs-concat")
# «.parsers_for_tcl» (to "parsers_for_tcl")
# «.encode_entities» (to "encode_entities")
# «.tclhttpd» (to "tclhttpd")
# «.plplot» (to "plplot")
# «.sciplot» (to "sciplot")
# «.quickplot» (to "quickplot")
# «.plotmtv» (to "plotmtv")
# «.debugging-.sos» (to "debugging-.sos")
# «.visual-tcl» (to "visual-tcl")
# «.dustmote» (to "dustmote")
# «.socket_servers_0» (to "socket_servers_0")
# «.tcltutor» (to "tcltutor")
# «.crim-2d» (to "crim-2d")
# «.tkinspect» (to "tkinspect")
# «.send» (to "send")
# «.mktclapp_objcom» (to "mktclapp_objcom")
# «.mktclapp_variadic» (to "mktclapp_variadic")
# «.environment» (to "environment")
# «.groupkit» (to "groupkit")
# «.freehand» (to "freehand")
# «.tkpaint» (to "tkpaint")
# «.static_libs» (to "static_libs")
# «.freewrap» (to "freewrap")
# «.tk_ps» (to "tk_ps")
# «.newdiaglib» (to "newdiaglib")
# «.tcl_from_c» (to "tcl_from_c")
# «.mousewheel_bug» (to "mousewheel_bug")
# «.nam» (to "nam")
# «.diaglib_blurb» (to "diaglib_blurb")
# «.namespaces» (to "namespaces")
# «.tclreadline» (to "tclreadline")
# «.8.3-src» (to "8.3-src")
# «.gepetto» (to "gepetto")
# «.tkgate» (to "tkgate")
# «.lrange_lreplace» (to "lrange_lreplace")
# «.regexp_and_ranges» (to "regexp_and_ranges")
# «.fundcomp» (to "fundcomp")
# «.resizer» (to "resizer")
# «.placer» (to "placer")
# «.frames» (to "frames")
# «.cursor» (to "cursor")
# «.pack» (to "pack")
# «.pack-slaves» (to "pack-slaves")
# «.pack-2023» (to "pack-2023")
# «.grid-2023» (to "grid-2023")
# «.drag» (to "drag")
# «.dragTs» (to "dragTs")
# «.prompts» (to "prompts")
# «.snack» (to "snack")
# «.piano.tcl» (to "piano.tcl")
# «.snack-upstream» (to "snack-upstream")
# «.vkeybd» (to "vkeybd")
# «.httpwiki» (to "httpwiki")
# «.pkgIndex.tcl» (to "pkgIndex.tcl")
# «.tk_chooseColor» (to "tk_chooseColor")
# «.luatclbridge» (to "luatclbridge")
# «.tcl8.4-deb-src» (to "tcl8.4-deb-src")
# «.tk8.4-deb-src» (to "tk8.4-deb-src")
# «.wish-event-loop» (to "wish-event-loop")
# «.tkwait» (to "tkwait")
# «.text-widget» (to "text-widget")
# «.Img-screenshots» (to "Img-screenshots")
# «.zgrep-tk-docs» (to "zgrep-tk-docs")
# «.wm-geometry» (to "wm-geometry")
# «.package-require-Tk» (to "package-require-Tk")
# «.tkdiff» (to "tkdiff")
# «.tkdiff-help» (to "tkdiff-help")
# «.tkdiff-merge» (to "tkdiff-merge")
# «.tkdiff-deb-src» (to "tkdiff-deb-src")
# «.bibtex» (to "bibtex")
# «.tclmagick» (to "tclmagick")
# «.tclmagick-build» (to "tclmagick-build")
# «.tclmagick-build2» (to "tclmagick-build2")
# «.tclmagick-buildlogs» (to "tclmagick-buildlogs")
# «.tclmagick-tests» (to "tclmagick-tests")
# «.tclmagick-using» (to "tclmagick-using")
# «.tclmagick-crop» (to "tclmagick-crop")
# «.anonymous-functions» (to "anonymous-functions")
# «.critcl» (to "critcl")
# «.namespace» (to "namespace")
# «.multiline-comments» (to "multiline-comments")
# «.glue-languages» (to "glue-languages")
# «.TH1» (to "TH1")
# «.jim» (to "jim")
# «.trap-2021» (to "trap-2021")
# «.2021-emacs-tcl-bridge» (to "2021-emacs-tcl-bridge")
# «.canvas» (to "canvas")
# «.dragABC» (to "dragABC")
# «.scrollbar» (to "scrollbar")
# «.scale» (to "scale")
# «.aloupe» (to "aloupe")
# «.apave» (to "apave")
# «.screenshooter» (to "screenshooter")
#####
#
# tcl and emacs
# 2004may15
#
#####
# «emacs» (to ".emacs")
# (find-efile "")
# (find-efile "progmodes/tcl.el")
# (require 'tcl)
# (find-evariable 'tcl-mode-map)
# (find-efunction 'inferior-tcl)
# (inferior-tcl "tclsh")
#####
#
# single-stepping with wish
# 2004sep11
#
#####
# «single-step-wish» (to ".single-step-wish")
# (find-man "3tcl split")
# (find-man "3tcl lindex")
# (find-man "3tk bind")
# (find-man "3tk bind" "event type is KeyPress or KeyRelease")
# (find-man "3tk keysyms")
#*
wish =(<<'%%%'
set i 0; set commands [split {
puts hi
! canvas .c -background sienna4
! pack .c -expand yes -fill both
! .c create line 10 20 30 50
! puts bye
! exit
} !]
bind . <Button-1> {eval [lindex $commands $i]; incr i}
%%%)
#*
#####
#
# bullseye
# 2021sep10
#
#####
# «bullseye» (to ".bullseye")
# (find-zsh "installeddebs | sort | grep tcl")
# (find-zsh "availabledebs | sort | grep tcl")
# (find-zsh "installeddebs | sort | grep tk")
# (find-zsh "availabledebs | sort | grep tk")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
# (find-status "tcl-doc")
# (find-vldifile "tcl-doc.list")
# (find-udfile "tcl-doc/")
# (find-status "tcl8.6-doc")
# (find-vldifile "tcl8.6-doc.list")
# (find-udfile "tcl8.6-doc/")
# (find-status "tk-doc")
# (find-vldifile "tk-doc.list")
# (find-udfile "tk-doc/")
# (find-status "tk8.6-doc")
# (find-vldifile "tk8.6-doc.list")
# (find-udfile "tk8.6-doc/")
# (find-udfile "tk8.6-doc/demos/")
# (find-udfile "tk8.6-doc/demos/README")
# (find-udfile "tk8.6-doc/demos/widget")
# (find-fline "/usr/share/doc/tk8.6-doc/demos/widget")
wish /usr/share/doc/tk8.6-doc/demos/widget
#####
#
# Tcl/Tk/Expect packaged for Debian
# 2004nov07 / 2021nov02
#
#####
# «debian» (to ".debian")
# (find-dpkg-l "")
# (find-status "tcl8.6")
# (find-vldifile "tcl8.6.list")
# (find-udfile "tcl8.6/")
# (find-status "tcl8.6-doc")
# (find-vldifile "tcl8.6-doc.list")
# (find-udfile "tcl8.6-doc/")
# (find-status "tk8.6")
# (find-vldifile "tk8.6.list")
# (find-udfile "tk8.6/")
# (find-status "tk8.6-doc")
# (find-vldifile "tk8.6-doc.list")
# (find-udfile "tk8.6-doc/")
# (find-status "expect")
# (find-vldifile "expect.list")
# (find-udfile "expect/")
# (find-status "expectk")
# (find-vldifile "expectk.list")
# (find-udfile "expectk/")
# (find-man "3tcl after")
# (find-man "3tcl append")
# (find-man "3tcl apply")
# (find-man "3tcl argc")
# (find-man "3tcl array")
# (find-man "3tcl bgerror")
# (find-man "3tcl binary")
# (find-man "3tcl break")
# (find-man "3tcl case")
# (find-man "3tcl catch")
# (find-man "3tcl cd")
# (find-man "3tcl chan")
# (find-man "3tcl clock")
# (find-man "3tcl close")
# (find-man "3tcl concat")
# (find-man "3tcl continue")
# (find-man "3tcl coroutine")
# (find-man "3tcl dde")
# (find-man "3tcl dict")
# (find-man "3tcl encoding")
# (find-man "3tcl eof")
# (find-man "3tcl error")
# (find-man "3tcl eval")
# (find-man "3tcl exec")
# (find-man "3tcl exit")
# (find-man "3tcl expr")
# (find-man "3tcl fblocked")
# (find-man "3tcl fconfigure")
# (find-man "3tcl fcopy")
# (find-man "3tcl file")
# (find-man "3tcl fileevent")
# (find-man "3tcl filename")
# (find-man "3tcl flush")
# (find-man "3tcl for")
# (find-man "3tcl foreach")
# (find-man "3tcl format")
# (find-man "3tcl gets")
# (find-man "3tcl glob")
# (find-man "3tcl global")
# (find-man "3tcl history")
# (find-man "3tcl http")
# (find-man "3tcl if")
# (find-man "3tcl incr")
# (find-man "3tcl info")
# (find-man "3tcl interp")
# (find-man "3tcl join")
# (find-man "3tcl lappend")
# (find-man "3tcl lassign")
# (find-man "3tcl library")
# (find-man "3tcl lindex")
# (find-man "3tcl linsert")
# (find-man "3tcl list")
# (find-man "3tcl llength")
# (find-man "3tcl lmap")
# (find-man "3tcl load")
# (find-man "3tcl lrange")
# (find-man "3tcl lrepeat")
# (find-man "3tcl lreplace")
# (find-man "3tcl lreverse")
# (find-man "3tcl lsearch")
# (find-man "3tcl lset")
# (find-man "3tcl lsort")
# (find-man "3tcl mathfunc")
# (find-man "3tcl mathop")
# (find-man "3tcl memory")
# (find-man "3tcl msgcat")
# (find-man "3tcl my")
# (find-man "3tcl namespace")
# (find-man "3tcl next")
# (find-man "3tcl oo_class")
# (find-man "3tcl oo_copy")
# (find-man "3tcl oo_define")
# (find-man "3tcl oo_object")
# (find-man "3tcl open")
# (find-man "3tcl package")
# (find-man "3tcl packagens")
# (find-man "3tcl pid")
# (find-man "3tcl pkgMkIndex")
# (find-man "3tcl platform")
# (find-man "3tcl platform_shell")
# (find-man "3tcl proc")
# (find-man "3tcl puts")
# (find-man "3tcl pwd")
# (find-man "3tcl re_syntax")
# (find-man "3tcl read")
# (find-man "3tcl refchan")
# (find-man "3tcl regexp")
# (find-man "3tcl registry")
# (find-man "3tcl regsub")
# (find-man "3tcl rename")
# (find-man "3tcl return")
# (find-man "3tcl safe")
# (find-man "3tcl scan")
# (find-man "3tcl seek")
# (find-man "3tcl self")
# (find-man "3tcl set")
# (find-man "3tcl socket")
# (find-man "3tcl source")
# (find-man "3tcl split")
# (find-man "3tcl string")
# (find-man "3tcl subst")
# (find-man "3tcl switch")
# (find-man "3tcl tailcall")
# (find-man "3tcl tcl_prefix")
# (find-man "3tcl tcltest")
# (find-man "3tcl tell")
# (find-man "3tcl throw")
# (find-man "3tcl time")
# (find-man "3tcl timerate")
# (find-man "3tcl tm")
# (find-man "3tcl trace")
# (find-man "3tcl transchan")
# (find-man "3tcl try")
# (find-man "3tcl unknown")
# (find-man "3tcl unload")
# (find-man "3tcl unset")
# (find-man "3tcl update")
# (find-man "3tcl uplevel")
# (find-man "3tcl upvar")
# (find-man "3tcl variable")
# (find-man "3tcl vwait")
# (find-man "3tcl while")
# (find-man "3tcl zlib")
tclreadline
tkdiff
tclex
tclparser
#####
#
# basic principles
# 2001jun14
#
#####
# «basic-principles» (to ".basic-principles")
# (find-man "3tcl Tcl")
# (find-man "3tcl expr")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
# (find-man "3tcl puts")
puts hello
puts -nonewline hello
puts -nonewline stdout hello
puts stdout hello
proc show {args} { foreach str $args {puts -nonewline " <$str>"}; puts "" }
show hello world
show "hello world"
show {hello world}
show hello\040world
show hello\ world
# (find-man "3tcl expr")
expr 1+2
expr 2*3+4*5
expr 2* 3+ 4 *5
show 2* 3+ 4 *5
show 2*3+4*5
expr cos(0)
expr 7/2
expr 7.0/2
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
proc show {args} { foreach str $args {puts -nonewline " <$str>"}; puts "" }
proc yes {} { puts yes }
proc no {} { puts no }
yes
eval yes
eval show hello
eval show "hello world"
eval show hello world
set a 63
show $a
show ".$a."
show a$a[expr 1+$a] "foo $a[expr 1+2]"
#####
#
# The chapter "6. Lists" of Ousterhout's book
# 2021nov02
#
#####
# «6._Lists» (to ".6._Lists")
# (find-books "__comp/__comp.el" "ousterhout")
# (find-tcltkpage (+ 8 51) "6. Lists")
# (find-tcltktext (+ 8 51) "6" "Lists")
# (find-tcltkpage (+ 8 52) "Table 6.1. A summary of the list-related commands")
# (find-tcltktext (+ 8 52) "Table 6.1. A summary of the list-related commands")
#####
#
# upvar
# 2000aug
#
#####
# «upvar» (to ".upvar")
# (find-man "3tcl upvar")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
proc myset {varname value} {
upvar $varname localvar
set localvar $value
}
if {[catch {puts "x = [list $x]"}]} {puts "x is unset"}
set x 2
if {[catch {puts "x = [list $x]"}]} {puts "x is unset"}
myset x "22 "
if {[catch {puts "x = [list $x]"}]} {puts "x is unset"}
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
proc codetoset {varname} {
upvar $varname localvar
if {[catch {set str "set [list $varname] [list $localvar]"}]} {
return "unset [list $varname]"
}
return $str
}
puts [codetoset x]
set x {22 }
puts [codetoset x]
#####
#
# uplevel
# 2000nov14
#
#####
# «uplevel» (to ".uplevel")
# (find-man "3tcl uplevel")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
set a 2
puts $a
proc seta {newa} {uplevel #0 "
set a $newa
"}
seta 3
puts $a
proc broken_seta {newa} {uplevel #0 {
set a $newa
}}
broken_seta 4
puts $a
#####
#
# The code returned by catch
# 2000aug17 / 2012jun13
#
#####
# «catch_code» (to ".catch_code")
# (find-man "3tcl catch")
# (find-man "3tcl catch" "0" "TCL_OK")
# (find-man "3tcl catch" "1" "TCL_ERROR")
# (find-man "3tcl catch" "2" "TCL_RETURN")
# (find-man "3tcl catch" "3" "TCL_BREAK")
# (find-man "3tcl catch" "4" "TCL_CONTINUE")
# (find-man "3tcl return")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
catch {expr 1+2}
catch error
catch return
catch break
catch continue
# Using "return -code xxx" directly inside a catch doesnt work:
catch {return -code ok}
catch {return -code error}
catch {return -code return}
catch {return -code break}
catch {return -code continue}
# Nor do these other forms:
catch {return -code 4}
catch {return -errorcode 4}
catch {return -code continue}
catch {return -errorcode continue}
# By calling a special function we can even return non-standard codes:
proc retcode {code} {return -code $code}
catch {retcode 4}
catch {retcode continue}
catch {retcode 6}
catch {retcode -20}
# Invalid code names are errors:
catch {retcode xuum}
#####
#
# eval
# 2000aug19
#
#####
# «eval» (to ".eval")
# (find-man "3tcl eval")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
set foo 22
eval puts {$foo}
eval {puts $foo}
eval puts [list {$foo}]
#####
#
# source
# 2019jun29
#
#####
# «source» (to ".source")
# (find-man "3tcl source")
# (find-tcltkpage (+ 8 68) "7.6 Executing from files: source")
#####
#
# info complete
# 2000oct17 / 2012jun13
#
#####
# «info_complete» (to ".info_complete")
# (find-man "3tcl info" "info complete")
# (find-es "lua5" "loadstring_and_eof")
# (find-fline "~/.tclshrc")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
proc mygets {} { if {[gets stdin s]==-1} error; return "$s\n" }
proc getcomplete {} {
for { set s [mygets] } { ![info complete $s] } {} { append s [mygets] }
return $s
}
proc gc {} { puts "#------- got:\n[getcomplete]#------- ok." }
proc gc0 {} { getcomplete; return }
proc gce {} { eval [getcomplete]; return }
gc0
hello
gc0
hello {
you
} aaa
gc
naa \
aaa {
you
} ppp
gce
puts \
"hello."
exit
#####
#
# info script (or: how to execute another script in the same dir)
# 2000nov30
#
#####
# «info_script» (to ".info_script")
#*
cat > /tmp/ttis1.tcl <<'---'
#!/usr/bin/tclsh
puts " ttis1: [info script]"
source [file dirname [info script]]/ttis2.tcl
---
chmod 755 /tmp/ttis1.tcl
cat > /tmp/ttis2.tcl <<'---'
puts " ttis2: [info script]"
---
ln -s ttis1.tcl /tmp/ttis3.tcl
rm -Rv /tmp/tt
mkdir /tmp/tt
ln -sf ../ttis1.tcl /tmp/tt/ttis4.tcl
cd
/tmp/ttis1.tcl
tclsh /tmp/ttis1.tcl
cd /tmp/
./ttis1.tcl
tclsh ttis1.tcl
./ttis3.tcl
tt/ttis4.tcl
#*
#####
#
# tcl8.2 source
# 2000jul18
#
#####
# «tcl8.2-source» (to ".tcl8.2-source")
pdsc $SPOTATO/main/source/libs/tcl8.2_8.2.3-1.dsc
cd /usr/src/tcl8.2-8.2.3/
# (eeman "3tcl info" "info complete")
# (find-tcl82file "tests/parse.test")
# (find-tcl82file "generic/tclTest.c")
# (find-fline "/snarf/ftp/ftp.neosoft.com/languages/tcl/all.files.list")
# (find-fline "~/TK/diag.006")
# (find-shttpfile "www.tclfaq.wservice.com/tcl-faq/part1-5.txt.gz" 4877)
# (find-shttpfile "www.tclfaq.wservice.com/tcl-faq/part1-5.txt.gz" "-X- On what sites can I find archives for comp.lang.tcl?")
#######
#
# Draft of Osterhout's book
# 2000feb29
#
#######
# «tclbook_dl_fix» (to ".tclbook_dl_fix")
# Download and fix the .ps of each part of the draft. They come with
# just "%!" in the first line and that makes gv/ghostview very
# unhappy, so we change the "%!"s to "%!PS-Adobe-2.0".
# Is there a standard way to do that?
# (find-fline "/usr/bin/fixfmps")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/")
# (find-shttpfile "www.cica.indiana.edu/cica/faq/tcl/")
psne http://www.cica.indiana.edu/cica/faq/tcl/book.p1.ps
psne http://www.cica.indiana.edu/cica/faq/tcl/book.p2.ps
psne http://www.cica.indiana.edu/cica/faq/tcl/book.p3.ps
psne http://www.cica.indiana.edu/cica/faq/tcl/book.p4.ps
cd $S/http/www.cica.indiana.edu/cica/faq/tcl/
# (find-man "patch" "--force")
for i in 1 2 3 4; do
patch -f book.p$i.ps <<'%%%'
1c1
< %!
---
> %!PS-Adobe-2.0
%%%
done
# rm -v *.rej
# rm -v *.orig
##
## View.
##
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.p1.ps")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.p2.ps")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.p3.ps")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.p4.ps")
# «tclbook» (to ".tclbook")
# (find-angg ".emacs" "tclbook")
gv /snarf/http/www.cica.indiana.edu/cica/faq/tcl/book.p1.ps &
gv /snarf/http/www.cica.indiana.edu/cica/faq/tcl/book.p2.ps &
gv /snarf/http/www.cica.indiana.edu/cica/faq/tcl/book.p3.ps &
gv /snarf/http/www.cica.indiana.edu/cica/faq/tcl/book.p4.ps &
#####
#
# Making a txt version of the draft
# 2000jul24
#
#####
# «_tmp_tclbook.p1.txt» (to "._tmp_tclbook.p1.txt")
# (find-es "ps" "pstotext")
# (find-pl5podfile "perlop.pod" "\\000")
# (find-angg ".zshrc" "pstotext")
cd $S/http/www.cica.indiana.edu/cica/faq/tcl/
mypstotext book.p1.ps > ~/tmp/tclbook.p1.txt
mypstotext book.p2.ps > ~/tmp/tclbook.p2.txt
mypstotext book.p3.ps > ~/tmp/tclbook.p3.txt
mypstotext book.p4.ps > ~/tmp/tclbook.p4.txt
# (find-fline "~/tmp/" "tclbook")
#####
#
# Eedit
#
#####
# (find-fline "~/TK/Edit")
# (find-fline "/hdd5/home/root/TK/Edit")
#####
#
# Tcl7.6 source
# 99jun??
#
#####
pdsc /big/slinks2/dists/slink/main/source/libs/tcl7.6_7.6p2-7.dsc
cd /usr/src/tcl7.6-7.6p2/
etags $(find generic unix -name '*.[ch]')
# (find-tcl7file "")
# (find-tcl7file "generic/tclCmdIL.c")
# (find-tcl7tag "Tcl_ListCmd")
# (find-tcl7file "generic/tclUtil.c")
# (find-tcl7tag "Tcl_Merge")
#####
#
# Some docs and examples
#
#####
(find-fline "/usr/doc/tcl8.0/")
(find-fline "/usr/doc/tcl8.0/README.gz" "Tcl newsgroup")
(find-fline "/usr/lib/tcl8.0/")
(find-enode "Regexps")
(find-elnode "Match Data")
(find-fline "~/EXPECT/")
(find-fline "/usr/doc/dotfile/")
(w3-open-local "/usr/doc/dotfile/html/dotdotfiles.html")
/snarf/http/www.cica.indiana.edu/cica/faq/tcl/
dpkg -L dotfile dotfile-doc
#####
#
# tix 4.1
#
#####
# (find-slink "tix41")
# (find-slink "tix41-dev")
# (find-vldifile "tix41.list")
# (find-vldifile "tix41-dev.list")
# (find-fline "/usr/doc/tix41/")
# (find-fline "/usr/doc/tix41/examples/")
# (find-fline "/usr/doc/tix41/txt/")
apti tix41 tix41-dev
cd /usr/doc/tix41/examples/
./widget
#####
#
# tkref
#
#####
# «tkref» (to ".tkref")
rm -Rv /usr/src/tkref/
mkdir /usr/src/tkref/
cd /usr/src/tkref/
tar -xvzf /snarf/ftp/ftp.neosoft.com/languages/tcl/sorted/info/ref/QuickRef.tar.gz
tar -xvzf /snarf/ftp/ftp.neosoft.com/languages/tcl/sorted/packages-7.6/info/ref/tkref-4.1.0.tar.gz
tar -xvzf /snarf/ftp/ftp.neosoft.com/languages/tcl/sorted/packages-7.6/info/ref/tkrefcard.tar.gz
tar -xvzf /snarf/ftp/ftp.neosoft.com/languages/tcl/sorted/packages-8.0/info/ref/tkref-8.0.2.tar.gz
# needs "multicol.sty", which is in tetex-nonfree...
# (find-es "tex" "tetex-0.9-nonfree")
# (find-fline "/usr/src/tkref/tkref-8.0.2/")
cd /usr/src/tkref/tkref-8.0.2/
make refbase.dvi
xdvi refbase.dvi &
cd /usr/src/tkref/tkref-8.0.2/
make PERL=perl TMPDIR=/tmp
gv refguide.ps &
xdvi /usr/src/tkref/tkref-8.0.2/refbase.dvi &
#######
#
# cgi.tcl-1.10
# 2000jun30 / 2006jun14
#
#######
# «cgi.tcl» (to ".cgi.tcl")
# http://expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz
# The new way, non-system-wide-ish but incomplete:
# (code-c-d "cgitcl" "~/usrc/cgi.tcl-1.10/")
# (find-cgitclfile "")
# (find-cgitclfile "Makefile.in" "pkgIndex.tcl:")
# (find-cgitclfile "pkgcreate")
# (find-man "3tcl pkg_mkIndex")
# (find-cgitclfile "cgi.tcl" "package provide cgi")
# (find-cgitclfile "pkgIndex.tcl")
#*
rm -Rfv ~/usrc/cgi.tcl-1.10/
tar -C ~/usrc/ -xvzf $S/http/expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz
cd ~/usrc/cgi.tcl-1.10/
./configure |& tee oc
make |& tee om
# Or:
echo 'pkg_mkIndex . cgi.tcl' | tclsh
#*
# The old way, system-wide-ish:
#*
rm -Rv /usr/src/cgi.tcl-1.10/
cd /usr/src/
tar -xvzf $S/http/expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz
cd /usr/src/cgi.tcl-1.10/
rm -Rv /usr/lib/tcl8.4/cgi/
mkdir -p /usr/lib/tcl8.4/cgi/
cd /usr/lib/tcl8.4/cgi/
cp -v /usr/src/cgi.tcl-1.10/cgi.tcl .
echo 'pkg_mkIndex . cgi.tcl' | tclsh
rm -Rv /var/www/cgi-tcl/
mkdir /var/www/cgi-tcl/
cd /usr/src/cgi.tcl-1.10/example/
cp -v * /var/www/cgi-tcl/
for i in *.cgi; do
echo Fixing: $i
tclsh ../fixline1 /usr/bin < $i > /var/www/cgi-tcl/$i
chmod 755 /var/www/cgi-tcl/$i
done
# (find-fline "/var/www/cgi-tcl/example.tcl" "production environment")
cat >> /var/www/cgi-tcl/example.tcl <<'---'
cgi_root {}
# http://localhost/cgi-tcl
---
# OLD!!! What was tclquery.cgi?
# (find-fline "~/EXPECT/tclquery.cgi")
#cd /var/www/cgi-tcl/
#ln -s ~/EXPECT/tclquery.cgi .
lynx http://localhost/cgi-tcl/
# edrxnetscape http://localhost/cgi-tcl/ &
#*
# (find-fline "/var/www/cgi-tcl/")
# (find-fline "/var/www/cgi-tcl/example.tcl")
# (find-fline "/usr/lib/tcl8.0/cgi/")
# (find-fline "/usr/lib/tcl8.0/cgi/cgi.tcl")
# (find-fline "/var/log/apache/")
# (find-fline "/var/log/apache/error.log")
# (find-cgitclfile "")
# (find-cgitclfile "fixline1")
# (find-cgitclfile "example/")
# (find-cgitclfile "example/README")
# (find-cgitclfile "doc/ref.txt")
# (find-cgitclfile "doc/ref.txt" "can be given arguments to fake input")
# (find-cgitclfile "doc/ref.txt" "cgi_cgi_set")
# (find-cgitclfile "cgi.tcl" "proc cgi_cgi")
# (find-cgitclfile "cgi.tcl" "proc cgi_cgi_set")
# (find-cgitclfile "doc/ref.txt" "** Getting at the input")
# (find-fline "/usr/lib/tcl8.0/")
# (find-fline "/usr/lib/tcl8.0/parray.tcl")
expect -c '
package require cgi
cgi_input "name=libes&old=foo&new1=bar&new2=hello"
puts [cgi_import_list]
puts ""
foreach name [cgi_import_list] {
puts "$name [cgi_import_as $name value]"
# cgi_import_as $name value
# puts "$name $value"
}
'
# (find-es "http" "tcl_http")
# (find-vldifile "tcl8.0-dev.list")
# (find-fline "/usr/doc/tcl8.0-dev/")
# (eeman "pkgMkIndex")
# (eeman "pkg_mkIndex")
cd /usr/src/cgi.tcl-1.10/example/
for i in *; do printf "%-22s" $i:; head -n 1 < $i; done
# (find-node "(sh-utils)printf invocation")
#####
#
# Using cgi.tcl
#
#####
lynx http://localhost/cgi-tcl/
cat
# (find-fline "/var/www/cgi-tcl/")
# (find-fline "/var/www/cgi-tcl/my.cgi")
lynx http://localhost/cgi-tcl/my.cgi
#!/usr/bin/tclsh
# (find-cgitclfile "doc/ref.txt" "\ncgi_input")
# (find-cgitclfile "doc/ref.txt" "-- Variables")
# (find-cgitclfile "doc/ref.txt" "black & white")
package require cgi
cgi_input
puts "Content-type: text/plain"
puts ""
puts [cgi_import_list]
foreach v [cgi_import_list] {
puts "$v [cgi_import $v]"
}
#####
#
# cgi.tcl-0.7 (old)
#
#####
rm -Rv /usr/src/cgi.tcl-0.7/
cd /usr/src/
tar -xvzf /snarf/http/expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz
cd /usr/src/cgi.tcl-0.7/
./configure
# (find-cgitclfile "Makefile")
make PREFIX=/usr
rm -Rv /var/www/cgi.tcl
mkdir /var/www/cgi.tcl
cd /usr/src/cgi.tcl-0.7/example/
for i in *.cgi; do
sed 's:#!/depot/path/tclsh:#!/usr/bin/tclsh:
s:package require cgi:source cgi.tcl:' \
$i > /var/www/cgi.tcl/$i
done
cp README *.tcl *.pl *.cnt ../cgi.tcl /var/www/cgi.tcl/
chown -Rc edrx:edrx /var/www/cgi.tcl/
chmod 777 /var/www/cgi.tcl/*.{cgi,pl}
# (find-fline "/var/www/cgi.tcl/example.tcl" "pitch.nist")
# (find-fline "/var/www/cgi.tcl/")
lynx http://127.0.0.1/cgi.tcl/
lynx http://127.0.0.1/cgi.tcl/examples.cgi
# «cgi.tcl:pkgIndex.tcl» (to ".cgi.tcl:pkgIndex.tcl")
# (to "pkgIndex.tcl")
# pkgIndex.tcl:
#
# (find-fline "/usr/lib/tcl8.0/")
# (find-fline "/usr/lib/tcl8.0/tclIndex")
# (find-fline "/usr/lib/tcl8.0/init.tcl" "# auto_mkindex --")
# (find-fline "/usr/lib/tcl8.0/init.tcl" "# pkg_mkindex --")
# (find-cgitclfile "pkgcreate")
# (find-cgitclfile "pkgIndex.tcl")
# (find-cgitclfile "Makefile" "updating of pkgIndex.tcl")
# (find-cgitclfile "cgi.tcl")
echo 'pkg_mkIndex /usr/src/cgi.tcl-0.7' | tclsh
# (w3-open-local "/snarf/http/www.beedub.com/book/2nd/library.doc.html")
mycat /var/lib/dpkg/info/tix41* |& l
ln -s /usr/src/cgi.tcl-0.7/example /var/www/cgi.tcl
chown -Rc edrx:edrx /usr/src/cgi.tcl-0.7/example
sed 's:#!/depot/path/tclsh:#!/usr/bin/tclsh:' cookie.cgi
cd /usr/src/cgi.tcl-0.7/
# (find-cgitclfile "")
# (find-fline "~/TCL/h")
# (find-fline "/snarf/http/www.tclfaq.wservice.com/tcl-faq/part1-5.txt.gz")
http://expect.nist.gov/doc/tcl-debug.ps.Z
http://conch.msen.com/~clif/TclTutor.0.96.tar.gz
ftp://130.246.72.228/pub/cookbook/cookbook.tar.gz
ftp://ftp.scriptics.com/pub/tcl/doc/engManual.tar.Z
ftp://ftp.scriptics.com/pub/tcl/doc/styleGuide.tar.Z
ftp://ftp.neosoft.com/languages/tcl/sorted/info/ref/tkrefcard.tar.gz
ftp://ftp.neosoft.com/languages/tcl/sorted/info/ref/QuickRef.tar.gz
# (find-fline "/snarf/ftp/ftp.neosoft.com/languages/tcl/all.files.list")
~/ICON/lslR2find < /snarf/ftp/ftp.neosoft.com/languages/tcl/all.files.list
agrep -i ':^|debug' /snarf/ftp/ftp.neosoft.com/languages/tcl/all.files.list
./alcatel/code/debug.tar.gz
./alcatel/extensions/debugger.gz
./sorted/packages-7.6/devel/l-debug.tar.gz
sne ftp://ftp.neosoft.com/languages/tcl/alcatel/code/tdebug-1.0.tar.gz
#####
#
# TDebug-1.7
#
#####
rm -Rv /usr/src/tdebug-1.7/
mkdir /usr/src/tdebug-1.7/
cd /usr/src/tdebug-1.7/
tar -xvzf /snarf/ftp/ftp.neosoft.com/languages/tcl/stuff/TDebug-1.7.tar.gz
cd /usr/src/tdebug-1.7/
patch TdChoose.tcl <<'%%%'
1c1
< #!/usr/local/bin/wish -f
---
> #!/usr/bin/wish -f
%%%
cd /usr/src/tdebug-1.7/
lynx README.html
# (find-fline "$S/ftp/ftp.neosoft.com/languages/tcl/stuff/TDebug-1.7.tar.gz")
#####
#
# Cookbook
#
#####
# Not working very well, and not very interesting.
rm -Rv /usr/src/cookbook/
cd /usr/src/
tar -xvzf /snarf/ftp/130.246.72.228/pub/cookbook/cookbook.tar.gz
cd /usr/src/cookbook/
# (find-fline "/usr/src/cookbook/ch1/Make_htcl")
# (find-fline "/usr/src/cookbook/ch1/htclInit.c")
# (find-fline "/usr/src/cookbook/ch1/htclInit.c")
# (find-fline "/usr/src/cookbook/ch1/hyper.tcl")
# (find-fline "/usr/src/cookbook/ch1/contents")
cd ch1/
gcc -c -o htclInit.o htclInit.c
gcc -ltcl8.0 -ltk8.0 -o htcl htclInit.c
$(LOCAL_LIBRARIES)
#####
#
# impress
#
#####
cd /usr/src/
rm -Rv 04alpha
tar -xvzf /snarf/http/www.ntlug.org/~ccox/impress/impress_complete.tar.gz
cd /usr/src/04alpha/
# (find-fline "/usr/src/04alpha/impress.tcl")
lynx /snarf/http/www.ntlug.org/~ccox/impress/Docs.html
lynx /snarf/http/www.tcltk.com/tclets/impress/
#####
#
# tk8.0 examples
#
#####
# (code-c-d "tkex" "/usr/doc/tk8.0/examples/")
# (find-tkexfile "widget")
# Nice places to put tuba breakpoints:
# (find-tkexfile "widget" "set demo")
# (find-tkexfile "widget" "proc showCode")
# (find-fline "/usr/lib/tk8.0/demos/widget" "The canvas item types")
(cd /usr/src/tcl8.0-8.0p2/doc; ls -C
echo; cd /usr/src/tk8.0-8.0p2/doc; ls -C) | l
# (find-tkfile "")
# (find-tkfile "generic/tkCmds.c")
# (find-fline "/usr/doc/tk8.0/examples/plot.tcl")
wget -r -nc -np -A htm,html,gif,jpg -l 20 -X man http://www.scriptics.com/
cd /usr/doc/tk8.0/examples/
a2ps -o ~/o.ps -M A4dj -6 -A --highlight-level=none \
widget plot.tcl arrow.tcl ruler.tcl items.tcl
cd
rm o.p[0-9][0-9]
gs -sDEVICE=djet500 -r300 -sOutputFile=o.p%02d -dNOPAUSE -dBATCH o.ps
rm o.zip; zip o.zip o.p0?
laf o.zip
#####
#
# Tuba-2.5.b1
# 99nov11
#
#####
# «tuba» (to ".tuba")
rm -Rv /usr/src/tuba-2.5.b1/
cd /usr/src/
tar -xvzf /snarf/http/www.geocities.com/SiliconValley/Ridge/2549/tuba/tuba-2.5.b1.tar.gz
cd /usr/src/tuba-2.5.b1/
cd /usr/src/tuba-2.5.b1/src/
# make -f Makefile.Linux Tclparser.so |& tee ../om
make -f Makefile.Linux SHLIB_LD='g++ -shared' Tclparser.so |& tee ../om
# (find-fline "/usr/src/tuba-2.5.b1/")
# (find-fline "/usr/src/tuba-2.5.b1/om")
# (find-fline "/usr/src/tuba-2.5.b1/src/Makefile.Linux")
# (find-tubafile "tuba")
# (find-tubafile "tuba_lib.tcl")
# (find-tubafile ".tubarc")
# An example, using my "tubak" alias:
# (find-fline "/usr/doc/tk8.0/examples/widget")
cd /usr/doc/tk8.0/examples/
tubak widget
#####
#
# blt
# 2019jul17
#
#####
# «blt» (to ".blt")
# (find-status "blt")
# (find-vldifile "blt.list")
# (find-udfile "blt/")
# (find-status "blt-demo")
# (find-vldifile "blt-demo.list")
# (find-udfile "blt-demo/")
#####
#
# blt8.0_2.4f
#
#####
apti blt8.0 blt8.0-dev
# (find-vldifile "blt8.0.list")
# (find-vldifile "blt8.0-dev.list")
# (find-fline "/usr/doc/blt8.0/")
# (find-fline "/usr/lib/blt2.4/demos/")
cd /usr/lib/blt2.4/demos/
./barchart
./barchart2
./barchart3
./barchart4
./barchart5
./bgexec
./bgexec2
#./bgexec3
#./bgexec4
./bitmap
./busy
./calendar
#./eps
./form
./graph
./graph2
./graph3
./graph4
./graph5
./graph6
./graph7
./hier
./hier2
./hier3
./hier4
./htext
#./htext.txt
./spline
./stripchart
./tabset
./tabset2
./tabset3
./tabset4
pdsc /big/slinks2/dists/slink/main/source/libs/blt8.0_2.4f-3.dsc
cd /usr/src/blt8.0-2.4f/
debian/rules binary |& tee odrb
# (code-c-d "blt" "/usr/src/blt8.0-2.4f/")
# (find-bltfile "src/bltDnd.c")
# (find-bltfile "src/bltPs.c")
# (find-bltfile "src/bltDebug.c")
# (find-bltfile "src/bltGrHairs.c")
# (find-bltfile "src/bltGraph.c")
# (find-bltfile "demos/")
# (find-bltfile "library/")
#####
#
# Tcl/Tk CD (infomagic, aug 95)
#
#####
# (find-fline "/cdrom/alcatel/code/INDEX" "tdcad")
# (find-fline "/cdrom/alcatel/code/INDEX" "tkcron")
# (find-fline "/cdrom/alcatel/code/INDEX" "make-a-wish")
# (find-fline "/cdrom/alcatel/code/INDEX" "budge")
# (find-fline "/cdrom/alcatel/code/INDEX" "picasso")
# (find-fline "/cdrom/alcatel/code/INDEX" "tkprompt")
# (find-fline "/cdrom/alcatel/code/INDEX" "replayxt")
# (find-fline "/cdrom/alcatel/code/INDEX" "tkHelloWorld")
# (find-fline "/cdrom/alcatel/code/INDEX" "evap")
# (find-fline "/cdrom/alcatel/code/INDEX" "mankala")
# (find-fline "/cdrom/alcatel/code/INDEX" "tkcvs")
# (find-fline "/cdrom/alcatel/code/INDEX" "tcl-cgi")
# (find-fline "/cdrom/alcatel/code/INDEX" "stl-0.3")
# (find-fline "/cdrom/alcatel/code/")
# (find-fline "/cdrom/alcatel/code/stl-0.3/stl/")
# (find-fline "/cdrom/olive.kek.jp/News/")
# (find-fline "/cdrom/olive.kek.jp/News/news92/comp.lang.tcl.92_digest")
tdcad
tkcron
gv /cdrom/alcatel/workshop/1993/tcl93-proceedings/tcl93-proceedings/body/mclennan.ps
# (defun tclndx (s) (find-fline "~/CB/tcltk95-ls-lR.i" s))
# (tclndx "xf")
# (tclndx "TkSteal3.6h/TkSteal/")
# (find-fline "/cdrom/alcatel/extensions/TkSteal3.6h/TkSteal/")
# (find-fline "/cdrom/alcatel/extensions/raster0.1/README")
# (find-fline "/cdrom/alcatel/extensions/INDEX")
# (find-fline "/cdrom/alcatel/extensions/dlwish/dlwish.README")
# (find-fline "/cdrom/alcatel/code/make-a-wish/make-a-wish-1.2.README")
#####
#
# et - Embedded Tcl/Tk
#
#####
# «et» (to ".et")
# (find-slink "et")
apti et
# (find-fline "/usr/doc/et/")
# (find-fline "/usr/doc/et/html/")
# (find-etfile "")
# (find-etfile "color.c")
# (find-etfile "color.tcl")
lynx /usr/doc/et/html/index.html
# (find-vldifile "et.list")
# (find-fline "/usr/doc/et/")
pdsc /big/slinks1/dists/slink/main/source/devel/et_80b2-8.dsc
cd /usr/src/et-80b2/
make CFLAGS="-O" \
LIBS="-ltk8.0 -ltcl8.0 -ldl -L/usr/X11R6/lib -lX11 -lm -lc" \
ET2CFLAGS="-I/usr/lib/tk8.0 -I/usr/lib/tcl8.0" \
color |& tee omc
cd /usr/src/et-80b2/
# (find-etfile "omc")
# (find-etfile "doc/ET.doc" 1234)
# (find-etfile "Makefile")
# (find-etfile "doc/Makefile")
# (find-etfile "debian/")
# (find-etfile "debian/rules")
# (find-etfile "et80.c" 562)
# (find-etfile "et80.c" 754)
# (find-etfile "doc/ET.doc")
# (find-fline "/usr/doc/et/html/ET0015.html")
lynx /usr/doc/et/html/ET0015.html
# (code-c-d "et" "/usr/src/et-80b2/")
# (find-etfile "Makefile")
# (find-etfile "")
# (find-etfile "" "httpd")
#####
#
# tclsh's interactive mode
#
#####
# (find-fline "/usr/lib/tcl8.0/init.tcl" "interactive")
# (find-fline "/usr/lib/tcl8.0/tclAppInit.c" "interactive")
# (find-tclfile "")
# (find-tclfile "unix/Makefile" "\ntclsh:")
# (find-tclfile "odrb" "tclsh")
# (find-tclfile "unix/rl-tclMain.c")
# (find-tclfile "unix/tclAppInit.c")
#####
#
# swig - a more pretentious et
# 99nov21
#
#####
# «swig» (to ".swig")
apti swig swig-doc swig-examples
# (find-vldifile "swig.list")
# (find-vldifile "swig-doc.list")
# (find-vldifile "swig-examples.list")
# (find-fline "/usr/doc/swig/examples/OpenGL/")
# (find-fline "/usr/doc/swig/examples/tcl/tree/")
cd /usr/doc/swig/
gzip -dv Makefile.template
cd /usr/doc/swig/examples/tcl/tree/
make SWIG=swig |& tee om
cd /usr/doc/swig/examples/tcl/graph/
gzip -dv *.gz
make SWIG=swig |& tee om
#
cd /usr/doc/swig/examples/tcl/graph/
wish graph.tcl
# (find-swigefile "tcl/graph/graph.tcl" "Button 2 adds")
cd /usr/doc/swig/html/
lynx /usr/doc/swig/html/Introduction.html
edrxnetscape /usr/doc/swig/html/Introduction.html &
rm -Rv /tmp/html/
mkdir /tmp/html/
cd /tmp/html/
wget -nv -r -A html http://127.0.0.1/doc/swig/html/Index.html |& tee o
perl -nle 'm:^.*html/([^" ]+) : && print $1' < o | sort
# (find-node "(sed)Addresses")
# (find-fline "/usr/doc/swig/html/")
# (find-fline "/usr/doc/swig/")
# (find-fline "/usr/doc/swig/examples/")
# (find-fline "/usr/doc/swig/examples/README.gz")
edrxnetscape /usr/doc/swig/html/Contents.html
# LIBS = -L$(MESA)/lib -lMesaaux -lMesatk -lMesaGLU -lMesaGL -lXext
# XLIBS = -L/usr/X11R6/lib -lX11
# INCLUDE = -I$(MESA)/include -I/usr/X11R6/include
# (find-fline "/usr/doc/swig/examples/OpenGL/")
# (find-fline "/usr/doc/swig/examples/OpenGL/Makefile")
# (find-fline "/usr/doc/swig/Makefile.template")
cd /usr/doc/swig/examples/OpenGL/
gzip -dv $(find *) ../../Makefile.template.gz
cd /usr/doc/swig/examples/OpenGL/
make LIBS='-lMesaaux -lMesatk -lMesaGLU -lMesaGL -lXext' \
INCLUDE='-I/usr/include/GL -I/usr/X11R6/include' \
SWIG=swig \
tcl
# Falta o glaux.h.
#####
#
# moodss
#
#####
# (find-fline "/usr/doc/moodss/")
# (find-vldifile "moodss.list")
# (find-fline "/usr/doc/moodss/INSTALL")
wish moodss ps cpustats memstats
#####
#
# list versus concat
# 2012jun13
#
#####
# «list-vs-concat» (to ".list-vs-concat")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
list a "b c" "d e" f
concat a "b c" "d e" f
concat "{"
list "{"
list "{a b"
#####
#
# Alguns programinhas educativos
#
#####
#*
cat > $EEG <<'---'
puts .[exec echo foo].
puts .[exec false 2> /dev/null].
puts .[system {echo foo; echo bar}].
puts .[catch [exec true]].
proc L {a} {puts -nonewline "$a; "; return [list $a]}
puts [L [L [L a]]]
puts [L [L [L ""]]]
puts [L [L [L \\]]]
puts [L [L [L \{]]]
puts [L [L [L \}]]]
puts [L [L [L {a b}]]]
puts [L [L [L {a\{ b}]]]
puts [L [L [L \n]]]
puts "{"
proc id {arg} {return $arg}
proc E {script} {
global errorInfo
if [set err [catch "id $script" output]] {
regexp "^\[^\n\]*" $errorInfo firstline
puts $firstline
} else {
puts $output
}
}
E $()
E $
E {$foo}
---
eeg tclsh
#*
expect -c 'foreach s [info globals] {puts $s}' | sort
expect -c 'foreach s [info commands] {puts $s}' | sort
echo 'foreach s [info globals] {puts $s}' | tclsh -f - | sort
echo 'foreach s [info commands] {puts $s}' | tclsh -f - | sort
echo 'foreach s [info commands ::*] {puts $s}' | tclsh -f - | sort
# (find-fline "/usr/lib/tcl8.0/init.tcl")
(global-set-key [f7] 'tcl-send-region)
# (find-enode "Keyboard Macros")
# (find-elnode "Keyboard Macros")
last-kbd-macro
(setq last-kbd-macro "\C-a\C-[xtosp\C-m\C-[[D\C-[w\C-a<li>{\C-e}\C-a\C-[[B-- \C-y \C-a\C-[[B")
(insert-kbd-macro 'mf)
C-c ESC r -- tcl-send-region
#####
#
# Parsers for Tcl (recycling)
#
#####
# «parsers_for_tcl» (to ".parsers_for_tcl")
# (find-tcl7file "")
# (find-tcl7file "generic/tclParse.c")
# (find-tcl7file "generic/tclInt.h" "ParseValue")
# (find-tcl7file "tests/parse.test")
agrep Tcl /usr/src/tcl7.6-7.6p2/generic/tclParse.c
(fooi
"TCL_BACKSLASH, " "/"
"TCL_CLOSE_BRACE, " "}"
"TCL_COMMAND_END, " "0"
"TCL_DOLLAR, " "$"
"TCL_NORMAL, " "a"
"TCL_OPEN_BRACE, " "{"
"TCL_OPEN_BRACKET," "["
"TCL_QUOTE, " "\""
"TCL_SPACE, " " "
)
0aaaaaaaa 0 aa
aaaaaaaaaaaaaaaa
a"a$aaaaaaaaaaa
aaaaaaaaaaa0aaaa
aaaaaaaaaaaaaaaa
aaaaaaaaaaa[/0aa
aaaaaaaaaaaaaaaa
aaaaaaaaaaa{a}aa
# (find-elfile "tcl-mode.el")
# (find-fline "/usr/src/tuba-2.5.b1/")
# (find-fline "/usr/src/tuba-2.5.b1/src/")
# (find-fline "/usr/src/tuba-2.5.b1/src/README" "VERY QUICK")
# (find-fline "/usr/src/tuba-2.5.b1/src/Tclparser.tcl")
# Three parsers, each to be run with M-x eet:
source /usr/src/tuba-2.5.b1/src/Tclparser.tcl
proc tset {vname val} {puts "$vname:=$val"; upvar $vname v; set v $val}
tset code {if [$a=="!"] {puts bang} else {puts $a}; [put${s} foo] bar}
tset tp [new_Tclparser $code 1]
while 1 {
tset tok [$tp gettok]
if {$tok==[geteof]} break
}
delete_Tclparser $tp
source /usr/src/tuba-2.5.b1/src/Tclparser.tcl
proc tset {vname val} {puts "$vname:=$val"; upvar $vname v; set v $val}
proc parse_recursively {code {pre {}}} {
set tp [new_Tclparser $code 1]
while 1 {
puts -nonewline $pre
tset tok [$tp gettok]
if {$tok==[geteof]} break
if [regexp "^\[\[\{\"\]" $tok] {
parse_recursively $tok " $pre"
}
}
delete_Tclparser $tp
}
tset code {if {$a=="!"} {puts bang} else {puts $a}; [put${s} foo] bar}
parse_recursively $code
source /usr/src/tuba-2.5.b1/src/Tclparser.tcl
proc tset {vname val} {puts "$vname := $val"; upvar $vname v; set v $val}
proc parse_recursively {code {pre {}}} {
set tp [new_Tclparser $code 1]
while 1 {
switch [set tok [$tp gettok]] \
[geteof] break \
[geteos] {puts "$pre<<EOS>>"} \
default {
puts "$pre$tok"
if [regexp "^\[\[\{\"\]" $tok] {
parse_recursively $tok " $pre"
}
}
}
delete_Tclparser $tp
}
tset code {if {$a=="!"} {puts bang} else {puts $a}; [put${s} foo] bar}
parse_recursively $code
# (find-node "(flex)Top")
#####
#
# splitter
#
#####
proc splitter0 {str p1p2} {
foreach {p1 p2} $p1p2 {}
return [list [string range $str 0 [expr $p1-1]] \
[string range $str $p1 $p2] \
[string range $str [expr $p2+1] end]]
}
regexp -indices "2.*4" 0123456789 r
foreach {beg line rest} [splitter0 0123456789 $r] {}
puts [splitter0 0123456789 $r]
# -> 01 234 56789
proc splitter {pat str} {
set rest $str
while {[regexp -indices $pat $rest {} range]} {
foreach {prematch match rest} [splitter0 $rest $range] {}
lappend pieces $prematch $match
}
lappend pieces $rest
return $pieces
}
puts [splitter "(<\[^>\]*>)" "012<34>5<67>88"]
# -> 012 <34> 5 <67> 88
set str [exec cat /home/root/ZHTML/escripts/kernel.e]
set pat1 "\n((#+|;+|\\\\|\\\\;) «\[!-~\]+»\n)"
set spl [splitter $pat1 $str]
foreach {nonmatch match} $spl {
puts -nonewline "([string length $nonmatch]), $match"
}
# Constant/linear/linear*log time?
# (find-fline "/usr/src/tcl7.4/tclVar.c" "Tcl_AppendCmd(")
# (find-fline "/usr/src/tcl7.4/tclVar.c" "Tcl_LappendCmd(")
#####
#
# encode_entities
#
#####
# «encode_entities» (to ".encode_entities")
isoto850 < /usr/lib/perl5/HTML/Entities.pm
isoto850 < /usr/lib/perl5/HTML/Entities.pm | grep "[Ç- ]" | tee ~/o
# (find-fline "~/o")
# (find-pl55ifile "HTML/Entities.pm")
# (find-drfcfile "rfc1866.txt.gz")
# (find-drfcfile "rfc1866.txt.gz" "9.7.2. ISO Latin 1 Character Entity Set")
for {set x 128} {$x<256} {incr x} {
set Entname([format "%c" $x]) [format "%c" $x]
}
# puts $Entname() ->
foreach {char entname} {
Æ AElig Á Aacute  Acirc À Agrave Å Aring à Atilde Ä Auml
Ç Ccedil É Eacute Ê Ecirc È Egrave Ë Euml Í Iacute Ï Iuml
Ó Oacute Ô Ocirc Ò Ograve Õ Otilde Ö Ouml Ú Uacute Û Ucirc
Ù Ugrave Ü Uuml á aacute â acirc æ aelig à agrave å aring
ã atilde ä auml ç ccedil é eacute ê ecirc è egrave ë euml
í iacute î icirc ì igrave ï iuml ó oacute ô ocirc ò ograve
õ otilde ö ouml ß szlig ú uacute û ucirc ù ugrave ü uuml
ª ordf « laquo ° deg º ordm » raquo
& amp > gt < lt " quot } {
set Entname($char) "&$entname;"
}
#####
#
# expand (Bill Duquette's html generator)
#
#####
cd $S/http/www.cogent.net/~duquette/expand/
psne http://www.cogent.net/~duquette/expand/expand1.2.tar.gz
rm -Rv /usr/src/expand1.2/
mkdir /usr/src/expand1.2/
cd /usr/src/expand1.2/
unzip -a $S/http/www.cogent.net/~duquette/expand/expand12.zip
# (find-fline "/usr/src/expand1.2/")
# (find-fline "~/TCL/html.004")
#####
#
# Some notes on an old version of my html generator
#
#####
# (find-enode "Fill Commands")
# (find-enode "Fill Commands" "adaptive-fill-mode")
# (find-enode "Text Mode" "indented-text-mode")
# (find-fline "~/.zshrc" "date")
date --utc '+%Y%b%d %k:%M' | tr A-Z a-z
date -u '+%Y%b%d %k:%M' | tr A-Z a-z
date -r ~/TCL/html.004 -u '+%Y%b%d %k:%M' | tr A-Z a-z
puts [exec date -u "+%Y%b%d %k:%M" | tr A-Z a-z]
# My timezone is wrong. Shit.
# (find-vldifile "libc6.list")
# (find-vldifile "timezones.list")
# (find-fline "/usr/sbin/tzconfig")
# (find-fline "/usr/bin/tzselect")
#####
#
# finer control on evaluation
#
#####
proc id {arg} {return $arg}
proc E {script} {
global errorInfo
if [set err [catch "id $script" output]] {
regexp "^\[^\n\]*" $errorInfo firstline
puts $firstline
} else {
puts $output
}
}
set a1 {[set $a2]}
set a2 a3
set a3 {[set $a4]}
set s4 a5
proc jaa {args} { return [uplevel #0 eval list [list $args]] }
puts {jaa $a1 $a1}
puts [jaa {$a1 $a1}]
puts [jaa "$a1 $a1"]
puts [jaa {$a1} {$a1}]
puts [jaa $a1 $a1]
set a1 {$a2}
set a2 foo
proc id {x} { return $x }
proc e {s} { uplevel #0 id [list $s] }
puts [e {$a1}]
proc map {F list1} {
set list2 {}
foreach item $list1 {
lappend list2 [eval $F [list $item]]
}
return $list2
}
proc le {ss} { map e $ss }
puts [le {$a1 $a1}]
proc es {args} { le $args }
puts [es {$a1} {$a1}]
puts [es {$a1 $a1}]
puts aa
puts [list aa]
puts [list [list aa]]
puts ""
puts {$aa}
puts [list {$aa}]
puts [list [list {$aa}]]
puts ""
puts [lindex {$aa $aa} 0]
puts [lindex {{$aa} {$aa}} 0]
puts [lindex {{{$aa}} {{$aa}}} 0]
puts ""
puts [list {$a1} {$a1}]
puts [list {{$a1}} {{$a1}}]
puts ""
puts [list aa {aa} {$aa}]
puts [list \\ \{ \$a \$\{\\a ]
puts \$\{\\a
Acho que o "list" sempre põe chaves -- exceto pelos elementos que não
têm nenhum caracter especial.
# (find-tcl7file "")
# (find-tcl7file "tclBasic.c" "\"append\"")
Tcl_ListCmd
Como é que eu faço um "eval" em que cada argumento passe protegido?
Quero isso aqui, ó:
proc map {F list1} {
set list2 {}
foreach item $list1 { lappend list2 [eval $F [list $item]] }
return $list2
}
proc foo {args} {
eval map puts [list $args]
eval map puts [list [map list $args]]
}
foo \{a \\a \$a
Um grande mistério: o que é
eval puts \{a b\}
?
Ah, o concat faz algo bem bobo com os strings que ele concatena... ou
não?
Qual é a diferença entre concat e join? Como o concat age sobre
não-listas?
O concat só sanduícha espaços, i.e., ele é quase a mesma coisa que
"join $list", só que o concat recebe seus argumentos separados.
A transformação que leva um string em "list $string" é horrivelmente
complicada e eu deveria pôr um nível de abstração em torno dela pra
usá-la mais claramente; aí o tcl passaria a ter tipos (mesmo que só na
cabeça do programador). Se eu esqueço os tipos com profundidades
mistas os tipos básicos passam a ser string, lista de strings, lista
de lista de strings... e uma lista de lista de strings, se tiver sido
criada do jeito certo, não sintetizada às pressas com "$a $b"s (mas
acho que "[list $a] [list $b]" dá o mesmo que [list $a $b], pela
definição do concat) deve ser invariante por map {map list} $list,
acho.
#####
#
# plugin
#
#####
/snarf/ftp/ftp.scriptics.com/pub/tcl/plugin/tclplug20-x86-linux2.tar.gz
/snarf/http/sunscript.sun.com/dist/plugin
/snarf/http/sunscript.sun.com/dist/plugin/index.html
/snarf/http/sunscript.sun.com/dist/plugin/old
/snarf/http/sunscript.sun.com/dist/plugin/old/index.html
/snarf/http/sunscript.sun.com/dist/plugin/tclplug20-src.tar.gz
tar -tvzf /snarf/ftp/ftp.scriptics.com/pub/tcl/plugin/tclplug20-x86-linux2.tar.gz
# (find-fline "/snarf/ftp/ftp.scriptics.com/pub/tcl/plugin/tclplug20-x86-linux2.tar.gz")
rm -Rv /usr/src/tclplug20-x86-linux2/
cd /usr/src/
tar -xvzf $S/ftp/ftp.scriptics.com/pub/tcl/plugin/tclplug20-x86-linux2.tar.gz
cd /usr/src/tclplug20-x86-linux2/
su -s install.sh edrx
# (find-fline "~/.netscape/")
# (find-fline "~edrx/.netscape/")
# (find-fline "~edrx/.netscape/plugin-list")
/home/edrx/.netscape/plugins/libtclp2.0.so 885356030 application/x-tcl: .tcl:Tcl Web Applets;
pluginName=Tcl Plugin 2.0
pluginDescription=Tcl Plugin 2.0 (2.0.200). Executes tclets found in Web pages. See the <a href=http://sunscript.sun.com/plugin/>Tcl Plugin</a> home page for more details.
rm -Rv /usr/src/tclplugin2.0/
cd /usr/src/
tar -xvzf $S/http/sunscript.sun.com/dist/plugin/tclplug20-src.tar.gz
cd /usr/src/tclplugin2.0/
# (find-fline "/usr/src/tclplugin2.0/")
# (find-fline "/usr/src/tclplugin2.0/README" "--with")
cd /usr/src/tclplugin2.0/tcl8.0/unix/
./configure --enable-shared |& tee oc
make |& tee om
# (find-fline "/usr/src/tclplugin2.0/tcl8.0/unix/om" "duplicate case value")
# (find-fline "/usr/src/tclplugin2.0/tcl8.0/generic/tclPosixStr.c" 328)
cd /usr/src/tclplugin2.0/tk8.0/unix/
./configure |& tee oc
make |& tee om
cd /usr/src/tclplugin2.0/plugin2.0/unix/
configure \
--with-tcl=/usr/src/tclplugin2.0/tcl8.0/unix \
--with-tk=/usr/src/tclplugin2.0/tk8.0/unix \
--with-mozilla=/home/root/.netscape |& tee oc
#####
#
# itcl
#
#####
apti itcl3.0 itcl3.0-dev
# (find-vldifile "itcl3.0.list")
# (find-vldifile "itcl3.0-dev.list")
# (find-fline "/usr/doc/itcl3.0/")
# (find-fline "/usr/doc/itcl3.0/iwidgets3.0.0/examples/catalog")
# (find-fline "/usr/lib/iwidgets3.0.0/scripts/")
apti itcl3.0 itcl3.0-dev
cd /usr/doc/itcl3.0/iwidgets3.0.0/examples/
/usr/doc/itcl3.0/iwidgets3.0.0/examples/catalog
pdsc /big/slinks2/dists/slink/main/source/libs/itcl3.0_3.0-1.dsc
cd /usr/src/itcl3.0-3.0/
psner -A htm,html,gif,jpg -X TclTkMan -l 200 http://www.tcltk.com/ |& tee ~/o
cd $S/http/www.tcltk.com/
setopt extendedglob
# rm -Rv *~TclTkMan
unsetopt extendedglob
cd $S/http/
wget -A htm,html,gif,jpg -X TclTkMan -l 200 -r -k -nc http://www.tcltk.com/
rm -Rv /usr/src/itcl-intro/
cd /usr/src/
tar -xvzf $S/http/www.tcltk.com/itcl/doc/itcl-intro.tar.gz
cd /usr/src/itcl-intro/
# On autoloading and auto_mkindex:
gv -page 63 -scale 2 itclitk-a4.ps
#####
#
# xf4.3
#
#####
rm /usr/src/xf/
cd /usr/src/
tar -xvzf $S/http/home.nycap.rr.com/drlabelle/download/xf43.tar.gz
cd /usr/src/xf/
# (find-fline "/usr/src/xf/")
# (find-fline "/usr/src/xf/Install.txt")
edrxnetscape Help/index.html
#####
#
# tclhttpd
# 99oct20
#
#####
# «tclhttpd» (to ".tclhttpd")
rm /usr/src/tclhttpd2.2.1/
cd /usr/src/
tar -xvzf $S/http/www.scriptics.com/ftp/httpd/tclhttpd2.2.1.tar.gz
cd /usr/src/tclhttpd2.2.1/
# (find-fline "/usr/src/tclhttpd2.2.1/")
# (find-fline "/usr/src/tclhttpd2.2.1/README")
cd /usr/src/tclhttpd2.2.1/
tclsh bin/httpd.tcl -debug true
lynx http://127.0.0.1:8015/
#####
#
# modemtcl
# 99may??
#
#####
# I gave up running this in favor of Expect+minicom.
cd /usr/src/
rm -Rv modemtcl-0.1/
mkdir modemtcl-0.1/
cd /usr/src/modemtcl-0.1/
tar -xvzf $S/http/www.fe.msk.ru/~vitus/works/modemtcl-0.1.tar.gz
cd /usr/src/modemtcl-0.1/
make modemtcl
man2t < modemtcl.1 | l
# (find-fline "/usr/src/modemtcl-0.1/")
# (find-fline "/usr/src/modemtcl-0.1/dumbterm.tcl" "/dev/ttyS")
cd /usr/src/modemtcl-0.1/
rm /var/lock/LCK..ttyS2
modemtcl dumbterm.tcl
# (find-fline "/usr/src/modemtcl-0.1/")
man 3tcl fileevent
######
#
# plplot on Slink (with Tcl)
#
######
# «plplot» (to ".plplot")
apti plplot plplot-doc plplot-dev plplot-tcl
# (find-vldifile "plplot-tcl.list")
# (find-fline "/usr/doc/plplot-tcl/")
# (find-node "(plplot)Top")
# (find-vldifile "octave-plplot.list")
# (find-vldifile "plplot.list")
# (find-vldifile "plplot-dev.list")
# (find-vldifile "plplot-doc.list")
# (find-vldifile "plplot-tcl.list")
# (find-fline "/usr/lib/tcl8.0/plplot/")
# (find-fline "/usr/doc/plplot/examples/tcl/")
# (find-fline "/usr/doc/plplot/examples/tk/")
# (find-fline "/usr/doc/plplot/examples/tcl/tcldemos.tcl")
# (find-fline "/usr/doc/plplot/examples/tcl/")
# (find-node "(plplot)API")
# Working:
cd /usr/doc/plplot/examples/tcl/
pltcl -e 'plsdev xwin; plinit; source tcldemos.tcl
proc run {args} { foreach n $args {
puts "$n:"; $n; puts "$n ok"
}}
run 1 2 3 4 5 6 8 9 10 12 13 14 15 16 17 18
exit'
# (find-plpfile "bindings/tk/tkMain.c" "pltkMain(int")
# (find-plpfile "bindings/tk/tkMain.c" "argTable")
# (find-node "(plplot)Initializing")
# Not working (but almost :-))
#
rm -Rv /usr/src/plplote/
mkdir /usr/src/plplote/
cd /usr/src/plplote/
cp -iv /usr/doc/plplot/examples/c/* .
gzip -dv *
cd /usr/src/plplote/
gcc tutor.c
cd /usr/src/plplote/
gcc -E tutor.c > tutor.E
gcc -ltk8.0 -ltcl8.0 -L/usr/X11R6/lib -lX11 -ldl -lm \
-lplplotdtk -lMatrix tutor.c |& tee o
# (find-fline "/usr/src/plplote/")
# (find-fline "/usr/src/plplote/tutor.c")
# (find-fline "/usr/src/plplote/plcdemos.h")
# (find-fline "/usr/src/plplote/Makefile")
# (find-plpfile "")
# (find-plpfile "bindings/tcl/")
# (find-plpfile "bindings/tk/")
# (find-plpfile "bindings/tk/tkMain.c")
pltcl -e 'puts foo'
/usr/lib/libPLcxx.so
/usr/lib/libplplotdtk.a
/usr/lib/libplplotdX.a
/usr/lib/libPLcxx.a
/usr/lib/libMatrix.a
/usr/lib/libplplotdX.so
/usr/lib/libplplotdtk.so
/usr/lib/libMatrix.so
# (find-fline "/usr/doc/plplot-dev/")
# (find-fline "/usr/doc/plplot-doc/")
# (find-fline "/usr/doc/plplot-tcl/")
# (find-fline "/usr/doc/plplot/")
# (find-vldifile "plplot-dev.list")
# (find-vldifile "plplot-doc.list")
# (find-vldifile "plplot-tcl.list")
# (find-vldifile "plplot.list")
# (find-vldifile "plotmtv.list")
# (find-vldifile "quickplot.list")
# (find-vldifile "sciplot.list")
#####
#
# sciplot
#
#####
# «sciplot» (to ".sciplot")
Pgrep m/sciplot/
apti sciplot lesstifg lesstifg-dev
# (find-vldifile "sciplot.list")
# (find-fline "/usr/doc/sciplot/")
cd /usr/doc/sciplot/
edrxnetscape SciPlot.html
# (find-fline "/usr/doc/sciplot/examples/")
apti lesstifg-dev
cd /tmp
gcc -o ./xyplot -I/usr/X11R6/include /usr/doc/sciplot/examples/xyplot.c -lsciplot
xyplot /usr/doc/sciplot/examples/data.txt
cd /tmp
gcc -o ./realtime /usr/doc/sciplot/examples/realtime.c -lsciplot
realtime
# (find-fline "/usr/doc/octave-plplot/")
# (find-vldifile "octave-plplot.list")
#####
#
# quickplot
#
#####
# «quickplot» (to ".quickplot")
Pgrep m/quickplot/
apti quickplot
# (find-vldifile "quickplot.list")
# (find-fline "/usr/doc/quickplot/")
test_data | quickplot -Pv &
man quickplot
#####
#
# plotmtv
#
#####
# «plotmtv» (to ".plotmtv")
apti plotmtv
# (find-vldifile "plotmtv.list")
# (find-fline "/usr/doc/plotmtv/")
# (find-fline "/usr/doc/plotmtv/examples/")
cd /usr/doc/plotmtv/examples/
./run.csh
pdsc /big/slinks2/dists/slink/main/source/math/plplot_4.99j-8.dsc
debian/rules binary |& tee odrb
#####
#
# Debugging ".so"s
#
#####
# «debugging-.sos» (to ".debugging-.sos")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.examples" "31")
# (find-fline "~/TCL/simple2.c")
# (find-fline "~/TCL/simple2.tcl")
# (find-tclfile "odrb" " -shared")
cd ~/TCL/
gcc -shared -o simple2.so simple2.c
#####
#
# visual-tcl
#
#####
# «visual-tcl» (to ".visual-tcl")
apti visual-tcl
# (find-vldifile "visual-tcl.list")
# (find-fline "/usr/doc/visual-tcl/")
# (find-fline "/usr/doc/examples/visual-tcl/")
# (find-fline "/usr/bin/vtcl")
# (find-fline "/usr/lib/visual-tcl/vt.tcl")
# (find-fline "/usr/lib/visual-tcl/vt.tcl" "proc vTcl:main")
cd /usr/doc/examples/visual-tcl/
vtcl
cd /usr/doc/examples/visual-tcl/
tubak /usr/lib/visual-tcl/vt.tcl
#####
#
# very small httpd, from comp.lang.tcl/dejanews
#
#####
>> Forum: comp.lang.tcl
>> Thread: simple httpd written in tk/tcl
>> Message 1 of 1
Subject: Re: simple httpd written in tk/tcl
Date: 1999/04/07
Author: Samy Zafrany <samy@mail.netanya.ac.il>
Posting History
David S Cargo wrote:
> I am trying to find the simple httpd written in tk/tcl that has been
> mentioned in the FAQ. The location given in the FAQ,
> http://arsenio.mit.edu:8001 no longer responds to http requests. The
> contact, jrq@mtl.mit.edu (John R. Gilbert) is no longer a valid user on
> that system.
>
> I just want a supersimple httpd to run on a single system to serve up
> static pages on a very small intranet. I have downloaded tclhttpd 2.1.7
> from Scriptics, but is more complex than I personally need.
>
> I have used Alta Vista to search the web and Deju News to search news
> archives, but I didn't find an alternate source.
>
> --David S. Cargo
The simplest httpd that I ever seen is due to Harald Kaplan. I do not
recall were I got it,
but since it's so short, here it is (it may look too short to be useful,
but it is!), with the author's words in comment:
# <html><head><title>DustMote source.</title></head>
# <body bgcolor=white><plaintext>
# This web server program has a smaller source than any other that I have
# seen or heard of. Its name is DustMote, and I hereby place it in the
# public domain.
# I wrote it in the Tcl language because Tcl is free, easy, stable, and
# well documented. For more documentation than comes with the Tcl
# download, one may purchase Brent B. Welch's excellent book, "Practical
# Programming in Tcl and Tk," second edition, Prentice Hall PTR. It is
# well worth the money. It is true that Tcl is not remarkably speedy, but
# it is fast enough for my site, and, though not multi-threaded, it can
# handle many clients at the same time asynchronously, by the use of
# non-blocking channels.
# Of course, there are now many freeware server programs to be downloaded
# from the web, and most of them are sturdy professional jobs that go like
# lightning and swarm with useful features. The businessperson ought to
# use one of those. I am an amateur, so I had to write the program myself.
# There are nearly no features. All DustMote can do is serve files, both
# text and image. I offer it to fellow amateurs, so they can ignore other
# people's features and think up new features that have never been thought
# up before.
# If you do use my program, remember to change the definition of "root" to
# suit your computer. Be sure to use forward slashes, not backward, or
# else double them so Tcl will understand them rightly.
# Please E-mail complaints to hmk@nadn.navy.mil and do not try to spare my
# feelings. The date of this revision is May 26, 1998.
# Yours truly,
# Harold Kaplan.
set root "/var/www"
set default "index.html"
set port 80
proc bgerror {trouble} {puts stdout "bgerror: $trouble"}
proc answer {socketChannel host2 port2} {
fileevent $socketChannel readable [list readIt $socketChannel]
}
proc readIt {socketChannel} {
global root default
fconfigure $socketChannel -blocking 0
set gotLine [gets $socketChannel]
if { [fblocked $socketChannel] } then {return}
fileevent $socketChannel readable ""
set shortName "/"
regexp {/[^ ]*} $gotLine shortName
set many [string length $shortName]
set last [string index $shortName [expr $many-1] ]
if {$last=="/"} then {set shortName $shortName$default }
set wholeName $root$shortName
if [catch {set fileChannel [open $wholeName RDONLY] } ] {
puts $socketChannel "HTTP/1.0 404 Not found"
puts $socketChannel ""
puts $socketChannel "<html><head><title><No such URL.></title></head>"
puts $socketChannel "<body><center>"
puts $socketChannel "The URL you requested does not exist on this site."
puts $socketChannel "</center></body></html>"
} else {
fconfigure $fileChannel -translation binary
fconfigure $socketChannel -translation binary -buffering full
puts $socketChannel "HTTP/1.0 200 OK"
puts $socketChannel ""
set work [read $fileChannel]
puts $socketChannel $work
close $fileChannel
}
close $socketChannel
}
socket -server answer $port
vwait forEver
#####
#
# dustmote 1.04
# 2000apr16
#
#####
# «dustmote» (to ".dustmote")
# (find-es "http" "dustmote")
# ftp://ftp.unicamp.br/pub/simtelnet/win95/webbrows/dumo104.zip
# (find-fline "$S/ftp/ftp.unicamp.br/pub/simtelnet/win95/webbrows/dumo104.zip")
rm -Rv /usr/src/dustmote/
mkdir /usr/src/dustmote/
cd /usr/src/dustmote/
unzip -La $S/ftp/ftp.unicamp.br/pub/simtelnet/win95/webbrows/dumo104.zip
patch dustmote.tcl <<'%%%'
1,3c1,3
< set root d:/mytcls/webpages
< set default index.htm
< set port 80
---
> set root /home/root/TH/L
> set default index.html
> set port 8080
141c141
< # vwait forEver
---
> vwait forEver
%%%
# (code-c-d "dm" "/usr/src/dustmote/")
# (find-dmfile "")
# (find-dmfile "readme.txt" "tclsh")
# (find-dmfile "dustmote.tcl")
# (find-dmfile "dustmote.tcl" "proc answer")
# (eeman "3tcl socket")
tclsh /usr/src/dustmote/dustmote.tcl
lynx http://127.0.0.1:8080/
#####
#
# first experience with socket servers
# 2000apr16 / 2021dec08
#
#####
# «socket_servers_0» (to ".socket_servers_0")
# (find-man "1 expect")
# (find-man "3tcl vwait")
expect -c '
proc ans {sock callerip clientport} {
puts "$sock $callerip $clientport"
puts [gets $sock]
close $sock
}
socket -server ans 5000
vwait forever
'
expect -c '
proc ans {sock callerip clientport} {
puts "$sock $callerip $clientport"
puts [eval [read $sock]]
close $sock
}
socket -server ans 5000
vwait forever
' &
telnet 127.0.0.1 5000
# Use "^] close" to end the telnet session.
expect -c '
set sock [socket 127.0.0.1 5000]
puts $sock "puts foo"
close $sock
'
#####
#
# tcltutor - new version
#
#####
# «tcltutor» (to ".tcltutor")
rm -Rv /usr/src/TclTutor/
cd /usr/src/
tar -xvzf $S/http/www.msen.com/~clif/tutor097.tar.gz
cd /usr/src/TclTutor/
# (find-tcltfile "")
# (find-tcltfile "conf.tk")
patch conf.tk <<'%%%'
1094,1095c1094,1097
< set install_dir "/usr/local/lib/tcltutor/lessons"
< set bin_dir "/usr/local/bin"
---
> # set install_dir "/usr/local/lib/tcltutor/lessons"
> # set bin_dir "/usr/local/bin"
> set install_dir "/usr/src/TclTutor/local/lib/tcltutor/lessons"
> set bin_dir "/usr/src/TclTutor/local/bin"
%%%
cd /usr/src/TclTutor/
# ./Configure
tubak conf.tk
# (find-tcltfile "conf.tk")
cd /usr/src/TclTutor/local/bin/
./TclTutor.tk
#####
#
# Crim - interface to the 2D diagram
#
#####
# «crim-2d» (to ".crim-2d")
# (find-fline "~/TK/diaglib.013")
# (find-fline "/usr/doc/tk8.0/examples/items.tcl")
# Version 0:
canvas .c -width 500 -height 350 -relief sunken -borderwidth 2
pack .c -expand yes -fill both
proc blop {x y args} {
eval .c create rectangle \
[expr $x*20+5] [expr $y*20+5] [expr $x*20+20] [expr $y*20+20] \
-tags $x,$y
.c bind $x,$y <Enter> ".c itemconf $x,$y -fill yellow"
.c bind $x,$y <Leave> ".c itemconf $x,$y -fill {}"
}
blop 0 0
blop 1 0
blop 2 1
# Version 1:
canvas .c -width 500 -height 350 -relief sunken -borderwidth 2
pack .c -expand yes -fill both
# Globals: (behaves like:)
# xyrets() xyrets(1,0) -> 0,0 (or {})
# xyfail() xyfail(2,1) -> 3,0 (or {})
# xynow xynow -> 2,1 (or {})
set xynow {}
proc blop {x y ret fail} {
global xyrets xyfails
eval .c create rectangle \
[expr $x*20+5] [expr $y*20+5] [expr $x*20+20] [expr $y*20+20] \
-tags $x,$y
.c bind $x,$y <Enter> "enter-blop $x,$y"
.c bind $x,$y <Leave> "leave-blop $x,$y"
set xyrets($x,$y) $ret
set xyfails($x,$y) $fail
}
proc color-blop {xy this_ret_fail_retfail} {
global xyrets xyfails
if {$xy==""} {return}
set xyret $xyrets($xy)
set xyfail $xyfails($xy)
set xyretfail {}
if {$xyret==$xyfail} {set xyretfail $xyret; set xyret {}; set xyfail {}}
foreach axy [list $xy $xyret $xyfail $xyretfail] \
color $this_ret_fail_retfail {
if {$axy!=""} {.c itemconf $axy -fill $color}
}
}
proc enter-blop {xy} {
global xynow; if {$xynow!=$xy} {leave-blop $xynow}
color-blop $xy {mintcream yellow red orange}
set $xynow $xy
}
proc leave-blop {xy} {
global xynow
if {$xy!={}} {color-blop $xy {{} {} {} {}}}
set $xynow {}
}
blop 0 0 {} {}
blop 1 0 0,0 {}
blop 2 1 1,0 1,0
blop 2 2 1,0 2,1
Próximos passos: 1) passo a ter um array indexado por x,y que diz quem
é o ret e quem é o fail de um cara; cada um deles pode ser {}. Na hora
de colorir o fail fica em vermelho, o ret em amarelo, e se os dois
forem o mesmo a gente colore de laranja. O próprio carinha sob o
cursor ganha um verde bonito. 2) Passo a ter um outro array que diz o
texto pra mostrar embaixo quando
#####
#
# tkinspect
#
#####
# «tkinspect» (to ".tkinspect")
psne $ALCATCL/alcatel/code/tkinspect-5.1.6.tar.gz
rm -Rv /usr/src/tkinspect-5/
cd /usr/src/
tar -xvzf $SALCATCL/alcatel/code/tkinspect-5.1.6.tar.gz
cd /usr/src/tkinspect-5/
rm -Rv RCS
patch install.tcl <<'%%%'
84c84
< set prefix /usr/local
---
> set prefix /usr/src/tkinspect-5
153a154
> set wish /usr/bin/wish
219a220,221
>
> do_install
%%%
patch version.tcl <<'%%%'
12c12
< if {$major != 4} {
---
> if {$major != 4 && 0} {
%%%
mkdir -p bin lib/tkinspect
agrep send $(find *) |& tee o
cd /usr/src/tkinspect-5/
wish install.tcl
# tubak install.tcl
wish -f tkinspect.tcl
# (find-fline "/usr/src/tkinspect-5/README")
# (find-fline "/usr/src/tkinspect-5/install.tcl")
# (find-fline "/usr/src/tkinspect-5/install.tcl" "proc do_install")
# (find-fline "/usr/src/tkinspect-5/install.tcl" "proc install ")
# set wish /usr/bin/wish
# (find-fline "/usr/src/tkinspect-5/install.tcl" 130)
# (find-fline "/usr/src/tkinspect-5/version.tcl")
# (code-c-d "tki" "/usr/src/tkinspect-5/")
# (find-tkifile "tkinspect.tcl")
cd /usr/src/tkinspect-5/
agrep -w proc *.tcl */*.tcl | tee ~/o
agrep -w target *.tcl */*.tcl | tee ~/o2
# (find-fline "~/o")
# (find-fline "~/o2")
# (find-tkifile "")
# (find-tkifile "stl-lite/")
# Not working AFAIK
#####
#
# send
# 99oct??
#
#####
# «send» (to ".send")
# (eeman "xauth" ".n.extract")
startx
#*
xauth nextract /tmp/0.0 :0.0
laf /tmp/0.0
cat /tmp/0.0
chmod 666 /tmp/0.0
#
su -s /usr/X11R6/bin/xauth edrx nmerge /tmp/0.0
#*
# Tests with my diagram editor:
#
echo 'puts [send tmpdiag {winfo children .buttons}]; exit' | wish
proc listwithchildren {app parent} {
puts $parent
foreach child [send $app "winfo children $parent"] {
listwithchildren $app $child
}
}
listwithchildren [lindex $argv 0] .
exit
# (find-fline "~/TCL/")
# (find-fline "~/TCL/winfo")
# (find-fline "~/TCL/tclsendmail")
# And for items in canvases?...
cat > /tmp/w <<'---'
proc ps {args} {puts [eval send tmpdiag $args]}
ps winfo children .
ps winfo children .c
ps .c configure
ps .c find all
ps .c itemconfigure 1
ps .c type 1
---
wish /tmp/w
#####
#
# mktclapp: C functions with binary arguments
#
#####
# «mktclapp_objcom» (to ".mktclapp_objcom")
# (find-fline "/usr/doc/mktclapp/mktclapp.html" "<a name=\"toc11\">")
# (find-fline "~/MTA/")
# (find-fline "~/MTA/test.tcl")
# (find-fline "~/MTA/Makefile")
# (find-fline "~/MTA/objcom.c")
cd ~/MTA/
make clean
cd ~/MTA/
make
cd ~/MTA/
(cat ~/replace/ega1.8; gzip -cd /usr/share/consolefonts/iso01.f08.gz) \
> /tmp/512
objcom test.tcl 8 /tmp/512
# (find-node "(gdb)File Options")
# (gdb "gdb -quiet -x ~/MTA/objcom.gdb objcom")
# (find-fline "~/MTA/objcom.gdb")
# (find-tcltag "Tcl_GetStringFromObj")
# (find-tcltag "Tcl_GetIntFromObj")
# (find-tcltag "Tcl_Obj")
# (find-fline "~/MTA/objcom.E")
# (find-fline "~/MTA/objcom_.E")
#####
#
# Enhancing mktclapp with a variadic argument parser
# (Completely incomplete!)
#
#####
# «mktclapp_variadic» (to ".mktclapp_variadic")
/*
* (find-node "(libc)Variable Arguments Output")
* (find-node "(gcc.info)Macro Varargs")
* (find-node "(libc)Variadic Functions")
* (find-node "(libc)Variadic Example")
* (find-node "(cpp)Stringification")
*/
int add_em_up (int count,...) {
va_list ap;
int i, sum;
va_start (ap, count); /* Initialize the argument list. */
sum = 0;
for (i = 0; i < count; i++)
sum += va_arg (ap, int); /* Get the next argument value. */
va_end (ap); /* Clean up. */
return sum;
}
int main (void) {
/* This call prints 16. */
printf ("%d\n", add_em_up (3, 5, 5, 6));
/* This call prints 55. */
printf ("%d\n", add_em_up (10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10));
return 0;
}
#define assert_nargs(n, msg) \
if (argc!=(n)+1) { \
Et_ResultF(interp, "wrong # args: should be %s %s", argv[0], msg); \
return TCL_ERROR; \
}
#define get_intarg(n, name, iptr) \
{ \
if (argc!=(n)+1) { \
Et_ResultF(interp, "wrong # args: should be %s %s", argv[0], msg); \
return TCL_ERROR; \
}
/*
char *tail;
int n;
errno = 0;
next = strtol (string, &tail, 0);
if (errno)
printf ("Overflow\n");
else
sum += next;
string = tail;
}
int strtol (const char *STRING, char **TAILPTR, int
BASE)
0004 int ET_COMMAND_add(ET_TCLARGS){
0005 if( argc!=3 ){
0006 Et_ResultF(interp, "wrong # args: should be \"%s NUM1 NUM2\"",argv[0]);
0007 return TCL_ERROR;
0008 }
0009 Et_ResultF(interp,"%d", atoi(argv[1]) + atoi(argv[2]));
0010 return TCL_OK;
# (find-tclfile "")
# (find-tclfile "changes" "Changes for Tcl 8.0 go below this line.")
# (find-vldifile "tcl8.0-dev.list")
# (find-fline "/usr/doc/tcl8.0-dev/")
grep -i obj $(eefile vldi tcl8.0-dev.list) | sort > ~/o
grep -i obj $(eefile vldi tcl8.0-dev.list) | sort \
| perl -nle 'm:man3/(.*).3tcl.gz: && print $1' \
| perl -nle 'print " [man3tcl $_]"' \
| tee ~/o
http://angg/cgi-bin/man2html/usr/man/man3/CrtObjCmd.3tcl.gz#index
# (find-fline "~/o")
/usr/man/man3/BoolObj.3tcl.gz
# (find-tcltag "Tcl_Obj")
# (find-fline "$PAGE2/mktclapp.th")
# (find-fline "~/MTA/objcom.c")
grep -i tcl ~/osnl | sort | grep -i htm > ~/o2
grep -v /man ~/o2 > ~/o3
grep /man ~/o2 > ~/o4
# (find-fline "~/o3")
# (find-fline "~/o4")
grep -i tcl ~/osnl | sort | awk '{if ($0 ~ /htm/) print " "$0; else print $0}'
14839 Fundamental /var/lib/dpkg/info/tcl8.0-dev.list
#####
#
# environment variables
# 2000mar11
#
#####
# «environment» (to ".environment")
#*
expect -c 'puts $env(DOREMOTE)'
export DOREMOTE=1; expect -c 'puts $env(DOREMOTE)'
export DOREMOTE=; expect -c 'puts $env(DOREMOTE)'
unset DOREMOTE; expect -c 'puts [info exists env(DOREMOTE)]'
export DOREMOTE=1; expect -c 'puts [info exists env(DOREMOTE)]'
unset DOREMOTE;
unset DR; expect -c 'puts [expr {[info exists env(DR)]&&$env(DR)}]'
export DR=1; expect -c 'puts [expr {[info exists env(DR)]&&$env(DR)}]'
export DR=0; expect -c 'puts [expr {[info exists env(DR)]&&$env(DR)}]'
unset DR;
#*
#####
#
# groupkit-5.1
# 99sep11
#
#####
# «groupkit» (to ".groupkit")
#*
rm -Rv /usr/src/groupkit-5.1/
cd /usr/src/
tar -xvzf $S/ftp/ftp.cpsc.ucalgary.ca/pub/projects/grouplab/software/groupkit-5.1.tar.gz
cd /usr/src/groupkit-5.1/
cd /usr/src/groupkit-5.1/unix/
./configure --with-tcl=/usr/lib
make install prefix=/usr exec_prefix=/usr/local |& tee omi
#*
registrar &
open.reg
# (find-fline "/usr/local/bin/")
# (find-fline "/usr/lib/gk5.1/")
rm -Rv /usr/lib/gk5.1/
rm -v /usr/local/bin/registrar
rm -v /usr/local/bin/open.reg
# (find-fline "/usr/src/groupkit-5.1/")
# (find-fline "/usr/src/groupkit-5.1/README")
# (find-fline "/usr/src/groupkit-5.1/unix/omi")
# (find-fline "/usr/src/groupkit-5.1/unix/Makefile")
# cd /usr/src/groupkit-5.1/unix/
# ./configure --with-tcl=/usr/src/tcl8.0-8.0.4/unix
# mkdir /tmp/p /tmp/ep
# make install prefix=/tmp/p exec_prefix=/tmp/ep |& tee omi
# find /tmp
cd /usr/src/groupkit-5.1/unix/
strace-to ~/s wish open.reg |& tee ow
######
#
# Freehand drawing
# 99oct18
#
######
# «freehand» (to ".freehand")
# (find-expfile "exp_main_tk.c" "-command")
#*
function wish-c () { echo $1 > ~/tmp/ee.tcl; wish ~/tmp/ee.tcl }
wish-c '
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
pack [canvas .c]
# canvas .c
bind .c <ButtonPress-1> {
set %W(line) [list %W coords [%W create line %x %y %x %y] %x %y]
}
bind .c <B1-Motion> {eval [lappend %W(line) %x %y]}
bind .c <ButtonRelease-1> {unset %W(line)}
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
# z = x+iy => z^2 = (x+iy)^2 = x^2-y^2+2ixy
#
# .d is the domain, .c is the image. z |-> z^2.
# Bug: y is flipped, but that`s unnoticeable in this case.
#
proc bpress {W x y} {
global $W-line
set $W-line [list $W coords [$W create line $x $y $x $y] $x $y]
}
proc bmotion {W x y} {
global $W-line
eval [lappend $W-line $x $y]
}
#
pack [canvas .c -width 200 -height 200]
bind .c <ButtonPress-1> {bpress .c %x %y}
bind .c <B1-Motion> {bmotion .c %x %y}
#
proc tof {n} {expr ($n-100)/50.0}
proc toscr {x} {expr ($x*50)+100}
proc imx {x y} {toscr [expr {pow([tof $x],2) - pow([tof $y],2)}]}
proc imy {x y} {toscr [expr {2*[tof $x]*[tof $y]}]}
#
toplevel .d
pack [canvas .d.e -width 200 -height 200]
bind .d.e <ButtonPress-1> {
bpress .d.e %x %y
bpress .c [imx %x %y] [imy %x %y]
}
bind .d.e <B1-Motion> {
# puts "%x %y"
bmotion .d.e %x %y
bmotion .c [imx %x %y] [imy %x %y]
}
######
#
# tkpaint
# 99oct18
#
######
# «tkpaint» (to ".tkpaint")
apti tkpaint
# (find-vldifile "tkpaint.list")
# (find-fline "/usr/doc/tkpaint/")
# (find-fline "/usr/X11R6/bin/tkpaint")
# (find-fline "/usr/X11R6/lib/tkpaint/")
# (find-fline "/usr/doc/tkpaint/examples/")
cd /usr/doc/tkpaint/examples/
tkpaint demo2.pic
tkpaint demo3.pic
#####
#
# static tcl libs (for freewrap)
# 99nov11
#
#####
# «static_libs» (to ".static_libs")
pdsc /big/slinks2/dists/slink/main/source/libs/tcl8.0_8.0.4-2.dsc
cd /usr/src/tcl8.0-8.0.4/
# etags $(find generic unix -name '*.[ch]')
debian/rules binary |& tee odrb
# (find-tclfile "")
# (find-tclfile "debian/")
# (find-tclfile "odrb")
# (find-tclfile "unix/")
#####
#
# freewrap
# 99nov11
#
#####
# «freewrap» (to ".freewrap")
rm -Rv /usr/src/freewrap/
mkdir /usr/src/freewrap/
cd /usr/src/freewrap/
tar -xvzf $S/http/www.albany.net/~dlabelle/freewrap/download/freewrap33.tar.gz
# (find-fline "/usr/src/freewrap/freewrap.mta")
mv freewrap.mta freewrap.mta.old
cat > freewrap.mta <<'---'
# Configuration file generated by xmktclapp
# Hand editing is not recommended
#
# The "xmktclapp" program reads the lines that begin with "##".
# The "mktclapp" program reads lines that don't begin with "#".
# Lines beginning with a single "#" are comment.
#
## Autofork No
## CFile:tcl/encrypt.c 1
## CmdLine Console
## ConfigFile freewrap.mta
## MainScript tcl/freewrap.tcl
## Mode Tcl/Tk
## NoSource No
## OutputFile tcl/freewrap.c
## Shroud No
## Standalone Yes
## TclFile:tcl/freewrap.tcl 1
## TclLib /usr/lib/tcl8.0
## TkLib /usr/lib/tk8.0
#
-console
-main-script "freewrap.tcl"
-tcl-library "/usr/lib/tcl8.0"
-tk-library "/usr/lib/tk8.0"
-strip-tcl "/usr/lib/tcl8.0/history.tcl"
-strip-tcl "/usr/lib/tcl8.0/init.tcl"
-strip-tcl "/usr/lib/tcl8.0/ldAout.tcl"
-strip-tcl "/usr/lib/tcl8.0/parray.tcl"
-strip-tcl "/usr/lib/tcl8.0/pkgIndex.tcl"
-strip-tcl "/usr/lib/tcl8.0/safe.tcl"
-strip-tcl "/usr/lib/tcl8.0/tclIndex"
-strip-tcl "/usr/lib/tcl8.0/word.tcl"
-strip-tcl "/usr/lib/tk8.0/bgerror.tcl"
-strip-tcl "/usr/lib/tk8.0/button.tcl"
-strip-tcl "/usr/lib/tk8.0/clrpick.tcl"
-strip-tcl "/usr/lib/tk8.0/comdlg.tcl"
-strip-tcl "/usr/lib/tk8.0/console.tcl"
-strip-tcl "/usr/lib/tk8.0/dialog.tcl"
-strip-tcl "/usr/lib/tk8.0/entry.tcl"
-strip-tcl "/usr/lib/tk8.0/focus.tcl"
-strip-tcl "/usr/lib/tk8.0/listbox.tcl"
-strip-tcl "/usr/lib/tk8.0/menu.tcl"
-strip-tcl "/usr/lib/tk8.0/msgbox.tcl"
-strip-tcl "/usr/lib/tk8.0/obsolete.tcl"
-strip-tcl "/usr/lib/tk8.0/optMenu.tcl"
-strip-tcl "/usr/lib/tk8.0/palette.tcl"
-strip-tcl "/usr/lib/tk8.0/safetk.tcl"
-strip-tcl "/usr/lib/tk8.0/scale.tcl"
-strip-tcl "/usr/lib/tk8.0/scrlbar.tcl"
-strip-tcl "/usr/lib/tk8.0/tclIndex"
-strip-tcl "/usr/lib/tk8.0/tearoff.tcl"
-strip-tcl "/usr/lib/tk8.0/text.tcl"
-strip-tcl "/usr/lib/tk8.0/tk.tcl"
-strip-tcl "/usr/lib/tk8.0/tkfbox.tcl"
-strip-tcl "/usr/lib/tk8.0/xmfbox.tcl"
"encrypt.c"
-strip-tcl "freewrap.tcl"
---
rm freewrap
mktclapp -f freewrap.mta > freewrap.c
mktclapp -header > freewrap.h
make \
LIBS="/usr/lib/libtcl8.0.a /usr/lib/libtk8.0.a -L/usr/X11R6/lib -lX11 -ldl -lieee -lm -lc" \
CFLAGS="-pipe -fPIC -DSTATIC_BUILD -DTcl_GetByteArrayFromObj=Tcl_GetStringFromObj -DTcl_NewByteArrayObj=Tcl_NewStringObj" \
-f makefile.linux |& tee om
cd /usr/src/freewrap/
laf
file freewrap
ldd freewrap
laf /usr/lib/lib{tcl,tk}*
# (find-fline "/usr/src/freewrap/freewrap.mta")
# (find-fline "/usr/src/freewrap/makefile.linux")
# (find-vldifile "tcl8.0-dev.list")
#####
#
# postscript
#
#####
# (find-tkfile "tests/")
# (find-tkfile "tests/canvPs.test")
# (find-tkfile "tests/canvRect.test")
# (find-tkfile "tests/canvText.test")
# (find-tkfile "tests/canvPsArc.tcl")
# (find-tkfile "tests/canvPsBmap.tcl")
# (find-tkfile "tests/canvPsGrph.tcl")
# (find-tkfile "tests/canvPsText.tcl")
canvPs.test: .c postscript -file bar.ps
canvRect.test: set x [.c postscript]
canvText.test: set x [.c postscript]
font.test: set post [.b.c postscript]
font.test: set x [.b.c postscript]
visual: $c postscript -file tmp.ps
#####
#
# Tk - more on PostScript
# 99nov06
#
#####
# «tk_ps» (to ".tk_ps")
# (find-tkfile "doc/CanvPsY.3")
# (find-tkfile "doc/CrtItemType.3")
# (find-tkfile "doc/canvas.n")
# (find-man "3tk CanvPsY")
# (find-man "3tk CrtItemType")
# (find-man "3tk canvas" "postscript")
# (find-fline "~/LATEX/")
# (find-fline "~/LATEX/diaglib.013" "postscript -file")
#####
#
# New version of the diagram libs
# 00jan??
#
#####
# «newdiaglib» (to ".newdiaglib")
# (find-fline "~/LATEX/basiclib.013")
# (find-fline "~/LATEX/diaglib.013")
# (find-fline "~/LATEX/diaglib.014")
# (find-fline "~/LATEX/desenhos.013")
# (find-fline "~/.emacs" "diaglib")
# (find-angg ".emacs" "diags")
(defun eediag-bounded () (interactive)
(write-ee-bounded
"----------\n" "\n#----------"
"cd ~/LATEX; cat > tmpdiag <<'--%%--'\nsource diaglib.014\n"
"\n--%%--\nwish tmpdiag &\n"))
(global-set-key [f3] 'eediag-bounded)
#####
#
# Calling Tcl from C
# 99dec14
#
#####
# «tcl_from_c» (to ".tcl_from_c")
# (find-fline "$S/http/www.cica.indiana.edu/cica/faq/tcl/book.examples" "Tcl_Interp")
# (find-vldifile "tcl8.0-dev.list")
# (find-fline "/usr/doc/tcl8.0-dev/")
# (find-man "3tcl Tcl_Eval")
# (find-man "3tcl Tcl_EvalObj")
# (find-man "3tcl Tcl_GetStringResult")
#*
cd /tmp/
cat > calltcl0.c <<'---'
#include <stdio.h>
#include <tcl.h>
main(int argc, char *argv[]) {
Tcl_Interp *interp = Tcl_CreateInterp();
Tcl_Eval(interp, "puts Hello");
Tcl_Eval(interp, "expr 1+2");
printf("..%s..\n", Tcl_GetStringResult(interp));
}
---
gcc -ltcl8.0 -o calltcl0 calltcl0.c
calltcl0
#*
#####
#
# The "MouseWheel" bug on Tk
# 2000may01
#
#####
# «mousewheel_bug» (to ".mousewheel_bug")
# (eeman "3tk bind" "MouseWheel")
# (find-fline "/usr/lib/tk8.0/listbox.tcl" "MouseWheel")
# (find-fline "/usr/lib/tk8.0/text.tcl" "MouseWheel")
# (eeman "3tk event" "MouseWheel")
# Problem: it seems that "bind ... <MouseWheel> {code}" on a raw tk8.0
# on Linux makes tk scream; MouseWheel is a windows-only event, that
# (I guess) isn't event recognize by tk8.0 on Linux. I don't think
# it's possible to define it as some sort of virtual event, as virtual
# events have names like "<<...>>"; but I'm almost tk-illiterate.
# Further problem: some programs (like tclcl, used by nam) pack files
# from /usr/lib/tk8.0/ in strings that are fed directly to tk; to
# avoid letting the "bind ... <MouseWhell>" lines go into this code,
# I'll try to use an ugly dirty hack.
# *UGLY DIRTY HACK*:
# Comment out (by hand) the following code blocks.
# Add a link to this e-script:
# (find-es "tcl" "mousewheel_bug")
# (find-fline "/usr/lib/tk8.0/listbox.tcl" "MouseWheel")
# (find-fline "/usr/lib/tk8.0/text.tcl" "MouseWheel")
#####
#
# nam (network animator)
# 2000apr24 / 2019jun17
#
#####
# «nam» (to ".nam")
# (find-available "nam")
# (find-zsh "installeddebs | sort | grep nam")
# (find-zsh "availabledebs | sort | grep nam")
# (find-status "nam")
# (find-vldifile "nam.list")
# (find-udfile "nam/")
# (find-man "1 nam")
# (find-status "nam-examples")
# (find-vldifile "nam-examples.list")
# (find-udfile "nam-examples/")
# (find-udfile "nam/examples/")
# (find-udfile "nam/examples/edu/")
# http://www.isi.edu/nsnam/nam/
# https://www.isi.edu/nsnam/ns/doc/node616.html
# https://www.isi.edu/nsnam/ns/doc/node607.html 9 Visualization with Nam - The Network Animator
# (find-status "ns3")
# (find-vldifile "ns3.list")
# (find-udfile "ns3/")
# https://www.nsnam.org/
# https://www.nsnam.org/documentation/
# https://www.nsnam.org/wiki/Main_Page
# https://www.cl.cam.ac.uk/~awm22/publications/hall2003multi.pdf
rm -Rv /usr/src/otcl-1.0a4/
cd /usr/src/
tar -xvzf $S/http/www-mash.cs.berkeley.edu/dist/otcl-1.0a4.tar.gz
cd /usr/src/otcl-1.0a4/
./configure |& tee oc
# make |& tee om
make INCLUDES="-I. -I/usr/include -I/usr/include/tcl8.0/generic" |& tee om
rm -Rv /usr/src/tclcl-1.0b8/
cd /usr/src/
tar -xvzf $S/http/www-mash.cs.berkeley.edu/dist/tclcl-src-1.0b8.tar.gz
cd /usr/src/tclcl-1.0b8/
./configure |& tee oc
rm embedded-tk.cc
make |& tee om
rm -Rv /usr/src/nam-1.0a8/
cd /usr/src/
tar -xvzf $S/http/www-mash.cs.berkeley.edu/dist/vint/nam-src-1.0a8.tar.gz
cd /usr/src/nam-1.0a8/
./configure |& tee oc
make |& tee om
gzip -c6 nam.1 > /usr/man/man1/nam.1.gz
cd /usr/src/nam-1.0a8/ex/
../nam lan.nam
# (code-c-d "otcl" "/usr/src/otcl-1.0a4/")
# (find-otclfile "")
# (code-c-d "tclcl" "/usr/src/tclcl-1.0b8/")
# (find-tclclfile "")
# (find-tclclfile "embedded-tk.cc")
# (find-tclclfile "embedded-tk.cc" "bind Listbox <MouseWheel>")
# (find-tclclfile "embedded-tk.cc" "bind Text <MouseWheel>")
# (find-tclclfile "Makefile" "embedded-tk.cc:")
# (find-es "tcl" "mousewheel_bug")
# (code-c-d "nam" "/usr/src/nam-1.0a8/")
# (find-namfile "")
# (find-namfile "conf/")
# (find-namfile "conf/configure.in.TclCL" "TclCL_VERS")
# (find-namfile "ex/")
# (eeman "nam")
# (find-namfile "CHANGES.html" "port address")
# (find-namfile "README" "QUICK START")
lynx $S/http/www.neosoft.com/neoscript/commands/otcl-commands.html
lynx $S/http/www.neosoft.com/neoscript/commands/otcl/
#####
#
# blurb for diaglib.014
# 2000apr24
#
#####
# «diaglib_blurb» (to ".diaglib_blurb")
Hey. Do you want an editor for commutative diagrams that is intuitive
and easy to use?
If you do then you'd better look elsewhere. Try xfig or tkdraw.
I wrote diaglib.014 because I needed something that I could hack
easily to add more features, and that would let me write the diagrams
in a real programming language. And I wanted to be able to edit the
diagrams in Emacs, not just by pointing and clicking; the graphical
interface was to be used only to drag some reference points until the
final result looked reasonably pretty.
<blurb> ...experience shows ( :-) that editing diagrams in ASCII-art
in Emacs is always much more fun than editing them using graphical
tools, and coding them after that in diaglib code is very quick and
fun enough (especially when you're diaglib's author, of course).
</blurb>
Quick and messy description:
Diagrams are made of text objects (see "TEXT ITEMS" in the manpage
(3tk)canvas) and arrow objects ("LINE ITEMS" in (3tk)canvas). Arrow
objects always go from a corner of a text object to a corner of
another; they're generally straight but there are tricks to get
curves. For the arrow objects we can specify line width, stipple,
arrow shape and which ends get arrows. Text objects can be dragged
with the mouse; when one of them is dragged all other text objects
whose coordinates depended on it are dragged together with it and the
diagram is redrawn; some arrows may move because their control points
moved.
Diagrams are written as Tcl code that is executed after sourcing
diaglib.014. The code creates two strings, $OnCreate and $OnUpdate,
that are in fact Tk scripts; these scripts can be inspected by
pressing buttons on the main window. OnCreate is only eval'ed once and
OnUpdate is eval'ed every time a drag is done. A third array, OnDump,
has Tcl code to show the present coordinates of the text objects in a
format that can be incorporated in the diagram code.
Some text objects may be marked as auxiliaries. There's a button that
deletes all auxiliary objects. Another button makes all objects black.
Another one exports the current figure as encapsulated postscript to
~/LATEX/eps/<epsfilename>.eps, where <epsfilename> is set with the
command "epsfile". The path ~/LATEX/eps/ is hardcoded but trivial to
change.
The contents of the variables OnCreate, OnUpdate and OnDump (and the
result of eval'ing OnDump) can be sent to stdout or to ~/o; again the
path is hardcoded but easy to change. A button toggles if the output
goes to stodut or to ~/o.
#####
#
# Namespaces and packages
# 2000may15
#
#####
# «namespaces» (to ".namespaces")
# (find-man "3tcl namespace")
# (find-man "3tcl namespace" "namespace eval")
# (find-man "3tcl namespace" "namespace export")
# (find-man "3tcl package")
# (find-man "3tcl pkg_mkIndex")
# (find-man "3tcl pkg_mkIndex" "HOW IT WORKS")
# (find-sh "locate init.tcl")
# (find-fline "/usr/share/tcltk/tcl8.4/init.tcl")
# (find-fline "/usr/share/tcltk/tcl8.5/init.tcl")
# (find-man "3tcl PkgRequire")
# (find-tcl82file "generic/tclPkg.c" "char *\nTcl_PkgRequireEx")
#####
#
# tclreadline
# 2000oct24
#
#####
# «tclreadline» (to ".tclreadline")
# (find-fline "~/.tclshrc")
# (find-status "tclreadline")
# (find-vldifile "tclreadline.list")
# (find-fline "/usr/doc/tclreadline/")
#####
#
# tcl8.3, tix4.1 and tk8.3 from the source (woody, on potato)
# 2000nov04
#
#####
# «8.3-src» (to ".8.3-src")
# (find-es "dpkg" "local_apt_repository")
# (find-fline "/usr/src/.debs/")
# (find-angg ".zshrc" "apt")
#*
pdsc $SDEBIAN/dists/woody/main/source/libs/tcl8.3_8.3.1-3.dsc
debian/rules binary |& tee odrb
cd /usr/src/
mv -iv tcl8.3*.deb .debs/
# (code-c-d "tcl83" "/usr/src/tcl8.3-8.3.1/")
# (find-tcl83file "")
#*
# (find-es "gdb" "invoking_gdbk")
ldd /usr/bin/tclsh8.3
# This one is stripped:
LD_LIBRARY_PATH=/usr/src/tcl8.3-8.3.1/debian/tcl8.3/usr/lib: \
ldd /usr/bin/tclsh
# This one is not (I think):
LD_LIBRARY_PATH=/usr/src/tcl8.3-8.3.1/unix: \
#*
aptu-local-i386
apt-get update
apti tcl8.3 tcl8.3-dev tcl8.3-doc
#*
pdsc $SDEBIAN/dists/woody/main/source/libs/tk8.3_8.3.1-2.dsc
cd /usr/src/tk8.3-8.3.1/
find * | sort > .files
debian/rules binary |& tee odrb
cd /usr/src/
mv -iv tk8.3*.deb .debs/
#*
aptu-local-i386
apt-get update
apti tk8.3 tk8.3-dev tk8.3-doc
#*
pdsc $SDEBIAN/dists/woody/main/source/libs/tix41_4.1.0.7-4.dsc
cd /usr/src/tix41-4.1.0.7/
chmod 755 unix/tk8.3/configure
debian/rules binary |& tee odrb
cd /usr/src/
mv -iv tix41*.deb .debs/
#*
# (code-c-d "tix" "/usr/src/tix41-4.1.0.7/")
# (find-tixfile "")
# (find-status "tcl8.3")
# (find-status "tcl8.3-dev")
# (find-status "tcl8.3-doc")
# (find-status "tix41")
# (find-status "tix41-dev")
# (find-status "tk8.3")
# (find-status "tk8.3-dev")
# (find-status "tk8.3-doc")
# (find-vldifile "tcl8.3-dev.list")
# (find-vldifile "tcl8.3-doc.list")
# (find-vldifile "tcl8.3.list")
# (find-vldifile "tix41-dev.list")
# (find-vldifile "tix41.list")
# (find-vldifile "tk8.3-dev.list")
# (find-vldifile "tk8.3-doc.list")
# (find-vldifile "tk8.3.list")
# (find-fline "/usr/doc/tcl8.3-dev/")
# (find-fline "/usr/doc/tcl8.3-doc/")
# (find-fline "/usr/doc/tcl8.3/")
# (find-fline "/usr/doc/tix41-dev/")
# (find-fline "/usr/doc/tix41/")
# (find-fline "/usr/doc/tk8.3-dev/")
# (find-fline "/usr/doc/tk8.3-doc/")
# (find-fline "/usr/doc/tk8.3/")
#####
#
# gepetto
# 2000sep23
#
#####
# «gepetto» (to ".gepetto")
apti tix41-dev tk8.0-dev
edrxnetscape http://laurent.riesterer.free.fr/gepetto/ &
#*
rm -Rv /usr/src/gepetto-0.12/
cd /usr/src/
tar -xvzf $S/http/laurent.riesterer.free.fr/gepetto/gepetto-0.12.tar.gz
cd /usr/src/gepetto-0.12/
rm src/parser*.o
#*
cd /usr/src/gepetto-0.12/
cd src/
rm -v tkInt*
make \
INCLUDES="-I/usr/X11R6/include -I/usr/include/tcl8.3 -I/usr/include/tk8.3 -I/usr/include/tcl8.3/tk-private/generic" \
LIBS="-ltcl8.3 -ltk8.3 -ltix -lGLU -lGL -lX11 -lXmu -lXext -lm -ldl" \
|& tee om
#*
cd /usr/src/gepetto-0.12/src/
echo exit \
| gepetto |& tee ~/o
# (find-fline "~/o")
# (find-vldifile "tix41.list" "/usr/share/tix4.1/Init.tcl")
# (find-gepfile "src/Makefile")
#*
# (find-gepfile "src/" "tkInt")
# (find-vldifile "tcl8.3-dev.list")
# (find-vldifile "tcl8.3.list")
# (find-vldifile "tix41-dev.list")
# (find-vldifile "tix41.list")
# (find-vldifile "tk8.3-dev.list")
# (find-vldifile "tk8.3.list")
# (find-gepfile "src/Makefile")
/usr/include/tcl8.3
INCLUDES = -I/usr/X11R6/include
#-I/usr/X11R6/include -I/usr/local/tcl8/include -I/home/moi/tcl/tk8.0.4/generic
# Where to find Tcl, Tk, OpenGL/Mesa libraries:
LIBDIRS = -L/usr/X11R6/lib
#-L/usr/local/tcl8/lib -L/usr/X11R6/lib
# Libraries to link with (-ldl for Linux only?):
LIBS = -ltcl8.0 -ltk8.0 -ltix4.1.8.0 -lGLU -lGL -lX11 -lXmu -lXext -lm -ldl
#*
cat > /tmp/test.c <<'---'
#include <tkInt.h>
---
cd /tmp/
gcc -I/usr/X11R6/include -I/usr/include/tcl8.3 -I/usr/include/tk8.3 test.c
#*
#####
#
# tkgate
# 2000sep08
#
#####
# «tkgate» (to ".tkgate")
#*
rm -Rv /usr/src/tkgate-1.5c/
cd /usr/src/
tar -xvzf $S/ftp/gadoid.ices.cmu.edu/pub/tkgate/tkgate-1.5c.tgz
cd /usr/src/tkgate-1.5c/
./configure |& tee oc
make |& tee om
make install |& tee omi
#*
# (code-c-d "tkgate" "/usr/src/tkgate-1.5c/")
# (find-tkgatefile "")
# (find-man "3tcl update")
#*
rm -Rv /usr/src/snoopy-0.1/
cd /usr/src/
tar -xvzf $S/http/www.equi4.com/jcw/snoopy.tar.gz
cd /usr/src/snoopy-0.1/
#*
# (find-fline "$S/http/www.equi4.com/jcw/snoopy.tar.gz")
# (find-fline "$S/http/www.equi4.com/previews/feddy.tar.gz")
#####
#
# lrange and lreplace
# 2000? / 2012jun13
#
#####
# «lrange_lreplace» (to ".lrange_lreplace")
# (find-man "3tcl lrange")
# (find-man "3tcl lreplace")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
puts [lrange {a _b c_ d} 1 2] ;# -> b c
puts [lreplace {a _b c_ d} 1 2 _E F G H_] ;# -> a _E F G H_ d
set lst {a b c d}
set n 3 ;# number of element to glue
set lst2 [lreplace $lst [expr [llength $lst]-$n] end \
[join [lrange $lst [expr [llength $lst]-$n] end] \
+]]
puts $lst2 ;# -> a b+c+d
#####
#
# regexp and ranges
# 2002aug29
#
#####
# «regexp_and_ranges» (to ".regexp_and_ranges")
#*
# (find-man "3tcl string" "string first")
# (find-man "3tcl string" "string range")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
string first FOO abcdefgh ;# -1
string first de abcdefgh ;# 3
string range abcdefgh 0 [expr 3-1] ;# abc
string range abcdefgh 3 [expr 3+[string length de]-1] ;# de
string range abcdefgh [expr 3+[string length de]] end ;# fgh
# (find-man "3tcl regexp" "-indices")
# (find-man "3tcl regexp" "-start")
regexp -indices de abcdefgh where_all ;# 1
puts $where_all ;# 3 4
string range abcdefgh 3 4 ;# de
string range abcdefgh 0 [expr 3-1] ;# abcd
string range abcdefgh [expr 4+1] end ;# fgh
proc before_regexp {re string} {
regexp -indices $re $string where
string range $string 0 [expr [lindex $where 0]-1]
}
puts [before_regexp de abcdefgh] ;# abc
# Tcl 8.0 does not support this:
puts [regexp -start 3 de abcdefgh] ;# 1
#####
#
# fundcomp
# 2004may19
#
#####
# «fundcomp» (to ".fundcomp")
#####
#
# a resizer (of top-level windows)
# 2005jan17
#
#####
# «resizer» (to ".resizer")
# (find-angg "TCL/resizer.tcl")
# (find-books "__comp/__comp.el" "ousterhout")
# (find-tcltkpage (+ 16 217) "22. Window Managers")
# (find-tcltktext (+ 16 217) "22. Window Managers")
# (find-man "3tk wm")
# (find-man "3tk wm" "wm geometry window ?newGeometry?")
# (find-man "3tk wm" "in order to make the change happen")
# (find-man "3tcl regexp")
# (find-man "3tk bind")
# (find-man "3tk bind" "toplevel window")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
proc incrsize {dx dy} {
regexp {([0-9]+)(.)([0-9]+)(.)([0-9]+)(.)([0-9]+)} [wm geometry .] \
-> width sep1 height sep2 x sep3 y
wm geometry . "[expr $width+$dx]$sep1[expr $height+$dy]$sep2$x$sep3$y"
}
bind . <Left> { incrsize -5 0 }
bind . <Right> { incrsize 5 0 }
bind . <Up> { incrsize 0 -5 }
bind . <Down> { incrsize 0 5 }
# Usage: now give the focus to the "wish" window and use the arrow
# keys to resize it.
# A little bug in fvwm-2.5.12 + tk-8.4.9 (?): move a "wish" window
# around by dragging it with the mouse; after that "wm geometry ."
# will confuse the origin of its fvwm borders and the origin of the
# contained area. The effect of that in the resizer is that in the
# next call to "incrsize" the window will jump a bit to the northwest.
#####
#
# the placer and frames
# 2005jan17
#
#####
# «placer» (to ".placer")
# «frames» (to ".frames")
# (find-angg "TCL/placer.tcl")
# (find-books "__comp/__comp.el" "ousterhout")
# (find-tcltkpage (+ 16 179) "17. Geometry Managers: The Placer")
# (find-tcltktext (+ 16 179) "17. Geometry Managers: The Placer")
# (find-man "3tk place")
# (find-man "3tk place" "-in master" "defaults to window's parent")
# (find-man "3tk place" "-relx location")
# (find-man "3tk place" "-anchor where")
# (find-man "3tk place" "-x location")
* (eechannel-xterm "A")
wish
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
proc incrsize {dx dy} {
regexp {([0-9]+)(.)([0-9]+)(.)([0-9]+)(.)([0-9]+)} [wm geometry .] \
-> width sep1 height sep2 x sep3 y
wm geometry . "[expr $width+$dx]$sep1[expr $height+$dy]$sep2$x$sep3$y"
}
bind . <Left> { incrsize -5 0 }
bind . <Right> { incrsize 5 0 }
bind . <Up> { incrsize 0 -5 }
bind . <Down> { incrsize 0 5 }
# (find-man "3tk place")
# (find-man "3tk frame")
#
frame .a -width 40 -height 20 -bg black
frame .b -width 30 -height 60 -bg yellow
frame .c -width 35 -height 35 -bg blue
place .a -x 40 -y 20
place .b -x 30 -y 60
place .c -x 35 -y 35
place info .
place info .a
place slaves .
place configure .
place configure .a
frame .c.d -width 10 -height 10 -bg red
place .c.d -x 10 -y 10
place configure .c.d -anchor se
frame .e -width 40 -height 40 -bg green
frame .f -bg forestgreen
place .e -anchor c -relx 0.5 -rely 0.5
place .f -anchor nw -relx 0.5 -rely 0.5 -relwidth 0.4 -relheight 0.4
frame .g -width 30 -height 30 -bg mediumvioletred
place .g -in .e
place .g -in .f
frame .h -width 10 -height 10 -bg blueviolet
place .h -in .f -relx 1 -rely 0.5 -anchor c
frame .i -width 10 -height 10 -bg violet
place .i -in .g -relx 1 -rely 0.5 -anchor c
place .g -in .e
place .g -in .f
#####
#
# cursor
# 2004sep21
#
#####
# «cursor» (to ".cursor")
#*
lua50 ~/LUA/rectxpm.lua '#ffff00' 2 2 > /tmp/cursor.xpm
expectk =(<<'%%%'
pack [canvas .c -background sienna4] -expand yes -fill both
# .c config -cursor {@/tmp/cursor.xpm}
.c config -cursor {arrow yellow red}
. config -cursor {cross blue green}
. config -cursor {cross black red}
%%%)
* (eechannel-xterm "A")
wish
. config -cursor {cross black red}
. config -cursor {@/tmp/1.xpm yellow}
# (find-es "x" "xpm")
# not working
#*
# (find-fline "~/LUA/rectxpm.lua")
# (find-fline "/tmp/cursor.xpm")
# (find-tclbook2page (- 167 126))
# (find-tkexfile "widget")
# (find-man "3tk options" "-cursor")
# (find-man "3tk Tk_GetCursor")
# (find-man "3tk Tk_GetCursor" "@sourceName fgColor")
# (find-fline "/usr/X11R6/include/X11/cursorfont.h")
# (find-vldifile "libx11-dev.list")
# libx11-dev
# (find-man "ImageMagick" "X Windows system pixmap")
# (find-fline "/usr/X11R6/include/X11/Xcursor/Xcursor.h")
# (find-sh "locate /cursor")
# (find-man "3tk cursors")
# (find-fline "/usr/X11R6/lib/X11/icons/whiteglass/cursors/")
# <azbridge> <GPS> $ wish8.4
# <azbridge> <GPS> % . config -cursor "@cursor.xbm orange"
. config -cursor "@/usr/share/doc/tk8.3/examples/images/flagdown.bmp orange"
. config -cursor "@/usr/X11R6/include/X11/bitmaps/card.xbm blue"
convert
#####
#
# toplevel
# 2005jan16
#
#####
* (eechannel-xterm "A")
* ;; (eechannel-kill "A")
wish
toplevel .t
wm withdraw .t
toplevel .t; wm geometry .t 100x200+10+20
wm withdraw .t
wm geometry .
-geometry +120+0-0-0
exit
# (find-man "3tk toplevel")
# (find-man "3tk wm")
# (find-man "3tk wm" "wm geometry window ?newGeometry?")
# http://www.tcl.tk/man/tcl8.4/
# http://www.tcl.tk/man/tcl8.4/TkCmd/toplevel.htm
#####
#
# text
# 2005jan16
#
#####
* (eechannel-xterm "A")
wish
set text .text
destroy $text
text .text \
-exportselection no \
-setgrid 1 \
-wrap word \
-width 12 \
-height 3
pack .text
$text configure -width 20
$text configure -font {Helvetica 12}
$text configure -font fixed
$text cget -font; # The default is "Courier -12". Why -12?
# Courier -12 and 12 are different!...
#
$text configure -font {Courier 12}
$text configure -font {Courier -12}
$text insert end "zero\n" song0
$text insert end "one\n" song1
$text insert end "two - this one is long and should be wrapped\n" song2
$text insert end "three\n" song3
$text insert end "four\n" song4
$text tag configure song2 -background yellow
$text tag configure song2 -background {}
$text see song0.first
$text see song4.first
$text see song2.first
$text see "song2.last - 1 char"
# (find-man "3tk text")
# (find-man "3tk text" "may not be deleted with")
# (find-man "3tk text" "pathName tag delete tagName ?tagName ...?")
# (find-man "3tk text" "tag.first")
# (find-man "3tk text" "pathName tag add tagName index1 ?index2")
# (find-man "3tk text" "pathName tag configure tagName ?option? ?value?")
# (find-man "3tk text" "pathName insert index chars ?tagList chars tagList ...?")
# (find-man "3tk text" "usual rules for geometry management")
#####
#
# listbox
# 2005jan16
#
#####
# (find-tkexfile "colors.tcl")
# (find-tkexfile "colors.tcl" "listbox $w.frame.list")
# (find-man "3tk listbox")
* (eechannel-xterm "A")
wish
listbox .list \
-exportselection no \
-setgrid 1 \
-selectforeground purple \
-selectbackground yellow
pack .list
set list .list
$list delete 0 end
$list insert 0 \
zero um dois tres quatro cinco seis sete oito nove \
dez onze doze "treze - esse tem um
texto comprido que vai forcar
line wrapping" quatorze
# (find-man "3tk listbox" "INDICES" "active")
# (find-man "3tk listbox" "pathName activate index")
# (find-man "3tk listbox" "pathName see index")
# (find-man "3tk listbox" "pathName selection set first ?last?")
# (find-man "3tk listbox" "pathName selection clear first ?last?")
proc listboxselect {listbox n} {
$listbox selection clear active
$listbox activate $n
$listbox see active
$listbox selection set active
}
listboxselect $list 0
listboxselect $list 1
listboxselect $list 9
listboxselect $list 10
listboxselect $list 11
listboxselect $list 12
listboxselect $list 13
listboxselect $list 14
listboxselect $list 0
# (find-man "3tk options" "exportselection")
# (find-man "xset")
# (find-man "3tk listbox")
# (find-man "3tk listbox" "If the Up or Down key is pressed")
# (find-man "3tk listbox" "pathName curselection")
# (find-man "3tk listbox" "pathName see index")
# (find-man "3tk listbox" "last element in the listbox")
# (find-man "3tk selection")
#####
#
# foreach
# 2005nov06
#
#####
# (find-man "3tcl foreach")
#*
expect -c 'foreach {a b} {a1 b1 a2 b2 a3 b3} c {c1 c2 c3} { puts "$a $b $c" }'
#*
#####
#
# pack
# 2012may02
#
#####
# «pack» (to ".pack")
# (find-books "__comp/__comp.el" "ousterhout")
# (find-tcltkpage (+ 16 189) "18.1 Packer basics\n")
# (find-tcltktext (+ 16 189) "18.1 Packer basics\n")
# (find-man "3tk pack" "\nEXAMPLE\n")
# (find-man "3tk pack")
# (find-man "3tk button")
# See: (find-es "tcl" "package-require-Tk")
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
* (ee-set-fullscreen nil)
* (size 150 56)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
wm geometry . 240x125+1000+50
button .a -text A
button .b -text B
pack .a
pack .b
pack slaves .
button .r -text R
pack .r -side right
pack .r -side left
pack slaves .
pack info .r
* (ee-set-fullscreen nil)
* (size 150 56)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
button .t -text T
button .b -text B
button .l -text L
button .r -text R
button .m -text M
pack .t -side top -fill x
pack .b -side bottom -fill x
pack .l -side left -fill y
pack .r -side right -fill y
pack .m -expand 1 -fill both
button .top -text Top
pack .top
label .t -text "This widget is at the top" -bg red
label .b -text "This widget is at the bottom" -bg green
label .l -text "Left\nHand\nSide"
label .r -text "Right\nHand\nSide"
text .mid
pack .t -side top -fill x
pack .b -side bottom -fill x
pack .l -side left -fill y
pack .r -side right -fill y
pack .mid -expand 1 -fill both
pack slaves .
pack info .t
pack info .b
pack info .l
pack info .r
pack info .mid
winfo children .
winfo screen .
.mid configure
.mid configure -width 20
winfo parent .mid
.mid foo
.mid window
.mid window foo
#####
#
# pack slaves
# 2007feb16
#
#####
# «pack-slaves» (to ".pack-slaves")
# (find-man "3tk pack" "\nEXAMPLE\n")
# (find-man "3tk pack")
# (find-tcltkpage (+ 16 189) "18.1 Packer basics\n")
# (find-tcltktext (+ 16 189) "18.1 Packer basics\n")
# (find-man "3tk winfo" "winfo children window")
# (find-man "3tk winfo" "winfo class window")
# (find-man "3tk pack" "pack slaves master")
# (find-man "3tk canvas")
# (find-man "3tk canvas" "pathName find searchCommand")
# (find-man "3tk canvas" "pathName addtag tag searchSpec" "all the items")
* (eepitch-wish)
* (ee-set-fullscreen nil)
* (size 150 56)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
label .t -text "This widget is at the top" -bg red
label .b -text "This widget is at the bottom" -bg green
label .l -text "Left\nHand\nSide"
label .r -text "Right\nHand\nSide"
text .mid
pack .t -side top -fill x
pack .b -side bottom -fill x
pack .l -side left -fill y
pack .r -side right -fill y
pack .mid -expand 1 -fill both
pack slaves .
pack info .t
pack info .b
pack info .l
pack info .r
pack info .mid
winfo children .
winfo screen .
.mid configure
.mid configure -width 20
winfo parent .mid
.mid foo
.mid window
.mid window foo
#####
#
# pack-2023
# 2023feb25
#
#####
# «pack-2023» (to ".pack-2023")
# (find-es "squeak" "non-openInWorld-able")
# (find-sshot-links "5" "2023-tk-pack")
# (find-man "3tk pack" "\nEXAMPLE\n")
# (find-man "3tk pack")
# (find-man "3tk frame")
# (find-man "3tk listbox")
# (find-man "3tk text")
# (find-man "3tk text" "pathName insert")
# (find-man "3tk pack" "pack slaves master")
# (find-tcltkpage (+ 16 189) "18.1 Packer basics\n")
# (find-tcltktext (+ 16 189) "18.1 Packer basics\n")
# (find-tcltkpage (+ 20 192) "Two invisible frame widgets")
# (find-tcltktext (+ 20 192) "Two invisible frame widgets")
* (ee-set-fullscreen nil)
* (size 150 56)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
frame .top
frame .bottom
text .textbox -width 10 -height 5
listbox .listbox -width 10 -height 5
button .button1 -text B1
button .button2 -text B2
button .button3 -text B3
.textbox insert end "Foo\nBar"
.listbox insert end "Item 1"
.listbox insert end "Item 2"
.listbox insert end "Item 3"
pack .top -side top
pack .bottom -side bottom -fill x -expand 1
pack .listbox -side left -in .top
pack .textbox -side right -in .top
pack .button1 -side left -in .bottom -fill x -expand 1
pack .button2 -side left -in .bottom -fill x -expand 1
pack .button3 -side left -in .bottom -fill x -expand 1
# (find-man "3tk text" "pathName insert")
listbox .lb
foreach o {{Item 1} {Item 2} {Item 3}} {
.lb insert end $o
}
label .l -text "Left\nHand\nSide"
label .r -text "Right\nHand\nSide"
button .b1 -text B1
button .b2 -text B2
button .b3 -text B3
pack .top -side top
pack .bottom -side bottom
pack .l -side left -in .top -fill x
pack .r -side right -in .top -fill x
pack .b1 -side left -in .bottom
pack .b2 -side left -in .bottom
pack .b3 -side left -in .bottom
pack [listbox .lb] -fill both
pack [text .txt] -fill both -expand 1
foreach o {{Item 1} {Item 2} {Item 3}} {
.lb insert end $o
}
.txt replace 1.0 end "Foo\nBar"
label .t -text "This widget is at the top" -bg red
label .b -text "This widget is at the bottom" -bg green
label .l -text "Left\nHand\nSide"
label .r -text "Right\nHand\nSide"
text .mid
pack .t -side top -fill x
pack .b -side bottom -fill x
pack .l -side left -fill y
pack .r -side right -fill y
pack .mid -expand 1 -fill both
#####
#
# grid-2023
# 2023mar17
#
#####
# «grid-2023» (to ".grid-2023")
# http://www.tcl-lang.org/man/tcl8.6/TkCmd/grid.htm#M29
#####
#
# drag
# 2007feb16
#
#####
# «drag» (to ".drag")
# (find-angg "LATEX/diaglib.014" "drag")
# (find-man "3tcl global")
# (find-man "3tk bind")
# (find-man "3tk bind" "%x, %y")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
canvas .c -width 200 -height 200
pack .c -expand yes -fill both
.c create text 100 100 -text abc -tag T
proc myputs {args} { puts $args }
.c bind T <1> "myputs T <1> %x %y"
.c bind T <B1-Motion> "myputs T <B1-Motion> %x %y"
.c bind T
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
canvas .c -width 200 -height 200
pack .c -expand yes -fill both
.c create text 100 100 -text abc -tag T
proc dragx {x} { global oldx; set prevx $oldx; set oldx $x; expr $x-$prevx }
proc dragy {y} { global oldy; set prevy $oldy; set oldy $y; expr $y-$prevy }
.c bind T <1> {set oldx %x; set oldy %y}
.c bind T <B1-Motion> {.c move T [dragx %x] [dragy %y]}
.c bind T
# (find-man "3tk bind")
# (find-man "3tk bind" "KeyRelease")
# (find-man "3tk event")
# (find-man "3tk keysyms")
# Is it possible to bind an event to key-release? (for piano.tcl)
# Yes:
* (eepitch-wish)
proc myputs {args} { puts $args }
bind . <KeyPress-d> "myputs T <kp-d> %x %y"
bind . <KeyRelease-d> "myputs T <kr-d> %x %y"
bind .
# Oops, repetition generates fake releases
#####
#
# dragTs
# 2007feb19
#
#####
# «dragTs» (to ".dragTs")
# (find-angg "TCL/dragTs.tcl")
# An example:
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
source $env(HOME)/TCL/dragTs.tcl ;# (find-angg "TCL/dragTs.tcl")
canvas .c -width 200 -height 200
pack .c -expand yes -fill both
.c configure -width 255
.c configure -height 500
set n 0; set placex 20; set placey 20
set n 0
T 20 51 {quinta 22:}
T 20 62 {pegar B.O.}
T 20 20 { }
T 20 84 sexta:
T 20 93 {aula da valeria}
T 20 31 { }
T 22 126 {baixar formulario da Karen}
T 21 138 {preencher / imprimir}
T 23 151 {British council}
T 20 42 { }
T 171 38 Halloween:
T 173 49 __add
T 173 64 Polys
T 173 76 {Newton (getx)}
T 172 85 getxs
T 173 97 gnuplot
writeTs ;# (find-fline "/tmp/Ts")
#####
#
# prompts
# 2007feb17
#
#####
# «prompts» (to ".prompts")
# (find-angg ".tclshrc" "prompts")
# (find-efile "progmodes/tcl.el")
# (find-efile "progmodes/tcl.el" "defcustom inferior-tcl-source-command")
# ^ why doesn't tcl-mode blah bother with this?
<edrx> I've just started to use Tcl interactively inside shell buffers
in Emacs (actually "comint" buffers) and I realized that Tcl's
"PS1" prompt is "% ", and "PS2" prompt is "" - and PS2 being ""
confuses comint, it thinks that it should wait more until it
gets a prompt again... as a quick-and-dirty hack around that I
could try to change Tcl's PS2 to, say, "%% ", until I learn
more about comint, but how do I do that? :-|
# (find-man "1 tclsh" "PROMPTS")
# (find-man "1 wish" "PROMPTS")
<ijchain> <dkf_> set tcl_prompt2 {puts -nonewline "> "}
<ijchain> <dkf_> there's also a tcl_prompt1 if you don't like the % ;)
* (eepitch-tclsh)
proc foo {} {
bar
}
#####
#
# snack
# 2007feb17 / 2012nov26
#
#####
# «snack» (to ".snack")
# «piano.tcl» (to ".piano.tcl")
# (find-angg "TCL/piano.tcl")
# Snack: http://wiki.tcl.tk/2647
# A toy piano: http://wiki.tcl.tk/3948
# Category Sound: http://wiki.tcl.tk/10057
# Reanimation of Snack: http://wiki.tcl.tk/21123
# http://www.speech.kth.se/snack/
# (find-status "libsnack2")
# (find-vldifile "libsnack2.list")
# (find-udfile "libsnack2/")
# (find-status "libsnack2-doc")
# (find-vldifile "libsnack2-doc.list")
# (find-udfile "libsnack2-doc/")
# (find-udfile "libsnack2-doc/examples/tcl/")
# (find-udfile "libsnack2-doc/examples/tcl/generator.tcl")
# (find-fline "/usr/lib/tcltk/snack2.2/snack.tcl")
# (find-fline "/usr/lib/tcltk/snack2.2/pkgIndex.tcl")
# (find-udfile "libsnack2-doc/html/")
# file:///usr/share/doc/libsnack2-doc/html/tcl-man.html
(code-c-d "snackexamples" "/usr/share/doc/libsnack2-doc/examples/tcl/")
# (find-snackexamplesfile "")
# (find-snackexamplesfile "tcl-demos.txt")
# (find-snackexamplessh0 "./widget.tcl")
# (find-snackexamplessh0 "wish formant.tcl")
# http://wiki.tcl.tk/10159
# (find-angg "TCL/piano.tcl")
# (find-man "3tcl namespace")
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package require sound
proc playwav {myWavFile} {
snack::sound s -file $myWavFile
s play -block 1
}
playwav /sda6/CDs/HILSINGER-BEATTY/track01.cdda.wav
playwav c:/path/to/wavfile.wav
# (find-sh "locate wav | grep 'wav$'")
#####
#
# snack-upstream
# 2007feb18
#
#####
# «snack-upstream» (to ".snack-upstream")
# http://www.speech.kth.se/snack/dist/snack2.2.10.tar.gz
# Ooops, how do I install this?...
#*
rm -Rv ~/usrc/snack2.2.10/
tar -C ~/usrc/ -xvzf \
$S/http/www.speech.kth.se/snack/dist/snack2.2.10.tar.gz
cd ~/usrc/snack2.2.10/
# (find-fline "/usr/lib/tcl8.4/tclConfig.sh")
# (find-fline "/usr/lib/tk8.4/tclConfig.sh")
cd ~/usrc/snack2.2.10/unix/
./configure \
--with-tcl=/usr/lib/tcl8.4/ \
--with-tk=/usr/lib/tk8.4/ \
|& tee oc
make |& tee om
#*
cd ~/usrc/snack2.2.10/unix/
export TCLLIBPATH=$PWD
make test
#*
# (code-c-d "snack" "~/usrc/snack2.2.10/" :grep)
# (find-snackfile "")
# (find-snackfile "README")
# (find-snackfile "README" "snack2.2.10/unix")
# (find-snackfile "README" "\nTesting\n")
# (find-snackfile "unix/")
# (find-snackfile "unix/oc")
# (find-snackfile "unix/pkgIndex.tcl")
# (find-man "3tcl package")
# (find-man "3tcl package" "pkg_mkIndex")
# (find-snackgrep "grep -niH -e tcl $(find * -name '*.c') | head -n 200")
# (find-snackgrep "grep -niH -e SectionToPS $(find * -name '*.c') | head -n 200")
#####
#
# vkeybd
# 2007feb18
#
#####
# «vkeybd» (to ".vkeybd")
# This thing seems to be able to distinguish between real keypresse /
# keyrelease events and "fake" ones coming from autorepeat... but how
# does it do that?
# http://ftp.debian.org/debian/pool/main/v/vkeybd/
# http://ftp.debian.org/debian/pool/main/v/vkeybd/vkeybd_0.1.17-3.dsc
# http://ftp.debian.org/debian/pool/main/v/vkeybd/vkeybd_0.1.17-3.diff.gz
# http://ftp.debian.org/debian/pool/main/v/vkeybd/vkeybd_0.1.17.orig.tar.gz
#*
rm -Rv ~/usrc/vkeybd/
mkdir ~/usrc/vkeybd/
cd $S/http/ftp.debian.org/debian/pool/main/v/vkeybd/
cp -v vkeybd_0.1.17* ~/usrc/vkeybd/
cd ~/usrc/vkeybd/
dpkg-source -sn -x vkeybd_0.1.17-3.dsc
cd ~/usrc/vkeybd/vkeybd-0.1.17/
dpkg-buildpackage -us -uc -b -rfakeroot |& tee odb
#*
cd ~/usrc/vkeybd/
sudo dpkg -i vkeybd_0.1.17-3_i386.deb
#*
# (code-c-d "vkeybd" "~/usrc/vkeybd/vkeybd-0.1.17/")
# (find-vkeybdfile "")
# (find-status "vkeybd")
# (find-vldifile "vkeybd.list")
# (find-udfile "vkeybd/")
# (find-man "1 xset" "autorepeat")
# http://lists.debian.org/debian-user/2006/03/msg01449.html
sudo modprobe snd_seq
vkeybd
# Remark: even with modporbe snd_seq I still get no sound...
#*
# (find-fline "/usr/share/vkeybd/vkeybd.tcl")
# (find-fline "/usr/share/vkeybd/vkeybd.tcl" "filter autorepeats")
# (find-fline "/usr/share/vkeybd/vkeybd.list")
# (find-fline "/usr/share/vkeybd/vkeybdmap")
# (find-fline "/usr/share/vkeybd/vkeybdmap-german")
# (find-udfile "vkeybd/README.gz")
# (find-udfile "vkeybd/README.gz" "--seqdev file")
# (find-udfile "vkeybd/changelog.Debian.gz")
#####
#
# httpwiki
# 2007feb18
#
#####
# «httpwiki» (to ".httpwiki")
# (find-anggfile "TCL/httpwiki")
# (find-angg ".emacs" "wikit-edit")
* (eepitch-tclsh)
package require http 1.0
set wikiurl http://wiki.tcl.tk/edit
# set N 33
set N 627
set s [http_data [http_get $wikiurl/${N}@]]
regexp "<textarea \[^\n>\]*>(.*)</textarea>" $s -> text
puts $text
regsub -all {\"} $text "\"" text
regsub -all {\<} $text {<} text
regsub -all {\>} $text {>} text
regsub -all {\&} $text {&} text
puts $text
#####
#
# itcl / iwidgets
# 2007feb18
#
#####
* (eepitch-shell)
# (find-fline "/usr/lib/iwidgets4.0.1/demos/")
# (find-fline "/usr/lib/iwidgets4.0.1/demos/html/")
cd /usr/lib/iwidgets4.0.1/demos/
ls
wish notebook
wish spinner
wish shell
# (find-dmissing "iwidgets")
# (find-status "iwidgets4")
# (find-vldifile "iwidgets4.list")
# (find-udfile "iwidgets4/")
# (find-status "iwidgets4-doc")
# (find-vldifile "iwidgets4-doc.list")
# (find-udfile "iwidgets4-doc/")
# (find-status "itcl3")
# (find-vldifile "itcl3.list")
# (find-udfile "itcl3/")
# (find-status "itk3")
# (find-vldifile "itk3.list")
# (find-udfile "itk3/")
#####
#
# pkgIndex.tcl
# 2007feb18
#
#####
# «pkgIndex.tcl» (to ".pkgIndex.tcl")
# (to "cgi.tcl:pkgIndex.tcl")
# (find-dmissing "pkgIndex.tcl")
#####
#
# tk_chooseColor
# 2007apr22
#
#####
# «tk_chooseColor» (to ".tk_chooseColor")
# (find-angg ".emacs" "ee-choosecolor")
# (find-vldifile "tk8.4.list")
# (find-vldifile "tk8.4-doc.list")
# (find-sh "grep -i color /var/lib/dpkg/info/tk8.4-doc.list")
# (find-man "3tk tk_chooseColor")
# (find-fline "/usr/lib/tk8.4/tk.tcl" "proc ::tk_chooseColor")
# (find-fline "/usr/lib/tk8.4/clrpick.tcl")
# (find-man "3tk tk_chooseColor")
# (find-zsh0 "wish <<<'puts [tk_chooseColor -initialcolor gray]; exit'")
(defun ee-choosecolor (&optional initialcolor)
(find-zsh0 (format "wish <<<'puts [tk_chooseColor -initialcolor %s]; exit'"
(or initialcolor "gray"))))
(insert (ee-choosecolor))
#be3b44
#####
#
# luatclbridge (the problem with "package")
# 2007may21
#
#####
# «luatclbridge» (to ".luatclbridge")
# (find-es "lua5" "luatclbridge")
# (find-fline "~/LOGS/2007may20.tcl")
# «tcl8.4-deb-src» (to ".tcl8.4-deb-src")
# (find-angg ".zshrc" "tcl-tk")
# http://ftp.debian.org/debian/pool/main/t/tcl8.4/
# http://ftp.debian.org/debian/pool/main/t/tcl8.4/tcl8.4_8.4.12-1.1.dsc
# http://ftp.debian.org/debian/pool/main/t/tcl8.4/tcl8.4_8.4.12-1.1.diff.gz
# http://ftp.debian.org/debian/pool/main/t/tcl8.4/tcl8.4_8.4.12.orig.tar.gz
#*
rm -Rv ~/usrc/tcl8.4/
mkdir ~/usrc/tcl8.4/
cd $S/http/ftp.debian.org/debian/pool/main/t/tcl8.4/
cp -v tcl8.4_8.4.12* ~/usrc/tcl8.4/
cd ~/usrc/tcl8.4/
dpkg-source -sn -x tcl8.4_8.4.12-1.1.dsc
cd ~/usrc/tcl8.4/tcl8.4-8.4.12/
dpkg-buildpackage -us -uc -b -rfakeroot |& tee odb
# (find-tcl84sh "cd unix/; objdump -xasf tclsh" "NEEDED")
cd ~/usrc/tcl8.4/tcl8.4-8.4.12/unix/
cp -siv libtcl8.4.so libtcl8.4.so.0
cd ~/usrc/tcl8.4/tcl8.4-8.4.12/
find * -type f | sort > .files
find * -name '*.[ch]' | sort > .files.ch
etags $(cat .files.ch)
#*
# (code-c-d "tcl84" "~/usrc/tcl8.4/tcl8.4-8.4.12/" :grep)
# (find-tcl84file "")
# (find-tcl84tag "Tcl_FindExecutable")
# (find-tcl84file "generic/tclEncoding.c" "Tcl_FindExecutable(argv0)")
# (find-tcl84grep "grep -nH -e Tcl_FindExecutable $(cat .files.ch)")
# (find-tcl84grep "grep -nH -e Tcl_CreateInterp $(cat .files.ch)")
# (find-tcl84grep "grep -nH -e Tcl_Main $(cat .files.ch)")
# http://www.tcl.tk/cgi-bin/tct/tip/66
# (find-tcl84file "odb" "-o tclsh")
# (find-tcl84file "unix/tclAppInit.c" "Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);")
# (find-tcl84file "generic/tclMain.c" "Tcl_FindExecutable(argv[0]);")
# (find-tcl84file "generic/tclMain.c" "interp = Tcl_CreateInterp();")
# (find-tcl84file "generic/tclBasic.c" "Tcl_CreateInterp()")
# (find-angg "LUA/luatclbridge.c")
<edrx> I'm writing a bridge between Lua and Tcl, initialized from the
Lua side - http://angg.twu.net/LUA/luatclbridge.c.html -, and
I'm starting the Tcl interpreter in the simplest way possible,
with just a Tcl_CreateInterp()... everything is working but
"package" is not happy
<ijchain> <arjen> edrx, you might want to consult
http://www.tcl.tk/cgi-bin/tct/tip/66
<ijchain> <GPS> edrx: call Tcl_FindExecutable() before
Tcl_CreateInterp() and it may work
# (find-man "3 Tcl_FindExecutable")
# (find-man "3 Tcl_Init")
# (find-man "3tcl Tcl_Init")
# (find-man "3tcl Tcl_Init")
<edrx> I am grepping the source, trying to find where tclsh calls
Tcl_FindExecutable()... pointers welcome :-\
<ijchain> <dkf> tclsh doesn't
<ijchain> <dkf> it calls Tcl_Main
<ijchain> <dkf> and Tcl_Main calls Tcl_FindExecutable internally
#####
#
# tk8.4 from the debian sources
# 2007jul24
#
#####
# «tk8.4-deb-src» (to ".tk8.4-deb-src")
# (find-angg ".zshrc" "tcl-tk")
# http://ftp.debian.org/debian/pool/main/t/tk8.4/
# http://ftp.debian.org/debian/pool/main/t/tk8.4/tk8.4_8.4.12-1.dsc
# http://ftp.debian.org/debian/pool/main/t/tk8.4/tk8.4_8.4.12-1.diff.gz
# http://ftp.debian.org/debian/pool/main/t/tk8.4/tk8.4_8.4.12.orig.tar.gz
#*
rm -Rv ~/usrc/tk8.4/
mkdir ~/usrc/tk8.4/
cd $S/http/ftp.debian.org/debian/pool/main/t/tk8.4/
cp -v tk8.4_8.4.12* ~/usrc/tk8.4/
cd ~/usrc/tk8.4/
dpkg-source -sn -x tk8.4_8.4.12-1.dsc
cd ~/usrc/tk8.4/tk8.4-8.4.12/
dpkg-buildpackage -us -uc -b -rfakeroot |& tee odb
# (find-tk84sh "cd unix/; objdump -xasf wish" "NEEDED")
cd ~/usrc/tk8.4/tk8.4-8.4.12/unix/
cp -siv libtk8.4.so libtk8.4.so.0
cd ~/usrc/tk8.4/tk8.4-8.4.12/
find * -type f | sort > .files
find * -name '*.[ch]' | sort > .files.ch
etags $(cat .files.ch)
#*
# (code-c-d "tk84" "~/usrc/tk8.4/tk8.4-8.4.12/" :grep)
# (find-tk84file "")
# «wish-event-loop» (to ".wish-event-loop")
# (find-es "davinci" "wish-event-loop")
# The source code for wish is at tkAppInit.c.
# (find-tk84file ".files" "unix/wish")
# (find-tk84file "unix/Makefile" "\nwish:")
# (find-tk84file "odb" "-o wish")
# (find-tk84file "unix/tkAppInit.c")
# Here's why I'm looking for this: wish is able to handle Tk windows
# (and their event loops), and an interactive prompt in a terminal
# (readline?), and a signal handler (as in tcmd.tcl), plus, probably,
# sockets... how does it do that? I need to implement something like
# that for IupLua...
# (find-man "2 select")
# (find-man "3 ConnectionNumber")
# (find-fline "~/LOGS/2007jul25.tcl")
# (find-tk84grep "grep -nH -e ConnectionNumber $(cat .files.ch)")
#####
#
# tkwait
# 2007aug14
#
#####
# «tkwait» (to ".tkwait")
# (find-man "3tk tkwait")
# (find-man "3tcl vwait")
# (find-tk84file "")
# (find-tk84grep "grep -nH -e tkwait $(cat .files.ch)")
# (find-tk84tag "Tk_TkwaitObjCmd")
* (fvwm-click-to-focus)
* (fvwm-sloppy-focus)
* (eepitch-kill)
* (eepitch-tclsh)
package require Tk
button .b -text 2 -command { .b configure -text [expr [.b cget -text]+1] }
button .q -text quit -command "destroy ."
pack .b .q
toplevel .w
button .w.b -text 2 -command { .w.b configure -text [expr [.w.b cget -text]+1] }
button .w.q -text quit -command "destroy .w"
pack .w.b .w.q
tkwait window .w
expr 1+2
exit
destroy .b
destroy .q
# destroy .
# toplevel .
# can't invoke "toplevel" command: application has been destroyed
#####
#
# the text widget
# 2007jun26
#
#####
# «text-widget» (to ".text-widget")
# (find-sh "locate examples/widget")
# (code-c-d "tkex" "/usr/share/doc/tk8.4/examples/" :grep)
# (find-tkexfile "widget")
# (find-tkexgrep "grep -nH -e 'See Code' *")
# (find-tkexgrep "grep -nH -e showCode *")
# (find-tkexfile "widget" "proc showCode")
# (find-bgprocess "wish /usr/share/doc/tk8.4/examples/widget")
#*
cat > /tmp/eeglib.tcl <<'%%%'
# (find-eevfile "eegchannel")
proc readfile {fname} {
set ch [open $fname r]; set str [read $ch]; close $ch; return $str
}
proc writefile {fname str} {
set ch [open $fname w]; puts -nonewline $ch $str; close $ch
}
proc getenv {key {defaultvalue {}}} {
global env; expr {[info exist env($key)]?$env($key):$defaultvalue}
}
proc EEVTMPDIR {} { getenv EEVTMPDIR [getenv HOME]/eev-current/tmp }
proc rmlastnewline {str} { regexp "^(.*)\n\$" $str -> str; return $str }
proc pidfile {} { global channel; return [EEVTMPDIR]/eeg.${channel}.pid }
proc strfile {} { global channel; return [EEVTMPDIR]/eeg.${channel}.str }
proc codefile {} { global channel; return [EEVTMPDIR]/eeg.${channel}.code }
%%%
#*
* (eepitch-expect)
source /tmp/eeglib.tcl
set channel gnuplot
writefile [pidfile] "[pid]\n"
trap {send -- [readfile [strfile]]} USR1
trap {eval [readfile [codefile]]} USR2
package require Tk
canvas .c -background sienna4
pack .c -expand yes -fill both
.c create line 10 20 30 50
# (find-man "3tk text")
# (find-man "3tk text" "\nTAGS\n")
# (find-man "3tk text" "line.char")
# (find-man "3tk text" "pathName tag delete tagName ?tagName ...?")
spawn gnuplot
interact
expect -e
set channel [lindex $argv 0]; # first argument
set argv [lrange $argv 1 end]; # discard first argument
writefile [pidfile] "[pid]\n"
trap {send -- [readfile [strfile]]} USR1
#####
#
# saving screenshots
# 2008feb07
#
#####
# «Img-screenshots» (to ".Img-screenshots")
# (find-status "libtk-img")
# (find-vldifile "libtk-img.list")
# (find-udfile "libtk-img/")
# (find-status "libtk-img-doc")
# (find-vldifile "libtk-img-doc.list")
# (find-udfile "libtk-img-doc/")
# (find-fline "/usr/share/doc/libtk-img-doc/examples/")
# (find-bgprocess "/usr/share/doc/libtk-img-doc/examples/demo.tcl")
# (find-bgprocess "/usr/share/doc/libtk-img-doc/examples/tkv.tcl")
# (find-man "3tk image")
# (find-man "3tk photo")
# (find-man "3tk photo" "imageName copy sourceImage")
# (find-man "3tk img-gif")
# (find-man "3tk img-ico")
# (find-man "3tk img-intro")
# (find-man "3tk img-jpeg")
# (find-man "3tk img-pcx")
# (find-man "3tk img-pixmap")
# (find-man "3tk img-png")
# (find-man "3tk img-ppm")
# (find-man "3tk img-ps")
# (find-man "3tk img-sgi")
# (find-man "3tk img-sun")
# (find-man "3tk img-tga")
# (find-man "3tk img-tiff")
# (find-man "3tk img-window")
# (find-man "3tk img-xbm")
# (find-man "3tk img-xpm")
# (find-udfile "libtk-img/html/")
# (find-udw3m "libtk-img/html/index.htm")
# (find-udfile "libtk-img/html/img-pixmap.man")
# (find-sh0 "rm -v /tmp/myfile.png")
# (find-fline "/tmp/myfile.png")
* (eepitch-wish)
* (eepitch-kill)
* (fvwm-sloppy-focus)
* (eepitch-wish)
* (fvwm-click-to-focus)
canvas .c -width 400 -height 350 -relief flat
pack .c -expand yes -fill both -side top
package require Img
.c create line 100 100 200 232
set im [image create photo -data .c]
$im write /tmp/myfile.png -format PNG
# (find-fline "/tmp/myfile.png")
# Adding an modifying a text item:
set t [.c create text 200 100 -text "abc\ndefgh"]
puts $t
.c itemconfigure $t -text "foo\nbar\nplicplic" -justify center
.c itemconfigure $t -text "bar\nplicplic" -justify center
.c itemconfigure $t -text "bar\nplicplic" -justify center -font 5x8 -fill sienna
.c delete all
# (find-man "3tk canvas")
# (find-man "3tk canvas" "pathName create type")
# (find-man "3tk canvas" "\nTEXT ITEMS\n")
#####
#
# zgrepping the tk docs
# 2008feb07
#
#####
# «zgrep-tk-docs» (to ".zgrep-tk-docs")
# (find-status "tk8.4-doc")
# (find-vldifile "tk8.4-doc.list")
# (find-udfile "tk8.4-doc/")
# (find-vldish "cat tk8.4-doc.list | grep man3/ | sort")
# (find-vldish "zgrep -i relief $(cat tk8.4-doc.list | grep man3/ | sort)")
# (find-vldish "zgrep '\\-relief' $(cat tk8.4-doc.list | grep man3/ | sort)")
# (find-man "3tk options")
# (find-man "3tk options" "-relief")
#####
#
# wm geometry
# 2009may03
#
#####
# «wm-geometry» (to ".wm-geometry")
# «package-require-Tk» (to ".package-require-Tk")
# https://wiki.tcl-lang.org/page/tclsh+vs.+wish
#
# (find-angg ".tclshrc" "package-require-Tk")
# (find-angg ".emacs" "size" "Tk")
* (toggle-frame-fullscreen)
* (size 164 56)
# <edrx> I can tell Tk to open its toplevel window at a certain
# position by invoking wish with a "-geometry" parameter, like
# this: "wish -geometry +700+0"
# <edrx> is there a way to set a preferred geometry for Tk from
# tclsh? I mean, by running something before a "package
# require Tk" in tclsh?
# <ijchain> <stevel> just "wm withdraw ." immediately after "package
# require Tk", then set the geom then deiconify it
# <edrx> hm, like what is done in ::tk::PlaceWindow in
# /usr/share/tcltk/tk8.5/tk.tcl?... lemme try, one min...
# <edrx> stevel: perfect, thanks! 8-)
# <ijchain> <stevel> np
# (find-fline "/usr/share/tcltk/tk8.5/tk.tcl")
# (find-fline "/usr/share/tcltk/tk8.5/tk.tcl" "wm geometry $w +$x+$y")
# (find-man "3tk wm")
# (find-man "3tk wm" "wm withdraw window")
# (find-man "3tk wm" "wm geometry window ?newGeometry?")
# (find-man "3tk wm" "wm deiconify")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
* (fvwm-sloppy-focus)
wish
exit
wish -geometry +700+0
exit
tclsh
package require Tk
wm withdraw .
wm geometry . +700+0
wm deiconify .
exit
* (fvwm-click-to-focus)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk-with-geometry +1010+0
#####
#
# tkdiff (2018)
# 2018dec04
#
#####
# «tkdiff» (to ".tkdiff")
# https://tkcvs.sourceforge.io/
# https://sourceforge.net/projects/tkcvs/
# (find-status "tkcvs")
# (find-vldifile "tkcvs.list")
# (find-udfile "tkcvs/")
# (find-man "1 tkdiff")
# (find-fline "/usr/bin/tkdiff")
# (find-fline "/usr/bin/tkdiff" "# Help menu")
# (find-fline "/usr/bin/tkdiff" "proc do-help {}")
# (find-fline "/usr/share/tkcvs/")
# https://sourceforge.net/projects/tkcvs/files/tkcvs_9.2.3.tar.gz/download
# https://sourceforge.net/projects/tkcvs/files/tkcvs_9.2.3.tar.gz
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rv ~/usrc/tkcvs_9.2.3/
mkdir ~/usrc/tkcvs_9.2.3/
# tar -C ~/usrc/ -xvzf /tmp/tkcvs_9.2.3.tar.gz
tar -C ~/usrc/ -xvzf $S/https/sourceforge.net/projects/tkcvs/files/tkcvs_9.2.3.tar.gz
cd ~/usrc/tkcvs_9.2.3/
# (find-fline "~/usrc/tkcvs_9.2.3/")
#####
#
# tkdiff-help
# 2023dec23
#
#####
# «tkdiff-help» (to ".tkdiff-help")
# (find-fline "/usr/bin/tkdiff" "# Help menu")
# (find-fline "/usr/bin/tkdiff" "proc do-help {}")
# (find-angg ".tkdiffrc")
#####
#
# tkdiff-merge
# 2023dec23
#
#####
# «tkdiff-merge» (to ".tkdiff-merge")
# (find-tkdiff "~/LUA/Repl1.lua" "~/emlua/Repl1.lua")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rfv /tmp/a/ /tmp/b/
mkdir /tmp/a/ /tmp/b/
cp -v ~/LUA/Repl1.lua /tmp/a/
cp -v ~/emlua/Repl1.lua /tmp/b/
# (find-tkdiff "/tmp/a/Repl1.lua" "/tmp/b/Repl1.lua")
# (find-fline "/tmp/a")
cd /tmp/a
# (find-fline "/tmp/b")
rm -Rv /tmp/b
mkdir /tmp/b
cd /tmp/b
#####
#
# tkdiff (from the debian sources)
# 2010sep28
#
#####
# «tkdiff-deb-src» (to ".tkdiff-deb-src")
# (find-status "tkdiff")
# (find-vldifile "tkdiff.list")
# (find-udfile "tkdiff/")
# (find-man "1 tkdiff")
# (find-fline "/usr/bin/tkdiff")
# http://tkdiff.sourceforge.net/
# http://sourceforge.net/projects/tkdiff/
# http://ftp.debian.org/debian/pool/main/t/tkdiff/
# http://ftp.debian.org/debian/pool/main/t/tkdiff/tkdiff_4.1.4-1.dsc
# http://ftp.debian.org/debian/pool/main/t/tkdiff/tkdiff_4.1.4-1.diff.gz
# http://ftp.debian.org/debian/pool/main/t/tkdiff/tkdiff_4.1.4.orig.tar.gz
#*
rm -Rv ~/usrc/tkdiff/
mkdir ~/usrc/tkdiff/
cd $S/http/ftp.debian.org/debian/pool/main/t/tkdiff/
cp -v tkdiff_4.1.4* ~/usrc/tkdiff/
cd ~/usrc/tkdiff/
dpkg-source -sn -x tkdiff_4.1.4-1.dsc
cd ~/usrc/tkdiff/tkdiff-4.1.4/
dpkg-buildpackage -us -uc -b -rfakeroot |& tee odb
#*
# (find-fline "~/usrc/tkdiff/")
* (eepitch-shell)
cd ~/usrc/tkdiff/
sudo dpkg -i *.deb
#*
# (code-c-d "tkdiff" "~/usrc/tkdiff/tkdiff-4.1.4/")
# (find-tkdifffile "")
# (find-tkdifffile "debian/")
# (find-tkdifffile "debian/tkdiff.desktop")
# (find-tkdifffile "debian/rules")
#####
#
# bibtex
# 2011feb13
#
#####
# «bibtex» (to ".bibtex")
# (find-es "lua5" "ltcl")
# (find-status "tcllib")
# (find-vldifile "tcllib.list")
# (find-udfile "tcllib/")
# (find-udfile "tcllib/examples/bibtex/bibtex.tcl")
# (find-man "3tcl bibtex")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
userocks()
tcl = require("ltcl").new()
tcl:call("package", "require", "bibtex")
mybibtexstr = readfile(ee_expand("~/LATEX/catsem.bib"))
bibtable = tcl:call("::bibtex::parse", mybibtexstr)
PP(bibtable)
#####
#
# TclMagick
# 2010dec12
#
#####
# «tclmagick» (to ".tclmagick")
# «tclmagick-build» (to ".tclmagick-build")
# (find-es "imagemagick" "tclmagick")
# http://tclmagick.sourceforge.net/
# http://tclmagick.sourceforge.net/TclMagick.html
# http://tclmagick.sourceforge.net/TkMagick.html
# http://www.imagemagick.org/www/api.html
# (find-angg "TCL/tclmagick-patch.sh")
# (find-TH "tclmagick")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
#*
# (eev-bounded)
# The slow part of the build:
# Download the cvs version (and make a tarball from it)
rm -Rv ~/usrc/TclMagick/
cd ~/usrc/
cvs -d:pserver:anonymous@cvs.graphicsmagick.org:/GraphicsMagick login
cvs -d:pserver:anonymous@cvs.graphicsmagick.org:/GraphicsMagick co TclMagick
tar -cvzf ~/tmp/tclmagick-cvs.tgz TclMagick/
# Run autoreconf (and make a tarball from it afterwards)
rm -Rv ~/usrc/TclMagick/
tar -C ~/usrc/ -xvzf ~/tmp/tclmagick-cvs.tgz
cd ~/usrc/TclMagick/
autoreconf
cd ~/usrc/
tar -cvzf ~/tmp/tclmagick-cvs-a.tgz TclMagick/
#*
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
#*
# (eev-bounded)
# «tclmagick-build2» (to ".tclmagick-build2")
# The personalized part of the build.
# Unpack the post-autoreconf tarball,
# and delete the previous .deb:
rm -Rv ~/usrc/TclMagick/
tar -C ~/usrc/ -xvzf ~/tmp/tclmagick-cvs-a.tgz
cd ~/usrc/TclMagick/
rm -v ~/usrc/tclmagick_0.45-1_i386.changes
rm -v ~/usrc/tclmagick_0.45-1_i386.deb
# (find-TH "tclmagick")
# (find-angg "TCL/tclmagick-patch.sh")
# Patch and build.
# «tclmagick-buildlogs» (to ".tclmagick-buildlogs")
. ~/TCL/tclmagick-patch.sh | tee opatch
dpkg-buildpackage -us -uc -b -rfakeroot |& tee odrb
ldd debian/tclmagick/usr/lib/TclMagick0.45/libTclMagick.so |& tee oldd-tclmagick
ldd debian/tclmagick/usr/lib/TclMagick0.45/libTkMagick.so |& tee oldd-tkmagick
# More info that may be relevant to the upstream maintainers...
# (find-other-debian-links "magick")
# (find-angg ".zshrc" "installeddebs")
# (find-zsh "installeddebs | sort | egrep 'tcl|tk|magick' | grep -v gtk")
installeddebs | sort | egrep 'tcl|tk|magick' | grep -v gtk |& tee oinstdebs
tar -cvzf /tmp/debian-tclmagick-build-info.tgz config.log config.status o*
#*
# (find-status "tclmagick")
# (find-vldifile "tclmagick.list")
# (find-udfile "tclmagick/")
sudo dpkg -i ~/usrc/tclmagick_0.45-1_i386.deb
#*
# (find-tclmagickfile "")
# (find-tclmagickfile "opatch")
# (find-tclmagickfile "odrb")
# (find-tclmagickfile "oldd-tclmagick")
# (find-tclmagickfile "oldd-tkmagick")
# (find-tclmagickfile "oinstdebs")
# (find-tclmagickfile "debian/tclmagick/usr/lib/TclMagick0.45/")
# (find-tclmagicksh "cd debian/tclmagick/ && find * | sort")
#*
# These links were useful while I was writing the patches...
# (find-tclmagickfile "debian/")
# (find-tclmagickfile "debian/rules")
# (find-tclmagickfile "debian/control")
# (find-tclmagickfile "tests/")
# (find-tclmagickfile "tests/test-wand.tcl")
# (find-tclmagickfile "tests/test-wand.tcl" "MontageImage")
# (find-tclmagickfile "tests/test-wand.tcl" "proc MontageImage")
# (kill-new "--with-tkinclude=/usr/include/tk/")
# (find-tclmagickfile "debian/rules" "include/tcl$(TCLVERSION)/")
# (find-tclmagickfile "debian/control" "Build-Depends:")
# (find-tclmagickfile "debian/")
#####
#
# TclMagick: running the tests
# 2010dec15
#
#####
# «tclmagick-tests» (to ".tclmagick-tests")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
cd ~/usrc/TclMagick/tests/
laf
tclsh test-bmp-compare.tcl
tclsh test-draw.tcl
tclsh test-pixel.tcl
tclsh test-wand.tcl
tclsh tkmagick.tcl
laf
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
cd ~/usrc/TclMagick/tests/
nice tclsh test-wand.tcl
# (find-tclmagickfile "")
# (find-tclmagickfile "generic/")
# (find-tclmagickfile "generic/TclMagick.c")
# (find-tclmagickfile "generic/TkMagick.c")
#####
#
# TclMagick: using
# 2010dec15
#
#####
# «tclmagick-using» (to ".tclmagick-using")
# (find-tclmagicksh "find * | sort")
# (find-tclmagickfile "tmp/")
# (find-tclmagickfile "tmp/x-Draw.jpg")
# (find-tclmagickfile "tests/")
# (find-tclmagickfile "tests/test-wand.tcl")
# (find-tclmagickfile "tests/test-wand.tcl" "# Prepare tests")
# (find-tclmagickfile "tests/test-wand.tcl" "$draw Rectangle")
# (find-sh0 "cp -v ~/SCANS/caderno4/C2_VR_2010dec10_2.jpg /tmp/orig.jpg")
# (find-sh0 "cp -v ~/IMAGES/logo_ict_martelo.png /tmp/orig.png")
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
set tcl_prompt2 {puts -nonewline "> "}
# (find-tclmagickfile "tests/test-wand.tcl")
package require TclMagick
package require TkMagick
proc debugLeave {cmdstr code result op} {
puts [format " %s ==>{%s}" [string range $cmdstr 0 50] [string range $result 0 50]]
update
}
proc debug {args} {
foreach cmdMask $args {
foreach cmd [info commands $cmdMask] {
trace add execution $cmd leave debugLeave
}
}
}
debug magick
set img [magick create wand img0]
$img ReadImage "/tmp/orig.png"
$img width
$img height
proc shrink {img divby} {
$img resize [expr [$img width]/$divby] [expr [$img height]/$divby]
}
set small [$img clone imgsmall]
shrink $small 8
$small WriteImage "/tmp/orig2.jpg"
$small write "/tmp/orig2.jpg"
# (find-fline "/tmp/orig2.jpg")
# (find-tclmagickfile "tests/tkmagick.tcl")
set tkimg [image create photo]
magicktophoto $small $tkimg
label .im
.im configure -image $tkimg
pack .im
# (find-angg "LUA/vectors.tcl")
# (find-LATEXfile "2009-1-C2-prova-1.tex" "~/LUA/vectors.tcl")
canvas .c -width 200 -height 200 -relief sunken -borderwidth 2
pack .im .c -expand yes -fill both -side top
pack .im .c -expand yes -fill both -side left
.c create line 10 20 30 40
# (find-man "3tk canvas")
# (find-man "3tk canvas" "IMAGE ITEMS")
.c create image 5 5 -anchor nw -image $tkimg
.c create line 10 20 30 40
.c configure -background
.c configure -background red
.c configure -background gray
#####
#
# TclMagick: cropping
# 2011sep01
#
#####
# «tclmagick-crop» (to ".tclmagick-crop")
* (eepitch-wish)
* (eepitch-kill)
* (eepitch-wish)
# (find-es "tcl" "tclmagick-using")
# (find-fline "~/FOTOS/camisetas/")
set tcl_prompt2 {puts -nonewline "> "}
package require TkMagick
proc cam {stem} { return "/home/edrx/FOTOS/camisetas/$stem.jpg" }
set w1 [magick create wand foo]
set p1 [image create photo poo]
$w1 read [cam roxo]
magicktophoto $w1 $p1
canvas .c -width 350 -height 400 -relief sunken -borderwidth 2
pack .c
.c create image 0 0 -anchor nw -image $p1
magick delete $w1
set w1 [magick create wand foo]
$w1 read [cam laranja]
magicktophoto $w1 $p1
set x 100
set y 120
proc move {dx dy} {
global x y
set x [expr $x+$dx]
set y [expr $y+$dy]
rset $x $y
}
set r1 [.c create rectangle 0 0 0 0 -fill {} -outline orange]
proc rset {x y} {
global r1
set x1 [expr $x-100]
set x2 [expr $x+100]
set y1 [expr $y-100]
set y2 [expr $y+100]
.c coords $r1 $x1 $y1 $x2 $y2
}
rset 20 30
rset 220 230
winfo children .
.c find all
.c itemconfigure 1
.c itemconfigure 2
.c type 1
.c type 2
bind . <Left> { move -5 0 }
bind . <Right> { move 5 0 }
bind . <Up> { move 0 -5 }
bind . <Down> { move 0 5 }
# Now use the arrows to move
puts "$x $y"
set w2 [$w1 clone woo2]
$w2 crop 200 200 [expr $x-100] [expr $y-100]
$w2 write /tmp/foo.jpg
magick delete $w2
# (find-fline "/tmp/foo.jpg")
# Interesting garbage:
# (find-man "3tcl expr")
magick fonts
magick formats
set img [magick create wand img0]
set seq [magick create wand img1]
debug $img $seq
magick names
set wand [$img clone imgX]
set draw [magick create draw drawX]
debug $wand $draw
[magick create pixel whitePix] SetColor "white"
[magick create pixel bluePix] SetColor "blue"
[magick create pixel redPix] SetColor "red"
$draw push graph
$draw Rotate -45
$draw push graph
$draw SetStrokeWidth 2
$draw SetFillColor whitePix
$draw SetStrokeColor bluePix
$draw Rectangle -200 280 +90 310
$draw pop graph
$draw push graph
$draw SetStrokeWidth 0.5
$draw SetStrokeColor bluePix
$draw SetFillColor bluePix
$draw SetFontSize 18
$draw Annotation -197 300 "Tcl/Tk + ImageMagick = TclMagick"
$draw pop graph
$draw pop graph
# (find-status "tclmagick")
# (find-vldifile "tclmagick.list")
# (find-udfile "tclmagick/")
# (find-udw3m "tclmagick/index.html")
# (find-udw3m "tclmagick/TclMagick.html")
# (find-udw3m "tclmagick/TkMagick.html")
# (find-zsh "dmissing magick | grep api")
# (find-fline "/usr/share/doc/imagemagick/www/api.html")
# (find-fline "/usr/share/doc/imagemagick/www/")
# (find-status "libmagickwand-dev")
# (find-vldifile "libmagickwand-dev.list")
# (find-udfile "libmagickwand-dev/")
# (find-fline "/usr/include/ImageMagick/wand/")
# (find-zsh "installeddebs | sort | grep magick")
# (find-zsh "availabledebs | sort | grep magick")
Hello TclMagick list...
A few days ago I decided to install TclMagick on my machine - which
runs Debian Testing -, and it seemed that the easiest way would be to
use the scripts in the "debian/" directory to produce a .deb... after
an "autoreconf" and just a few trivial changes everything worked.
Here's what I did (remove the indentation to run it, of course):
cd ~/usrc/
cvs -d:pserver:anonymous@cvs.graphicsmagick.org:/GraphicsMagick login
cvs -d:pserver:anonymous@cvs.graphicsmagick.org:/GraphicsMagick co TclMagick
cd ~/usrc/TclMagick/
autoreconf
# Add "--with-tkinclude=/usr/include/tk/"
#
patch -p0 debian/rules <<'%%%'
28c28
< ./configure --with-tcl=/usr/lib/tcl$(TCLVERSION)/ --with-tk=/usr/lib/tk$(TCLVERSION)/ --with-magick=/usr/bin/Wand-config --enable-threads --with-tclinclude=/usr/include/tcl$(TCLVERSION)/
---
> ./configure --with-tcl=/usr/lib/tcl$(TCLVERSION)/ --with-tk=/usr/lib/tk$(TCLVERSION)/ --with-magick=/usr/bin/Wand-config --enable-threads --with-tclinclude=/usr/include/tcl$(TCLVERSION)/ --with-tkinclude=/usr/include/tk/
%%%
# Here I should replace "libmagick6-dev"
# by something else, but I was lazy...
#
patch -p0 debian/control <<'%%%'
5c5
< Build-Depends: debhelper (>= 4.0.0), libmagick6-dev, tcl8.4-dev, tk8.4-dev
---
> Build-Depends: debhelper (>= 4.0.0), tcl8.4-dev, tk8.4-dev
%%%
# Skip the MontageImage test, that takes too long
# to run (maybe forever). The tests don't go into
# the .deb, but it is instructive to run them from
# the source directory...
#
patch -p0 tests/test-wand.tcl <<'%%%'
133c133
< MontageImage seq 1
---
> MontageImage seq 0
%%%
# The Debian build process builds these libs elsewhere.
# Replace the "load" by a "package require" to use
# the global libraries (after the .deb is installed).
#
patch -p0 tests/tkmagick.tcl <<'%%%'
9,10c9,11
< load [file join $dirname .. generic .libs libTclMagick[info sharedlibextension]]
< load [file join $dirname .. generic .libs libTkMagick[info sharedlibextension]]
---
> # load [file join $dirname .. generic .libs libTclMagick[info sharedlibextension]]
> # load [file join $dirname .. generic .libs libTkMagick[info sharedlibextension]]
> package require TkMagick
%%%
dpkg-buildpackage -us -uc -b -rfakeroot
sudo dpkg -i ~/usrc/tclmagick_0.45-1_i386.deb
Then I was able to run the tests, i.e., this:
cd ~/usrc/TclMagick/tests/
tclsh test-bmp-compare.tcl
tclsh test-draw.tcl
tclsh test-pixel.tcl
tclsh test-wand.tcl
tclsh tkmagick.tcl
The last test in "test-bmp-compare.tcl" fails with this message:
Checking epsilon 1.0e-6 difference in image comparison with only one pixel difference
Comparing ../images/tclmagick-small.bmp and ../images/tclmagick-small-diff.bmp
Images compared at 2.74747474747e-05 using meansquarederror
FAIL compareOnePixelDiff
And "test-wand.tcl" freezes after displaying this message:
MontageImage:
magick names ==>{img0 img1}
img1 clone seqX ==>{seqX}
magick create drawing drawX ==>{drawX}
seqX MontageImage drawX 40x40 400x400 frame 4x4 img ==>{imgX}
Except for that and for the (not few) compilation warnings everything
seems to be fine, or at least fine enough 8-). I thought that maybe
you were planning to update the scripts in the "debian/" directory,
but that that could be a very low-priority task... and a report like
this could help a bit.
Cheers & thanks,
Eduardo Ochs
eduardoochs@gmail.com
http://angg.twu.net/
# (code-c-d "tclmagick" "~/usrc/TclMagick/")
# (find-tclmagickfile "")
http://lists.sourceforge.net/lists/listinfo/graphicsmagick-tclmagick
#####
#
# Anonymous functions in Tcl8.5
# 2012dec26
#
#####
# «anonymous-functions» (to ".anonymous-functions")
(defun eepitch-tcl85 () (interactive) (eepitch-comint "tclsh8.5" "tclsh8.5"))
* (eepitch-tcl85)
* (eepitch-kill)
* (eepitch-tcl85)
set foo {{x} {puts ">> $x <<"}}
apply $foo 10
apply {{x} {puts ">> $x <<"}} 20
#####
#
# CriTcl
# 2013jan05
#
#####
# «critcl» (to ".critcl")
# http://wiki.tcl.tk/2523
#####
#
# Namespaces
# 2013jan19
#
#####
# «namespace» (to ".namespace")
# (find-man "3tcl namespace")
# (find-man "3tcl namespace" "\nQUALIFIED NAMES")
# (find-man "3tcl namespace" "\nNAME RESOLUTION")
# (find-man "3tcl variable")
#####
#
# multiline-comments
# 2019jun29
#
#####
# «multiline-comments» (to ".multiline-comments")
# https://stackoverflow.com/questions/3368845/how-put-block-comments-in-tcl
# (find-eev "eev-wrap.el" "ee-insert-test")
# (find-eev "eev-wrap.el" "ee-insert-test" "ee-insert-test-tcl")
#####
#
# Glue languages
# 2019aug18
#
#####
# «glue-languages» (to ".glue-languages")
# (find-sh "dict \"Ousterhout's dichotomy\"")
# (find-books "__comp/__comp.el" "ousterhout")
#####
#
# TH1
# 2020jan05
#
#####
# «TH1» (to ".TH1")
# https://fossil-scm.org/home/doc/trunk/www/th1.md
#####
#
# jim
# 2021feb05
#
#####
# «jim» (to ".jim")
# http://jim.tcl.tk/index.html/doc/www/www/index.html
# http://jim.tcl.tk/index.html/doc/www/www/download/
# http://jim.tcl.tk/index.html/doc/www/www/documentation/
# http://jim.tcl.tk/fossil/doc/trunk/Tcl_shipped.html
# https://lists.btbrotary.org.au/pipermail/jimtcl/
# https://github.com/msteveb/jimtcl
# (code-c-d "jimtcl" "~/usrc/jimtcl/")
# (find-jimtclfile "")
# (find-jimtclfile "examples/")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
cd ~/usrc/jimtcl/
./configure |& tee oc
make |& tee om
make test |& tee omt
#####
#
# Using trap to receive commands via SIGUSR1 and SIGUSR2
# 2021dec07
#
#####
# «trap-2021» (to ".trap-2021")
# «2021-emacs-tcl-bridge» (to ".2021-emacs-tcl-bridge")
# (find-fline "~/LOGS/2021dec07.tcl")
# http://angg.twu.net/IMAGES/2021-emacs-tcl-bridge.png
# (find-man "1 expect" "trap [[command] signals]")
# (find-man "3tcl vwait")
# (define-key eev-mode-map "\M-#" 'eewrap-two-eepitches)
# (find-eevfile "eegchannel")
# (eek "6*<down> M-2 C-l")
#####
#
# canvas
# 2022mar02
#
#####
# «canvas» (to ".canvas")
# (find-tcltkpage (+ 16 155) "15.8 Canvases")
# (find-sh "sort /var/lib/dpkg/info/tk8.6-doc.list")
# (find-man "3tk canvas")
# (find-man "3tk options")
# (find-man "3tk canvas" "pathName coords tagOrId")
# (find-man "3tk canvas" "pathName moveto")
# «dragABC» (to ".dragABC")
# (find-es "pharo" "dragging-objects")
* (eepitch-tcl)
* (eepitch-kill)
* (eepitch-tcl)
package-require-Tk; # See: (find-es "tcl" "package-require-Tk")
canvas .c -width 250 -height 250
pack .c -expand yes -fill both
.c create text 100 100 -text A -anchor nw -tags "A"
.c create text 120 100 -text B -anchor nw -tags "B"
.c create text 120 80 -text C -anchor nw -tags "C"
proc A_x {} { lindex [.c coords A] 0 }
proc A_y {} { lindex [.c coords A] 1 }
proc B_x {} { lindex [.c coords B] 0 }
proc B_y {} { lindex [.c coords B] 1 }
proc C_x {} { lindex [.c coords C] 0 }
proc C_y {} { lindex [.c coords C] 1 }
.c bind A <B1-Motion> {puts "%x %y"}
.c bind B <B1-Motion> {puts "%x %y"}
.c bind C <B1-Motion> {puts "%x %y"}
.c bind A <B1-Motion> {.c moveto A %x %y}
.c bind B <B1-Motion> {.c moveto B %x [A_y]}
.c bind C <B1-Motion> {.c moveto C %x %y; .c moveto B [C_x] [B_y]}
# .c delete A B C
#####
#
# scrollbar
# 2023mar17
#
#####
# «scrollbar» (to ".scrollbar")
# https://wiki.tcl-lang.org/page/ttk%3A%3Ascrollbar
# https://wiki.tcl-lang.org/page/Dissecting+a+scrollbar
# https://wiki.tcl-lang.org/page/Minimal+scrolling+canvas
# (find-sh "locate -i scrollbar | grep -i tk")
# (find-man "3pm Tk::Scrollbar")
# (find-man "3tk scrollbar")
# (find-man "3tk ttk_scrollbar")
# (find-fline "/usr/share/tcltk/tk8.6/ttk/scrollbar.tcl")
#####
#
# scale
# 2023mar18
#
#####
# «scale» (to ".scale")
# https://wiki.tcl-lang.org/page/scale
# (find-sh "locate -i scale | grep -i tk")
# (find-man "3pm Tk::Scale")
# (find-man "3tk scale")
# (find-man "3tk ttk_scale")
# (find-fline "/sda1/usr/share/tcltk/tk8.6/scale.tcl")
# (find-fline "/sda1/usr/share/tcltk/tk8.6/ttk/scale.tcl")
# (find-angg "TCL/scrollingcanvas.tcl")
* (ee-set-fullscreen nil)
* (size 150 56)
* (eepitch-tclsh)
* (eepitch-kill)
* (eepitch-tclsh)
package-require-Tk
set scalex .sx
set scaley .sy
set scaleR .sR
scale $scalex -orient horiz
scale $scaley -orient horiz
scale $scaleR -orient horiz
pack $scalex
pack $scaley
pack $scaleR
#####
#
# aloupe
# 2023apr08
#
#####
# «aloupe» (to ".aloupe")
# https://wiki.tcl-lang.org/page/aloupe%2C+a+screen+loupe
# https://aplsimple.github.io/en/tcl/aloupe/aloupe.html
# https://chiselapp.com/user/aplsimple/repository/aloupe/download
# https://chiselapp.com/user/aplsimple/repository/aloupe/tarball/trunk/aloupe.tar.gz
# https://chiselapp.com/user/aplsimple/repository/aloupe/dir?ci=tip
# (code-c-d "aloupe" "~/usrc/aloupe/")
# (find-aloupefile "")
# (find-aloupefile "README.md")
# (find-aloupefile "README.md" "-zoom")
# (find-aloupefile "README.md" "libtk-img" "tktreectrl")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rv ~/usrc/aloupe/
tar -C ~/usrc/ -xvzf \
$S/https/chiselapp.com/user/aplsimple/repository/aloupe/tarball/trunk/aloupe.tar.gz
cd ~/usrc/aloupe/
apti libtk-img tktreectrl
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
tclsh ~/usrc/aloupe/aloupe.tcl
tclsh ~/usrc/aloupe/aloupe.tcl -zoom 16 -size 9
#####
#
# apave
# 2023apr08
#
#####
# «apave» (to ".apave")
# https://aplsimple.github.io/en/tcl/pave/index.html
# https://aplsimple.github.io/en/tcl/booksum/index.html
# https://aplsimple.github.io/en/tcl/screenshooter/screenshooter.html
#####
#
# screenshooter
# 2023apr26
#
#####
# «screenshooter» (to ".screenshooter")
# https://aplsimple.github.io/en/tcl/screenshooter/screenshooter.html
# https://chiselapp.com/user/aplsimple/repository/screenshooter/tarball/trunk/screenshooter.tar.gz
# (find-bgprocess "tclsh ~/usrc/screenshooter/screenshooter.tcl")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
rm -Rv ~/usrc/screenshooter/
tar -C ~/usrc/ -xvzf \
$S/https/chiselapp.com/user/aplsimple/repository/screenshooter/tarball/trunk/screenshooter.tar.gz
cd ~/usrc/screenshooter/
# (code-c-d "sshooter" "~/usrc/screenshooter/")
# (find-sshooterfile "")
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
tclsh ~/usrc/screenshooter/screenshooter.tcl
* (find-3EE '(eepitch-bash) '(eepitch-tcl))
* (find-3ee '(eepitch-bash) '(eepitch-tcl))
* (eepitch-bash)
* (eepitch-tcl)
package require Expect
proc readfile {fname} {
set ch [open $fname r]; set str [read $ch]; close $ch; return $str
}
proc writefile {fname str} {
set ch [open $fname w]; puts -nonewline $ch $str; close $ch
}
proc savepid {} { writefile /tmp/bridge-pid "[pid]\n" }
proc onsigusr1 {} { puts -nonewline [readfile /tmp/bridge-data] }
proc onsigusr2 {} { eval [readfile /tmp/bridge-data] }
trap {onsigusr1} USR1
trap {onsigusr2} USR2
savepid
vwait forever
* (eepitch-bash)
function bridge-send () {
echo "$2" > /tmp/bridge-data
kill -s $1 $(cat /tmp/bridge-pid)
}
bridge-send SIGUSR1 'Hello'
bridge-send SIGUSR2 '
puts "(Redefining onsigusr1)"
proc onsigusr1 {} { puts -nonewline "![readfile /tmp/bridge-data]" }
'
bridge-send SIGUSR1 'Hello 2'
Tcl book examples
# http://tcl.sourceforge.net/faqs/tcl/part1.html
# ftp://ftp.tcl.tk/pub/tcl/doc/book.examples.Z
set set set; [$set $set] $set $set
set set set; [[set set] [set set]] [set set] [set set]
Geometry managers: http://wiki.tcl.tk/443
Drawing program: http://wiki.tcl.tk/13257
Category Music: http://wiki.tcl.tk/references/14463!
Pstack: http://wiki.tcl.tk/10631
PostgreSQL: http://wiki.tcl.tk/3744
ACID: http://wiki.tcl.tk/3129
Odyce/TCC: http://wiki.tcl.tk/20086
# (find-zsh "grep-available -i spreadsheet")
https://0branch.com/highlight/snippets/twc.tcl world clock
https://exercism.io/tracks/tcl
https://news.ycombinator.com/item?id=29071339 A little backtracking Prolog interpreter in Tcl (2010) (tcl-lang.org)
https://news.ycombinator.com/item?id=29143346 Why is Tcl syntax so weird (2013) (tcl-lang.org)
https://news.ycombinator.com/item?id=9098859 before tcl got it's own native OO system, there were LOTS of competing OO systems
https://news.ycombinator.com/item?id=32405713 Tcled: Pure Tcl Console Text Editor (2019) (github.com/slebetman)
https://www.se-radio.net/2022/07/episode-520-john-ousterhout-on-a-philosophy-of-software-design/
http://antirez.com/articoli/tclmisunderstood.html
http://oldblog.antirez.com/page/picol.html picol, a Tcl interpreter in 550 lines of C code
http://antirez.com/picol/picol.c.txt
https://news.ycombinator.com/item?id=34733120 A brief interview with Tcl creator John Ousterhout (pldb.com)
https://eugenkiss.github.io/7guis/tasks
# (find-telegachat "1487862914#214227" "exec-menu.tcl")
# (find-telegachat "1487862914#214364" "exec {*}$cmd becomes exec \"/bin/bash\" -c $cmd")
https://www.tcl-lang.org/cgi-bin/tct/tip/157.html TIP #157: Argument Expansion with Leading {expand}
https://tcl.tk/man/tcl8.6.13/TclCmd/Tcl.htm#M9
https://www.magicsplat.com/blog/disassemble/
https://wiki.tcl-lang.org/page/List+the+call+stack
https://www.magicsplat.com/blog/meta-html/
https://wiki.tcl-lang.org/page/The+Hello+World+program+as+implemented+in+Tcl%2FTk
https://wiki.tcl-lang.org/page/Playing+with+Pipes%2C+Send+and+DDE
https://news.ycombinator.com/item?id=35647364 Tcl Programming/Tk Examples (wikibooks.org)
https://cohost.org/sakiamu/post/177439-tcl-on-the-brain
# Local Variables:
# coding: utf-8-unix
# End: