From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 1 Jun 2012 20:24:17 +0000 (-0400)
Subject: * lisp/gnus/nntp.el: Stop the `letf' madness.
X-Git-Tag: emacs-24.2.90~471^2~6^2~27
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2612a3d60a30a8bdef066d636b72ab810d1e6f95;p=emacs.git

* lisp/gnus/nntp.el: Stop the `letf' madness.
(nntp--report-1): New var.
(nntp-report): Merge nntp-report-1 into it.
(nntp-with-open-group-function): Set nntp--report-1 instead of modifying
the nntp-report function.
---

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 95fb18bfbd7..a51b9401caf 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,11 @@
 2012-06-01  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* nntp.el: Stop the `letf' madness.
+	(nntp--report-1): New var.
+	(nntp-report): Merge nntp-report-1 into it.
+	(nntp-with-open-group-function): Set nntp--report-1 instead of modifying
+	the nntp-report function.
+
 	* auth-source.el: Fix comment-style to follow the convention.
 
 2012-05-27  Katsumi Yamaoka  <yamaoka@jpl.org>
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 621aece8920..e237227f78a 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -344,26 +344,26 @@ backend doesn't catch this error.")
     (insert (format-time-string "%Y%m%dT%H%M%S.%3N")
 	    " " nntp-address " " string "\n")))
 
+(defvar nntp--report-1 nil)
+
 (defun nntp-report (&rest args)
   "Report an error from the nntp backend.  The first string in ARGS
 can be a format string.  For some commands, the failed command may be
 retried once before actually displaying the error report."
+  (if nntp--report-1
+      (progn
+        ;; Throw out to nntp-with-open-group-error so that the connection may
+        ;; be restored and the command retried."
+        (when nntp-record-commands
+          (nntp-record-command "*** CONNECTION LOST ***"))
+        (throw 'nntp-with-open-group-error t))
 
-  (when nntp-record-commands
-    (nntp-record-command "*** CALLED nntp-report ***"))
-
-  (nnheader-report 'nntp args)
+    (when nntp-record-commands
+      (nntp-record-command "*** CALLED nntp-report ***"))
 
-  (apply 'error args))
+    (nnheader-report 'nntp args)
 
-(defun nntp-report-1 (&rest args)
-  "Throws out to nntp-with-open-group-error so that the connection may
-be restored and the command retried."
-
-  (when nntp-record-commands
-    (nntp-record-command "*** CONNECTION LOST ***"))
-
-  (throw 'nntp-with-open-group-error t))
+    (apply 'error args)))
 
 (defmacro nntp-copy-to-buffer (buffer start end)
   "Copy string from unibyte current buffer to multibyte buffer."
@@ -633,10 +633,6 @@ be restored and the command retried."
    (t
     nil)))
 
-(eval-when-compile
-  (defvar nntp-with-open-group-internal nil)
-  (defvar nntp-report-n nil))
-
 (defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
   "Protect against servers that don't like clients that keep idle connections opens.
 The problem being that these servers may either close a connection or
@@ -647,9 +643,9 @@ connection timeouts (which may be several minutes) or
 `nntp-connection-timeout' has expired.  When these occur
 `nntp-with-open-group', opens a new connection then re-issues the NNTP
 command whose response triggered the error."
-  (letf ((nntp-report-n (symbol-function 'nntp-report))
-         ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
-         (nntp-with-open-group-internal nil))
+  (let ((nntp-report-n nntp--report-1)
+        (nntp--report-1 t)
+        (nntp-with-open-group-internal nil))
     (while (catch 'nntp-with-open-group-error
              ;; Open the connection to the server
              ;; NOTE: Existing connections are NOT tested.
@@ -685,7 +681,7 @@ command whose response triggered the error."
                  (when -timer
                    (nnheader-cancel-timer -timer)))
                nil))
-      (setf (symbol-function 'nntp-report) nntp-report-n))
+      (setq nntp--report-1 nntp-report-n))
     nntp-with-open-group-internal))
 
 (defmacro nntp-with-open-group (group server &optional connectionless &rest forms)