Changes for DWL on Arch

2021-05-16 11:31:19 -07:00
parent bd28feb6b8
commit d2386bca8d
6 changed files with 175 additions and 5 deletions
--- a/dwltags.pl
+++ b/dwltags.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Term::ANSIColor;
+use FileHandle;
+
+my $info = {};
+
+# Color scheme is only used in ANSI mode
+# <class>_f/_g: class is used in JSON mode to be used in style.css for styling
+my $colorscheme = {
+    'norm_f' => '#ffffff',
+    'norm_b' => '#111111',
+    'sel_f' => '#ffffff',
+    'sel_b' => '#aa4444',
+    'mon_f' => '#000000',
+    'mon_b' => '#777777',
+    'lay_f' => '#111111',
+    'lay_b' => '#77aaaa',
+    'title_f' => '#ffcccc',
+    'title_b' => '#111111'
+    # 'norm_f' => 'white',
+    # 'norm_b' => 'black',
+    # 'sel_f' => 'black',
+    # 'sel_b' => 'red',
+    # 'mon_f' => 'black',
+    # 'mon_b' => 'grey23',
+    # 'lay_f' => 'black',
+    # 'lay_b' => 'cyan',
+    # 'title_f' => 'red',
+    # 'title_b' => 'black'
+};
+
+print_tags({
+        'selmon' => '1',
+        'tags' => '1 1',
+        'title' => '',
+        'layout' => '[]='
+    });
+
+while (<>) {
+    my $line = $_;
+    chomp $line;
+
+    if (my ($mon, $key, $val) = $line =~ /^(\S+)\s+(\S+)\s(.*)$/) {
+        $info->{$key} = $val;
+        if ($key eq "layout") {
+            # Commit a status
+            # Assumption: layout is the last piece of information dumped by DWL
+            $info->{'mon'} = $mon;
+            print_tags($info);
+
+            $info = {};
+        }
+    } else {
+        print "DWL: Printed out of format\n";
+    }
+}
+
+sub print_tags {
+    my ($info) = @_;
+    my $numtags = 10;
+
+    return if ($info->{'selmon'} ne "1");
+
+    if (my ($tuse, $tsel) = $info->{'tags'} =~ /(\d+)\s+(\d+)/) {
+        my $tags = "";
+
+        for (my $i = 0; $i < $numtags; $i++) {
+            my $sel = "norm";
+            if (($tuse & (1 << $i))) {
+                if ($tsel & (1 << $i)) {
+                    $sel = "sel";
+                }
+                $tags .= getformatted($sel, " ". ($i+1) . " ");
+            }
+        }
+
+        if (exists $ENV{'DWLTAGS_SHOW_MON'}) {
+            $tags .= getformatted("mon", " $info->{'mon'} ");
+        }
+
+        $tags .= getformatted("lay", " $info->{'layout'} ");
+        $tags .= getformatted("title", " $info->{'title'} ");
+
+        my $fh = FileHandle->new("> " . $ENV{'DWLTAGS_FILE'});
+        if (defined $fh) {
+            print $fh $tags . "\n";
+            $fh->close;
+        }
+    } else {
+        print "DWL: Printed out of format - tags\n";
+    }
+}
+
+sub getformatted {
+    my ($c, $txt) = @_;
+
+    if ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "DZEN")) {
+        return dzen_colored($c, $txt);
+    } elsif ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "ANSI")) {
+        return colored([$colorscheme->{$c . '_f'} . " on_" . $colorscheme->{$c . '_b'}], $txt);
+    } elsif ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "JSON")) {
+        return '{"text": "' . $txt . '", "class": "dwltags-' . $c . '"}';
+    } else {
+        if ($c eq "sel") {
+            $txt =~ s/\s+//g;
+            $txt = "[$txt]";
+        }
+        return $txt;
+    }
+}
+
+sub dzen_colored {
+    my ($class, $txt) = @_;
+    my $fc = $colorscheme->{$class . '_f'};
+    my $bc = $colorscheme->{$class . '_b'};
+    # return colored([$colorscheme->{$c . '_f'} . " on_" . $colorscheme->{$c . '_b'}], $txt);
+    return "^fg(" . $fc . ")^bg(" . $bc . ")" . $txt . "^fg()^bg()";
+}