Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndoc.el @ 70:131b0175ea99 r20-0b30

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