+Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.8 is released.
+
+1998-08-30 12:23:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.7 is released.
+
+1998-08-30 01:26:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <steve@altair.xemacs.org>
+
+ * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown.
+
+1998-08-30 01:04:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el: Check for coding-system-list.
+
Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.6 is released.
"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)))))
directory)
:group 'gnus-xmas)
+;;(format "%02x%02x%02x" 114 66 20) "724214"
+
(defvar gnus-xmas-logo-color-alist
'((flame "#cc3300" "#ff2200")
(pine "#c0cc93" "#f8ffb8")
(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.")
: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
: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)
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
(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))
;;; Internal variables.
+(defvar message-default-charset nil)
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(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
(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
(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)
-;;; 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 <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; This file is not yet part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
(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\".
(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)))
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)
--- /dev/null
+;;; mm-encode.el --- Functions for encoding 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 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
(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."
\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
@tex
@titlepage
-@title Pterodactyl Gnus 0.6 Manual
+@title Pterodactyl Gnus 0.8 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.6.
+This manual corresponds to Pterodactyl Gnus 0.8.
@end ifinfo
\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
@tex
@titlepage
-@title Pterodactyl Message 0.6 Manual
+@title Pterodactyl Message 0.8 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / elisp / gnus.git- / commitdiff