Mercurial > emacs
comparison lisp/informat.el @ 18422:96deedadd2f0
(Info-validate-allnodes): Variable renamed, defvar added.
(Info-validate-thisnode, Info-validate-lossages): Likewise.
Change all references.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 23 Jun 1997 19:10:51 +0000 |
parents | 11218164bc54 |
children | 5f67eacb5c04 |
comparison
equal
deleted
inserted
replaced
18421:618cc7b75c06 | 18422:96deedadd2f0 |
---|---|
151 (goto-char start) | 151 (goto-char start) |
152 (insert "\^_\nIndirect:\n") | 152 (insert "\^_\nIndirect:\n") |
153 (search-forward "\nTag Table:\n") | 153 (search-forward "\nTag Table:\n") |
154 (insert "(Indirect)\n"))) | 154 (insert "(Indirect)\n"))) |
155 | 155 |
156 (defvar Info-validate-allnodes) | |
157 (defvar Info-validate-thisnode) | |
158 (defvar Info-validate-lossages) | |
159 | |
156 ;;;###autoload | 160 ;;;###autoload |
157 (defun Info-validate () | 161 (defun Info-validate () |
158 "Check current buffer for validity as an Info file. | 162 "Check current buffer for validity as an Info file. |
159 Check that every node pointer points to an existing node." | 163 Check that every node pointer points to an existing node." |
160 (interactive) | 164 (interactive) |
164 (goto-char (point-min)) | 168 (goto-char (point-min)) |
165 (if (search-forward "\nTag table:\n(Indirect)\n" nil t) | 169 (if (search-forward "\nTag table:\n(Indirect)\n" nil t) |
166 (error "Don't yet know how to validate indirect info files: \"%s\"" | 170 (error "Don't yet know how to validate indirect info files: \"%s\"" |
167 (buffer-name (current-buffer)))) | 171 (buffer-name (current-buffer)))) |
168 (goto-char (point-min)) | 172 (goto-char (point-min)) |
169 (let ((allnodes '(("*"))) | 173 (let ((Info-validate-allnodes '(("*"))) |
170 (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") | 174 (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]") |
171 (case-fold-search t) | 175 (case-fold-search t) |
172 (tags-losing nil) | 176 (tags-losing nil) |
173 (lossages ())) | 177 (Info-validate-lossages ())) |
174 (while (search-forward "\n\^_" nil t) | 178 (while (search-forward "\n\^_" nil t) |
175 (forward-line 1) | 179 (forward-line 1) |
176 (let ((beg (point))) | 180 (let ((beg (point))) |
177 (forward-line 1) | 181 (forward-line 1) |
178 (if (re-search-backward regexp beg t) | 182 (if (re-search-backward regexp beg t) |
179 (let ((name (downcase | 183 (let ((name (downcase |
180 (buffer-substring-no-properties | 184 (buffer-substring-no-properties |
181 (match-beginning 1) | 185 (match-beginning 1) |
182 (progn | 186 (progn |
183 (goto-char (match-end 1)) | 187 (goto-char (match-end 1)) |
184 (skip-chars-backward " \t") | 188 (skip-chars-backward " \t") |
185 (point)))))) | 189 (point)))))) |
186 (if (assoc name allnodes) | 190 (if (assoc name Info-validate-allnodes) |
187 (setq lossages | 191 (setq Info-validate-lossages |
188 (cons (list name "Duplicate node-name" nil) | 192 (cons (list name "Duplicate node-name" nil) |
189 lossages)) | 193 Info-validate-lossages)) |
190 (setq allnodes | 194 (setq Info-validate-allnodes |
191 (cons (list name | 195 (cons (list name |
192 (progn | 196 (progn |
193 (end-of-line) | 197 (end-of-line) |
194 (and (re-search-backward | 198 (and (re-search-backward |
195 "prev[ious]*:" beg t) | 199 "prev[ious]*:" beg t) |
196 (progn | 200 (progn |
197 (goto-char (match-end 0)) | 201 (goto-char (match-end 0)) |
198 (downcase | 202 (downcase |
199 (Info-following-node-name))))) | 203 (Info-following-node-name))))) |
200 beg) | 204 beg) |
201 allnodes))))))) | 205 Info-validate-allnodes))))))) |
202 (goto-char (point-min)) | 206 (goto-char (point-min)) |
203 (while (search-forward "\n\^_" nil t) | 207 (while (search-forward "\n\^_" nil t) |
204 (forward-line 1) | 208 (forward-line 1) |
205 (let ((beg (point)) | 209 (let ((beg (point)) |
206 thisnode next) | 210 Info-validate-thisnode next) |
207 (forward-line 1) | 211 (forward-line 1) |
208 (if (re-search-backward regexp beg t) | 212 (if (re-search-backward regexp beg t) |
209 (save-restriction | 213 (save-restriction |
210 (search-forward "\n\^_" nil 'move) | 214 (search-forward "\n\^_" nil 'move) |
211 (narrow-to-region beg (point)) | 215 (narrow-to-region beg (point)) |
212 (setq thisnode (downcase | 216 (setq Info-validate-thisnode (downcase |
213 (buffer-substring-no-properties | 217 (buffer-substring-no-properties |
214 (match-beginning 1) | 218 (match-beginning 1) |
215 (progn | 219 (progn |
216 (goto-char (match-end 1)) | 220 (goto-char (match-end 1)) |
217 (skip-chars-backward " \t") | 221 (skip-chars-backward " \t") |
218 (point))))) | 222 (point))))) |
219 (end-of-line) | 223 (end-of-line) |
220 (and (search-backward "next:" nil t) | 224 (and (search-backward "next:" nil t) |
221 (setq next (Info-validate-node-name "invalid Next")) | 225 (setq next (Info-validate-node-name "invalid Next")) |
222 (assoc next allnodes) | 226 (assoc next Info-validate-allnodes) |
223 (if (equal (car (cdr (assoc next allnodes))) | 227 (if (equal (car (cdr (assoc next Info-validate-allnodes))) |
224 thisnode) | 228 Info-validate-thisnode) |
225 ;; allow multiple `next' pointers to one node | 229 ;; allow multiple `next' pointers to one node |
226 (let ((tem lossages)) | 230 (let ((tem Info-validate-lossages)) |
227 (while tem | 231 (while tem |
228 (if (and (equal (car (cdr (car tem))) | 232 (if (and (equal (car (cdr (car tem))) |
229 "should have Previous") | 233 "should have Previous") |
230 (equal (car (car tem)) | 234 (equal (car (car tem)) |
231 next)) | 235 next)) |
232 (setq lossages (delq (car tem) lossages))) | 236 (setq Info-validate-lossages |
237 (delq (car tem) Info-validate-lossages))) | |
233 (setq tem (cdr tem)))) | 238 (setq tem (cdr tem)))) |
234 (setq lossages | 239 (setq Info-validate-lossages |
235 (cons (list next | 240 (cons (list next |
236 "should have Previous" | 241 "should have Previous" |
237 thisnode) | 242 Info-validate-thisnode) |
238 lossages)))) | 243 Info-validate-lossages)))) |
239 (end-of-line) | 244 (end-of-line) |
240 (if (re-search-backward "prev[ious]*:" nil t) | 245 (if (re-search-backward "prev[ious]*:" nil t) |
241 (Info-validate-node-name "invalid Previous")) | 246 (Info-validate-node-name "invalid Previous")) |
242 (end-of-line) | 247 (end-of-line) |
243 (if (search-backward "up:" nil t) | 248 (if (search-backward "up:" nil t) |
244 (Info-validate-node-name "invalid Up")) | 249 (Info-validate-node-name "invalid Up")) |
245 (if (re-search-forward "\n* Menu:" nil t) | 250 (if (re-search-forward "\n* Menu:" nil t) |
246 (while (re-search-forward "\n\\* " nil t) | 251 (while (re-search-forward "\n\\* " nil t) |
247 (Info-validate-node-name | 252 (Info-validate-node-name |
248 (concat "invalid menu item " | 253 (concat "invalid menu item " |
249 (buffer-substring (point) | 254 (buffer-substring (point) |
250 (save-excursion | 255 (save-excursion |
251 (skip-chars-forward "^:") | 256 (skip-chars-forward "^:") |
252 (point)))) | 257 (point)))) |
253 (Info-extract-menu-node-name)))) | 258 (Info-extract-menu-node-name)))) |
254 (goto-char (point-min)) | 259 (goto-char (point-min)) |
255 (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) | 260 (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) |
256 (goto-char (+ (match-beginning 0) 5)) | 261 (goto-char (+ (match-beginning 0) 5)) |
257 (skip-chars-forward " \n") | 262 (skip-chars-forward " \n") |
258 (Info-validate-node-name | 263 (Info-validate-node-name |
261 (save-excursion | 266 (save-excursion |
262 (skip-chars-forward "^:") | 267 (skip-chars-forward "^:") |
263 (point)))) | 268 (point)))) |
264 (Info-extract-menu-node-name "Bad format cross-reference"))))))) | 269 (Info-extract-menu-node-name "Bad format cross-reference"))))))) |
265 (setq tags-losing (not (Info-validate-tags-table))) | 270 (setq tags-losing (not (Info-validate-tags-table))) |
266 (if (or lossages tags-losing) | 271 (if (or Info-validate-lossages tags-losing) |
267 (with-output-to-temp-buffer " *problems in info file*" | 272 (with-output-to-temp-buffer " *problems in info file*" |
268 (while lossages | 273 (while Info-validate-lossages |
269 (princ "In node \"") | 274 (princ "In node \"") |
270 (princ (car (car lossages))) | 275 (princ (car (car Info-validate-lossages))) |
271 (princ "\", ") | 276 (princ "\", ") |
272 (let ((tem (nth 1 (car lossages)))) | 277 (let ((tem (nth 1 (car Info-validate-lossages)))) |
273 (cond ((string-match "\n" tem) | 278 (cond ((string-match "\n" tem) |
274 (princ (substring tem 0 (match-beginning 0))) | 279 (princ (substring tem 0 (match-beginning 0))) |
275 (princ "...")) | 280 (princ "...")) |
276 (t | 281 (t |
277 (princ tem)))) | 282 (princ tem)))) |
278 (if (nth 2 (car lossages)) | 283 (if (nth 2 (car Info-validate-lossages)) |
279 (progn | 284 (progn |
280 (princ ": ") | 285 (princ ": ") |
281 (let ((tem (nth 2 (car lossages)))) | 286 (let ((tem (nth 2 (car Info-validate-lossages)))) |
282 (cond ((string-match "\n" tem) | 287 (cond ((string-match "\n" tem) |
283 (princ (substring tem 0 (match-beginning 0))) | 288 (princ (substring tem 0 (match-beginning 0))) |
284 (princ "...")) | 289 (princ "...")) |
285 (t | 290 (t |
286 (princ tem)))))) | 291 (princ tem)))))) |
287 (terpri) | 292 (terpri) |
288 (setq lossages (cdr lossages))) | 293 (setq Info-validate-lossages (cdr Info-validate-lossages))) |
289 (if tags-losing (princ "\nTags table must be recomputed\n"))) | 294 (if tags-losing (princ "\nTags table must be recomputed\n"))) |
290 ;; Here if info file is valid. | 295 ;; Here if info file is valid. |
291 ;; If we already made a list of problems, clear it out. | 296 ;; If we already made a list of problems, clear it out. |
292 (save-excursion | 297 (save-excursion |
293 (if (get-buffer " *problems in info file*") | 298 (if (get-buffer " *problems in info file*") |
305 nil | 310 nil |
306 (setq name | 311 (setq name |
307 (buffer-substring-no-properties | 312 (buffer-substring-no-properties |
308 (point) | 313 (point) |
309 (progn | 314 (progn |
310 (skip-chars-forward "^,\t\n") | 315 (skip-chars-forward "^,\t\n") |
311 (skip-chars-backward " ") | 316 (skip-chars-backward " ") |
312 (point)))))) | 317 (point)))))) |
313 (if (null name) | 318 (if (null name) |
314 nil | 319 nil |
315 (setq name (downcase name)) | 320 (setq name (downcase name)) |
316 (or (and (> (length name) 0) (= (aref name 0) ?\()) | 321 (or (and (> (length name) 0) (= (aref name 0) ?\()) |
317 (assoc name allnodes) | 322 (assoc name Info-validate-allnodes) |
318 (setq lossages | 323 (setq Info-validate-lossages |
319 (cons (list thisnode kind name) lossages)))) | 324 (cons (list Info-validate-thisnode kind name) |
325 Info-validate-lossages)))) | |
320 name) | 326 name) |
321 | 327 |
322 (defun Info-validate-tags-table () | 328 (defun Info-validate-tags-table () |
323 (goto-char (point-min)) | 329 (goto-char (point-min)) |
324 (if (not (search-forward "\^_\nEnd tag table\n" nil t)) | 330 (if (not (search-forward "\^_\nEnd tag table\n" nil t)) |
326 (not (catch 'losing | 332 (not (catch 'losing |
327 (let* ((end (match-beginning 0)) | 333 (let* ((end (match-beginning 0)) |
328 (start (progn (search-backward "\nTag table:\n") | 334 (start (progn (search-backward "\nTag table:\n") |
329 (1- (match-end 0)))) | 335 (1- (match-end 0)))) |
330 tem) | 336 tem) |
331 (setq tem allnodes) | 337 (setq tem Info-validate-allnodes) |
332 (while tem | 338 (while tem |
333 (goto-char start) | 339 (goto-char start) |
334 (or (equal (car (car tem)) "*") | 340 (or (equal (car (car tem)) "*") |
335 (search-forward (concat "Node: " | 341 (search-forward (concat "Node: " |
336 (car (car tem)) | 342 (car (car tem)) |
341 (goto-char (1+ start)) | 347 (goto-char (1+ start)) |
342 (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$") | 348 (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$") |
343 (setq tem (downcase (buffer-substring-no-properties | 349 (setq tem (downcase (buffer-substring-no-properties |
344 (match-beginning 1) | 350 (match-beginning 1) |
345 (match-end 1)))) | 351 (match-end 1)))) |
346 (setq tem (assoc tem allnodes)) | 352 (setq tem (assoc tem Info-validate-allnodes)) |
347 (if (or (not tem) | 353 (if (or (not tem) |
348 (< 1000 (progn | 354 (< 1000 (progn |
349 (goto-char (match-beginning 2)) | 355 (goto-char (match-beginning 2)) |
350 (setq tem (- (car (cdr (cdr tem))) | 356 (setq tem (- (car (cdr (cdr tem))) |
351 (read (current-buffer)))) | 357 (read (current-buffer)))) |