Perl6 Hexchat plugin

Perl6.c

#include "Perl6.h"
#include <moar.h>

#define HEXCHAT_PLUGIN_HANDLE (perl6hc_ph)
#include "hexchat-plugin.h"

#define PNAME "Perl6"
#define PDESC "Perl 6 scripting interface"
#define VERSION "0.1"

export hexchat_plugin *perl6hc_ph;

export void
hexchat_plugin_get_info (char **name, char **desc, char **version, void **reserved)
{
	*name = PNAME;
	*desc = PDESC;
	*version = PVERSION;
}

MVMInstance *instance = NULL;

const char *filename = PERL6_INSTALL_PATH "/share/perl6/runtime/perl6.moarvm";
 
static void toplevel_initial_invoke(MVMThreadContext *tc, void *data) {
	/* Create initial frame, which sets up all of the interpreter state also. */
	MVM_frame_invoke(tc, (MVMStaticFrame *)data, MVM_callsite_get_common(tc, MVM_CALLSITE_ID_NULL_ARGS), NULL, NULL, NULL, -1);
}
 
static int load_moar( char **word, char **word_eol, void *unused) {
	const char  *lib_path[8];
	const char *raw_clargs[2];

	int argi         = 1;
	int lib_path_i   = 0;

	MVMCompUnit *cu = NULL;
	MVMThreadContext *tc = NULL;

	if( instance != NULL ) {
		hexchat_print (plugin_handle, "Perl6 interpreter previously loaded\n");
		return HEXCHAT_EAT_ALL;
	}
	
	hexchat_print (plugin_handle, "Perl6 interpreter loading\n");
	
	MVM_crash_on_error();

	instance   = MVM_vm_create_instance();
	lib_path[lib_path_i++] = PERL6_INSTALL_PATH "/share/nqp/lib";
	lib_path[lib_path_i++] = PERL6_INSTALL_PATH "/share/perl6/lib";
	lib_path[lib_path_i++] = PERL6_INSTALL_PATH "/share/perl6/runtime";
	lib_path[lib_path_i++] = NULL;

	for( argi = 0; argi < lib_path_i; argi++)
		instance->lib_path[argi] = lib_path[argi];

	/* stash the rest of the raw command line args in the instance */
	instance->prog_name  = PERL6_INSTALL_PATH "/share/perl6/runtime/perl6.moarvm";
	instance->exec_name  = "perl6";
	instance->raw_clargs = NULL;

	/* Map the compilation unit into memory and dissect it. */
	tc = instance->main_thread;
	cu = MVM_cu_map_from_file(tc, filename);

	MVMROOT(tc, cu, {
		/* The call to MVM_string_utf8_decode() may allocate, invalidating the
		   location cu->body.filename */
		MVMString *const str = MVM_string_utf8_decode(tc, instance->VMString, filename, strlen(filename));
		cu->body.filename = str;

		/* Run deserialization frame, if there is one. */
		if (cu->body.deserialize_frame) {
			MVM_interp_run(tc, &toplevel_initial_invoke, cu->body.deserialize_frame);
		}
	});
	
	instance->raw_clargs = (char **)raw_clargs;
	instance->clargs = NULL; /* clear cache */

	instance->num_clargs = 1;
	raw_clargs[0] = "Raw.pm";
	
	MVM_interp_run(tc, &toplevel_initial_invoke, cu->body.main_frame);

	{
		/* I am told that these variables will only get used inside of */
		/* toplevel_initial_invoke, and will not get stashed inside of 'instance'. */
		
		/* Points to the current opcode. */
		MVMuint8 *cur_op = NULL;

		/* The current frame's bytecode start. */
		MVMuint8 *bytecode_start = NULL;

		/* Points to the base of the current register set for the frame we
		 * are presently in. */
		MVMRegister *reg_base = NULL;

		/* Stash addresses of current op, register base and SC deref base
		 * in the TC; this will be used by anything that needs to switch
		 * the current place we're interpreting. */
		tc->interp_cur_op         = &cur_op;
		tc->interp_bytecode_start = &bytecode_start;
		tc->interp_reg_base       = &reg_base;
		tc->interp_cu             = &cu;
		
		toplevel_initial_invoke(tc, cu->body.main_frame);
	}
	
	hexchat_print (plugin_handle, "Perl6 interpreter loaded\n");
	return HEXCHAT_EAT_ALL;
}

