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