

Em algum outro baú, mais fundo, devo ter as apostilas dos cursos.
:-)
(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 " &"))))))
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).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.runner à combinação de teclas H-RET (Hyper-Enter):(bind-keys global-keymap
...
"H-RET" (lambda () (runner))
...)

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-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)



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)
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)))

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))))
if não passa seu resultado para a sua continuação):(def fatorial(n)
(if (< n 2)
(return 1)
(return (* n (fatorial (sub1 n))))))
return):(def fatorial(n)
(return (if (< n 2)
1
(* n (fatorial (sub1 n))))))
(define (fatorial n)
(if (< n 2)
1
(* n (fatorial (sub1 n)))))