export int
hexchat_plugin_init (hexchat_plugin *plugin_handle, char **plugin_name, char **plugin_desc, char **plugin_version, char *word_eol)
{
	/* we need to save this for use with any hexchat_* functions */
	perl6hc_ph = plugin_handle;

	/* tell HexChat our info */
	*plugin_name = PNAME;
	*plugin_desc = PDESC;
	*plugin_version = PVERSION;
	
	hexchat_hook_command(ph, "init_p6", HEXCHAT_PRI_NORM, load_moar,
		"Usage: Fire up the moarvm perl6 interpreter.", NULL);
	hexchat_print (plugin_handle, "Perl6 interface loaded\n");
	
	return 1;
}


export int
hexchat_plugin_deinit (hexchat_plugin * plugin_handle) {
	if( instance != NULL ) {
		hexchat_print (plugin_handle, "Destroying perl6 interpreter.\n");
		MVM_vm_destroy_instance( instance );
		instance = NULL;
	}
	hexchat_print (plugin_handle, "Perl6 interface unloaded\n");
	return 1;
}

export int perl6hc_emit_print_workaround(hexchat_plugin *handle, char *event_name,
	char *one, char *two, char *three, char *four, char *five) {
	return hexchat_emit_print(handle, event_name, one, two, three, four, five, NULL);
}

export int perl6hc_emit_print_attrs_workaround(hexchat_plugin *ph,
	hexchat_event_attrs *attrs, const char *event_name,
	char *one, char *two, char *three, char *four, char *five) {
	return hexchat_emit_print_attrs(handle, attrs, event_name, one, two, three, four, five, NULL);
}

Perl6.def

EXPORTS
    hexchat_plugin_init
    hexchat_plugin_deinit
    hexchat_plugin_get_info

Raw.pm

#!perl6

unit module Plugin::Raw;

# Although writers of perl6 scripts for hexchat won't
# use this module directly, I nevertheless want it to
# be as functional and convenient as possible.  Thus,
# many methods are generated dynamically and added to
# both the main Plugin class and also a helper class.

# Also, as this file a relatively thin wrapper around
# the C functions, I'm calling it a 'raw' interface,
# and making lots of things 'our'.

# Here is the documentation for the C version of the
# hexchat API:
# http://hexchat.readthedocs.io/en/latest/plugins.html

# Very nearly every function in hexchat.h has been made
# into a method of class Plugin.  Naturally, any leading
# hexchat_ has been stripped of the method name.

# If a method name begins or ends with the name of one of
# our five helper classes, then the name of the helper
# is removed from the method name, and the method is
# added to the helper class.

# This means that users can use either Plugin.plugingui_add,
# or Plugin.add, whichever comes more naturally.

# Furthermore, due to EXPORT trickery, the user doesn't see
# class Plugin directly, but rather the symbol 'Hexchat',
# which is actually an instance of Plugin.

our enum Constants is export (
	HEXCHAT_PRI_HIGHEST => 127,
	HEXCHAT_PRI_HIGH => 64,
	HEXCHAT_PRI_NORM => 0,
	HEXCHAT_PRI_LOW => -64,
	HEXCHAT_PRI_LOWEST => -128
	
	HEXCHAT_EAT_NONE => 0,
	HEXCHAT_EAT_HEXCHAT => 1,
	HEXCHAT_EAT_PLUGIN => 2,
	HEXCHAT_EAT_ALL => 3,

	HEXCHAT_FD_READ => 1,
	HEXCHAT_FD_WRITE => 2,
	HEXCHAT_FD_EXCEPTION => 4,
	HEXCHAT_FD_NOTSOCKET => 8,
);

