*** pub/pgnus/lisp/gnus-art.el Sun Aug 30 00:59:59 1998 --- pgnus/lisp/gnus-art.el Sun Aug 30 15:28:12 1998 *************** *** 949,954 **** --- 949,955 ---- "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))))) *** pub/pgnus/lisp/gnus-xmas.el Sun Aug 30 12:16:07 1998 --- pgnus/lisp/gnus-xmas.el Sun Aug 30 15:28:13 1998 *************** *** 41,46 **** --- 41,48 ---- 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,58 **** (grape "#b264cc" "#cf7df") (labia "#cc64c2" "#fd7dff") (berry "#cc6485" "#ff7db5") ! (dino "#8e4900" "#911e1e") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") --- 54,60 ---- (grape "#b264cc" "#cf7df") (labia "#cc64c2" "#fd7dff") (berry "#cc6485" "#ff7db5") ! (dino "#724214" "#1e3f03") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") *** pub/pgnus/lisp/gnus.el Sun Aug 30 12:16:07 1998 --- pgnus/lisp/gnus.el Sun Aug 30 15:28:13 1998 *************** *** 250,256 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.7" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 250,256 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.8" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *** pub/pgnus/lisp/message.el Sat Aug 29 22:25:18 1998 --- pgnus/lisp/message.el Sun Aug 30 15:28:13 1998 *************** *** 39,44 **** --- 39,45 ---- (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,853 **** --- 849,855 ---- ;;; 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,1028 **** --- 1025,1044 ---- (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,2009 **** --- 2020,2026 ---- (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,2179 **** --- 2191,2197 ---- (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) *** pub/pgnus/lisp/mm-decode.el Sun Aug 30 12:16:07 1998 --- pgnus/lisp/mm-decode.el Sun Aug 30 15:28:13 1998 *************** *** 1,7 **** ! ;;; mm-decode.el --- Function for decoding MIME things ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is not yet part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify --- 1,8 ---- ! ;;; 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 *** pub/pgnus/lisp/mm-encode.el Sun Aug 30 15:28:17 1998 --- pgnus/lisp/mm-encode.el Sun Aug 30 15:28:13 1998 *************** *** 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 *** pub/pgnus/lisp/qp.el Sat Aug 29 22:25:20 1998 --- pgnus/lisp/qp.el Sun Aug 30 15:28:14 1998 *************** *** 56,82 **** (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." (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) (insert (prog1 ! (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))))) (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." --- 56,84 ---- (quoted-printable-decode-region (point-min) (point-max)) (buffer-string))) ! (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-\377_=]" nil t) (insert (prog1 ! (upcase (format "=%x" (char-after (1- (point))))) (delete-char -1)))) ! (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." *** pub/pgnus/lisp/ChangeLog Sun Aug 30 12:16:07 1998 --- pgnus/lisp/ChangeLog Sun Aug 30 15:28:12 1998 *************** *** 1,3 **** --- 1,27 ---- + 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. *** pub/pgnus/texi/gnus.texi Sun Aug 30 12:16:08 1998 --- pgnus/texi/gnus.texi Sun Aug 30 15:28:14 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.7 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.8 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.7 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.8 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.7. @end ifinfo --- 354,360 ---- 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. @end ifinfo *** pub/pgnus/texi/message.texi Sun Aug 30 12:16:08 1998 --- pgnus/texi/message.texi Sun Aug 30 15:28:15 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.7 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.8 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.7 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.8 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.7. Message is distributed with the Gnus distribution bearing the same version number as this manual has. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.8. Message is distributed with the Gnus distribution bearing the same version number as this manual has.