+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.
(buffer-read-only nil))
(save-restriction
(message-narrow-to-head)
- (mm-decode-words-region (point-min) (point-max)))))
+ (rfc1522-decode-region (point-min) (point-max)))))
(defun article-de-quoted-unreadable (&optional force)
"Translate a quoted-printable-encoded article.
(setq header
(make-full-mail-header
number ; number
- (mm-decode-words-string (gnus-nov-field)) ; subject
- (mm-decode-words-string (gnus-nov-field)) ; from
+ (rfc1522-decode-string (gnus-nov-field)) ; subject
+ (rfc1522-decode-string (gnus-nov-field)) ; from
(gnus-nov-field) ; date
(or (gnus-nov-field)
(nnheader-generate-fake-message-id)) ; id
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (mm-decode-words-string (nnheader-header-value))
+ (rfc1522-decode-string (nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (mm-decode-words-string (nnheader-header-value))
+ (rfc1522-decode-string (nnheader-header-value))
"(nobody)"))
;; Date.
(progn
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.8"
+(defconst gnus-version-number "0.9"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
("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)
+ ("rfc1522" rfc1522-decode-region rfc1522-decode-string)
("ps-print" ps-print-preprint)
("mail-extr" mail-extract-address-components)
("browse-url" browse-url)
(if (string-match "XEmacs\\|Lucid" emacs-version)
(require 'mail-abbrevs)
(require 'mailabbrev))
-(require 'mm-encode)
+(require 'rfc1522)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
(message-generate-headers message-required-mail-headers))
- (mm-encode-message-header)
+ (rfc1522-encode-message-header)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
(message-narrow-to-headers)
;; Insert some headers.
(message-generate-headers message-required-news-headers)
- (mm-encode-message-header)
+ (rfc1522-encode-message-header)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(message-cleanup-headers)
;; 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
;; 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
--- /dev/null
+;;; 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
(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)))))
--- /dev/null
+;;; 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
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.8 Manual
+@settitle Pterodactyl Gnus 0.9 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.8 Manual
+@title Pterodactyl Gnus 0.9 Manual
@author by Lars Magne Ingebrigtsen
@page
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.9.
@end ifinfo
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.8 Manual
+@settitle Pterodactyl Message 0.9 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.8 Manual
+@title Pterodactyl Message 0.9 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.9. Message is
distributed with the Gnus distribution bearing the same version number
as this manual has.
projects / gnus / commitdiff