use NativeCall;

# Perl6 of course has it's own "List", and I don't think it would
# be a good idea to use that name 😊
our class HCList is repr('CPointer') is export { };

our class Hook is repr('CPointer') is export { };

our class Context is repr('CPointer') is export { };

our class Event_Attrs is repr('CStruct') is export {
	has time_t $server_time_utc; # 0 if not used
};

our class PluginGui is repr('CPointer') is export {};

my %augment := Set.new( HCList, Hook, Context, Event_Attrs, PluginGui );

our class Plugin is repr('CPointer') is export {
	
	my multi sub trait_mod:<is>(Method $m, :$h!) {
		trait_mod:<is>($m, :symbol("hexchat_" ~ $m.name));
		trait_mod:<is>($m, :native(Str));
	}
	
	method hook_command (
		Str $name,
		int $pri,
		&callback (CArray[Str] $word, CArray[Str] $word_eol, Pointer $user_data --> int),
		Str $help_text,
		Pointer $userdata,
		--> Hook) is h {};
	method hook_server (
		Str $name,
		int $pri,
		&callback (CArray[Str] $word, CArray[Str] $word_eol, Pointer $user_data --> int),
		Str $help_text,
		Pointer $userdata
		--> Hook) is h {};
	method hook_print (
		Str $name,
		int $pri,
		&callback (CArray[Str] $word, Pointer $user_data --> int),
		Pointer $userdata,
		--> Hook) is h {};
	method hook_timer (
		int $timeout,
		&callback (Pointer $user_data --> int),
		Pointer $userdata
		--> Hook) is h {};
	method hook_fd (
		int $fd,
		int $flags,
		&callback (int $fd, int $flags, Pointer $user_data --> int),
		Pointer $userdata
		--> Hook) is h {};
	method unhook (Hook $hook) is h {}
	method print (Str $text) is h {}
	method command (Str $text) is h {}
	method nickcmp (Str $s1, Str $s2) is h {}
	method set_context (Context $ctx --> int) is h {}
	method find_context (
		Str $servname,
		Str $channel,
		--> Context),
	method get_context (--> Context) is h {}
	method get_info (Str $id --> Str) is h {}
	method get_prefs (
		Str $name,
		Str $string is rw,
		int $integer is rw,
		--> int) is h {}
	method list_get (Str $name --> HCList) is h {}
	method list_free (HCList $xlist) is h {}
	method list_fields (Str $name --> CArray[Str]) is h {}
	method list_next (HCList $xlist --> int) is h {}
	method list_str (HCList $xlist, Str $name --> Str) is h {}
	method list_int (HCList $xlist, Str $name --> int) is h {}
	method list_ptr (HCList $xlist, Str $name --> Pointer)
		is native(Str) is symbol('hexchat_list_int') {}
	# Perhaps once, the fifth argument was something interesting;
	# In the present, in plugin.c of hexchat, it is ignored/unused.
	# Perhaps in the future, it will be usefull again.  The docs say
	# it is reserved, and NULL should be passed.
	method plugingui_add (
		Str $filename,
		Str $name,
		Str $desc,
		Str $version,
		Str $ignored,
		--> PluginGui) is h {}
	method plugingui_remove (PluginGui $handle) is h {}
	# Find a use for it, and I'll uncomment it.
	# method read_fd ( Pointer $src, Str $buf, int $len is rw --> int) is h {}
	method list_time :(
		HCList $xlist,
		Str $name,
		--> time_t) is h {}
	# This would be useful, except that it only internationalizes
	# hexchat's own messages.  If there's demand for it, I can uncomment it.
	# method gettext (Str $msgid --> Str) is h {}
	method send_modes (
		CArray[Str] $targets,
		int $ntargets,
		int $modes_per_line,
		int8 $sign,
		int8 $mode) is h {}
	# This function allocates a version of the string with color
	# and/or attributes (bold/italic/underline) removed.
	method strip (
		Str $str,
		int $len,
		int $flags => Blob) is h {}
	# Use this to free strings returned by Plugin.strip.
	method free (Blob $ptr) is h {}
	
	# Be aware, this SILENTLY truncates data over 511 bytes.
	# Also, strings are NUL terminated/truncated.
	# Also, every single time you use a pluginpref function,
	# the file will be opened, written/read, and closed.
	method pluginpref_set_str (Str $var, Str $value --> int) is h {}
	# Use Blob.allocate(512) to avoid segfault.
	method pluginpref_get_str (Str $var, Blob $dest is rw --> int) is h {}
	method pluginpref_set_int (Str $var, int $value --> int) is h {}
	method pluginpref_get_int (Str $var, int $valus is rw --> int) is h {}
	method pluginpref_delete (Str $var --> int) is h {}
	# Use Blob.allocate(4096) to avoid segfault.
	method pluginpref_list (Blob $dest --> int) is h {}
	
	method hook_server_attrs (
		Str $name,
		int $pri,
		&callback (CArray[Str] $word, CArray[Str] $word_eol,
			Event_Attrs $attrs, Pointer $user_data --> int) is h {}
		Pointer $userdata,
		--> Hook) is h {}
	
	method hook_print_attrs (
		Str $name,
		int $pri,
		&callback (CArray[Str] $word, Event_Attrs $attrs,
			Pointer $user_data --> int) is h {}
		Pointer $userdata
		--> Hook) is h {}
	
	# Find a use for these, and I'll uncomment them.
	#method event_attrs_create (--> Pointer[Event_Attrs]) is h {}
	#method event_attrs_free (Event_Attrs $attrs) is h {}

	my multi sub trait_mod:<is>(Method $m, :$w!) {
		trait_mod:<is>($m, :symbol("perl6hc_" ~ $m.name));
		trait_mod:<is>($m, :native(Str));
	}
	method emit_print_workaround (
		Str $event_name, Str, Str, Str, Str, Str --> int) is w {}
	method emit_print_attrs_workaround (
		Event_Attrs $attrs, Str $event_name,
		Str, Str, Str, Str, Str --> int) is w {}
	
	int method emit_print(Str $event, *@args --> int) {
		push @args, Str while @args < 5;
		return .emit_print_workaround $event, |@args;
	}
	
	int method emit_print_attrs(Event_Attrs $attrs, Str $event, *@args --> int) {
		push @args, Str while @args < 5;
		return .emit_print_attrs_workaround $attrs, $event, |@args;
	}
	
	method printf(Str $fmt, *@args) {
		.print: sprintf $fmt, |@args;
	}
	
	method commandf(Str $fmt, *@args) {
		.command: sprintf $fmt, |@args;
	}
	
};

