#!/usr/bin/perl -w
# slashes.pl - Slashdot headlines news-ticker
# Maintained by Darxus@op.net
# Copyright (c) 1998 Alex Shnitman <alexsh@linux.org.il>, 1999 Darxus@op.net
# This code is distributed under the terms of the GNU General Public License.
#
# Darxus
# v1.3+speech Dec 11 19:31:11 1998 
#  Added speech synthesis support requiring speechd:  
#  http://SpeechIO.undef.net/
#
# Darxus
# v1.4 8393 Wed Aug 11 22:35:35 EDT 1999
#  Okay, I've gone and incremented the version number.
#  Hakan.Lennestal@cdt.luth.se informed me that v1.3 did not work w/
#  current libraries without remarking out lines 94 & 180 (of v1.3).  So
#  I've done so.  Also changed formatting of output to /dev/speech.
#
# Darxus
# v1.5 9272 Sat Aug 28 12:04:50 EDT 1999
#  Got permissin from Alex Shnitman to take over maintenance of slashes.
#  Improved speech I/O.
#  Display date of last update.
#
# This script requires libgtk-perl 0.3 or better.
#
# Usage: slashes.pl [-clf]
#  -c  run slashes.pl in compact mode
#  -l  has effect only in compact mode, where it makes slashes.pl launch an
#      article upon left click and not middle click
#  -f  tells slashes.pl that you'd like to read flattened comments
#  -s  tells slashes.pl to use speech

use Gtk;
init Gtk;
use Socket;
use IO::Handle;
use Getopt::Std;

use strict;

my %opts;
getopts("clfs", \%opts);	   # Patrick Seal: support for command-line args

# You can tell the script to use a proxy. If $PROXY is empty it
# will not use one. By default the script takes the value of the
# http_proxy environment variable (suggested by ERDI 'Cactus' Gergo),
# so if there isn't one no proxy will be used.
my $PROXY = "";
my $PROXYPORT = 0;
if($ENV{http_proxy}) {
    $ENV{http_proxy} =~ m$http://(.*?):(.*?)/$;
    $PROXY = $1;
    $PROXYPORT = $2;
}

# Number of seconds before a refresh is performed.
# Suggested by Brett Kosinski
# Since ultramode.txt only updates once in 30 minutes, the timeout is
# set to that value.
my $REFRESH_TIMEOUT = 1800;

# Path to Netscape executable
# Suggested by Brett Kosinski
# The ## is replaced by the URL here
my $BROWSER_CMD = "/usr/X11R6/bin/netscape -remote 'OpenURL(##, new_window)'";

# If you prefer to read flattened comments, set the following variable to 1.
# Suggested by P. Siegmann
my $COMMENTS_FLAT = $opts{f} || 0;

# If you'd like to run slashes.pl in "compact" mode (without the
# buttons on the bottom & the column titles, and launching an article
# upon a click on its row) set this variable to 1.
my $COMPACT_MODE = $opts{c} || 0;

# If while in compact mode you'd like an article to be launched upon a
# left-click (and not a middle-click like it is by default) set this
# variable to 1.
my $COMPACT_LCLICK = $opts{l} || 0;

# If you want to hear headlines spoken, set this to 1.
# Requires speechd (http://www.op.net/~darxus/speech)
my $SPEECH = $opts{"s"} || 0;

############ End of configuration

if ($SPEECH)
{
  open SPEECH, ">/dev/speech" or die "Error opening /dev/speech for writing  $!\n";
}

# $clist and $status hold the references to the Gtk CList holding the
# articles, and the status line which is actually a label. @articles
# holds the URLs of the articles.
my($clist, $status, @articles);

