Programação

*Nota:* Para baixar a última versão do TclLearn siga o seguinte link:

tcllearn.tcl

*Nota:* Esse trabalho ainda está muito cru, muito incipiente. Sugestões de melhoria são bem vindas. Por favor, entre em contato.

Introdução

Iniciei esse trabalho para tentar ensinar um pouco de programação a algumas pessoas que me rodeiam. Inicialmente, eu poderia utilizar qualquer um dos milhões de materiais disponíveis na web. Entretanto, porque decidi fazer mais este?

Em primeiro lugar, eu gostaria de ter um material que fosse utilizado como uma ferramenta de proximidade entre eu e as pessoas que gostariam de aprender programação comigo. A ideia é que a pessoa possa utilizar esse material para estudo e depois vir conversar comigo pessoalmente ou pela internet e tirar as dúvidas. Nesse ponto de vista, é um material muito pessoal.

Também queria trazer para a experiência algumas tecnologias que admiro e acho muito boas mas que, devido à pressão do mercado, são muito pouco tratadas no dia a dia. Os livros utilizam linguagens de programação que são muito utilizadas (por motivos que não valem a pena explicar aqui) como Java ou C# (C Sharp), dentre outras, esquecendo que há uma miríade de linguagens diferentes e a compreensão de várias linguagens faz você compreender melhor outras. Neste livro vamos utilizar várias linguagens e utilizar os aspectos principais de cada uma.

Além disso, infelizmente, a grande maioria dos livros não tem uma preocupação didática e próxima do aluno.

Objetivo do livro

Público-alvo desta publicação

Como este livro deve ser lido

Começando a programar: um software gráfico para cadastrar suas coisas

Como se programa computadores? Em primeiro lugar, um computador só entende uma linguagem chamada "código binário", que nada mais é do que um fluxo de zeros e uns. Nós não vamos tentar compreender esse código por enquanto, uma vez que é muito complicado e até programadores experientes tem dificuldades de lidar com esse código. Para falar a linguagem dos computadores, os seres humanos criaram as "linguagens de programação", que são formas que os seres humanos podem utilizar para dizer aos computadores o que fazer.

Por exemplo, supomos que, para se desenhar um botão na tela, talvez um computador precise receber as seguintes instruções: 

110000111000010010001100100000001010001110000100000010010000101011110010
000110010101100011101000000101001110000000100100010101100011000100000100
101100000000100100100100100010011011010001011001000010111000000100011100
000001100001001001110001110110000000010101011000110000011111000100100111
001010101110100000000110001011000110000001100001001001000010100010000101

Em uma linguagem de programação, isso seria muito mais fácil, como: 

button .btn -caption "Clique aqui!"

O que vamos fazer, portanto, é expressar nosso pensamento, dizer o que queremos que o computador faça, utilizando uma linguagem de programação.

TODO: recomendar autor Sebesta?

A linguagem de programação que vamos utilizar chama-se *Tcl*. Para elaboração de softwares gráficos vamos utilizar uma biblioteca chamada *Tk* para desenvolvimento de aplicações gráficas. As duas juntas formam uma ferramenta conhecida por *Tcl/Tk*. Não vamos explicar, por enquanto, a diferença entre Tcl e Tk. Iremos utilizar ambas de como se fossem somente uma ferramenta e depois nos preocuparemos com a diferença e os detalhes de cada uma.

Tcl

Para saber como instalar o Tcl/Tk, verifique o _Apêndice 1: Instalando e utilizando o Tcl/Tk_.

Um parêntesis:

Ao instalar o Tcl/Tk, *não* será instalado um editor de texto para você digitar o código. Você pode utilizar qualquer editor de texto básico para digitar o conteúdo dos arquivos, como o Bloco de Notas do Windows. Entretanto, é recomendado que você utilize algum editor com realce de sintaxe. Um deles é o gedit que existe para diferentes sistemas operacionais.

gedit

Não utilize um processador de texto como o Microsoft Word ou LibreOffice Writer. Esses programas gravam muito mais informação que o texto digitado e o formato de arquivo que eles gravam não será reconhecido pelos interpretadores e compiladores das linguagens de programação.

Neste curso, ao menos no início, recomendamos que você utilize uma ferramenta que desenvolvemos, a qual chamamos TclLearn. Que pode ser baixada no link abaixo. Importante: para executar o TclLearn, é necessário, primeiro, baixar e instalar o Tcl/Tk para sua plataforma.

