X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=b97fe5f8079d50b81e24002db86d36592798d2f5;hb=8339220cc25db3fbdab4367d6252e596bddd9cb1;hp=e4ca17be1dae1ed8782f20296576841bc5811b6c;hpb=a77dd35f2d1dc13eb88e5b153d4c03b83f7eb2c7;p=gnus diff --git a/lisp/nnheader.el b/lisp/nnheader.el index e4ca17be1..b97fe5f80 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,8 +1,8 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, +;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -10,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,16 +21,21 @@ ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) +(defvar nnmail-extra-headers) +(defvar gnus-newsgroup-name) +(defvar nnheader-file-coding-system) +(defvar jka-compr-compression-info-list) + ;; Requiring `gnus-util' at compile time creates a circular ;; dependency between nnheader.el and gnus-util.el. ;;(eval-when-compile (require 'gnus-util)) @@ -38,11 +43,11 @@ (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")) +;; FIXME none of these are used explicitly in this file. +(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. @@ -58,7 +63,7 @@ they will keep on jabbering all the time." :group 'gnus-server :type 'boolean) -(defvar nnheader-max-head-length 4096 +(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 @@ -72,17 +77,32 @@ Integer values will in effect be rounded up to the nearest multiple of "*Length of each read operation when trying to fetch HEAD headers.") (defvar nnheader-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) - 1.0 ; why? - 0.1) + ;; 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 + ;; 2008-05-19 change by Larsi: + ;; Change the default timeout from 0.1 seconds to 0.01 seconds. This will + ;; make nntp and pop3 article retrieval faster in some cases, but might + ;; make CPU usage larger. If this has any bad side effects, we might + ;; revert this change. + 0.01) + ;; When changing this variable, consider changing `pop3-read-timeout' as + ;; well. "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" + ((string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) (append (mapcar (lambda (c) (cons c ?_)) '(?: ?* ?\" ?< ?> ??)) @@ -101,11 +121,9 @@ on your system, you could say something like: (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 'gnus-buffer-live-p "gnus-util")) +(autoload 'nnmail-message-id "nnmail") +(autoload 'mail-position-on-field "sendmail") +(autoload 'gnus-buffer-live-p "gnus-util") ;;; Header access macros. @@ -198,9 +216,9 @@ on your system, you could say something like: "Return the extra headers in HEADER." `(aref ,header 9)) -(defmacro mail-header-set-extra (header extra) +(defun mail-header-set-extra (header extra) "Set the extra headers in HEADER to EXTRA." - `(aset ,header 9 ',extra)) + (aset header 9 extra)) (defsubst make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." @@ -216,12 +234,16 @@ on your system, you could say something like: (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))) + (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id))) ;; Parsing headers and NOV lines. @@ -234,6 +256,8 @@ on your system, you could say something like: (skip-chars-forward " \t") (buffer-substring (point) (point-at-eol))) +(autoload 'ietf-drums-unfold-fws "ietf-drums") + (defun nnheader-parse-naked-head (&optional number) ;; This function unfolds continuation lines in this buffer ;; destructively. When this side effect is unwanted, use @@ -283,7 +307,7 @@ on your system, you could say something like: (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))) + (nnheader-generate-fake-message-id number))) ;; References. (progn (goto-char p) @@ -381,20 +405,29 @@ on your system, you could say something like: out))) out)) -(defmacro nnheader-nov-read-message-id () - '(let ((id (nnheader-nov-field))) +(eval-and-compile + (defvar nnheader-uniquify-message-id nil)) + +(defmacro nnheader-nov-read-message-id (&optional number) + `(let ((id (nnheader-nov-field))) (if (string-match "^<[^>]+>$" id) - id - (nnheader-generate-fake-message-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 (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 - (nnheader-nov-read-message-id) ; id + (nnheader-nov-read-message-id number) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines @@ -430,7 +463,7 @@ on your system, you could say something like: (let ((extra (mail-header-extra header))) (while extra (insert (symbol-name (caar extra)) - ": " (cdar extra) "\t") + ": " (if (stringp (cdar extra)) (cdar extra) "") "\t") (pop extra)))) (insert "\n") (backward-char 1) @@ -537,19 +570,16 @@ the line could be found." (defvar nntp-server-buffer nil) (defvar nntp-process-response nil) -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) (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*"))) - (set-buffer nntp-server-buffer) - (mm-enable-multibyte) + (unless (gnus-buffer-live-p nntp-server-buffer) + (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) + (with-current-buffer nntp-server-buffer (erase-buffer) + (mm-enable-multibyte) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. (set (make-local-variable 'nntp-process-response) nil) @@ -575,17 +605,27 @@ the line could be found." (if (eq nnheader-max-head-length t) ;; Just read the entire file. (nnheader-insert-file-contents file) - ;; Read 1K blocks until we find a separator. + ;; Read blocks of the size specified by `nnheader-head-chop-length' + ;; until we find a separator. (let ((beg 0) - format-alist) + (start (point)) + ;; Use `binary' to prevent the contents from being decoded, + ;; or it will change the number of characters that + ;; `insert-file-contents' returns. + (coding-system-for-read 'binary)) (while (and (eq nnheader-head-chop-length - (nth 1 (nnheader-insert-file-contents + (nth 1 (mm-insert-file-contents file nil beg (incf beg nnheader-head-chop-length)))) - (prog1 (not (search-forward "\n\n" nil t)) + ;; CRLF or CR might be used for the line-break code. + (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) (goto-char (point-max))) (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))))) + (< beg nnheader-max-head-length)))) + ;; Finally decode the contents. + (when (mm-coding-system-p nnheader-file-coding-system) + (mm-decode-coding-region start (point-max) + nnheader-file-coding-system)))) t)) (defun nnheader-article-p () @@ -621,8 +661,12 @@ the line could be found." ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) +(declare-function message-remove-header "message" + (header &optional is-regexp first reverse)) + (defun nnheader-replace-header (header new-value) "Remove HEADER and insert the NEW-VALUE." + (require 'message) (save-excursion (save-restriction (nnheader-narrow-to-headers) @@ -641,6 +685,14 @@ 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)) @@ -655,7 +707,6 @@ the line could be found." (erase-buffer)) (current-buffer)) -(eval-when-compile (defvar jka-compr-compression-info-list)) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) (concat "\\([0-9]+\\)\\(" @@ -674,14 +725,13 @@ the line could be found." (defsubst nnheader-file-to-number (file) "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) - (and (not (featurep 'xemacs)) - (> emacs-major-version 20))) + (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, @@ -734,8 +784,7 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt - cygwin))) + (memq system-type '(windows-nt cygwin))) ;; This is needed on NT and stuff, because ;; file-name-nondirectory is not enough to split ;; file names, containing ':', e.g. @@ -773,19 +822,22 @@ The first string in ARGS can be a format string." (apply 'format args))) nil) -(defun nnheader-get-report (backend) +(defun nnheader-get-report-string (backend) "Get the most recent report from BACKEND." (condition-case () - (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (nnheader-message 5 "")))) + (format "%s" (symbol-value (intern (format "%s-status-string" + backend)))) + (error ""))) + +(defun nnheader-get-report (backend) + "Get the most recent report from BACKEND." + (nnheader-message 5 (nnheader-get-report-string backend))) (defun nnheader-insert (format &rest args) "Clear the communication 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) + (with-current-buffer nntp-server-buffer (erase-buffer) (if (string-match "%" format) (insert (apply 'format format args)) @@ -827,7 +879,9 @@ without formatting." "Message if the Gnus backends are talkative." (if (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends)) - (apply 'message args) + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)) (apply 'format args))) (defun nnheader-be-verbose (level) @@ -897,9 +951,8 @@ first. Otherwise, find the newest one, though it may take a time." (car results) (car (sort results 'file-newer-than-file-p))))) -(eval-when-compile - (defvar ange-ftp-path-format) - (defvar efs-path-regexp)) +(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)) @@ -942,15 +995,24 @@ find-file-hooks, etc. (nnheader-insert-file-contents file))))))) (defun nnheader-find-file-noselect (&rest args) - (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) - (find-file-hooks nil) - (coding-system-for-read nnheader-file-coding-system)) - (apply 'find-file-noselect args))) + "Open a file with some variables bound. +See `find-file-noselect' for the arguments." + (letf* ((format-alist nil) + (auto-mode-alist (mm-auto-mode-alist)) + ((default-value '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) + (version-control 'never) + (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." @@ -1004,11 +1066,11 @@ find-file-hooks, etc. "Strip all \r's from the current buffer." (nnheader-skeleton-replace "\r")) -(defalias 'nnheader-run-at-time 'run-at-time) (defalias 'nnheader-cancel-timer 'cancel-timer) (defalias 'nnheader-cancel-function-timers 'cancel-function-timers) -(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) +;; When changing this function, consider changing `pop3-accept-process-output' +;; as well. (defun nnheader-accept-process-output (process) (accept-process-output process