repo: rxvt-unicode-sixel
action: commit
revision: 
path_from: 
revision_from: 13621306f5f692003e9689c1bc8447bc96e074d8:
path_to: 
revision_to: 
git.thebackupbox.net
rxvt-unicode-sixel
git clone git://git.thebackupbox.net/rxvt-unicode-sixel
commit 13621306f5f692003e9689c1bc8447bc96e074d8
Author: Marc Lehmann 
Date:   Mon Jan 2 18:20:23 2006 +0000

    *** empty log message ***

diff --git a/src/main.C b/src/main.C
index 1f851331d388f56aa0c49fecdfa36d0ccd0e0cdc..
index ..a61dbe14a4f55be236ed85a0effec7eba9beccfc 100644
--- a/src/main.C
+++ b/src/main.C
@@ -50,7 +50,7 @@

 vector rxvt_term::termlist;

-static char curlocale[128];
+static char curlocale[128], savelocale[128];

 bool
 rxvt_set_locale (const char *locale)
@@ -63,6 +63,19 @@ rxvt_set_locale (const char *locale)
   return true;
 }

+bool
+rxvt_push_locale (const char *locale)
+{
+  strcpy (savelocale, curlocale);
+  rxvt_set_locale (locale);
+}
+
+void
+rxvt_pop_locale ()
+{
+  rxvt_set_locale (savelocale);
+}
+
 #if ENABLE_COMBINING
 class rxvt_composite_vec rxvt_composite;

diff --git a/src/rsinc.h b/src/rsinc.h
index b66b36bcd653693fc86039e297ceb1eb670b5a00..
index ..efeb52e0f2e7142c2beba89e6cbb447031173fb1 100644
--- a/src/rsinc.h
+++ b/src/rsinc.h
@@ -103,3 +103,8 @@
 #ifdef TINTING
   Rs_def(shade)
 #endif
+#if ENABLE_PERL
+  Rs_def(perl_lib)
+  Rs_def(perl_eval)
+  Rs_def(perl)
+#endif
diff --git a/src/rxvt.h b/src/rxvt.h
index 9f91482f675a21f8d3dc675915e6b651d676581e..
index ..5c4cabbf04d4d01409a1e4f4c94e89674cd890cd 100644
--- a/src/rxvt.h
+++ b/src/rxvt.h
@@ -851,6 +851,8 @@ extern void rxvt_exit_failure () __attribute__ ((noreturn));

 #define SET_LOCALE(locale) rxvt_set_locale (locale)
 extern bool rxvt_set_locale (const char *locale);
