contrib/guile/internal-hooks.scm

   1 ;;; Bare interface to C code
   2
   3
   4 (define-module (elinks internal)
   5   :export (goto-url-hooks
   6            follow-url-hooks
   7            pre-format-html-hooks
   8            get-proxy-hooks
   9            quit-hooks))
  10
  11
  12 ;;; GOTO-URL-HOOKS: Each hook is called in turn with a single argument
  13 ;;; (a URL string).  Each may return one of:
  14 ;;;
  15 ;;;    a string    to visit the returned url
  16 ;;;    ()          to go nowhere
  17 ;;;    #f          to continue with the next hook
  18 ;;;
  19 ;;; If no hooks return a string or empty list, the default action is
  20 ;;; to visit the original URL passed.
  21
  22 (define goto-url-hooks (make-hook 1))
  23
  24 (define (%goto-url-hook url)
  25   (%call-hooks-until-truish goto-url-hooks
  26                             (lambda (h) (h url))
  27                             url))
  28
  29
  30 ;;; FOLLOW-URL-HOOKS: Each hook is called in turn with a single
  31 ;;; argument (a URL string).  Each may return one of:
  32 ;;;
  33 ;;;    a string    to visit the returned url
  34 ;;;    ()          to go nowhere
  35 ;;;    #f          to continue with the next hook
  36 ;;;
  37 ;;; If no hooks return a string or empty list, the default action is
  38 ;;; to visit the original URL passed.
  39
  40 (define follow-url-hooks (make-hook 1))
  41
  42 (define (%follow-url-hook url)
  43   (%call-hooks-until-truish follow-url-hooks
  44                             (lambda (h) (h url))
  45                             url))
  46
  47
  48 ;;; PRE-FORMAT-HTML-HOOKS:
  49
  50 (define pre-format-html-hooks (make-hook 2))
  51 (define (%pre-format-html-hook url html)
  52   (%call-hooks-until-truish pre-format-html-hooks
  53                             (lambda (h) (h url html))
  54                             #f))
  55
  56
  57 ;;; GET-PROXY-HOOKS:
  58 (define get-proxy-hooks (make-hook 1))
  59 (define (%get-proxy-hook url)
  60   (%call-hooks-until-truish get-proxy-hooks
  61                             (lambda (h) (h url))
  62                             #f))
  63
  64
  65 ;;; QUIT-HOOKS: ...
  66
  67 (define quit-hooks (make-hook))
  68
  69 (define (%quit-hook)
  70   (run-hook quit-hooks))
  71
  72
  73 ;;; Helper: calls hooks one at a time until one of them returns
  74 ;;; non-#f.
  75 (define (%call-hooks-until-truish hooks caller default)
  76   (let lp ((hs (hook->list hooks)))
  77     (if (null? hs)
  78         default
  79         (or (caller (car hs))
  80             (lp (cdr hs))))))