mapping.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) 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