mirror of
https://github.com/rn10950/RetroZilla.git
synced 2024-08-30 17:40:16 +02:00
189 lines
5.6 KiB
Plaintext
189 lines
5.6 KiB
Plaintext
|
#!/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
|
||
|
|