specials.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
---
specials.lisp (7168B)
---
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))))