tcllearn.tcl

*Importante:* Os códigos abaixo podem ser copiados e colados direto no editor de texto que você está usando. Entretanto, é altamente recomendável que você digite linha a linha. A digitação irá te ajudar a memorizar os comandos. Eventualmente você cometerá alguns erros na digitação, que acarretarão erros de execução do programa, mas você aprenderá muito ao estudar o programa digitado e interpretando as mensagens de erro, encontrar o problema e solucioná-lo.

Inicialmente, vamos desenvolver alguns programas que podem não parecer muito úteis no início, mas que vão trazer alguns conceitos básicos.

O primeiro é o mais simples de todos. Vamos simplesmente mostrar na console o texto "Olá mundo". Veja o program a seguir:

<<hello-world-1.tcl>>= 

puts "Olá mundo"

<<management1.tcl>>= 

# Informa ao Tcl que vamos utilizar a biblioteca Tk
package require Tk

# Cria os componentes
listbox .books -listvariable books
entry .bookname -textvariable bookname
button .add -text Adicionar -command {
    lappend books $bookname
    set bookname ""
}

# Posiciona os componentes na tela
grid .books
grid .bookname
grid .add

A execução do programa acima deverá mostrar uma tela cujo esquema lembra o desenho abaixo:

Descrição do diagrama acima para pessoas cegas: Uma janela com três widgets organizados verticalmente: uma listbox, uma caixa de texto e um botão com o nome "Adicionar".

Tente experimentar digitar algo na caixa de texto (a caixa branca na parte de baixo). E clicar no botão "Adicionar". O que aconteceu? O que você digitou na caixa de texto apareceu na lista acima. Você pode incluir vários itens na lista e selecionar cada um deles. O programa é muito simples, mas já tem algumas capacidades básicas de armazenamento. Iremos melhorá-lo para ter mais funcionalidades.

Por enquanto, vamos voltar ao conteúdo do programa e estudá-lo linha a linha.

As duas primeiras linhas são: 

# Informa ao Tcl que vamos utilizar a biblioteca Tk
package require Tk

Essas linhas já dizem bastante a respeito da linguagem de programação que estamos utilizando. Em primeiro lugar, toda linguagem de programação aceita comentários para esclarecer o funcionamento do programa. É altamente recomendável que o programador coloque comentários no programa, explicando a outros programadores (e também a ele mesmo) o funcionamento de determinado trecho de código. Em Tcl, comentários iniciam-se após o caractere #. A próxima linha, package require Tk diz que vamos utilizar a biblioteca gráfica Tk. Posteriormente, vamos utilizar várias outras bibliotecas e, portante, utilizaremos mais vezes o comando package require.

As próximas duas linhas são: 

# Cria os componentes
listbox .books -listvariable books

Os comentários já explicamos em parágrafo anterior. O mistério aqui é a linha que começa com listbox. Este é o comando para criarmos uma lista a ser posicionada na tela. Este é o widget (nome para "componente", na nomenclatura do Tk) que mostra a lista de itens adicionados no programa. O nome do widget é .books.

*Nota*: Aqui vale a pena explicar um pouco o significado desse nome. A janela principal de seu programa **sempre** terá um nome: . (ponto). Se essa janela for fechada o seu programa será finalizado. Todos os widgets criados (inclusive outras janelas, que veremos posteriormente) devem estar dentro ou dependentes desta janela, o que significa que o seu nome deverá vir depois do nome da janela ou widget em questão. Assim, .books significa "crie uma lista chamada books dentro da janela . (ponto)". Um outro exemplo que ajudaria a compreender a natureza hierárquica do posicionamento de widgets poderia ser explicado pelo trecho .avo.pai.filho.neto, onde o neto é filho de filho, que é filho de pai, que é filho de avo e assim por diante. Você compreenderá essa relação hierárquica com mais detalhes conforme for utilizando Tk para criar aplicações cada vez mais complexas.

O trecho -listvariable books é especial. Vamos trabalhar durante muito tempo com *variáveis*. Variáveis representam trechos da memória do computador. São "lugares" onde vamos armazenar as informações. Neste caso, precisamos dizer que os itens da lista .books estão na variável books. O nome da variável, neste programa, é o mesmo do nome dos componentes, mas isso é opcional.

A próxima linha é: 

entry .bookname -textvariable bookname

