1 |
|
(in-package "SI" ) |
2 |
|
|
3 |
|
(eval-when (compile) |
4 |
|
|
5 |
|
|
6 |
|
(proclaim '(ftype (function (t t &optional fixnum) fixnum) string-match)) |
7 |
|
(proclaim '(ftype (function (fixnum) fixnum) |
8 |
|
match-beginning match-end))) |
9 |
|
(eval-when (compile eval) |
10 |
|
(defmacro while (test &body body) |
11 |
|
`(slooP::sloop while ,test do ,@ body)) |
12 |
|
(defmacro f (op x y) |
13 |
|
`(the ,(if (get op 'compiler::predicate) 't 'fixnum) |
14 |
|
(,op (the fixnum ,x) (the fixnum ,y))))) |
15 |
|
|
16 |
|
(eval-when (compile eval load) |
17 |
|
(defun sharp-u-reader (stream subchar arg) |
18 |
|
subchar arg |
19 |
|
(let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0))) |
20 |
|
(or (eql (read-char stream) #\") |
21 |
|
(error "sharp-u-reader reader needs a \" right after it")) |
22 |
|
(loop |
23 |
|
(let ((ch (read-char stream))) |
24 |
|
(cond ((eql ch #\") (return tem)) |
25 |
|
((eql ch #\\) |
26 |
|
(setq ch (read-char stream)) |
27 |
|
(setq ch (or (cdr (assoc ch '((#\n . #\newline) |
28 |
|
(#\t . #\tab) |
29 |
|
(#\r . #\return)))) |
30 |
|
ch)))) |
31 |
|
(vector-push-extend ch tem))) |
32 |
|
tem)) |
33 |
|
|
34 |
|
|
35 |
|
(set-dispatch-macro-character #\# #\u 'sharp-u-reader) |
36 |
|
) |
37 |
|
|
38 |
|
(defvar *info-data* nil) |
39 |
|
(defvar *current-info-data* nil) |
40 |
|
|
41 |
|
(defun file-to-string (file &optional (start 0) |
42 |
|
&aux (si::*ALLOW-GZIPPED-FILE* t)(len 0)) |
43 |
|
(with-open-file |
44 |
|
(st file) |
45 |
|
(setq len (file-length st)) |
46 |
|
(or (and (<= 0 start ) (<= start len)) |
47 |
|
(error "illegal file start ~a" start)) |
48 |
|
(let ((tem (make-array (- len start) |
49 |
|
:element-type 'string-char))) |
50 |
|
(if (> start 0) (file-position st start)) |
51 |
|
(si::fread tem 0 (length tem) st) tem))) |
52 |
|
|
53 |
|
(defun atoi (string start &aux (ans 0) (ch 0)(len (length string))) |
54 |
|
(declare (string string)) |
55 |
|
(declare (fixnum start ans ch len) ) |
56 |
|
(while (< start len) |
57 |
|
(setq ch (char-code (aref string start))) |
58 |
|
(setq start (+ start 1)) |
59 |
|
(setq ch (- ch #.(char-code #\0))) |
60 |
|
(cond ((and (>= ch 0) (< ch 10)) |
61 |
|
(setq ans (+ ch (* 10 ans)))) |
62 |
|
(t (return nil)))) |
63 |
|
ans)) |
64 |
|
|
65 |
|
(defun info-get-tags (file &aux (lim 0) *match-data* tags files |
66 |
|
(*case-fold-search* t)) |
67 |
|
(declare (fixnum lim)) |
68 |
|
(let ((s (file-to-string file)) (i 0)) |
69 |
|
(declare (fixnum i) (string s)) |
70 |
|
(cond ((f >= (string-match #u"[\n]+Indirect:" s 0) 0) |
71 |
|
(setq i (match-end 0)) |
72 |
|
(setq lim (string-match #u"" s i)) |
73 |
|
(while |
74 |
|
(f >= (string-match #u"\n([^\n]+): ([0-9]+)" s i lim) 0) |
75 |
|
(setq i (match-end 0)) |
76 |
|
(setq files |
77 |
|
(cons(cons |
78 |
|
(atoi s (match-beginning 2)) |
79 |
|
(get-match s 1) |
80 |
|
) |
81 |
|
files))))) |
82 |
|
(cond ((f >= (si::string-match #u"[\n]+Tag Table:" s i) 0) |
83 |
|
(setq i (si::match-end 0)) |
84 |
|
(cond ((f >= (si::string-match "" s i) 0) |
85 |
|
(setq tags (subseq s i (si::match-end 0))))))) |
86 |
|
(if files (or tags (info-error "Need tags if have multiple files"))) |
87 |
|
(list* tags (nreverse files)))) |
88 |
|
|
89 |
|
(defun re-quote-string (x &aux (i 0) (len (length x)) ch |
90 |
|
(extra 0) ) |
91 |
|
(declare (fixnum i len extra)) |
92 |
|
(declare (string x)) |
93 |
|
(let (tem) |
94 |
|
(tagbody |
95 |
|
AGAIN |
96 |
|
(while (< i len) |
97 |
|
(setq ch (aref x i)) |
98 |
|
(cond ((position ch "\\()[]+.*|^$?") |
99 |
|
(cond (tem |
100 |
|
(vector-push-extend #\\ tem)) |
101 |
|
(t (incf extra))))) |
102 |
|
(if tem |
103 |
|
(vector-push-extend ch tem)) |
104 |
|
(setq i (+ i 1))) |
105 |
|
(cond (tem ) |
106 |
|
((> extra 0) |
107 |
|
(setq tem |
108 |
|
(make-array (f + (length x) extra) |
109 |
|
:element-type 'string-char :fill-pointer 0)) |
110 |
|
(setq i 0) |
111 |
|
(go AGAIN)) |
112 |
|
(t (setq tem x))) |
113 |
|
) |
114 |
|
tem)) |
115 |
|
|
116 |
|
(defun get-match (string i) |
117 |
|
(subseq string (match-beginning i) (match-end i))) |
118 |
|
|
119 |
|
(defun get-nodes (pat node-string &aux (i 0) ans |
120 |
|
(*case-fold-search* t) *match-data*) |
121 |
|
(declare (fixnum i)) |
122 |
|
(when node-string |
123 |
|
(setq pat |
124 |
|
(si::string-concatenate "Node: ([^]*" (re-quote-string |
125 |
|
pat) "[^]*)")) |
126 |
|
(while (f >= (string-match pat node-string i) 0) |
127 |
|
(setq i (match-end 0)) |
128 |
|
(setq ans (cons (get-match node-string 1) |
129 |
|
ans)) |
130 |
|
) |
131 |
|
(nreverse ans))) |
132 |
|
|
133 |
|
(defun get-index-node () |
134 |
|
(or (third *current-info-data*) |
135 |
|
(let* ( |
136 |
|
s |
137 |
|
(node-string (car (nth 1 *current-info-data*))) |
138 |
|
(node |
139 |
|
(and node-string (car (get-nodes "index" node-string))))) |
140 |
|
(when node |
141 |
|
(setq s (show-info |
142 |
|
node |
143 |
|
nil |
144 |
|
nil |
145 |
|
)) |
146 |
|
(setf (third *current-info-data*) s))))) |
147 |
|
|
148 |
|
(defun nodes-from-index (pat &aux (i 0) ans |
149 |
|
(*case-fold-search* t) *match-data*) |
150 |
|
(let ((index-string (get-index-node))) |
151 |
|
(when index-string |
152 |
|
(setq pat |
153 |
|
(si::string-concatenate #u"\n\\* ([^:\n]*" (re-quote-string |
154 |
|
pat) |
155 |
|
#u"[^:\n]*):[ \t]+([^\t\n,.]+)")) |
156 |
|
(while (f >= (string-match pat index-string i) 0) |
157 |
|
(setq i (match-end 0)) |
158 |
|
(setq ans (cons (cons (get-match index-string 1) |
159 |
|
(get-match index-string 2)) |
160 |
|
|
161 |
|
|
162 |
|
ans)) |
163 |
|
) |
164 |
|
(nreverse ans)))) |
165 |
|
|
166 |
|
(defun get-node-index (pat node-string &aux (node pat) *match-data*) |
167 |
|
(cond ((null node-string) 0) |
168 |
|
(t |
169 |
|
(setq pat |
170 |
|
(si::string-concatenate "Node: " |
171 |
|
(re-quote-string pat) "([0-9]+)")) |
172 |
|
(cond ((f >= (string-match pat node-string) 0) |
173 |
|
(atoi node-string (match-beginning 1))) |
174 |
|
(t (info-error "cant find node ~s" node) 0))))) |
175 |
|
|
176 |
|
(defun all-matches (pat st &aux (start 0) *match-data*) |
177 |
|
(declare (fixnum start)) |
178 |
|
(sloop::sloop while (>= (setq start (si::string-match pat st start)) 0) |
179 |
|
do nil;(print start) |
180 |
|
collect (list start (setq start (si::match-end 0))))) |
181 |
|
|
182 |
|
|
183 |
|
|
184 |
|
(defmacro node (prop x) |
185 |
|
`(nth ,(position prop '(string begin end header name |
186 |
|
info-subfile |
187 |
|
file tags)) ,x)) |
188 |
|
|
189 |
|
(defun node-offset (node) |
190 |
|
(+ (car (node info-subfile node)) (node begin node))) |
191 |
|
|
192 |
|
(defvar *info-paths* |
193 |
|
'("" "/usr/info/" "/usr/local/lib/info/" "/usr/local/info/" |
194 |
|
"/usr/local/gnu/info/" "/usr/share/info/")) |
195 |
|
|
196 |
|
(defvar *old-lib-directory* nil) |
197 |
|
(defun setup-info (name &aux tem file) |
198 |
|
(or (eq *old-lib-directory* si::*lib-directory*) |
199 |
|
(progn |
200 |
|
(setq *old-lib-directory* si::*lib-directory*) |
201 |
|
(push (si::string-concatenate |
202 |
|
si::*lib-directory* "info/") *info-paths*) |
203 |
|
(setq *info-paths* (si::fix-load-path *info-paths*)))) |
204 |
|
(cond ((or (equal name "DIR")) |
205 |
|
(setq name "dir"))) |
206 |
|
;; compressed info reading -- search for gzipped files, and open with base filename |
207 |
|
;; relying on si::*allow-gzipped-files* to uncompress |
208 |
|
(setq file (si::file-search name *info-paths* '("" ".info" ".gz") nil)) |
209 |
|
(let ((ext (search ".gz" file))) |
210 |
|
(when ext |
211 |
|
(setq file (subseq file 0 ext)))) |
212 |
|
(cond ((and (null file) |
213 |
|
(not (equal name "dir"))) |
214 |
|
(let* ( |
215 |
|
(tem (show-info "(dir)Top" nil nil)) |
216 |
|
*case-fold-search*) |
217 |
|
(cond ((f >= (string-match |
218 |
|
(si::string-concatenate |
219 |
|
"\\(([^(]*" |
220 |
|
(re-quote-string name) |
221 |
|
"(.info)?)\\)") |
222 |
|
tem ) 0) |
223 |
|
(setq file (get-match tem 1))))))) |
224 |
|
(cond (file |
225 |
|
(let* ((na (namestring (truename file)))) |
226 |
|
(cond ((setq tem (assoc na *info-data* :test 'equal)) |
227 |
|
(setq *current-info-data* tem)) |
228 |
|
(t (setq *current-info-data* |
229 |
|
(list na (info-get-tags na) nil)) |
230 |
|
(setq *info-data* (cons *current-info-data* *info-data*) |
231 |
|
))))) |
232 |
|
(t (format t "(not found ~s)" name))) |
233 |
|
nil) |
234 |
|
|
235 |
|
(defun get-info-choices (pat type) |
236 |
|
(if (eql type 'index) |
237 |
|
(nodes-from-index pat ) |
238 |
|
(get-nodes pat (car (nth 1 *current-info-data*)))))) |
239 |
|
|
240 |
|
(defun add-file (v file &aux (lis v)) |
241 |
|
(while lis |
242 |
|
(setf (car lis) (list (car lis) file)) |
243 |
|
(setq lis (cdr lis))) |
244 |
|
v) |
245 |
|
|
246 |
|
(defvar *info-window* nil) |
247 |
|
(defvar *tk-connection* nil) |
248 |
|
|
249 |
|
(defun info-error (&rest l) |
250 |
|
(if *tk-connection* |
251 |
|
(tk::tkerror (apply 'format nil l)) |
252 |
|
(apply 'error l))) |
253 |
|
|
254 |
|
(defvar *last-info-file* nil) |
255 |
|
;; cache last file read to speed up lookup since may be gzipped.. |
256 |
|
(defun info-get-file (pathname) |
257 |
|
(setq pathname |
258 |
|
(merge-pathnames pathname |
259 |
|
(car *current-info-data*))) |
260 |
|
(cdr |
261 |
|
(cond ((equal (car *last-info-file*) pathname) |
262 |
|
*last-info-file*) |
263 |
|
(t (setq *last-info-file* |
264 |
|
(cons pathname (file-to-string pathname))))))) |
265 |
|
|
266 |
|
(defun waiting (win) |
267 |
|
(and *tk-connection* |
268 |
|
(fboundp win) |
269 |
|
(winfo :exists win :return 'boolean) |
270 |
|
(funcall win :configure :cursor "watch"))) |
271 |
|
|
272 |
|
(defun end-waiting (win) (and (fboundp win) |
273 |
|
(funcall win :configure :cursor ""))) |
274 |
|
|
275 |
|
(defun info-subfile (n &aux ) |
276 |
|
; "For an index N return (START . FILE) for info subfile |
277 |
|
; which contains N. A second value bounding the limit if known |
278 |
|
; is returned. At last file this limit is nil." |
279 |
|
(let ((lis (cdr (nth 1 *current-info-data*))) |
280 |
|
ans lim) |
281 |
|
(and lis (>= n 0) |
282 |
|
(dolist (v lis) |
283 |
|
(cond ((> (car v) n ) |
284 |
|
(setq lim (car v)) |
285 |
|
(return nil))) |
286 |
|
(setq ans v) |
287 |
|
)) |
288 |
|
(values (or ans (cons 0 (car *current-info-data*))) lim))) |
289 |
|
|
290 |
|
;;used by search |
291 |
|
(defun info-node-from-position (n &aux (i 0)) |
292 |
|
(let* ((info-subfile (info-subfile n)) |
293 |
|
(s (info-get-file (cdr info-subfile))) |
294 |
|
(end (- n (car info-subfile)))) |
295 |
|
(while (f >= (string-match #u"" s i end) 0) |
296 |
|
(setq i (match-end 0))) |
297 |
|
(setq i (- i 1)) |
298 |
|
(if (f >= (string-match |
299 |
|
#u"[\n][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n" s i) 0) |
300 |
|
(let* ((i (match-beginning 0)) |
301 |
|
(beg (match-end 0)) |
302 |
|
(name (get-match s 1)) |
303 |
|
(end(if (f >= (string-match "[]" s beg) 0) |
304 |
|
(match-beginning 0) |
305 |
|
(length s))) |
306 |
|
(node (list* s beg end i name info-subfile |
307 |
|
*current-info-data*))) |
308 |
|
node)))) |
309 |
|
|
310 |
|
(defun show-info (name &optional position-pattern |
311 |
|
(use-tk *tk-connection*) |
312 |
|
&aux info-subfile *match-data* |
313 |
|
file |
314 |
|
(initial-offset 0)(subnode -1)) |
315 |
|
(declare (fixnum subnode initial-offset)) |
316 |
|
;;; (pat . node) |
317 |
|
;;; node |
318 |
|
;;; (node file) |
319 |
|
;;; ((pat . node) file) |
320 |
|
; (print (list name position-pattern use-tk)) |
321 |
|
(progn ;decode name |
322 |
|
(cond ((and (consp name) (consp (cdr name))) |
323 |
|
(setq file (cadr name) |
324 |
|
name (car name)))) |
325 |
|
(cond ((consp name) |
326 |
|
(setq position-pattern (car name) name (cdr name))))) |
327 |
|
(or (stringp name) (info-error "bad arg")) |
328 |
|
(waiting *info-window*) |
329 |
|
(cond ((f >= (string-match "^\\(([^(]+)\\)([^)]*)" name) 0) |
330 |
|
;; (file)node |
331 |
|
(setq file (get-match name 1)) |
332 |
|
(setq name (get-match name 2)) |
333 |
|
(if (equal name "")(setq name "Top")))) |
334 |
|
(if file (setup-info file)) |
335 |
|
(let ((indirect-index (get-node-index name |
336 |
|
(car (nth 1 *current-info-data*))))) |
337 |
|
(cond ((null indirect-index) |
338 |
|
(format t"~%Sorry, Can't find node ~a" name) |
339 |
|
(return-from show-info nil))) |
340 |
|
|
341 |
|
(setq info-subfile (info-subfile indirect-index)) |
342 |
|
(let* ((s |
343 |
|
(info-get-file (cdr info-subfile))) |
344 |
|
(start (- indirect-index (car info-subfile)))) |
345 |
|
(cond ((f >= (string-match |
346 |
|
;; to do fix this ;; see (info)Add for description; |
347 |
|
;; the |
348 |
|
(si::string-concatenate |
349 |
|
#u"[\n][^\n]*Node:[ \t]+" |
350 |
|
(re-quote-string name) #u"[,\t\n][^\n]*\n") |
351 |
|
s start) 0) |
352 |
|
(let* ((i (match-beginning 0)) |
353 |
|
(beg (match-end 0)) |
354 |
|
(end(if (f >= (string-match "[]" s beg) 0) |
355 |
|
(match-beginning 0) |
356 |
|
(length s))) |
357 |
|
(node (list* s beg end i name info-subfile |
358 |
|
*current-info-data*))) |
359 |
|
|
360 |
|
(cond |
361 |
|
(position-pattern |
362 |
|
(setq position-pattern (re-quote-string position-pattern)) |
363 |
|
|
364 |
|
(let (*case-fold-search* ) |
365 |
|
(if (or |
366 |
|
(f >= (setq subnode |
367 |
|
(string-match |
368 |
|
(si::string-concatenate |
369 |
|
#u"\n - [A-Za-z ]+: " |
370 |
|
position-pattern #u"[ \n]") |
371 |
|
s beg end)) 0) |
372 |
|
(f >= (string-match position-pattern s beg end) 0)) |
373 |
|
(setq initial-offset |
374 |
|
(- (match-beginning 0) beg)) |
375 |
|
)))) |
376 |
|
(cond ( use-tk |
377 |
|
(prog1 (print-node node initial-offset) |
378 |
|
(end-waiting *info-window*)) |
379 |
|
) |
380 |
|
(t |
381 |
|
(let ((e |
382 |
|
(if (and (>= subnode 0) |
383 |
|
(f >= |
384 |
|
(string-match #u"\n\n - [A-Z]" |
385 |
|
s (+ beg 1 |
386 |
|
initial-offset) |
387 |
|
end) |
388 |
|
0)) |
389 |
|
(match-beginning 0) |
390 |
|
end))) |
391 |
|
;(print (list beg initial-offset e end)) |
392 |
|
(subseq s (+ initial-offset beg) e ) |
393 |
|
;s |
394 |
|
))))) |
395 |
|
(t (info-error "Cant find node ~a?" name) |
396 |
|
(end-waiting *info-window*) |
397 |
|
)) |
398 |
|
))) |
399 |
|
|
400 |
|
(defvar *default-info-files* '( "gcl-si.info" "gcl-tk.info" "gcl.info")) |
401 |
|
|
402 |
|
(defun info-aux (x dirs) |
403 |
|
(sloop for v in dirs |
404 |
|
do (setup-info v) |
405 |
|
append (add-file (get-info-choices x 'node) v) |
406 |
|
append (add-file (get-info-choices x 'index) v))) |
407 |
|
|
408 |
|
(defun info-search (pattern &optional start end &aux limit) |
409 |
|
; "search for PATTERN from START up to END where these are indices in |
410 |
|
;the general info file. The search goes over all files." |
411 |
|
(or start (setq start 0)) |
412 |
|
(while start |
413 |
|
(multiple-value-bind |
414 |
|
(file lim) |
415 |
|
(info-subfile start) |
416 |
|
(setq limit lim) |
417 |
|
(and end limit (< end limit) (setq limit end)) |
418 |
|
|
419 |
|
(let* ((s (info-get-file (cdr file))) |
420 |
|
(beg (car file)) |
421 |
|
(i (- start beg)) |
422 |
|
(leng (length s))) |
423 |
|
(cond ((f >= (string-match pattern s i (if limit (- limit beg) leng)) 0) |
424 |
|
(return-from info-search (+ beg (match-beginning 0)))))) |
425 |
|
(setq start lim))) |
426 |
|
-1) |
427 |
|
|
428 |
|
#+debug ; try searching |
429 |
|
(defun try (pat &aux (tem 0) s ) |
430 |
|
(while (>= tem 0) |
431 |
|
(cond ((>= (setq tem (info-search pat tem)) 0) |
432 |
|
(setq s (cdr *last-info-file*)) |
433 |
|
(print (list |
434 |
|
tem |
435 |
|
(list-matches s 0 1 2) |
436 |
|
(car *last-info-file*) |
437 |
|
(subseq s |
438 |
|
(max 0 (- (match-beginning 0) 50)) |
439 |
|
(min (+ (match-end 0) 50) (length s))))) |
440 |
|
(setq tem (+ tem (- (match-end 0) (match-beginning 0)))))))) |
441 |
|
|
442 |
|
(defun idescribe (name) |
443 |
|
(let* ((items (info-aux name *default-info-files*))) |
444 |
|
(dolist (v items) |
445 |
|
(when (cond ((consp (car v)) |
446 |
|
(equalp (caar v) name)) |
447 |
|
(t (equalp (car v) name))) |
448 |
|
(format t "~%From ~a:~%" v) |
449 |
|
(princ (show-info v nil nil)))))) |
450 |
|
|
451 |
|
(defun info (x &optional (dirs *default-info-files*) &aux wanted |
452 |
|
*current-info-data* file position-pattern) |
453 |
|
(let ((tem (info-aux x dirs))) |
454 |
|
(cond |
455 |
|
(*tk-connection* |
456 |
|
(offer-choices tem dirs) |
457 |
|
) |
458 |
|
(t |
459 |
|
|
460 |
|
(when tem |
461 |
|
(let ((nitems (length tem))) |
462 |
|
(sloop for i from 0 for name in tem with prev |
463 |
|
do (setq file nil position-pattern nil) |
464 |
|
(progn ;decode name |
465 |
|
(cond ((and (consp name) (consp (cdr name))) |
466 |
|
(setq file (cadr name) |
467 |
|
name (car name)))) |
468 |
|
(cond ((consp name) |
469 |
|
(setq position-pattern (car name) name (cdr name))))) |
470 |
|
(format t "~% ~d: ~@[~a :~]~@[(~a)~]~a." i |
471 |
|
position-pattern |
472 |
|
(if (eq file prev) nil (setq prev file)) name)) |
473 |
|
(if (> (length tem) 1) |
474 |
|
(format t "~%Enter n, all, none, or multiple choices eg 1 3 : ") |
475 |
|
(terpri)) |
476 |
|
(let ((line (if (> (length tem) 1) (read-line) "0")) |
477 |
|
(start 0) |
478 |
|
val) |
479 |
|
(while (equal line "") (setq line (read-line))) |
480 |
|
(while (multiple-value-setq |
481 |
|
(val start) |
482 |
|
(read-from-string line nil nil :start start)) |
483 |
|
(cond ((numberp val) |
484 |
|
(setq wanted (cons val wanted))) |
485 |
|
(t (setq wanted val) (return nil)))) |
486 |
|
(cond ((consp wanted)(setq wanted (nreverse wanted))) |
487 |
|
((symbolp wanted) |
488 |
|
(setq wanted (and |
489 |
|
(equal (symbol-name wanted) "ALL") |
490 |
|
(sloop for i below (length tem) collect i))))) |
491 |
|
(when wanted |
492 |
|
;; Remove invalid (numerical) answers |
493 |
|
(setf wanted (remove-if #'(lambda (x) |
494 |
|
(and (integerp x) (>= x nitems))) |
495 |
|
wanted)) |
496 |
|
(format t "~%Info from file ~a:" (car *current-info-data*))) |
497 |
|
(sloop for i in wanted |
498 |
|
do (princ(show-info (nth i tem))))))))))) |
499 |
|
|
500 |
|
|
501 |
|
;; idea make info_text window have previous,next,up bindings on keys |
502 |
|
;; and on menu bar. Have it bring up apropos menu. allow selection |
503 |
|
;; to say spawn another info_text window. The symbol that is the window |
504 |
|
;; will carry on its plist the prev,next etc nodes, and the string-to-file |
505 |
|
;; cache the last read file as well. Add look up in index file, so that can |
506 |
|
;; search an indtqex as well. Could be an optional arg to show-node |
507 |
|
;; |
508 |
|
|
509 |
|
|
510 |
|
|
511 |
|
(defun default-info-hotlist() |
512 |
|
(namestring (merge-pathnames "hotlist" (user-homedir-pathname)))) |
513 |
|
|
514 |
|
(defvar *info-window* nil) |
515 |
|
|
516 |
|
(defun add-to-hotlist (node ) |
517 |
|
(if (symbolp node) (setq node (get node 'node))) |
518 |
|
(cond |
519 |
|
(node |
520 |
|
(with-open-file |
521 |
|
(st (default-info-hotlist) |
522 |
|
:direction :output |
523 |
|
:if-exists :append |
524 |
|
:if-does-not-exist :create) |
525 |
|
(cond ((< (file-position st) 10) |
526 |
|
(princ #u"\nFile:\thotlist\tNode: Top\n\n* Menu: Hot list of favrite info items.\n\n" st))) |
527 |
|
(format st "* (~a)~a::~%" |
528 |
|
(node file node)(node name node)))))) |
529 |
|
|
530 |
|
(defun list-matches (s &rest l) |
531 |
|
(sloop for i in l |
532 |
|
collect |
533 |
|
(and (f >= (match-beginning i) 0) |
534 |
|
(get-match s i)))) |
535 |
|
|
536 |
|
;;; Local Variables: *** |
537 |
|
;;; mode:lisp *** |
538 |
|
;;; version-control:t *** |
539 |
|
;;; comment-column:0 *** |
540 |
|
;;; comment-start: ";;; " *** |
541 |
|
;;; End: *** |
542 |
|
|
543 |
|
|