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.
 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.
 
        * 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.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>
 
 
 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"))
 
   '("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)
 (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")))))
 
                               :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)
 ;;; 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)
              (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.
            (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)
 
 (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)
     (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))
                              (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)))
 
     (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))
        (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)
        (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-...
                (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))
 
            (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..
 
          (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)))))
 
        (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-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")
 (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)
   (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)
   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)
 
 (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)
     (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)
 
 (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)
 
 (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 ((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)
     (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)
       (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)
 
 (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
 
 
 ;;; 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))))
                 (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)))
        (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)
          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)
        (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
 ;;;
 
 ;;; 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)
 (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)
                       ;; 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
                             'B
                           'Q))))
         (start (concat