Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndoc.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 4be1180a9e89
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; nndoc.el --- single file access for Gnus 1 ;;; nndoc.el --- single file access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news 6 ;; Keywords: news
7 7
51 (article-begin . "^Path:")) 51 (article-begin . "^Path:"))
52 (rnews 52 (rnews
53 (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") 53 (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
54 (body-end-function . nndoc-rnews-body-end)) 54 (body-end-function . nndoc-rnews-body-end))
55 (mbox 55 (mbox
56 (article-begin . "^From \\([^ \n]*\\(\\|\".*\"[^ \n]*\\)\\) ?\\([^ \n]*\\) *\\([^ ]*\\) *\\([0-9]*\\) *\\([0-9:]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) * [0-9][0-9]\\([0-9]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) *\\(remote from .*\\)?\n")
57 (article-begin-function . nndoc-mbox-article-begin) 56 (article-begin-function . nndoc-mbox-article-begin)
58 (body-end-function . nndoc-mbox-body-end)) 57 (body-end-function . nndoc-mbox-body-end))
59 (babyl 58 (babyl
60 (article-begin . "\^_\^L *\n") 59 (article-begin . "\^_\^L *\n")
61 (body-end . "\^_") 60 (body-end . "\^_")
62 (body-begin-function . nndoc-babyl-body-begin) 61 (body-begin-function . nndoc-babyl-body-begin)
63 (head-begin-function . nndoc-babyl-head-begin)) 62 (head-begin-function . nndoc-babyl-head-begin))
64 (forward 63 (forward
65 (article-begin . "^-+ Start of forwarded message -+\n+") 64 (article-begin . "^-+ Start of forwarded message -+\n+")
66 (body-end . "^-+ End of forwarded message -+$") 65 (body-end . "^-+ End of forwarded message -+$")
67 (prepare-body . nndoc-unquote-dashes)) 66 (prepare-body-function . nndoc-unquote-dashes))
68 (clari-briefs 67 (clari-briefs
69 (article-begin . "^ \\*") 68 (article-begin . "^ \\*")
70 (body-end . "^\t------*[ \t]^*\n^ \\*") 69 (body-end . "^\t------*[ \t]^*\n^ \\*")
71 (body-begin . "^\t") 70 (body-begin . "^\t")
72 (head-end . "^\t") 71 (head-end . "^\t")
73 (generate-head . nndoc-generate-clari-briefs-head) 72 (generate-head-function . nndoc-generate-clari-briefs-head)
74 (article-transform . nndoc-transform-clari-briefs)) 73 (article-transform-function . nndoc-transform-clari-briefs))
74 (mime-digest
75 (article-begin . "")
76 (head-end . "^ ?$")
77 (body-end . "")
78 (file-end . "")
79 (subtype digest guess))
80 (standard-digest
81 (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
82 (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+"))
83 (prepare-body-function . nndoc-unquote-dashes)
84 (body-end-function . nndoc-digest-body-end)
85 (head-end . "^ ?$")
86 (body-begin . "^ ?\n")
87 (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
88 (subtype digest guess))
75 (slack-digest 89 (slack-digest
76 (article-begin . "^------------------------------*[\n \t]+") 90 (article-begin . "^------------------------------*[\n \t]+")
77 (head-end . "^ ?$") 91 (head-end . "^ ?$")
78 (body-end-function . nndoc-digest-body-end) 92 (body-end-function . nndoc-digest-body-end)
79 (body-begin . "^ ?$") 93 (body-begin . "^ ?$")
80 (file-end . "^End of") 94 (file-end . "^End of")
81 (prepare-body . nndoc-unquote-dashes)) 95 (prepare-body-function . nndoc-unquote-dashes)
82 (mime-digest 96 (subtype digest guess))
83 (article-begin . "") 97 (lanl-gov-announce
84 (head-end . "^ ?$") 98 (article-begin . "^\\\\\\\\\n")
85 (body-end . "") 99 (head-begin . "^Paper.*:")
86 (file-end . "")) 100 (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
87 (standard-digest 101 (body-begin . "")
88 (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) 102 (body-end . "-------------------------------------------------")
89 (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) 103 (file-end . "^Title: Recent Seminal")
90 (prepare-body . nndoc-unquote-dashes) 104 (generate-head-function . nndoc-generate-lanl-gov-head)
91 (body-end-function . nndoc-digest-body-end) 105 (article-transform-function . nndoc-transform-lanl-gov-announce)
92 (head-end . "^ ?$") 106 (subtype preprints guess))
93 (body-begin . "^ ?\n")
94 (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$"))
95 (guess 107 (guess
96 (guess . nndoc-guess-type)) 108 (guess . t)
109 (subtype nil))
97 (digest 110 (digest
98 (guess . nndoc-guess-digest-type)) 111 (guess . t)
112 (subtype nil))
113 (preprints
114 (guess . t)
115 (subtype nil))
99 )) 116 ))
100 117
101 118
102 119
103 (defvoo nndoc-file-begin nil) 120 (defvoo nndoc-file-begin nil)
104 (defvoo nndoc-first-article nil) 121 (defvoo nndoc-first-article nil)
105 (defvoo nndoc-article-end nil) 122 (defvoo nndoc-article-end nil)
106 (defvoo nndoc-article-begin nil) 123 (defvoo nndoc-article-begin nil)
107 (defvoo nndoc-article-begin-function nil)
108 (defvoo nndoc-head-begin nil) 124 (defvoo nndoc-head-begin nil)
109 (defvoo nndoc-head-end nil) 125 (defvoo nndoc-head-end nil)
110 (defvoo nndoc-file-end nil) 126 (defvoo nndoc-file-end nil)
111 (defvoo nndoc-body-begin nil) 127 (defvoo nndoc-body-begin nil)
112 (defvoo nndoc-body-end-function nil) 128 (defvoo nndoc-body-end-function nil)
113 (defvoo nndoc-body-begin-function nil) 129 (defvoo nndoc-body-begin-function nil)
114 (defvoo nndoc-head-begin-function nil) 130 (defvoo nndoc-head-begin-function nil)
115 (defvoo nndoc-body-end nil) 131 (defvoo nndoc-body-end nil)
116 (defvoo nndoc-dissection-alist nil) 132 (defvoo nndoc-dissection-alist nil)
117 (defvoo nndoc-prepare-body nil) 133 (defvoo nndoc-prepare-body-function nil)
118 (defvoo nndoc-generate-head nil) 134 (defvoo nndoc-generate-head-function nil)
119 (defvoo nndoc-article-transform nil) 135 (defvoo nndoc-article-transform-function nil)
136 (defvoo nndoc-article-begin-function nil)
120 137
121 (defvoo nndoc-status-string "") 138 (defvoo nndoc-status-string "")
122 (defvoo nndoc-group-alist nil) 139 (defvoo nndoc-group-alist nil)
123 (defvoo nndoc-current-buffer nil 140 (defvoo nndoc-current-buffer nil
124 "Current nndoc news buffer.") 141 "Current nndoc news buffer.")
143 'headers 160 'headers
144 (while articles 161 (while articles
145 (when (setq entry (cdr (assq (setq article (pop articles)) 162 (when (setq entry (cdr (assq (setq article (pop articles))
146 nndoc-dissection-alist))) 163 nndoc-dissection-alist)))
147 (insert (format "221 %d Article retrieved.\n" article)) 164 (insert (format "221 %d Article retrieved.\n" article))
148 (if nndoc-generate-head 165 (if nndoc-generate-head-function
149 (funcall nndoc-generate-head article) 166 (funcall nndoc-generate-head-function article)
150 (insert-buffer-substring 167 (insert-buffer-substring
151 nndoc-current-buffer (car entry) (nth 1 entry))) 168 nndoc-current-buffer (car entry) (nth 1 entry)))
152 (goto-char (point-max)) 169 (goto-char (point-max))
153 (or (= (char-after (1- (point))) ?\n) (insert "\n")) 170 (unless (= (char-after (1- (point))) ?\n)
171 (insert "\n"))
154 (insert (format "Lines: %d\n" (nth 4 entry))) 172 (insert (format "Lines: %d\n" (nth 4 entry)))
155 (insert ".\n"))) 173 (insert ".\n")))
156 174
157 (nnheader-fold-continuation-lines) 175 (nnheader-fold-continuation-lines)
158 'headers))))) 176 'headers)))))
163 (let ((buffer (or buffer nntp-server-buffer)) 181 (let ((buffer (or buffer nntp-server-buffer))
164 (entry (cdr (assq article nndoc-dissection-alist))) 182 (entry (cdr (assq article nndoc-dissection-alist)))
165 beg) 183 beg)
166 (set-buffer buffer) 184 (set-buffer buffer)
167 (erase-buffer) 185 (erase-buffer)
168 (if (stringp article) 186 (when entry
169 nil 187 (if (stringp article)
170 (insert-buffer-substring 188 nil
171 nndoc-current-buffer (car entry) (nth 1 entry)) 189 (insert-buffer-substring
172 (insert "\n") 190 nndoc-current-buffer (car entry) (nth 1 entry))
173 (setq beg (point)) 191 (insert "\n")
174 (insert-buffer-substring 192 (setq beg (point))
175 nndoc-current-buffer (nth 2 entry) (nth 3 entry)) 193 (insert-buffer-substring
176 (goto-char beg) 194 nndoc-current-buffer (nth 2 entry) (nth 3 entry))
177 (when nndoc-prepare-body 195 (goto-char beg)
178 (funcall nndoc-prepare-body)) 196 (when nndoc-prepare-body-function
179 (when nndoc-article-transform 197 (funcall nndoc-prepare-body-function))
180 (funcall nndoc-article-transform article)) 198 (when nndoc-article-transform-function
181 t)))) 199 (funcall nndoc-article-transform-function article))
200 t)))))
182 201
183 (deffoo nndoc-request-group (group &optional server dont-check) 202 (deffoo nndoc-request-group (group &optional server dont-check)
184 "Select news GROUP." 203 "Select news GROUP."
185 (let (number) 204 (let (number)
186 (cond 205 (cond
251 (save-excursion 270 (save-excursion
252 (set-buffer nndoc-current-buffer) 271 (set-buffer nndoc-current-buffer)
253 (buffer-disable-undo (current-buffer)) 272 (buffer-disable-undo (current-buffer))
254 (erase-buffer) 273 (erase-buffer)
255 (if (stringp nndoc-address) 274 (if (stringp nndoc-address)
256 (insert-file-contents nndoc-address) 275 (nnheader-insert-file-contents nndoc-address)
257 (insert-buffer-substring nndoc-address))))) 276 (insert-buffer-substring nndoc-address)))))
258 ;; Initialize the nndoc structures according to this new document. 277 ;; Initialize the nndoc structures according to this new document.
259 (when (and nndoc-current-buffer 278 (when (and nndoc-current-buffer
260 (not nndoc-dissection-alist)) 279 (not nndoc-dissection-alist))
261 (save-excursion 280 (save-excursion
265 (unless nndoc-current-buffer 284 (unless nndoc-current-buffer
266 (nndoc-close-server)) 285 (nndoc-close-server))
267 ;; Return whether we managed to select a file. 286 ;; Return whether we managed to select a file.
268 nndoc-current-buffer)) 287 nndoc-current-buffer))
269 288
270 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>. 289 ;;;
271 (defun nndoc-guess-digest-type () 290 ;;; Deciding what document type we have
272 "Guess what digest type the current document is." 291 ;;;
273 (let ((case-fold-search t) ; We match a bit too much, keep it simple.
274 boundary-id b-delimiter entry)
275 (goto-char (point-min))
276 (cond
277 ;; MIME digest.
278 ((and
279 (re-search-forward
280 (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
281 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
282 nil t)
283 (match-beginning 1))
284 (setq boundary-id (match-string 1)
285 b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
286 (setq entry (assq 'mime-digest nndoc-type-alist))
287 (setcdr entry
288 (list
289 (cons 'head-end "^ ?$")
290 (cons 'body-begin "^ ?\n")
291 (cons 'article-begin b-delimiter)
292 (cons 'body-end-function 'nndoc-digest-body-end)
293 ; (cons 'body-end
294 ; (concat "\n--" boundary-id "\\(--\\)?[\n \t]+"))
295 (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
296 'mime-digest)
297 ;; Standard digest.
298 ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
299 (re-search-forward
300 (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
301 'standard-digest)
302 ;; Stupid digest.
303 (t
304 'slack-digest))))
305
306 (defun nndoc-guess-type ()
307 "Guess what document type is in the current buffer."
308 (goto-char (point-min))
309 (cond
310 ((looking-at message-unix-mail-delimiter)
311 'mbox)
312 ((looking-at "\^A\^A\^A\^A$")
313 'mmdf)
314 ((looking-at "^Path:.*\n")
315 'news)
316 ((looking-at "#! *rnews")
317 'rnews)
318 ((re-search-forward "\^_\^L *\n" nil t)
319 'babyl)
320 ((save-excursion
321 (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
322 (not (re-search-forward "^Subject:.*digest" nil t))))
323 'forward)
324 ((let ((case-fold-search nil))
325 (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
326 'clari-briefs)
327 (t
328 'digest)))
329 292
330 (defun nndoc-set-delims () 293 (defun nndoc-set-delims ()
331 "Set the nndoc delimiter variables according to the type of the document." 294 "Set the nndoc delimiter variables according to the type of the document."
332 (let ((vars '(nndoc-file-begin 295 (let ((vars '(nndoc-file-begin
333 nndoc-first-article 296 nndoc-first-article
334 nndoc-article-end nndoc-head-begin nndoc-head-end 297 nndoc-article-end nndoc-head-begin nndoc-head-end
335 nndoc-file-end nndoc-article-begin 298 nndoc-file-end nndoc-article-begin
336 nndoc-body-begin nndoc-body-end-function nndoc-body-end 299 nndoc-body-begin nndoc-body-end-function nndoc-body-end
337 nndoc-prepare-body nndoc-article-transform 300 nndoc-prepare-body-function nndoc-article-transform-function
338 nndoc-generate-head nndoc-body-begin-function 301 nndoc-generate-head-function nndoc-body-begin-function
339 nndoc-head-begin-function nndoc-article-begin-function))) 302 nndoc-head-begin-function)))
340 (while vars 303 (while vars
341 (set (pop vars) nil))) 304 (set (pop vars) nil)))
342 (let* (defs guess) 305 (let (defs)
343 ;; Guess away until we find the real file type. 306 ;; Guess away until we find the real file type.
344 (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)) 307 (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
345 guess (assq 'guess defs)) 308 nndoc-type-alist))))
346 (setq nndoc-article-type (funcall (cdr guess)))) 309 (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
347 ;; Set the nndoc variables. 310 ;; Set the nndoc variables.
348 (while defs 311 (while defs
349 (set (intern (format "nndoc-%s" (caar defs))) 312 (set (intern (format "nndoc-%s" (caar defs)))
350 (cdr (pop defs)))))) 313 (cdr (pop defs))))))
351 314
352 (defun nndoc-search (regexp) 315 (defun nndoc-guess-type (subtype)
353 (prog1 316 (let ((alist nndoc-type-alist)
354 (re-search-forward regexp nil t) 317 results result entry)
355 (beginning-of-line))) 318 (while (and (not result)
356 319 (setq entry (pop alist)))
357 (defun nndoc-dissect-buffer () 320 (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
358 "Go through the document and partition it into heads/bodies/articles." 321 (goto-char (point-min))
359 (let ((i 0) 322 (when (numberp (setq result (funcall (intern
360 (first t) 323 (format "nndoc-%s-type-p"
361 head-begin head-end body-begin body-end) 324 (car entry))))))
362 (setq nndoc-dissection-alist nil) 325 (push (cons result entry) results)
363 (save-excursion 326 (setq result nil))))
364 (set-buffer nndoc-current-buffer) 327 (unless (or result results)
365 (goto-char (point-min)) 328 (error "Document is not of any recognized type"))
366 ;; Find the beginning of the file. 329 (if result
367 (when nndoc-file-begin 330 (car entry)
368 (nndoc-search nndoc-file-begin)) 331 (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
369 ;; Go through the file. 332
370 (while (if (and first nndoc-first-article) 333 ;;;
371 (nndoc-search nndoc-first-article) 334 ;;; Built-in type predicates and functions
372 (if nndoc-article-begin-function 335 ;;;
373 (funcall nndoc-article-begin-function) 336
374 (nndoc-search nndoc-article-begin))) 337 (defun nndoc-mbox-type-p ()
375 (setq first nil) 338 (when (looking-at message-unix-mail-delimiter)
376 (cond (nndoc-head-begin-function 339 t))
377 (funcall nndoc-head-begin-function))
378 (nndoc-head-begin
379 (nndoc-search nndoc-head-begin)))
380 (if (and nndoc-file-end
381 (looking-at nndoc-file-end))
382 (goto-char (point-max))
383 (setq head-begin (point))
384 (nndoc-search (or nndoc-head-end "^$"))
385 (setq head-end (point))
386 (if nndoc-body-begin-function
387 (funcall nndoc-body-begin-function)
388 (nndoc-search (or nndoc-body-begin "^\n")))
389 (setq body-begin (point))
390 (or (and nndoc-body-end-function
391 (funcall nndoc-body-end-function))
392 (and nndoc-body-end
393 (nndoc-search nndoc-body-end))
394 (if nndoc-article-begin-function
395 (funcall nndoc-article-begin-function)
396 (nndoc-search nndoc-article-begin))
397 (progn
398 (goto-char (point-max))
399 (when nndoc-file-end
400 (and (re-search-backward nndoc-file-end nil t)
401 (beginning-of-line)))))
402 (setq body-end (point))
403 (push (list (incf i) head-begin head-end body-begin body-end
404 (count-lines body-begin body-end))
405 nndoc-dissection-alist))))))
406
407 (defun nndoc-unquote-dashes ()
408 "Unquote quoted non-separators in digests."
409 (while (re-search-forward "^- -"nil t)
410 (replace-match "-" t t)))
411
412 (defun nndoc-digest-body-end ()
413 (and (re-search-forward nndoc-article-begin nil t)
414 (goto-char (match-beginning 0))))
415 340
416 (defun nndoc-mbox-article-begin () 341 (defun nndoc-mbox-article-begin ()
417 (when (re-search-forward nndoc-article-begin nil t) 342 (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
418 (goto-char (match-beginning 0)))) 343 (goto-char (match-beginning 0))))
419 344
420 (defun nndoc-mbox-body-end () 345 (defun nndoc-mbox-body-end ()
421 (let ((beg (point)) 346 (let ((beg (point))
422 len end) 347 len end)
423 (when 348 (when
424 (save-excursion 349 (save-excursion
425 (and (re-search-backward nndoc-article-begin nil t) 350 (and (re-search-backward
351 (concat "^" message-unix-mail-delimiter) nil t)
426 (setq end (point)) 352 (setq end (point))
427 (search-forward "\n\n" beg t) 353 (search-forward "\n\n" beg t)
428 (re-search-backward 354 (re-search-backward
429 "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) 355 "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
430 (setq len (string-to-int (match-string 1))) 356 (setq len (string-to-int (match-string 1)))
431 (search-forward "\n\n" beg t) 357 (search-forward "\n\n" beg t)
432 (or (= (setq len (+ (point) len)) (point-max)) 358 (unless (= (setq len (+ (point) len)) (point-max))
433 (and (< len (point-max)) 359 (and (< len (point-max))
434 (goto-char len) 360 (goto-char len)
435 (looking-at nndoc-article-begin))))) 361 (looking-at message-unix-mail-delimiter)))))
436 (goto-char len)))) 362 (goto-char len))))
363
364 (defun nndoc-mmdf-type-p ()
365 (when (looking-at "\^A\^A\^A\^A$")
366 t))
367
368 (defun nndoc-news-type-p ()
369 (when (looking-at "^Path:.*\n")
370 t))
371
372 (defun nndoc-rnews-type-p ()
373 (when (looking-at "#! *rnews")
374 t))
437 375
438 (defun nndoc-rnews-body-end () 376 (defun nndoc-rnews-body-end ()
439 (and (re-search-backward nndoc-article-begin nil t) 377 (and (re-search-backward nndoc-article-begin nil t)
440 (forward-line 1) 378 (forward-line 1)
441 (goto-char (+ (point) (string-to-int (match-string 1)))))) 379 (goto-char (+ (point) (string-to-int (match-string 1))))))
380
381 (defun nndoc-babyl-type-p ()
382 (when (re-search-forward "\^_\^L *\n" nil t)
383 t))
384
385 (defun nndoc-babyl-body-begin ()
386 (re-search-forward "^\n" nil t)
387 (when (looking-at "\*\*\* EOOH \*\*\*")
388 (let ((next (or (save-excursion
389 (re-search-forward nndoc-article-begin nil t))
390 (point-max))))
391 (unless (re-search-forward "^\n" next t)
392 (goto-char next)
393 (forward-line -1)
394 (insert "\n")
395 (forward-line -1)))))
396
397 (defun nndoc-babyl-head-begin ()
398 (when (re-search-forward "^[0-9].*\n" nil t)
399 (when (looking-at "\*\*\* EOOH \*\*\*")
400 (forward-line 1))
401 t))
402
403 (defun nndoc-forward-type-p ()
404 (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
405 (not (re-search-forward "^Subject:.*digest" nil t))
406 (not (re-search-backward "^From:" nil t 2))
407 (not (re-search-forward "^From:" nil t 2)))
408 t))
409
410 (defun nndoc-clari-briefs-type-p ()
411 (when (let ((case-fold-search nil))
412 (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
413 t))
442 414
443 (defun nndoc-transform-clari-briefs (article) 415 (defun nndoc-transform-clari-briefs (article)
444 (goto-char (point-min)) 416 (goto-char (point-min))
445 (when (looking-at " *\\*\\(.*\\)\n") 417 (when (looking-at " *\\*\\(.*\\)\n")
446 (replace-match "" t t)) 418 (replace-match "" t t))
464 "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) 436 "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
465 (setq from (match-string 1))))) 437 (setq from (match-string 1)))))
466 (insert "From: " "clari@clari.net (" (or from "unknown") ")" 438 (insert "From: " "clari@clari.net (" (or from "unknown") ")"
467 "\nSubject: " (or subject "(no subject)") "\n"))) 439 "\nSubject: " (or subject "(no subject)") "\n")))
468 440
469 (defun nndoc-babyl-body-begin () 441 (defun nndoc-mime-digest-type-p ()
470 (re-search-forward "^\n" nil t) 442 (let ((case-fold-search t)
471 (when (looking-at "\*\*\* EOOH \*\*\*") 443 boundary-id b-delimiter entry)
472 (re-search-forward "^\n" nil t))) 444 (when (and
473 445 (re-search-forward
474 (defun nndoc-babyl-head-begin () 446 (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
475 (when (re-search-forward "^[0-9].*\n" nil t) 447 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
476 (when (looking-at "\*\*\* EOOH \*\*\*") 448 nil t)
477 (forward-line 1)) 449 (match-beginning 1))
478 t)) 450 (setq boundary-id (match-string 1)
451 b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
452 (setq entry (assq 'mime-digest nndoc-type-alist))
453 (setcdr entry
454 (list
455 (cons 'head-end "^ ?$")
456 (cons 'body-begin "^ ?\n")
457 (cons 'article-begin b-delimiter)
458 (cons 'body-end-function 'nndoc-digest-body-end)
459 (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
460 t)))
461
462 (defun nndoc-standard-digest-type-p ()
463 (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
464 (re-search-forward
465 (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
466 t))
467
468 (defun nndoc-digest-body-end ()
469 (and (re-search-forward nndoc-article-begin nil t)
470 (goto-char (match-beginning 0))))
471
472 (defun nndoc-slack-digest-type-p ()
473 0)
474
475 (defun nndoc-lanl-gov-announce-type-p ()
476 (when (let ((case-fold-search nil))
477 (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
478 t))
479
480 (defun nndoc-transform-lanl-gov-announce (article)
481 (goto-char (point-max))
482 (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
483 (replace-match "\n\nGet it at \\1 (\\2)" t nil))
484 ;; (when (re-search-backward "^\\\\\\\\$" nil t)
485 ;; (replace-match "" t t))
486 )
487
488 (defun nndoc-generate-lanl-gov-head (article)
489 (let ((entry (cdr (assq article nndoc-dissection-alist)))
490 (e-mail "no address given")
491 subject from)
492 (save-excursion
493 (set-buffer nndoc-current-buffer)
494 (save-restriction
495 (narrow-to-region (car entry) (nth 1 entry))
496 (goto-char (point-min))
497 (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
498 (setq subject (concat " (" (match-string 1) ")"))
499 (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
500 (setq e-mail (match-string 1)))
501 (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
502 nil t)
503 (setq subject (concat (match-string 1) subject))
504 (setq from (concat (match-string 2) " <" e-mail ">"))))
505 ))
506 (while (and from (string-match "(\[^)\]*)" from))
507 (setq from (replace-match "" t t from)))
508 (insert "From: " (or from "unknown")
509 "\nSubject: " (or subject "(no subject)") "\n")))
510
511
512
513 ;;;
514 ;;; Functions for dissecting the documents
515 ;;;
516
517 (defun nndoc-search (regexp)
518 (prog1
519 (re-search-forward regexp nil t)
520 (beginning-of-line)))
521
522 (defun nndoc-dissect-buffer ()
523 "Go through the document and partition it into heads/bodies/articles."
524 (let ((i 0)
525 (first t)
526 head-begin head-end body-begin body-end)
527 (setq nndoc-dissection-alist nil)
528 (save-excursion
529 (set-buffer nndoc-current-buffer)
530 (goto-char (point-min))
531 ;; Find the beginning of the file.
532 (when nndoc-file-begin
533 (nndoc-search nndoc-file-begin))
534 ;; Go through the file.
535 (while (if (and first nndoc-first-article)
536 (nndoc-search nndoc-first-article)
537 (nndoc-article-begin))
538 (setq first nil)
539 (cond (nndoc-head-begin-function
540 (funcall nndoc-head-begin-function))
541 (nndoc-head-begin
542 (nndoc-search nndoc-head-begin)))
543 (if (or (>= (point) (point-max))
544 (and nndoc-file-end
545 (looking-at nndoc-file-end)))
546 (goto-char (point-max))
547 (setq head-begin (point))
548 (nndoc-search (or nndoc-head-end "^$"))
549 (setq head-end (point))
550 (if nndoc-body-begin-function
551 (funcall nndoc-body-begin-function)
552 (nndoc-search (or nndoc-body-begin "^\n")))
553 (setq body-begin (point))
554 (or (and nndoc-body-end-function
555 (funcall nndoc-body-end-function))
556 (and nndoc-body-end
557 (nndoc-search nndoc-body-end))
558 (nndoc-article-begin)
559 (progn
560 (goto-char (point-max))
561 (when nndoc-file-end
562 (and (re-search-backward nndoc-file-end nil t)
563 (beginning-of-line)))))
564 (setq body-end (point))
565 (push (list (incf i) head-begin head-end body-begin body-end
566 (count-lines body-begin body-end))
567 nndoc-dissection-alist))))))
568
569 (defun nndoc-article-begin ()
570 (if nndoc-article-begin-function
571 (funcall nndoc-article-begin-function)
572 (ignore-errors
573 (nndoc-search nndoc-article-begin))))
574
575 (defun nndoc-unquote-dashes ()
576 "Unquote quoted non-separators in digests."
577 (while (re-search-forward "^- -"nil t)
578 (replace-match "-" t t)))
579
580 ;;;###autoload
581 (defun nndoc-add-type (definition &optional position)
582 "Add document DEFINITION to the list of nndoc document definitions.
583 If POSITION is nil or `last', the definition will be added
584 as the last checked definition, if t or `first', add as the
585 first definition, and if any other symbol, add after that
586 symbol in the alist."
587 ;; First remove any old instances.
588 (setq nndoc-type-alist
589 (delq (assq (car definition) nndoc-type-alist)
590 nndoc-type-alist))
591 ;; Then enter the new definition in the proper place.
592 (cond
593 ((or (null position) (eq position 'last))
594 (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
595 ((or (eq position t) (eq position 'first))
596 (push definition nndoc-type-alist))
597 (t
598 (let ((list (memq (assq position nndoc-type-alist)
599 nndoc-type-alist)))
600 (unless list
601 (error "No such position: %s" position))
602 (setcdr list (cons definition (cdr list)))))))
479 603
480 (provide 'nndoc) 604 (provide 'nndoc)
481 605
482 ;;; nndoc.el ends here 606 ;;; nndoc.el ends here