Introspecção de módulos em Chicken Scheme

Abaixo está um pequeno procedimento para inspecionar símbolos de módulos importados no sistema Chicken (para a versão 4). É semelhante à função dir de Python.

(define (introspect #!optional symbol)
  (if symbol
      (let ((module-data (alist-ref symbol ##sys#module-table)))
        (if module-data
            (let-values (((_ module-symbols _) (##sys#module-exports module-data)))
              (map car module-symbols))
            (let loop ((syms (##sys#current-environment)))
              (if (null? syms)
                  '()
                  (let* ((sym/sym+prefix (car syms))
                         (sym+prefix (symbol->string (cdr sym/sym+prefix)))
                         (tokens (string-split sym+prefix "#" #t))
                         (prefix (car tokens)))
                    (if (equal? (->string symbol) prefix)
                        (cons (string->symbol (string-intersperse (cdr tokens) ""))
                              (loop (cdr syms)))
                        (loop (cdr syms))))))))
      (map car (##sys#current-environment))))

Exemplos de uso

$ csi -n

CHICKEN
(c)2008-2009 The Chicken Team
(c)2000-2007 Felix L. Winkelmann
Version 4.2.0 - SVN rev. 16023
linux-unix-gnu-x86 [ manyargs dload ptables applyhook ]
compiled 2009-10-20 on dellito (Linux)

#;1> ,l introspection.scm
; loading introspection.scm ...
#;1> (introspect)
()
#;2> (import html-utils)
; loading /usr/local/chicken-4.2.0/lib/chicken/4/html-utils.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/chicken.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/scheme.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/files.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/data-structures.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/srfi-13.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/posix.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/utils.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/html-tags.import.so ...
; loading /usr/local/chicken-4.2.0/lib/chicken/4/srfi-1.import.so ...
#;3> (introspect 'html-utils)
(tabularize itemize enumerate html-page combo-box hidden-input)
#;4> (introspect 'srfi-1)
(alist-cons alist-copy alist-delete alist-delete! any append! append-map append-map!
append-reverse append-reverse! assoc break break! car+cdr circular-list circular-list? 
concatenate concatenate! cons* count delete delete! delete-duplicates delete-duplicates! 
dotted-list? drop drop-right drop-right! drop-while eighth every fifth filter filter! filter-map 
find find-tail first fold fold-right fourth iota last last-pair length+ list-copy list-index 
list-tabulate list= lset-adjoin lset-diff+intersection lset-diff+intersection! lset-difference 
lset-difference! lset-intersection lset-intersection! lset-union lset-union! lset-xor lset-xor! 
lset<= lset= make-list map map! map-in-order member ninth not-pair? null-list? pair-fold 
pair-fold-right pair-for-each partition partition! proper-list? reduce reduce-right remove 
remove! reverse! second seventh sixth span span! split-at split-at! take take! take-right 
take-while take-while! tenth third unfold unfold-right unzip1 unzip2 unzip3 unzip4 unzip5 xcons 
zip)

Opções utilizadas nos diferentes níveis de otimização do GCC

Hoje surgiu uma dica interessante na lista de discussão do GCC. Está reproduzida abaixo:

From: "John (Eljay) Love-Jensen"
Subject: Re: How can I find out which optimizing techniques were used for  each function?
To: Byoungyoung Lee, GCC-help 
Date: Tue, 1 Dec 2009 04:51:11 -0800

Hi Byoungyoung Lee,

> Is there anyway in gcc to log the information about which compiler
> options were actually used to optimize each function?
> For example, if I compile a program with option -O3, how could I
> figure out which specific options (such as -funroll-loops or something
> like that) were used to optimize function X ?

I use this technique:

echo '' | gcc -O3 -fverbose-asm -S -xc - -o O3.s
cat O3.s

In the created O3.s assembly source comment, it mentions which flags were
enabled by the -O3 switch.

If you want a detailed assembly line-by-line diagnostic of which particular
optimization was used for a given algorithm, you'll have to do some more
sleuthing.

Such as using -fno-<flag> to disable all the flags, and enable them
one-by-one.

Or perhaps by dumping the compiler state after each optimization pass (which
I think is usually only used as a diagnostic aid for making changes to GCC
itself).

Also, the majority of optimizations do not have a toggle-able flag to
enable/disable them.  As I understand it...  -O1 enables a whole lot of
optimizations that do not have toggle-able flags.  -O2 enables a few more.
-O3 enables one-or-two more.

HTH,
--Eljay

Indentação de and-let* no Emacs

A indentação padrão do Emacs para a expressão and-let* não é das melhores. Abaixo está a expressão a ser avaliada no Emacs para fazer com que a indentação padrão de and-let* (Figura 1) fique como a da Figura 2:

(put 'and-let* 'scheme-indent-function 1)

Suporte a versionamento de bibliotecas de carga dinâmica para Chicken 4.2.0

Coloquei em http://parenteses.org/mario/misc/chicken-4.2.0-soname.patch um patch para a versão estável mais recente do sistema Chicken (4.2.0). Este patch recoloca o suporte a versionamento das bibliotecas de carga dinâmica usadas pelo runtime. Isso permite que várias versões do sistema Chicken convivam pacificamente quando instaladas no mesmo sistema operacional (i.e., o compilador de uma versão não tentará usar bibliotecas de carga dinâmica do compilador de outra versão).

O patch é, na verdade, um backport do suporte que existe na versão de desenvolvimento do sistema Chicken para a versão estável mais recente. A versão 4.3.0 deverá sair com esta correção.

Corrigindo o Sawfish no Ubuntu 9.10

Lamentavelmente, a versão do Sawfish fornecida pelo Ubuntu 9.10 contém um bug. Felizmente, há uma forma fácil de corrigi-lo. Abaixo está uma receita de bolo:

1. $ sudo apt-get source sawfish
2. $ sudo apt-get build-dep sawfish
3. $ cd sawfish-1.3.5.2
4. $ wget http://parenteses.org/mario/misc/sawfish-patch.diff
5. $ patch -p1 --ignore-whitespace < sawfish-patch.diff
6. $ dpkg-buildpackage -rfakeroot -uc -b
7. $ sudo dpkg -i ../sawfish_1.3.5.2-1_i386.deb

O passo 1 instala os fontes do pacote do sawfish.

O passo 2 instala os pacotes necessários para a compilação do sawfish.

O passo 3 é óbvio.

O passo 4 baixa o patch a ser aplicado para que o sawfish passe a funcionar (é o patch disponível em http://sawfish.wikia.com/wiki/Fix_sawfish_server_connection).

O passo 5 aplica o patch nos fontes do sawfish.

O passo 6 compila o código corrigido e gera os pacotes (.deb).

O passo 7 instala o pacote com o sawfish corrigido.

Com isso, os programas sawfish-client e sawfish-ui passam a funcionar normalmente.

$ sawfish-client 
sawfish 1.3.5.2, Copyright (C) 1999-2000 John Harper
sawfish comes with ABSOLUTELY NO WARRANTY; for details see the file COPYING

Enter `,help' to list commands.
user>

Don't cross my way

Na semana passada o Eduardo me enviou a versão final da música que gravou mais recentemente (Don't Cross My Way). A composição e as gravações de guitarra e vocal foram feitas por ele. A bateria foi gravada pelo Fábio Cruz (Tela), a gaita pelo Mateus Brod e o baixo por mim.

A música está disponível na página do Eduardo no MySpace.

Jogo para iPhone em Scheme

O Scheme hacker Alex Queiroz implementou o jogo Reverso para iPhone. Os comentários de Alex sobre a implementação do jogo estão em http://www.ventonegro.org/2009/10/scheme-hits-the-app-store/.

Certamente uma aplicação muito interessante da linguagem. Alex utilizou a implementação Gambit (assim como Chicken, compila Scheme para C) e diz que o código resultante é 90% Scheme e 10% Objective-C.

web-scheme para Chicken 4

Vou aproveitar a transição de versões do sistema Chicken (versão 3 -> versão 4, com algumas incompatibilidades) para lançar uma versão nova de web-scheme, totalmente incompatível com a versão anterior (para Chicken 3). Eu mesmo provavelmente serei o maior prejudicado pelas incompatibilidades. Sem exagero, devo ter algumas dezenas de milhares de linhas de código usando web-scheme e Chicken 3. Mas o momento é esse.

Se bem me lembro, a extensão web-scheme foi lançada em 2005 e, desde então, venho pensando em algumas melhorias que só podem ser implementadas quebrando a compatibilidade com versões anteriores. Como Chicken 4 de certa forma faz isso, vou aproveitar a onda. :-)

As duas maiores modificações são sintáticas.

Uma das coisas que me incomodam em web-scheme para Chicken 3 é o mapeamento direto de nomes de tags para procedimentos. Inicialmente me pareceu uma boa idéia, e na maioria dos casos é, mas há situações que tornam esse aspecto inconveniente. Por exemplo, o procedimento equivalente à tag map, deveria, a rigor, ser map. Obviamente isso causa problemas em Scheme.

Casos semelhantes ocorrem com tags com nomes muito usuais como select (Chicken define uma macro com esse nome), title, i ou object.

Em Chicken 4 há a possibilidade de se importar um módulo prefixando símbolos do módulo importado. Então, por exemplo, seria possível importar o módulo web-scheme prefixando os procedimentos por ws:. Nos casos como o do procedimento map, não usar um prefixo seria suicídio. É difícil algum código em Scheme não fazer uso de map. web-scheme para Chicken 3 coloca "de fábrica" o prefixo ws: nos procedimentos map e select, para evitar conflito de nomes com os respectivos procedimento e macro correspondentes. Isso já é meio feio em Chicken 3, em que não há uma forma direta para se importar uma biblioteca de extensão com um prefixo -- em Chicken 4 seria muito feio, pois se o usuário decide prefixar os símbolos do módulo, ficarão dois prefixos para map e select!

Decidi, então, modificar o nome de todos os procedimentos correspondentes a tags HTML e usar uma notação semelhante à usada por Hop. Assim, em vez de (pre "texto"), tem-se (<pre> "texto").

Não estou totalmente satisfeito com esta notação, pois é conflitante com a convenção de nomes de classes quando se usa um sistema de objetos. Em Scheme não chega a ser um grande problema, pois o uso de classes não é muito usual. Em Common Lisp essa decisão seria mais problemática, pois CLOS é bastante usado. Optei por essa sitaxe porque claramente lembra a sintaxe de tags HTML e provavelmente desenvolvedores para a Web associarão <pre> à tag pre de HTML e não à classe pre de algum código parte de um sistema de objetos.

A outra modificação é com relação à sintaxe para atributos e valores de atributos de tags. Em web-scheme para Chicken 3 usa-se da seguinte forma:

(a 'href "http://minha-url.com" "Minha URL")

Em web-scheme para Chicken 4 decidi usar parâmetros por palavra-chave para representar atributos. Fica, então, assim:

(<a> href: "http://minha-url.com" "Minha URL")

As razões para esta mudaça são puramente técnicas. No esquema usado em web-scheme para Chicken 3, precisei implementar um parser para extrair atributos e seus respectivos valores. Usando parâmetros por palavra-chave, ganho o parser "de brinde" de Chicken, melhor e mais rápido.

O esquema de atributos usado por web-scheme para Chicken 3 tem uma limitação chata quando espera-se poder usar ou não atributos em função do fluxo de execução do código. Exemplo: no caso de um procedimento text-input como um wrapper para o elemento input de tipo texto:

(define (text-input text #!key maxlength)
     (if maxlength
       (input 'type "text" 'maxlength maxlength 'value text)
       (input 'type "text" 'value text)))

Em web-scheme para Chicken 3 não há uma forma "fácil" (i.e., sem eval ou macros) de fazer isso sem duplicar código. Em web-scheme para Chicken 4 bastará:

(define (text-input text #!key maxlength)
    (<input> type: "text" maxlength: maxlength value: text)

O uso de parâmetros por palavra-chave dá essa flexibilidade, o que é tratado internamente pelo código que gera o HTML. Se o valor de um parâmetro for #f o par atributo/valor não é gerado. Em web-scheme para Chicken 3 geraria uma certa complicação nos casos de atributos que não requerem valor, como selected em elementos select.

Essas serão as modificações mais radicais. Haverá também modificações nos procedimentos extras de web-scheme, os quais não estão diretamente relacionados ao mapeamento tags->procedimentos. Mas essa parte ainda está em estudo.

Fatiamento de seqüências em Scheme

Python oferece uma funcionalidade interessante para ser usadas com seqüências (string, listas e qualquer objeto com o método __getslice__, suponho). O fatiamento de Python admite índices negativos, omissão de índices e índices maiores que o tamanho da seqüência.

Exemplos:

>>> "abcdef"[3:6]
'def'
>>> [1, 2, 3, 4, 5][:3]
[1, 2, 3]
>>> [1,2,3,4,5][:-3]
[1, 2]
>>> [1,2,3,4,5][-3:]
[3, 4, 5]
>>> [1,2,3,4,5][-10:]
[1, 2, 3, 4, 5]

A seguir está uma implementação de algo parecido para Chicken, que funciona com listas, vetores, strings e permite a adição de fatiadores personalizados para o procedimento slice.

#!/usr/bin/csi -script

(use (srfi 1 13))

(define slice
 (let ()
   (define (positive? n) (> n 0))
   (define (negative? n) (< n 0))
   (define (both-positive? n m) (and n m (>= n 0) (>= m 0)))
 
   (define (from/to from to len)
     (cond
      ((and from (> from len))         ; [XXX:2]
        #f)
      ((and (both-positive? from to)   ; [1:2]
             from to
            (> to from)
            (< to len))
       (cons from to))
      ((and (both-positive? from to)   ; [1:XXX]
             from to
            (> to from)
            (>= to len))
       (cons from len))
      ((and (both-positive? from to)   ; [2:1]
             from to
            (> from to))
       #f)
      ((and from                       ; [-1:]
             (< from 0)
            (not to))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             len))
      ((and (not from)                 ; [:-1]
             to
            (< to 0))
       (cons 0
             (if (>= (abs to) len)
                 len
                 (+ len to))))
      ((and from                       ; [1:]
             (>= from 0)
            (not to))
       (cons from len))
      ((and from to                    ; [-2:-1]
             (< from 0)
            (< to 0)
            (< to from))
       #f)
      ((and from to                    ; [-1:-2]
             (< from 0)
            (< to 0))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             (if (>= (abs to) len)
                 len
                 (+ len to))))      
      (else #f)))

   (define (generic-slicer obj from to ruler empty obj-slicer)
     (let* ((len (ruler obj))
            (from&to (from/to from to len))
            (from (and from&to (car from&to)))
            (to (and from&to (cdr from&to))))
       (if (and from to)
           (obj-slicer obj from to)
           empty)))

   (define (string-slice s from to)
     (generic-slicer s from to string-length "" substring))

   (define (list-slice l from to)
     (generic-slicer l from to length '()
                     (lambda (l from to)
                       (take (drop l from) (- to from)))))

   (define (vector-slice v from to)
     (define (subvector vector start end)
       (let ((sub (make-vector (- end start))))
         (let loop ((i 0))
           (if (< i (- end start))
               (begin (vector-set! sub i (vector-ref vector (+ i start)))
                      (loop (+ i 1)))))
         sub))
     (generic-slicer v from to vector-length '#() subvector))


   (let ((slicers
          (list (lambda (obj)
                  (and (string? obj)
                       string-slice))
                (lambda (obj)
                  (and (vector? obj)
                       vector-slice))
                (lambda (obj)
                  (and (list? obj)
                       list-slice)))))
     (lambda (obj #!optional from to)
       (if (procedure? obj)
           (set! slicers (cons obj slicers))
           (let loop ((slicers slicers))
             (if (null? slicers)
                 (error "No slicer for the given object.")
                 (let* ((slicer (car slicers))
                        (slice (slicer obj)))
                   (if slice
                       (slice obj from to)
                       (loop (cdr slicers)))))))))))

Abaixo está o arquivo de teste do código de fatiamento (usando a extensão test), o qual também serve como exemplo de uso.

#!/usr/bin/csi -script

(use test)

(load "slice.scm")

;;;
;;; Strings
;;;
(define s "1234567")

(display "s = ")
(pp s)
(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "1" (slice s 0 1))
(test "" (slice s 10 10))
(test "1234567" (slice s 0 10))
(test "" (slice s 10 0))

(test "1234567" (slice s 0))
(test "7" (slice s -1))
(test "" (slice s 10))
(test "1234567" (slice s -10))
(test "4567" (slice s -4))

(test "" (slice s -4 -4))
(test "45" (slice s -4 -2))
(test "" (slice s -4 -10))
(test "123" (slice s -10 -4))


;;;
;;; Lists
;;;
(define l '(1 2 3 4 5 6 7))

(newline)
(display "l = ")
(pp l)

(test '() (slice l 0 0))
(test '() (slice l 1 0))
(test '(1) (slice l 0 1))
(test '(2 3) (slice l 1 3))
(test '() (slice l 10 10))
(test '(1 2 3 4 5 6 7) (slice l 0 10))
(test '() (slice l 10 0))

(test '(1 2 3 4 5 6 7) (slice l 0))
(test '(7) (slice l -1))
(test '() (slice l 10))
(test '(1 2 3 4 5 6 7) (slice l -10))
(test '(4 5 6 7) (slice l -4))

(test '() (slice l -4 -4))
(test '(4 5) (slice l -4 -2))
(test '() (slice l -4 -10))
(test '(1 2 3) (slice l -10 -4))

;;;
;;; Vectors
;;;
(define v '#(1 2 3 4 5 6 7))

(newline)
(display "v = ")
(pp v)

(test '#() (slice v 0 0))
(test '#() (slice v 1 0))
(test '#(1) (slice v 0 1))
(test '#(2 3) (slice v 1 3))
(test '#() (slice v 10 10))
(test '#(1 2 3 4 5 6 7) (slice v 0 10))
(test '#() (slice v 10 0))

(test '#(1 2 3 4 5 6 7) (slice v 0))
(test '#(7) (slice v -1))
(test '#() (slice v 10))
(test '#(1 2 3 4 5 6 7) (slice v -10))
(test '#(4 5 6 7) (slice v -4))

(test '#() (slice v -4 -4))
(test '#(4 5) (slice v -4 -2))
(test '#() (slice v -4 -10))
(test '#(1 2 3) (slice v -10 -4))

;;;
;;; Custom object
;;;
(define-record custom-string text)

(define s (make-custom-string "custom string"))
(slice (lambda (obj)
        (and (custom-string? obj)
             (lambda (obj from to)
               (handle-exceptions
                exn
                ""
                (substring (custom-string-text obj) from to))))))

(newline)
(display "s = ")
(pp s)

(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "c" (slice s 0 1))

A seguir está a saída da execução do programa de teste:

s = "1234567"
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]
(slice s 10 10) ................................ [ PASS]
(slice s 0 10) ................................. [ PASS]
(slice s 10 0) ................................. [ PASS]
(slice s 0) .................................... [ PASS]
(slice s -1) ................................... [ PASS]
(slice s 10) ................................... [ PASS]
(slice s -10) .................................. [ PASS]
(slice s -4) ................................... [ PASS]
(slice s -4 -4) ................................ [ PASS]
(slice s -4 -2) ................................ [ PASS]
(slice s -4 -10) ............................... [ PASS]
(slice s -10 -4) ............................... [ PASS]

l = (1 2 3 4 5 6 7)
(slice l 0 0) .................................. [ PASS]
(slice l 1 0) .................................. [ PASS]
(slice l 0 1) .................................. [ PASS]
(slice l 1 3) .................................. [ PASS]
(slice l 10 10) ................................ [ PASS]
(slice l 0 10) ................................. [ PASS]
(slice l 10 0) ................................. [ PASS]
(slice l 0) .................................... [ PASS]
(slice l -1) ................................... [ PASS]
(slice l 10) ................................... [ PASS]
(slice l -10) .................................. [ PASS]
(slice l -4) ................................... [ PASS]
(slice l -4 -4) ................................ [ PASS]
(slice l -4 -2) ................................ [ PASS]
(slice l -4 -10) ............................... [ PASS]
(slice l -10 -4) ............................... [ PASS]

v = #(1 2 3 4 5 6 7)
(slice v 0 0) .................................. [ PASS]
(slice v 1 0) .................................. [ PASS]
(slice v 0 1) .................................. [ PASS]
(slice v 1 3) .................................. [ PASS]
(slice v 10 10) ................................ [ PASS]
(slice v 0 10) ................................. [ PASS]
(slice v 10 0) ................................. [ PASS]
(slice v 0) .................................... [ PASS]
(slice v -1) ................................... [ PASS]
(slice v 10) ................................... [ PASS]
(slice v -10) .................................. [ PASS]
(slice v -4) ................................... [ PASS]
(slice v -4 -4) ................................ [ PASS]
(slice v -4 -2) ................................ [ PASS]
(slice v -4 -10) ............................... [ PASS]
(slice v -10 -4) ............................... [ PASS]

s = #<custom-string>
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]

Spam via telefone

Como se não bastasse a praga de spams que assola o mundo dos e-mails, há algum tempo venho recebendo propagandas não solicitadas da própria companhia telefônica (TIM) -- tanto através de SMS como, ultimamente, por ligações e mensagens de voz.

Hoje decidi ligar para a TIM para ver se conseguia me livrar desse transtorno. O atendente me disse que não é possível desativar esse "serviço" e sugeriu que eu mandasse um e-mail para a ouvidoria TIM, cujo endereço estaria disponível no site da empresa. Quando eu disse que não faria por medo de começar a receber spam da TIM por e-mail também, ele mesmo deu uma risada discreta, como se estivesse pensando "ele tem razão, é muita burrice fazer isso".

Do fundo do baú

Em algum outro baú, mais fundo, devo ter as apostilas dos cursos. :-)

Disparador de programas para Sawfish

Havia tempos que eu queria um disparador de aplicações para usar com o Sawfish. Nunca tinha encontrado um que tivesse me agradado. Basicamente, gostaria de um que fosse simples, permitisse completar o nome de programas com TAB, que fosse rápido e que não ocupasse muita memória. Com uma rápida pesquisa na Internet, achei o código em http://www.skamphausen.de/cgi-bin/ska/download/runner.jl, o qual faz exatamente o que eu queria e satisfaz todos os meus requisitos: como é implementado em rep, não é preciso nem criar um novo processo; e a implementação é minúscula.

Depois de uma leve refatorada no código, estou usando o seguinte:

(require 'prompt)

(define (uniq l #!optional in)
  ;; Elimina replicas na lista L usando o procedimento IN para
  ;; verificar se um dado elemento se encontra na lista.
  (let ((unique '()))
    (let loop ((l l))
      (if (null l)
          unique
          (let ((head (car l)))
            (unless ((or in member) head unique)
              (setq unique (cons head unique)))
            (loop (cdr l)))))
    (reverse unique)))

(define runner
  (let* ((paths (uniq (delete-if-not file-directory-p
         (string-split ":" (getenv "PATH")))))
  (completions (uniq (apply append (mapcar directory-files paths)))))
    (lambda ()
      (interactive)
      (let ((cmd (prompt-from-list completions "Run: " "" t)))
 (system (concat cmd " &"))))))

Adicionei o procedimento uniq para eliminar eventuais réplicas na lista de comandos. Ela é mais flexível que uniquify-list, do Sawfish (a comparação é feita exclusivamente usando eq). uniq aceita um argumento opcional que é o procedimento de comparação (em caso de omissão, usa member).

O procedimento runner monta uma lista de elementos para serem usados como possíveis alternativas para completar palavras digitadas pelo usuário (tab completion), a qual é usada por prompt-from-list, do módulo prompt. As alternativas são os arquivos nos diretórios apontados pela variável de ambiente PATH.

Associei o procedimento runner à combinação de teclas H-RET (Hyper-Enter):

(bind-keys global-keymap
...
   "H-RET"  (lambda () (runner))
...)

A seguir está um screenshot:



O prompt criado pelo procedimento prompt-from-list define um mapa de teclas. Assim, quando em uso, o prompt aceita as seguintes combinações de teclas associadas a procedimentos (de prompt.jl, so Sawfish):

(bind-keys prompt-keymap
     "ESC" prompt-exit
     "C-g" prompt-exit
     "C-u" prompt-clear
     "BS" prompt-backspace
     "C-k" prompt-kill-line
     "Left" prompt-backward-character
     "C-b" prompt-backward-character
     "Right" prompt-forward-character
     "C-f" prompt-forward-character
     "C-Left" prompt-backward-word
     "M-b" prompt-backward-word
     "A-b" prompt-backward-word
     "C-Right" prompt-forward-word
     "M-f" prompt-forward-word
     "A-f" prompt-forward-word
     "C-a" prompt-beginning-of-line
     "C-e" prompt-end-of-line
     "TAB" prompt-complete
     "RET" prompt-accept
     "Up" prompt-previous
     "Down" prompt-next
     "M-n" prompt-next
     "M-p" prompt-previous
     "A-n" prompt-next
     "A-p" prompt-previous))

Sawfish

O Sawfish é um dos softwares da lista dos que eu não gostaria de parar de usar. Assim como o Emacs, é o tipo de software que, depois que se entende e aprende a usar, é difícil de largar.

O Sawfish durante algum tempo foi o gerenciador de janelas do ambiente de desktop Gnome. Por razões ainda não muito claras para mim, foi substituído pelo Metacity.

Assim como o Emacs, um dos grandes diferenciais do Sawfish é o fato de ser programável em uma linguagem de alto nível da família Lisp. Sawfish usa a linguagem rep (Read, Eval, Print), a qual inicialmente foi inspirada por Elisp (Emacs Lisp). A concepção do Sawfish segue a mesma linha do Emacs: prover uma API em uma linguagem de alto nível para desenvolvimento voltado às aplicações a que se destina (abstração). Manipulação de texto no caso do Emacs e gerenciamento de janelas no caso do Sawfish. Com base na API de alto nível, os aplicativos são desenvolvidos. Assim são desenvolvidos o Emacs e o Sawfish. A maior parte do código do Emacs é em Elisp e a maior parte do código do Sawfish é em rep.

O fato de prover uma API para desenvolvimento em uma linguagem de alto nível faz com que o Sawfish seja altamente (e facilmente!) personalizável e extensível. Além das possibilidades de configuração e extensão através de código em rep, Sawfish também dispõe de um configurador gráfico, o qual, por baixo dos panos, apenas gera e executa código rep para configurar o gerenciador de janelas (similar à interface para personalização do Emacs).



Seguindo a tradição de linguagens Lisp e de aplicativos que usam Lisp como linguagem de extensão/implementacao, Sawfish também oferece um REPL para avaliação de expressões rep. Abaixo está um exemplo de sessão com o REPL do Sawfish:

$ sawfish-client
sawfish 1.3.3, Copyright (C) 1999-2000 John Harper
sawfish comes with ABSOLUTELY NO WARRANTY; for details see the file COPYING

Enter `,help' to list commands.
user> (define emacs (get-window-by-name-re "emacs.*"))
user> emacs
#<window 1e00011>
user> (window-name emacs)
"emacs@mandolate"
user> (window-visible-p emacs)
t
user> (window-iconified-p emacs)
()
user> (window-dimensions emacs)
(798 . 742)
user> (window-border-width emacs)
0
user> (window-framed-p emacs)
t
user> (window-depth emacs)
0
user> (window-absolute-position emacs)
(68 . 0)
user> (window-sticky-p emacs)
()
user> (move-window-to emacs 200 100)
#<window 1e00011>
user> (window-absolute-position emacs)
(200 . 100)

O Manual de Programação do Sawfish documenta a API para programação e extensão do gerenciador de janelas.

Abaixo está um screenshot com temas pouco usuais do sawfish (cada janela pode ser decorada com um tema diferente).



A seguir está um exemplo de aplicação feita na linguagem de extensão do Sawfish. Os aplicativos no canto superior esquerdo da tela são dockapps (aqui há vários deles). Quando um dockapp é executado em um gerenciador de janelas sem suporte a dock, o aplicativo é mostrado como uma janela normal, com bordas, decorações e respondendo a eventos como qualquer outra janela. Quando o gerenciador de janelas oferece suporte a dockapps, ou quando se usa um programa externo para gerenciar dockapps, eles são mostrados como no screenshot e têm comportamento diferenciado (são exibidos em todas as áreas de trabalho, não são cobertos por outras janelas quando elas são maximizadas etc).



A extensão para gerenciamento de dockapps pode ser obtida em http://paginas.ucpel.tche.br/~mario/english/utils/sawdock/.

Criptografia simples (ingênua)

A seguir está um esquema simples de criptografia para autenticação em páginas web. Não é um esquema seguro e não envolve chaves públicas (criptografia de chaves assimétricas).

O esquema consiste em apresentar para o usuário uma matriz de números aleatórios (puzzle) para que ele possa dali extrair o texto a ser enviado para ser validado. A cada acesso à pagina uma matriz aleatória nova é exibida. Somente o usuário e o software para valição de senha sabem o segredo (chave) para determinar se a senha está ou não correta.

Na implementação mostrada a seguir (em Chicken Scheme), o código para valição de senha verifica se:

• a senha possui quatro caracteres


• o primeiro caractere da senha é igual ao caractere do canto superior esquerdo da matriz de números


• o segundo caractere da senha é igual ao caractere do canto superior direito da matriz de números


• o terceiro caractere da senha é igual ao caractere do canto inferior esquerdo da matriz de números


• o quarto caractere da senha é igual ao caractere do canto inferior direito da matriz de números

Ou seja, o validador verifica se a senha corresponde aos números dos quatro cantos da matriz números concatenados no sentido horário, começando pelo canto superior esquerdo.

Obviamente o validador de senha é dos mais simples, mas poderia usar técnicas mais elaboradas como, por exemplo, o código de Beale. Neste caso, o validador teria um texto padrão, o qual seria de conhecimento do usuário, e os números da matriz indicariam a posição das letras no texto. Assim, o usuário digitaria as letras correspondentes às posições do texto indicadas em lugares pré-determinados da matriz (o uso da matriz é uma otimização sobre o código de Beale -- originalmente seriam apresentados apenas os números indicando a posição das letras no texto).

O código de servidor web (extensão spiffy de Chicken) está abaixo (web-server.scm):

#!/usr/bin/csi -script

(use spiffy spiffy-utils web-scheme web-scheme-handler (srfi 1 13))

(spiffy-file-ext-handlers `(("ws" . ,web-scheme-handler)))
(spiffy-tcp-port 8080)
(spiffy-root-path "./")

(start-server)

A implementação do esquema de autenticação está a seguir (index.ws):

(define (make-puzzle)
  ;; Retorna uma lista de listas de numeros aleatorios entre 0 e 9
  ;; (inclusive 0 e 9).
  (let* ((line-length 40)
         (num-columns 10)
         (random-line
          (lambda ()
            (map (lambda (_) (random 10))
                 (iota line-length)))))
    (map (lambda (_)
           (random-line))
         (iota num-columns))))

(define (valid-passwd? passwd puzzle)
  ;; Chave (ingenua): a senha corresponde aos numeros dos cantos da
  ;; tabela de numeros concatenados no sentido horario, comecando pelo
  ;; canto superior esquerdo.

  (define ($ pos)
    ;; Retorna o caractere da posicao POS em PASSWD, ou #f se POS nao
    ;; existir em PASSWD.
    (handle-exceptions exn #f (->string (string-ref passwd pos))))

  (define (check pw-pos key-pos)
    (equal? ($ pw-pos) (number->string key-pos)))
    
  (and passwd
       (= (string-length passwd) 4)
       (check 0 (caar puzzle))
       (check 1 (last (car puzzle)))
       (check 2 (car (last puzzle)))
       (check 3 (last (last puzzle)))))

(define (auth-page #!optional preamble)
  ;; Pagina de autenticacao.
  (ws:page
   (let ((puzzle (make-puzzle)))
     (center
      (if preamble (p preamble) "")
      (ws:make-table puzzle)
      (form 'method "post"
            (input 'type "hidden" 'name "puzzle"
                   'value (with-output-to-string (cut pp puzzle)))
            (input 'type "password" 'name "passwd")
            (input 'type "submit"))))))

(let ((passwd (post-var "passwd"))
      (puzzle (post-var "puzzle")))
  (if (and puzzle passwd)
      (if (valid-passwd? passwd (with-input-from-string puzzle read))
          (ws:page "Senha correta")
          (auth-page "Senha errada!"))
      (auth-page)))

Camiseta do projeto Chicken!

Há umas semanas, Felix Winkelmann, autor e principal desenvolvedor do projeto Chicken Scheme, gentilmente me enviou um e-mail informando que me mandaria uma camiseta do projeto Chicken. Hoje, para a minha felicidade, recebi a camiseta. Muito bonita. :-)



Um tempo atrás tentei fazer uma camiseta dessas no site http://www.camisaonline.com.br/ mas fui roubado. Efetuei o pagamento e nunca recebi a camiseta nem resposta para os vários e-mails que enviei para o endereço de contato. Não comprem desse site.

Definição de procedimentos e return explícito

A seguir está um pequeno hack em Chicken Scheme usando procedimento de escape (via call/cc) e definição de macros ao estilo de Common Lisp. No final das contas, tem-se definições de função como em Python ou Ruby, incluindo return explícito (para os masoquistas).

(define-macro (def procname args . body)
  `(define (,procname ,@args)
     (call/cc (lambda (return)
                ,@body))))

Exemplo de uso (considerando programadores de linguagens cujo if não passa seu resultado para a sua continuação):

(def fatorial(n)
     (if (< n 2)
         (return 1)
         (return (* n (fatorial (sub1 n))))))

Exemplo de uso (considerando um schemer sendo obrigado a usar return):

(def fatorial(n)
     (return (if (< n 2)
                 1
                 (* n (fatorial (sub1 n))))))

Código equivalente em Scheme puro:

(define (fatorial n)
  (if (< n 2)
      1
      (* n (fatorial (sub1 n)))))