Este trecho é semelhante ao anterior. Criamos uma caixa de texto para o usuário digitar, que é feito pela palavra entry. O nome da caixa é .bookname. O ponto no início significa que ela ficará na janela principal da aplicação. O trecho -textvariable bookname indica a variável que estará associada ao conteúdo da caixa de texto. O nome dessa variável é bookname (Para mais informações sobre variáveis, verifique o capítulo _Variáveis_).

As próximas linhas são mais complexas: 

button .add -text Adicionar -command {
    lappend books $bookname
    set bookname ""
}

Observando o que você leu anteriormente, consegue também interpretar esse trecho de código? Criamos um botão chamado .add. O texto que estará escrito neste botão é passado pelo parâmetro -text e é Adicionar. A próxima parte é especial. É o parâmetro -command. É seguido por um *block de código* com instruções sobre o que fazer quando o botão é pressionado. Um bloco de código é composto por uma ou mais linhas de programação, com as instruções para o computador executar. Neste caso, se você já executou o programa acima, queremos que, a cada vez que o usuário clicar no botão, o programa faça duas coisas:

1. Incluir o nome do livro digitado na listbox acima.

2. Apagar o conteúdo da entry.

Essas instruções são exatamente as linhas do bloco de códigos. A primeira linha é lappend books $bookname. Você lembra o que são books e bookname? Variáveis que contém, respectivamente, o conteúdo da listbox e da entry. A variável $bookname tem um sinal de cifrão ($) antes porque não estamos interessados na variável em si, mas no **conteúdo** dela. Lembre-se: Em Tcl, sempre que você utilizar um cifrão antes do nome da variável, significa que você está obtendo o conteúdo que está armazenado dentro dela.

Por fim, o comando lappend requer mais atenção. Veja o seguinte código: 

lappend  numeros  1
lappend  numeros  2
lappend  numeros  3

Neste exemplo temos uma variável chamada numeros. Utilizamos o comando lappend para add a esta variável ou números 1, depois 2 depois 3. Ao final, teremos uma lista {1 2 3}. O comando lappend, portanto, adiciona um item em uma lista. Note a ordem dos parâmetros: a variável que será a lista a ser aumentada é sempre o primeiro parâmetro.

Então, o que significa o trecho lappend books $bookname? Significa que o computador está obtendo o conteúdo da variável bookname e adicionando na lista books. Lembre-se bookname é a variável associada à entry que acabamos de criar e books é a lista associada à listbox. Logo, ao fazer isso, ele irá mostrar o nome do livro digitado na listbox.

Por fim, o trecho set bookname "" também opera de maneira análoga. set é um comando que utilizaremos muito para definir o valor de uma variável. Neste caso, o valor "". Aqui, vale a pena também dar alguns exemplos: 

set  variavel1  "Oi, tudo bem?"
set  variavel2  123
set  variavel3  $variavel1
set  variavel4  ""

Neste caso, estamos definindo três variáveis. A variavel1 recebe o texto Oi, tudo bem?? As aspas são opcionais em algumas situações, mas vamos tratar disso em outra ocasião. A variavel2 recebe o número 123. Aqui não estamos utilizando aspas, mas poderíamos utilizar. Normalmente, em Tcl, evitamos utilizar aspas quando o valor é um numeral. A variavel3 recebe o valor da variavel1, ou seja, o texto Oi, tudo bem?. Por fim, a variavel4 recebe um valor vazio.

Voltando ao código, o que significa a linha set bookname ""? Que a variável bookname recebe um valor vazio (ou, em outras palavras, tem seu conteúdo apagado). Como a variável bookname está associada à entry .bookname, o conteúdo desta caixa de texto é apagado.

Então, finalizamos o programa com as seguintes linhas: 

# Posiciona os componentes na tela
grid .books
grid .bookname
grid .add

O comando grid somente posiciona os componentes na tela. Somente criá-los não é suficiente: eles ficarão na memória mas não aparecerão na tela até você utilizar o comando grid ou os comandos pack e place que veremos adiante. Posteriormente, também aprederemos a utilizar os parâmetros do comando grid para construir interfaces cada vez mais complexas.

**Exercícios**

1. Melhore a interface acima criando um outro botão com o texto "Apagar" para apagar o conteúdo da lista. Por enquanto o botão não precisa ter nenhuma funcionalidade.

Iniciando a construção da aplicação

Alto e baixo nível

Variáveis