+extern bool rxvt_push_locale (const char *locale);
+extern void rxvt_pop_locale ();

 /*
  *****************************************************************************
diff --git a/src/rxvtperl.xs b/src/rxvtperl.xs
index 23945bd59600cf0570adbc2d74086f31279f7129..
index ..5be34cb0ebeb3260625d9dbfbfa586065a3e47f8 100644
--- a/src/rxvtperl.xs
+++ b/src/rxvtperl.xs
@@ -326,25 +326,68 @@ fatal (const char *msg)
 	CODE:
         rxvt_fatal ("%s", msg);

+NV
+NOW ()
+	CODE:
+        RETVAL = NOW;
+        OUTPUT:
+        RETVAL
+
+MODULE = urxvt             PACKAGE = urxvt::term
+
 int
-wcswidth (SV *str)
+rxvt_term::strwidth (SV *str)
 	CODE:
 {
         wchar_t *wstr = sv2wcs (str);
+
+	rxvt_push_locale (THIS->locale);
         RETVAL = wcswidth (wstr, wcslen (wstr));
+        rxvt_pop_locale ();
+
         free (wstr);
 }
 	OUTPUT:
         RETVAL

-NV
-NOW ()
+SV *
+rxvt_term::locale_encode (SV *str)
 	CODE:
-        RETVAL = NOW;
-        OUTPUT:
+{
+        wchar_t *wstr = sv2wcs (str);
+
+	rxvt_push_locale (THIS->locale);
+        char *mbstr = rxvt_wcstombs (wstr);
+        rxvt_pop_locale ();
+
+        free (wstr);
+
+        RETVAL = newSVpv (mbstr, 0);
+        free (mbstr);
+}
+	OUTPUT:
         RETVAL

-MODULE = urxvt             PACKAGE = urxvt::term
+SV *
+rxvt_term::locale_decode (SV *octets)
+	CODE:
+{
+	STRLEN len;
+        char *data = SvPVbyte (octets, len);
+
+	rxvt_push_locale (THIS->locale);
+        wchar_t *wstr = rxvt_mbstowcs (data, len);
+        rxvt_pop_locale ();
+
+        char *str = rxvt_wcstoutf8 (wstr);
+        free (wstr);
+
+        RETVAL = newSVpv (str, 0);
+        SvUTF8_on (RETVAL);
+        free (str);
+}
+	OUTPUT:
+        RETVAL

 void
 rxvt_term::_resource (char *name, int index, SV *newval = 0)
@@ -460,6 +503,14 @@ rxvt_term::scr_overlay_set (int x, int y, SV *text)
         free (wtext);
 }

+void
+rxvt_term::tt_write (SV *octets)
+        INIT:
+          STRLEN len;
+          char *str = SvPVbyte (octets, len);
+	C_ARGS:
+          (unsigned char *)str, len
+
 MODULE = urxvt             PACKAGE = urxvt::timer

 SV *
diff --git a/src/urxvt.pm b/src/urxvt.pm
index 5f20d721f56094aa0f5ab616d02e6becd504adeb..
index ..eabcb6c1c0c35bd1ef0aa8f18911c314256cb050 100644
--- a/src/urxvt.pm
+++ b/src/urxvt.pm
@@ -6,9 +6,6 @@ rxvtperl - rxvt-unicode's embedded perl interpreter

 * Put your scripts into F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, they will be loaded automatically.

-* Each script will only be loaded once, even in urxvtd, and will be valid
-globally.
-
 * Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
 thus must be encoded as UTF-8.

@@ -21,6 +18,28 @@ thus must be encoded as UTF-8.

 =head1 DESCRIPTION

+On startup, @@RXVT_NAME@@ will scan F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>
+for files and will load them. Everytime a terminal object gets created,
+the directory specified by the C resource will be additionally
+scanned.
+
+Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
+scripts will be shared for all terminals.
+
+Hooks in scripts specified by C will only be called for the
+terminals created with that specific option value.
+
+=head2 General API Considerations
+
+All objects (such as terminals, time watchers etc.) are typical
+reference-to-hash objects. The hash can be used to store anything you
+like. The only reserved member is C<_ptr>, which must not be changed.
+
+When objects are destroyed on the C++ side, the perl object hashes are
+emptied, so its best to store related objects such as time watchers and
+the like inside the terminal object so they get destroyed as soon as the
+terminal is destroyed.
+
 =head2 Hooks

 The following subroutines can be declared in loaded scripts, and will be called
@@ -122,18 +141,13 @@ starts up.

 =item urxvt::warn $string

-Calls C witht eh given string which should not include a
+Calls C with the given string which should not include a
 newline. The module also overwrites the C builtin with a function
 that calls this function.

 Using this function has the advantage that its output ends up in the
 correct place, e.g. on stderr of the connecting urxvtc client.

-=item $cellwidth = urxvt::wcswidth $string
-
-Returns the number of screen-cells this string would need. Correctly
-accounts for wide and combining characters.
-
 =item $time = urxvt::NOW

 Returns the "current time" (as per the event loop).
@@ -227,7 +241,27 @@ sub load_script($) {
    };
 }

-load_script $_ for grep -f $_, <$LIBDIR/perl-ext/*>;
+sub load_scripts($) {
+   my ($dir) = @_;
+
+   verbose 3, "loading scripts from '$dir'";
+
+   load_script $_
+      for grep -f $_,
+         <$dir/perl-ext/*>;
+}
+
+sub on_init {
+   my ($term) = @_;
+
+   my $libdir = $term->resource ("perl_lib");
+
+   load_scripts $libdir
+      if defined $libdir;
+}
+
+register_package __PACKAGE__;
+load_scripts $LIBDIR;

 =back

@@ -261,13 +295,13 @@ list:
   display_name embed ext_bwidth fade font geometry hold iconName
   imFont imLocale inputMethod insecure int_bwidth intensityStyles
   italicFont jumpScroll lineSpace loginShell mapAlert menu meta8
-  modifier mouseWheelScrollPage name pastableTabs path pointerBlank
-  pointerBlankDelay preeditType print_pipe pty_fd reverseVideo saveLines
-  scrollBar scrollBar_align scrollBar_floating scrollBar_right
-  scrollBar_thickness scrollTtyKeypress scrollTtyOutput scrollWithBuffer
-  scrollstyle secondaryScreen secondaryScroll selectstyle shade term_name
-  title transparent transparent_all tripleclickwords utmpInhibit
-  visualBell
+  modifier mouseWheelScrollPage name pastableTabs path perl perl_eval
+  perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
+  reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
+  scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
+  scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
+  shade term_name title transparent transparent_all tripleclickwords
+  utmpInhibit visualBell

 =cut

@@ -307,7 +341,7 @@ sub urxvt::term::scr_overlay {
    my @lines = split /\n/, $text;

    my $w = 0;
-   for (map urxvt::wcswidth $_, @lines) {
+   for (map $self->strwidth ($_), @lines) {
       $w = $_ if $w < $_;
    }

@@ -335,6 +369,25 @@ position.

 Write a string at the given position into the overlay.

+=item $cellwidth = $term->strwidth $string
+
+Returns the number of screen-cells this string would need. Correctly
+accounts for wide and combining characters.
+
+=item $octets = $term->locale_encode $string
+
+Convert the given text string into the corresponding locale encoding.
+
+=item $string = $term->locale_decode $octets
+
+Convert the given locale-encoded octets into a perl string.
+
+=item $term->tt_write ($octets)
+
+Write the octets given in C<$data> to the tty (i.e. as program input). To
+pass characters instead of octets, you should convetr you strings first to
+the locale-specific encoding using C<< $term->locale_encode >>.
+
 =back

 =head2 The C Class
diff --git a/src/xdefaults.C b/src/xdefaults.C
index a161b738761f0eba523bb5833f1b8c4d2a05a285..
index ..034ba8d7b9fad0c53ddc480769450eab480ab364 100644
--- a/src/xdefaults.C
+++ b/src/xdefaults.C
@@ -260,6 +260,11 @@ optList[] = {
               BOOL (Rs_secondaryScreen, "secondaryScreen", "ssc", Opt_secondaryScreen, "enable secondary screen"),
               BOOL (Rs_secondaryScroll, "secondaryScroll", "ssr", Opt_secondaryScroll, "enable secondary screen scroll"),
 #endif
+#if ENABLE_PERL
+              STRG (Rs_perl_lib, "perl-lib", 0, "string", "directory where to look for additional extension scripts"),
+              STRG (Rs_perl_eval, "perl-eval", 0, "string", "string to be evaluated after all extensions have been loaded"),
+              STRG (Rs_perl, "perl", "perl", "string", "unused by urxvt proper, free for extensions to use"),
+#endif
 #if 0 && TODO
 #if !defined(NO_RESOURCES) && defined(USE_XGETDEFAULT)
               INFO ("xrm", "string", "X resource"),

-----END OF PAGE-----