# cglobal returns a proxy object.  'item' fetches it's contents,
# thus avoiding insane numbers of calls to Proxy.FETCH.
our constant Hexchat is export = item cglobal(Str, 'perl6hc_ph', Plugin);

# Here's how I generate names for the other class's methods.
# Namely, remove the class's name from the method, e.g.
# hook_server_attrs becomes Hook.server_attrs.
my %strip = %augment.keys ==> map {
	my $name = $_.lc;
	$name =~ s/hc//;
	$_ => rx/_?"$name"_?/;
};

# Our dynamic method generator:
for Plugin.^methods {
	my $name = .name;
	my $sig  = .signature;

	# First, we look for methods whose first argument, after the
	# Plugin object, is one of our classes.
	my $type = $sig.params[1].type;
	if $type and %strip{$type} -> $remove {
		(my $newname = $name) ~~ s/$remove// or die;
		$type.^add_method: $newname, method(Any:D: |args) {
			Hexchat."$name"( self, |args );
		}
	}
	
	# Now, we look for methods which *return* one of our classes.
	# These can be thought of as constructors.
	my $type = $sig.returns;
	$type = $type.of if $type ~~ Pointer;
	if %strip{$type} -> $remove {
		(my $newname = $name) ~~ s/$remove// or die;
		$type.^add_method: $newname, method(Any:U: |@args --> Any:D) {
			Hexchat."$name"( |@args );
		}
	}
	
	# TODO: All three of the above thingies create wrapper methods
	# whose signatures are not usefully introspectable.  Generate
	# using EVAL, perhaps?
}