Documentação

Programação e literatura

O fluxo de desenvolvimento e o fluxo de programação

Testando seu código

Apêndice 1: Instalando e utilizando o Tcl/Tk

Instalação do Tcl/Tk no NetBSD

Instalação do Tcl/Tk no Linux

Instalação do Tcl/Tk no Windows

Entre no site do Tcl, baixe e instale a aplicação *ActiveTcl* (a versão mais recente).

Tcl

Para executar os programas deste livro, basta criar o arquivo com a extensão .tcl (exemplo: arquivo.tcl) em qualquer editor de texto e, após inserir o código e salvar o arquivo, dar um duplo clique no arquivo. O *ActiveTcl* trás vários programas e bibliotecas utilizadas no decorrer deste livro, mas não traz um editor de texto. Para utilização de um editor de texto para iniciantes no Windows, recomendo o gedit.

Apêndice 2: Código-fonte do programa TclLearn

Código-fonte do programa TclLearn

<<tcllearn.tcl>>= 

# This is a very simple, zero dependency (depending only on Tcl and Tk) learn
# programming environment for Tcl/Tk.

package require Tk

#
# Global variables
#

# This program name
set ::appname {TclLearn}

# This variable will have the user input whenever the slave interp calls [gets].
set ::user_input {}

# An indication whether or nout .program should accept input.
set ::user_input_wait no

# This variable references a safe interpreter to run our Tcl code.  We create
# one immediately.
set ::interp [interp create -safe]

# The filename currently opened.
set ::filename {}

# The contents of .program
set ::program "\n"

# Whether or not the user modified current program (in comparison to the last
# save).  We cannot just use <<Modified>> binding of .program because we are
# using it to control when syntax highlight happen, so we keep a separated
# variable.
set ::modified no

#
# GUI
#

frame .toolbar
button .toolbar.btnnewfile -text New -command newfile
button .toolbar.btnopenfile -text Open -command openfile
button .toolbar.btnsavefile -text Save -command savefile
button .toolbar.btnsavefileas -text SaveAs -command savefileas
button .toolbar.btnplay -text Play -command play

# Program input.
label .programlb -text {Your program}
text .program -font {monospace 10} -yscrollcommand {.programsb set}
scrollbar .programsb -command {.program yview}

# Console (program output, but can also receive input if the programmer wants to
# use [gets].
label .consolelb -text {The console}
text .console -font {monospace 10} -yscrollcommand {.consolesb set}
scrollbar .consolesb -command {.console yview}

grid .toolbar -columnspan 4
pack .toolbar.btnnewfile -side left
pack .toolbar.btnopenfile -side left
pack .toolbar.btnsavefile -side left
pack .toolbar.btnsavefileas -side left
pack .toolbar.btnplay -side left
grid .programlb -row 1 -column 0 -sticky news
grid .program -row 2 -column 0 -sticky news
grid .programsb -row 2 -column 1 -sticky ns
grid .consolelb -row 1 -column 2 -sticky news
grid .console -row 2 -column 2 -sticky news
grid .consolesb -row 2 -column 3 -sticky ns

grid rowconfigure . 2 -weight 1
grid columnconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
grid columnconfigure . 2 -weight 1

#
# The next code is a modified version of the code present in
# https://wiki.tcl.tk/881 and it is also inspired by the code of tkcon.
# This is done so we allow .console to have a special behaviour for .console.
# Basically, it captures every input in .console, allowing it only, when the
# source program use [gets].  We add special treatment for Backspace and Return.
#

# We drop Text from the list of bindtags.
bindtags .console [list .console . all]
# And now we create our bind for <KeyPress>.
bind .console <KeyPress> {
    if {$::user_input_wait eq "no"} {
        return
    }
    %W mark set insert end
    %W insert insert %A
}
# But BackSpace deserves special treatment.
bind .console <BackSpace> {
    set startl [%W index "insert linestart"]
    # Only works on the current line
    if {[%W compare insert != $startl]} {
        %W delete insert-1c
        %W see insert
    }
}
# Handle <Return> specially, when waiting for user input.
bind .console <Return> {
    if {$::user_input_wait eq "no"} {
        return
    }
    set startl [%W index "insert linestart"]
    set endl [lindex [split $startl "."] 0].end
    set line [%W get $startl $endl]
    set ::user_input $line
    %W mark set insert end
    # we use \n because %A prints a box (it is probably \r)
    %W insert insert \n
}

