Importing pgnus-0.10
authorichikawa <ichikawa>
Mon, 31 Aug 1998 12:16:07 +0000 (12:16 +0000)
committerichikawa <ichikawa>
Mon, 31 Aug 1998 12:16:07 +0000 (12:16 +0000)
20 files changed:
lisp/ChangeLog
lisp/base64.el
lisp/gnus-art.el
lisp/gnus-ems.el
lisp/gnus-msg.el
lisp/gnus-sum.el
lisp/gnus-util.el
lisp/gnus.el
lisp/lpath.el
lisp/message.el
lisp/mm-decode.el
lisp/mm-encode.el
lisp/mm-util.el [new file with mode: 0644]
lisp/nnfolder.el
lisp/qp.el
lisp/rfc1522.el [new file with mode: 0644]
lisp/rfc2047.el [new file with mode: 0644]
texi/ChangeLog
texi/gnus.texi
texi/message.texi

index 5afb31d..acb8c2a 100644 (file)
@@ -1,3 +1,62 @@
+Mon Aug 31 12:43:46 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v0.10 is released.
+
+1998-08-31 11:45:13  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow
+       hook to be run.
+
+1998-08-30 17:59:07  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * rfc2047.el (rfc2047-encodable-p): Use find-charset-region.
+
+       * mm-util.el (mm-charsets-in-region): Removed.
+
+       * rfc2047.el: Renamed file.
+
+       * gnus-msg.el (gnus-copy-article-buffer): Multibyte.
+
+       * message.el (message-mode): Set multibyte.
+
+       * mm-util.el (mm-charsets-in-region): Copied here.
+
+       * gnus-util.el: Removed gnus-truncate-string.
+
+       * gnus-art.el (gnus-article-decode-mime-words): Use 1522.
+
+       * rfc1522.el (rfc1522-unencoded-charsets): New variable.
+       (rfc1522-encodable-p): New function.
+       (rfc1522-encode-message-header): Use it.
+
+Sun Aug 30 17:46:01 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v0.9 is released.
+
+1998-08-30 16:13:08  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-util.el: Shadow encode-coding-string.
+
+       * base64.el (base64-encode-region): Don't add newline.
+
+       * rfc1522.el (rfc1522-narrow-to-field): Copied here.
+
+       * mm-util.el: New file.
+
+       * mm-decode.el: Somewhat depleted.
+       * mm-encode.el: Ditto.
+
+       * rfc1522.el: New file.
+
+       * mm-util.el (mm-replace-chars-in-string): Copied here.
+
+       * mm-encode.el (mm-q-encode-region): New function.
+
+       * qp.el (quoted-printable-encode-region): Take an optional CLASS
+       param. 
+
+       * mm-encode.el (mm-encode-word-region): Downcase.
+
 Sun Aug 30 15:28:01 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Pterodactyl Gnus v0.8 is released.
index b96e890..88493c6 100644 (file)
@@ -237,8 +237,11 @@ base64-encoder-program.")
                (base64-insert-char (aref alphabet (logand (lsh bits -6) 63))
                                    1 nil work-buffer)
                (base64-insert-char ?= 1 nil work-buffer)))
-           (if (> cols 0)
-               (base64-insert-char ?\n 1 nil work-buffer)))
+           ;;;!!! LMI removed this, because he didn't like having
+           ;;;!!! newlines added to the end of the encoding.
+           ;;(if (> cols 0)
+           ;;  (base64-insert-char ?\n 1 nil work-buffer))
+           )
          (or (markerp end) (setq end (set-marker (make-marker) end)))
          (goto-char start)
          (insert-buffer-substring work-buffer)
