Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/edicl-flexi-streams-20240429143708/specials.lisp

Kind	Covered	All	%
expression	9	52	17.3
branch	0	0	nil

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

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

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

(:cp936 . :gbk)

68

(:gb2312 . :gbk)

69

(:utf32 . :utf-32)

70

(:ucs4 . :utf-32)

71

(:ucs-4 . :utf-32)

72

(:ascii . :us-ascii)

73

(:koi8r . :koi8-r)

74

(:mac . :mac-roman)

75

(:macintosh . :mac-roman)

76

(:macos-roman . :mac-roman)

77

(:latin-1 . :iso-8859-1)

78

(:latin1 . :iso-8859-1)

79

(:latin-2 . :iso-8859-2)

80

(:latin2 . :iso-8859-2)

81

(:latin-3 . :iso-8859-3)

82

(:latin3 . :iso-8859-3)

83

(:latin-4 . :iso-8859-4)

84

(:latin4 . :iso-8859-4)

85

(:cyrillic . :iso-8859-5)

86

(:arabic . :iso-8859-6)

87

(:greek . :iso-8859-7)

88

(:hebrew . :iso-8859-8)

89

(:latin-5 . :iso-8859-9)

90

(:latin5 . :iso-8859-9)

91

(:latin-6 . :iso-8859-10)

92

(:latin6 . :iso-8859-10)

93

(:thai . :iso-8859-11)

94

(:latin-7 . :iso-8859-13)

95

(:latin7 . :iso-8859-13)

96

(:latin-8 . :iso-8859-14)

97

(:latin8 . :iso-8859-14)

98

(:latin-9 . :iso-8859-15)

99

(:latin9 . :iso-8859-15)

100

(:latin-0 . :iso-8859-15)

101

(:latin0 . :iso-8859-15)

102

(:latin-10 . :iso-8859-16)

103

(:latin10 . :iso-8859-16)

104

(:codepage . :code-page)

105

#+(and :lispworks :win32)

106

(win32:code-page . :code-page))

107

"An alist which mapes alternative names for external formats to

108

their canonical counterparts.")

109

110

(defvar +shortcut-map+

111

'((:ucs-2le . (:ucs-2 :little-endian t))

112

(:ucs-2be . (:ucs-2 :little-endian nil))

113

(:ucs-4le . (:ucs-4 :little-endian t))

114

(:ucs-4be . (:ucs-4 :little-endian nil))

115

(:utf-16le . (:utf-16 :little-endian t))

116

(:utf-16be . (:utf-16 :little-endian nil))

117

(:utf-32le . (:utf-32 :little-endian t))

118

(:utf-32be . (:utf-32 :little-endian nil))

119

(:ibm437 . (:code-page :id 437))

120

(:ibm850 . (:code-page :id 850))

121

(:ibm852 . (:code-page :id 852))

122

(:ibm855 . (:code-page :id 855))

123

(:ibm857 . (:code-page :id 857))

124

(:ibm860 . (:code-page :id 860))

125

(:ibm861 . (:code-page :id 861))

126

(:ibm862 . (:code-page :id 862))

127

(:ibm863 . (:code-page :id 863))

128

(:ibm864 . (:code-page :id 864))

129

(:ibm865 . (:code-page :id 865))

130

(:ibm866 . (:code-page :id 866))

131

(:ibm869 . (:code-page :id 869))

132

(:windows-1250 . (:code-page :id 1250))

133

(:windows-1251 . (:code-page :id 1251))

134

(:windows-1252 . (:code-page :id 1252))

135

(:windows-1253 . (:code-page :id 1253))

136

(:windows-1254 . (:code-page :id 1254))

137

(:windows-1255 . (:code-page :id 1255))

138

(:windows-1256 . (:code-page :id 1256))

139

(:windows-1257 . (:code-page :id 1257))

140

(:windows-1258 . (:code-page :id 1258)))

141

"An alist which maps shortcuts for external formats to their

142

long forms.")

143

144

(defvar *default-eol-style*

145

#+:win32 :crlf

146

#-:win32 :lf

147

"The end-of-line style used by external formats if none is

148

explicitly given. Depends on the OS the code is compiled on.")

149

150

(defvar *default-little-endian*

151

#+:little-endian t

152

#-:little-endian nil

153

"Whether external formats are little-endian by default

154

\(i.e. unless explicitly specified). Depends on the platform

155

the code is compiled on.")

156

157

(defvar *substitution-char* nil

158

"If this value is not NIL, it should be a character which is used

159

\(as if by a USE-VALUE restart) whenever during reading an error of

160

type FLEXI-STREAM-ENCODING-ERROR would have been signalled otherwise.")

161

162

(defconstant +iso-8859-hashes+

163

(loop for (name . table) in +iso-8859-tables+

164

collect (cons name (invert-table table)))

165

"An alist which maps names for ISO-8859 encodings to hash

166

tables which map character codes to the corresponding octets.")

167

168

(defconstant +code-page-hashes+

169

(loop for (id . table) in +code-page-tables+

170

collect (cons id (invert-table table)))

171

"An alist which maps IDs of Windows code pages to hash tables

172

which map character codes to the corresponding octets.")

173

174

(defconstant +ascii-hash+ (invert-table +ascii-table+)

175

"A hash table which maps US-ASCII character codes to the

176

corresponding octets.")

177

178

(defconstant +koi8-r-hash+ (invert-table +koi8-r-table+)

179

"A hash table which maps KOI8-R character codes to the

180

corresponding octets.")

181

182

(defconstant +mac-roman-hash+ (invert-table +mac-roman-table+)

183

"A hash table which maps MAC-ROMAN character codes to the

184

corresponding octets.")

185

186

(defconstant +buffer-size+ 8192

187

"Default size for buffers used for internal purposes.")

188

189

(pushnew :flexi-streams *features*)

190

191

;; stuff for Nikodemus Siivola's HYPERDOC

192

;; see <http://common-lisp.net/project/hyperdoc/>

193

;; and <http://www.cliki.net/hyperdoc>

194

;; also used by LW-ADD-ONS

195

196

(defvar *hyperdoc-base-uri* "http://weitz.de/flexi-streams/")

197

198

(let ((exported-symbols-alist

199

(loop for symbol being the external-symbols of :flexi-streams

200

collect (cons symbol

201

(concatenate 'string

202

"#"

203

(string-downcase symbol))))))

204

(defun hyperdoc-lookup (symbol type)

205

(declare (ignore type))

206

(cdr (assoc symbol

207

exported-symbols-alist

208

:test #'eq))))