src/scripting/guile/hooks.c

   1 /* Guile scripting hooks */
   2
   3 #ifdef HAVE_CONFIG_H
   4 #include "config.h"
   5 #endif
   6
   7 #include <libguile.h>
   8
   9 #include "elinks.h"
  10
  11 #include "cache/cache.h"
  12 #include "main/event.h"
  13 #include "protocol/uri.h"
  14 #include "scripting/guile/hooks.h"
  15 #include "session/session.h"
  16 #include "util/string.h"
  17
  18
  19 static SCM
  20 internal_module(void)
  21 {
  22         /* XXX: should use internal_module from core.c instead of referring to
  23          * the module by name, once I figure out how... --pw */
  24         return scm_c_resolve_module("elinks internal");
  25 }
  26
  27
  28 /* We need to catch and handle errors because, otherwise, Guile will kill us.
  29  * Unfortunately, I do not know Guile, but this seems to work... -- Miciah */
  30 static SCM
  31 error_handler(void *data, SCM tag, SCM throw_args)
  32 {
  33         return SCM_BOOL_F;
  34 }
  35
  36 static SCM
  37 get_guile_hook_do(void *data)
  38 {
  39         unsigned char *hook = data;
  40
  41         return scm_c_module_lookup(internal_module(), hook);
  42 }
  43
  44 static SCM
  45 get_guile_hook(unsigned char *hook)
  46 {
  47         return scm_internal_catch(SCM_BOOL_T, get_guile_hook_do, hook,
  48                                   error_handler, NULL);
  49 }
  50
  51
  52 /* The events that will trigger the functions below and what they are expected
  53  * to do is explained in doc/events.txt */
  54
  55 static enum evhook_status
  56 script_hook_goto_url(va_list ap, void *data)
  57 {
  58         unsigned char **url = va_arg(ap, unsigned char **);
  59         struct session *ses = va_arg(ap, struct session *);
  60         SCM proc;
  61         SCM x;
  62
  63         evhook_use_params(url && ses);
  64
  65         if (*url == NULL || !*url[0]) return EVENT_HOOK_STATUS_NEXT;
  66
  67         proc = get_guile_hook("%goto-url-hook");
  68         if (SCM_FALSEP(proc)) return EVENT_HOOK_STATUS_NEXT;
  69
  70         x = scm_call_1(SCM_VARIABLE_REF(proc), scm_makfrom0str(*url));
  71
  72         if (SCM_STRINGP(x)) {
  73                 unsigned char *new_url;
  74
  75                 new_url = stracpy(SCM_STRING_UCHARS(x));
  76                 if (new_url) {
  77                         mem_free_set(url, new_url);
  78                 }
  79         } else {
  80                 (*url)[0] = 0;
  81         }
  82
  83         return EVENT_HOOK_STATUS_NEXT;
  84 }
  85
  86 static enum evhook_status
  87 script_hook_follow_url(va_list ap, void *data)
  88 {
  89         unsigned char **url = va_arg(ap, unsigned char **);
  90         struct session *ses = va_arg(ap, struct session *);
  91         SCM proc;
  92         SCM x;
  93
  94         evhook_use_params(url && ses);
  95
  96         if (*url == NULL || !*url[0]) return EVENT_HOOK_STATUS_NEXT;
  97
  98         proc = get_guile_hook("%follow-url-hook");
  99         if (SCM_FALSEP(proc)) return EVENT_HOOK_STATUS_NEXT;
 100
 101         x = scm_call_1(SCM_VARIABLE_REF(proc), scm_makfrom0str(*url));
 102
 103         if (SCM_STRINGP(x)) {
 104                 unsigned char *new_url;
 105
 106                 new_url = memacpy(SCM_STRING_UCHARS(x),
 107                                   SCM_STRING_LENGTH(x) + 1);
 108                 if (new_url) {
 109                         mem_free_set(url, new_url);
 110                 }
 111         } else {
 112                 (*url)[0] = 0;
 113         }
 114
 115         return EVENT_HOOK_STATUS_NEXT;
 116 }
 117
 118 static enum evhook_status
 119 script_hook_pre_format_html(va_list ap, void *data)
 120 {
 121         struct session *ses = va_arg(ap, struct session *);
 122         struct cache_entry *cached = va_arg(ap, struct cache_entry *);
 123         struct fragment *fragment = get_cache_fragment(cached);
 124         unsigned char *url = struri(cached->uri);
 125         int len;
 126         SCM proc;
 127         SCM x;
 128
 129         evhook_use_params(ses && cached);
 130
 131         if (!cached->length || !*fragment->data) return EVENT_HOOK_STATUS_NEXT;
 132
 133         proc = get_guile_hook("%pre-format-html-hook");
 134         if (SCM_FALSEP(proc)) return EVENT_HOOK_STATUS_NEXT;
 135
 136         x = scm_call_2(SCM_VARIABLE_REF(proc), scm_makfrom0str(url),
 137                        scm_mem2string(fragment->data, fragment->length));
 138
 139         if (!SCM_STRINGP(x)) return EVENT_HOOK_STATUS_NEXT;
 140
 141         len = SCM_STRING_LENGTH(x);
 142         add_fragment(cached, 0, SCM_STRING_UCHARS(x), len);
 143         normalize_cache_entry(cached, len);
 144
 145         return EVENT_HOOK_STATUS_NEXT;
 146 }
 147
 148 /* The Guile function can return:
 149  *  - "PROXY:PORT" to use the specified proxy
 150  *  - ""           to not use any proxy
 151  *  - nil          to use the default proxies */
 152 static enum evhook_status
 153 script_hook_get_proxy(va_list ap, void *data)
 154 {
 155         unsigned char **retval = va_arg(ap, unsigned char **);
 156         unsigned char *url = va_arg(ap, unsigned char *);
 157         SCM proc = get_guile_hook("%get-proxy-hook");
 158         SCM x;
 159
 160         if (SCM_FALSEP(proc)) return EVENT_HOOK_STATUS_NEXT;
 161
 162         x = scm_call_1(SCM_VARIABLE_REF(proc), scm_makfrom0str(url));
 163
 164         evhook_use_params(retval && url);
 165
 166         if (SCM_STRINGP(x)) {
 167                 mem_free_set(retval, memacpy(SCM_STRING_UCHARS(x), SCM_STRING_LENGTH(x)+1));
 168         } else if (SCM_NULLP(x)) {
 169                 mem_free_set(retval, NULL);
 170         }
 171
 172         return EVENT_HOOK_STATUS_NEXT;
 173 }
 174
 175 static enum evhook_status
 176 script_hook_quit(va_list ap, void *data)
 177 {
 178         SCM proc = get_guile_hook("%quit-hook");
 179
 180         if (SCM_FALSEP(proc)) return EVENT_HOOK_STATUS_NEXT;
 181
 182         scm_call_0(SCM_VARIABLE_REF(proc));
 183
 184         return EVENT_HOOK_STATUS_NEXT;
 185 }
 186
 187 struct event_hook_info guile_scripting_hooks[] = {
 188         { "goto-url", 0, script_hook_goto_url, NULL },
 189         { "follow-url", 0, script_hook_follow_url, NULL },
 190         { "pre-format-html", 0, script_hook_pre_format_html, NULL },
 191         { "get-proxy", 0, script_hook_get_proxy, NULL },
 192         { "quit", 0, script_hook_quit, NULL },
 193         NULL_EVENT_HOOK_INFO,
 194 };