index cec51c0..d3b2357 100644 (file)
@@ -952,7 +952,7 @@ characters to translate to."
     (set-buffer gnus-article-buffer)
     (let ((inhibit-point-motion-hooks t)
          buffer-read-only)
-      (mm-decode-words-region (point-min) (point-max)))))
+      (rfc2047-decode-region (point-min) (point-max)))))
 
 (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
 (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
@@ -962,7 +962,7 @@ characters to translate to."
        (buffer-read-only nil))
     (save-restriction
       (message-narrow-to-head)
-      (mm-decode-words-region (point-min) (point-max)))))
+      (rfc2047-decode-region (point-min) (point-max)))))
 
 (defun article-de-quoted-unreadable (&optional force)
   "Translate a quoted-printable-encoded article.
index 34625a2..f0e4362 100644 (file)
     ;; `emacs-version'. In this case, implementation for XEmacs/mule
     ;; may be able to share between XEmacs and XEmacs/mule.
 
-    (defalias 'gnus-truncate-string 'truncate-string)
-
     (defvar gnus-summary-display-table nil
       "Display table used in summary mode buffers.")
     (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
index 0d370f7..6d4aee0 100644 (file)
@@ -354,6 +354,10 @@ header line with the old Message-ID."
   ;; this buffer should be passed to all mail/news reply/post routines.
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
   (buffer-disable-undo gnus-article-copy)
+  (save-excursion
+    (set-buffer gnus-article-copy)
+    (when (fboundp 'set-buffer-multibyte)
+      (set-buffer-multibyte t)))
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)
index e2d17c9..ad03a14 100644 (file)
@@ -3057,8 +3057,8 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
          (setq header
                (make-full-mail-header
                 number                 ; number
-                (mm-decode-words-string (gnus-nov-field)) ; subject
-                (mm-decode-words-string (gnus-nov-field)) ; from
+                (rfc2047-decode-string (gnus-nov-field)) ; subject
+                (rfc2047-decode-string (gnus-nov-field)) ; from
                 (gnus-nov-field)       ; date
                 (or (gnus-nov-field)
                     (nnheader-generate-fake-message-id)) ; id
@@ -4200,7 +4200,7 @@ If WHERE is `summary', the summary mode line format will be used."
          ;; We might have to chop a bit of the string off...
          (when (> (length mode-string) max-len)
            (setq mode-string
-                 (concat (gnus-truncate-string mode-string (- max-len 3))
+                 (concat (truncate-string mode-string (- max-len 3))
                          "...")))
          ;; Pad the mode string a bit.
          (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
@@ -4400,13 +4400,13 @@ The resulting hash table is returned, or nil if no Xrefs were found."
            (progn
              (goto-char p)
              (if (search-forward "\nsubject: " nil t)
-                 (mm-decode-words-string (nnheader-header-value))
+                 (rfc2047-decode-string (nnheader-header-value))
                "(none)"))
            ;; From.
            (progn
              (goto-char p)
              (if (search-forward "\nfrom: " nil t)
-                 (mm-decode-words-string (nnheader-header-value))
+                 (rfc2047-decode-string (nnheader-header-value))
                "(nobody)"))
            ;; Date.
            (progn
index 069e6a6..3ccd1c8 100644 (file)
@@ -75,9 +75,6 @@
         (set symbol nil))
      symbol))
 
-(defun gnus-truncate-string (str width)
-  (substring str 0 width))
-
 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
 ;; to limit the length of a string.  This function is necessary since
 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
index 5d3fa0d..46d1469 100644 (file)
@@ -250,7 +250,7 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "0.8"
+(defconst gnus-version-number "0.10"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
@@ -1571,7 +1571,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
      ("info" Info-goto-node)
      ("pp" pp pp-to-string pp-eval-expression)
      ("qp" quoted-printable-decode-region quoted-printable-decode-string)
-     ("mm-decode" mm-decode-words-region mm-decode-words-string)
+     ("rfc2047" rfc2047-decode-region rfc2047-decode-string)
      ("ps-print" ps-print-preprint)
      ("mail-extr" mail-extract-address-components)
      ("browse-url" browse-url)
index c48c08e..2afa7dc 100644 (file)
@@ -31,7 +31,8 @@
                     w3-form-encode-xwfu gnus-mule-get-coding-system
                     decode-coding-string mail-aliases-setup
                     mm-copy-tree url-view-url w3-prepare-buffer
-                    set-buffer-multibyte))
+                    set-buffer-multibyte
+                    find-non-ascii-charset-region char-charset))
       (maybe-bind '(global-face-data
                    mark-active transient-mark-mode mouse-selection-click-count
                    mouse-selection-click-count-buffer buffer-display-table
index 6b4587b..24cbee5 100644 (file)
@@ -39,7 +39,7 @@
 (if (string-match "XEmacs\\|Lucid" emacs-version)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
-(require 'mm-encode)
+(require 'rfc2047)
 
 (defgroup message '((user-mail-address custom-variable)
                    (user-full-name custom-variable))
@@ -1386,6 +1386,8 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (setq adaptive-fill-first-line-regexp
        (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
                adaptive-fill-first-line-regexp))
+  (when (fboundp 'set-buffer-multibyte)
+    (set-buffer-multibyte t))
   (run-hooks 'text-mode-hook 'message-mode-hook))
 
 \f
@@ -2020,7 +2022,7 @@ the user from the mailer."
       (let ((message-deletable-headers
             (if news nil message-deletable-headers)))
        (message-generate-headers message-required-mail-headers))
-      (mm-encode-message-header)
+      (rfc2047-encode-message-header)
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (unwind-protect
@@ -2191,7 +2193,7 @@ to find out how to use this."
       (message-narrow-to-headers)
       ;; Insert some headers.
       (message-generate-headers message-required-news-headers)
-      (mm-encode-message-header)
+      (rfc2047-encode-message-header)
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (message-cleanup-headers)
index c7f8681..9d0a44b 100644 (file)
@@ -3,7 +3,7 @@
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; This file is not yet part of GNU Emacs.
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 
 ;;; Code:
 
-(require 'base64)
-(require 'qp)
-(require 'nnheader)
-
-(defvar mm-charset-regexp (concat "[^" "][\000-\040()<>@,\;:\\\"/?.=" "]+"))
-
-(defvar mm-encoded-word-regexp
-  (concat "=\\?\\(" mm-charset-regexp "\\)\\?\\(B\\|Q\\)\\?"
-         "\\([!->@-~]+\\)\\?="))
-
-(defun mm-decode-words-region (start end)
-  "Decode MIME-encoded words in region between START and END."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      ;; Remove whitespace between encoded words.
-      (while (re-search-forward
-             (concat "\\(" mm-encoded-word-regexp "\\)"
-                     "\\(\n?[ \t]\\)+"
-                     "\\(" mm-encoded-word-regexp "\\)")
-             nil t)
-       (delete-region (goto-char (match-end 1)) (match-beginning 6)))
-      ;; Decode the encoded words.
-      (goto-char (point-min))
-      (while (re-search-forward mm-encoded-word-regexp nil t)
-       (insert (mm-decode-word
-                (prog1
-                    (match-string 0)
-                  (delete-region (match-beginning 0) (match-end 0)))))))))
-
-(defun mm-decode-words-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (with-temp-buffer
-   (insert string)
-   (inline
-     (mm-decode-words-region (point-min) (point-max)))
-   (buffer-string)))
-
-(defun mm-decode-word (word)
-  "Decode WORD and return it if it is an encoded word.
-Return WORD if not."
-  (if (not (string-match mm-encoded-word-regexp word))
-      word
-    (or
-     (condition-case nil
-        (mm-decode-text
-         (match-string 1 word)
-         (upcase (match-string 2 word))
-         (match-string 3 word))
-       (error word))
-     word)))
-
-(eval-and-compile
-  (if (fboundp 'decode-coding-string)
-      (fset 'mm-decode-coding-string 'decode-coding-string)
-    (fset 'mm-decode-coding-string (lambda (s a) s))))
-
-(eval-and-compile
-  (if (fboundp 'coding-system-list)
-      (fset 'mm-coding-system-list 'coding-system-list)
-    (fset 'mm-coding-system-list 'ignore)))
-
-(defun mm-decode-text (charset encoding string)
-  "Decode STRING as an encoded text.
-Valid ENCODINGs are \"B\" and \"Q\".
-If your Emacs implementation can't decode CHARSET, it returns nil."
-  (let ((cs (mm-charset-to-coding-system charset)))
-    (when cs
-      (mm-decode-coding-string
-       (cond
-       ((equal "B" encoding)
-        (base64-decode string))
-       ((equal "Q" encoding)
-        (quoted-printable-decode-string
-         (nnheader-replace-chars-in-string string ?_ ? )))
-       (t (error "Invalid encoding: %s" encoding)))
-       cs))))
-
-(defvar mm-charset-coding-system-alist
-  (let ((rest
-        '((us-ascii . iso-8859-1)
-          (gb2312 . cn-gb-2312)
-          (iso-2022-jp-2 . iso-2022-7bit-ss2)
-          (x-ctext . ctext)))
-       (systems (mm-coding-system-list))
-       dest)
-    (while rest
-      (let ((pair (car rest)))
-       (unless (memq (car pair) systems)
-         (setq dest (cons pair dest))))
-      (setq rest (cdr rest)))
-    dest)
-  "Charset/coding system alist.")
-
-(defun mm-charset-to-coding-system (charset &optional lbt)
-  "Return coding-system corresponding to CHARSET.
-CHARSET is a symbol naming a MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as the line break code type of the coding system."
-  (when (stringp charset)
-    (setq charset (intern (downcase charset))))
-  (setq charset
-       (or (cdr (assq charset mm-charset-coding-system-alist))
-           charset))
-  (when lbt
-    (setq charset (intern (format "%s-%s" charset lbt))))
-  (cond
-   ;; Running in a non-MULE environment.
-   ((and (null (mm-coding-system-list))
-        (eq charset 'iso-8859-1))
-    charset)
-   ;; Check to see whether we can handle this charset.
-   ((memq charset (mm-coding-system-list))
-    charset)
-   ;; Nope.
-   (t
-    nil)))
-
 (provide 'mm-decode)
 
-;; qp.el ends here
+;; mm-decode.el ends here
index 875d12f..38cd97a 100644 (file)
@@ -3,7 +3,7 @@
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; This file is not yet part of GNU Emacs.
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 
 ;;; Code:
 
-(defvar mm-header-encoding-alist
-  '(("X-Nsubject" . iso-2022-jp-2)
-    ("Newsgroups" . nil)
-    ("Message-ID" . nil)
-    (t . mime))
-  "*Header/encoding method alist.
-The list is traversed sequentially.  The keys can either be a
-header regexp or `t'.
-
-The values can be:
-
-1) nil, in which case no encoding is done;
-2) `mime', in which case the header will be encoded according to RFC1522;
-3) a charset, in which case it will be encoded as that charse;
-4) `default', in which case the field will be encoded as the rest
-   of the article.")
-
-(defvar mm-mime-mule-charset-alist
-  '((us-ascii ascii)
-    (iso-8859-1 latin-iso8859-1)
-    (iso-8859-2 latin-iso8859-2)
-    (iso-8859-3 latin-iso8859-3)
-    (iso-8859-4 latin-iso8859-4)
-    (iso-8859-5 cyrillic-iso8859-5)
-    (koi8-r cyrillic-iso8859-5)
-    (iso-8859-6 arabic-iso8859-6)
-    (iso-8859-7 greek-iso8859-7)
-    (iso-8859-8 hebrew-iso8859-8)
-    (iso-8859-9 latin-iso8859-9)
-    (iso-2022-jp latin-jisx0201
-                japanese-jisx0208-1978 japanese-jisx0208)
-    (euc-kr korean-ksc5601)
-    (cn-gb-2312 chinese-gb2312)
-    (cn-big5 chinese-big5-1 chinese-big5-2)
-    (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
-                  latin-jisx0201 japanese-jisx0208-1978
-                  chinese-gb2312 japanese-jisx0208
-                  korean-ksc5601 japanese-jisx0212)
-    (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
-                   latin-jisx0201 japanese-jisx0208-1978
-                   chinese-gb2312 japanese-jisx0208
-                   korean-ksc5601 japanese-jisx0212
-                   chinese-cns11643-1 chinese-cns11643-2)
-    (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
-                   cyrillic-iso8859-5 greek-iso8859-7
-                   latin-jisx0201 japanese-jisx0208-1978
-                   chinese-gb2312 japanese-jisx0208
-                   korean-ksc5601 japanese-jisx0212
-                   chinese-cns11643-1 chinese-cns11643-2
-                   chinese-cns11643-3 chinese-cns11643-4
-                   chinese-cns11643-5 chinese-cns11643-6
-                   chinese-cns11643-7))
-  "Alist of MIME-charset/MULE-charsets.")
-
-(defvar mm-mime-charset-encoding-alist
-  '((us-ascii . nil)
-    (iso-8859-1 . Q)
-    (iso-8859-2 . Q)
-    (iso-8859-3 . Q)
-    (iso-8859-4 . Q)
-    (iso-8859-5 . Q)
-    (koi8-r . Q)
-    (iso-8859-7 . Q)
-    (iso-8859-8 . Q)
-    (iso-8859-9 . Q)
-    (iso-2022-jp . B)
-    (iso-2022-kr . B)
-    (gb2312 . B)
-    (cn-gb . B)
-    (cn-gb-2312 . B)
-    (euc-kr . B)
-    (iso-2022-jp-2 . B)
-    (iso-2022-int-1 . B))
-  "Alist of MIME charsets to MIME encodings.
-Valid encodings are nil, `Q' and `B'.")
-
-(defvar mm-mime-encoding-function-alist
-  '((Q . quoted-printable-encode-region)
-    (B . base64-encode-region)
-    (nil . ignore))
-  "Alist of MIME encodings to encoding functions.")
-
-(defun mm-encode-message-header ()
-  "Encode the message header according to `mm-header-encoding-alist'."
-  (when (featurep 'mule)
-    (save-excursion
-      (save-restriction
-       (message-narrow-to-headers)
-       (let ((alist mm-header-encoding-alist)
-             elem method)
-         (while (not (eobp))
-           (save-restriction
-             (message-narrow-to-field)
-             (when (find-non-ascii-charset-region (point-min) (point-max))
-               ;; We found something that may perhaps be encoded.
-               (while (setq elem (pop alist))
-                 (when (or (and (stringp (car elem))
-                                (looking-at (car elem)))
-                           (eq (car elem) t))
-                   (setq alist nil
-                         method (cdr elem))))
-               (when method
-                 (cond
-                  ((eq method 'mime)
-                   (mm-encode-words-region (point-min) (point-max)))
-                  ;; Hm.
-                  (t))))
-             (goto-char (point-max)))))))))
-
-(defun mm-encode-words-region (b e)
-  "Encode all encodable words in REGION."
-  (let (prev c start qstart qprev qend)
-    (save-excursion
-      (goto-char b)
-      (while (re-search-forward "[^ \t\n]+" nil t)
-       (save-restriction
-         (narrow-to-region (match-beginning 0) (match-end 0))
-         (goto-char (setq start (point-min)))
-         (setq prev nil)
-         (while (not (eobp))
-           (unless (eq (setq c (char-charset (following-char))) 'ascii)
-             (cond
-              ((eq c prev)
-               )
-              ((null prev)
-               (setq qstart (or qstart start)
-                     qend (point-max)
-                     qprev c)
-               (setq prev c))
-              (t
-               ;(mm-encode-word-region start (setq start (point)) prev)
-               (setq prev c)
-               )))
-           (forward-char 1)))
-       (when (and (not prev) qstart)
-         (mm-encode-word-region qstart qend qprev)
-         (setq qstart nil)))
-      (when qstart
-       (mm-encode-word-region qstart qend qprev)
-       (setq qstart nil)))))
-
-(defun mm-encode-words-string (string)
-  "Encode words in STRING."
-  (with-temp-buffer
-    (insert string)
-    (mm-encode-words-region (point-min) (point-max))
-    (buffer-string)))
-
-(defun mm-mule-charset-to-mime-charset (charset)
-  "Return the MIME charset corresponding to MULE CHARSET."
-  (let ((alist mm-mime-mule-charset-alist)
-       out)
-    (while alist
-      (when (memq charset (cdar alist))
-       (setq out (caar alist)
-             alist nil))
-      (pop alist))
-    out))
-
-(defun mm-encode-word-region (b e charset)
-  "Encode the word in the region with CHARSET."
-  (let* ((mime-charset (mm-mule-charset-to-mime-charset charset))
-        (encoding (cdr (assq mime-charset mm-mime-charset-encoding-alist))))
-    (save-restriction
-      (narrow-to-region b e)
-      (funcall (cdr (assq encoding mm-mime-encoding-function-alist))
-              b e)
-      (goto-char (point-min))
-      (insert "=?" (upcase (symbol-name mime-charset)) "?"
-             (symbol-name encoding) "?")
-      (goto-char (point-max))
-      (insert "?="))))
-
 (provide 'mm-encode)
 
 ;;; mm-encode.el ends here
diff --git a/lisp/mm-util.el b/lisp/mm-util.el
new file mode 100644 (file)
index 0000000..67018f4
--- /dev/null
@@ -0,0 +1,144 @@
+;;; mm-util.el --- Utility functions for MIME things
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-and-compile
+  (if (fboundp 'decode-coding-string)
+      (fset 'mm-decode-coding-string 'decode-coding-string)
+    (fset 'mm-decode-coding-string (lambda (s a) s))))
+
+(eval-and-compile
+  (if (fboundp 'encode-coding-string)
+      (fset 'mm-encode-coding-string 'encode-coding-string)
+    (fset 'mm-encode-coding-string (lambda (s a) s))))
+
+(eval-and-compile
+  (if (fboundp 'coding-system-list)
+      (fset 'mm-coding-system-list 'coding-system-list)
+    (fset 'mm-coding-system-list 'ignore)))
+
+(defvar mm-mime-mule-charset-alist
+  '((us-ascii ascii)
+    (iso-8859-1 latin-iso8859-1)
+    (iso-8859-2 latin-iso8859-2)
+    (iso-8859-3 latin-iso8859-3)
+    (iso-8859-4 latin-iso8859-4)
+    (iso-8859-5 cyrillic-iso8859-5)
+    (koi8-r cyrillic-iso8859-5)
+    (iso-8859-6 arabic-iso8859-6)
+    (iso-8859-7 greek-iso8859-7)
+    (iso-8859-8 hebrew-iso8859-8)
+    (iso-8859-9 latin-iso8859-9)
+    (iso-2022-jp latin-jisx0201
+                japanese-jisx0208-1978 japanese-jisx0208)
+    (euc-kr korean-ksc5601)
+    (cn-gb-2312 chinese-gb2312)
+    (cn-big5 chinese-big5-1 chinese-big5-2)
+    (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
+                  latin-jisx0201 japanese-jisx0208-1978
+                  chinese-gb2312 japanese-jisx0208
+                  korean-ksc5601 japanese-jisx0212)
+    (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
+                   latin-jisx0201 japanese-jisx0208-1978
+                   chinese-gb2312 japanese-jisx0208
+                   korean-ksc5601 japanese-jisx0212
+                   chinese-cns11643-1 chinese-cns11643-2)
+    (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
+                   cyrillic-iso8859-5 greek-iso8859-7
+                   latin-jisx0201 japanese-jisx0208-1978
+                   chinese-gb2312 japanese-jisx0208
+                   korean-ksc5601 japanese-jisx0212
+                   chinese-cns11643-1 chinese-cns11643-2
+                   chinese-cns11643-3 chinese-cns11643-4
+                   chinese-cns11643-5 chinese-cns11643-6
+                   chinese-cns11643-7))
+  "Alist of MIME-charset/MULE-charsets.")
+
+(defvar mm-charset-coding-system-alist
+  (let ((rest
+        '((us-ascii . iso-8859-1)
+          (gb2312 . cn-gb-2312)
+          (iso-2022-jp-2 . iso-2022-7bit-ss2)
+          (x-ctext . ctext)))
+       (systems (mm-coding-system-list))
+       dest)
+    (while rest
+      (let ((pair (car rest)))
+       (unless (memq (car pair) systems)
+         (setq dest (cons pair dest))))
+      (setq rest (cdr rest)))
+    dest)
+  "Charset/coding system alist.")
+
+(defun mm-mule-charset-to-mime-charset (charset)
+  "Return the MIME charset corresponding to MULE CHARSET."
+  (let ((alist mm-mime-mule-charset-alist)
+       out)
+    (while alist
+      (when (memq charset (cdar alist))
+       (setq out (caar alist)
+             alist nil))
+      (pop alist))
+    out))
+
+(defun mm-charset-to-coding-system (charset &optional lbt)
+  "Return coding-system corresponding to CHARSET.
+CHARSET is a symbol naming a MIME charset.
+If optional argument LBT (`unix', `dos' or `mac') is specified, it is
+used as the line break code type of the coding system."
+  (when (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (setq charset
+       (or (cdr (assq charset mm-charset-coding-system-alist))
+           charset))
+  (when lbt
+    (setq charset (intern (format "%s-%s" charset lbt))))
+  (cond
+   ;; Running in a non-MULE environment.
+   ((and (null (mm-coding-system-list))
+        (eq charset 'iso-8859-1))
+    charset)
+   ;; Check to see whether we can handle this charset.
+   ((memq charset (mm-coding-system-list))
+    charset)
+   ;; Nope.
+   (t
+    nil)))
+
+(defun mm-replace-chars-in-string (string from to)
+  "Replace characters in STRING from FROM to TO."
+  (let ((string (substring string 0))  ;Copy string.
+       (len (length string))
+       (idx 0))
+    ;; Replace all occurrences of FROM with TO.
+    (while (< idx len)
+      (when (= (aref string idx) from)
+       (aset string idx to))
+      (setq idx (1+ idx)))
+    string))
+
+(provide 'mm-util)
+
+;;; mm-util.el ends here
index 5efb0db..b6ba830 100644 (file)
@@ -511,17 +511,20 @@ Returns t if successful, nil otherwise."
   "Delete the message that point is in.
 If optional argument LEAVE-DELIM is t, then mailbox delimiter is not
 deleted.  Point is left where the deleted region was."
-  (delete-region
-   (save-excursion
-     (forward-line 1) ; in case point is at beginning of message already
-     (nnmail-search-unix-mail-delim-backward)
-     (if leave-delim (progn (forward-line 1) (point))
-       (point)))
-   (progn
-     (forward-line 1)
-     (if (nnmail-search-unix-mail-delim)
-        (point)
-       (point-max)))))
+  (save-restriction
+    (narrow-to-region
+     (save-excursion
+       (forward-line 1)                        ; in case point is at beginning of message already
+       (nnmail-search-unix-mail-delim-backward)
+       (if leave-delim (progn (forward-line 1) (point))
+        (point)))
+     (progn
+       (forward-line 1)
+       (if (nnmail-search-unix-mail-delim)
+          (point)
+        (point-max))))
+    (run-hooks 'nnfolder-delete-mail-hook)
+    (delete-region (point-min) (point-max))))
 
 (defun nnfolder-possibly-change-group (group &optional server dont-check)
   ;; Change servers.
index fd54392..d0e93bc 100644 (file)
    (quoted-printable-decode-region (point-min) (point-max))
    (buffer-string)))
 
-(defun quoted-printable-encode-region (from to &optional fold)
+(defun quoted-printable-encode-region (from to &optional fold class)
   "QP-encode the region between FROM and TO.
-If FOLD, fold long lines."
+If FOLD, fold long lines.  If CLASS, translate the characters
+matched by that regexp."
   (interactive "r")
   (save-excursion
     (save-restriction
       (narrow-to-region from to)
       (goto-char (point-min))
-      (while (re-search-forward "[\000-\007\013\015-\037\200-\377_=]" nil t)
+      (while (re-search-forward
+             (or class "[\000-\007\013\015-\037\200-\377=]") nil t)
        (insert
         (prog1
             (upcase (format "=%x" (char-after (1- (point)))))
diff --git a/lisp/rfc1522.el b/lisp/rfc1522.el
new file mode 100644 (file)
index 0000000..98c8ea8
--- /dev/null
@@ -0,0 +1,276 @@
+;;; rfc1522.el --- Functions for encoding and decoding rfc1522 messages
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'base64)
+(require 'qp)
+(require 'mm-util)
+
+(defvar rfc1522-header-encoding-alist
+  '(("Newsgroups" . nil)
+    ("Message-ID" . nil)
+    (t . mime))
+  "*Header/encoding method alist.
+The list is traversed sequentially.  The keys can either be
+header regexps or `t'.
+
+The values can be:
+
+1) nil, in which case no encoding is done;
+2) `mime', in which case the header will be encoded according to RFC1522;
+3) a charset, in which case it will be encoded as that charse;
+4) `default', in which case the field will be encoded as the rest
+   of the article.")
+
+(defvar rfc1522-charset-encoding-alist
+  '((us-ascii . nil)
+    (iso-8859-1 . Q)
+    (iso-8859-2 . Q)
+    (iso-8859-3 . Q)
+    (iso-8859-4 . Q)
+    (iso-8859-5 . Q)
+    (koi8-r . Q)
+    (iso-8859-7 . Q)
+    (iso-8859-8 . Q)
+    (iso-8859-9 . Q)
+    (iso-2022-jp . B)
+    (iso-2022-kr . B)
+    (gb2312 . B)
+    (cn-gb . B)
+    (cn-gb-2312 . B)
+    (euc-kr . B)
+    (iso-2022-jp-2 . B)
+    (iso-2022-int-1 . B))
+  "Alist of MIME charsets to RFC1522 encodings.
+Valid encodings are nil, `Q' and `B'.")
+
+(defvar rfc1522-encoding-function-alist
+  '((Q . rfc1522-q-encode-region)
+    (B . base64-encode-region)
+    (nil . ignore))
+  "Alist of RFC1522 encodings to encoding functions.")
+
+(defvar rfc1522-q-encoding-alist
+  '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "[^-A-Za-z0-9!*+/=_]")
+    ("." . "[\000-\007\013\015-\037\200-\377=_?]"))
+  "Alist of header regexps and valid Q characters.")
+
+;;;
+;;; Functions for encoding RFC1522 messages
+;;;
+
+(defun rfc1522-narrow-to-field ()
+  "Narrow the buffer to the header on the current line."
+  (beginning-of-line)
+  (narrow-to-region
+   (point)
+   (progn
+     (forward-line 1)
+     (if (re-search-forward "^[^ \n\t]" nil t)
+        (progn
+          (beginning-of-line)
+          (point))
+       (point-max))))
+  (goto-char (point-min)))
+
+;;;###autoload
+(defun rfc1522-encode-message-header ()
+  "Encode the message header according to `rfc1522-header-encoding-alist'.
+Should be called narrowed to the head of the message."
+  (interactive "*")
+  (when (featurep 'mule)
+    (save-excursion
+      (let ((alist rfc1522-header-encoding-alist)
+           elem method)
+       (while (not (eobp))
+         (save-restriction
+           (rfc1522-narrow-to-field)
+           (when (find-non-ascii-charset-region (point-min) (point-max))
+             ;; We found something that may perhaps be encoded.
+             (while (setq elem (pop alist))
+               (when (or (and (stringp (car elem))
+                              (looking-at (car elem)))
+                         (eq (car elem) t))
+                 (setq alist nil
+                       method (cdr elem))))
+             (when method
+               (cond
+                ((eq method 'mime)
+                 (rfc1522-encode-region (point-min) (point-max)))
+                ;; Hm.
+                (t))))
+           (goto-char (point-max))))))))
+
+(defun rfc1522-encode-region (b e)
+  "Encode all encodable words in REGION."
+  (let (prev c start qstart qprev qend)
+    (save-excursion
+      (goto-char b)
+      (while (re-search-forward "[^ \t\n]+" nil t)
+       (save-restriction
+         (narrow-to-region (match-beginning 0) (match-end 0))
+         (goto-char (setq start (point-min)))
+         (setq prev nil)
+         (while (not (eobp))
+           (unless (eq (setq c (char-charset (following-char))) 'ascii)
+             (cond
+              ((eq c prev)
+               )
+              ((null prev)
+               (setq qstart (or qstart start)
+                     qend (point-max)
+                     qprev c)
+               (setq prev c))
+              (t
+               ;(rfc1522-encode start (setq start (point)) prev)
+               (setq prev c))))
+           (forward-char 1)))
+       (when (and (not prev) qstart)
+         (rfc1522-encode qstart qend qprev)
+         (setq qstart nil)))
+      (when qstart
+       (rfc1522-encode qstart qend qprev)
+       (setq qstart nil)))))
+
+(defun rfc1522-encode-string (string)
+  "Encode words in STRING."
+  (with-temp-buffer
+    (insert string)
+    (rfc1522-encode-region (point-min) (point-max))
+    (buffer-string)))
+
+(defun rfc1522-encode (b e charset)
+  "Encode the word in the region with CHARSET."
+  (let* ((mime-charset (mm-mule-charset-to-mime-charset charset))
+        (encoding (cdr (assq mime-charset
+                             rfc1522-charset-encoding-alist)))
+        (start (concat
+                "=?" (downcase (symbol-name mime-charset)) "?"
+                (downcase (symbol-name encoding)) "?")))
+    (save-restriction
+      (narrow-to-region b e)
+      (insert
+       (prog1
+          (mm-encode-coding-string (buffer-string) mime-charset)
+        (delete-region (point-min) (point-max))))
+      (funcall (cdr (assq encoding rfc1522-encoding-function-alist))
+              (point-min) (point-max))
+      (goto-char (point-min))
+      (insert start)
+      (goto-char (point-max))
+      (insert "?=")
+      ;; Encoded words can't be more than 75 chars long, so we have to
+      ;; split the long ones up.
+      (end-of-line)
+      (while (> (current-column) 74)
+       (beginning-of-line)
+       (forward-char 73)
+       (insert "?=\n " start)
+       (end-of-line)))))
+
+(defun rfc1522-q-encode-region (b e)
+  "Encode the header contained in REGION with the Q encoding."
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (goto-char b) e)
+      (let ((alist rfc1522-q-encoding-alist))
+       (while alist
+         (when (looking-at (caar alist))
+           (quoted-printable-encode-region b e nil (cdar alist))
+           (subst-char-in-region (point-min) (point-max) ?  ?_))
+         (pop alist))))))
+
+;;;
+;;; Functions for decoding RFC1522 messages
+;;;
+
+(defvar rfc1522-encoded-word-regexp
+  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~]+\\)\\?=")
+
+;;;###autoload
+(defun rfc1522-decode-region (start end)
+  "Decode MIME-encoded words in region between START and END."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char (point-min))
+      ;; Remove whitespace between encoded words.
+      (while (re-search-forward
+             (concat "\\(" rfc1522-encoded-word-regexp "\\)"
+                     "\\(\n?[ \t]\\)+"
+                     "\\(" rfc1522-encoded-word-regexp "\\)")
+             nil t)
+       (delete-region (goto-char (match-end 1)) (match-beginning 6)))
+      ;; Decode the encoded words.
+      (goto-char (point-min))
+      (while (re-search-forward rfc1522-encoded-word-regexp nil t)
+       (insert (rfc1522-parse-and-decode
+                (prog1
+                    (match-string 0)
+                  (delete-region (match-beginning 0) (match-end 0)))))))))
+
+;;;###autoload
+(defun rfc1522-decode-string (string)
+ "Decode the quoted-printable-encoded STRING and return the results."
+ (with-temp-buffer
+   (insert string)
+   (inline
+     (rfc1522-decode-region (point-min) (point-max)))
+   (buffer-string)))
+
+(defun rfc1522-parse-and-decode (word)
+  "Decode WORD and return it if it is an encoded word.
+Return WORD if not."
+  (if (not (string-match rfc1522-encoded-word-regexp word))
+      word
+    (or
+     (condition-case nil
+        (rfc1522-decode
+         (match-string 1 word)
+         (upcase (match-string 2 word))
+         (match-string 3 word))
+       (error word))
+     word)))
+
+(defun rfc1522-decode (charset encoding string)
+  "Decode STRING as an encoded text.
+Valid ENCODINGs are \"B\" and \"Q\".
+If your Emacs implementation can't decode CHARSET, it returns nil."
+  (let ((cs (mm-charset-to-coding-system charset)))
+    (when cs
+      (mm-decode-coding-string
+       (cond
+       ((equal "B" encoding)
+        (base64-decode string))
+       ((equal "Q" encoding)
+        (quoted-printable-decode-string
+         (mm-replace-chars-in-string string ?_ ? )))
+       (t (error "Invalid encoding: %s" encoding)))
+       cs))))
+
+(provide 'rfc1522)
+
+;;; rfc1522.el ends here
diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
new file mode 100644 (file)
index 0000000..81241c2
--- /dev/null
@@ -0,0 +1,289 @@
+;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'base64)
+(require 'qp)
+(require 'mm-util)
+
+(defvar rfc2047-unencoded-charsets '(ascii latin-iso8859-1)
+  "List of MULE charsets not to encode.")
+
+(defvar rfc2047-header-encoding-alist
+  '(("Newsgroups" . nil)
+    ("Message-ID" . nil)
+    (t . mime))
+  "*Header/encoding method alist.
+The list is traversed sequentially.  The keys can either be
+header regexps or `t'.
+
+The values can be:
+
+1) nil, in which case no encoding is done;
+2) `mime', in which case the header will be encoded according to RFC2047;
+3) a charset, in which case it will be encoded as that charse;
+4) `default', in which case the field will be encoded as the rest
+   of the article.")
+
+(defvar rfc2047-charset-encoding-alist
+  '((us-ascii . nil)
+    (iso-8859-1 . Q)
+    (iso-8859-2 . Q)
+    (iso-8859-3 . Q)
+    (iso-8859-4 . Q)
+    (iso-8859-5 . Q)
+    (koi8-r . Q)
+    (iso-8859-7 . Q)
+    (iso-8859-8 . Q)
+    (iso-8859-9 . Q)
+    (iso-2022-jp . B)
+    (iso-2022-kr . B)
+    (gb2312 . B)
+    (cn-gb . B)
+    (cn-gb-2312 . B)
+    (euc-kr . B)
+    (iso-2022-jp-2 . B)
+    (iso-2022-int-1 . B))
+  "Alist of MIME charsets to RFC2047 encodings.
+Valid encodings are nil, `Q' and `B'.")
+
+(defvar rfc2047-encoding-function-alist
+  '((Q . rfc2047-q-encode-region)
+    (B . base64-encode-region)
+    (nil . ignore))
+  "Alist of RFC2047 encodings to encoding functions.")
+
+(defvar rfc2047-q-encoding-alist
+  '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "[^-A-Za-z0-9!*+/=_]")
+    ("." . "[\000-\007\013\015-\037\200-\377=_?]"))
+  "Alist of header regexps and valid Q characters.")
+
+;;;
+;;; Functions for encoding RFC2047 messages
+;;;
+
+(defun rfc2047-narrow-to-field ()
+  "Narrow the buffer to the header on the current line."
+  (beginning-of-line)
+  (narrow-to-region
+   (point)
+   (progn
+     (forward-line 1)
+     (if (re-search-forward "^[^ \n\t]" nil t)
+        (progn
+          (beginning-of-line)
+          (point))
+       (point-max))))
+  (goto-char (point-min)))
+
+;;;###autoload
+(defun rfc2047-encode-message-header ()
+  "Encode the message header according to `rfc2047-header-encoding-alist'.
+Should be called narrowed to the head of the message."
+  (interactive "*")
+  (when (featurep 'mule)
+    (save-excursion
+      (let ((alist rfc2047-header-encoding-alist)
+           elem method)
+       (while (not (eobp))
+         (save-restriction
+           (rfc2047-narrow-to-field)
+           (when (rfc2047-encodable-p)
+             ;; We found something that may perhaps be encoded.
+             (while (setq elem (pop alist))
+               (when (or (and (stringp (car elem))
+                              (looking-at (car elem)))
+                         (eq (car elem) t))
+                 (setq alist nil
+                       method (cdr elem))))
+             (when method
+               (cond
+                ((eq method 'mime)
+                 (rfc2047-encode-region (point-min) (point-max)))
+                ;; Hm.
+                (t))))
+           (goto-char (point-max))))))))
+
+(defun rfc2047-encodable-p ()
+  "Say whether the current (narrowed) buffer contains characters that need encoding."
+  (let ((charsets (find-charset-region (point-min) (point-max)))
+       (cs rfc2047-unencoded-charsets)
+       found)
+    (while charsets
+      (unless (memq (pop charsets) cs)
+       (setq found t)))
+    found))
+
+(defun rfc2047-encode-region (b e)
+  "Encode all encodable words in REGION."
+  (let (prev c start qstart qprev qend)
+    (save-excursion
+      (goto-char b)
+      (while (re-search-forward "[^ \t\n]+" nil t)
+       (save-restriction
+         (narrow-to-region (match-beginning 0) (match-end 0))
+         (goto-char (setq start (point-min)))
+         (setq prev nil)
+         (while (not (eobp))
+           (unless (eq (setq c (char-charset (following-char))) 'ascii)
+             (cond
+              ((eq c prev)
+               )
+              ((null prev)
+               (setq qstart (or qstart start)
+                     qend (point-max)
+                     qprev c)
+               (setq prev c))
+              (t
+               ;(rfc2047-encode start (setq start (point)) prev)
+               (setq prev c))))
+           (forward-char 1)))
+       (when (and (not prev) qstart)
+         (rfc2047-encode qstart qend qprev)
+         (setq qstart nil)))
+      (when qstart
+       (rfc2047-encode qstart qend qprev)
+       (setq qstart nil)))))
+
+(defun rfc2047-encode-string (string)
+  "Encode words in STRING."
+  (with-temp-buffer
+    (insert string)
+    (rfc2047-encode-region (point-min) (point-max))
+    (buffer-string)))
+
+(defun rfc2047-encode (b e charset)
+  "Encode the word in the region with CHARSET."
+  (let* ((mime-charset (mm-mule-charset-to-mime-charset charset))
+        (encoding (cdr (assq mime-charset
+                             rfc2047-charset-encoding-alist)))
+        (start (concat
+                "=?" (downcase (symbol-name mime-charset)) "?"
+                (downcase (symbol-name encoding)) "?")))
+    (save-restriction
+      (narrow-to-region b e)
+      (insert
+       (prog1
+          (mm-encode-coding-string (buffer-string) mime-charset)
+        (delete-region (point-min) (point-max))))
+      (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
+              (point-min) (point-max))
+      (goto-char (point-min))
+      (insert start)
+      (goto-char (point-max))
+      (insert "?=")
+      ;; Encoded words can't be more than 75 chars long, so we have to
+      ;; split the long ones up.
+      (end-of-line)
+      (while (> (current-column) 74)
+       (beginning-of-line)
+       (forward-char 73)
+       (insert "?=\n " start)
+       (end-of-line)))))
+
+(defun rfc2047-q-encode-region (b e)
+  "Encode the header contained in REGION with the Q encoding."
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (goto-char b) e)
+      (let ((alist rfc2047-q-encoding-alist))
+       (while alist
+         (when (looking-at (caar alist))
+           (quoted-printable-encode-region b e nil (cdar alist))
+           (subst-char-in-region (point-min) (point-max) ?  ?_))
+         (pop alist))))))
+
+;;;
+;;; Functions for decoding RFC2047 messages
+;;;
+
+(defvar rfc2047-encoded-word-regexp
+  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~]+\\)\\?=")
+
+;;;###autoload
+(defun rfc2047-decode-region (start end)
+  "Decode MIME-encoded words in region between START and END."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char (point-min))
+      ;; Remove whitespace between encoded words.
+      (while (re-search-forward
+             (concat "\\(" rfc2047-encoded-word-regexp "\\)"
+                     "\\(\n?[ \t]\\)+"
+                     "\\(" rfc2047-encoded-word-regexp "\\)")
+             nil t)
+       (delete-region (goto-char (match-end 1)) (match-beginning 6)))
+      ;; Decode the encoded words.
+      (goto-char (point-min))
+      (while (re-search-forward rfc2047-encoded-word-regexp nil t)
+       (insert (rfc2047-parse-and-decode
+                (prog1
+                    (match-string 0)
+                  (delete-region (match-beginning 0) (match-end 0)))))))))
+
+;;;###autoload
+(defun rfc2047-decode-string (string)
+ "Decode the quoted-printable-encoded STRING and return the results."
+ (with-temp-buffer
+   (insert string)
+   (inline
+     (rfc2047-decode-region (point-min) (point-max)))
+   (buffer-string)))
+
+(defun rfc2047-parse-and-decode (word)
+  "Decode WORD and return it if it is an encoded word.
+Return WORD if not."
+  (if (not (string-match rfc2047-encoded-word-regexp word))
+      word
+    (or
+     (condition-case nil
+        (rfc2047-decode
+         (match-string 1 word)
+         (upcase (match-string 2 word))
+         (match-string 3 word))
+       (error word))
+     word)))
+
+(defun rfc2047-decode (charset encoding string)
+  "Decode STRING as an encoded text.
+Valid ENCODINGs are \"B\" and \"Q\".
+If your Emacs implementation can't decode CHARSET, it returns nil."
+  (let ((cs (mm-charset-to-coding-system charset)))
+    (when cs
+      (mm-decode-coding-string
+       (cond
+       ((equal "B" encoding)
+        (base64-decode string))
+       ((equal "Q" encoding)
+        (quoted-printable-decode-string
+         (mm-replace-chars-in-string string ?_ ? )))
+       (t (error "Invalid encoding: %s" encoding)))
+       cs))))
+
+(provide 'rfc2047)
+
+;;; rfc2047.el ends here
index b76c05d..56fc5d3 100644 (file)
@@ -1,3 +1,7 @@
+1998-08-31 11:46:57  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Mail Folders): Addition.
+
 1998-08-27 07:29:17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus.texi (Mail Folders): Addition.
index b1622cc..c91ced7 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename gnus
-@settitle Pterodactyl Gnus 0.8 Manual
+@settitle Pterodactyl Gnus 0.10 Manual
 @synindex fn cp
 @synindex vr cp
 @synindex pg cp
@@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions.
 @tex
 
 @titlepage
-@title Pterodactyl Gnus 0.8 Manual
+@title Pterodactyl Gnus 0.10 Manual
 
 @author by Lars Magne Ingebrigtsen
 @page
@@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local
 spool or your mbox file.  All at the same time, if you want to push your
 luck.
 
-This manual corresponds to Pterodactyl Gnus 0.8.
+This manual corresponds to Pterodactyl Gnus 0.10.
 
 @end ifinfo
 
@@ -10419,6 +10419,12 @@ your @file{.emacs} file:
 (add-hook 'nnfolder-save-buffer-hook 'turn-off-backup)
 @end lisp
 
+@item nnfolder-delete-mail-hook
+@vindex nnfolder-delete-mail-hook
+Hook run in a buffer narrowed to the message that is to be deleted.
+This function can be used to copy the message to somewhere else, or to
+extract some information from it before removing it.  
+
 @end table
 
 
index 935ab4f..66c3ff3 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename message
-@settitle Pterodactyl Message 0.8 Manual
+@settitle Pterodactyl Message 0.10 Manual
 @synindex fn cp
 @synindex vr cp
 @synindex pg cp
@@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions.
 @tex
 
 @titlepage
-@title Pterodactyl Message 0.8 Manual
+@title Pterodactyl Message 0.10 Manual
 
 @author by Lars Magne Ingebrigtsen
 @page
@@ -83,7 +83,7 @@ Message mode buffers.
 * Key Index::         List of Message mode keys.
 @end menu
 
-This manual corresponds to Pterodactyl Message 0.8.  Message is
+This manual corresponds to Pterodactyl Message 0.10.  Message is
 distributed with the Gnus distribution bearing the same version number
 as this manual has.