mapping.lisp - clic - Clic is an command line interactive client for gopher wri… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
mapping.lisp (3180B) | |
--- | |
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 1… | |
2 ;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.3 2008/05/… | |
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-CO… | |
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) ,valu… | |
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 |