Mercurial > emacs

comparison lisp/informat.el @ 18422:96deedadd2f0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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))))