* gnus-util.el (gnus-bind-print-variables): New macro.

(gnus-prin1): Use it.
(gnus-prin1-to-string): Use it.
(gnus-pp): New function.
(gnus-pp-to-string): New function.

* gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace pp-to-string
 with gnus-pp-to-string.
* gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
* gnus-group.el (gnus-group-make-kiboze-group): Ditto.
* gnus-msg.el (gnus-debug): Ditto.
* gnus-score.el (gnus-score-save): Ditto.
* gnus-spec.el (gnus-update-format): Replace pp-to-string with
 gnus-pp-to-string.
* legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Replace pp with
 gnus-pp.
* score-mode.el (gnus-score-pretty-print): Ditto.
* webmail.el (webmail-debug): Ditto.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1f5b0af..70287ee 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
+2004-08-24  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-util.el (gnus-bind-print-variables): New macro.
+       (gnus-prin1): Use it.
+       (gnus-prin1-to-string): Use it.
+       (gnus-pp): New function.
+       (gnus-pp-to-string): New function.
+
+       * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace
+       pp-to-string with gnus-pp-to-string.
+       * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
+       * gnus-group.el (gnus-group-make-kiboze-group): Ditto.
+       * gnus-msg.el (gnus-debug): Ditto.
+       * gnus-score.el (gnus-score-save): Ditto.
+       * gnus-spec.el (gnus-update-format): Replace pp-to-string with
+       gnus-pp-to-string.
+       * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Replace pp
+       with gnus-pp.
+       * score-mode.el (gnus-score-pretty-print): Ditto.
+       * webmail.el (webmail-debug): Ditto.
+
 2004-08-23  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-art.el (article-display-face, article-display-x-face): Use

diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el
index c177c2a..a5e09ca 100644 (file)
--- a/lisp/gnus-cus.el
+++ b/lisp/gnus-cus.el
@@ -1,6 +1,6 @@
 ;;; gnus-cus.el --- customization commands for Gnus
 ;;
