3rdparties/software/flexi-streams-20200427-git/specials.lisp (7168 bytes)
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- 2 ;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.33 2008/05/25 01:40:54 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 (defvar *standard-optimize-settings* 33 '(optimize 34 speed 35 (space 0) 36 (debug 1) 37 (compilation-speed 0)) 38 "The standard optimize settings used by most declaration expressions.") 39 40 (defvar *fixnum-optimize-settings* 41 '(optimize 42 speed 43 (space 0) 44 (debug 1) 45 (compilation-speed 0) 46 #+:lispworks (hcl:fixnum-safety 0)) 47 "Like *STANDARD-OPTIMIZE-SETTINGS*, but \(on LispWorks) with all 48 arithmetic being fixnum arithmetic.") 49 50 (defconstant +lf+ (char-code #\Linefeed)) 51 52 (defconstant +cr+ (char-code #\Return)) 53 54 (defvar *current-unreader* nil 55 "A unary function which might be called to `unread' a character 56 \(i.e. the sequence of octets it represents). 57 58 Used by the function OCTETS-TO-CHAR-CODE and must always be bound to a 59 suitable functional object when this function is called.") 60 61 (defvar +name-map+ 62 '((:utf8 . :utf-8) 63 (:utf16 . :utf-16) 64 (:ucs2 . :utf-16) 65 (:ucs-2 . :utf-16) 66 (:unicode . :utf-16) 67 (:utf32 . :utf-32) 68 (:ucs4 . :utf-32) 69 (:ucs-4 . :utf-32) 70 (:ascii . :us-ascii) 71 (:koi8r . :koi8-r) 72 (:latin-1 . :iso-8859-1) 73 (:latin1 . :iso-8859-1) 74 (:latin-2 . :iso-8859-2) 75 (:latin2 . :iso-8859-2) 76 (:latin-3 . :iso-8859-3) 77 (:latin3 . :iso-8859-3) 78 (:latin-4 . :iso-8859-4) 79 (:latin4 . :iso-8859-4) 80 (:cyrillic . :iso-8859-5) 81 (:arabic . :iso-8859-6) 82 (:greek . :iso-8859-7) 83 (:hebrew . :iso-8859-8) 84 (:latin-5 . :iso-8859-9) 85 (:latin5 . :iso-8859-9) 86 (:latin-6 . :iso-8859-10) 87 (:latin6 . :iso-8859-10) 88 (:thai . :iso-8859-11) 89 (:latin-7 . :iso-8859-13) 90 (:latin7 . :iso-8859-13) 91 (:latin-8 . :iso-8859-14) 92 (:latin8 . :iso-8859-14) 93 (:latin-9 . :iso-8859-15) 94 (:latin9 . :iso-8859-15) 95 (:latin-0 . :iso-8859-15) 96 (:latin0 . :iso-8859-15) 97 (:latin-10 . :iso-8859-16) 98 (:latin10 . :iso-8859-16) 99 (:codepage . :code-page) 100 #+(and :lispworks :win32) 101 (win32:code-page . :code-page)) 102 "An alist which mapes alternative names for external formats to 103 their canonical counterparts.") 104 105 (defvar +shortcut-map+ 106 '((:ucs-2le . (:ucs-2 :little-endian t)) 107 (:ucs-2be . (:ucs-2 :little-endian nil)) 108 (:ucs-4le . (:ucs-4 :little-endian t)) 109 (:ucs-4be . (:ucs-4 :little-endian nil)) 110 (:utf-16le . (:utf-16 :little-endian t)) 111 (:utf-16be . (:utf-16 :little-endian nil)) 112 (:utf-32le . (:utf-32 :little-endian t)) 113 (:utf-32be . (:utf-32 :little-endian nil)) 114 (:ibm437 . (:code-page :id 437)) 115 (:ibm850 . (:code-page :id 850)) 116 (:ibm852 . (:code-page :id 852)) 117 (:ibm855 . (:code-page :id 855)) 118 (:ibm857 . (:code-page :id 857)) 119 (:ibm860 . (:code-page :id 860)) 120 (:ibm861 . (:code-page :id 861)) 121 (:ibm862 . (:code-page :id 862)) 122 (:ibm863 . (:code-page :id 863)) 123 (:ibm864 . (:code-page :id 864)) 124 (:ibm865 . (:code-page :id 865)) 125 (:ibm866 . (:code-page :id 866)) 126 (:ibm869 . (:code-page :id 869)) 127 (:windows-1250 . (:code-page :id 1250)) 128 (:windows-1251 . (:code-page :id 1251)) 129 (:windows-1252 . (:code-page :id 1252)) 130 (:windows-1253 . (:code-page :id 1253)) 131 (:windows-1254 . (:code-page :id 1254)) 132 (:windows-1255 . (:code-page :id 1255)) 133 (:windows-1256 . (:code-page :id 1256)) 134 (:windows-1257 . (:code-page :id 1257)) 135 (:windows-1258 . (:code-page :id 1258))) 136 "An alist which maps shortcuts for external formats to their 137 long forms.") 138 139 (defvar *default-eol-style* 140 #+:win32 :crlf 141 #-:win32 :lf 142 "The end-of-line style used by external formats if none is 143 explicitly given. Depends on the OS the code is compiled on.") 144 145 (defvar *default-little-endian* 146 #+:little-endian t 147 #-:little-endian nil 148 "Whether external formats are little-endian by default 149 \(i.e. unless explicitly specified). Depends on the platform 150 the code is compiled on.") 151 152 (defvar *substitution-char* nil 153 "If this value is not NIL, it should be a character which is used 154 \(as if by a USE-VALUE restart) whenever during reading an error of 155 type FLEXI-STREAM-ENCODING-ERROR would have been signalled otherwise.") 156 157 (defconstant +iso-8859-hashes+ 158 (loop for (name . table) in +iso-8859-tables+ 159 collect (cons name (invert-table table))) 160 "An alist which maps names for ISO-8859 encodings to hash 161 tables which map character codes to the corresponding octets.") 162 163 (defconstant +code-page-hashes+ 164 (loop for (id . table) in +code-page-tables+ 165 collect (cons id (invert-table table))) 166 "An alist which maps IDs of Windows code pages to hash tables 167 which map character codes to the corresponding octets.") 168 169 (defconstant +ascii-hash+ (invert-table +ascii-table+) 170 "A hash table which maps US-ASCII character codes to the 171 corresponding octets.") 172 173 (defconstant +koi8-r-hash+ (invert-table +koi8-r-table+) 174 "A hash table which maps KOI8-R character codes to the 175 corresponding octets.") 176 177 (defconstant +buffer-size+ 8192 178 "Default size for buffers used for internal purposes.") 179 180 (pushnew :flexi-streams *features*) 181 182 ;; stuff for Nikodemus Siivola's HYPERDOC 183 ;; see <http://common-lisp.net/project/hyperdoc/> 184 ;; and <http://www.cliki.net/hyperdoc> 185 ;; also used by LW-ADD-ONS 186 187 (defvar *hyperdoc-base-uri* "http://weitz.de/flexi-streams/") 188 189 (let ((exported-symbols-alist 190 (loop for symbol being the external-symbols of :flexi-streams 191 collect (cons symbol 192 (concatenate 'string 193 "#" 194 (string-downcase symbol)))))) 195 (defun hyperdoc-lookup (symbol type) 196 (declare (ignore type)) 197 (cdr (assoc symbol 198 exported-symbols-alist 199 :test #'eq))))