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

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

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	8d2a9b52c682
children	0d2f883870bc

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; Keywords: news
 ;; uses it for xrefs.)
 ;;; Code:
 (require 'mail-utils)
+(eval-when-compile (require 'cl))
 (defvar nnheader-max-head-length 4096
 "*Max length of the head of articles.")
-(defvar nnheader-head-chop-length 2048
-"*Length of each read operation when trying to fetch HEAD headers.")
 (defvar nnheader-file-name-translation-alist nil
 "*Alist that says how to translate characters in file names.
 For instance, if \":\" is illegal as a file character in file names
 on your system, you could say something like:
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
-(eval-and-compile
-(autoload 'nnmail-message-id "nnmail")
-(autoload 'mail-position-on-field "sendmail")
-(autoload 'message-remove-header "message")
-(autoload 'cancel-function-timers "timers")
-(autoload 'gnus-point-at-eol "gnus-util"))
 ;;; Header access macros.
 (defmacro mail-header-number (header)
 "Return article number in HEADER."
 `(aref ,header 0))
 (defun make-mail-header (&optional init)
 "Create a new mail header structure initialized with INIT."
 (make-vector 9 init))
-(defun make-full-mail-header (&optional number subject from date id
-					references chars lines xref)
-"Create a new mail header structure initialized with the parameters given."
-(vector number subject from date id references chars lines xref))
-;; fake message-ids: generation and detection
-(defvar nnheader-fake-message-id 1)
-(defsubst nnheader-generate-fake-message-id ()
-(concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
-(defsubst nnheader-fake-message-id-p (id)
-(save-match-data			; regular message-id's are <.*>
-(string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
 ;; Parsing headers and NOV lines.
 (defsubst nnheader-header-value ()
 (buffer-substring (match-end 0) (gnus-point-at-eol)))
+(defvar nnheader-newsgroup-none-id 1)
 (defun nnheader-parse-head (&optional naked)
 (let ((case-fold-search t)
 	(cur (current-buffer))
 	(buffer-read-only nil)
-	in-reply-to lines p)
+	end ref in-reply-to lines p)
 (goto-char (point-min))
 (when naked
 (insert "\n"))
-;; Search to the beginning of the next header.  Error messages
+;; Search to the beginning of the next header. Error messages
 ;; do not begin with 2 or 3.
 (prog1
 	(when (or naked (re-search-forward "^[23][0-9]+ " nil t))
 	  ;; This implementation of this function, with nine
 	  ;; search-forwards instead of the one re-search-forward and
 	  ;; a case (which basically was the old function) is actually
 	  ;; about twice as fast, even though it looks messier.	 You
 	  ;; can't have everything, I guess.  Speed and elegance
-	  ;; don't always go hand in hand.
+	  ;; doesn't always go hand in hand.
 	  (vector
 	   ;; Number.
 	   (if naked
 	       (progn
 		 (setq p (point-min))
 	     (if (search-forward "\ndate: " nil t)
 		 (nnheader-header-value) ""))
 	   ;; Message-ID.
 	   (progn
 	     (goto-char p)
-	     (if (search-forward "\nmessage-id:" nil t)
+	     (if (search-forward "\nmessage-id: " nil t)
-		 (buffer-substring
+		 (nnheader-header-value)
-		  (1- (or (search-forward "<" nil t) (point)))
-		  (or (search-forward ">" nil t) (point)))
 	       ;; If there was no message-id, we just fake one to make
 	       ;; subsequent routines simpler.
-	       (nnheader-generate-fake-message-id)))
+	       (concat "none+"
+		       (int-to-string
+			(incf nnheader-newsgroup-none-id)))))
 	   ;; References.
 	   (progn
 	     (goto-char p)
 	     (if (search-forward "\nreferences: " nil t)
 		 (nnheader-header-value)
 		  (nnheader-header-value)))))
 (when naked
 	(goto-char (point-min))
 	(delete-char 1)))))
-(defmacro nnheader-nov-skip-field ()
-'(search-forward "\t" eol 'move))
-(defmacro nnheader-nov-field ()
-'(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
-(defmacro nnheader-nov-read-integer ()
-'(prog1
-(if (= (following-char) ?\t)
-	   0
-	 (let ((num (ignore-errors (read (current-buffer)))))
-	   (if (numberp num) num 0)))
-(or (eobp) (forward-char 1))))
-;; (defvar nnheader-none-counter 0)
-(defun nnheader-parse-nov ()
-(let ((eol (gnus-point-at-eol)))
-(vector
-(nnheader-nov-read-integer)	; number
-(nnheader-nov-field)		; subject
-(nnheader-nov-field)		; from
-(nnheader-nov-field)		; date
-(or (nnheader-nov-field)
-	 (nnheader-generate-fake-message-id)) ; id
-(nnheader-nov-field)		; refs
-(nnheader-nov-read-integer)	; chars
-(nnheader-nov-read-integer)	; lines
-(if (= (following-char) ?\n)
-	 nil
-(nnheader-nov-field))		; misc
-)))
 (defun nnheader-insert-nov (header)
 (princ (mail-header-number header) (current-buffer))
 (insert
 "\t"
 (or (mail-header-subject header) "(none)") "\t"
 (or (mail-header-from header) "(nobody)") "\t"
 (or (mail-header-date header) "") "\t"
 (or (mail-header-id header)
-(nnmail-message-id))
+(nnmail-message-id)) "\t"
-"\t"
 (or (mail-header-references header) "") "\t")
 (princ (or (mail-header-chars header) 0) (current-buffer))
 (insert "\t")
 (princ (or (mail-header-lines header) 0) (current-buffer))
 (insert "\t")
 (when (mail-header-xref header)
 (insert "Xref: " (mail-header-xref header) "\t"))
 (insert "\n"))
 (defun nnheader-insert-article-line (article)
 (goto-char (point-min))
 (search-forward "\n\n" nil 'move)
 (delete-region (point) (point-max))
 (forward-char -1)
 (insert "."))
-(defun nnheader-nov-delete-outside-range (beg end)
-"Delete all NOV lines that lie outside the BEG to END range."
-;; First we find the first wanted line.
-(nnheader-find-nov-line beg)
-(delete-region (point-min) (point))
-;; Then we find the last wanted line.
-(when (nnheader-find-nov-line end)
-(forward-line 1))
-(delete-region (point) (point-max)))
-(defun nnheader-find-nov-line (article)
-"Put point at the NOV line that start with ARTICLE.
-If ARTICLE doesn't exist, put point where that line
-would have been.  The function will return non-nil if
-the line could be found."
-;; This function basically does a binary search.
-(let ((max (point-max))
-	(min (goto-char (point-min)))
-	(cur (current-buffer))
-	(prev (point-min))
-	num found)
-(while (not found)
-(goto-char (/ (+ max min) 2))
-(beginning-of-line)
-(if (or (= (point) prev)
-	      (eobp))
-	  (setq found t)
-	(setq prev (point))
-	(cond ((> (setq num (read cur)) article)
-	       (setq max (point)))
-	      ((< num article)
-	       (setq min (point)))
-	      (t
-	       (setq found 'yes)))))
-;; We may be at the first line.
-(when (and (not num)
-	       (not (eobp)))
-(setq num (read cur)))
-;; Now we may have found the article we're looking for, or we
-;; may be somewhere near it.
-(when (and (not (eq found 'yes))
-	       (not (eq num article)))
-(setq found (point))
-(while (and (< (point) max)
-		  (or (not (numberp num))
-		      (< num article)))
-	(forward-line 1)
-	(setq found (point))
-	(or (eobp)
-	    (= (setq num (read cur)) article)))
-(unless (eq num article)
-	(goto-char found)))
-(beginning-of-line)
-(eq num article)))
 ;; Various cruft the backends and Gnus need to communicate.
 (defvar nntp-server-buffer nil)
 (defvar gnus-verbose-backends 7
 "*A number that says how talkative the Gnus backends should be.")
 (defvar nnheader-callback-function nil)
 (defun nnheader-init-server-buffer ()
 "Initialize the Gnus-backend communication buffer."
 (save-excursion
-(unless (gnus-buffer-live-p nntp-server-buffer)
+(setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-(setq nntp-server-buffer (get-buffer-create " *nntpd*")))
 (set-buffer nntp-server-buffer)
 (buffer-disable-undo (current-buffer))
 (erase-buffer)
 (kill-all-local-variables)
 (setq case-fold-search t)		;Should ignore case.
 t))
 ;;; Various functions the backends use.
 (defun nnheader-file-error (file)
 "Return a string that says what is wrong with FILE."
 (defun nnheader-insert-head (file)
 "Insert the head of the article."
 (when (file-exists-p file)
 (if (eq nnheader-max-head-length t)
 	;; Just read the entire file.
-	(nnheader-insert-file-contents file)
+	(nnheader-insert-file-contents-literally file)
 ;; Read 1K blocks until we find a separator.
 (let ((beg 0)
-	    format-alist)
+	    format-alist
-	(while (and (eq nnheader-head-chop-length
+	    (chop 1024))
-			(nth 1 (nnheader-insert-file-contents
+	(while (and (eq chop (nth 1 (insert-file-contents
-				file nil beg
+				     file nil beg (incf beg chop))))
-				(incf beg nnheader-head-chop-length))))
+		    (prog1 (not (search-forward "\n\n" nil t))
-		    (prog1 (not (search-forward "\n\n" nil t))
 		      (goto-char (point-max)))
 		    (or (null nnheader-max-head-length)
 			(< beg nnheader-max-head-length))))))
 t))
 (goto-char (point-min))
 (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
 (goto-char (match-end 0)))
 (prog1
 	(eobp)
 (widen))))
 (defun nnheader-insert-references (references message-id)
 "Insert a References header based on REFERENCES and MESSAGE-ID."
 (if (and (not references) (not message-id))
-()				; This is illegal, but not all articles have Message-IDs.
+()	; This is illegal, but not all articles have Message-IDs.
 (mail-position-on-field "References")
 (let ((begin (save-excursion (beginning-of-line) (point)))
 	  (fill-column 78)
 	  (fill-prefix "\t"))
-(when references
+(if references (insert references))
-	(insert references))
+(if (and references message-id) (insert " "))
-(when (and references message-id)
+(if message-id (insert message-id))
-	(insert " "))
-(when message-id
-	(insert message-id))
 ;; Fold long References lines to conform to RFC1036 (sort of).
 ;; The region must end with a newline to fill the region
 ;; without inserting extra newline.
 (fill-region-as-paragraph begin (1+ (point))))))
 (if (search-forward "\n\n" nil t)
 (1- (point))
 (point-max)))
 (goto-char (point-min)))
-(defun nnheader-set-temp-buffer (name &optional noerase)
+(defun nnheader-set-temp-buffer (name)
 "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
 (set-buffer (get-buffer-create name))
 (buffer-disable-undo (current-buffer))
-(unless noerase
+(erase-buffer)
-(erase-buffer))
 (current-buffer))
 (defmacro nnheader-temp-write (file &rest forms)
-"Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+"Create a new buffer, evaluate FORM there, and write the buffer to FILE."
-Return the value of FORMS.
+`(save-excursion
-If FILE is nil, just evaluate FORMS and don't save anything.
+(let ((nnheader-temp-file ,file)
-If FILE is t, return the buffer contents as a string."
+	   (nnheader-temp-cur-buffer
-(let ((temp-file (make-symbol "temp-file"))
+	    (nnheader-set-temp-buffer
-	(temp-buffer (make-symbol "temp-buffer"))
+	     (generate-new-buffer-name " *nnheader temp*"))))
-	(temp-results (make-symbol "temp-results")))
+(when (and nnheader-temp-file
-`(save-excursion
+		  (not (file-directory-p (file-name-directory
-(let* ((,temp-file ,file)
+					  nnheader-temp-file))))
-	      (default-major-mode 'fundamental-mode)
+	 (make-directory (file-name-directory nnheader-temp-file) t))
-	      (,temp-buffer
+(unwind-protect
-	       (set-buffer
+	   (prog1
-		(get-buffer-create
+	       (progn
-		 (generate-new-buffer-name " *nnheader temp*"))))
+		 ,@forms)
-	      ,temp-results)
+	     (when nnheader-temp-file
-	 (unwind-protect
+	       (set-buffer nnheader-temp-cur-buffer)
-	     (progn
+	       (write-region (point-min) (point-max)
-	       (setq ,temp-results (progn ,@forms))
+			     nnheader-temp-file nil 'nomesg)))
-	       (cond
+	 (when (buffer-name nnheader-temp-cur-buffer)
-		;; Don't save anything.
+	   (kill-buffer nnheader-temp-cur-buffer))))))
-		((null ,temp-file)
-		 ,temp-results)
-		;; Return the buffer contents.
-		((eq ,temp-file t)
-		 (set-buffer ,temp-buffer)
-		 (buffer-string))
-		;; Save a file.
-		(t
-		 (set-buffer ,temp-buffer)
-		 ;; Make sure the directory where this file is
-		 ;; to be saved exists.
-		 (when (not (file-directory-p
-			     (file-name-directory ,temp-file)))
-		   (make-directory (file-name-directory ,temp-file) t))
-		 ;; Save the file.
-		 (write-region (point-min) (point-max)
-			       ,temp-file nil 'nomesg)
-		 ,temp-results)))
-	   ;; Kill the buffer.
-	   (when (buffer-name ,temp-buffer)
-	     (kill-buffer ,temp-buffer)))))))
 (put 'nnheader-temp-write 'lisp-indent-function 1)
+(put 'nnheader-temp-write 'lisp-indent-hook 1)
 (put 'nnheader-temp-write 'edebug-form-spec '(form body))
 (defvar jka-compr-compression-info-list)
 (defvar nnheader-numerical-files
 (if (boundp 'jka-compr-compression-info-list)
 (concat "\\([0-9]+\\)\\("
 	      (mapconcat (lambda (i) (aref i 0))
 			 jka-compr-compression-info-list "\\|")
 	      "\\)?")
 "[0-9]+$")
 "Regexp that match numerical files.")
 (string-to-int (match-string 0 file))))
 (defun nnheader-directory-files-safe (&rest args)
 ;; It has been reported numerous times that `directory-files'
 ;; fails with an alarming frequency on NFS mounted file systems.
 ;; This function executes that function twice and returns
 ;; the longest result.
 (let ((first (apply 'directory-files args))
 	(second (apply 'directory-files args)))
 (if (> (length first) (length second))
 	first
 	  (nnheader-directory-files-safe
 	   dir nil nnheader-numerical-short-files t)))
 (defun nnheader-fold-continuation-lines ()
 "Fold continuation lines in the current buffer."
-(nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
+(goto-char (point-min))
+(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+(replace-match " " t t)))
 (defun nnheader-translate-file-chars (file)
 (if (null nnheader-file-name-translation-alist)
 ;; No translation is necessary.
 file
 ;; We translate -- but only the file name.  We leave the directory
 ;; alone.
 (let* ((i 0)
 	   trans leaf path len)
 (if (string-match "/[^/]+\\'" file)
 	   (car args)
 	 (apply 'format args)))
 nil)
 (defun nnheader-get-report (backend)
-"Get the most recent report from BACKEND."
+(message "%s" (symbol-value (intern (format "%s-status-string" backend)))))
-(condition-case ()
-(message "%s" (symbol-value (intern (format "%s-status-string"
-						  backend))))
-(error (message ""))))
 (defun nnheader-insert (format &rest args)
-"Clear the communication buffer and insert FORMAT and ARGS into the buffer.
+"Clear the communicaton buffer and insert FORMAT and ARGS into the buffer.
 If FORMAT isn't a format string, it and all ARGS will be inserted
 without formatting."
 (save-excursion
 (set-buffer nntp-server-buffer)
 (erase-buffer)
 (if (string-match "%" format)
 	(insert (apply 'format format args))
 (apply 'insert format args))
 t))
+(defun nnheader-mail-file-mbox-p (file)
+"Say whether FILE looks like an Unix mbox file."
+(when (and (file-exists-p file)
+	     (file-readable-p file)
+	     (file-regular-p file))
+(save-excursion
+(nnheader-set-temp-buffer " *mail-file-mbox-p*")
+(nnheader-insert-file-contents-literally file)
+(goto-char (point-min))
+(prog1
+	  (looking-at message-unix-mail-delimiter)
+	(kill-buffer (current-buffer))))))
 (defun nnheader-replace-chars-in-string (string from to)
 "Replace characters in STRING from FROM to TO."
 (let ((string (substring string 0))	;Copy string.
 	(len (length string))
 	(idx 0))
 ;; Replace all occurrences of FROM with TO.
 (while (< idx len)
-(when (= (aref string idx) from)
+(if (= (aref string idx) from)
-	(aset string idx to))
+	  (aset string idx to))
 (setq idx (1+ idx)))
 string))
 (defun nnheader-file-to-group (file &optional top)
 "Return a group name based on FILE and TOP."
 (nnheader-replace-chars-in-string
 (if (not top)
 file
 (condition-case ()
 	 (substring (expand-file-name file)
 		    (length
 		     (expand-file-name
 		      (file-name-as-directory top))))
 (error "")))
 ?/ ?.))
 (defun nnheader-functionp (form)
 "Return non-nil if FORM is funcallable."
 (or (and (symbolp form) (fboundp form))
 (and (listp form) (eq (car form) 'lambda))))
-(defun nnheader-concat (dir &rest files)
+(defun nnheader-concat (dir file)
 "Concat DIR as directory to FILE."
-(apply 'concat (file-name-as-directory dir) files))
+(concat (file-name-as-directory dir) file))
 (defun nnheader-ms-strip-cr ()
 "Strip ^M from the end of all lines."
 (save-excursion
 (goto-char (point-min))
 (defun nnheader-file-size (file)
 "Return the file size of FILE or 0."
 (or (nth 7 (file-attributes file)) 0))
-(defun nnheader-find-etc-directory (package &optional file)
+(defun nnheader-find-etc-directory (package)
-"Go through the path and find the \".../etc/PACKAGE\" directory.
+"Go through the path and find the \".../etc/PACKAGE\" directory."
-If FILE, find the \".../etc/PACKAGE\" file instead."
 (let ((path load-path)
 	dir result)
 ;; We try to find the dir by looking at the load path,
 ;; stripping away the last component and adding "etc/".
 (while path
 (if (and (car path)
 	       (file-exists-p
 		(setq dir (concat
 			   (file-name-directory
 			    (directory-file-name (car path)))
-			   "etc/" package
+			   "etc/" package "/")))
-			   (if file "" "/"))))
+	       (file-directory-p dir))
-	       (or file (file-directory-p dir)))
 	  (setq result dir
 		path nil)
 	(setq path (cdr path))))
 result))
 (defvar ange-ftp-path-format)
 (defvar efs-path-regexp)
 (defun nnheader-re-read-dir (path)
 "Re-read directory PATH if PATH is on a remote system."
 (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
-(when (string-match efs-path-regexp path)
+	(when (string-match efs-path-regexp path)
-	(efs-re-read-dir path))
+	  (efs-re-read-dir path))
-(when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
+(if (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
 (when (string-match (car ange-ftp-path-format) path)
 	(ange-ftp-re-read-dir path)))))
-(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
-"Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
-This function ensures that none of these modifications will take place."
-(let ((format-alist nil)
-	(auto-mode-alist (nnheader-auto-mode-alist))
-	(default-major-mode 'fundamental-mode)
-(after-insert-file-functions nil))
-(insert-file-contents filename visit beg end replace)))
-(defun nnheader-find-file-noselect (&rest args)
-(let ((format-alist nil)
-	(auto-mode-alist (nnheader-auto-mode-alist))
-	(default-major-mode 'fundamental-mode)
-	(enable-local-variables nil)
-(after-insert-file-functions nil))
-(apply 'find-file-noselect args)))
-(defun nnheader-auto-mode-alist ()
-"Return an `auto-mode-alist' with only the .gz (etc) thingies."
-(let ((alist auto-mode-alist)
-	out)
-(while alist
-(when (listp (cdar alist))
-	(push (car alist) out))
-(pop alist))
-(nreverse out)))
-(defun nnheader-directory-regular-files (dir)
-"Return a list of all regular files in DIR."
-(let ((files (directory-files dir t))
-	out)
-(while files
-(when (file-regular-p (car files))
-	(push (car files) out))
-(pop files))
-(nreverse out)))
-(defmacro nnheader-skeleton-replace (from &optional to regexp)
-`(let ((new (generate-new-buffer " *nnheader replace*"))
-	 (cur (current-buffer))
-	 (start (point-min)))
-(set-buffer new)
-(buffer-disable-undo (current-buffer))
-(set-buffer cur)
-(goto-char (point-min))
-(while (,(if regexp 're-search-forward 'search-forward)
-	     ,from nil t)
-(insert-buffer-substring
-	cur start (prog1 (match-beginning 0) (set-buffer new)))
-(goto-char (point-max))
-,(when to `(insert ,to))
-(set-buffer cur)
-(setq start (point)))
-(insert-buffer-substring
-cur start (prog1 (point-max) (set-buffer new)))
-(copy-to-buffer cur (point-min) (point-max))
-(kill-buffer (current-buffer))
-(set-buffer cur)))
-(defun nnheader-replace-string (from to)
-"Do a fast replacement of FROM to TO from point to point-max."
-(nnheader-skeleton-replace from to))
-(defun nnheader-replace-regexp (from to)
-"Do a fast regexp replacement of FROM to TO from point to point-max."
-(nnheader-skeleton-replace from to t))
-(defun nnheader-strip-cr ()
-"Strip all \r's from the current buffer."
-(nnheader-skeleton-replace "\r"))
 (fset 'nnheader-run-at-time 'run-at-time)
 (fset 'nnheader-cancel-timer 'cancel-timer)
-(fset 'nnheader-cancel-function-timers 'cancel-function-timers)
+(fset 'nnheader-find-file-noselect 'find-file-noselect)
+(fset 'nnheader-insert-file-contents-literally
+'insert-file-contents-literally)
 (when (string-match "XEmacs\\|Lucid" emacs-version)
 (require 'nnheaderxm))
 (run-hooks 'nnheader-load-hook)

Mercurial > hg > xemacs-beta

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