X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fgnus.git-;a=blobdiff_plain;f=lisp%2Fnnheader.el;h=dc1f0907f9a18fe378463384f659b06aa1b23bba;hp=dc21b7fbba88635edf7029a64e8c7e744b7a007a;hb=ab6b58ba032f3baaf4c78e63be9e39e9d8de5e62;hpb=9af3abed1d0a199ba28ab0013980af74950aef98 diff --git a/lisp/nnheader.el b/lisp/nnheader.el index dc21b7f..dc1f090 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,8 +1,11 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. + +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, +;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -19,53 +22,114 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref] -;; -;; (That last entry is defined as "misc" in the NOV format, but Gnus -;; uses it for xrefs.) - ;;; Code: (eval-when-compile (require 'cl)) -(require 'mail-utils) +(defvar nnmail-extra-headers) + +;; Requiring `gnus-util' at compile time creates a circular +;; dependency between nnheader.el and gnus-util.el. +;;(eval-when-compile (require 'gnus-util)) -(defvar nnheader-max-head-length 4096 - "*Max length of the head of articles.") +(require 'mail-utils) +(require 'mm-util) +(require 'gnus-util) +(eval-and-compile + (autoload 'gnus-sorted-intersection "gnus-range") + (autoload 'gnus-intersection "gnus-range") + (autoload 'gnus-sorted-complement "gnus-range") + (autoload 'gnus-sorted-difference "gnus-range")) + +(defcustom gnus-verbose-backends 7 + "Integer that says how verbose the Gnus backends should be. +The higher the number, the more messages the Gnus backends will flash +to say what it's doing. At zero, the Gnus backends will be totally +mute; at five, they will display most important messages; and at ten, +they will keep on jabbering all the time." + :group 'gnus-start + :type 'integer) + +(defcustom gnus-nov-is-evil nil + "If non-nil, Gnus backends will never output headers in the NOV format." + :group 'gnus-server + :type 'boolean) + +(defvar nnheader-max-head-length 8192 + "*Max length of the head of articles. + +Value is an integer, nil, or t. nil means read in chunks of a file +indefinitely until a complete head is found\; t means always read the +entire file immediately, disregarding `nnheader-head-chop-length'. + +Integer values will in effect be rounded up to the nearest multiple of +`nnheader-head-chop-length'.") (defvar nnheader-head-chop-length 2048 "*Length of each read operation when trying to fetch HEAD headers.") -(defvar nnheader-file-name-translation-alist nil +(defvar nnheader-read-timeout + (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de + ;; + ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. + ;; + ;; There should probably be a runtime test to determine the timing + ;; resolution, or a primitive to report it. I don't know off-hand + ;; what's possible. Perhaps better, maybe the Windows/DOS primitive + ;; could round up non-zero timeouts to a minimum of 1.0? + 1.0 + 0.1) + "How long nntp should wait between checking for the end of output. +Shorter values mean quicker response, but are more CPU intensive.") + +(defvar nnheader-file-name-translation-alist + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + (append (mapcar (lambda (c) (cons c ?_)) + '(?: ?* ?\" ?< ?> ??)) + (if (string-match "windows-nt\\|cygwin" + (symbol-name system-type)) + nil + '((?+ . ?-))))) + (t nil))) "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names +For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") +(defvar nnheader-directory-separator-character + (string-to-char (substring (file-name-as-directory ".") -1)) + "*A character used to a directory separator.") + (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") - (autoload 'gnus-delete-line "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util") - (autoload 'gnus-encode-coding-string "gnus-ems")) + (autoload 'nnmail-message-id "nnmail") + (autoload 'mail-position-on-field "sendmail") + (autoload 'message-remove-header "message") + (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. +;; These macros may look very much like the ones in GNUS 4.1. They +;; are, in a way, but you should note that the indices they use have +;; been changed from the internal GNUS format to the NOV format. The +;; makes it possible to read headers from XOVER much faster. +;; +;; The format of a header is now: +;; [number subject from date id references chars lines xref extra] +;; +;; (That next-to-last entry is defined as "misc" in the NOV format, +;; but Gnus uses it for xrefs.) + (defmacro mail-header-number (header) "Return article number in HEADER." `(aref ,header 0)) @@ -137,130 +201,173 @@ on your system, you could say something like: `(aref ,header 8)) (defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." + "Set article XREF of HEADER to xref." `(aset ,header 8 ,xref)) -(defun make-mail-header (&optional init) +(defmacro mail-header-extra (header) + "Return the extra headers in HEADER." + `(aref ,header 9)) + +(defun mail-header-set-extra (header extra) + "Set the extra headers in HEADER to EXTRA." + (aset header 9 extra)) + +(defsubst make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) + (make-vector 10 init)) -(defun make-full-mail-header (&optional number subject from date id - references chars lines xref) +(defsubst make-full-mail-header (&optional number subject from date id + references chars lines xref + extra) "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref)) + (vector number subject from date id references chars lines xref extra)) ;; 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-generate-fake-message-id (&optional number) + (if (numberp number) + (format "fake+none+%s+%d" gnus-newsgroup-name number) + (format "fake+none+%s+%s" + gnus-newsgroup-name + (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))) + (save-match-data ; regular message-id's are <.*> + (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id))) ;; Parsing headers and NOV lines. +(defsubst nnheader-remove-cr-followed-by-lf () + (goto-char (point-max)) + (while (search-backward "\r\n" nil t) + (delete-char 1))) + (defsubst nnheader-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) + (skip-chars-forward " \t") + (buffer-substring (point) (point-at-eol))) -(defun nnheader-parse-head (&optional naked) +(defun nnheader-parse-naked-head (&optional number) + ;; This function unfolds continuation lines in this buffer + ;; destructively. When this side effect is unwanted, use + ;; `nnheader-parse-head' instead of this function. (let ((case-fold-search t) - (cur (current-buffer)) (buffer-read-only nil) - in-reply-to lines p ref) - (goto-char (point-min)) - (when naked - (insert "\n")) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. + (cur (current-buffer)) + (p (point-min)) + in-reply-to lines ref) + (nnheader-remove-cr-followed-by-lf) + (ietf-drums-unfold-fws) + (subst-char-in-region (point-min) (point-max) ?\t ? ) + (goto-char p) + (insert "\n") (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. - (vector - ;; Number. - (if naked - (progn - (setq p (point-min)) - 0) - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point))))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (nnheader-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" (gnus-point-at-eol) t) - (point))) - (or (search-forward ">" (gnus-point-at-eol) t) (point))) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (nnheader-generate-fake-message-id))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (nnheader-header-value) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^>]+>" in-reply-to (match-end 0)) - (setq ref2 (substring in-reply-to (match-beginning 0) - (match-end 0))) - (when (> (length ref2) (length ref)) - (setq ref ref2))) - ref) - nil))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) - (when naked - (goto-char (point-min)) - (delete-char 1))))) + ;; 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. + (vector + ;; Number. + (or number 0) + ;; Subject. + (progn + (goto-char p) + (if (search-forward "\nsubject:" nil t) + (nnheader-header-value) "(none)")) + ;; From. + (progn + (goto-char p) + (if (search-forward "\nfrom:" nil t) + (nnheader-header-value) "(nobody)")) + ;; Date. + (progn + (goto-char p) + (if (search-forward "\ndate:" nil t) + (nnheader-header-value) "")) + ;; Message-ID. + (progn + (goto-char p) + (if (search-forward "\nmessage-id:" nil t) + (buffer-substring + (1- (or (search-forward "<" (point-at-eol) t) + (point))) + (or (search-forward ">" (point-at-eol) t) (point))) + ;; If there was no message-id, we just fake one to make + ;; subsequent routines simpler. + (nnheader-generate-fake-message-id number))) + ;; References. + (progn + (goto-char p) + (if (search-forward "\nreferences:" nil t) + (nnheader-header-value) + ;; Get the references from the in-reply-to header if + ;; there were no references and the in-reply-to header + ;; looks promising. + (if (and (search-forward "\nin-reply-to:" nil t) + (setq in-reply-to (nnheader-header-value)) + (string-match "<[^\n>]+>" in-reply-to)) + (let (ref2) + (setq ref (substring in-reply-to (match-beginning 0) + (match-end 0))) + (while (string-match "<[^\n>]+>" + in-reply-to (match-end 0)) + (setq ref2 (substring in-reply-to (match-beginning 0) + (match-end 0))) + (when (> (length ref2) (length ref)) + (setq ref ref2))) + ref) + nil))) + ;; Chars. + 0 + ;; Lines. + (progn + (goto-char p) + (if (search-forward "\nlines: " nil t) + (if (numberp (setq lines (read cur))) + lines 0) + 0)) + ;; Xref. + (progn + (goto-char p) + (and (search-forward "\nxref:" nil t) + (nnheader-header-value))) + ;; Extra. + (when nnmail-extra-headers + (let ((extra nnmail-extra-headers) + out) + (while extra + (goto-char p) + (when (search-forward + (concat "\n" (symbol-name (car extra)) ":") nil t) + (push (cons (car extra) (nnheader-header-value)) + out)) + (pop extra)) + out))) + (goto-char p) + (delete-char 1)))) + +(defun nnheader-parse-head (&optional naked) + (let ((cur (current-buffer)) num beg end) + (when (if naked + (setq num 0 + beg (point-min) + end (point-max)) + (goto-char (point-min)) + ;; Search to the beginning of the next header. Error + ;; messages do not begin with 2 or 3. + (when (re-search-forward "^[23][0-9]+ " nil t) + (end-of-line) + (setq num (read cur) + beg (point) + end (if (search-forward "\n.\n" nil t) + (- (point) 2) + (point))))) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (nnheader-parse-naked-head num))))) (defmacro nnheader-nov-skip-field () '(search-forward "\t" eol 'move)) @@ -270,49 +377,115 @@ on your system, you could say something like: (defmacro nnheader-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 - (let ((num (ignore-errors (read (current-buffer))))) + (let ((num (condition-case nil + (read (current-buffer)) + (error nil)))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) -;; (defvar nnheader-none-counter 0) +(defmacro nnheader-nov-parse-extra () + '(let (out string) + (while (not (memq (char-after) '(?\n nil))) + (setq string (nnheader-nov-field)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) + (substring string (match-end 0))) + out))) + out)) + +(defvar nnheader-uniquify-message-id nil) + +(defmacro nnheader-nov-read-message-id (&optional number) + `(let ((id (nnheader-nov-field))) + (if (string-match "^<[^>]+>$" id) + ,(if nnheader-uniquify-message-id + `(if (string-match "__[^@]+@" id) + (concat (substring id 0 (match-beginning 0)) + (substring id (1- (match-end 0)))) + id) + 'id) + (nnheader-generate-fake-message-id ,number)))) (defun nnheader-parse-nov () - (let ((eol (gnus-point-at-eol))) + (let ((eol (point-at-eol)) + (number (nnheader-nov-read-integer))) (vector - (nnheader-nov-read-integer) ; number + number ; 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-read-message-id number) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) + (if (eq (char-after) ?\n) nil - (nnheader-nov-field)) ; misc - ))) + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref + (nnheader-nov-parse-extra)))) ; extra (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) + (let ((p (point))) + (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)) + "\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))) + (when (or (mail-header-xref header) + (mail-header-extra header)) + (insert "\t")) + (when (mail-header-extra header) + (let ((extra (mail-header-extra header))) + (while extra + (insert (symbol-name (caar extra)) + ": " (cdar extra) "\t") + (pop extra)))) + (insert "\n") + (backward-char 1) + (while (search-backward "\n" p t) + (delete-char 1)) + (forward-line 1))) + +(defun nnheader-parse-overview-file (file) + "Parse FILE and return a list of headers." + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let (headers) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (nreverse headers)))) + +(defun nnheader-write-overview-file (file headers) + "Write HEADERS to FILE." + (with-temp-file file + (mapcar 'nnheader-insert-nov headers))) + +(defun nnheader-insert-header (header) (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)) - "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") + "Subject: " (or (mail-header-subject header) "(none)") "\n" + "From: " (or (mail-header-from header) "(nobody)") "\n" + "Date: " (or (mail-header-date header) "") "\n" + "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n" + "References: " (or (mail-header-references header) "") "\n" + "Lines: ") (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")) + (insert "\n\n")) (defun nnheader-insert-article-line (article) (goto-char (point-min)) @@ -346,7 +519,7 @@ the line could be found." (prev (point-min)) num found) (while (not found) - (goto-char (/ (+ max min) 2)) + (goto-char (+ min (/ (- max min) 2))) (beginning-of-line) (if (or (= (point) prev) (eobp)) @@ -385,10 +558,7 @@ the line could be found." ;; 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 gnus-nov-is-evil nil - "If non-nil, Gnus backends will never output headers in the NOV format.") +(defvar nntp-process-response nil) (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) @@ -400,10 +570,11 @@ the line could be found." (unless (gnus-buffer-live-p nntp-server-buffer) (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) + (mm-enable-multibyte) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. + (set (make-local-variable 'nntp-process-response) nil) t)) ;;; Various functions the backends use. @@ -446,7 +617,7 @@ the line could be found." nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) - (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") + (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) @@ -455,9 +626,10 @@ the line could be found." (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 invalid, but not all articles have Message-IDs. + () (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) + (let ((begin (point-at-bol)) (fill-column 78) (fill-prefix "\t")) (when references @@ -491,61 +663,29 @@ the line could be found." (point-max))) (goto-char (point-min))) +(defun nnheader-get-lines-and-char () + "Return the number of lines and chars in the article body." + (goto-char (point-min)) + (if (not (re-search-forward "\n\r?\n" nil t)) + (list 0 0) + (list (count-lines (point) (point-max)) + (- (point-max) (point))))) + +(defun nnheader-remove-body () + "Remove the body from an article in this current buffer." + (goto-char (point-min)) + (when (re-search-forward "\n\r?\n" nil t) + (delete-region (point) (point-max)))) + (defun nnheader-set-temp-buffer (name &optional noerase) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." (set-buffer (get-buffer-create name)) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (unless noerase (erase-buffer)) (current-buffer)) -(defmacro nnheader-temp-write (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. -Return the value of FORMS. -If FILE is nil, just evaluate FORMS and don't save anything. -If FILE is t, return the buffer contents as a string." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer")) - (temp-results (make-symbol "temp-results"))) - `(save-excursion - (let* ((,temp-file ,file) - (default-major-mode 'fundamental-mode) - (,temp-buffer - (set-buffer - (get-buffer-create - (generate-new-buffer-name " *nnheader temp*")))) - ,temp-results) - (unwind-protect - (progn - (setq ,temp-results (progn ,@forms)) - (cond - ;; Don't save anything. - ((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 'edebug-form-spec '(form body)) - -(defvar jka-compr-compression-info-list) +(eval-when-compile (defvar jka-compr-compression-info-list)) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) (concat "\\([0-9]+\\)\\(" @@ -559,20 +699,25 @@ If FILE is t, return the buffer contents as a string." "Regexp that matches numerical file names.") (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file paths.") + "Regexp that matches numerical full file names.") (defsubst nnheader-file-to-number (file) - "Take a file name and return the article number." + "Take a FILE name and return the article number." (if (string= nnheader-numerical-short-files "^[0-9]+$") - (string-to-int file) + (string-to-number file) (string-match nnheader-numerical-short-files file) - (string-to-int (match-string 0 file)))) + (string-to-number (match-string 0 file)))) + +(defvar nnheader-directory-files-is-safe + (or (eq system-type 'windows-nt) + (not (featurep 'xemacs))) + "If non-nil, Gnus believes `directory-files' is safe. +It has been reported numerous times that `directory-files' fails with +an alarming frequency on NFS mounted file systems. If it is nil, +`nnheader-directory-files-safe' is used.") (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. + "Execute `directory-files' twice and returns the longer result." (let ((first (apply 'directory-files args)) (second (apply 'directory-files args))) (if (> (length first) (length second)) @@ -580,16 +725,22 @@ If FILE is t, return the buffer contents as a string." second))) (defun nnheader-directory-articles (dir) - "Return a list of all article files in a directory." + "Return a list of all article files in directory DIR." (mapcar 'nnheader-file-to-number - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) + (if nnheader-directory-files-is-safe + (directory-files + dir nil nnheader-numerical-short-files t) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t)))) (defun nnheader-article-to-file-alist (dir) "Return an alist of article/file pairs in DIR." (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) + (if nnheader-directory-files-is-safe + (directory-files + dir nil nnheader-numerical-short-files t) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t)))) (defun nnheader-fold-continuation-lines () "Fold continuation lines in the current buffer." @@ -605,15 +756,33 @@ If FULL, translate everything." trans leaf path len) (if full ;; Do complete translation. - (setq leaf file - path "") + (setq leaf (copy-sequence file) + path "" + i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1))) + 2 0)) ;; We translate -- but only the file name. We leave the directory ;; alone. - (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (setq leaf (substring file (1+ (match-beginning 0))) - path (substring file 0 (1+ (match-beginning 0)))) - ;; Fall back on this. + (if (and (featurep 'xemacs) + (memq system-type '(cygwin32 win32 w32 mswindows windows-nt + cygwin))) + ;; This is needed on NT and stuff, because + ;; file-name-nondirectory is not enough to split + ;; file names, containing ':', e.g. + ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE" + ;; + ;; we are trying to correctly split such names: + ;; "d:file.name" -> "a:" "file.name" + ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc" + ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc" + ;; etc. + ;; to translate then only the file name part. + (progn + (setq leaf file + path "") + (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file) + (setq leaf (substring file (match-beginning 2)) + path (substring file 0 (match-beginning 2))))) + ;; Emacs DTRT, says andrewi. (setq leaf (file-name-nondirectory file) path (file-name-directory file)))) (setq len (length leaf)) @@ -636,9 +805,9 @@ The first string in ARGS can be a format string." (defun nnheader-get-report (backend) "Get the most recent report from BACKEND." (condition-case () - (message "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (message "")))) + (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" + backend)))) + (error (nnheader-message 5 "")))) (defun nnheader-insert (format &rest args) "Clear the communication buffer and insert FORMAT and ARGS into the buffer. @@ -652,15 +821,21 @@ without formatting." (apply 'insert format args)) t)) -(defun nnheader-replace-chars-in-string (string from to) +(defsubst nnheader-replace-chars-in-string (string from to) + (mm-subst-char-in-string from to string)) + +(defun nnheader-replace-duplicate-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)) + (idx 0) prev i) ;; Replace all occurrences of FROM with TO. (while (< idx len) - (when (= (aref string idx) from) + (setq i (aref string idx)) + (when (and (eq prev from) (= i from)) + (aset string (1- idx) to) (aset string idx to)) + (setq prev i) (setq idx (1+ idx))) string)) @@ -675,7 +850,7 @@ without formatting." (expand-file-name (file-name-as-directory top)))) (error ""))) - ?/ ?.)) + nnheader-directory-separator-character ?.)) (defun nnheader-message (level &rest args) "Message if the Gnus backends are talkative." @@ -690,50 +865,47 @@ without formatting." (<= level gnus-verbose-backends))) (defvar nnheader-pathname-coding-system 'iso-8859-1 - "*Coding system for pathname.") + "*Coding system for file name.") (defun nnheader-group-pathname (group dir &optional file) - "Make pathname for GROUP." + "Make file name for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (gnus-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnheader-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (file-directory-p (concat dir group)) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name (mm-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnheader-pathname-coding-system) + dir)))) (cond ((null file) "") ((numberp file) (int-to-string file)) (t file)))) -(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) - "Concat DIR as directory to FILE." + "Concat DIR as directory to FILES." (apply 'concat (file-name-as-directory dir) files)) (defun nnheader-ms-strip-cr () "Strip ^M from the end of all lines." (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)))) + (nnheader-remove-cr-followed-by-lf))) (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) - "Go through the path and find the \".../etc/PACKAGE\" directory. -If FILE, find the \".../etc/PACKAGE\" file instead." +(defun nnheader-find-etc-directory (package &optional file first) + "Go through `load-path' and find the \"../etc/PACKAGE\" directory. +This function will look in the parent directory of each `load-path' +entry, and look for the \"etc\" directory there. +If FILE, find the \".../etc/PACKAGE\" file instead. +If FIRST is non-nil, return the directory or the file found at the +first. Otherwise, find the newest one, though it may take a time." (let ((path load-path) - dir result) + dir results) ;; We try to find the dir by looking at the load path, ;; stripping away the last component and adding "etc/". (while path @@ -745,13 +917,18 @@ If FILE, find the \".../etc/PACKAGE\" file instead." "etc/" package (if file "" "/")))) (or file (file-directory-p dir))) - (setq result dir - path nil) + (progn + (or (member dir results) + (push dir results)) + (setq path (if first nil (cdr path)))) (setq path (cdr path)))) - result)) + (if (or first (not (cdr results))) + (car results) + (car (sort results 'file-newer-than-file-p))))) -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) +(eval-when-compile + (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)) @@ -770,31 +947,47 @@ 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) - (coding-system-for-read nnheader-file-coding-system)) - (insert-file-contents filename visit beg end replace))) + (let ((coding-system-for-read nnheader-file-coding-system)) + (mm-insert-file-contents filename visit beg end replace))) + +(defun nnheader-insert-nov-file (file first) + (let ((size (nth 7 (file-attributes file))) + (cutoff (* 32 1024))) + (when size + (if (< size cutoff) + ;; If the file is small, we just load it. + (nnheader-insert-file-contents file) + ;; We start on the assumption that FIRST is pretty recent. If + ;; not, we just insert the rest of the file as well. + (let (current) + (nnheader-insert-file-contents file nil (- size cutoff) size) + (goto-char (point-min)) + (delete-region (point) (or (search-forward "\n" nil 'move) (point))) + (setq current (ignore-errors (read (current-buffer)))) + (if (and (numberp current) + (< current first)) + t + (delete-region (point-min) (point-max)) + (nnheader-insert-file-contents file))))))) (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) - (coding-system-for-read nnheader-file-coding-system)) - (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))) + "Open a file with some variables bound. +See `find-file-noselect' for the arguments." + (let* ((format-alist nil) + (auto-mode-alist (mm-auto-mode-alist)) + (default-major-mode 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (coding-system-for-read nnheader-file-coding-system) + (ffh (if (boundp 'find-file-hook) + 'find-file-hook + 'find-file-hooks)) + (val (symbol-value ffh))) + (set ffh nil) + (unwind-protect + (apply 'find-file-noselect args) + (set ffh val)))) (defun nnheader-directory-regular-files (dir) "Return a list of all regular files in DIR." @@ -820,8 +1013,6 @@ find-file-hooks, etc. `(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) @@ -839,26 +1030,35 @@ find-file-hooks, etc. (set-buffer cur))) (defun nnheader-replace-string (from to) - "Do a fast replacement of FROM to TO from point to point-max." + "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." + "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) +(defalias 'nnheader-cancel-timer 'cancel-timer) +(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) +(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) + +(defun nnheader-accept-process-output (process) + (accept-process-output + process + (truncate nnheader-read-timeout) + (truncate (* (- nnheader-read-timeout + (truncate nnheader-read-timeout)) + 1000)))) -(when (string-match "XEmacs\\|Lucid" emacs-version) +(when (featurep 'xemacs) (require 'nnheaderxm)) (run-hooks 'nnheader-load-hook) (provide 'nnheader) +;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202 ;;; nnheader.el ends here