$_.^compose() for keys %augment;

# This will only be reached if everything above worked.
$*OUT = $*ERR = class :: {
	method print(*@_) { Hexchat.print(join '', @_) }
	method say(*@_) { Hexchat.print(join '', map *.gist, @_) }
	method flush { }
	method nl-out { "\n" }
	method close { }
};

1;

Simple.pm

#!perl

unit module Hexchat::Simple;

use Hexchat::Raw;

# Due to EXPORT trickery, each Script object is symbol
# named Hexchat in the end user's symbol table.

our %scripts := SetHash.new;

use NativeCall;

my sub ca2a(CArray[Str]:D $carray --> Array[Str]) {
	Array[Str].new(gather for ^Inf {
		if $carray[$_] -> $_ { .take } else { last }
	})
}

class Script {
	has $.gui;
	has $.hooks;
	has $.deinit;
	
	method register(Str $name, Str() $version, Str $description?, Callable $deinit?) {
		my $gui = PluginGui.add(
			$file, $name, $description, $version, Str
		);
		my $hooks = SetHash.new;
		my $new = Script.new(:$gui, :$hooks, :$deinit);
		%scripts{$new} = True;
		$new;
	}
	
	method find-script(Script:U --> Script:D) {
		for ^Inf {
			my $c = callframe($_) or last;
			my $h = $c.my.<Hexchat> or next;
			return $h if $h ~~ Script;
		}
		fail "Cannot identify current script.";
	}
	
	method list_fields($name) {
		ca2a( Hexchat.list_fields($name) );
	}
	