-;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
@@ -915,7 +915,8 @@ articles in the thread.
             (val (,field info))
             (deflt (if (,field defaults)
                        (concat " [" (gnus-trim-whitespace
-                                     (pp-to-string (,field defaults))) "]")))
+                                     (gnus-pp-to-string (,field defaults)))
+                               "]")))
             symb)
 
        (if (eq (car type) 'radio)

diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el
index e43e01c..ae5deba 100644 (file)
--- a/lisp/gnus-eform.el
+++ b/lisp/gnus-eform.el
@@ -1,5 +1,5 @@
 ;;; gnus-eform.el --- a mode for editing forms for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -106,7 +106,7 @@ of the buffer."
     (insert ";; Type `C-c C-c' after you've finished editing.\n")
     (insert "\n")
     (let ((p (point)))
-      (pp form (current-buffer))
+      (gnus-pp form)
       (insert "\n")
       (goto-char p))))
 

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 222c4f2..5e45ce3 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -2741,7 +2741,7 @@ score file entries for articles to include in the group."
       (make-directory score-dir))
     (with-temp-file score-file
       (let (emacs-lisp-mode-hook)
-       (pp scores (current-buffer))))))
+       (gnus-pp scores)))))
 
 (defun gnus-group-add-to-virtual (n vgroup)
   "Add the current group to a virtual group."

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 7c2c881..ae421f8 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -1521,14 +1521,14 @@ The source file has to be in the Emacs load path."
     (while olist
       (if (boundp (car olist))
          (ignore-errors
-           (pp `(setq ,(car olist)
-                      ,(if (or (consp (setq sym (symbol-value (car olist))))
-                               (and (symbolp sym)
-                                    (not (or (eq sym nil)
-                                             (eq sym t)))))
-                           (list 'quote (symbol-value (car olist)))
-                         (symbol-value (car olist))))
-               (current-buffer)))
+           (gnus-pp
+            `(setq ,(car olist)
+                   ,(if (or (consp (setq sym (symbol-value (car olist))))
+                            (and (symbolp sym)
+                                 (not (or (eq sym nil)
+                                          (eq sym t)))))
+                        (list 'quote (symbol-value (car olist)))
+                      (symbol-value (car olist))))))
        (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
       (setq olist (cdr olist)))
     (insert "\n\n")

diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index 084a203..3a79658 100644 (file)
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -1414,7 +1414,7 @@ If FORMAT, also format the current score file."
              ;; This is a normal score file, so we print it very
              ;; prettily.
              (let ((lisp-mode-syntax-table score-mode-syntax-table))
-               (pp score (current-buffer)))))
+               (gnus-pp score))))
          (gnus-make-directory (file-name-directory file))
          ;; If the score file is empty, we delete it.
          (if (zerop (buffer-size))

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index 203f957..83c020b 100644 (file)
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -1,5 +1,5 @@
 ;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -180,7 +180,7 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
     (pop-to-buffer "*Gnus Format*")
     (erase-buffer)
     (lisp-interaction-mode)
-    (insert (pp-to-string spec))))
+    (insert (gnus-pp-to-string spec))))
 
 (defun gnus-update-format-specifications (&optional force &rest types)
   "Update all (necessary) format specifications."

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 97f43e7..3b661bd 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,5 @@
 ;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -619,24 +619,49 @@ yield \"nnimap:yxa\"."
   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
     [menu-bar edit] 'undefined))
 
+(defmacro gnus-bind-print-variables (&rest forms)
+  "Bind print-* variables and evaluate FORMS.
+This macro is used with `prin1', `pp', etc. in order to ensure printed
+Lisp objects are loadable.  Bind `print-quoted' and `print-readably'
+to t, and `print-escape-multibyte', `print-escape-newlines',
+`print-escape-nonascii', `print-length', `print-level' and
+`print-string-length' to nil."
+  `(let ((print-quoted t)
+        (print-readably t)
+        ;;print-circle
+        ;;print-continuous-numbering
+        print-escape-multibyte
+        print-escape-newlines
+        print-escape-nonascii
+        ;;print-gensym
+        print-length
+        print-level
+        print-string-length)
+     ,@forms))
+
 (defun gnus-prin1 (form)
   "Use `prin1' on FORM in the current buffer.
-Bind `print-quoted' and `print-readably' to t while printing."
-  (let ((print-quoted t)
-       (print-readably t)
-       (print-escape-multibyte nil)
-       print-level print-length)
-    (prin1 form (current-buffer))))
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (prin1 form (current-buffer))))
 
 (defun gnus-prin1-to-string (form)
   "The same as `prin1'.
-Bind `print-quoted' and `print-readably' to t, and `print-length'
-and `print-level' to nil."
-  (let ((print-quoted t)
-       (print-readably t)
-       (print-length nil)
-       (print-level nil))
-    (prin1-to-string form)))
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (prin1-to-string form)))
+
+(defun gnus-pp (form)
+  "Use `pp' on FORM in the current buffer.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (pp form (current-buffer))))
+
+(defun gnus-pp-to-string (form)
+  "The same as `pp-to-string'.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (pp-to-string form)))
 
 (defun gnus-make-directory (directory)
   "Make DIRECTORY (and all its parents) if it doesn't exist."

diff --git a/lisp/legacy-gnus-agent.el b/lisp/legacy-gnus-agent.el
index e5c2ae4..2ddca1f 100644 (file)
--- a/lisp/legacy-gnus-agent.el
+++ b/lisp/legacy-gnus-agent.el
@@ -109,7 +109,7 @@ converted to the compressed format."
             (set-buffer buffer)
             (erase-buffer)
             (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n  ")
-            (let (print-level print-length) (pp gnus-agent-expire-days (current-buffer)))
+            (gnus-pp gnus-agent-expire-days)
 
             (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
             (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")

diff --git a/lisp/score-mode.el b/lisp/score-mode.el
index ff67a9e..a54b57f 100644 (file)
--- a/lisp/score-mode.el
+++ b/lisp/score-mode.el
@@ -1,6 +1,6 @@
 ;;; score-mode.el --- mode for editing Gnus score files
 
-;; Copyright (C) 1996, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001, 2004 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
@@ -28,6 +28,7 @@
 
 (eval-when-compile (require 'cl))
 (require 'mm-util)                     ; for mm-universal-coding-system
+(require 'gnus-util)                   ; for gnus-pp
 
 (defvar gnus-score-mode-hook nil
   "*Hook run in score mode buffers.")
@@ -94,7 +95,7 @@ This mode is an extended emacs-lisp mode.
   (let ((form (read (current-buffer))))
     (erase-buffer)
     (let ((emacs-lisp-mode-syntax-table score-mode-syntax-table))
-      (pp form (current-buffer))))
+      (gnus-pp form)))
   (goto-char (point-min)))
 
 (defun gnus-score-edit-exit ()

diff --git a/lisp/webmail.el b/lisp/webmail.el
index b2466a7..b967013 100644 (file)
--- a/lisp/webmail.el
+++ b/lisp/webmail.el
@@ -1,5 +1,5 @@
 ;;; webmail.el --- interface of web mail
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: hotmail netaddress my-deja netscape
@@ -196,7 +196,7 @@
     (insert "\n---------------- A bug at " str " ------------------\n")
     (mapcar #'(lambda (sym)
                (if (boundp sym)
-                   (pp `(setq ,sym ',(eval sym)) (current-buffer))))
+                   (gnus-pp `(setq ,sym ',(eval sym)))))
            '(webmail-type user))
     (insert "---------------- webmail buffer ------------------\n\n")
     (insert-buffer-substring webmail-buffer)