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
149
150
151
152
153
|
; This is an XLISP-PLUS glossary lookup package.
; It requires the package facility to work, and uses a file called
; glos.txt which is the glossary portion of the XLISP documentation file
; When loaded for the first time, it adds a *glossary* property to all
; functions which are defined in glos.txt and are in the XLISP package.
; This property is the displacement into the file. When a glossary lookup
; occurs the file itself is referenced. By operating this way, very little
; space is taken for this feature.
; There are two user-accessable symbols. tools:*glospaging* is a variable
; which causes the output to "page" (pause for user response) at every
; screenful. Set it to NIL to defeat this feature or to the number of lines
; per page to enable.
; The main entry point is the function tools:glos. When given an argument that
; is a function symbol, it will look up the glossary definition. If the
; symbol is not in the XLISP package, or if a second non-nil argument is
; supplied, the name will be passed to APROPOS, and the glossary definitions
; for all matching symbols will be displayed
; For instance (glos :car) or (glos 'car) or (glos "car") will show the
; definition for the CAR function, while (glos 'car t) will show that of
; MAPCAR as well. (glos "X") will give the glossary listing of all functions
; with names containing an X character, since there is no external symbol
; named X in the XLISP package.
; It would not be that difficult to modifify this program for environments
; where packages are not compiled in, however operation would not be quite
; as sophisticated.
;Tom Almy
;10/93
; Revised 2/94, improving operation and clarifying some loading messages
; Revised 10/14/96 to create file useable with function DOCUMENTATION
#-:packages
(error "This utility was written asuming the package facility is in use")
#-:common
(load "common")
(unless (find-package "TOOLS")
(make-package "TOOLS" :use '("XLISP")))
(in-package "TOOLS")
(export '(glos *glospaging*))
(defvar *glosfilename*)
; We will look things up while loading
; so we can toss all the code when done
(unless *glosfilename*
(format t "~&Building glossary references---")
(let ((lpar #\()
(rpar #\))
(dot #\.)
(*pos* 0)
symbol)
(labels (
(xposition (chr str &aux (pos (position chr str)))
(if pos pos (length str)))
(seek-next-fcn (strm)
(do ((thispos *pos* (file-position strm))
(text (read-line strm nil) (read-line strm nil)))
((null text) nil)
(when (and (> (length text) 3)
(or (char= lpar (char text 0))
(char= dot (char text 0))))
(setf *pos* thispos)
(return-from seek-next-fcn
(subseq text 1 (min (xposition rpar text)
(xposition #\space text))))))))
;; The body of the code that does the work:
(unless (open "glos.txt" :direction :probe)
(error "Could not find glossary file glos.txt"))
(with-open-file
(strm "glos.txt")
(setq *glosfilename* (truename strm))
(do ((name (seek-next-fcn strm) (seek-next-fcn strm)))
((null name) nil)
(setq symbol (find-symbol (string-upcase name) :xlisp))
(unless symbol
(if (string-equal name "nil")
(setf (get nil '*glossary*) *pos*)
(format t
"~&Documented symbol ~s not found in XLISP.~%"
name)))
(when symbol
; (format t "~s " symbol)
(setf (get symbol '*glossary*) *pos*))))
;; Check for functions & vars in package XLISP that aren't documented
(format t "~&Not documented, but found in XLISP:")
(do-external-symbols
(x :xlisp)
(when (and (or (fboundp x) (specialp x))
(not (get x '*glossary*)))
(format t "~s " x)))
(format t "~&")
))) ;; Ends the Flet, let, and unless
(defvar *linecount*)
(defvar *glospaging* 23)
(defun linechk ()
(when (and *glospaging*
(> (incf *linecount*) *glospaging*))
(setq *linecount* 0)
(if (y-or-n-p "--PAUSED-- Continue?")
(fresh-line)
(throw 'getoutahere))))
(defun glos2 (val)
(with-open-file
(strm *glosfilename*)
(file-position strm val)
(do ((line (read-line strm nil) (read-line strm nil)))
((zerop (length line))
(linechk)
(format t "~%"))
(linechk)
(format t "~a~%" line))))
(defun glos (symbol &optional matchall &aux val (sym (string symbol)))
(catch
'getoutahere
(setq *linecount* 0)
(if (and (null matchall) (setq val (find-symbol sym)))
(if (setq val (get val '*glossary*))
(glos2 val)
(format t"No information on ~a~%" sym))
(progn
(setq val
(do ((list (apropos-list sym :xlisp) (cdr list))
(result nil result))
((null list) result)
(when (setq val (get (car list) '*glossary*))
(pushnew val result))))
(if (zerop (length val))
(format t "No matches for ~a~%" symbol)
(map nil #'glos2 val)))))
#+:mulvals (values)
#-:mulvals nil
)
|
