-- Leo's gemini proxy

-- Connecting to git.thebackupbox.net:1965...

-- Connected

-- Sending request

-- Meta line: 20 text/gemini

repo: rxvt-unicode-sixel
action: commit
revision:
path_from:
revision_from: be8ead2b5809602208532ee388b69ac2b6fe7218:
path_to:
revision_to:

commit be8ead2b5809602208532ee388b69ac2b6fe7218
Author: Marc Lehmann <schmorp@schmorp.de>
Date:   Tue Jun 5 22:23:07 2012 +0000

    *** empty log message ***

diff --git a/src/perl/background b/src/perl/background

--- a/src/perl/background
+++ b/src/perl/background
@@ -1,6 +1,7 @@
 #! perl

 #:META:RESOURCE:$$:string:background expression
+#:META:RESOURCE:$$-enable:boolean:some boolean

 our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", repeat_wrap, X, Y';
 $EXPR = '
diff --git a/src/rxvtperl.h b/src/rxvtperl.h

--- a/src/rxvtperl.h
+++ b/src/rxvtperl.h
@@ -57,7 +57,7 @@ struct rxvt_perl_interp
   bool invoke (rxvt_term *term, hook_type htype, ...);
   void line_update (rxvt_term *term);
   void selection_finish (rxvt_selection *sel, char *data, unsigned int len);
-  void usage (int type);
+  void usage (rxvt_term *term, int type);

   enum
   {
diff --git a/src/rxvtperl.xs b/src/rxvtperl.xs

--- a/src/rxvtperl.xs
+++ b/src/rxvtperl.xs
@@ -394,7 +394,7 @@ rxvt_perl_interp::init (rxvt_term *term)
 }

 void
-rxvt_perl_interp::usage (int type)
+rxvt_perl_interp::usage (rxvt_term *term, int type)
 {
   localise_env set_environ (perl_environ);

@@ -402,7 +402,9 @@ rxvt_perl_interp::usage (int type)
   SAVETMPS;

   dSP;
-  XPUSHs (sv_2mortal (newSViv (type)));
+  EXTEND (SP, 2);
+  PUSHs (sv_2mortal (newSVterm (term)));
+  PUSHs (sv_2mortal (newSViv (type)));
   PUTBACK;
   call_pv ("urxvt::usage", G_VOID | G_DISCARD | G_EVAL);

@@ -880,6 +882,11 @@ BOOT:
     newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
 }

+void
+log (const char *msg)
+	CODE:
+        rxvt_log ("%s", msg);
+
 void
 warn (const char *msg)
 	CODE:
diff --git a/src/urxvt.pm b/src/urxvt.pm

--- a/src/urxvt.pm
+++ b/src/urxvt.pm
@@ -945,28 +945,40 @@ BEGIN {

 no warnings 'utf8';

-sub perl_libdirs {
-   map { split /:/ }
-      $_[0]->resource ("perl_lib"),
-      $ENV{URXVT_PERL_LIB},
-      "$ENV{HOME}/.urxvt/ext",
-      "$LIBDIR/perl"
-}
-
-our %META; # meta header information from scripts
-our %SCAN; # which dirs already scanned
-
 sub resource {
    my ($term, $name, $isarg, $flag, $value) = @_;

-   for my $dir (perl_libdirs $term) {
-   }
+   $term->scan_meta;

    warn "resourece<@_>\n";#d#

    0
 }

+sub usage {
+   my ($term, $usage_type) = @_;
+
+   $term->scan_meta;
+
+   my $r = $term->{meta}{resource};
+
+   for my $regex (sort keys %$r) {
+      my ($ext, $type, $desc) = @{ $r->{$regex} };
+
+      $desc .= " (-pe $ext)";
+
+      if ($usage_type == 1) {
+         if ($type eq "boolean") {
+            urxvt::log sprintf "  -%-20.20s %s\n", "/+$regex", $desc;
+         } else {
+            urxvt::log sprintf "  -%-20.20s %s\n", "$regex $type", $desc;
+         }
+      } else {
+         urxvt::log sprintf "  %-19.19s %s\n", "$regex:", $type;
+      }
+   }
+}
+
 my $verbosity = $ENV{URXVT_PERL_VERBOSITY};

 sub verbose {
@@ -1012,7 +1024,7 @@ sub invoke {
    my $htype = shift;

    if ($htype == 0) { # INIT
-      my @dirs = perl_libdirs $TERM;
+      my @dirs = $TERM->perl_libdirs;

       my %ext_arg;

@@ -1293,6 +1305,49 @@ sub register_package {
    }
 }

+sub perl_libdirs {
+   map { split /:/ }
+      $_[0]->resource ("perl_lib"),
+      $ENV{URXVT_PERL_LIB},
+      "$ENV{HOME}/.urxvt/ext",
+      "$LIBDIR/perl"
+}
+
+sub scan_meta {
+   my ($self) = @_;
+   my @libdirs = perl_libdirs $self;
+
+   return if $self->{meta_libdirs} eq join "\x00", @libdirs;
+
+   my %meta;
+
+   $self->{meta_libdirs} = join "\x00", @libdirs;
+   $self->{meta}         = \%meta;
+
+   for my $dir (reverse @libdirs) {
+      opendir my $fh, $dir
+         or next;
+      for my $ext (readdir $fh) {
+         $ext ne "."
+            and $ext ne ".."
+            and open my $fh, "<", "$dir/$ext"
+            or next;
+
+         while (<$fh>) {
+            if (/^#:META:RESOURCE:(.*)/) {
+               my ($regex, $type, $desc) = split /:/, $1;
+               $regex =~ s/\$\$/$ext/g; # $$ in regex == extension name
+               $meta{resource}{$regex} = [$ext, $type, $desc];
+            } elsif (/^\s*(?:#|$)/) {
+               # skip other comments and empty lines
+            } else {
+               last; # stop parsing on first non-empty non-comment line
+            }
+         }
+      }
+   }
+}
+
 =item $term = new urxvt::term $envhashref, $rxvtname, [arg...]

 Creates a new terminal, very similar as if you had started it with system
diff --git a/src/xdefaults.C b/src/xdefaults.C

--- a/src/xdefaults.C
+++ b/src/xdefaults.C
@@ -449,6 +449,12 @@ rxvt_term::rxvt_usage (int type)
                          (optList_isBool (i) ? "turn on/off " : ""),
                          optList[i].desc);
             }
+
+#if ENABLE_PERL
+        rxvt_perl.init (this);
+        rxvt_perl.usage (this, 1);
+#endif
+
         rxvt_log ("\n  --help to list long-options");
         break;

@@ -462,18 +468,16 @@ rxvt_term::rxvt_usage (int type)
                     optList[i].kw,
                     (INDENT - strlen (optList[i].kw)), "", /* XXX */
                     (optList_isBool (i) ? "boolean" : optList[i].arg));
-        rxvt_log ("\n  -help to list options");
-        break;
-    }

 #if ENABLE_PERL
-  if (type) // do not initialise perl for type == 0, as perl does not have "short" options
-    {
-      rxvt_perl.init (this);
-      rxvt_perl.usage (type);
-    }
+        rxvt_perl.init (this);
+        rxvt_perl.usage (this, 2);
 #endif

+        rxvt_log ("\n  -help to list options");
+        break;
+    }
+
   rxvt_log ("\n\n");
   rxvt_exit_failure ();
 }

-- Response ended

-- Page fetched on Sun Jun 2 11:23:31 2024