xemacs-beta: lisp/gnus/nndoc.el comparison

comparison lisp/gnus/nndoc.el @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	1917ad0d78d7
children	d620409f5eb8

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 `clari-briefs' or `guess'.")
 (defvoo nndoc-post-type 'mail
 "*Whether the nndoc group is `mail' or `post'.")
 (defvar nndoc-type-alist
 `((mmdf
 (article-begin .  "^\^A\^A\^A\^A\n")
 (body-end .  "^\^A\^A\^A\^A\n"))
 (news
 (article-begin . "^Path:"))
 (rnews
 (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
 (body-end-function . nndoc-rnews-body-end))
 (mbox
 (article-begin-function . nndoc-mbox-article-begin)
 (body-end-function . nndoc-mbox-body-end))
 (babyl
 (article-begin . "\^_\^L *\n")
 (body-end . "\^_")
 (body-begin-function . nndoc-babyl-body-begin)
 (head-begin-function . nndoc-babyl-head-begin))
 (forward
 (body-end   . "-------------------------------------------------")
 (file-end   . "^Title: Recent Seminal")
 (generate-head-function . nndoc-generate-lanl-gov-head)
 (article-transform-function . nndoc-transform-lanl-gov-announce)
 (subtype preprints guess))
 (guess
 (guess . t)
 (subtype nil))
 (digest
 (guess . t)
 (subtype nil))
 (set-buffer buffer)
 (erase-buffer)
 (when entry
 	(if (stringp article)
 	    nil
 	  (insert-buffer-substring
 	   nndoc-current-buffer (car entry) (nth 1 entry))
 	  (insert "\n")
 	  (setq beg (point))
 	  (insert-buffer-substring
 	   nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 	  (goto-char beg)
 	  (when nndoc-prepare-body-function
 	    (funcall nndoc-prepare-body-function))
 	  (when nndoc-article-transform-function
 	  t)))))
 (deffoo nndoc-request-group (group &optional server dont-check)
 "Select news GROUP."
 (let (number)
 (cond
 ((not (nndoc-possibly-change-buffer group server))
 (nnheader-report 'nndoc "No such file or buffer: %s"
 		       nndoc-address))
 (dont-check
 (nnheader-report 'nndoc "Selected group %s" group)
 ;;; Internal functions.
 (defun nndoc-possibly-change-buffer (group source)
 (let (buf)
 (cond
 ;; The current buffer is this group's buffer.
 ((and nndoc-current-buffer
 	   (buffer-name nndoc-current-buffer)
 	   (eq nndoc-current-buffer
 	       (setq buf (cdr (assoc group nndoc-group-alist))))))
 ;; We change buffers by taking an old from the group alist.
 ;; `source' is either a string (a file name) or a buffer object.
 (buf
 (setq nndoc-current-buffer buf))
 ;; It's a totally new group.
 ((or (and (bufferp nndoc-address)
 	       (buffer-name nndoc-address))
 	  (and (stringp nndoc-address)
 	       (file-exists-p nndoc-address)
 	       (not (file-directory-p nndoc-address))))
 (push (cons group (setq nndoc-current-buffer
 			      (get-buffer-create
 			       (concat " *nndoc " group "*"))))
 	    nndoc-group-alist)
 (setq nndoc-dissection-alist nil)
 (save-excursion
 	(set-buffer nndoc-current-buffer)
 ;;; Deciding what document type we have
 ;;;
 (defun nndoc-set-delims ()
 "Set the nndoc delimiter variables according to the type of the document."
 (let ((vars '(nndoc-file-begin
 		nndoc-first-article
 		nndoc-article-end nndoc-head-begin nndoc-head-end
 		nndoc-file-end nndoc-article-begin
 		nndoc-body-begin nndoc-body-end-function nndoc-body-end
 		nndoc-prepare-body-function nndoc-article-transform-function
 		nndoc-generate-head-function nndoc-body-begin-function
 		nndoc-head-begin-function)))
 (while vars
 (set (pop vars) nil)))
 (let (defs)
 ;; Guess away until we find the real file type.
 (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
 					      nndoc-type-alist))))
 (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
 ;; Set the nndoc variables.
 (while defs
 (set (intern (format "nndoc-%s" (caar defs)))
 (while (and (not result)
 		(setq entry (pop alist)))
 (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
 	(goto-char (point-min))
 	(when (numberp (setq result (funcall (intern
 					      (format "nndoc-%s-type-p"
 						      (car entry))))))
 	  (push (cons result entry) results)
 	  (setq result nil))))
 (unless (or result results)
 (error "Document is not of any recognized type"))
 (if result
 	(car entry)
 (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
 ;;;
 ;;; Built-in type predicates and functions
 ;;;
 (defun nndoc-mbox-type-p ()
 (when (looking-at message-unix-mail-delimiter)
 (defun nndoc-mbox-body-end ()
 (let ((beg (point))
 	len end)
 (when
 	(save-excursion
 	  (and (re-search-backward
 		(concat "^" message-unix-mail-delimiter) nil t)
 	       (setq end (point))
 	       (search-forward "\n\n" beg t)
 	       (re-search-backward
 		"^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
 	       (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
 t)))
 (defun nndoc-standard-digest-type-p ()
 (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
 	     (re-search-forward
 	      (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
 t))
 (defun nndoc-digest-body-end ()
 (and (re-search-forward nndoc-article-begin nil t)
 (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
 (replace-match "\n\nGet it at \\1 (\\2)" t nil))
 ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
 ;;    (replace-match "" t t))
 )
 (defun nndoc-generate-lanl-gov-head (article)
 (let ((entry (cdr (assq article nndoc-dissection-alist)))
 	(e-mail "no address given")
 	subject from)
 (save-excursion
 	))
 (while (and from (string-match "(\[^)\]*)" from))
 (setq from (replace-match "" t t from)))
 (insert "From: "  (or from "unknown")
 	    "\nSubject: " (or subject "(no subject)") "\n")))
 ;;;
 ;;; Functions for dissecting the documents
 ;;;
 		 (nndoc-search nndoc-first-article)
 	       (nndoc-article-begin))
 	(setq first nil)
 	(cond (nndoc-head-begin-function
 	       (funcall nndoc-head-begin-function))
 	      (nndoc-head-begin
 	       (nndoc-search nndoc-head-begin)))
 	(if (or (>= (point) (point-max))
 		(and nndoc-file-end
 		     (looking-at nndoc-file-end)))
 	    (goto-char (point-max))

Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndoc.el @ 30:ec9a17fef872 r19-15b98