dc suite à la page Gmail en pop3 et Gmail en imap, voici un petit notificateur du nombre de messages qui se place en haut à droite de l'écran et qui se masque automatiquement. Le script se décompose bien distinctement, la première partie met en place la zone de notification, la seconde l'utilise pour y mettre le nombre de messages dans la boîte actuellement (ici, rafraîchissement toutes les 2 minutes).
Un clic droit donne des infos sur les Libellés, le "bouton du milieu" permet de voir les expéditeurs et le sujet des messages non archivés (les non lus en gras), et enfin le clic gauche ouvre le navigateur sur la page des messages non archivés.
Pour éviter le problème de poster mon code avec mes id. et mots de passe (cf. Discussion), j'ai créé deux variables d'environnement dans ~/.profile : GMAILUSER et GMAILPASS.
# Code du 8 mai 2008
########################## ASPECT ###########################
package require Tk
# pour mes tests et eviter les chevauchements avec
# la version courante mettre la variable 'test' à 1
set test 0
if {$test eq 0} {
set positionYON +0
} else {
set positionYON +33
}
set visibilite 1
set largeur 100
set hauteur 32
wm geometry . ${largeur}x${hauteur}-0${positionYON}
wm overrideredirect . 1
set lecran [winfo screenheight .]
set Lecran [winfo screenwidth .]
pack [canvas .c -highlightt 0 -bg white -borderwidth 0 ]
bind .c <Enter> changeVisibilite
bind .c <Leave> enclencheDisparition
proc enclencheDisparition {} {
global id_disp
set id_disp [after 5000 {
set nv_posx [expr {$Lecran-3}]
#set nv_posy [expr {$lecran-3}]
wm geometry . +${nv_posx}${::positionYON}
set visibilite 0
}]
}
proc changeVisibilite {} {
global visibilite id_disp
if {$visibilite eq 1} {
# je reviens dans l'intervalle de
# disparition -> j'annule la disparition
# je catche car au lancement la visibilité est à 1
catch {after cancel $id_disp}
}
wm geometry . -0${::positionYON}
set visibilite 1
}
proc apparitionPeriodique {} {
changeVisibilite
enclencheDisparition
# toutes les 5 minutes
after 300000 apparitionPeriodique
}
apparitionPeriodique
################# FONCTION #############################
package require tls
set idMail $::env(GMAILUSER)
set passMail $::env(GMAILPASS)
set compteur 0
proc Write {chan} {
fileevent $chan writable {}
tls::handshake $chan
fconfigure $chan -buffering line -blocking 0 -translation crlf
### liste des tâches ###
animationAttente 0
attenteReponse $chan {\* OK}
identification $chan
set nb [recupNbMessages $chan]
set listeNM [recupInfoMessages $chan $nb]
set listeL [recupereListeArchives $chan]
recupereInfoLibelles $chan $listeL
stopAnimationAttente
########################
afficheResultat $nb $listeL $listeNM
aurevoir $chan
}
proc animationAttente {x} {
if {$x >= $::largeur} {
set x 0
}
.c delete animation
.c create rectangle $x 0 [expr {$x+15}] $::hauteur -width 0 \
-fill lightblue -tags animation
#.c create text [expr {$::largeur/2}] [expr {$::hauteur/2}]\
#-text Consultation... -tags animation
.c raise n animation
.c raise G animation
.c raise msg animation
incr x 5
update
set ::idAnimation [after 200 "animationAttente $x"]
}
proc stopAnimationAttente {} {
after cancel $::idAnimation
.c delete animation
return
}
proc afficheResultat {nb lL lNM} {
#### affichage nombre des messages
set x [expr {$::largeur/4}]
set y [expr {$::hauteur-6}]
.c delete all
.c create text $x $y -text $nb -anchor se \
-font "Helvetica 12 bold" -fill red -tags n
.c create text [expr {$x+3}] $y -text G \
-font "Helvetica 12 bold" -fill blue -anchor sw -tags G
set x [expr {[lindex [.c bbox G] 2]}]
if {$nb <= 1} {
set msg Message
} else {
set msg Messages
}
.c create text $x $y -text $msg -anchor sw -tags msg
### affichage du menu-popup des libellés
destroy .m
menu .m -tearoff 0
foreach l $lL {
.m add command -label "$l : [set ::[set l](total)]\
messages [set ::[set l](paslu)] non lus" -command [list cliqueLibelle $l]
}
##
destroy .n
menu .n -tearoff 0 -font "Courier 8"
# on inverse la liste des messages (les derniers en premier)
set long [llength $lNM]
set etsil {}
while {[incr long -1] >= 0} {lappend etsil [lindex $lNM $long]}
foreach e $etsil {
foreach {f s v} $e {
if {$v} {
set police {Courier 8}
} else {
set police {Courier 8 bold}
}
.n add command -command [list ouvertureClientMail]\
-label "[string range $f 0 30] [string range $s 0 50]" -font $police
}
}
##
bind .c <3> {tk_popup .m %X %Y}
bind .c <2> {tk_popup .n %X %Y}
}
proc cliqueLibelle {lib} {
#tk_messageBox -message $bouton
ouvertureClientMail $lib
}
proc prefixe {} {
return [format A%03d [incr ::compteur]]
}
proc attenteReponse {chan c} {
set l [gets $chan]
while {![regexp $c $l]} {
update
set l [gets $chan]
#if {$l!=""} {puts $l}
}
puts $l
return $l
}
proc envoiCommande {chan com {c {A[0-9]+}}} {
puts $chan $com
attenteReponse $chan $c
}
proc identification {chan} {
envoiCommande $chan "[prefixe] LOGIN $::idMail $::passMail"
}
proc aurevoir {chan} {
envoiCommande $chan "[prefixe] LOGOUT"
set ::forever 1
}
proc recupNbMessages {chan} {
puts $chan "[prefixe] SELECT INBOX"
set l [gets $chan]
while {![regexp {A[\d]+} $l]} {
update
if {[regexp {([\d]+) EXISTS$} $l -> nb]} {
puts "$nb nouveaux messages"
}
set l [gets $chan]
}
puts $l
return $nb
}
proc recupereListeArchives {chan} {
puts $chan "[prefixe] LIST \"\" %"
set listeLibelles [list]
set l [gets $chan]
while {![regexp {A[\d]+ OK Success} $l]} {
update
if {[regexp {LIST \(.*\) \"/\" \"(.*)\"} $l -> libelle]} {
lappend listeLibelles $libelle
}
#if {$l!=""} {puts $l}
set l [gets $chan]
}
# un libellé nommé [Gmail] fout sa *#!$(
set i [lsearch -exact $listeLibelles {[Gmail]}]
set listeLibelles [lsort -dictionary [lreplace $listeLibelles $i $i]]
return $listeLibelles
}
# la procédure crée des tableaux au niveau global du nom des libellés
proc recupereInfoLibelles {chan lL} {
foreach libelle $lL {
global $libelle
puts $chan "[prefixe] SELECT $libelle"
set l [gets $chan]
while {![regexp {A[\d]+ OK} $l]} {
update
if {![info exists total]} {
regexp {([\d]+) EXISTS} $l -> total
}
if {![info exists recent]} {
regexp {([\d]+) RECENT} $l -> recent
}
if {![info exists paslu]} {
regexp {UNSEEN ([\d]+)} $l -> paslu
}
#if {$l!=""} {puts $l}
set l [gets $chan]
}
array set $libelle "total $total recent $recent paslu $paslu"
unset total
unset recent
unset paslu
#puts ""
#parray $libelle
}
}
proc recupInfoMessages {chan nb} {
set listeNvMsg [list]
# on récupère/parse les entêtes
for {set i 0} {$i<$nb} {incr i} {
puts $chan "[prefixe] FETCH [expr {$i+1}] (BODY\[HEADER.FIELDS (FROM SUBJECT)] FLAGS)"
#puts "Message [expr {$i+1}]"
set l [gets $chan]
set seen 0
while {![regexp {A[\d]+ OK Success} $l]} {
update
if {[regexp {FLAGS \(\\Seen\)} $l]} {set seen 1}
if {![info exists from]} {
regexp {From: (.*)$} $l -> from
}
if {![info exists sujet]} {
regexp {Subject: (.*)$} $l -> sujet
}
set l [gets $chan]
}
#puts "\tDe :\t $from"
#puts "\tSujet :\t $sujet"
lappend listeNvMsg [list $from $sujet $seen]
unset from
unset sujet
}
return $listeNvMsg
}
proc verifGmail {} {
set sock [tls::socket -async imap.gmail.com 993]
fconfigure $sock -buffering none -blocking 1
fileevent $sock writable [list Write $sock]
after 120000 verifGmail
}
proc ouvertureClientMail {{libelle ""}} {
if {[catch {set nav $::env(BROWSER)}]} {
# tant pis pour les autres :P
set nav firefox
}
set adresse "https://mail.google.com/mail"
if {$libelle ne ""} {
append adresse "/#label/$libelle"
}
exec $nav $adresse &
}
verifGmail
bind .c <1> ouvertureClientMailDiscussion Kroc 06/05/2008 - Super exemple David ! il y avait même ton vrai login+password Gmail (que j'ai enlevé car je suis gentil).
dc c'était cadeau pour ceux qui suivent ;-)