	method list_get(Str $name) {
		my $hclist = Hexchat.list_get($listname) where leave { .free };
		unless( $hclist ) {
			my @lists = .list_fields("lists");
			fail "$listname is not a valid list name, use one of @lists";
		}
		return unless $hclist.next;
		state %methods;
		my @getters := (%methods{$listname} //= []);
		unless @getters {
			my constant %to_method = map { .substr(0,1) => $_ },
				qw(ptr int str time);
			for .list_fields($listname) {
				push @getters, .substr: 1;
				push @getters, %to_method{.substr: 0, 1} // die;
			}
		}
		# The 'eager' is so we fully use $hclist before .free()ing it.
		eager gather do {
			repeat {
				my %result;
				for @getters -> $key, $method {
					%result{$key} = $hclist."$method"($key);
				}
				take %result;
			} while $hclist.next;
		}
	}
	
	method strip(Str $string, Int $flags) {
		my $buf = Hexchat.strip(String, -1, $flags) or fail;
		my $copy = $buf.decode;
		Hexchat.free( $buf );
		$copy;
	}
	
	method get_prefs(Str $name) {
		my Str $str;
		my Int $int;
		given Hexchat.get_prefs($name, $str, $int) {
			return $str when 1;
			return $int when 2;
			return so $int when 3;
			fail "$name is not a valid hexchat pref to get";
		}
	}
	
	method set_pref(Str $name, Str $value) {
		.command: qq!SET -quiet $name "$value"!;
	}
	
	multi method emit_print(%attrs, Str $event, Str *@args) {
		my $a = Event_Attrs.new: |%attrs;
		Hexchat.emit_print_attrs: $a, $event, |@args or fail;
	}
	
	multi method emit_print(Str $event, %attrs, Str *@args) {
		.emit_print(%attrs, $event, |@args)
	}
	
	multi method emit_print(Str $event, Str *@args) {
		Hexchat.emit_print: $event, |@args or fail;
	}
	
	method send_modes (
		@targets,
		int $modes_per_line,
		int8 $sign,
		int8 $mode
	) {
		CArray[Str] $targets .= new;
		$targets.push: $_ for @targets;
		Hexchat.send_modes: $targets, +@targets, $modes_perl_line, $sign, $mode;
	}
	
	method unload(Script:D) {
		my $goodbye = $!deinit;
		$!gui.remove if $!gui;
		$!gui = Any;
		$!deinit = Any;
		%scripts{self}:delete;
		.unhook for $!hooks.keys;
		try $goodbye() if $goodbye;
	}
	
	method is-unloaded { not $!gui }
	
	method unload-all {
		.unload for %scripts.values;
	}
	
	# Allow Hexchat::EAT_ALL, etc.
	enum EAT (map -> $k is copy, $v {
		$name ~~ s[HEXCHAT_][] or die;
		$name => $value;
	}, grep *.key ~~ /_EAT_/, Hexchat::Raw::Constants.enum.kv);
	
	enum PRI (map -> $k is copy, $v {
		$name ~~ s[HEXCHAT_][] or die;
		$name => $value;
	}, grep *.key ~~ /_PRI_/, Hexchat::Raw::Constants.enum.kv);
	
	enum FD (map -> $k is copy, $v {
		$name ~~ s[HEXCHAT_][] or die;
		$name => $value;
	}, grep *.key ~~ /_FD_/, Hexchat::Raw::Constants.enum.kv);
	
	enum REPETITION (qw,REMOVE KEEP,);
	method REMOVE(-->REMOVE) {};
	method KEEP(-->KEEP) {};
	

}

for Hexchat.^methods -> {
	my $skip = once { Hook|Context|PluginGui|HCList|Blob };
	my $name = .name;
	my $sig = .signature;
	next if $name.starts-with("pluginpref"|"event_attrs");
	next if $name.ends-with: "workaround";
	next if $sig.returns === $skip;
	next if $sig.params.first: *.type === $skip;
	next if Script.^find_method: $name;
	
	# Because I've moved so much into helper classes,
	# very few raw hexchat methods will added to Script
	# in this loop.  At the time of this writing, they are:
	#
	# print, command, nickcmp, get_info, printf, commandf.
	#
	# In a future version of hexchat, that list might expand...
	# Alternatively, I might just put them into class Script
	# directly, and remove this loop.  I'd rather not, since
	# this way, at least a few methods added in Raw.pm might
	# magically become methods in Script.
	
	Script.^add_method: $name, method (Script: |args) {
		return Hexchat."$name"(|args);
	}
}

# Also, allow Hexchat.EAT_ALL, etc.
for qw(EAT PRI FD) -> $enum {
	for Script::($enum).pick(*) -> $e {
		Script.^add_method: $e.Str, method(Script:) { $e };
	}
}
Script.^compose();


# While I'm sure .set, .get, and .find should be obvious,

# The usage of .dwim is as follows:
# my $c = Context.find(:channel("freenode"));
# my $nick = $c.dwim: {
#    .print: "foo";
#    .get_info: "nick";
# }
# first prints "foo" in the freenode tab,
# then fetches your nickname on the freenode server,
# then resets the context to whatever it originally had been,
# then assigns the fetched nickname to the variable $nick.
#
# Neat, huh?

# FALLBACK is not entirely unlike perl5's AUTOLOAD.
# Because of it, I could have written the above as:
# $c.print: "foo";
# my $nick = $c.get_info("nick");
# Which is almost the same, but does extra context switching.

class ScriptContext {
	has Context $!c;
	method set { $!c.set or fail; self }
	method get { ScriptContext.new( c => Context.get ) }
	
	# In the C API, it's server then channel.
	# In the perl5 API, it's channel then server.
	# In the python API, it's named arguments.
	#
	# Named arguments can be passed in any order, so that's
	# what the perl6 API will use.
	
	method find( :$server_name, :$channel ) {
		ScriptContext.new: c => Context.find: $server_name, $channel;
	}
	
