X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=2ce5cb8af5f9a26c0429b1fdc81e98833973dc40;hb=997404c721a1de533aa9f82d4d5bbc5447bfc23d;hp=cad34db1eeff0f1b54c447078050b74af85ea2cd;hpb=8b5af94e55ef83ee46b42d32d92fa1ce95dcacf5;p=gnus

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index cad34db1e..2ce5cb8af 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,8 +1,7 @@
 ;;; 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,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2015 Free Software
+;; Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -41,11 +40,13 @@
 (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"))
+(autoload 'gnus-range-add "gnus-range")
+(autoload 'gnus-remove-from-range "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.
@@ -75,7 +76,7 @@ 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))
       ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
       ;;
@@ -86,14 +87,21 @@ Integer values will in effect be rounded up to the nearest multiple of
       ;; 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)
+    ;; 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 ?_))
 		      '(?: ?* ?\" ?< ?> ??))
@@ -112,11 +120,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.
 
@@ -358,15 +364,13 @@ on your system, you could say something like:
 	      (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)
+			    (goto-char  (- (point) 2))
 			  (point)))))
       (with-temp-buffer
 	(insert-buffer-substring cur beg end)
@@ -456,7 +460,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)
@@ -563,8 +567,6 @@ 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)
 
@@ -656,8 +658,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)
@@ -775,8 +781,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.
@@ -814,19 +819,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))
@@ -986,18 +994,18 @@ find-file-hooks, etc.
 (defun nnheader-find-file-noselect (&rest args)
   "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)
-	 (version-control 'never)
-	 (ffh (if (boundp 'find-file-hook)
-		  'find-file-hook
-		'find-file-hooks))
-	 (val (symbol-value ffh)))
+  (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)
@@ -1058,6 +1066,8 @@ See `find-file-noselect' for the arguments."
 (defalias 'nnheader-cancel-timer 'cancel-timer)
 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
 
+;; When changing this function, consider changing `pop3-accept-process-output'
+;; as well.
 (defun nnheader-accept-process-output (process)
   (accept-process-output
    process
@@ -1066,6 +1076,46 @@ See `find-file-noselect' for the arguments."
 		   (truncate nnheader-read-timeout))
 		1000))))
 
+(defun nnheader-update-marks-actions (backend-marks actions)
+  (dolist (action actions)
+    (let ((range (nth 0 action))
+	  (what  (nth 1 action))
+	  (marks (nth 2 action)))
+      (dolist (mark marks)
+	(setq backend-marks
+	      (gnus-update-alist-soft
+	       mark
+	       (cond
+		((eq what 'add)
+		 (gnus-range-add (cdr (assoc mark backend-marks)) range))
+		((eq what 'del)
+		 (gnus-remove-from-range
+		  (cdr (assoc mark backend-marks)) range))
+		((eq what 'set)
+		 range))
+	       backend-marks)))))
+  backend-marks)
+
+(defmacro nnheader-insert-buffer-substring (buffer &optional start end)
+  "Copy string from unibyte buffer to multibyte current buffer."
+  (if (featurep 'xemacs)
+      `(insert-buffer-substring ,buffer ,start ,end)
+    `(if enable-multibyte-characters
+	 (insert (with-current-buffer ,buffer
+		   (mm-string-to-multibyte
+		    ,(if (or start end)
+			 `(buffer-substring (or ,start (point-min))
+					    (or ,end (point-max)))
+		       '(buffer-string)))))
+       (insert-buffer-substring ,buffer ,start ,end))))
+
+(defvar nnheader-last-message-time '(0 0))
+(defun nnheader-message-maybe (&rest args)
+  (let ((now (current-time)))
+    (when (> (float-time (time-subtract now nnheader-last-message-time)) 1)
+      (setq nnheader-last-message-time now)
+      (apply 'nnheader-message args))))
+
 (when (featurep 'xemacs)
   (require 'nnheaderxm))
 
@@ -1073,5 +1123,4 @@ See `find-file-noselect' for the arguments."
 
 (provide 'nnheader)
 
-;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202
 ;;; nnheader.el ends here