sub MainWindow {
    my $mainwin = new Gtk::Window;
    $mainwin->set_title("Slashdot headlines");
    $mainwin->signal_connect("destroy", \&Gtk::main_quit);
    $mainwin->signal_connect("delete_event", \&Gtk::false);
    $mainwin->set_usize(600,150);
    $mainwin->set_policy(1,1,1);
    my $vbox = new Gtk::VBox(0,5);
    $vbox->border_width(5);

    $clist = new_with_titles Gtk::CList("Title", "Author", "Topic", "Comments");
    if($COMPACT_MODE) {
	$clist->column_titles_hide;
    } else {
	$clist->column_titles_passive;
    }
    $clist->set_selection_mode("browse");

#   Does not work w/ current libs.   
#   "...sets the scrollbar policy of the CList, saying that the vertical
#   scrollbar should appear always, and the horizontal - only when needed.
#   --Alex Shnitman <alexsh@hectic.net>

#   $clist->set_policy("always", "automatic");

    $clist->set_column_width(0, 250);
    $clist->set_column_width(1, 70);
    $clist->set_column_width(2, 100);
    $clist->set_column_width(3, 20);
    if($COMPACT_MODE) {
	if($COMPACT_LCLICK) {  # Launch article on left click
	# The following based on code by Dov Grobgeld
	$clist->signal_connect("select_row", sub {
				     &Browse($articles[$clist->selection]);
				 });
	} else {	       # Launch article on middle click
	$clist->signal_connect("button_press_event", sub {
				     my $event = $_[1];
				     if($event->{button} == 2) {
			 		$event->{button} = 1;
					Gtk::Gdk::event_put($clist, $event);
				     }
				     return 1;
				 });
	$clist->signal_connect("button_release_event", sub {
				     my $event = $_[1];
				     my $button = $event->{button};
				     my $x = $event->{"x"};
				     my $y = $event->{"y"};
				     my ($r, $c) =
				           $clist->get_selection_info($x, $y);
				     if ($button == 2 &&
				         defined $r && defined $c &&
					 $r!=-1 && $c!=-1) {
				     # although this selecting isn't
				     # necessary, the results make much
				     # more sense as opposed to simply
				     # opening that selection while
				     # leaving the selected row somewhere
				     # else.
				     #	chris quirk <quirk@andrew.cmu.edu>
				     #	12/01/98
				     $clist->select_row($r, $c);
				     &Browse($articles[$clist->selection]);
				     }
				     return 1;
				 });
	}
    }
    $clist->show;
    $vbox->pack_start($clist, 1,1,0);

    unless($COMPACT_MODE) {
	my $hbox = new Gtk::HBox(0,0);
	my $but;
	$but = new_with_label Gtk::Button("  Refresh  ");
	$but->signal_connect("clicked", \&Refresh);
	$hbox->pack_start($but, 0,0,0);
	$but->show;
	
	$but = new_with_label Gtk::Button("  Read  ");
	$but->signal_connect("clicked", sub {
				 return unless(defined $clist->selection);
				 &Browse($articles[$clist->selection]);
			     });
	$hbox->pack_start($but, 0,0,0);
	$but->show;
	$status = new Gtk::Label("Refreshing headlines...");
	$hbox->pack_start($status, 0,0,10);
	$status->show;
	$but = new_with_label Gtk::Button("  Quit  ");
	$but->signal_connect("clicked", \&Gtk::main_quit);
	$hbox->pack_end($but, 0,0,0);
	$but->show;
	
	$vbox->pack_start($hbox, 0,0,0);
	$hbox->show;
    } else {
	# Create a dummy $status so funtions that set the status line
	# don't complain.
	$status = new Gtk::Label("");
    }

    # Add a timeout to refresh the list automatically.
    # Suggested by Brett Kosinski
    Gtk->timeout_add(1000*$REFRESH_TIMEOUT, \&Refresh, undef);

    $mainwin->add($vbox);
    $vbox->show;
    $mainwin->show;

#   Does not work w/ current libs.   
#   "...draws the main window and all the widgets before getting the
#   headlines, so that even if it takes time for the headlines to appear,
#   the slashes window appears right in the beginnig and doesn't pop out
#   on you later."
#   --Alex Shnitman <alexsh@hectic.net>

#    $mainwin->draw_children; # for the window to draw before the

}			      # first refresh

sub Browse {
    my($url) = @_;
    $url =~ s/\.shtml$/_F.shtml/
	if $COMMENTS_FLAT;
    my $cmd = $BROWSER_CMD;
    $cmd =~ s/\#\#/$url/;
    system($cmd);
    $status->set("Sent URL to the browser");
    # If I don't return 1 explicitly then timeout_add won't reschedule
    # the event again.
    return 1;
}
    

sub Refresh {
    if ($SPEECH) 
    {
      print SPEECH "downloading slash dot news\n";
      autoflush SPEECH 1;
    }
    my($iaddr, $proto, $port, $paddr, $url);

    if($PROXY) {
	$iaddr = gethostbyname($PROXY);
	$port = $PROXYPORT;
	$url = "http://slashdot.org/ultramode.txt";
    } else {
	$iaddr = gethostbyname("slashdot.org");
	$port = 80;
	$url = "/ultramode.txt";
    }

    $proto = getprotobyname("tcp");
    $paddr = sockaddr_in($port, $iaddr);

    $status->set("Connecting to slashdot.org...");  # this actually
						    # won't show...
    socket(SLASH, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
    connect(SLASH, $paddr) or die "connect: $!";
    autoflush SLASH 1;
    print SLASH "GET $url HTTP/1.0\r\n\r\n";
    $status->set("Connected; waiting for reply...");

    # Generic ultramode.txt parser
    # by Steve Haslam
    # Handles the number of fields between delimiters being extended...
    # Skip HTTP header
    local $/ = "\r\n\r\n";
    my $http_header = <SLASH>;
    my @http_headerlist = split(/\r\n/, $http_header);
    my $http_status = shift @http_headerlist;
    my($httpver, $nstatus, $vstatus) = ($http_status =~ /(.*?) (.*?) (.*)/);
    if ($nstatus !~ /^2/) {
      $status->set("HTTP error $nstatus: $vstatus");
      return;
    }
    $status->set("Data arriving...");
    $clist->clear;
    undef @articles;
    # Get text data
    local $/ = "\n%%\n";
    # Remove the intro
    my $intro = <SLASH>;
    foreach (<SLASH>) {
      my($title, $link, $time, $author, $dept, $topic, $numcomments,
	 $storytype, $imagename) = split(/\n/);
      if ($SPEECH)
      {
        print SPEECH " $title \n";
        autoflush SPEECH 1;
      }
      $clist->append($title, $author, $topic, $numcomments);
      push(@articles, $link);
    }
    close SLASH;

    $status->set("Headlines retrieved ".(localtime));
}

&MainWindow;
&Refresh;
main Gtk;