Win32下的Perl，无用的select，停滞的Tk，结束吧....
当我写完edcucumber之后，TclTk差不多算是可以暂时告一段落了。毕竟，在这个项目，如果这能算作项目的话，花费了很多的精力。从攻克一个又一个难题，到细节的处理，总之目前edcucumber是已经可以使用了，至少，我本人实在使用它处理TclTk程序的，而且相当方便于调试和编写实验脚本。如果那一天我觉得不够用了，我还会增加其他功能的，但目前还是暂停一下吧。在此期间，我对TclTk的认识也随着编写的深入而慢慢加深了。这是一个特点于缺点一样明显的语言，结合Tk在快速编写界面方面几乎无语言能出其右也。而对于数据类型支持的薄弱，使其在处理复杂数据是力不从心，虽然可以借助一些方法，但是总就不是能自然解决的，最关键的一点是没有类似于指针的数据类型，这相当让人头疼。在群里的管理员之职，其实更多的时候是挂羊头卖狗肉，由于个人喜好的原因，除了Tk之外，我对其他方面的内容涉及很少，尤其是Expect，而这又恰恰是很多人想要学习了解的。差不多了，就这个水平了，可能比浅尝辄止要好一点吧。
现实总是很残酷的（原先我想写有时候的），当我发现我花费在这个爱好上无数的时间却还不回什么回报的时候，感到的是深深的不安和自责。而的确，没有什么办法让这个TclTk变得有点价值，而爱好不能当饭吃吧，虽然没有它我也不会饿死，但事实是它并不能让我变得更好。我还是会写一些东西，算是对于TclTk的纪念，而且有一天我还会回来。差不多写了很多字了，零零碎碎的，我想大约到了20万字的时候就编本书。也没想法去出书，自个儿留着，以后看看，年轻时候还花了不少精力捣鼓这玩意儿。
C啊，我又回来了。苹果或者Android，也或者Palm....这次看看是不是能弄出点名堂.....至于本人的工作，唉.....干得多，反而要被人搞，就是这么一个世道....坏的就让他去吧，我不想自寻烦恼，好的一定要记着，话说受人之恩当涌泉相报，涌泉我估计是做不到，太tmd假了，记着记在心里，好好干，别给人丢脸。
其实这是两个完全不一样的东西，应该分开来讲，这里和在一起是因为只是打算做一个介绍，谈点个人的看法和一些关键点，并不需要摊开来讲，因此如若单独切开来就显得太少了，索性和在一起吧。
缩进基本上就是说在某一块或者上下文环境中的程序代码前添加若干空白，以使得程序结构清晰。就
TclTk
来说，可能需要的一般有三种情况：在花括号中、在方括号中和反斜杠后。对于花括号的判断，我考察了一些编辑器的做法，最偷懒的可能就是查找前一行的缩进位置了，这几乎费不了什么资源和时间，但害处也是显而易见的，倘若前一行缩进发生错误，则之后的都会跟着出错。
一种正确的做法是查询行所在的上下文环境的起始行的缩进，比如
if
或者
while
所处行的缩进。期间我试验了多种方法，最后还是选择了向后的正则查询，这是基于对
TclTk
正则匹配速度的信任所做出的决定。一开始的时候，考虑到大文本的处理性能，我打算为每一行维护信息队列，包括了正反花括号的数量与位置，这样当需要查找当前行所在上下文环境时，只需要对比该位置之前的正反括号数量即可。打个比方：
{{} {}
{}
你好
}
}
其中各行正反花括号的数量信息如下：
1: ’{‘ => 3, ‘}’ => 2
2: ‘{’ => 1, ‘}’ => 1
3: ‘{’ => 0, ‘}’ => 0
4: ‘{’ => 0, ‘}’ => 1
5: ‘{’ => 0, ‘}’ => 0
以上的这种情况中，我们是如何得到你好的缩进位置的呢？首先，“你好“处在第三行，它的上下文环境应考虑第
3
行之前的信息，这里是第
1
、
2
行；令
’{’
值为
1
，
’}’
值为
-1
，将第二行相加可得值为
0
，则继续向上查询；将第一行信息相加得到
1
为正值，即说明第三行所在上下文的起始行即为第一行。
这种方法在即使是巨大的上下文环境时也可以将性能消耗控制在线性范围内，但是维护这么一个信息组也不是一件容易的事情。对于行插入或者删除的情况，都需要对该信息组进行操作，可能需要在
list
中移动上万个单元。幸好
lreplace
的性能及时在百万级的数据下，也表现得不错，应该是够用了。
至于为什么用到之后选择反向正则匹配，是因为我在
text
中拷贝了《
wxPython in action
》的某一章的全部内容并进行了匹配试验，发现速度竟然比使用信息组的性能还要好，而一般的单个程序文件我想不会有这么多字吧。
至于方括号也大致如此，事实上我是用了一个统一的函数来进行处理的。
proc myLeft {id_1 id_2 l r} {
set id_1 [.f.content search -backward -nolinestop -regexp "\\$l" $id_1 1.0]
set id_2 [.f.content search -backward -nolinestop -regexp "\\$r" $id_2 1.0]
if {$id_1 eq {}} {return {}}
if {$id_2 eq {}} {return $id_1}
if {[.f.content compare $id_1 < $id_2]} {return [myLeft $id_1 $id_2 $l $r]}
return $id_1
}
以上的函数用来得到第一个正向括号，是
"{"
还是“
[
”则可以通过复制
l
和
r
参数来决定。基本上这是一个递归，每次比较得到的相向括号的位置前后。
最后的反斜杠的处理，这是最简单的，只需要查询上一行的位置即可，然后缩进
4
个空格。
这个差不多花费了我一周的时间来解决，最后还是因为一件不相关的事情而得到了启发。一般地，我们会考虑将作色绑定在可能使文本内容发生改变的事件上，但是这并不是一件简单的事情，应该说存在着若干个截然不同的情况。比如说，删除动作之后，我们应该考虑当前插入点的前后文本的变化；而在拷贝事件时，需要考虑被插入文本的前后端以及本身的内容，但如果之前有范围选择存在，则还需要首先考虑选择区域应被删除。总之这是一件很复杂的事情，很难保证代码的清晰易懂，也很有可能随之带来
bug
，因此这个思路被暂时搁置了。
在确定
<modified>
事件是发生在文本发生改变之后，我试图寻找一个简洁的办法来得到事件前后的文本差异，但是似乎只能寄希望于极耗时间的全文比对，这种着色引擎只适用于大文本的载入情况，而对于实时渲染显然非常低效。
考虑再三，我还是选择了绑定各个事件的办法，但编写调试的过程相当痛苦，充满了复杂的逻辑和奇怪的问题。这个时间里，群里有人大约是在讨论关于
rename
的必要性，我记忆里隐约记得是有这么一个看似毫无价值的命令的存在。随手
google
了一下权作放松，可恰恰是这次搜索使得高亮的进展柳暗花明。
在
tcltk
的
wiki
上，有一篇关于在
text
中通过
rename
的办法得到实际操作指令的的例子。具体的讲，比如一个
copy
，可能会被分解为选择，删除和插入等几个步骤，通过
rename
我们可以在具体的指令操作发生之前捕捉到它。对于高亮而言，事实上需要关心的只是文本的变化，也就是说我只要能够捕捉到插入和删除这两个基本事件就可以了。
这个技巧很诡异：
text .t
pack .t
rename .t fake
proc .t {args} {
puts "catch: $args"
uplevel #1 fake $args
}
“
rename
”应该是会注销掉“
.t
”的命令，但由于
tk
本身的命名规则，“
.t
”依然会被使用到，因此我们必须将其重新定义为一个接收参数的过程，在该过程中使用“
fake
”来真正执行指令，显然在此之前我们已经捕获了它。需要注意的是，别在真正执行指令之后插入别的代码，因为该过程在最后会对全局带来一些必要的副作用，不能将其覆盖。因此，诸如着色的操作代码必须写在真正指令之前。
这算是一个矛盾的事情，着色代码放在了引发着色事件的前面，这岂不是在当前操作未来的内容。幸好还有“
after idle
”，用来缓冲代码的命令。纵观整个程序，充满了“
after idle
”，实在是非同小可的东西。
热替换的好处就不提了，至少是有用处的。如果没有
Erlang
，我想迟早也会去关注这个话题。尤其是在
Tk
中绑定事件处理函数时或者在调试的时候，根据不同的需要，可以动态的改变代码功能，这显然非常方便。但是如果实现的过程本身可能破坏原来代码的结构，我想这就有点得不偿失了。最起码的，应该有一套方便并且可遵循的规则。下面就两种办法进行分析。
先来设定一个最基本的实验环境：一个用来显示结果的文本框和一个用来激发事件的按钮，足矣。需要达到的目的是，在运行过程中，动态改变按钮的绑定处理函数。
第一种做法
--
嵌入
source
：
Tcl
的代码集成，包括
package
等，多是建立在
source
和
load
的基础上的，说白了
package require
不过也是在
pkgIndex.tcl
中找到相应的文件并
source
之。所以第一种思路是在按钮的绑定函数中
source
文件，主要的代码片段如下：
text .t
button .bt -text test -command {
source
b.tcl
}
pack .t .bt
我不得不将
source
放在函数中的原因在于，必须在每次运行时检测文件，以确保运行了最新修改过的代码。其中，
b.tcl
的代码为
.t insetr end “1\n”
用来在文本框中新插入一行，内容为
1
。如果将
1
改为
2
，程序将自动变换为插入内容为
2
的一行。但是这里有两个问题存在，首先这种检测很多时候是多余的，我们并不需要修改代码；第二，
source
本身是对文件的读入操作，这不可避免地引入了
IO
，也就是说影像了性能。这种热替换方式，不大适合与巨大的事件处理函数，或者可能遭遇频繁调用的情况。
第二种做法
–- socket
指令
:
在修改完
b.tcl
之后，需要有人告诉运行程序一声，“喂，你的按钮该换代码了！”，接着主程序兴冲冲地去找按钮处理函数的源代码。这里讲的其实是一个进程间通信的问题，于是选择了
socket
。我把这个过程写了两个文件，一个是名为
hot.tm
的包，提供了两个主要函数：
init
，用来指定可以被替换的函数及其相对应的文件；
update
，用来具体实施热替换。其实替换的过程也是一个
source
，不同之处在于
source
的内容是一个函数，而非第一种情况里函数中的一段代码，这样新的函数将覆盖之前的版本。这是
a.tcl
的代码需要有所修改：
lappend auto_path [file dirname [info
script]]
package require hot
hot::init b b.tcl
text .t
button .bt -text test –command b
pack .t .bt
在
hot
的
namespace
中，维护着一个函数名到源文件的
array
，在初始化时需要指明哪些函数是可以被热替换的。我可不想随便哪个函数都可以被替换，这就乱套了。
另一个文件时
hotc.tcl
，用来在修改完代码之后通知运行程序来进行热替换，当然这个过程只能依靠人工来完成了。比如在这里需要替换
b
函数，那么就执行一下
hotc.tcl b
。
最后我想，这应该是一个比较可以被接受的方法了。其实即使是标榜着热替换的
erlang
，也需要在修改代码之后
compile
的，这就好比执行了
hotc.tcl
，只不过
erlang
的做法是语言级的。
代码下载
在前面一贴关于
linum
的杂论中，我使用了双
text
的拼接来实现
linum
，关于其优点主要在于只读属性的设置。但在涉及到纵向的
scrollbar
时，我们不得不面对一个问题：如何使
linum
和文本内容跟随
scrollbar
一齐滚动？
一般而言，
scrollbar
是绑定与一个可
scroll
组件的，比如
text
或者
list
。显然，没有相应的
scrollcommand
命令的组件，例如容器组件就不属于可
scroll
组件，也就无法绑定到
scrollbar
的。因此，我们不能使用
frame
作为一个统一的外部包裹来绑定
scrollbar
。
canvas
是很好的替换选择，但有鉴于
canvas
过于强大，除非需要实现特定效果，我个人不倾向于使用这种大型组件。另外，要提一下的经验是，对于单组件绑定
scrollbar
，最好是使用
widget::scrolledwindow
，它带
optional
特征，只有在必要的时候才会显示
scrollbar
本身。
办法终归是有的，但是需要首先知道
scrollbar
到底是怎么工作的。从实际出发，我们会在两种大的情况下触发到滚动事件，第一个是直接操作
scrollbar
；第二个是操作文本内容，包括插入和光标上下移动。
对于第一种情况，比如我们点击
scrollbar
中的下标时，首先发生的并非是改变滑条的位置，相反的文本框的内容整体下移了一行，此时出发了文本框的滚屏事件，而在该事件相关的处理程序再设置
scrollbar
的滑条到相应的位置。也就是说，对于
scrollbar
的操作，最终还是要落实到
text
上来完成的。而相对与第二种情况，
scrollbar
其实只是指定了文本框的滚屏形式，例如点击下标是下滚一行，点击滑条上方的空白条是上滚一页，拖动则是滚屏一定数值。在第二种情况中，滚屏完全由
text
自身控制，比如绑定一个滚屏到文本开头的快捷键，则
scrollbar
也将相应地滑动到最上端。
text
的
command
以及
scrollbar
的
x(y)scrollcommand
命令是很需要注意的，它们其实是被其他过程用来产生命令的参数，并不直接执行。在
ttk::scrollbar
中有如下一段定义：
proc ttk::scrollbar::Scroll {w n units} {
set cmd [$w cget -command]
if {$cmd ne ""} {
uplevel
#0 $cmd scroll $n $units
}
}
显然“
$w
cget -command
”得到的比如“
.txt yview
”与之后参数结合，最后真正执行的是“
.txt yview scroll 1 unit
”这样的命令。这么做其实是限制了对
scrollbar
的操作，由于实际的使用是一个很死板的命令，除非修改
scrollbar
的定义或者使用
snit
重新构造一个，不然除了“
$w yview
”和“
$w xview
”，我们不可能得到任何有益的副作用。
text
的
command
相对好一点，它为绑定的函数添加了两个参数，分别表示可视区域的最上端和最下端处于全文的相对位置。事实上这么做是提供了编写规范，即为了设置滑块的位置，在绑定函数中一定要有
scrollbar
的
set
命令。除此之外总还是有一些自由的，双
text
滚动的
hack
就在此处进入。
当文本组件发生滚屏事件时，一方面需要设置滑条位置，另外再引发
linum
产生滚屏，如此便打到了双滚屏的效果，这里改变的无非是一个先来后到的顺序问题，要实现多组件滚动的话也是一个道理。
要设置滑条位置需要的是自动传入的两个参数，而
linum
滚屏用到的则是其中的第一个参数。命令如下：
.scrollbar set $first $last
.linum yview moveto $first
是的，这是最后的命令，只是多了一行“
moveto
”，这点事儿我却写了半天，见笑了。
关于
text
这个组件，说起来简单，其实却是又相当复杂，今天我从一个带
linum
的
text
出发，管中窥豹，以期抛砖引玉。
使用
emacs
的大多会安装行号显示，便于
debug
时的定位，比较常用的便是
linum.el
。这里的
linum
是
line number
的意思。现在我们来实现这种效果，以达到当发生输入、粘贴、删除或者退格事件时，左侧行号自动匹配实际文本行数。
首先需要设置行号的显示方式，这是最基础但却是很重要的一个决定。倘若是在单
text
组件中使用
tag
实现
linum
，那么有两个问题。第一，无法保证
linum
的只读状态；第二，复制时会包含行号，大多数情况下这是多余的。这里我选择了两个组件的粘合，事实上是将两个
text
拼在一起，当然也可以使用
entry
或者
canvas
，只是前者比较方便，容易保持代码的一致性。在此之前，最好设置一个用于记录最后行号值的变量
linum
，初始化为
1
。
package require Tk
set linum 1
frame .f
text .f.linum -width 1 -bg gray -bd 0
.f.linum insert end "1"
.f.linum configure -state disable
text .f.content -bd 0
pack .f.linum -side left -expand 1 -fill y
pack .f.content -side left -expand 1 -fill
both
pack .f
我们得到了如下图片显示的记事本，当然目前它还不能正常添加或删除行号，需要定义并绑定一系列过程。另外，随着行号的增加，应该相应设置左侧灰带的宽度来正常显示行号。
无论是因为何种文本编辑操作使得文本行数发生改变，在改变行号之前，我们都必须得到文本行的数量。这里有几种办法，比如
count
或者
index
，我们使用后者，顺便对
index
进行介绍。
proc linum {w} {
return [expr int([$w index "end - 1c"])]
}
此处的
index
是“
end
– 1c
”，表示文本的最后的前一个位置。事实上，这就是文本的实际最后位置，只不过因为
end
被定义为“
the character just after the last newline
”，一个不存在字符，所以必须在
end
的位置处再向前减去一个
character
，可以简写为“
- 1c
”。同样的，如果要得到待插入行的最后一个字符的位置，应使用“
insert lineend
”；向前一个字符就是“
insert lineend – 1c
”，如此类推。
现在要切实做一些绑定了，一般地我们使用回车和退格来进行换行，其中回车是必然转换为一个换行符的，而退格则在遇到换行符时才会通过一系列的操作实现换行。还是应该提一下，通过
ascii
码我们可以看到回车并不是换行，换行的码值是
10
，而回车是
13
，所以需要转换；而退格换行的行为，在实际中行数并不会立即发生变化，在退格时先增加一个退格符，再将该退格符连同上一个换行符一起删除。需要注意的是，文本永远在其最后保留一个换行符。
明白了这个细节，接下来的事情就好办了。由于我们还需要响应长按的情况，所以必须绑定是
KeyPress
过程，但无论是
KeyPress
还是
KeyRelease
，当遇到换行时
text
都会在之后做做一些以上描述的小手脚，所以真正的绑定处理过程必须发生在这些小手脚完成之后。这是一个矛盾，但并非不可调和。
after idle incrLinum
在绑定中，使用“
after idle
”的小技巧便可以轻松应对。它让
text
先干完想干的，一旦空下来就立即执行真正的处理过程。
除了回车和退格，还应该增加对一些常用的比如粘贴或删除操作的支持。对于粘贴，通常的快捷键是“
ctrl v
”，对应的事件是“
<Control-Key-v>
”，当然也可以是如
emacs
中的“
ctrl y
”。使用以下的形式可以方便地增加对事件的支持。
foreach keysum {
<KeyPress-Return>
<Control-Key-v>
} {
bind .f.content $keysum {
after
idle incrLinum
}
}
点击下载代码。
另外，添加比如语法着色也并非难事，只是肯定会相当复杂，以后再说了。
关于
Button
最诡异的事情大概就是与变量作用域相关的命令了。
Button
事件是作用域全局域下而非任何过程函数中。如果
Button
是在一个过程函数中创建的，那么该
Button
的命令之后将在不同的作用域中执行。即使是使用
binding
的事件处理，也将在全局域中执行。
我认为这是一个关于定义与执行的时间问题。举例来说，当定义一个
Button
时可以使用到一组变量，但在使用该
Button
的时候却用的是另一组变量。当遇到混合上下文环境的情况，这就变得很混乱了。以下例子中的
Button
命令使用到了两个变量：
x
和
val
。其中
x
是在执行中需要使用的全局变量，，本地变量
val
在定义
Button
时使用。
proc Trouble
{args} {
set b 0
# Display the value of x, a global variable
label .label -textvariable x
set f [frame .buttons -borderwidth 10]
# Create buttons that multiply x by their
value
foreach val $args {
button $f.$b -text $val \
-command "set x \[expr \$x *
$val\]"
pack $f.$b -side left
incr b
}
pack .label $f
}
set x 1
Trouble -1 4
7 36
这个例子用了一个
label
来设置
textvariable
属性来显示
x
的当前值，该
x
总是一个全局变量。在这里，因为
x
不在
Trouble
中使用（只是被定义），所以不用使用
global
来说明
x
是全局变量（当然，用了也没关系）。
Button
命令之后则将在全局范围被使用。
但是这个
Button
命令的定义非常丑陋，在
foreach
中的定义的
Button
使用了本地的变量
val
，而其他变量的实值替换将发生在之后的全局范围内。因此需要前缀反斜杠使
$x
和
expr
不在双引号被转义。
set x \[expr
\$x * $val\]
我们举个反例来说，以下的这里例子中给
x
在定义过程中被直接赋值了一个常量，因而无法达到上面例子中的目的，显然是不正确的。
button $f.$b
-text $val -command "set x [expr $x * $val]"
另外一个不正确的做法是对整个命令使用花括号（就是
“”
）。这么做则是过犹不及了，所有的变量都将在全局范围内执行时被实值替换，这个时候
tcl
解析器可能发生提示发生错误，说找不到某些变量。
最近一直没有写博客，其实也没什么，主要是一直在看书，主要是两本书：《Programming Erlang》和《Emacs Lisp Intro》，以及一些关于parrotVM的文档。第一本关于Erlang的差不多看完了，真是非常好的书，难得一见，差不多是一口气读完的，对并发和多进程以及服务器端的设计有了更深的理解并较好的架构概念，目前看来还没有很好地消化，这需要时间和实践。至于parrotVM，这可是最近的一件大事，8年时间终于等来了1.0.0版，这本身就足够让人关注。不过CU和PerlChina的反应很冷淡，让人有点意外，目前看来研究的人还比较少，或者大牛们都在闷声啃文档。虽然算是正式了，但还是有点bug，比如win32的编译版本只能在C盘下正常运行，perl6的语法似乎跟《Perl6 essential》的设计也有出入...最后是《Emacs Lisp Intro》，这是因为最近在对vim实在无法适应，因为原来一直使用UE，习惯了用Ctrl的快捷键，换到vim之后，模式切来切去实在抓狂，于是用了Emacs。上手出乎意料的快，非常适合本人的习惯，不过就是字体有点难看。win下只要打开可选字体的显示项就可以选择一些比如雅黑的字体，但在linux下面似乎麻烦了不少，最后一狠心直接用“emacs -nw”在bash里运行得了，字体也很好看而且基本上一模一样。
界面处理还是延用了
bugd
的组件，为了方便修改，这次在
lib
文件夹里直接使用了
tcl
文件，而不是以往用到的
tbc
。总之，这一系列的程序应该都是
foobar-like
的。音频处理方面使用了
snack
，也有人用
lame
的，但是
lame
没有专门的模块，需要
dll
来调用，因此不是很方便，就更别提文档了。在
http://www.speech.kth.se/snack/
中有详细的文档和例子，很容易上手。另外，也可以参考
snackAmp
的源代码。在功能上，和我的设想有类似之处，比如说除了普通的播放之外，还可以作为网络服务器，提供在线广播收听。
OK
，要做到这步显然是需要花大功夫的，目前先作为一个正常的播放器来解决。但恰恰使这个“正常”让我花费了好大功夫。故障的表现是这样的，当使用
snack
播放音乐时，无论是最小化、最大化
snack
程序还是其他的任何桌面窗体，播放都会卡一下。但是，当我使用
snackAmp
来播放的时候却不会有这个现象，而它也是调用
snack
的。
起初，我的想法是可能
snackAmp
中的
snack
版本和我使用的不一样，于是做了替换，结果依旧。之后，我怀疑是因为
snack
的原始
Tk
界面占用资源，于是将它
withdraw
了，也没有作用。没办法之下，研究起
snackAmp
的源代码起来。话说回来，这个程序写得真是糟糕，虽然分成了几十个
package
，但是相关性太高，到了你中有我我中有你的境界
,
绝大多数根本无法重用，看起来也云里雾里。最后终于定位到了
macro
中的
Play
和
soundCtrol
中的
play
两个函数，仔细分析之下发现真正涉及到播放的部分竟然非常普通，没有特别之处。打印出来的
snack::sound
对象属性基本雷同。
事实上，我忽略了最重要也是最有效的工具，文档。当发给
snack
和
snackAmp
作者的
email
石沉大海数日之后，我万念俱灰，却偶尔发现了在
manual
关于
snack
：：
audio
的
playLatency
介绍中有一句“
A low value makes new sound
samples reach the loudspeakers quickly at the risk of gaps in the output stream
”。不会是它吧！连忙对比了默认状态下和
snackAmp
中的
playLantency
参数，一个
250
，一个
2000
，
8
倍！就是这个！问题迎刃而解。
点击下载 （刚修订了一些bug，甚至连逻辑也改了，所以下面的内容也就没什么意义，要源代码的可电邮我gyn_tadao@yahoo.com.cn，要运行下载代码请先安装TCL解析器http://www.activestate.com/activetcl/downloads/）因为对
bugd
中的
item
状态需要定时地进行判断，以确定其是否过期。也就是说，对于
due
中的值小于当前日期但
status
却未
fixed
的，可以认为该
item
就是过期的了，需要将
status
更新为
outdated
。这种事情对于
sqlserver
之类的数据库，一般只需要做一个简单的
schedule
就可以了，但是在
bugd
中我采用的是
sqlite
作为服务器端的数据库，所以这个
schedule
不得不自己编了。
之前，我使用
perl
来写了一个，之后思索着索性写一个
sqlite
的
schedule
工具吧，最好还是带
GUI
的。这并不难，
bugd
中的组件正好可以利用。说干就干，两天的功夫就完成了。跟
bugd
很像，算是一个派生物了吧，但是复杂度小了很多，一则实现的功能比较单一，不需要复杂的界面配套；二来，不是
CS
的结构，考虑的问题都集中在本地。真正的难点是怎么维护一个对各个事件需要发生的时间的判断，同时又可以方便地增加和删除
schedule
事件。在这里，我维护了
一个名为
rl
的队列，意思是
runing-list
，将需要进入
schedule
的事件名称放入到该队列中，要停止的时候再将其从该队列中移除，由专门的函数循环处理该队列。
该函数叫
runSchedule
，形式如下。其中的
yet
用于判断是否已经在当天检查了时间队列
rl
。
proc runSchedule {} {
global rl loop_interval yet
update idletask
if [at 00:00:00] {
if $yet {
schedule $rl
set yet 0
}
}
after [expr $loop_interval * 1000] runSchedule
}
在原来的函数中，我是使用
after idle
来进行循环的，由于使用了
update idletasks
，该程序界面运行第很流畅，但是在资源管理器中
cpu
的使用率达到了
100%
，没办法是能改为一个秒级的
interval
。
每个新的一天到来的时候，真正的队列处理在
schedule
被处理。该函数如下：
proc schedule {rl} {
global cmd scdl dbl
set sep1 @
set sep2 |
foreach n $rl {
set m [dict get $cmd $n]
set s [dict get $scdl $n]
set d [dict get $dbl $n]
foreach {ery dy tm} [split $s $sep1] {}
switch $ery {
month { set d [clock format [clock seconds] -format "%d"]}
week {set d [clock format [clock seconds] -format "%a"]}
default {}
}
if [info exists d] {
foreach e [split $dy $sep2] {
if {$e eq $d} {
runCommand $tm $d $m
}
}
} else {
runCommand $tm $m
}
}
}
在
schedule
中，根据
rl
中的事件名称，将通过
cmd
、
scdl
和
dbl
三个
dict
，调出对应的命令，运行时间和所在的数据库。之后通过
runCommand
来根据具体时间来运行
SQL
命令。
proc runCommand {tm db cmd} {
global loop_interval
if ![at $tm] {
update idletask
after [expr $loop_interval * 1000] [list runCommand $tm $cmd]
} else {
sqlite3 d $db
if [catch {d eval $cmd} err] {
updateStatusInfo [join $err _]
}
d close
}
}
最后需要说明的是
at
函数，它是用来判断是否过了所给定的时间的，也就是说只要当前时间大于输入参数，它就返回为真，不然为否。所以真正意义上应该叫做
after
，但是
after
已经是
tcl
默认函数了，所以改成了
at
。
proc at {tm} {
global yet
if {[clock scan $tm] >= [clock seconds]} {set yet 1; return 1}
return 0
}
有时候做出一点决定是很烦人的，特别是之前付出了很多努力，现在却要改弦易张。对于
bugd
的
toolbar
，我最后还是决定改了，特别是去除了之前花了大力气做的一个控件
menucombobox
。很遗憾，我越看它越不爽，最重要的是我不认为它有什么用处。当我打算削减用户的
select
操作时，就注定了它的命运。另外，加了
5
个用于显示不同状态列表的
radiobutton
，这几个图标是在一个相同的底图标的基础上
copy
小修饰得到的。
之后，对
status
处于
outdated
的
item
的
background
着色以明显突出，但是为了尽量不影像其他代码，在原先的
addItem
之外又包了一个叫
judgeAddItem
的函数，用于判断
item
状态，从而给与新定义了橘黄颜色的
style
。
