Notificateur de courrier du pauvre

 

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

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