Synch to No Gnus 200402090253.
authoryamaoka <yamaoka>
Mon, 9 Feb 2004 03:03:54 +0000 (03:03 +0000)
committeryamaoka <yamaoka>
Mon, 9 Feb 2004 03:03:54 +0000 (03:03 +0000)
lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-score.el
lisp/imap.el
lisp/nnrss.el
lisp/rfc2047.el

index 6976d25..9bababb 100644 (file)
@@ -1,3 +1,29 @@
+2004-02-09  Jesper Harder  <harder@ifa.au.dk>
+
+       * rfc2047.el (rfc2047-qp-or-base64): New function to reduce
+       dependencies.
+       (rfc2047-encode): Use it.
+
+       * gnus-art.el (gnus-button-marker-list): Move before first
+       reference.
+
+       * imap.el (imap-parse-flag-list, imap-parse-body-extension)
+       (imap-parse-body): Fix format string mismatch.
+
+       * gnus-score.el (gnus-summary-increase-score): do.
+
+       * nnrss.el (nnrss-close): New function.
+
+2004-02-08  Jesper Harder  <harder@ifa.au.dk>
+
+       * nnrss.el (nnrss-make-filename): New function.
+       (nnrss-request-delete-group, nnrss-read-server-data)
+       (nnrss-save-server-data, nnrss-read-group-data)
+       (nnrss-save-group-data): Use it.
+       (nnrss-save-server-data, nnrss-save-group-data): Use gnus-prin1.
+       (nnrss-read-server-data, nnrss-read-group-data): Use load.
+       (nnrss-group-hashtb): Make it a hash table rather than an obarray.
+
 2004-02-07  Jesper Harder  <harder@ifa.au.dk>
 
        * mml.el (mml-compute-boundary-1): Don't uncompress files.
        * message.el (message-generate-headers-first): Don't quote nil
        and t in docstrings.
 
-       * imap.el (imap-id): do. 
+       * imap.el (imap-id): do.
 
        * gnus-agent.el (gnus-agent-consider-all-articles)
-       (gnus-agent-queue-mail): do.             
+       (gnus-agent-queue-mail): do.
 
 2004-02-05  Reiner Steib  <Reiner.Steib@gmx.de>
 
index 0e429eb..9a5882f 100644 (file)
@@ -1486,6 +1486,13 @@ This requires GNU Libidn, and by default only enabled if it is found."
   '("January" "February" "March" "April" "May" "June" "July" "August"
     "September" "October" "November" "December"))
 
+(defvar gnus-button-regexp nil)
+(defvar gnus-button-marker-list nil)
+;; Regexp matching any of the regexps from `gnus-button-alist'.
+
+(defvar gnus-button-last nil)
+;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
+
 (defvar article-goto-body-goes-to-point-min-p nil)
 (defvar gnus-article-wash-types nil)
 (defvar gnus-article-emphasis-alist nil)
@@ -6714,13 +6721,6 @@ HEADER is a regexp to match a header.  For a fuller explanation, see
                               :inline t
                               (integer :tag "Regexp group")))))
 
-(defvar gnus-button-regexp nil)
-(defvar gnus-button-marker-list nil)
-;; Regexp matching any of the regexps from `gnus-button-alist'.
-
-(defvar gnus-button-last nil)
-;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
-
 ;;; Commands:
 
 (defun gnus-article-push-button (event)
index e395cee..e656b32 100644 (file)
@@ -661,7 +661,7 @@ file for the command instead of the current score file."
              (gnus-score-insert-help "Match permanence" char-to-perm 2)))
 
          (gnus-score-kill-help-buffer)
