Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 40977f103599623739e4f0dcd5a246e6ec6e23c5 1 parent 323bfbc
@larsmagne larsmagne authored
View
28 lisp/ChangeLog
@@ -1,3 +1,31 @@
+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.
View
2  lisp/gnus-art.el
@@ -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)))))
+ (rfc1522-decode-region (point-min) (point-max)))))
(defun article-de-quoted-unreadable (&optional force)
"Translate a quoted-printable-encoded article.
View
8 lisp/gnus-sum.el
@@ -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
+ (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
@@ -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))
+ (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
View
4 lisp/gnus.el
@@ -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.9"
"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)
+ ("rfc1522" rfc1522-decode-region rfc1522-decode-string)
("ps-print" ps-print-preprint)
("mail-extr" mail-extract-address-components)
("browse-url" browse-url)
View
6 lisp/message.el
@@ -39,7 +39,7 @@
(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))
@@ -2020,7 +2020,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)
+ (rfc1522-encode-message-header)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
@@ -2191,7 +2191,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)
+ (rfc1522-encode-message-header)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(message-cleanup-headers)
View
124 lisp/mm-decode.el
@@ -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
@@ -24,126 +24,6 @@
;;; 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
View
175 lisp/mm-encode.el
@@ -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
@@ -24,179 +24,6 @@
;;; 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
View
144 lisp/mm-util.el
@@ -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
View
8 lisp/qp.el
@@ -56,15 +56,17 @@
(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)))))
View
276 lisp/rfc1522.el
@@ -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
View
6 texi/gnus.texi
@@ -1,7 +1,7 @@
\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
@@ -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.9 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.9.
@end ifinfo
View
6 texi/message.texi
@@ -1,7 +1,7 @@
\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
@@ -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.9 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.9. Message is
distributed with the Gnus distribution bearing the same version number
as this manual has.
Please sign in to comment.
Something went wrong with that request. Please try again.