#
# .program also has some special treatment.
#

# Whenever it gets modified, redraw syntax highlight.
bind .program <<Modified>> {
    highlight %W
    .program edit modified false
}
#bind .program <KeyPress> {
#    set ::program [.program get 0.0 end]
#}
bind .program <KeyRelease> {
    set text [.program get 0.0 end]
    if {$::program ne $text} {
        set ::modified yes
    }
    # So we add the suffix indicating the program was modified.
    set_toplevel_title
}
# How to keep indentation, thanks http://wiki.tcl.tk/15619
bind .program <Return> {handleEnter %W; break}
proc handleEnter {w} {
    # First, delete the current selection
    if {[$w tag nextrange sel 1.0] != ""} {
        $w delete sel.first sel.last
    }

    # Find the whitespace at the start of the current line
    set startl [$w index "insert linestart"]
    set endl [lindex [split $startl "."] 0].end
    regexp {^([ \t]*)} [$w get $startl $endl] -> ws

    # Create a newline, insert whitespace
    $w insert [$w index insert] "\n$ws"
    # If necessary, scroll the view so cursor is visible
    $w see [$w index insert]
}

# Add tags to color the text.
.program tag configure KEYWORD -foreground blue -font {monospace 10 bold}
.program tag configure IDENTIFIER -foreground red -font {monospace 10 bold}
.program tag configure STRING -foreground green -font {monospace 10 bold}
.console tag configure ERROR -foreground red

#
# We've finally setup our GUI (with its internal logic to have finer control of
# widgets behaviour).  Let's now handle our program logic.
#

# Just set the top level title.  It takes care of adding a suffix (currently,
# "*") to indicate whether or not the current program was modified.
proc set_toplevel_title {{filename {}}} {
    set suffix {}
    if {$::modified eq {yes}} {
        set suffix *
    }
    if {$::filename eq {}} {
        wm title . "$::appname$suffix"
    } else {
        wm title . "$::appname: [file tail $::filename]$suffix"
    }
}

#
# Commands for the buttons in the toolbar.
#

# Creates a new file.
proc newfile {} {
    set ret [save_maybe]
    if {$ret eq "cancel"} {
        return
    }
    set ::filename {}
    .program delete 1.0 end
    set ::modified no
    set ::program "\n"
    set_toplevel_title
}

# Reads a file from the file system.
proc openfile {} {
    set filename [tk_getOpenFile -filetypes {{{Tcl Scripts} {.tcl}}}]
    if {$filename eq ""} {
        return
    }
    set ::filename $filename
    set file [open $filename r]
    set data [read $file]
    .program delete 1.0 end
    .program insert insert $data
    set ::program "$data\n"
    close $file
    set ::modified no
    set_toplevel_title
}

# Save a file to the file system.
proc savefile {} {
    if {$::filename eq {}} {
        savefileas
    } else {
        save $::filename
    }
}

# Saves a file to the file system, but always prompt the save dialog.
proc savefileas {} {
    set filename [tk_getSaveFile -filetypes {{{Tcl Scripts} {.tcl}}}]
    if {$filename eq ""} {
        return ""
    }
    set ::filename $filename
    save $::filename
    return $::filename
}

# Saves the content of the text to the file which path is $filename.  Used by
# [savefile] and [savefileas].
proc save {filename} {
    set file [open $filename w]
    set data [.program get 0.0 end]
    set ::program $data
    set data [string range $data 0 end-1]
    puts $file $data
    close $file
    set ::modified no
    set_toplevel_title
    return $::filename
}

# Given a list of vars $varlist with one or more elements, sets a variable for
# each element in $varlist with the contents of the respective element in $list.
#
# For example:
#
# mset {a b} {1 2}
#
# will set $a = 1 and $b = 2.
proc mset {varlist list} {
    foreach var $varlist value $list {
        upvar $var myvar
        set myvar $value
    }
}

