1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
 2 
 3 ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz.  All rights reserved.
 4 
 5 ;;; Redistribution and use in source and binary forms, with or without
 6 ;;; modification, are permitted provided that the following conditions
 7 ;;; are met:
 8 
 9 ;;;   * Redistributions of source code must retain the above copyright
10 ;;;     notice, this list of conditions and the following disclaimer.
11 
12 ;;;   * Redistributions in binary form must reproduce the above
13 ;;;     copyright notice, this list of conditions and the following
14 ;;;     disclaimer in the documentation and/or other materials
15 ;;;     provided with the distribution.
16 
17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 
29 (in-package :url-rewrite)
30 
31 (defvar *url-rewrite-tags*
32   '(("a" . "href")
33     ("area" . "href")
34     ("frame" . "src")
35     ("img" . "src")
36     ("input" . "src")
37     ("form" . "action")
38     ("iframe" . "src"))
39   "The tag/attribute combinations where URL-rewriting should happen.")
40 
41 (defvar *url-rewrite-fill-tags*
42   '(("form" . "action"))
43   "The tag/attribute combinations where URL-rewriting should
44 optionally add an attribute.")
45 
46 (defvar *find-string-hash*
47   (make-hash-table :test #'equal)
48   "Hash tables used internally by READ-UNTIL to cache offset arrays.")
49 
50 ;; stuff for Nikodemus Siivola's HYPERDOC
51 ;; see <http://common-lisp.net/project/hyperdoc/>
52 ;; and <http://www.cliki.net/hyperdoc>
53 
54 (defvar *hyperdoc-base-uri* "http://weitz.de/url-rewrite/")
55 
56 (let ((exported-symbols-alist
57        (loop for symbol being the external-symbols of :url-rewrite
58              collect (cons symbol
59                            (concatenate 'string
60                                         "#"
61                                         (string-downcase symbol))))))
62   (defun hyperdoc-lookup (symbol type)
63     (declare (ignore type))
64     (cdr (assoc symbol
65                 exported-symbols-alist
66                 :test #'eq))))