mapping.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
HTML git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
DIR Log
DIR Files
DIR Refs
DIR Tags
DIR README
DIR LICENSE
---
mapping.lisp (3180B)
---
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
2 ;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.3 2008/05/25 19:07:53 edi Exp $
3
4 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.
5
6 ;;; Redistribution and use in source and binary forms, with or without
7 ;;; modification, are permitted provided that the following conditions
8 ;;; are met:
9
10 ;;; * Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
12
13 ;;; * Redistributions in binary form must reproduce the above
14 ;;; copyright notice, this list of conditions and the following
15 ;;; disclaimer in the documentation and/or other materials
16 ;;; provided with the distribution.
17
18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30 (in-package :flexi-streams)
31
32 (deftype octet ()
33 "A shortcut for \(UNSIGNED-BYTE 8)."
34 '(unsigned-byte 8))
35
36 (deftype char* ()
37 "Convenience shortcut to paper over the difference between LispWorks
38 and the other Lisps."
39 #+:lispworks 'lw:simple-char
40 #-:lispworks 'character)
41
42 (deftype string* ()
43 "Convenience shortcut to paper over the difference between LispWorks
44 and the other Lisps."
45 #+:lispworks 'lw:text-string
46 #-:lispworks 'string)
47
48 (deftype char-code-integer ()
49 "The subtype of integers which can be returned by the function CHAR-CODE."
50 #-:cmu '(integer 0 #.(1- char-code-limit))
51 #+:cmu '(integer 0 65533))
52
53 (deftype code-point ()
54 "The subtype of integers that's just big enough to hold all Unicode
55 codepoints.
56
57 See for example <http://unicode.org/glossary/#C>."
58 '(mod #x110000))
59
60 (defmacro defconstant (name value &optional doc)
61 "Make sure VALUE is evaluated only once \(to appease SBCL)."
62 `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
63 ,@(when doc (list doc))))
64
65 (defun invert-table (table)
66 "`Inverts' an array which maps octets to character codes to a hash
67 table which maps character codes to octets."
68 (let ((hash (make-hash-table)))
69 (loop for octet from 0
70 for char-code across table
71 unless (= char-code 65533)
72 do (setf (gethash char-code hash) octet))
73 hash))
74
75 (defun make-decoding-table (list)
76 "Creates and returns an array which contains the elements in the
77 list LIST and has an element type that's suitable for character
78 codes."
79 (make-array (length list)
80 :element-type 'char-code-integer
81