	method dwim(&code) {
		my $current = Context.get where leave { .set };
		$!c.set;
		code() with Script.find-script;
	}
	
	method FALLBACK($name, |args) {
		.dwim: { ."$name"(|args) };
	}
}

# It's harmless to call .unhook more than once on
# a ScriptHook object, because it will only call
# hexchat_hook_unhook once.
class ScriptHook {
	has Hook $!hook;
	has Script $!script = Script.find-script;
	
	method unhook {
		return unless $!hook;
		$!script.hooks{self}:delete;
		$!hook.un;
		$!hook = Any;
	}
	
	method print (
		Str $name, int $pri,
		&callback (Str @word, Any $user_data --> Hexchat::EAT:D),
		Any $user_data?,
		--> ScriptHook:D
	) {
		my sub wrapped(CArray[Str] $word, Pointer --> int) {
			callback ca2a( $word ), $user_data'
		};
		.new: :hook => Hook.print: $name, $pri, &wrapped, Pointer;
	}
	
	method timer (
		int $milliseconds,
		&callback (Any $user_data --> Hexchat::REPETITION:D),
		Any $user_data?,
		--> ScriptHook:D
	) {
		my sub wrapped(CArray[Str] $word, Pointer --> int) {
			callback $user_data;
		};
		.new: hook => Hook.timer: $milliseconds, &wrapped, Pointer;
	}

	method fd (
		int $fd, int $flags,
		&callback (int $fd, int $flags, Any $user_data --> Hexchat::REPETITION:D),
		Any $user_data?,
		--> ScriptHook:D
	) {
		my sub wrapped (int $fd, int $flags, Pointer --> int) {
			callback $fd, $flags, $user_data;
		};
		.new: hook => Hook.fd: $fd, $flags, &wrapped, Pointer;
	}

	my sub ea2h(Event_Attrs $ea --> Associative) {
		Hash.new: map { $_ => $attrs."$_"() },
			once { map *.name, Event_Attrs.^methods };
	}
	
	method server_attrs (
		Str $name,
		int $pri,
		&callback (Str @word, Str @word_eol,
			%attrs, Any $user_data --> Hexchat::EAT:D),
		Any $user_data?,
		--> ScriptHook:D
	) {
		my sub wrapped (
			CArray[Str] $word, CArray[Str] $word_eol, Event_Attrs $attrs, Pointer --> int) {
			callback ca2a( $word ), ca2a( $word_eol ), ea2h( $attrs ), $user_data;
		};
		.new: hook => Hook.server_attrs: $name, $pri, &wrapped, Pointer;
	}
	
	method print_attrs (
		Str $name, int $pri,
		&callback (Str @word, %attrs, $user_data --> Hexchat::EAT:D),
		Any $user_data?,
		--> ScriptHook:D
	) {
		my sub wrapped(CArray[Str] $word, Event_Attrs $attrs, Pointer $user_data --> int) {
			callback ca2a( $word ), ea2h( $attrs ), $user_data;
		}
		.new: hook => Hook.print_attrs: $name, $pri, &wrapped, Pointer;
	}
	
}

for qw,command server, -> $name {
	ScriptHook.^add_method: $name, method (
		Str $name, int $pri,
		&callback (Str @word, Str @word_eol, Any $user_data --> Hexchat::EAT:D),
		Str $help_text?, Any $user_data?,
		--> ScriptHook:D) {
		my sub wrapped(CArray[Str] $word, CArray[Str] $word_eol, Pointer --> int) {
			callback ca2a( $word ), ca2a( $word_eol ), $user_data;
		};
		.new: hook => Hook."$name"( $name, $pri, &wrapped, $help_text, Pointer );
	};
}

ScriptHook.^compose;

class PluginPref {
	# I threw these three functions into their own class
	# because it seemed to make sense.
	