-         (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+         (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
            (message ""))
          (unless (setq temporary (cadr (assq pchar char-to-perm)))
            ;; Deal with der(r)ided superannuated paradigms.
index 3b3baf5..c204a47 100644 (file)
@@ -2433,7 +2433,7 @@ Return nil if no complete line has arrived."
 
 (defun imap-parse-flag-list ()
   (let (flag-list start)
-    (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
     (while (and (not (eq (char-after) ?\)))
                (setq start (progn
                              (imap-forward)
@@ -2442,7 +2442,7 @@ Return nil if no complete line has arrived."
                              (point)))
                (> (skip-chars-forward "^ )" (point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))
-    (assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
     (imap-forward)
     (nreverse flag-list)))
 
@@ -2527,7 +2527,7 @@ Return nil if no complete line has arrived."
        (while (eq (char-after) ?\ )
          (imap-forward)
          (push (imap-parse-body-extension) b-e))
-       (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
+       (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
        (imap-forward)
        (nreverse b-e))
     (or (imap-parse-number)
@@ -2651,7 +2651,7 @@ Return nil if no complete line has arrived."
                (push (and (imap-parse-nil) nil) body))
              (setq body
                    (append (imap-parse-body-ext) body))) ;; body-ext-...
-           (assert (eq (char-after) ?\)) t "In imap-parse-body")
+           (assert (eq (char-after) ?\)) nil "In imap-parse-body")
            (imap-forward)
            (nreverse body))
 
@@ -2711,7 +2711,7 @@ Return nil if no complete line has arrived."
          (push (imap-parse-nstring) body) ;; body-fld-md5
          (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
 
-       (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
+       (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
        (imap-forward)
        (nreverse body)))))
 
index 35739a6..3368bb1 100644 (file)
@@ -54,7 +54,7 @@
 (defvoo nnrss-group-max 0)
 (defvoo nnrss-group-min 1)
 (defvoo nnrss-group nil)
-(defvoo nnrss-group-hashtb nil)
+(defvoo nnrss-group-hashtb (make-hash-table :test 'equal))
 (defvoo nnrss-status-string "")
 
 (defconst nnrss-version "nnrss 1.0")
@@ -232,14 +232,8 @@ ARTICLE is the article number of the current headline.")
   (setq nnrss-server-data
        (delq (assoc group nnrss-server-data) nnrss-server-data))
   (nnrss-save-server-data server)
-  (let ((file (expand-file-name
-              (nnrss-translate-file-chars
-               (concat group (and server
-                                  (not (equal server ""))
-                                  "-")
-                       server ".el")) nnrss-directory)))
-    (ignore-errors
-      (delete-file file)))
+  (ignore-errors
+    (delete-file (nnrss-make-filename group server)))
   t)
 
 (deffoo nnrss-request-list-newsgroups (&optional server)
@@ -312,85 +306,60 @@ ARTICLE is the article number of the current headline.")
 
 (defun nnrss-read-server-data (server)
   (setq nnrss-server-data nil)
-  (let ((file (expand-file-name
-              (nnrss-translate-file-chars
-               (concat "nnrss" (and server
-                                    (not (equal server ""))
-                                    "-")
-                       server
-                       ".el"))
-              nnrss-directory)))
+  (let ((file (nnrss-make-filename "nnrss" server)))
     (when (file-exists-p file)
-      (with-temp-buffer
-       (let ((coding-system-for-read 'binary)
-             emacs-lisp-mode-hook)
-         (insert-file-contents file)
-         (emacs-lisp-mode)
-         (goto-char (point-min))
-         (eval-buffer))))))
+      (let ((coding-system-for-read 'binary))
+       (load file nil nil t)))))
 
 (defun nnrss-save-server-data (server)
   (gnus-make-directory nnrss-directory)
-  (let ((file (expand-file-name
-              (nnrss-translate-file-chars
-               (concat "nnrss" (and server
-                                    (not (equal server ""))
-                                    "-")
-                       server ".el"))
-              nnrss-directory)))
-    (let ((coding-system-for-write 'binary)
-         print-level print-length)
-      (with-temp-file file
-       (insert "(setq nnrss-group-alist '"
-               (prin1-to-string nnrss-group-alist)
-               ")\n")
-       (insert "(setq nnrss-server-data '"
-               (prin1-to-string nnrss-server-data)
-               ")\n")))))
+  (let ((coding-system-for-write 'binary))
+    (with-temp-file (nnrss-make-filename "nnrss" server)
+      (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist))
+      (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data)))))
 
 (defun nnrss-read-group-data (group server)
   (setq nnrss-group-data nil)
-  (setq nnrss-group-hashtb (gnus-make-hashtable))
+  (clrhash nnrss-group-hashtb)
   (let ((pair (assoc group nnrss-server-data)))
     (setq nnrss-group-max (or (cadr pair) 0))
     (setq nnrss-group-min (+ nnrss-group-max 1)))
-  (let ((file (expand-file-name
-              (nnrss-translate-file-chars
-               (concat group (and server
-                                  (not (equal server ""))
-                                  "-")
-                       server ".el"))
-              nnrss-directory)))
+  (let ((file (nnrss-make-filename group server)))
     (when (file-exists-p file)
-      (with-temp-buffer
-       (let ((coding-system-for-read 'binary)
-             emacs-lisp-mode-hook)
-         (insert-file-contents file)
-         (emacs-lisp-mode)
-         (goto-char (point-min))
-         (eval-buffer)))
+      (let ((coding-system-for-read 'binary))
+       (load file nil t t))
       (dolist (e nnrss-group-data)
-       (gnus-sethash (nth 2 e) e nnrss-group-hashtb)
-       (if (and (car e) (> nnrss-group-min (car e)))
-           (setq nnrss-group-min (car e)))
-       (if (and (car e) (< nnrss-group-max (car e)))
-           (setq nnrss-group-max (car e)))))))
+       (puthash (nth 2 e) e nnrss-group-hashtb)
+       (when (and (car e) (> nnrss-group-min (car e)))
+         (setq nnrss-group-min (car e)))
+       (when (and (car e) (< nnrss-group-max (car e)))
+         (setq nnrss-group-max (car e)))))))
 
 (defun nnrss-save-group-data (group server)
   (gnus-make-directory nnrss-directory)
-  (let ((file (expand-file-name
-              (nnrss-translate-file-chars
-               (concat group (and server
-                                  (not (equal server ""))
-                                  "-")
-                       server ".el"))
-              nnrss-directory)))
-    (let ((coding-system-for-write 'binary)
-         print-level print-length)
-      (with-temp-file file
-       (insert "(setq nnrss-group-data '"
-               (prin1-to-string nnrss-group-data)
-               ")\n")))))
+  (let ((coding-system-for-write 'binary))
+    (with-temp-file (nnrss-make-filename group server)
+      (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data )))))
+
+(defun nnrss-make-filename (name server)
+  (expand-file-name
+   (nnrss-translate-file-chars
+    (concat name
+           (and server
+                (not (equal server ""))
+                "-")
+           server
+           ".el"))
+   nnrss-directory))
+
+(gnus-add-shutdown 'nnrss-close 'gnus)
+
+(defun nnrss-close ()
+  "Clear internal nnrss variables."
+  (setq nnrss-group-data nil
+       nnrss-server-data nil
+       nnrss-group-hashtb nil
+       nnrss-group-alist nil))
 
 ;;; URL interface
 
@@ -452,7 +421,7 @@ ARTICLE is the article number of the current headline.")
                 (eq (intern (concat rss-ns "item")) (car item))
                 (setq url (nnrss-decode-entities-unibyte-string
                            (nnrss-node-text rss-ns 'link (cddr item))))
-                (not (gnus-gethash url nnrss-group-hashtb)))
+                (not (gethash url nnrss-group-hashtb)))
        (setq subject (nnrss-node-text rss-ns 'title item))
        (setq extra (or (nnrss-node-text content-ns 'encoded item)
                        (nnrss-node-text rss-ns 'description item)))
@@ -472,7 +441,7 @@ ARTICLE is the article number of the current headline.")
          date
          (and extra (nnrss-decode-entities-unibyte-string extra)))
         nnrss-group-data)
-       (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb)
+       (puthash url (car nnrss-group-data) nnrss-group-hashtb)
        (setq changed t)))
     (when changed
       (nnrss-save-group-data group server)
index 0cbb732..f8796d5 100644 (file)
@@ -97,6 +97,25 @@ quoted-printable and base64 respectively.")
 ;;; Functions for encoding RFC2047 messages
 ;;;
 
+(defun rfc2047-qp-or-base64 ()
+  "Return the type with which to encode the buffer.
+This is either `base64' or `quoted-printable'."
+  (save-excursion
+    (let ((limit (min (point-max) (+ 2000 (point-min))))
+         (n8bit 0))
+      (goto-char (point-min))
+      (skip-chars-forward "\x20-\x7f\r\n\t" limit)
+      (while (< (point) limit)
+       (incf n8bit)
+       (forward-char 1)
+       (skip-chars-forward "\x20-\x7f\r\n\t" limit))
+      (if (or (< (* 6 n8bit) (- limit (point-min)))
+             ;; Don't base64, say, a short line with a single
+             ;; non-ASCII char when splitting parts by charset.
+             (= n8bit 1))
+         'quoted-printable
+       'base64))))
+
 (defun rfc2047-narrow-to-field ()
   "Narrow the buffer to the header on the current line."
   (beginning-of-line)
@@ -382,7 +401,7 @@ By default, the region is treated as containing addresses (see
                       ;; encoding, choose the one that's shorter.
                       (save-restriction
                         (narrow-to-region b e)
-                        (if (eq (mm-qp-or-base64) 'base64)
+                        (if (eq (rfc2047-qp-or-base64) 'base64)
                             'B
                           'Q))))
         (start (concat