← Back to branch summary

~ubuntu-branches/ubuntu/hoary/gnucash/hoary

« back to all changes in this revision

Viewing changes to lib/guile-www/main.scm

  • Committer: Bazaar Package Importer
  • Author(s): James A. Treacy
  • Date: 2002-03-16 14:14:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020316141459-wtkyyrpfovryhl1s
Tags: upstream-1.6.6
Import upstream version 1.6.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/guile-www/main.scm
 
1
;;;; www/main.scm: general WWW navigation aids.
 
2
 
 
3
(define-module (www main)
 
4
  :use-module (www http)
 
5
  :use-module (www url))
 
6
 
 
7
;;;;    Copyright (C) 1997 Free Software Foundation, Inc.
 
8
;;;; 
 
9
;;;; This program is free software; you can redistribute it and/or modify
 
10
;;;; it under the terms of the GNU General Public License as published by
 
11
;;;; the Free Software Foundation; either version 2, or (at your option)
 
12
;;;; any later version.
 
13
;;;; 
 
14
;;;; This program is distributed in the hope that it will be useful,
 
15
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
;;;; GNU General Public License for more details.
 
18
;;;; 
 
19
;;;; You should have received a copy of the GNU General Public License
 
20
;;;; along with this software; see the file COPYING.  If not, write to
 
21
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 
22
;;;; Boston, MA 02111-1307 USA
 
23
;;;; 
 
24
 
 
25
(define dispatch-table
 
26
  (acons 'http http:get '()))
 
27
 
 
28
;;; (www:get URL)
 
29
;;;   parse a URL into portions, open a connection, and retrieve
 
30
;;;   selected document
 
31
 
 
32
(define-public (www:set-protocol-handler! proto handler)
 
33
  (set! dispatch-table
 
34
        (assq-set! dispatch-table proto handler)))
 
35
 
 
36
(define-public (www:get url-str)
 
37
  (let ((url (url:parse url-str)))
 
38
    ;; get handler for this protocol
 
39
    (case (url:scheme url)
 
40
      ((http) (let ((msg (http:get url)))
 
41
                  (http:message-body msg)))
 
42
      (else
 
43
       (let ((handle (assq-ref dispatch-table (url:scheme url))))
 
44
         (if handle
 
45
             (handle (url:host url)
 
46
                     (url:port url)
 
47
                     (url:path url))
 
48
             (error "unknown URL scheme" (url:scheme url))))))))
 
49