	# Be aware, hexchat SILENTLY truncates data over 511 bytes.
	# Also, strings are NUL terminated/truncated.
	# Also, every single time you use a pluginpref function,
	# the file will be opened, written, read (or both!), and closed.
	
	# Lookups are done in a case-insensitive manner,
	# using a string search algorithm which takes O(N*M),
	# where N is the length of the key, and M is number of
	# stored items.
	
	method list {
		Blob $dest = Blob.allocate(4096, 0);
		Hexchat.pluginpref_list( $dest ) or fail;
		Str $str = $dest.decode;
		$str .= substr: 0, $_ when $str.index: "\0";
		$str.comb: ',';
	}
	
	method get($name) {
		Blob $dest = Blob.allocate(512, 0);
		Hexchat.pluginpref_get_str($name, $dest) or fail;
		Str $s = $dest.decode;
		$s .= substr: 0, $_ when $s.index: "\0";
		try { return $s.Numeric };
		return $s;
	}
	
	method set($name, Str() $value) {
		Hexchat.pluginpref_set_str( $name, $value ) or fail;
	}
	
	method delete($name) {
		Hexchat.pluginpref_delete( $name ) or fail;
	}
	
}


sub myquote($_) {
	defined(.index: " ") ?? qq("$_") !! $_;
}

sub cmd(*@args) {
	Hexchat.command: join " ", map &myquote, @args;
}

# See:
# http://hexchat.readthedocs.io/en/latest/plugins.html#controlling-the-gui

class GUI {
	method FALLBACK($name, |args) {
		cmd "GUI", $name, |args;
	}
}

class Menu {
	enum Mod (SHIFT => 1, CONTROL => 4, ALT => 8);
	method mkshortcut( $letter, |@modifiers ) {
		$letter.ord ~ "," ~ [+|] Mod::{@modifiers};
	}
	method FALLBACK($name, $path, $command?, $deselect_command?, *%pairs is copy ) {
		my @command = "MENU";
		for( qw,e i k m p r x , ) -> $key {
			push @command, "-" ~ $key ~ $_ when %pairs{$key}:delete;
		}
		fail "Unexpected options %pairs" if %pairs.elems;
		.defined and push @command, $_
			for $name, $path, $command, $deselect_command;
		cmd |@command;
	}
}

class Tray {
	
	method flash_icon($timeout, $file1, $file2?) {
		cmd "TRAY", "-f", $timeout, $file1, ($file2 ?? $file2 !! slip);
	}
	method set_icon($filename) {
		cmd "TRAY", "-f", $filename;
	}
	method message   { Hexchat.command: "TRAY -i 2" }
	method highlight { Hexchat.command: "TRAY -i 5" }
	method private   { Hexchat.command: "TRAY -i 8" }
	method file      { Hexchat.command: "TRAY -i 11" }
	method tooltip($text) { cmd "TRAY", "-t", $text }
	# Hexchat is wierdly incosnstent about which things need quotes.
	method balloon($title, $text) { Hexchat.command: "TRAY -b {myquote $title} $text" }
}

sub EXPORT(|args) {
	my $script = Script.register(|args);
	return {
		'Hexchat' => $script,
		'Hook' => ScriptHook,
		'Context' => ScriptContext,
		'PluginPref' => PluginPref,
		'GUI' => GUI,
		'Menu' => Menu,
		'Tray' => Tray,
	};
}

TODO.txt

Todo:

Successfully compile the plugin and load it into hexchat.

Write a plugin manager, so individual scripts can be loaded and unloaded.

Unloading a script means unhooking all of it's hooks, and removing it's
PluginGui from the display, etc.

Hide CArray stuff.

Hide anything which requires the user explicitly allocate/free stuff.

User callbacks should be forced to return an enum, instead of an int.
This will prevent them from accidentally falling off the end of the
function without an explicit return.

Write some docs, remind people that hexchat is single threaded, and
it's not safe to call methods on the Hexchat object from outside of
the main thread.  Use a hexchat timer hook to occasionally poll a
Promise or somesuch.