RetroZilla/extensions/xmlterm/scripts/xls

#!/usr/bin/perl
# xls: an XMLterm wrapper for the UNIX "ls" command
# Usage: xls  [-c|--cols] [-h|help] [-t||--text] <files>

use Cwd;
use Getopt::Long;

Getopt::Long::Configure('bundling');

&GetOptions("cols|c=i", "help|h", "text|t");

if ($opt_help) {
    print "Usage: xls [-c|--cols] [-t|--text] [<files>]\n";
    exit;
}

my $char_cols = $ENV{COLUMNS};

$char_cols = 80 unless $char_cols;

# Icon details
#my $imgdir="chrome://xmlterm/skin/default/images"
my $imgdir = "file:///usr/share/pixmaps/mc";

my %img;
($img{'directory'}, $img{'executable'}, $img{'plainfile'}, $img{'urlfile'}) =
    ('i-directory.png', 'i-executable.png', 'i-regular.png', 'i-regular.png');

my $dir = cwd();
my $rowimg = "";
my $rowtxt = "";
my $nfile = 0;

my $filelist;

if (@ARGV) {
    if ((@ARGV == 1) && (-d $ARGV[0])) {
        @filelist = glob("$ARGV[0]/*");    # specified directory
    } else {
        @filelist = @ARGV;                 # specified file(s)
    }
} else {
    @filelist = glob("*");                 # all files in current directory
}

my $file;
my $maxlen = 0;
foreach $file (@filelist) {        # for each file in the list
    $maxlen = length($file) if length($file) > $maxlen;
}

my $table_cols = $char_cols/($maxlen+1);

$table_cols = $opt_cols if ($opt_cols);

my $cookie = $ENV{LTERM_COOKIE};           # XMLTerm cookie

if (!$cookie) {
    print 'Please use the "eval `xenv`" command to set-up the remote XMLterm environment'."\n";
    exit;
}

print "\e{S$cookie\012";                     # HTML stream escape sequence
print "<TABLE FRAME=none BORDER=0>";
print "<COLGROUP COLSPAN=$table_cols WIDTH=1*>";

foreach $file (@filelist) {        # for each file in the list
    $file =~ m%\A(.*?) (\.[^/.]*)?\Z%x # Deconstruct file name
        or die "xls: Internal error; unable to deconstruct file name\n";

    my ($filename, $extension) = ($1, $2);

    my ($filetype, $fileimg, $sendcmd, $sendtxt1, $sendtxt2);

    $sendtxt1  = $file;
    if ($dir eq "/") {
        $sendtxt2  = "/";
    } else {
        $sendtxt2  = "$dir/";
    }

    if (-d $file) {                     # directory
        $filetype = "directory";
        $fileimg  = "$imgdir/$img{$filetype}";
        $sendcmd  = "cdxls";

    } elsif (-x $file) {                # executable
        $filetype = "executable";
        $fileimg  = "$imgdir/$img{$filetype}";
        $sendcmd  = "exec";

    } elsif (($extension eq ".gif") ||
             ($extension eq ".png") ||
             ($extension eq ".jpg")) {  # image
        $filetype = "imagefile";
        $fileimg  = "file://$dir/$file";
        $sendcmd  = "xcat";

    } elsif ($extension eq ".ps") {     # postscript
        $filetype = "plainfile";
        $fileimg  = "$imgdir/$img{$filetype}";
        $sendcmd  = "xcat";

    } elsif ($extension eq ".url") {  # URL
        open INFILE, $file or next;
        $_ = <INFILE>;
        close INFILE;

        # Extract content URL and the icon URL (if any)
        my @urlvals;
        my $nurl = 0;
        while ( m%\b                              # URL word boundary
                 (http|file|mailto):              # protocol
                 (?=/)                            # lookahead
                 (?://                            # slashpair
                   (?:([\w.]+)@)?                 # username
                   ([\w\-]+(?:\.[\w\-]+)*)?       # host
                   (?::(\d+))?                    # port
                 )?
                 (/|/[^/\s]\S*?)?                 # pathname
                 (?=>|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # URL terminator (look ahead)
                 %x ) {
            $urlvals[$nurl] = $&;
            s%$&%%;
            $nurl++;
        }
        s%\A\s*(\S.*?)?\s*\Z%$1%;                 # trim leading/trailing space

        if ($nurl >= 1) {
            my $urldesc = $_;
            my $urlstr = $urlvals[0];
            $urldesc = $urlstr if !$urldesc;

            $sendcmd = "textlink";               # override send command
            $sendtxt1 = "$urlstr";
            $sendtxt2 = "$urlstr";
            
            $filetype = "urlfile";
            if ($nurl >= 2) {
                $fileimg  = "$urlvals[1]";       # use icon URL
            } else {
                $fileimg  = "$imgdir/$img{$filetype}";  #default URL icon
            }
        } else {
            $filetype = "plainfile";
            $fileimg  = "$imgdir/$img{$filetype}";
            $sendcmd  = "xcat";
        }

    } else {                            # plain file
        $filetype = "plainfile";
        $fileimg  = "$imgdir/$img{$filetype}";
        $sendcmd  = "xcat";
    }

    my @comps = split(m./.,$file);
    my $tail = $comps[$#comps];            # file name

    my $clickcmd =
     qq%onClick="return HandleEvent(event,'click','$sendcmd',-\#,'$sendtxt1','$sendtxt2')"%;

    $rowimg .= "<TD><IMG HEIGHT=48 WIDTH=48 SRC='$fileimg' $clickcmd>";
    $rowtxt .= "<TD><SPAN CLASS='$filetype' $clickcmd>";
    $rowtxt .= "$tail</SPAN>";
    $nfile++;

    if (($nfile % $table_cols) == 0) {       # print complete table row
        print "<TR CLASS='icons'>$rowimg" unless $opt_text;
        print "<TR>$rowtxt";
        $rowimg = "";
        $rowtxt = "";
    }

}

if ($rowtxt) {
    print "<TR CLASS='icons'>$rowimg" unless $opt_text;
    print "<TR>$rowtxt";
}

print "</TABLE>";
print "<div class='beginner'>";
print "Double-click on file/directory name to execute file/open directory.";
print "<span class='noicons'><br>Set <b>Icons</b> setting to <em>on</em> to enable icon display.</span>";
print "<span class='icons'><br>Set <b>Icons</b> setting to <em>off</em> to disable icon display.</span>";
print "</div>";
print "\000";                           # Terminate HTML stream