--- VT-asedeno.pl 2008-10-01 20:43:44.000000000 -0400 +++ VT_NElhage.pm 2008-07-04 14:08:56.000000000 -0400 @@ -1,66 +1,70 @@ -package VT_asedeno; +use strict; +use warnings; -use utf8; -use Text::CharWidth qw(mbswidth); +package BarnOwl::Module::VT_ASedeno; + +use BarnOwl::Hooks; + +use Text::Autoformat; +use HTML::WikiConverter; use Encode qw(encode decode); use Encode::MIME::Header; +use WWW::Mechanize; + +*boldify = \&BarnOwl::Style::boldify; + +BarnOwl::new_variable_bool('vta:escape_formatting', { + default => 'on', + summary => "Escape z-formatting in BarnOwl::Style::VT_ASedeno" + }); ################################################################################ #Run this on start and reload. Adds styles, sets style to start. ################################################################################ sub onStart { - # Style definition - owl::command("style VT perl VT_asedeno::style_VT"); - - bindings_VT(); - owl::set("-q default_style VT"); - owl::command("VT"); + my $reload = shift; + bindings_VT() unless $reload; } -push @::onStartSubs, \&onStart; +$BarnOwl::Hooks::startup->add(\&onStart); ################################################################################ -# Help information +# Branching point for various formatting functions in this style. ################################################################################ -sub moduleHelp() +sub format_msg($) { - my @helpmsgArray = <is_zephyr) + { + return format_VT($m); } -push @::onModuleHelp, \&moduleHelp; - - -################################################################################ -# Dispatch to various formatting functions in this style. -################################################################################ -sub style_VT($) + elsif ($m->is_aim) + { + return format_VT_AIM($m); + } + elsif ($m->is_jabber) + { + return format_VT_jabber($m); + } + elsif ($m->type eq 'IRC') + { + return format_VT_IRC($m); + } + elsif ($m->is_admin) + { + return "\@bold(OWL ADMIN):\t".$m->body; + } + elsif ($m->is_loopback) + { + return "\@bold(loopback): ".$m->body; + } + else { - my $m = shift; - - return format_VT($m) if ($m->is_zephyr); - return format_VT_AIM($m) if ($m->is_aim); - return format_VT_jabber($m) if ($m->is_jabber); - return format_VT_irc($m) if ($m->type eq 'IRC'); - return "\@bold(OWL ADMIN):\t".$m->header.': '.$m->body if ($m->is_admin); - return "\@bold(loopback): ".$m->body if ($m->is_loopback); return $m->type.":\t".$m->body; } +} ################################################################################ # A place to keep my options all together, with default values. @@ -69,22 +73,18 @@ ("zsigs" => 0, "showControl" => 0, "stripMitEdu" => 1, - "rot13" => 0, "narrowMode" => 100); sub bindings_VT { + # Style definition + owl::command("style VT perl BarnOwl::Module::VT_ASedeno::format_msg"); + # Command aliases owl::command("alias VT view -s VT"); - owl::command("alias VT-zsigs perl VT_asedeno::VT_toggle_sigs()"); - owl::command("alias VT-hosts perl VT_asedeno::VT_toggle_host_strip()"); - owl::command("alias VT-ctrl perl VT_asedeno::VT_toggle_control()"); - owl::command("alias VT-rot13 perl VT_asedeno::VT_toggle_rot13()"); # Keybinding owl::command('bindkey recv "C-s C-v" command VT'); - owl::command('bindkey recv "C-s C-z" command VT-zsigs'); - owl::command('bindkey recv "C-s C-h" command VT-hosts'); } #Turn zsigs on or off @@ -108,13 +108,6 @@ refreshView(); } -#Toggle rot13 body -sub VT_toggle_rot13 -{ - $VT_Options{"rot13"} = !($VT_Options{"rot13"}); - refreshView(); -} - sub refreshView() { my $filter = owl::command("getview"); @@ -122,6 +115,23 @@ owl::command("view -f $filter ".($style?"-s $style":"")); } +sub clean_utf8 { + my $text = shift; + eval { + my $utf = decode('utf-8', $text, 1); + # $text = unidecode($utf); + $text = $utf; + }; + return $text; +} + +sub zescape { + my $text = shift; + if(BarnOwl::getvar('vta:escape_formatting') eq 'on') { + $text =~ s/@/@@/g; + } + return $text; +} ################################################################################ # Functions to format zephyrs. @@ -178,18 +188,13 @@ # If the defaults aren't being used, show both class and instance. $dest = $m->context.'['.$m->instance.']'; } + $dest =~ s/[[:cntrl:]]//g; # Extract user/authentication information from the message. my $user = $m->pretty_sender; - if ($user eq 'daemon.webzephyr' && lc($m->class) eq 'webzephyr') - { - $user = lc($m->instance); - } - my $auth = (($m->auth =~ /YES/) - ? '+' - : '-'); + my $auth; # I'm assuming I'll never see echoes of outbound non-personal zephyrs, # so these must be personals. For outbound personals, set username as @@ -197,25 +202,18 @@ # outbound. if (lc($m->direction) eq 'out') { - $auth = '>'; - if (lc($m->class eq 'webzephyr')) - { - $user = "->".$m->instance; - } - elsif (lc($m->class) eq 'message' && lc($m->instance) eq 'personal') - { $user = "->".$m->recipient; - $user =~ s/\@ATHENA\.MIT\.EDU$//; + $user =~ s/\@ATHENA\.MIT\.EDU//; $dest = '[personal]'; - } + $auth = '>'; + } else { + $auth = (($m->auth =~ /YES/) ? '+' : '-'); } my ($body, $hostSep) = format_body($m); my $zVT = ""; my $cols = owl::getnumcols(); - my $wDestAdjustment = (length($dest) - mbswidth($dest)); - $wDestAdjustment++ while($dest =~ /@@/g); if ($cols < $VT_Options{"narrowMode"}) { #This formats the zephyr for smaller screens. @@ -226,7 +224,7 @@ # 1 #1234567890123456789 #_username_ HH:MM A - my $wDest = ($cols - 19) + $wDestAdjustment; + my $wDest = $cols - 19; my $fmt = "%-10.10s %5s $auth %-".$wDest.".".$wDest."s\n %s"; $zVT = sprintf($fmt, $user, @@ -251,7 +249,7 @@ my $wHost = 14 + (($rest <= 10) ? $rest : 10); $rest -= $wHost - 14; - $wDest += $rest + $wDestAdjustment; + $wDest += $rest; my $fmt = "%-".$wUser.".".$wUser."s %5s $auth %-".$wDest.".".$wDest."s %".$wHost."s\n %s"; @@ -266,8 +264,7 @@ else { # This formats the zephyr for larger screens. - $dest_width = 18 + $wDestAdjustment; - $zVT = sprintf("%-10.10s %5s %-".$dest_width.".".$dest_width."s $auth%s", + $zVT = sprintf("%-10.10s %5s %-18.18s $auth%s", $user, $time, $dest, @@ -276,7 +273,7 @@ if (($m->is_personal || lc($m->direction) eq 'out')) { - return BarnOwl::Style::boldify($zVT); + return boldify($zVT); } return $zVT; } @@ -336,11 +333,7 @@ $dest, $body); } - if (($m->is_personal || lc($m->direction) eq 'out')) - { - return BarnOwl::Style::boldify($zVT); - } - return $zVT; + return boldify($zVT); } ################################################################################ @@ -365,7 +358,7 @@ return sprintf("\@b(%-10.10s) %s %s", "LOGIN", $time, - BarnOwl::Style::boldify($m->sender.$appendStr)); + boldify($m->sender.$appendStr)); } if ($m->is_logout()) @@ -373,7 +366,7 @@ return sprintf("\@b(%-10.10s) %s %s", "LOGOUT", $time, - BarnOwl::Style::boldify($m->sender)); + boldify($m->sender)); } my $dir = (lc($m->direction) eq 'out') ? '>' : '<'; @@ -381,27 +374,16 @@ # Extract destination from message my $dest = $m->recipient; my $hostStr = ''; - if ($m->jtype eq "groupchat") { + if (!$m->is_personal) { #MUC - $dest =~ s/\@(.*)//; + $dest =~ s/\@(conference.mit.edu)//; $hostStr = uc($1); $dest .= "[".$m->{subject}."]"if ($m->{subject}); $dir = '*' } - # Extract user information from the message. my $user = $m->sender; - - if ($m->sender =~ /s.ly$/) { - $m->sender =~ /^(.*)\@s\.ly$/; - $dest = $m->sender; - if ($m->direction eq 'in') { - $m->body =~ /^(.*): (.*)$/; - $user = $1; - $m->{body} = $2; - } - } - + $user =~ s/\xE2\x99\xb3/1/g; # Deal with recycling symbol of raeburn's. Remove after UTF-8 is supported. my ($body, $hostSep) = format_body($m); @@ -428,15 +410,15 @@ } if (($m->is_personal || lc($m->direction) eq 'out')) { - return BarnOwl::Style::boldify($zVT); + return boldify($zVT); } return $zVT; } ################################################################################ -# Functions to format irc messages. +# Functions to format IRC messages. ################################################################################ -sub format_VT_irc($) +sub format_VT_IRC($) { my $m = shift; @@ -446,33 +428,27 @@ # Deal with login/logout messages if ($m->is_login()) { - my $show = $m->{show}; - my $status = $m->{status}; - my $appendStr = ""; - $appendStr .= "$show" if ($show); - $appendStr .= ", $status" if ($status); - $appendStr = " ($appendStr)" if $appendStr; - return sprintf("\@b(%-10.10s) %s %s (%s/%s)", + my $chan = $m->channel; + return sprintf("\@b(%-10.10s) %s %s", "JOIN", $time, - BarnOwl::Style::boldify($m->sender.$appendStr), - $m->network, $m->channel); + boldify($m->sender." ($chan)")); } if ($m->is_logout()) { - return sprintf("\@b(%-10.10s) %s %s (%s/%s)", + my $chan = $m->channel; + return sprintf("\@b(%-10.10s) %s %s", "PART", $time, - BarnOwl::Style::boldify($m->sender), - $m->network, $m->channel); + boldify($m->sender." ($chan)")); } my $dir = (lc($m->direction) eq 'out') ? '>' : '<'; # Extract destination from message my $dest = $m->recipient; - my $hostStr = uc($m->server); + my $hostStr = $m->server; # Extract user information from the message. my $user = $m->sender; @@ -502,11 +478,31 @@ } if (($m->is_personal || lc($m->direction) eq 'out')) { - return BarnOwl::Style::boldify($zVT); + return boldify($zVT); } return $zVT; } +sub url_title { + my $url = shift; + my $mech = WWW::Mechanize->new; + $mech->get($url); + return clean_utf8($mech->title); +} + +sub youtube_title { + my $url = shift; + my $title = url_title($url); + $title =~ s/^YouTube - //; + return $title; +} + +sub tag_youtube { + my $body = shift; + $body =~ s{(http://(?:www[.])?youtube[.]com/watch\S+)}{"$1 [".youtube_title($1)."]"}ge; + return $body; +} + ################################################################################ # Universal body formatter. ################################################################################ @@ -526,39 +522,11 @@ # Zephyrs only: This shows me if there are literal backspaces in the # zephyr body or zsig. - my $hostSep = ($m->body =~ /\cH/ || $m->zsig =~ /\cH/) ? "!#" : "##"; + my $hostSep = ($m->body =~ /\cH/ || ($m->zsig||"") =~ /\cH/) ? "!#" : "##"; my $rawBody = $m->body; - if ($m->type eq "zephyr" && lc($m->opcode) ne "crypt") - { - # Show the other fields in zephyrs. - my $count = @{$m->fields}; - (my $body = $m->body) =~ s/^\n*|\n*$//g; - (my $zsig = $m->zsig) =~ s/^\n*|\n*$//g; - - for(my $index = 0; $index < $count; $index++) - { - my $field = @{($m->fields)}[$index]; - $field =~ s/^\n*|\n*$//g; - next if ($field eq $body - || $field eq $zsig - || $field eq ""); - $rawBody .= sprintf(" [field %i: %s]", $index + 1, $field); - } - } - # Show the XML for body-less messages. - elsif ($m->type eq "jabber") { - if ($m->body eq "") { - $rawBody = "XMPP{".$m->{xml}."}"; - } - } - - if($m->type eq "zephyr" && lc($m->class) eq 'mail') { - $rawBody =decode('MIME-Header', $rawBody); - } - - + $rawBody =~ s/\r/^M/g; # Deal with literal backspaces by interpreting them or revealing them. if ($VT_Options{"showControl"}) { @@ -567,25 +535,21 @@ 1 while $rawBody =~ s/[^\cH]\cH//g; $rawBody =~ s/[\cH]//g; } - # Deal with literal escapes by hiding or revealing them. - if ($VT_Options{"showControl"}) { - $hostSep = '!#' if $rawBody =~ s/\x1B/^[/g; - } else { - $hostSep = '!#' if $rawBody =~ s/\x1B//g; - } - - # Kill leading tags. AIM troubles. - $rawBody =~ s/^//; - - # Tab to eight spaces. Why are people sending tabs anyhow? - $rawBody =~ s/\t/ /g; # This cleans up other peoples formatting. I can see what they meant, but it - # doesn't muck with my display. Sorry about the painful regexp. + # doesn't muck with my display. # Basically, double up the '@'s in these formatting messages such that they # no longer work. Also, fix backspace issues. $rawBody =~ s/\@font\(fixed\)$//; # GAIM is broken. - 1 while $rawBody =~ s/([^@]|^)(\@(?:b|bold|i|italic|l|left|r|right|c|center|huge|large|medium|small|beep|color)?([\(\<\{\[]))/\1\@\2/gi; + $rawBody = zescape($rawBody); + + if($m->type eq 'zephyr' && $m->class eq 'MAIL') { + $rawBody = decode('MIME-Header', $rawBody); + } else { + $rawBody = clean_utf8($rawBody); + } + + $rawBody = tag_youtube($rawBody); # This is a really dumb formatting test. If the message has any newlines # followed by whitespace followed by non whitespace, I'll assume the sender @@ -599,19 +563,19 @@ # build the body, taking into account the desired indenting. my $line = shift @lines; $body .= " $line"; - $strlen = mbswidth($line); + $strlen = length($line); foreach my $l (@lines) { $body .= "\n"; $body .= " " x ($hwidth - 1); $body .= " $l"; - $strlen = mbswidth($l); + $strlen = length($l); $line = $l; } my @count = split(/\@\@/, $line); if ($#count == -1) { - $strlen -= mbswidth($line) / 2; + $strlen -= length($line) / 2; } elsif ($#count) { $strlen -= $#count; } @@ -621,50 +585,27 @@ # If the formatting does not pass the above test, I'm rewrapping the entire # message to my liking. else { - # Strip leading whitespace and then get an array of 'words' - $rawBody =~ s/^\s*//; - my @words = split (/\s+/,$rawBody); - - # -1 to take into account the leading space. It makes the loop nicer, - # and is a useful space anyways. - $strlen = -1; - foreach my $word (@words) { - #Strip extra control characters, and take note. - $hostSep = '!#' if ($word =~ /[[:cntrl:]]/); - if (!$VT_Options{'showControl'}) { - $word =~ s/[[:cntrl:]]//g; - } - if (($strlen + mbswidth($word) + 1) < $bwidth) { - $body .= " $word"; - $strlen += 1 + mbswidth($word); - } else { - # There is a small bug here, but it doesn't bother - # me. If someone types in a 'word' that is larger than - # the 'max width' it will be on a line by itself. - # Since owl can scroll sideways, I can look at what - # was said, and it won't affect the rest of the - # display... I hope. I could instead break the 'word' - # if this becomes a problem one day. - - $body .= " " x ($bwidth - $strlen); - $body .= "\n"; - $body .= " " x $hwidth; - $body .= "$word"; - $strlen = mbswidth($word); + if($m->type eq 'AIM') { + my $wc = HTML::WikiConverter->new(dialect => 'Markdown'); + $rawBody = $wc->html2wiki($rawBody); + $rawBody =~ s/\\(?=[`*_\\])//g; + my %esc = ( + gt => '>', + lt => '<', + amp => '&', + quot => '"', + ); + $rawBody =~ s/&(\w+);/$esc{$1}/eg; + } + $body = autoformat $rawBody, {left => $hwidth + 1, + right => $hwidth + $bwidth - 2, + all => 1, + renumber => 0}; + $body = "" unless defined($body); + $body =~ s/^\s+/ /; + $body =~ s/\s+$//; } - # Since '@@' is displayed as '@', we should take that into - # account when figuring out how long this word is. - my @count = split(/\@\@/, $word); - if ($#count == -1) { - $strlen -= mbswidth($word) / 2; - } elsif ($#count) { - $strlen -= $#count; - } - } - } - - $body =~ tr/A-Za-z/N-ZA-Mn-za-m/ if ($VT_Options{"rot13"}); if ($m->is_zephyr) { # Now that the body is done, we deal with formatting the zsig, if desired. if ($VT_Options{"zsigs"} && $m->zsig ne "") { @@ -679,8 +620,7 @@ # Kill leading whitespace $sig =~ s/^\s*//; - # You've seen this regexp before. - 1 while $sig =~ s/([^@]|^)(\@(?:b|bold|i|italic|l|left|r|right|c|center|huge|large|medium|small|beep|color)([\(\<\{\[]))/\1\@\2/gi; + $sig = zescape($sig); # Unlike zephyr bodies, I'm unwrapping zsigs no matter what. my @words = split (/\s+/, $sig); @@ -692,28 +632,28 @@ if (!$VT_Options{'showControl'}) { $word =~ s/[[:cntrl:]]//go; } - if (($strlen + mbswidth($word) + 1) < $zsbwidth) { + if (($strlen + length($word) + 1) < $zsbwidth) { $body .= " $word"; - $strlen += 1 + mbswidth($word); + $strlen += 1 + length($word); } else { $body .= "\n"; $body .= " " x $zsindent; # The three extra spaces keep the zsig body lined up. # Remember the '-- '? $body .= " $word"; - $strlen = 3 + mbswidth($word); + $strlen = 3 + length($word); } # And again with the '@@' => '@' processing. my @count = split(/\@\@/, $word); if ($#count == -1) { - $strlen -= mbswidth($word) / 2; + $strlen -= length($word) / 2; } elsif ($#count) { $strlen -= $#count; } } } } - if ($m->is_zephyr || ($m->type eq 'jabber' && $m->jtype eq 'groupchat') || ($m->type eq 'IRC')) { + if ($m->is_zephyr || ($m->type eq 'IRC') || ($m->type eq 'jabber' && !$m->is_personal)) { # Finally append the hostname. If it will fit on the last line of the # zephyr, that's great, if not it gets a line of its own. The hostname is # right justified. This only happens in the large screen formatting style. @@ -727,18 +667,19 @@ $hostStr = uc($m->host); $hostStr =~ s/\.MIT\.EDU$// if $VT_Options{"stripMitEdu"}; } elsif ($m->type eq 'IRC') { - $hostStr = uc($m->server); + $hostStr = uc $m->server; } else { $hostStr = uc($m->room); $hostStr =~ s/.*\@//; } - if ($hostAlone || (($strlen + 4 + mbswidth($hostStr)) >= $hostwidth)) { + $strlen = (length $1) if $body =~ /\s+(\S.+)$/; + if ($hostAlone || (($strlen + 4 + length($hostStr)) >= $hostwidth)) { $body .= "\n"; $body .= sprintf("%".($width)."s", " $hostSep $hostStr"); } else { - $body .= " " x ($hostwidth - $strlen - 4 - mbswidth($hostStr)); + $body .= " " x ($hostwidth - $strlen - 4 - length($hostStr)); $body .= " $hostSep $hostStr"; } } else { @@ -749,3 +690,5 @@ } return ($body, $hostSep); } + +1;