blob: 02a3a32b0dd0d31c22c6af3c0601fc6b55e64e35 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(defpackage clhs-lookup
(:use :common-lisp)
(:export :symbol-lookup
:populate-table
:spec-lookup))
(in-package :clhs-lookup)
(defparameter *hyperspec-pathname* (translate-logical-pathname "MOXIE:RES;"))
(defparameter *hyperspec-map-file* (merge-pathnames "Map_Sym.txt" *hyperspec-pathname*))
(defparameter *hyperspec-root* "http://www.lispworks.com/reference/HyperSpec/")
;;; AMOP.
(defparameter *mop-map-file* (merge-pathnames "Mop_Sym.txt" *hyperspec-pathname*))
(defparameter *mop-root* "http://www.alu.org/mop/")
(defvar *symbol-table* (make-hash-table :test 'equal))
(defvar *section-table* (make-hash-table :test 'equal))
(defvar *format-table* (make-hash-table :test 'equal))
(defvar *populated-p* nil)
(defun add-clhs-section-to-table (&rest numbers)
(let ((key (format nil "~{~d~^.~}" numbers))
(target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers))))))
(setf (gethash key *section-table*) target)))
(defun valid-target (&rest numbers)
(probe-file (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))
(defvar *last-warn-time* 0)
(defun populate-table ()
(unless *populated-p*
;; Hyperspec
(with-open-file (s *hyperspec-map-file* :if-does-not-exist nil)
;; populate the table with the symbols from the Map file
;; this bit is easy and portable.
(unless s
(when (> (- (get-universal-time) *last-warn-time*) 10)
(format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%")
(setf *last-warn-time* (get-universal-time)))
(return-from populate-table nil))
(do ((symbol-name (read-line s nil s) (read-line s nil s))
(url (read-line s nil s) (read-line s nil s)))
((eq url s) 'done)
(setf (gethash symbol-name *symbol-table*) (concatenate 'string *hyperspec-root* (subseq url 3))))
;; add in section references.
(let ((*default-pathname-defaults* *hyperspec-pathname*))
;; Yuk. I know. Fixes welcome.
(loop for section from 0 to 27
do (add-clhs-section-to-table section)
do (loop named s for s1 from 1 to 26
unless (valid-target section s1)
do (return-from s nil)
do (add-clhs-section-to-table section s1)
do (loop named ss for s2 from 1 to 26
unless (valid-target section s1 s2)
do (return-from ss nil)
do (add-clhs-section-to-table section s1 s2)
do (loop named sss for s3 from 1 to 26
unless (valid-target section s1 s2 s3)
do (return-from sss nil)
do (add-clhs-section-to-table section s1 s2 s3)
do (loop named ssss for s4 from 1 to 26
unless (valid-target section s1 s2 s3 s4)
do (return-from ssss nil)
do (add-clhs-section-to-table section s1 s2 s3 s4)
do (loop named sssss for s5 from 1 to 26
unless (valid-target section s1 s2 s3 s4 s5)
do (return-from sssss nil)
do (add-clhs-section-to-table section s1 s2 s3 s4 s5))))))))
;; format directives
(loop for code from 32 to 127
do (setf (gethash (format nil "~~~A" (code-char code)) *format-table*)
(concatenate 'string
*hyperspec-root*
(case (code-char code)
((#\c #\C) "Body/22_caa.htm")
((#\%) "Body/22_cab.htm")
((#\&) "Body/22_cac.htm")
((#\|) "Body/22_cad.htm")
((#\~) "Body/22_cae.htm")
((#\r #\R) "Body/22_cba.htm")
((#\d #\D) "Body/22_cbb.htm")
((#\b #\B) "Body/22_cbc.htm")
((#\o #\O) "Body/22_cbd.htm")
((#\x #\X) "Body/22_cbe.htm")
((#\f #\F) "Body/22_cca.htm")
((#\e #\E) "Body/22_ccb.htm")
((#\g #\G) "Body/22_ccc.htm")
((#\$) "Body/22_ccd.htm")
((#\a #\A) "Body/22_cda.htm")
((#\s #\S) "Body/22_cdb.htm")
((#\w #\W) "Body/22_cdc.htm")
((#\_) "Body/22_cea.htm")
;((#\<) "Body/22_ceb.htm")
((#\i #\I) "Body/22_cec.htm")
((#\/) "Body/22_ced.htm")
((#\t #\T) "Body/22_cfa.htm")
;; FIXME
((#\<) "Body/22_cfb.htm")
((#\>) "Body/22_cfc.htm")
((#\*) "Body/22_cga.htm")
((#\[) "Body/22_cgb.htm")
((#\]) "Body/22_cgc.htm")
((#\{) "Body/22_cgd.htm")
((#\}) "Body/22_cge.htm")
((#\?) "Body/22_cgf.htm")
((#\() "Body/22_cha.htm")
((#\)) "Body/22_chb.htm")
((#\p #\P) "Body/22_chc.htm")
((#\;) "Body/22_cia.htm")
((#\^) "Body/22_cib.htm")
((#\Newline) "Body/22_cic.htm")
(t "Body/22_c.htm")))))
;; glossary.
)
;; MOP
(with-open-file (s *mop-map-file* :if-does-not-exist nil)
(when s
(do ((symbol-name (read-line s nil s) (read-line s nil s))
(url (read-line s nil s) (read-line s nil s)))
((eq url s) 'done)
(setf (gethash (concatenate 'string "MOP:" symbol-name) *symbol-table*) (concatenate 'string *mop-root* url)))))
(setf *populated-p* t)))
(defun spec-lookup (term &key (type :all))
(unless *populated-p*
(populate-table))
(ecase type
(:all
(or (gethash term *symbol-table*)
(gethash term *section-table*)
(gethash term *format-table*)))
(:symbol
(gethash term *symbol-table*))
(:section
(gethash term *section-table*))
(:format
(gethash term *format-table*))))
(defun symbol-lookup (term)
(spec-lookup term :type :symbol))
|
