From a3fbfe62d8a31ca9b3c0d18a4895e3a8924fc176 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Sun, 30 Aug 1998 14:40:12 +0000 Subject: [PATCH] Importing pgnus-0.8 --- lisp/ChangeLog | 46 ++++++++++++ lisp/gnus-art.el | 1 + lisp/gnus-xmas.el | 7 +- lisp/gnus.el | 4 +- lisp/message.el | 18 +++++ lisp/mm-decode.el | 23 ++++-- lisp/mm-encode.el | 202 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/qp.el | 28 ++++---- texi/gnus.texi | 6 +- texi/message.texi | 6 +- 10 files changed, 314 insertions(+), 27 deletions(-) create mode 100644 lisp/mm-encode.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 555213b..5afb31d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,49 @@ +Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.8 is released. + +1998-08-30 12:23:03 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Encode headers. + + * qp.el (quoted-printable-encode-region): Encode 8-bit words. + (quoted-printable-encode-region): Upcase. + + * message.el (message-default-charset): New variable. + + * qp.el (quoted-printable-encode-region): Optional param FOLD. + + * message.el (message-narrow-to-field): Changed name. + + * mm-encode.el: New file. + + * message.el (message-narrow-to-header): New function. + + * gnus-art.el (gnus-article-decode-mime-words): Place point in the + right buffer. + +Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.7 is released. + +1998-08-30 01:26:12 Lars Magne Ingebrigtsen + + * gnus.el: Remove autoload for + gnus-article-mime-decode-quoted-printable. + + * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to + be decoded in non-MULE Emacsen. + + * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown. + +1998-08-29 SL Baur + + * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown. + +1998-08-30 01:04:57 Lars Magne Ingebrigtsen + + * mm-decode.el: Check for coding-system-list. + Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.6 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index f598f57..cec51c0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -949,6 +949,7 @@ characters to translate to." "Decode all MIME-encoded words in the article." (interactive) (save-excursion + (set-buffer gnus-article-buffer) (let ((inhibit-point-motion-hooks t) buffer-read-only) (mm-decode-words-region (point-min) (point-max))))) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 23eb31c..ff215dc 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -41,6 +41,8 @@ automatically." directory) :group 'gnus-xmas) +;;(format "%02x%02x%02x" 114 66 20) "724214" + (defvar gnus-xmas-logo-color-alist '((flame "#cc3300" "#ff2200") (pine "#c0cc93" "#f8ffb8") @@ -52,7 +54,7 @@ automatically." (grape "#b264cc" "#cf7df") (labia "#cc64c2" "#fd7dff") (berry "#cc6485" "#ff7db5") - (dino "#cc6485" "#ff7db5") + (dino "#724214" "#1e3f03") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") @@ -62,7 +64,8 @@ automatically." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) (const velvet) (const grape) (const labia) - (const berry) (const neutral) (const september)) + (const berry) (const neutral) (const september) + (const dino)) :group 'gnus-xmas) (defvar gnus-xmas-logo-colors diff --git a/lisp/gnus.el b/lisp/gnus.el index 82ae7cc..5d3fa0d 100644 --- a/lisp/gnus.el +++ b/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.6" +(defconst gnus-version-number "0.8" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -1698,7 +1698,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-treat-overstrike gnus-article-word-wrap gnus-article-remove-cr gnus-article-remove-trailing-blank-lines gnus-article-display-x-face gnus-article-de-quoted-unreadable - gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp + gnus-article-hide-pgp gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed diff --git a/lisp/message.el b/lisp/message.el index 15c9b5b..6b4587b 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -39,6 +39,7 @@ (if (string-match "XEmacs\\|Lucid" emacs-version) (require 'mail-abbrevs) (require 'mailabbrev)) +(require 'mm-encode) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -848,6 +849,7 @@ The cdr of ech entry is a function for applying the face to a region.") ;;; Internal variables. +(defvar message-default-charset nil) (defvar message-buffer-list nil) (defvar message-this-is-news nil) (defvar message-this-is-mail nil) @@ -1023,6 +1025,20 @@ The cdr of ech entry is a function for applying the face to a region.") (when value (nnheader-replace-chars-in-string value ?\n ? )))) +(defun message-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))) + (defun message-add-header (&rest headers) "Add the HEADERS to the message header, skipping those already present." (while headers @@ -2004,6 +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) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (unwind-protect @@ -2174,6 +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) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (message-cleanup-headers) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index e1d50ed..c7f8681 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,7 +1,8 @@ -;;; mm-decode.el --- Function for decoding MIME things +;;; mm-decode.el --- Functions for decoding MIME things ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko ;; This file is not yet part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -82,6 +83,11 @@ Return WORD if not." (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\". @@ -104,7 +110,7 @@ If your Emacs implementation can't decode CHARSET, it returns nil." (gb2312 . cn-gb-2312) (iso-2022-jp-2 . iso-2022-7bit-ss2) (x-ctext . ctext))) - (systems (coding-system-list)) + (systems (mm-coding-system-list)) dest) (while rest (let ((pair (car rest))) @@ -126,8 +132,17 @@ used as the line break code type of the coding system." charset)) (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) - (when (memq charset (coding-system-list)) - charset)) + (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) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el new file mode 100644 index 0000000..875d12f --- /dev/null +++ b/lisp/mm-encode.el @@ -0,0 +1,202 @@ +;;; mm-encode.el --- Functions for encoding MIME things +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; This file is not yet 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: + +(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/qp.el b/lisp/qp.el index 1ef4a77..fd54392 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -56,27 +56,29 @@ (quoted-printable-decode-region (point-min) (point-max)) (buffer-string))) -(defun quoted-printable-encode-region (from to) - "QP-encode the region between FROM and TO." +(defun quoted-printable-encode-region (from to &optional fold) + "QP-encode the region between FROM and TO. +If FOLD, fold long lines." (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-\237=]" nil t) + (while (re-search-forward "[\000-\007\013\015-\037\200-\377_=]" nil t) (insert (prog1 - (format "=%x" (char-after (1- (point)))) + (upcase (format "=%x" (char-after (1- (point))))) (delete-char -1)))) - ;; Fold long lines. - (goto-char (point-min)) - (end-of-line) - (while (> (current-column) 72) - (beginning-of-line) - (forward-char 72) - (search-backward "=" (- (point) 2) t) - (insert "=\n") - (end-of-line))))) + (when fold + ;; Fold long lines. + (goto-char (point-min)) + (end-of-line) + (while (> (current-column) 72) + (beginning-of-line) + (forward-char 72) + (search-backward "=" (- (point) 2) t) + (insert "=\n") + (end-of-line)))))) (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." diff --git a/texi/gnus.texi b/texi/gnus.texi index 20da8ca..b1622cc 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.6 Manual +@settitle Pterodactyl Gnus 0.8 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.6 Manual +@title Pterodactyl Gnus 0.8 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.6. +This manual corresponds to Pterodactyl Gnus 0.8. @end ifinfo diff --git a/texi/message.texi b/texi/message.texi index 588ef1b..935ab4f 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.6 Manual +@settitle Pterodactyl Message 0.8 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.6 Manual +@title Pterodactyl Message 0.8 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.6. Message is +This manual corresponds to Pterodactyl Message 0.8. Message is distributed with the Gnus distribution bearing the same version number as this manual has. -- 1.7.10.4