# Tcl simple highlight code.  Only keywords, variables and strings.
# Inspired by https://www.tcl.tk/community/hobbs/tcl/src/tcl2html.tcl
proc highlight {w} {
    foreach tag [$w tag names] {
        $w tag remove $tag 1.0 end
    }
    set alltext {}
    foreach {_ what _} [$w dump -text 1.0 end] {
        append alltext $what
    }

    set re {\$[[:alnum:]]+}
    hi_re $w $alltext IDENTIFIER $re

    # A list of keywords to highlight.  All available commands on the safe
    # interpreter (fetched by using [info commands], plus {else} and {elseif}.
    set commands {tell subst eof list pid time eval lassign lrange fblocked
        lsearch gets case lappend proc throw break variable llength return
        linsert error catch clock info split array if coroutine concat join
        lreplace fcopy global switch update close for append lreverse format
        lmap read package set namespace binary scan apply trace seek zlib while
        chan flush after vwait dict uplevel continue try foreach lset rename
        fileevent yieldto regexp lrepeat upvar tailcall expr unset regsub interp
        puts incr lindex lsort string yield else elseif}

    set re "\[\[:<:\]\]([join $commands |])\[\[:>:\]\]"
    hi_re $w $alltext KEYWORD $re

    set re {".*?"}
    hi_re $w $alltext STRING $re
}
proc hi_re {w text tag re} {
    set indices [regexp -inline -all -indices $re $text]
    foreach v $indices {
        mset {i j} $v
        set i [$w index "0.0+$i chars"]
        incr j
        set j [$w index "0.0+$j chars"]
        $w tag add $tag $i $j
    }
}

#
# Aliases for the safe interpreter.
#

# [puts]
#
# TODO: This currently only supports the form [puts string], it doesn't
# support [puts ?-nonewline? ?channelId? string].
proc puts_ {args} {
    set str [lindex $args end]
    .console insert insert "$str\n"
}

# [gets]
#
# TODO: This currently only form [gets stdin varname], this will not work for
# other channels besides stdin nor without variables..
proc gets_ {args} {
    interp limit $::interp time -seconds 0
    mset {chan varname} $args
    .console mark set insert end
    focus .console
    set ::user_input_wait yes
    vwait ::user_input
    set time [expr {[clock seconds] + 5}]
    interp limit $::interp time -seconds 0
    interp eval $::interp [list set $varname $::user_input]
    set ::user_input_wait no
}

# Finally run our program.
proc play {} {
    # Clean the console.
    .console delete 1.0 end
    # We create a different interpreter every play to clean the environment
    if {[interp exists $::interp]} {
        interp delete $::interp
    }
    .toolbar.btnplay configure -state disabled
    set ::interp [interp create -safe]
    interp alias $::interp puts {} puts_
    interp alias $::interp gets {} gets_
    set code [.program get 0.0 end]
    set time [expr {[clock seconds] + 5}]
    interp limit $::interp time -seconds $time
    set error [catch {
        interp eval $::interp $code
    } res opt]
    if {$error} {
        .console tag add ERROR end
        .console insert insert [dict get $opt -errorinfo] ERROR
    }
    .toolbar.btnplay configure -state active
}

# Checks if the file was modified.  If yes, ask for the user if she/he wants to
# save the file.
#
# Returns:
#
# no -> The file wasn't modified.
# cancel -> The user cancelled the operation by clicking Cancel on the first
# tk_messageBox or on the tk_getSaveFile called by [savefile].
proc save_maybe {} {
    # If the file was not modified, return immediately.
    if {$::modified eq {no}} {
        return no
    }
    # Else, ask the user if she/he wants to save the file.
    set ret [tk_messageBox \
        -parent . \
        -title "Save file" \
        -message {Save file?}\
        -type yesnocancel]
    # If the user clicked {cancel}, return it to the caller.
    if {$ret in {no cancel}} {
        return $ret
    }
    # If the user clicked "yes", try to save the file.
    if {$ret eq "yes"} {
        if {[savefile] eq ""} {
            return cancel
        }
    }
    return yes
}

# When closing the window, ask whether or not the user wants to save the file.
wm protocol . WM_DELETE_WINDOW {finish}
proc finish {} {
    set ret [save_maybe]
    if {$ret eq "cancel"} {
        return
    }
    exit
}

set_toplevel_title

# TODO: implement "main" receiving args to open Tcl files automatically from
# operating system.

Apêndice 3: Códigos para testar os programas deste livro

Listagem de todos os programas de teste

<<hello-world-1.test.tcl>>= 

source-file hello-world-1.tcl
type console
stdout-expected "Olá mundo"

<<management1.test.tcl>>= 

