11 |
`(slooP::sloop while ,test do ,@ body)) |
`(slooP::sloop while ,test do ,@ body)) |
12 |
(defmacro f (op x y) |
(defmacro f (op x y) |
13 |
`(the ,(if (get op 'compiler::predicate) 't 'fixnum) |
`(the ,(if (get op 'compiler::predicate) 't 'fixnum) |
14 |
(,op (the fixnum ,x) (the fixnum ,y))))) |
(,op (the fixnum ,x) (the fixnum ,y)))) |
15 |
|
(defmacro fcr (x) `(load-time-value (compile-regexp ,x)))) |
16 |
|
|
17 |
(eval-when (compile eval load) |
(eval-when (compile eval load) |
18 |
(defun sharp-u-reader (stream subchar arg) |
(defun sharp-u-reader (stream subchar arg) |
32 |
(vector-push-extend ch tem))) |
(vector-push-extend ch tem))) |
33 |
tem)) |
tem)) |
34 |
|
|
|
|
|
35 |
(set-dispatch-macro-character #\# #\u 'sharp-u-reader) |
(set-dispatch-macro-character #\# #\u 'sharp-u-reader) |
36 |
|
|
37 |
) |
) |
38 |
|
|
39 |
|
(defconstant +crlu+ (compile-regexp #u"")) |
40 |
|
(defconstant +crnp+ (compile-regexp #u"[]")) |
41 |
|
|
42 |
(defvar *info-data* nil) |
(defvar *info-data* nil) |
43 |
(defvar *current-info-data* nil) |
(defvar *current-info-data* nil) |
44 |
|
|
71 |
(declare (fixnum lim)) |
(declare (fixnum lim)) |
72 |
(let ((s (file-to-string file)) (i 0)) |
(let ((s (file-to-string file)) (i 0)) |
73 |
(declare (fixnum i) (string s)) |
(declare (fixnum i) (string s)) |
74 |
(cond ((f >= (string-match #u"[\n]+Indirect:" s 0) 0) |
(cond ((f >= (string-match (fcr #u"[\n]+Indirect:") s 0) 0) |
75 |
(setq i (match-end 0)) |
(setq i (match-end 0)) |
76 |
(setq lim (string-match #u"" s i)) |
(setq lim (string-match +crlu+ s i)) |
77 |
(while |
(while |
78 |
(f >= (string-match #u"\n([^\n]+): ([0-9]+)" s i lim) 0) |
(f >= (string-match (fcr #u"\n([^\n]+): ([0-9]+)") s i lim) 0) |
79 |
(setq i (match-end 0)) |
(setq i (match-end 0)) |
80 |
(setq files |
(setq files |
81 |
(cons(cons |
(cons(cons |
83 |
(get-match s 1) |
(get-match s 1) |
84 |
) |
) |
85 |
files))))) |
files))))) |
86 |
(cond ((f >= (si::string-match #u"[\n]+Tag Table:" s i) 0) |
(cond ((f >= (si::string-match (fcr #u"[\n]+Tag Table:") s i) 0) |
87 |
(setq i (si::match-end 0)) |
(setq i (si::match-end 0)) |
88 |
(cond ((f >= (si::string-match "" s i) 0) |
(cond ((f >= (si::string-match +crlu+ s i) 0) |
89 |
(setq tags (subseq s i (si::match-end 0))))))) |
(setq tags (subseq s i (si::match-end 0))))))) |
90 |
(if files (or tags (info-error "Need tags if have multiple files"))) |
(if files (or tags (info-error "Need tags if have multiple files"))) |
91 |
(list* tags (nreverse files)))) |
(list* tags (nreverse files)))) |
92 |
|
|
93 |
(defun re-quote-string (x &aux (i 0) (len (length x)) ch |
(defun re-quote-string (x &aux (i 0) ch (extra 0)) |
94 |
(extra 0) ) |
(declare (fixnum i extra)) |
95 |
(declare (fixnum i len extra)) |
(let ((x (if (stringp x) x (string x)))) |
96 |
(declare (string x)) |
(declare (string x)) |
97 |
(let (tem) |
(let (tem (len (length x))) |
98 |
(tagbody |
(declare (fixnum len)) |
99 |
AGAIN |
(tagbody |
100 |
(while (< i len) |
AGAIN |
101 |
(setq ch (aref x i)) |
(while (< i len) |
102 |
(cond ((position ch "\\()[]+.*|^$?") |
(setq ch (aref x i)) |
103 |
(cond (tem |
(cond ((position ch "\\()[]+.*|^$?") |
104 |
(vector-push-extend #\\ tem)) |
(cond (tem |
105 |
(t (incf extra))))) |
(vector-push-extend #\\ tem)) |
106 |
(if tem |
(t (incf extra))))) |
107 |
(vector-push-extend ch tem)) |
(if tem |
108 |
(setq i (+ i 1))) |
(vector-push-extend ch tem)) |
109 |
(cond (tem ) |
(setq i (+ i 1))) |
110 |
((> extra 0) |
(cond (tem ) |
111 |
(setq tem |
((> extra 0) |
112 |
(make-array (f + (length x) extra) |
(setq tem |
113 |
:element-type 'string-char :fill-pointer 0)) |
(make-array (f + (length x) extra) |
114 |
(setq i 0) |
:element-type 'string-char :fill-pointer 0)) |
115 |
(go AGAIN)) |
(setq i 0) |
116 |
(t (setq tem x))) |
(go AGAIN)) |
117 |
) |
(t (setq tem x))) |
118 |
tem)) |
) |
119 |
|
tem))) |
120 |
|
|
121 |
(defun get-match (string i) |
(defun get-match (string i) |
122 |
(subseq string (match-beginning i) (match-end i))) |
(subseq string (match-beginning i) (match-end i))) |
297 |
(let* ((info-subfile (info-subfile n)) |
(let* ((info-subfile (info-subfile n)) |
298 |
(s (info-get-file (cdr info-subfile))) |
(s (info-get-file (cdr info-subfile))) |
299 |
(end (- n (car info-subfile)))) |
(end (- n (car info-subfile)))) |
300 |
(while (f >= (string-match #u"" s i end) 0) |
(while (f >= (string-match +crlu+ s i end) 0) |
301 |
(setq i (match-end 0))) |
(setq i (match-end 0))) |
302 |
(setq i (- i 1)) |
(setq i (- i 1)) |
303 |
(if (f >= (string-match |
(if (f >= (string-match |
304 |
#u"[\n][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n" s i) 0) |
(fcr #u"[\n][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n") s i) 0) |
305 |
(let* ((i (match-beginning 0)) |
(let* ((i (match-beginning 0)) |
306 |
(beg (match-end 0)) |
(beg (match-end 0)) |
307 |
(name (get-match s 1)) |
(name (get-match s 1)) |
308 |
(end(if (f >= (string-match "[]" s beg) 0) |
(end(if (f >= (string-match +crnp+ s beg) 0) |
309 |
(match-beginning 0) |
(match-beginning 0) |
310 |
(length s))) |
(length s))) |
311 |
(node (list* s beg end i name info-subfile |
(node (list* s beg end i name info-subfile |
331 |
(setq position-pattern (car name) name (cdr name))))) |
(setq position-pattern (car name) name (cdr name))))) |
332 |
(or (stringp name) (info-error "bad arg")) |
(or (stringp name) (info-error "bad arg")) |
333 |
(waiting *info-window*) |
(waiting *info-window*) |
334 |
(cond ((f >= (string-match "^\\(([^(]+)\\)([^)]*)" name) 0) |
(cond ((f >= (string-match (fcr "^\\(([^(]+)\\)([^)]*)") name) 0) |
335 |
;; (file)node |
;; (file)node |
336 |
(setq file (get-match name 1)) |
(setq file (get-match name 1)) |
337 |
(setq name (get-match name 2)) |
(setq name (get-match name 2)) |
356 |
s start) 0) |
s start) 0) |
357 |
(let* ((i (match-beginning 0)) |
(let* ((i (match-beginning 0)) |
358 |
(beg (match-end 0)) |
(beg (match-end 0)) |
359 |
(end(if (f >= (string-match "[]" s beg) 0) |
(end(if (f >= (string-match +crnp+ s beg) 0) |
360 |
(match-beginning 0) |
(match-beginning 0) |
361 |
(length s))) |
(length s))) |
362 |
(node (list* s beg end i name info-subfile |
(node (list* s beg end i name info-subfile |
371 |
(f >= (setq subnode |
(f >= (setq subnode |
372 |
(string-match |
(string-match |
373 |
(si::string-concatenate |
(si::string-concatenate |
374 |
#u"\n - [A-Za-z ]+: " |
#u"\n -+ [A-Za-z ]+: " |
375 |
position-pattern #u"[ \n]") |
position-pattern #u"[ \n]") |
376 |
s beg end)) 0) |
s beg end)) 0) |
377 |
(f >= (string-match position-pattern s beg end) 0)) |
(f >= (string-match position-pattern s beg end) 0)) |
386 |
(let ((e |
(let ((e |
387 |
(if (and (>= subnode 0) |
(if (and (>= subnode 0) |
388 |
(f >= |
(f >= |
389 |
(string-match #u"\n\n - [A-Z]" |
(string-match |
390 |
s (+ beg 1 |
(fcr #u"\n -+ [a-zA-Z]") |
391 |
initial-offset) |
s |
392 |
|
(let* ((bg (+ beg 1 initial-offset)) |
393 |
|
(sd (string-match (fcr #u"\n ") s bg end)) |
394 |
|
(nb (if (minusp sd) bg sd))) |
395 |
|
nb) |
396 |
end) |
end) |
397 |
0)) |
0)) |
398 |
(match-beginning 0) |
(match-beginning 0) |