diff -c exmh-2.0.2/exmh.install exmh-2.0.2-urlFaces.modif/exmh.install *** exmh-2.0.2/exmh.install Wed Jul 29 23:35:29 1998 --- exmh-2.0.2-urlFaces.modif/exmh.install Tue Feb 24 14:35:48 1998 *************** *** 63,69 **** install_dir man /usr/man/manl {Install man directory} install_glob man exmh*.l install_dir lib /usr/local/lib/exmh-$vers {Install lib directory} ! install_glob lib lib/*.tcl lib/*.bitmap lib/help.* lib/*.FAQ lib/tclIndex lib/app-defaults* lib/*.mask lib/*.exp lib/mime.types lib/*.au lib/html lib/PgpDecryptExpect # Define test command install_test exec ./exmh & --- 63,69 ---- install_dir man /usr/man/manl {Install man directory} install_glob man exmh*.l install_dir lib /usr/local/lib/exmh-$vers {Install lib directory} ! install_glob lib lib/*.tcl lib/*.bitmap lib/*.ppm lib/help.* lib/*.FAQ lib/tclIndex lib/app-defaults* lib/*.mask lib/*.exp lib/mime.types lib/*.au lib/html lib/PgpDecryptExpect # Define test command install_test exec ./exmh & diff -arcP -x *tclIndex exmh-2.0.2/lib/faces.tcl exmh-2.0.2-urlFaces.modif/lib/faces.tcl *** exmh-2.0.2/lib/faces.tcl Mon Sep 15 15:04:23 1997 --- exmh-2.0.2-urlFaces.modif/lib/faces.tcl Wed Jul 29 20:49:02 1998 *************** *** 79,86 **** } ! proc Face_Show { fromwho {xface {}} } { ! global faces faceCache Face_Delete --- 79,89 ---- } ! proc Face_Show { fromwho {xface {}} {ximageurl {}} } { ! global faces faceCache failedURLs ! ! set xfaceAvail 0 ! set ximageurlAvail 0 Face_Delete *************** *** 91,99 **** if {$faces(rowEnabled) && $faces(defer)} { DeferWork faces(work) [list FaceXFace $xface [FaceAlloc]] } elseif {[FaceXFace $xface] && !$faces(rowEnabled)} { ! return 1 } } if {$faces(enabled!) || !$faces(enabled)} { return 0 } --- 94,123 ---- if {$faces(rowEnabled) && $faces(defer)} { DeferWork faces(work) [list FaceXFace $xface [FaceAlloc]] } elseif {[FaceXFace $xface] && !$faces(rowEnabled)} { ! set xfaceAvail 1 ! } ! } ! ! # Honor X-Image-URL even if X-Face was displayed or the faces are ! # disabled ! if {[string compare "" $ximageurl]} { ! if {![info exists failedURLs] ! || ([info exists failedURLs] ! && [lsearch $failedURLs $ximageurl] == -1)} { ! if {$faces(rowEnabled) && $faces(defer)} { ! DeferWork faces(work) \ ! [list UrlDisplayFace $ximageurl [FaceAlloc]] ! } elseif {[UrlDisplayFace $ximageurl [FaceAlloc]] ! && !$faces(rowEnabled)} { ! set ximageurlAvail 1 ! } } } + + if {$xfaceAvail || $ximageurlAvail} { + return 1 + } + if {$faces(enabled!) || !$faces(enabled)} { return 0 } *************** *** 305,311 **** set facefile $faces(base)$facefile } switch -- [file extension $facefile] { ! .ppm - .pgm - .pbm - .gif { if [catch { # Tputs image create: [time { set image [image create photo -file $facefile -palette $faces(palette)] --- 329,335 ---- set facefile $faces(base)$facefile } switch -- [file extension $facefile] { ! .ppm - .pgm - .pbm - .gif - .xpm { if [catch { # Tputs image create: [time { set image [image create photo -file $facefile -palette $faces(palette)] *************** *** 324,338 **** return 0 } } - .xpm { - if [catch { - set image [image create pixmap -file $facefile] - $pane config -image $image - } id] { - Exmh_Debug $id - return 0 - } - } .xbm { if [catch { $pane config -bitmap @$facefile --- 348,353 ---- *************** *** 460,467 **** catch {unset faceMap} catch {unset faceCache} } - - # # Defer work to an after handler [this code should be elsewhere] --- 475,480 ---- diff -arcP -x *tclIndex exmh-2.0.2/lib/ftp_get.tcl exmh-2.0.2-urlFaces.modif/lib/ftp_get.tcl *** exmh-2.0.2/lib/ftp_get.tcl Wed Dec 31 16:00:00 1969 --- exmh-2.0.2-urlFaces.modif/lib/ftp_get.tcl Wed Jul 29 16:10:33 1998 *************** *** 0 **** --- 1,240 ---- + # ftp_get.tcl + # + # Author: Ovidiu Predescu + # + # Retrive an a file via FTP using passive data transfer (see RCF 959) + + set ftp(cmdSock) -1 + set ftp(dataSock) -1 + set ftp(host) "" + set ftp(directory) "" + set ftp(filename) "" + + proc FtpConnect {server port} { + HttpLog ftp $server on $port + set sock [socket $server $port] + fconfigure $sock -blocking false + return $sock + } + + proc FtpSetConnectionInfo { url } { + upvar #0 $url data + global ftp + + # Check if the URL is correct. Also separate the host, directory + # and filename + if {![regexp "\[fF\]\[tT\]\[pP\]://(\[^/\]+)(.*)/(\[^/\]*)" $url x \ + ftp(host) ftp(directory) ftp(filename)]} { + return 0 + } + + # Create the data file + set data(file) [Cache_NewFile $data(url)] + if {[catch {open $data(file) w 0600} data(fd)]} { + Exmh_Status "Cannot write to HTML cache directory" + Http_kill $data(url) + } else { + HttpLog "using file $data(file)" + fconfigure $data(fd) -translation lf + } + + return 1 + } + + proc Ftp_event {url} { + global Http env ftp + upvar #0 $url data + + if {![info exists data] || ![info exists data(socket)]} { + return + } + if ![info exists data(count)] { + set data(count) 0 + } + + if [catch { + switch $data(what) { + connected { + # Get the server's greeting + ftp_reply_expect 220 + # Send the user name + ftp_send "USER anonymous" + set data(what) login + Exmh_Status "login into $ftp(host)..." + HttpLog "login into $ftp(host)..." + } + + login { + # Get the user name response reply + ftp_reply_expect 230 331 + # Send the password + ftp_send "PASS $env(USER)@" + set data(what) password + } + + password { + # Get the password response reply + ftp_reply_expect 230 + ftp_send "CWD $ftp(directory)" + set data(what) changedir + Exmh_Status "changing directory to $ftp(directory)..." + HttpLog "changing directory to $ftp(directory)..." + } + + changedir { + # Get the change directory reply + ftp_reply_expect 250 + # Set the type to binary + ftp_send "TYPE I" + set data(what) settype + } + + settype { + # Get the type set reply + ftp_reply_expect 200 + # Create a pasive connection to the server + ftp_send "PASV" + set data(what) dataconnection + } + + dataconnection { + # Get the data connection information + ftp_get response + if {![regexp "^227" $response]} { + error "the FTP server does not support passive connections!" + } + if {![regexp "^227(\[^0123456789\]*)(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+),(\[0-9\]+).*$" $response x y h1 h2 h3 h4 p1 p2]} { + error "cannot get the address of the server socket data" + } else { + set host $h1.$h2.$h3.$h4 + set port [format "%u" 0x[format "%x%x" ${p1} ${p2}]] + if [catch {set ftp(dataSock) [socket $host $port]} err] { + error "cannot open data socket to $host, port $port! ($err)" + } + fconfigure $ftp(dataSock) -blocking false + } + # Send the retrieve command + ftp_send "RETR $ftp(filename)" + Exmh_Status "opening the data channel for $ftp(filename)..." + HttpLog "opening the data channel for $ftp(filename)..." + set data(what) retrievecmd + } + + retrievecmd { + # Get the response from the retrieve request and + # analyze it to get information about the file's size + ftp_get response + if {![regexp "^150" $response]} { + error "$response" + } + if {![regexp "^150.*\\((\[0-9\]+).*" $response x data(length)]} { + set data(length) -1 + } + set data(what) dataget + } + + dataget { + # Get the data from the data socket + if [catch {copychannel $ftp(dataSock) $data(fd) $Http(hunk)} more] { + catch {eval $data(progress) error $more 0} + error "Read error on $url\n$more" + } + if {$more >= 0} { + incr data(count) $more + catch {eval $data(progress) file $data(count) $data(length)} + } + if {$data(length) > 0} { + set percent [format "%3.1f" [expr $data(count) * 100 / $data(length)]] + Exmh_Status "$url...$percent%" + HttpLog "$url...$percent%" + } else { + set kbytes [format "%4.1" [expr $data(count) / 1024]] + Exmh_Status "$url...$kbytes kb" + HttpLog "$url...$kbytes kb" + } + if [eof $ftp(dataSock)] { + set data(what) closeconnection + } + } + + closeconnection { + Exmh_Status "$url...done" + HttpLog "$url...done" + catch {close $ftp(dataSock)} + set ftp(dataSock) -1 + catch {close $ftp(cmdSock)} + set ftp(cmdSock) -1 + Http_depend $url + catch {close $data(fd)} + unset data(fd) + Cache_SetFile $url $data(file) + catch {eval $data(progress) done $data(count) $data(length)} + foreach cmd $data(command) { + HttpLog $cmd + catch $cmd + } + set data(command) "" + after idle Http_poke + } + + } + } err] { + if {$err != "again"} { + # An error appeared during the execution of the protocol + HttpLog $err + catch {eval [list $data(progress) error "$err" $data(length)]} + catch {close $ftp(dataSock)} + set ftp(dataSock) -1 + catch {close $ftp(cmdSock)} + set ftp(cmdSock) -1 + catch {close $data(fd)} + unset data(fd) + Http_kill $url + return + } else { + # Not enough data; return to the main loop and await for + # more data + return + } + } + } + + proc ftp_reply_expect { args } { + ftp_get response + + foreach code $args { + if {[regexp "^$code.*" $response]} { + return; + } + } + error "bad response from the ftp server: $response" + } + + proc ftp_get { varname } { + global ftp + upvar $varname response + + if {[gets $ftp(cmdSock) response] == -1} { + if [fblocked $ftp(cmdSock)] { + # Line was not read completly because there's not a full + # line available yet + error "again" + } else { + # End of file was encountered before reading a full line + close $ftp(cmdSock) + set ftp(cmdSock) -1 + error "remote has closed the connection!" + } + } + HttpLog "ftpd: $response" + } + + proc ftp_send { cmd } { + global ftp + + HttpLog "--> $cmd" + if [catch {puts $ftp(cmdSock) $cmd} err] { + error "cannot send to ftp socket: $err" + } + flush $ftp(cmdSock) + } diff -arcP -x *tclIndex exmh-2.0.2/lib/html_get_http.tcl exmh-2.0.2-urlFaces.modif/lib/html_get_http.tcl *** exmh-2.0.2/lib/html_get_http.tcl Tue Jan 13 10:14:09 1998 --- exmh-2.0.2-urlFaces.modif/lib/html_get_http.tcl Wed Jul 29 16:10:33 1998 *************** *** 17,23 **** # only accept these types (This is usually ignored) set Http(accept) { ! text/plain text/html image/gif image/jpeg image/xbm } proc Http_SetProxy {win} { --- 17,23 ---- # only accept these types (This is usually ignored) set Http(accept) { ! text/plain text/html image/gif image/jpeg image/xbm } proc Http_SetProxy {win} { *************** *** 104,110 **** HttpLog fetching linked url ($data(link)) Http_get $data(link) $command } else { ! HttpLog appending ($command) to ($data(command) lappend data(command) $command } } --- 104,110 ---- HttpLog fetching linked url ($data(link)) Http_get $data(link) $command } else { ! HttpLog appending ($command) to ($data(command)) lappend data(command) $command } } *************** *** 121,170 **** # when a fetch is complete. proc Http_poke {} { ! global Http HttpHost ! if {$Http(queue) == ""} { ! return 0 ! } ! ! if {[llength $Http(pending)] >= $Http(max_pending)} { ! after 2000 Http_poke ! return 0 ! } ! ! # find the item on the head of the Q ! ! set url [lindex $Http(queue) 0] ! set Http(queue) [lrange $Http(queue) 1 end] ! lappend Http(pending) $url ! ! upvar #0 $url data ! ! # go ask for the url, and wait for the data ! ! set data(state) connecting ! set data(what) connect ! set port {} ! if ![regexp -nocase {http://([^/:]+)(:([0-9]+))?(.*)} $url x host y port srvurl] { ! HttpLog Invalid url $url ! Http_kill $url ! return ! } ! if {[string length $port] == 0} { ! set port 80 ! } ! if 0 { ! # Old "fall-back" code that only works responsively on some systems ! if [catch {HttpConnect $host $port $data(protocol) $srvurl} sock] { ! HttpLog $sock ! # Fall back to proxy ! if [catch {HttpConnect $Http(server) $Http(port) $data(protocol) $url} sock] { ! HttpLog "$sock" ! Http_kill $url ! return ! } ! } ! } else { # Callback to determine if a proxy is necessary lassign {proxy pport} [Http_Proxy $host] if [catch { --- 121,159 ---- # when a fetch is complete. proc Http_poke {} { ! global Http HttpHost ! if {$Http(queue) == ""} { ! return 0 ! } ! ! if {[llength $Http(pending)] >= $Http(max_pending)} { ! after 2000 Http_poke ! return 0 ! } ! ! # find the item on the head of the Q ! ! set url [lindex $Http(queue) 0] ! set Http(queue) [lrange $Http(queue) 1 end] ! lappend Http(pending) $url ! ! upvar #0 $url data ! ! # go ask for the url, and wait for the data ! ! set data(state) connecting ! set data(what) connect ! set port {} ! if ![regexp -nocase {(http|ftp)://([^/:]+)(:([0-9]+))?(.*)} $url x protocol host y port srvurl] { ! HttpLog Invalid url $url ! Http_kill $url ! return ! } ! if {[string length $port] == 0} { ! set port 80 ! } ! if {$protocol == "http"} { # Callback to determine if a proxy is necessary lassign {proxy pport} [Http_Proxy $host] if [catch { *************** *** 178,214 **** Http_kill $url return } ! } ! set data(socket) $sock ! set data(mime) {} ! set data(what) connected ! if [catch { foreach type $Http(accept) { ! puts $sock "Accept: $type" } puts $sock "User-Agent: [HttpAgent]" puts $sock "Host: $host" if {$data(protocol) == "POST"} { ! HttpLog $data(query) ! puts $sock "Content-type: application/x-www-form-urlencoded" ! puts $sock "Content-length: [string length $data(query)]\n" ! puts $sock "$data(query)" ! puts $sock "\n" } else { ! puts $sock "" } flush $sock # Our translation is now lf because of our own output. Reset it. - fconfigure $sock -translation auto fileevent $sock r [list Http_event $url] ! } err] { ! # Connect really failed. ! HttpLog $err Http_kill $url return } ! catch {eval $data(progress) connecting 0 0} ! return 1 } proc HttpConnect {server port cmd url} { --- 167,221 ---- Http_kill $url return } ! } elseif {$protocol == "ftp"} { ! if [catch {set sock [FtpConnect $host 21]} err] { ! HttpLog $err ! Http_kill $url ! return ! } ! } ! set data(socket) $sock ! set data(mime) {} ! set data(what) connected ! if {$protocol == "http" ! && [catch { foreach type $Http(accept) { ! puts $sock "Accept: $type" } puts $sock "User-Agent: [HttpAgent]" puts $sock "Host: $host" if {$data(protocol) == "POST"} { ! HttpLog $data(query) ! puts $sock "Content-type: application/x-www-form-urlencoded" ! puts $sock "Content-length: [string length $data(query)]\n" ! puts $sock "$data(query)" ! puts $sock "\n" } else { ! puts $sock "" } flush $sock # Our translation is now lf because of our own output. Reset it. fileevent $sock r [list Http_event $url] ! fconfigure $sock -translation auto ! } err]} { ! # Connect really failed. ! HttpLog $err ! Http_kill $url ! return ! } elseif {$protocol == "ftp"} { ! global ftp ! ! set ftp(cmdSock) $sock ! if {![FtpSetConnectionInfo $url]} { ! HttpLog "invalid URL for FTP: $url" Http_kill $url return } ! fileevent $sock r [list Ftp_event $url] ! } ! ! catch {eval $data(progress) connecting 0 0} ! return 1 } proc HttpConnect {server port cmd url} { diff -arcP -x *tclIndex exmh-2.0.2/lib/loaderror.ppm exmh-2.0.2-urlFaces.modif/lib/loaderror.ppm *** exmh-2.0.2/lib/loaderror.ppm Wed Dec 31 16:00:00 1969 --- exmh-2.0.2-urlFaces.modif/lib/loaderror.ppm Wed Jul 29 20:24:32 1998 *************** *** 0 **** --- 1,4 ---- + P6 + 48 48 + 255 +                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         UU     кк                                                                                                                               99 rr                                                                                                                                            кк             UU UU     UU UU     ╟╟ 99  UU        rr UU                                                                         ╟╟  99 UU UU         кк      кк уу 99 кк уу  ╟╟ ╟╟  UU ╟╟                                                                         кк UU                                 99 ОО        кк кк UU                                                                               UU кк             кк UU       кк UU        кк    ╟╟  уу UU кк                                                                            ╟╟  уу             99 ОО       99 ОО       rr rr ╟╟  ╟╟ ╟╟  уу                                                                            ╟╟ UU UU UU UU UU    UU ╟╟       UU ╟╟       уу rr UU ╟╟    ╟╟ UU                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      UU UU                                              кк UU    UU UU                                                                               99 rr                                              ОО rr    ╟╟ ╟╟                                                                                кк    UU  99 ╟╟    ОО          ОО    кк     кк кк    ╟╟       UU  99                                            ╟╟ 99 уу UU ОО уу 99 rr    UU ╟╟ ОО     кк UU ╟╟ ОО  уу ╟╟ 99 уу rr 99 уу UU UU    UU ОО уу 99 99                                           кк UU ОО 99       UU UU    ОО   UU ╟╟  уу    кк     кк UU    UU кк    UU UU ОО 99       UU UU                                           UU кк UU UU        ОО ОО UU ╟╟ UU UU кк        rr 99    UU кк            кк UU UU        кк                                        ╟╟  уу ╟╟     99 rr     кк UU     уу 99 ╟╟ ОО  ОО ╟╟  уу ОО 99    ╟╟  уу ╟╟     99  уу                                        ╟╟ UU       ОО UU ОО       ОО UU кк UU       ╟╟ UU rr UU ╟╟ ╟╟ UU    ОО ОО    ╟╟ UU       ОО UU UU                                                                                                                                кк  ╟╟     уу                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    UU UU                                                                                   кк                                                    ╟╟ ╟╟                                                                               ╟╟  уу                                                     кк кк    99         99   rr       UU  99        UU   ╟╟    rr 99                                                    ╟╟ 99 уу rr 99 уу  UU        ╟╟ rr уу 99 UU    UU ОО уу 99 99    UU ОО уу 99 rr    UU ОО                                                    кк UU    UU кк     кк           99   кк ОО 99       UU UU ОО  UU UU  UU                                                           UU кк        кк     UU UU уу UU ОО уу  кк UU UU        кк UU 99 кк кк кк уу    ОО                                                    ╟╟  уу ОО 99    rr rr     ОО кк  ╟╟ 99 UU    ╟╟     99  уу ╟╟     99 rr    UU ╟╟                                                    ╟╟ UU    ОО ОО    ОО ╟╟    UU ╟╟ уу rr rr ОО ОО       ОО UU UU        ОО UU ОО       UU ╟╟                                                                                                    кк  ╟╟     уу                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ No newline at end of file diff -arcP -x *tclIndex exmh-2.0.2/lib/loading.ppm exmh-2.0.2-urlFaces.modif/lib/loading.ppm *** exmh-2.0.2/lib/loading.ppm Wed Dec 31 16:00:00 1969 --- exmh-2.0.2-urlFaces.modif/lib/loading.ppm Wed Jul 29 20:26:16 1998 *************** *** 0 **** --- 1,5 ---- + P6 + # CREATOR: The GIMP's PNM Filter Version 1.0 + 48 48 + 255 +                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               UUUUUU                                                                                                                                          999rrr                                                                                                                                          кккккк999      999rrr      UUU999      UUU╟╟╟                                                            ╟╟╟999уууrrr999уууUUU      ╟╟╟rrrууу999UUU   UUUОООууу999999   UUUОООууу999rrr                                                            кккUUU   UUUккк   ккк         999кккООО999      UUUUUUОООUUUUUUUUU                                                            UUUккк      ккк   UUUUUUуууUUUОООууукккUUUUUU      кккUUU999кккккккккууу                                                         ╟╟╟уууООО999   rrrrrr   ОООккк╟╟╟999UUU   ╟╟╟   999ууу╟╟╟   999rrr                                                            ╟╟╟UUU   ОООООО   ООО╟╟╟   UUU╟╟╟уууrrrrrrОООООО      ОООUUUUUU      ОООUUUООО                                                                                                               ккк╟╟╟   ууу                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        UUUUUU                                             кккUUU   UUUUUU                                                                              999rrr                                             ОООrrr   ╟╟╟╟╟╟                                                                              ккк   UUU999╟╟╟   ООО      ОООккк   кккккк╟╟╟      UUU999                                          ╟╟╟999уууUUUОООууу999rrr   UUU╟╟╟ООО   кккUUU╟╟╟ОООууу╟╟╟999уууrrr999уууUUUUUU   UUUОООууу999999                                          кккUUUООО999      UUUUUU   ОООUUU╟╟╟ууу   ккк   кккUUU   UUUккк   UUUUUUООО999      UUUUUU                                          UUUкккUUUUUU      ООООООUUU╟╟╟UUUUUUккк      rrr999   UUUккк         кккUUUUUU      ккк                                       ╟╟╟ууу╟╟╟   999rrr   кккUUU   ууу999╟╟╟ОООООО╟╟╟уууООО999   ╟╟╟ууу╟╟╟   999уууОООООО   UUU╟╟╟╟╟╟UUU                  ╟╟╟UUU      ОООUUUООО      ОООUUUкккUUU      ╟╟╟UUUrrrUUU╟╟╟╟╟╟UUU   ОООООО   ╟╟╟UUU      ОООUUUUUU   ОООООО   UUU╟╟╟╟╟╟UUU                                                                                                      ккк╟╟╟   ууу                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               \ No newline at end of file diff -arcP -x *tclIndex exmh-2.0.2/lib/msgShow.tcl exmh-2.0.2-urlFaces.modif/lib/msgShow.tcl *** exmh-2.0.2/lib/msgShow.tcl Tue Feb 10 17:04:46 1998 --- exmh-2.0.2-urlFaces.modif/lib/msgShow.tcl Wed Jul 29 19:23:33 1998 *************** *** 62,68 **** } } - proc MsgShow { msgid } { # Display the current message in a text widget global msg exwin exmh mhProfile mimeHdr mime --- 62,67 ---- *************** *** 73,78 **** --- 72,78 ---- Html_Stop $exwin(mtext) Label_Message $exmh(folder):$msgid Audit "Show $exmh(folder) $msgid" + if [MsgShowInText $exwin(mtext) $mhProfile(path)/$exmh(folder)/$msgid] { MsgSeen $msgid if {!$mime(stop)} { *************** *** 81,87 **** set msg(curclear) 0 set mime(stop) 0 update idletasks ;# Faces display can be slow ! Face_Show [MsgParseFrom $mimeHdr(0=1,hdr,from)] $mimeHdr(0=1,hdr,x-face) foreach cmd [info commands Hook_MsgShow*] { $cmd $mhProfile(path)/$exmh(folder)/$msgid mimeHdr } --- 81,89 ---- set msg(curclear) 0 set mime(stop) 0 update idletasks ;# Faces display can be slow ! ! Face_Show [MsgParseFrom $mimeHdr(0=1,hdr,from)] $mimeHdr(0=1,hdr,x-face) $mimeHdr(0=1,hdr,x-image-url) ! foreach cmd [info commands Hook_MsgShow*] { $cmd $mhProfile(path)/$exmh(folder)/$msgid mimeHdr } *************** *** 109,114 **** --- 111,117 ---- set mimeHdr($part=$subpart,hdr,date) {} set mimeHdr($part=$subpart,hdr,subject) {} set mimeHdr($part=$subpart,hdr,x-face) {} + set mimeHdr($part=$subpart,hdr,x-image-url) {} set mimeHdr($part=$subpart,fullHeaders) $mime(fullHeaders) set mimeHdr($part=$subpart,yview) 1.0 diff -arcP -x *tclIndex exmh-2.0.2/lib/urlFace.tcl exmh-2.0.2-urlFaces.modif/lib/urlFace.tcl *** exmh-2.0.2/lib/urlFace.tcl Wed Dec 31 16:00:00 1969 --- exmh-2.0.2-urlFaces.modif/lib/urlFace.tcl Wed Jul 29 20:39:02 1998 *************** *** 0 **** --- 1,286 ---- + # urlFace.tcl + # + # Author: Ovidiu Predescu + # + # Retrieve an image giving an URL and use it as face. + + set urlFace(width) 48 + set urlFace(height) 48 + + # Some private procedures for this module + + proc UrlGetCachedImageFileName { href } { + global urlFace + + set extension [file extension $href] + + if [catch {exec echo $href | sed -e s^/^_^g} trhref] { + UrlFaceLog "cannot process URL! ($trhref)" + # Cannot process the URL; create a temp file to hold the image + set trhref "temp.$extension" + } + set rootname [file rootname $trhref] + + # Handle image types not currently known by Tk. This requires the + # PPM tools to work. We use a PPM conversion of the file instead + # of the original file. + + switch -- $extension { + .tiff - .tif - .jpeg - .jpg - .pbm - .xbm { + set trhref "$rootname.ppm" + } + + .pnm - .ppm - .pgm - .gif - .xpm { + # Do nothing + } + + default { + Exmh_Status "Image type $extension not supported!" red + UrlFaceLog "Image type $extension not supported!" + return "" + } + } + + set cachedImagesDir "[glob ~]/.exmh-images" + if {![file exists $cachedImagesDir]} { + exec mkdir $cachedImagesDir + } + set imageFile "$cachedImagesDir/$trhref" + + return $imageFile + } + + # Transform unknown image file formats to PPM. All the images are + # converted to the size urlFace(width) x $urlFace(height). + proc UrlFaceGetNormalizedImage { filename } { + global urlFace + + set extension [file extension $filename] + set rootname [file rootname $filename] + + switch -- $extension { + .tiff - .tif { + if [catch {exec tifftopnm <$filename 2>/dev/null \ + | pnmscale -xysize $urlFace(width) $urlFace(height) \ + >${rootname}.ppm} err] { + Exmh_Status "cannot convert TIFF file! ($err)" red + UrlFaceLog "cannot convert TIFF file! ($err)" + return ""; + } else { + return ${rootname}.ppm + } + } + + .jpeg - .jpg { + if [catch {exec djpeg -pnm $filename \ + | pnmscale -xysize $urlFace(width) $urlFace(height) \ + >${rootname}.ppm} err] { + Exmh_Status "cannot convert JPEG file! ($err)" red + UrlFaceLog "cannot convert JPEG file! ($err)" + return ""; + } else { + return ${rootname}.ppm + } + } + + .xbm { + if [catch {exec xbmtopbm <$filename \ + | pnmscale -xysize $urlFace(width) $urlFace(height) >${rootname}.ppm 2>/dev/null} err] { + Exmh_Status "cannot convert XBM file! ($err)" red + UrlFaceLog "cannot convert XBM file! ($err)" + return ""; + } else { + return ${rootname}.ppm + } + } + + .pbm { + if [catch {exec pnmscale -xysize $urlFace(width) $urlFace(height) <$filename \ + >${rootname}.ppm 2>/dev/null} err] { + Exmh_Status "cannot scale PBM file! ($err)" red + UrlFaceLog "cannot scale PBM file! ($err)" + return ""; + } else { + return ${rootname}.ppm + } + } + + + .pnm - .ppm - .pgm { + set image [image create photo -file $filename] + + # Scale the image if its different than + # $urlFace(width) x $urlFace(height) + set height [image height $image] + set width [image width $image] + + if {($height != $urlFace(height) || $width != $urlFace(width)) + && [catch {exec sh -c "pnmscale -xysize $urlFace(width) $urlFace(height) <$filename \ + >${filename}.new \ + && mv $filename.new ${filename}"} err]} { + Exmh_Status "cannot scale PPM file! ($err)" red + UrlFaceLog "cannot scale PPM file! ($err)" + } + return $filename; + } + + .gif { + set image [image create photo -file $filename] + + # Scale the image if its different than + # $urlFace(width) x $urlFace(height) + set height [image height $image] + set width [image width $image] + + if {($height != $urlFace(height) || $width != $urlFace(width)) + && [catch {exec sh -c "(giftopnm <$filename \ + | pnmscale -xysize $urlFace(width) $urlFace(height) \ + | ppmquant 256 \ + | ppmtogif >${filename}.new \ + && mv ${filename}.new ${filename}\ + && exit 0)" 2>/dev/null} err]} { + Exmh_Status "cannot scale GIF file! ($err)" red + UrlFaceLog "cannot scale GIF file! ($err)" + } + return $filename + } + + .xpm { + set image [image create photo -file $filename] + + # Scale the image if its different than + # $urlFace(width) x $urlFace(height) + set height [image height $image] + set width [image width $image] + + if {($height != $urlFace(height) || $width != $urlFace(width)) + && [catch {exec sh -c "(xpmtoppm <$filename \ + | pnmscale -xysize $urlFace(width) $urlFace(height) \ + | ppmquant 256 \ + | ppmtoxpm >${filename}.new \ + && mv ${filename}.new ${filename})" 2>/dev/null} err]} { + Exmh_Status "cannot scale XPM file! ($err)" red + UrlFaceLog "cannot scale XPM file! ($err)" + } + return $filename; + } + + } + + return $filename + } + + proc UrlFaceQueryStatus {state count length} { + global exmh urlFace failedURLs + upvar url href + + if {![string compare $state "error"]} { + # error reading from URL + Exmh_Status "error reading $href! ($count)" red + UrlFaceLog "error reading $href! ($count)" + set urlFace($href,urlFailed) 1 + lappend failedURLs $href + FaceShowFile $exmh(library)/loaderror.ppm $urlFace($href,pane) + return + } elseif {![string compare $state "body"]} { + # The URL does not exist + UrlFaceLog "URL $href does not exist!" + FaceShowFile $exmh(library)/loaderror.ppm $urlFace($href,pane) + set urlFace($href,urlFailed) 1 + lappend failedURLs $href + return + } + + if {$length} { + Exmh_Status [format "%s... %.1f%% complete" \ + $href [expr 100.0 * $count / $length]] + } else { + Exmh_Status [format "%s..." $href] + } + } + + proc UrlFaceQueryDone { href filename msgPath pane } { + global exmh urlFace msg + upvar #0 $href data + + unset urlFace($href,pane) + + if {[info exists urlFace($href,urlFailed)]} { + unset urlFace($href,urlFailed) + } else { + UrlFaceLog "got image from $href in $data(file)" + set normalized [UrlFaceGetNormalizedImage $data(file)] + UrlFaceLog "normalized file is $normalized" + + UrlFaceLog "executing cp $normalized $filename" + if [catch {exec cp $normalized $filename} err] { + Exmh_Status "cannot create face file in ~/.exmh-images! ($err)" red + UrlFaceLog "cannot create face file in ~/.exmh-images! ($err)" + FaceShowFile $exmh(library)/loaderror.ppm $pane + return + } + + # Display the face if the current message is the same + if {$msg(path) == $msgPath} { + Url_displayFace $href $filename $pane + } + } + } + + proc Url_displayFace { href imageFile {pane {}} } { + global exmh failedURLs + + Exmh_Status "Displaying face..." + UrlFaceLog "displaying face from $imageFile" + if ![FaceShowFile $imageFile $pane] { + # Remove the cached image in case of errors + catch {exec rm -f $imageFile} + lappend failedURLs $href + FaceShowFile $exmh(library)/loaderror.ppm $pane + return 0 + } else { + Exmh_Status "Displaying face...done" + return 1 + } + } + + # This is the public procedure in this file + proc UrlDisplayFace { href pane } { + global urlFace msg failedURLs exmh + + set imageFile [UrlGetCachedImageFileName $href] + + # Check to see if the file is already cached + if {[string compare $imageFile ""] + && ![file exists $imageFile]} { + # The image is not cached, retrieve it. Since this may take a + # while we simply return with the appropriate return code. The + # face will be displayed when the loading of the image is + # finished. + + set urlFace($href,pane) $pane + FaceShowFile $exmh(library)/loading.ppm $pane + + Exmh_Status "getting image face from $href..." + UrlFaceLog "getting image face from $href..." + set ret [Http_get $href \ + "UrlFaceQueryDone $href $imageFile $msg(path) $pane" \ + UrlFaceQueryStatus] + if {![string compare $ret ""]} { + # URL could not be reached. Disable the access to it + # during this session. + Exmh_Status "unable to display the X-Image-Url face!" red + UrlFaceLog "unable to display the X-Image-Url face!" + FaceShowFile $exmh(library)/loaderror.ppm $pane + lappend failedURLs $href + } + UrlFaceLog "delayed showing the image from $href" + return 0 + } else { + return [Url_displayFace $href $imageFile $pane] + } + } + + proc UrlFaceLog {args} { + # puts $args + }