source-file management1.tcl
type eventloop
# Check ::bookname variable and entry correspondance
eventloop-tests {
    run {
        set ::bookname "a book name"
    }
    assert {[.bookname get] eq "a book name"}

    # Check one item inclusion
    run {
        set ::bookname "foo"
        .add invoke
    }
    assert {$::books eq "foo"}
    assert {$::bookname eq {}}

    # Check another item inclusion
    run {
        set ::bookname "bar more"
        .add invoke
    }
    assert {$::books eq [list foo {bar more}]}
    assert {$::bookname eq {}}
}

<<tcllearn.test.tcl>>= 

source-file tcllearn.tcl
type eventloop
wait-for-window .program

#
# Helper procs
#

# Retrieve text from .program widget.
proc program-get {} {
    string range [.program get 0.0 end] 0 end-1
}

# Simulating inserting text to .program widget by inserting each keystroke at a
# atime.  Variable $text is broken up and every char is inserted separately
# using program_generate_event.
proc program-set {text} {
    .program delete 1.0 end
    focus -force .program
    for {set i 0} {$i < [string length $text]} {incr i} {
        set ch [string index $text $i]
        program_generate_event .program $ch
    }
}

# Simulating sending a keystroke to widget pointed by $w.  This is used by
# program-set proc to insert text into .program.
proc program_generate_event {w ch} {
    switch $ch {
        " " {event generate $w <KeyPress-space> -when now}
        "$" {event generate $w <KeyPress-dollar> -when now}
        "<" {event generate $w <KeyPress-less> -when now}
        ">" {event generate $w <KeyPress-greater> -when now}
        "\n" {event generate $w <KeyPress-Return> -when now}
        "{" {event generate $w <KeyPress-braceleft> -when now}
        "}" {event generate $w <KeyPress-braceright> -when now}
        default {
            event generate $w <KeyPress-$ch> -when now
        }
    }
    event generate .program <KeyRelease> -when now
}

# Retrieve text from .console
proc console-get {} {
    string range [.console get 0.0 end] 0 end-1
}

# Next proc are called by the test to rewrite Tk's tk_getSaveFile and
# tk_messageBox.  Since we cannot easily control these toplevels in a
# programmatic way (is it possible?).  The new tk_getSaveFile and tk_messageBox
# does two things:
#
# 1. set tk_getSaveFile_called and tk_messageBox_called so we can check if
#    tk_getSaveFile and tk_messageBox really was called.
#
# 2. return $response, so we can test behaviour when the user clicked "yes",
#    "no" or "cancel".

proc def_tk_getSaveFile {response} {
    variable tk_getSaveFile_called 0
    proc ::tk_getSaveFile {args} "
        set test::tk_getSaveFile_called 1
        return $response
    "
}
proc def_tk_messageBox {response} {
    variable tk_messageBox_called 0
    proc ::tk_messageBox {args} "
        set test::tk_messageBox_called 1
        return $response
    "
}

eventloop-tests {
    # First check window title
    assert {[wm title .] eq "TclLearn"}

    # Running and playing a normal procedure
    run {
        program-set {
            for {set i 0} {$i < 3} {incr i} {
                puts $i
            }
        }
        .toolbar.btnplay invoke
    }
    assert {[console-get] eq "0\n1\n2\n"}
    assert {[wm title .] eq "TclLearn*"}

    # Then, clicking in new.  Should ask for the user if he/she wants to
    # save the file.
    run {
        def_tk_messageBox yes
        def_tk_getSaveFile ""
        .toolbar.btnnewfile invoke
    }
    assert {$test::tk_messageBox_called == 1}
    assert {$test::tk_getSaveFile_called == 1}
    assert {$::modified eq {yes}}
    assert {[wm title .] eq "TclLearn*"}

    # Creating a new file.  Should prompt the user if he/she wants to save.
    # We chose not to save.
    run {
        def_tk_messageBox no
        .toolbar.btnnewfile invoke
    }
    assert {[program-get] eq ""}
    assert {$::modified eq {no}}
    assert {[wm title .] eq "TclLearn"}

    # Then finishing the program after adding anything to text widget.  We
    # should prompt the user if he/she wants to save the file.  We click
    # cancel to not finish the program.
    run {
        def_tk_messageBox cancel
        program-set {anything}
        ::finish
    }
    assert {$test::tk_messageBox_called == 1}

    # TODO: infinite loop test
    # TODO: Opening file after new file
    # TODO: Opening file after having adding file to text
    # TODO: Saving a file (have a tmp dir for file)
    # TODO: Opening a file (have a tmp dir for file)
    # TODO: Saving a file and clicking in new
    # TODO: Saving a file and clicking in open
    # TODO: Opening a file and clicking in save
    # TODO: Opening a file and clicking in new
    # TODO: saveas
    # TODO: test [gets stdin var]
}

Framework de teste

<<test-framework.tcl>>= 

namespace eval test {
    # Tests passed, failed and total
    variable passed 0
    variable failed 0
    variable total 0

    # All test files should specify what program they are testing.
    variable source-file none

    # Type of test.
    #
    # "console": a "stdout-expect" parameter should be given.  The program is
    # run and its output (standard output only, for now) is checked against
    # "stdout-expected".
    #
    # "eventloop": an "eventloop-tests" parameter should be provided.  It is
    # a block with "run" (code to be run) and "assert" (expr to be checked)
    # blocks.  "eventloop" is usually used by GUI applications.
    variable type none

    # The "stdout-expected" variable for console tests.  "none" for now.
    variable stdout-expected none

    # The "eventloop-tests" variable for eventloop.  "none" for now.
    variable eventloop-tests none

    # For "eventloop" tests, a widget should be used so the test framework can
    # wait until it becomes visible, in order to run the tests.
    variable wait-for-window none

    # The next proc sets variables above

    proc source-file {file} {
        variable source-file
        set source-file $file
    }

    proc type {t} {
        variable type
        set type $t
    }

    proc stdout-expected {e} {
        variable stdout-expected
        set stdout-expected $e
    }

    proc eventloop-tests {body} {
        variable eventloop-tests
        set eventloop-tests $body
    }

    proc wait-for-window {window} {
        variable wait-for-window
        set wait-for-window $window
    }

    # This proc should be called by another script.  This is meant to be a
    # public proc, while other procs (the ones above) are used inside test
    # scripts to specify the test to be run.
    proc run-test-file {testfile} {
        variable passed
        variable failed
        variable total
        variable type
        variable source-file

        source $testfile

        puts "=> Test: $testfile"

        switch $type {
            console {
                # For console tests, we execute the 
                variable stdout-expected
                try {
                    set temp [exec mktemp -d /tmp/www-programming-test.XXXXX]
                    exec tclsh ${source-file} > $temp/${source-file}.out
                    write-once $temp/${source-file}.expected ${stdout-expected}
                    exec diff -Nu $temp/${source-file}.expected \
                            $temp/${source-file}.out 
                    incr passed
                } trap CHILDSTATUS {results options} {
                    puts $results
                    incr failed
                } finally {
                    incr total
                    exec rm -rf $temp
                }
            }
            eventloop {
                variable eventloop-tests
                variable wait-for-window
                variable source-file
                namespace eval :: {source ${test::source-file}}
                if {${wait-for-window} ne {none}} {
                    tkwait visibility ${wait-for-window}
                }
                eval ${eventloop-tests}
            }
            default {
                puts "Invalid test type: $type"
                exit 1
            }
        }

        puts "=> Test passed: $passed"
        puts "=> Test failed: $failed"
        puts "=> Test total:  $total"
        puts "---"
    }

    proc write-once {filename contents} {
        set file [open $filename w]
        puts $file $contents
        close $file
    }

    proc run {body} {
        if {[catch {eval $body} res]} {
            puts $res
        }
    }

    proc assert {expr} {
        variable passed
        variable failed
        variable total
        if {[catch {set ret [expr $expr]} res]} {
            puts $res
            set ret 0
        }
        if {$ret == 0} {
            puts "Test failed"
            puts "Assert failed: $expr"
            puts "             : [subst $expr]"
            puts ""
            incr failed
        } else {
            incr passed
        }
        incr total
    }
}

<<run-tests.tcl>>= 

set passed 0
set failed 0
set total 0

foreach testfile $::argv {
    set interp [interp create]
    interp eval $interp [list apply {{testfile} {
        source test-framework.tcl
        test::run-test-file $testfile
    }} $testfile]
    incr passed [interp eval $interp {set test::passed}]
    incr failed [interp eval $interp {set test::failed}]
    incr total  [interp eval $interp {set test::total}]
    interp delete $interp
}

puts "=> Final results:"
puts "=> Tests passed: $passed"
puts "=> Tests failed: $failed"
puts "=> Tests total:  $total"

if {$total != ($passed + $failed)} {
    puts "Warning: Tests total != (passed + failed)"
}