This commit was generated by cvs2svn to compensate for changes in r273,
authorshuhei-k <shuhei-k>
Sun, 8 Mar 1998 19:18:06 +0000 (19:18 +0000)
committershuhei-k <shuhei-k>
Sun, 8 Mar 1998 19:18:06 +0000 (19:18 +0000)
which included commits to RCS files with non-trunk default branches.

20 files changed:
ChangeLog
Makefile [deleted file]
README.semi [new file with mode: 0644]
lisp/ChangeLog
lisp/Makefile [deleted file]
lisp/gnus-agent.el
lisp/gnus-art.el
lisp/gnus-draft.el
lisp/gnus-ems.el
lisp/gnus-i18n.el [new file with mode: 0644]
lisp/gnus-msg.el
lisp/gnus-sum.el
lisp/gnus.el
lisp/lpath.el
lisp/message.el
lisp/nnheader.el
lisp/pop3.el
lisp/smtp.el [new file with mode: 0644]
lisp/smtpmail.el [new file with mode: 0644]
texi/Makefile [deleted file]

index db57397..a5608c8 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,238 @@
+1998-03-01  Tatsuya Ichikawa  <t-ichi@po.shiojiri.ne.jp>
+
+       * lisp/gnus-ems.el: Change variable name
+         gnus-bdf-image-file to gnus-mule-bitmap-image-file.
+
+1998-02-28  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el (gnus-version-number): Update to 6.0.8.
+
+       * lisp/gnus.el: Sync up with qgnus-0.34.
+
+1998-02-28  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/message.el: Sync up with qgnus-0.33.
+
+       * lisp/gnus-ems.el (gnus-bdf-image-file): New variable; moved from
+       gnus.el.
+       (gnus-mule-group-startup-message): New function; moved and renamed
+       from `gnus-group-startup-message' of gnus.el.
+
+       * lisp/gnus.el, lisp/gnus-sum.el, lisp/gnus-art.el,
+       lisp/gnus-agent.el: Sync up with qgnus-0.33.
+
+1998-02-28  Tatsuya Ichikawa  <t-ichi@niagara.shiojiri.ne.jp>
+
+       * lisp/gnus.el (gnus-bdf-image-file): New variable.
+       (gnus-mule-group-startup-message): Display bitmap image using
+       bitmap.el running with Emacs 20.
+       
+       * lisp/gnus-agent.el (gnus-agent-fetch-headers): Fix problem when
+       Xref field is not exist.
+
+1998-02-26  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * README.semi (How to join development): Modify for Semi-gnus
+       mailing list.
+
+       * lisp/gnus.el (gnus-version-number): Update to 6.0.7.
+
+       * lisp/gnus.el (gnus-article-display-hook): Delete
+       `gnus-article-de-quoted-unreadable' from options.
+
+       * lisp/gnus-sum.el (gnus-article-make-menu-bar): Delete key for
+       `gnus-article-de-quoted-unreadable'.
+       (gnus-summary-make-menu-bar): Delete menu for
+       `gnus-article-de-quoted-unreadable'.
+
+       * lisp/gnus-art.el (gnus-article-make-menu-bar): Delete menu for
+       `gnus-article-de-quoted-unreadable'.
+
+1998-02-24  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el, lisp/message.el: Sync up with qgnus-0.32.
+
+1998-02-23  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el (gnus-version-number): Update to 6.0.6.
+
+       * lisp/message.el (message-fill-references): Abolish unused local
+       variables.
+
+       * lisp/pop3.el, lisp/message.el, lisp/gnus.el, lisp/gnus-sum.el,
+       lisp/gnus-art.el: Sync up with qgnus-0.31.
+
+       * lisp/gnus.el, lisp/message.el, lisp/gnus-sum.el,
+       lisp/gnus-art.el: Sync up with qgnus-0.30.
+
+1998-02-20  Christophe Broult <christophe.broult@info.unicaen.fr>
+
+       * README.semi (How to get?): The command `update' must come before
+       `-r semi-gnus'. (cf. [tm-en:1559])
+
+1998-02-17  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el: Sync up with qgnus-0.29.
+
+       * lisp/gnus.el, lisp/message.el: Sync up with qgnus-0.28.
+
+       * lisp/message.el: Abolish variable
+       `message-references-generator'.  Abolish function
+       `message-generate-filled-references',
+       `message-generate-folded-references' and
+       `message-generate-unfolded-references'.
+       (message-reply): Don't use `message-references-generator'.
+       (message-followup): Don't use `message-references-generator'.
+
+       (message-fill-references): New function.
+       (message-header-format-alist): Use `message-fill-references' for
+       References.
+
+1998-02-17  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el (gnus-version-number): Update to 6.0.5.
+
+1998-02-17  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus-sum.el: Check SEMI-0.118.2 (Otomaru) or later.
+       (gnus-structured-field-decoder): Use
+       `eword-decode-and-unfold-structured-field'.
+
+       * lisp/gnus-art.el (gnus-article-decode-rfc1522): Use charset
+       conversion option of `eword-decode-header'.
+       (gnus-article-decode-encoded-word): Use charset conversion option
+       of `eword-decode-header'; use `gnus-run-hooks'.
+       (gnus-content-header-filter): Use charset conversion option of
+       `eword-decode-header'.
+
+       * README.semi (How to get?): Should specify "-r semi-gnus".
+
+1998-02-16  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus-art.el (gnus-article-decode-rfc1522): Decode header by
+       localized code.
+
+1998-02-16  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus-msg.el: Delete commented-out function
+       `gnus-inews-insert-mime-headers'.
+
+       * lisp/gnus.el, lisp/message.el, lisp/gnus-sum.el,
+       lisp/gnus-art.el: Sync up with qgnus-0.27.
+
+1998-02-16  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/nnheader.el: Use original.
+
+       * lisp/gnus.el, lisp/pop3.el, lisp/message.el, lisp/gnus-sum.el,
+       lisp/gnus-msg.el, lisp/gnus-draft.el, lisp/gnus-art.el: Sync up
+       with qgnus-0.26.
+
+1998-02-15  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/nnmail.el, lisp/nnmh.el: Use original.
+
+       * lisp/gnus.el, lisp/gnus-draft.el, lisp/gnus-sum.el,
+       lisp/message.el, lisp/gnus-art.el: Sync up with qgnus-0.25.
+
+1998-02-11  Shuhei Kobayashi  <shuhei-k@jaist.ac.jp>
+
+       * texi/message.texi, texi/gnus.texi, texi/ChangeLog,
+       lisp/message.el, lisp/gnus.el, lisp/gnus-uu.el,
+       lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el,
+       lisp/gnus-score.el, lisp/gnus-group.el, lisp/gnus-art.el,
+       lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.24
+
+1998-02-10  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus-art.el (gnus-article-prepare): Don't bind coding
+       systems.
+
+       * lisp/gnus.el (gnus-version-number): Update to 6.0.4.
+       (gnus-version): Sync with qgnus-0.23.
+
+       * lisp/pop3.el, lisp/nnmh.el, lisp/nnheader.el, lisp/message.el,
+       lisp/gnus-sum.el, lisp/gnus-msg.el, lisp/gnus-draft.el,
+       lisp/gnus-art.el: Merge qgnus-0.23.
+
+1998-02-09  Shuhei Kobayashi  <shuhei-k@jaist.ac.jp>
+
+       * texi/message.texi, texi/gnus.texi, texi/ChangeLog, lisp/nntp.el,
+       lisp/nnheader.el, lisp/message.el, lisp/gnus.el,
+       lisp/gnus-xmas.el, lisp/gnus-sum.el, lisp/gnus-start.el,
+       lisp/gnus-msg.el, lisp/gnus-group.el, lisp/gnus-draft.el,
+       lisp/gnus-art.el, lisp/gnus-agent.el, lisp/ChangeLog: Importing
+       qgnus-0.23
+
+1998-02-04  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/message.el (message-references-generator): New variable.
+       (message-generate-filled-references): New function.
+       (message-generate-folded-references): New function.
+       (message-generate-unfolded-references): New function.
+       (message-reply): Refer `message-references-generator'.
+       (message-followup): Refer `message-references-generator'.
+
+1998-01-17  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/message.el (message-send-mail-with-sendmail): Guard
+       `coding-system-for-write' by binary.
+       (message-send-mail-with-qmail): Likewise.
+
+1998-01-16  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/lpath.el: Require path-util; add load-path of APEL, MEL and
+       SEMI.
+
+1998-01-12  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/message.el: Require smtp.el when compile.
+
+       * lisp/message.el (message-send-mail-with-smtp): Use
+       `(current-buffer)' instead of `tembuf'; rename
+       `smtp-recipient-address-list' -> `recipient-address-list'.
+
+1998-01-12  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/smtp.el (smtp-deduce-address-list): Don't use
+       `smtp-recipient-address-list' as global variable.
+
+       * lisp/message.el (message-send-mail-with-smtp): Don't use
+       `smtp-recipient-address-list' as global variable.
+
+       * lisp/smtpmail.el (smtpmail-recipient-address-list): New
+       variable; renamed from `smtp-recipient-address-list'.
+       (smtpmail-send-it): Remove `(not (null ...))'.
+       (smtpmail-send-queued-mail): Likewise.
+
+1998-01-12  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/message.el (message-send-mail-with-smtp): Don't generate
+       temporary buffer for message; don't generate and kill
+       `smtp-address-buffer' for `smtp-deduce-address-list'.
+
+       * lisp/smtpmail.el (smtpmail-send-it): Don't generate and kill
+       `smtp-address-buffer' for `smtp-deduce-address-list'.
+
+       * lisp/smtp.el (smtp-deduce-address-list): Bind and generate
+       `smtp-address-buffer' in itself.
+
+1998-01-12  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/gnus.el (gnus-version-number): Update to version 6.0.3.
+
+1998-01-11  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+
+       * lisp/smtp.el: New file.
+
+       * lisp/smtpmail.el: Split basic features into smtp.el.
+
+       * lisp/message.el (message-send-mail-function): Add
+       `message-send-mail-with-smtp' as an item.
+       (message-send-mail-with-smtp): New function.
+
+       * ChangeLog: New file.
+
 1998-01-08  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 
        * lisp/smtpmail.el (smtpmail-via-smtp): Bind
diff --git a/Makefile b/Makefile
deleted file mode 100644 (file)
index 05503f4..0000000
--- a/Makefile
+++ /dev/null
@@ -1,36 +0,0 @@
-EMACS=emacs
-XEMACS=xemacs
-
-all: lick info
-
-lick:
-       cd lisp; $(MAKE) EMACS=$(EMACS) all
-
-# Rule for Lars and nobody else.
-some:
-       cd lisp; $(MAKE) EMACS=$(EMACS) some
-l:
-       cd lisp; $(MAKE) EMACS=$(EMACS) clever
-
-info:
-       cd texi; $(MAKE) EMACS=$(EMACS) all
-
-clean:
-       rm -f */*.orig */*.rej *.orig *.rej
-
-xsome: 
-       cd lisp; $(MAKE) EMACS=$(XEMACS) some
-
-elclean:
-       rm lisp/*.elc
-
-x:
-       make EMACS=xemacs
-
-distclean:
-       make clean
-       rm -r *~
-       for i in lisp texi; do (cd $$i; make distclean); done
-
-osome:
-       make EMACS=emacs-19.34 some
diff --git a/README.semi b/README.semi
new file mode 100644 (file)
index 0000000..6d607e2
--- /dev/null
@@ -0,0 +1,63 @@
+This package contains Semi-gnus.
+
+What is Semi-gnus?
+==================
+
+  Semi-gnus is a replacement of Gnus with gnus-mime for SEMI.  It has
+all features of Gnus and gnus-mime, so there are no need to install
+Gnus to use it, and you must not use gnus-mime for SEMI.
+
+  It requires SEMI package, so please get and install SEMI package
+before to install it.
+
+
+How to get?
+===========
+
+(0) cvs login
+
+    % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
+       login
+
+    CVS password: [CR] # NULL string
+
+(1) checkout
+
+    Please do following in a directory to extract (ex. site-lisp):
+
+    % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
+       co -r semi-gnus gnus
+
+(2) compile
+
+    ;; as same as Gnus
+
+    % cd gnus
+
+    % make EMACS=<file name of your emacs>
+
+(3) update
+
+    Please do following in your Open gnus directory:
+
+    % cvs update -r semi-gnus
+
+
+How to join development
+=======================
+
+  If you write bug-reports and/or suggestions for improvement, please
+send them to the Semi-gnus mailing list:
+
+    semi-gnus-en@meadow.scphys.kyoto-u.ac.jp   (English)
+    semi-gnus-ja@meadow.scphys.kyoto-u.ac.jp   (Japanese)
+
+  Via the Semi-gnus ML, you can report Semi-gnus related bugs, obtain
+the latest release of Semi-gnus, and discuss future enhancements to
+Semi-gnus.  To join the Semi-gnus ML, send e-mail to
+
+    semi-gnus-ja-subscribe@meadow.scphys.kyoto-u.ac.jp (Japanese)
+    semi-gnus-en-subscribe@meadow.scphys.kyoto-u.ac.jp (English)
+
+  In addition, we need developers.  If you would like to develop it,
+please send mail to cvs@chamonix.jaist.ac.jp.
index 8376c9d..6b2a1b3 100644 (file)
@@ -1,15 +1,3 @@
-Sun Mar  8 00:00:04 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
-
-       * gnus.el: Gnus v5.6.1 is released.
-
-Sat Mar  7 22:15:46 1998  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
-
-       * gnus.el (gnus-edit-form-buffer): Moved here.
-
-       * gnus-agent.el (gnus-agent-expire-old): Removed.
-       (gnus-agent-expire-directory): Ditto.
-       (gnus-agent-expire-group): Even more ditto.
-
 Sat Mar  7 21:59:18 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Quassia Gnus v0.37 is released.
diff --git a/lisp/Makefile b/lisp/Makefile
deleted file mode 100644 (file)
index b949400..0000000
+++ /dev/null
@@ -1,40 +0,0 @@
-SHELL = /bin/sh
-EMACS=emacs
-FLAGS=-batch -q -no-site-file -l ./dgnushack.el
-
-total:
-       rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile
-
-all:
-       rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile
-
-clever:
-       $(EMACS) $(FLAGS) -f dgnushack-compile
-
-some:
-       $(EMACS) $(FLAGS) -f dgnushack-compile
-
-tags:
-       etags *.el
-
-separately:
-       rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $$i; done
-
-pot:
-       xpot -drgnus -r`cat ./version` *.el > rgnus.pot
-
-gnus-load.el: 
-       echo ";;; gnus-load.el --- automatically extracted custom dependencies" > gnus-load.el
-       echo ";;" >> gnus-load.el
-       echo ";;; Code:" >> gnus-load.el
-       echo >> gnus-load.el
-       $(EMACS)  $(FLAGS) -l ./dgnushack.el -l cus-edit.el *.el \
-               -f custom-make-dependencies >> gnus-load.el
-       echo >> gnus-load.el
-       echo "(provide 'gnus-load)" >> gnus-load.el
-       echo >> gnus-load.el
-       echo ";;; gnus-load.el ends here" >> gnus-load.el
-
-distclean:
-       rm -f *.orig *.rej *.elc *~
-
index b705341..864cc1b 100644 (file)
@@ -1,4 +1,4 @@
-;;; gnus-agent.el --- unplugged support for Gnus
+;;; gnus-agent.el --- unplugged support for Semi-gnus
 ;; Copyright (C) 1997,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -708,6 +708,17 @@ the actual number of articles toggled is returned."
        (set-buffer nntp-server-buffer)
        (unless (eq 'nov (gnus-retrieve-headers articles group))
          (nnvirtual-convert-headers))
+       ;;
+       ;; To gnus-agent-expire work fine with no Xref field in .overview 
+       ;; Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
+       (goto-char (point-min))
+       (while (not (eobp))
+         (goto-char (point-at-eol))
+         (insert "\t")
+         (forward-line 1))
+       ;; Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
+       ;; To gnus-agent-expire work fine with no Xref field in .overview 
+       ;;
        ;; Save these headers for later processing.
        (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
        (let (file)
@@ -1274,6 +1285,94 @@ The following commands are available:
          (gnus-delete-line))
        (gnus-agent-save-history)
        (gnus-agent-close-history)))))
+  
+(defun gnus-agent-expire-old ()
+  "Expire all old articles."
+  (interactive)
+  (let ((methods gnus-agent-covered-methods)
+       (alist (cdr gnus-newsrc-alist))
+       gnus-command-method ofiles info method file group)
+    (while (setq gnus-command-method (pop methods))
+      (setq ofiles (nconc ofiles (gnus-agent-expire-directory
+                                 (gnus-agent-directory)))))
+    (while (setq info (pop alist))
+      (when (and (gnus-agent-method-p
+                 (setq gnus-command-method
+                       (gnus-find-method-for-group
+                        (setq group (gnus-info-group info)))))
+                (member
+                 (setq file
+                       (concat
+                        (gnus-agent-directory)
+                        (gnus-agent-group-path group) "/.overview"))
+                 ofiles))
+       (setq ofiles (delete file ofiles))
+       (gnus-agent-expire-group file group)))
+    (while ofiles
+      (gnus-agent-expire-group (pop ofiles)))))
+
+(defun gnus-agent-expire-directory (dir)
+  "Expire all groups in DIR recursively."
+  (when (file-directory-p dir)
+    (let ((files (directory-files dir t))
+         file ofiles)
+      (while (setq file (pop files))
+       (cond
+        ((member (file-name-nondirectory file) '("." ".."))
+         ;; Do nothing.
+         )
+        ((file-directory-p file)
+         ;; Recurse.
+         (setq ofiles (nconc ofiles (gnus-agent-expire-directory file))))
+        ((string-match "\\.overview$" file)
+         ;; Expire group.
+         (push file ofiles))))
+      ofiles)))
+
+(defun gnus-agent-expire-group (overview &optional group)
+  "Expire articles in OVERVIEW."
+  (gnus-message 5 "Expiring %s..." overview)
+  (let ((odate (- (gnus-time-to-day (current-time)) 4))
+       (dir (file-name-directory overview))
+       (info (when group (gnus-get-info group)))
+       headers article file point unreads)
+    (gnus-agent-load-alist nil dir)
+    (when info
+      (setq unreads
+           (nconc
+            (gnus-list-of-unread-articles group)
+            (gnus-uncompress-range
+             (cdr (assq 'tick (gnus-info-marks info))))
+            (gnus-uncompress-range
+             (cdr (assq 'dormant (gnus-info-marks info)))))))
+    (nnheader-temp-write overview
+      (insert-file-contents overview)
+      (goto-char (point-min))
+      (while (not (eobp))
+       (setq point (point))
+       (condition-case ()
+           (setq headers (inline (nnheader-parse-nov)))
+         (error
+          (goto-char point)
+          (gnus-delete-line)
+          (setq headers nil)))
+       (when headers
+         (if (memq (setq article (mail-header-number headers)) unreads)
+             (forward-line 1)
+           (if (not (< (inline
+                         (gnus-time-to-day
+                          (inline (nnmail-date-to-time
+                                   (mail-header-date headers)))))
+                       odate))
+               (forward-line 1)              
+             (gnus-delete-line)
+             (setq gnus-agent-article-alist
+                   (delq (assq article gnus-agent-article-alist)
+                         gnus-agent-article-alist))
+             (when (file-exists-p
+                    (setq file (concat dir (number-to-string article))))
+               (delete-file file))))))
+      (gnus-agent-save-alist nil nil nil dir))))
 
 ;;;###autoload
 (defun gnus-agent-batch ()
index a249eb9..6229bfb 100644 (file)
@@ -1,8 +1,9 @@
-;;; gnus-art.el --- article mode commands for Gnus
+;;; gnus-art.el --- article mode commands for Semi-gnus
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
@@ -33,6 +34,8 @@
 (require 'gnus-spec)
 (require 'gnus-int)
 (require 'browse-url)
+(require 'alist)
+(require 'mime-view)
 
 (defgroup gnus-article nil
   "Article display."
@@ -365,13 +368,13 @@ be used as possible file names."
   :group 'gnus-article-mime
   :type 'boolean)
 
-(defcustom gnus-show-mime-method 'metamail-buffer
+(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message
   "Function to process a MIME message.
 The function is called from the article buffer."
   :group 'gnus-article-mime
   :type 'function)
 
-(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
+(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
   "*Function to decode MIME encoded words.
 The function is called from the article buffer."
   :group 'gnus-article-mime
@@ -923,84 +926,14 @@ characters to translate to."
                  (process-send-region "article-x-face" beg end)
                  (process-send-eof "article-x-face"))))))))))
 
-(defun gnus-hack-decode-rfc1522 ()
-  "Emergency hack function for avoiding problems when decoding."
-  (let ((buffer-read-only nil))
-    (goto-char (point-min))
-    ;; Remove encoded TABs.
-    (while (search-forward "=09" nil t)
-      (replace-match " " t t))
-    ;; Remove encoded newlines.
-    (goto-char (point-min))
-    (while (search-forward "=10" nil t)
-      (replace-match " " t t))))
-
-(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
-(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
-(defun article-decode-rfc1522 ()
-  "Hack to remove QP encoding from headers."
-  (let ((case-fold-search t)
-       (inhibit-point-motion-hooks t)
-       (buffer-read-only nil)
-       string)
-    (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (or (search-forward "\n\n" nil t) (point-max)))
-      (goto-char (point-min))
-      (while (re-search-forward
-             "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
-       (setq string (match-string 1))
-       (save-restriction
-         (narrow-to-region (match-beginning 0) (match-end 0))
-         (delete-region (point-min) (point-max))
-         (insert string)
-         (article-mime-decode-quoted-printable
-          (goto-char (point-min)) (point-max))
-         (subst-char-in-region (point-min) (point-max) ?_ ? )
-         (goto-char (point-max)))
-       (goto-char (point-min))))))
-
-(defun article-de-quoted-unreadable (&optional force)
-  "Do a naive translation of a quoted-printable-encoded article.
-This is in no way, shape or form meant as a replacement for real MIME
-processing, but is simply a stop-gap measure until MIME support is
-written.
-If FORCE, decode the article whether it is marked as quoted-printable
-or not."
-  (interactive (list 'force))
-  (save-excursion
-    (let ((case-fold-search t)
-         (buffer-read-only nil)
-         (type (gnus-fetch-field "content-transfer-encoding")))
-      (gnus-article-decode-rfc1522)
-      (when (or force
-               (and type (string-match "quoted-printable" (downcase type))))
-       (goto-char (point-min))
-       (search-forward "\n\n" nil 'move)
-       (article-mime-decode-quoted-printable (point) (point-max))))))
-
-(defun article-mime-decode-quoted-printable-buffer ()
-  "Decode Quoted-Printable in the current buffer."
-  (article-mime-decode-quoted-printable (point-min) (point-max)))
-
-(defun article-mime-decode-quoted-printable (from to)
-  "Decode Quoted-Printable in the region between FROM and TO."
-  (interactive "r")
-  (goto-char from)
-  (while (search-forward "=" to t)
-    (cond ((eq (following-char) ?\n)
-          (delete-char -1)
-          (delete-char 1))
-         ((looking-at "[0-9A-F][0-9A-F]")
-          (subst-char-in-region
-           (1- (point)) (point) ?=
-           (hexl-hex-string-to-integer
-            (buffer-substring (point) (+ 2 (point)))))
-          (delete-char 2))
-         ((looking-at "=")
-          (delete-char 1))
-         ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+(defun gnus-article-decode-rfc1522 ()
+  "Decode MIME encoded-words in header fields."
+  (let (buffer-read-only)
+    (let ((charset (save-excursion
+                    (set-buffer gnus-summary-buffer)
+                    default-mime-charset)))
+      (eword-decode-header charset)
+      )))
 
 (defun article-hide-pgp (&optional arg)
   "Toggle hiding of any PGP headers and signatures in the current article.
@@ -1917,7 +1850,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["Hide citation" gnus-article-hide-citation t]
        ["Treat overstrike" gnus-article-treat-overstrike t]
        ["Remove carriage return" gnus-article-remove-cr t]
-       ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
+       ))
 
     (when nil
       (when (boundp 'gnus-summary-article-menu)
@@ -2022,6 +1955,41 @@ commands:
        (forward-line line)
        (point)))))
 
+;;; @@ article filters
+;;;
+
+(defun gnus-article-preview-mime-message ()
+  (make-local-variable 'mime-button-mother-dispatcher)
+  (setq mime-button-mother-dispatcher
+       (function gnus-article-push-button))
+  (let ((default-mime-charset
+         (save-excursion
+           (set-buffer gnus-summary-buffer)
+           default-mime-charset))
+       )
+    (save-excursion
+      (mime-view-mode nil nil nil gnus-original-article-buffer
+                     gnus-article-buffer
+                     gnus-article-mode-map)
+      ))
+  (run-hooks 'gnus-mime-article-prepare-hook)
+  )
+
+(defun gnus-article-decode-encoded-word ()
+  "Header filter for gnus-article-mode.
+It is registered to variable `mime-view-content-header-filter-alist'."
+  (let ((charset (save-excursion
+                  (set-buffer gnus-summary-buffer)
+                  default-mime-charset)))
+    (eword-decode-header charset)
+    (goto-char (point-min))
+    (if (search-forward "\n\n" nil t)
+       (decode-mime-charset-region (match-end 0) (point-max) charset))
+    (mime-maybe-hide-echo-buffer)
+    )
+  (gnus-run-hooks 'gnus-mime-article-prepare-hook)
+  )
+
 (defun gnus-article-prepare (article &optional all-headers header)
   "Prepare ARTICLE in article mode buffer.
 ARTICLE should either be an article number or a Message-ID.
@@ -2123,9 +2091,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                (when gnus-show-mime
                  (if (or (not gnus-strict-mime)
                          (gnus-fetch-field "Mime-Version"))
-                     (let ((coding-system-for-write 'binary)
-                           (coding-system-for-read 'binary))
-                       (funcall gnus-show-mime-method))
+                     (funcall gnus-show-mime-method)
                    (funcall gnus-decode-encoded-word-method)))
                ;; Perform the article display hooks.
                (gnus-run-hooks 'gnus-article-display-hook))
@@ -3275,6 +3241,45 @@ forbidden in URL encoding."
     (gnus-article-prev-page)
     (select-window win)))
 
+
+;;; @ for mime-view
+;;;
+
+(defun gnus-content-header-filter ()
+  "Header filter for mime-view.
+It is registered to variable `mime-view-content-header-filter-alist'."
+  (eword-decode-header default-mime-charset))
+
+(defun mime-view-quitting-method-for-gnus ()
+  (if (not gnus-show-mime)
+      (mime-view-kill-buffer))
+  (delete-other-windows)
+  (gnus-article-show-summary)
+  (if (or (not gnus-show-mime)
+         (null gnus-have-all-headers))
+      (gnus-summary-select-article nil t)
+    ))
+
+(set-alist 'mime-view-content-header-filter-alist
+          'gnus-original-article-mode
+          (function gnus-content-header-filter))
+
+(set-alist 'mime-text-decoder-alist
+          'gnus-original-article-mode
+          (function mime-text-decode-buffer))
+
+(set-alist 'mime-view-quitting-method-alist
+          'gnus-original-article-mode
+          (function mime-view-quitting-method-for-gnus))
+
+(set-alist 'mime-view-show-summary-method
+          'gnus-original-article-mode
+          (function mime-view-quitting-method-for-gnus))
+
+
+;;; @ end
+;;;
+
 (gnus-ems-redefine)
 
 (provide 'gnus-art)
index cb3c145..912af8e 100644 (file)
@@ -1,8 +1,9 @@
-;;; gnus-draft.el --- draft message support for Gnus
+;;; gnus-draft.el --- draft message support for Semi-gnus
 ;; Copyright (C) 1997,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtgnus-run-hooks
-;; Keywords: news
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME, offline
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Utility functions
 
+(defcustom gnus-draft-decoding-function
+  (function
+   (lambda ()
+     (mime-edit-decode-buffer nil)
+     (eword-decode-header)
+     ))
+  "*Function called to decode the message from network representation."
+  :group 'gnus-agent
+  :type 'function)
+
 ;;;!!!If this is byte-compiled, it fails miserably.
 ;;;!!!I have no idea why.
 
       (if (not (gnus-request-restore-buffer article group))
          (error "Couldn't restore the article")
        ;; Insert the separator.
+       (funcall gnus-draft-decoding-function)
        (goto-char (point-min))
        (search-forward "\n\n")
        (forward-char -1)
index d7e8fb8..734723a 100644 (file)
@@ -1,7 +1,8 @@
-;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
+;;; gnus-ems.el --- functions for making Semi-gnus work under different Emacsen
 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;         Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
           (truncate-string valstr (, max-width))
         valstr))))
 
+(defvar gnus-mule-bitmap-image-file nil)
+(defun gnus-mule-group-startup-message (&optional x y)
+  "Insert startup message in current buffer."
+  ;; Insert the message.
+  (erase-buffer)
+  (insert
+   (if (featurep 'bitmap)
+     (format "              %s
+
+"
+            "" (if (and (stringp gnus-mule-bitmap-image-file)
+                        (file-exists-p gnus-mule-bitmap-image-file))
+                   (insert-file gnus-mule-bitmap-image-file)))
+     (format "              %s
+          _    ___ _             _
+          _ ___ __ ___  __    _ ___
+          __   _     ___    __  ___
+              _           ___     _
+             _  _ __             _
+             ___   __            _
+                   __           _
+                    _      _   _
+                   _      _    _
+                      _  _    _
+                  __  ___
+                 _   _ _     _
+                _   _
+              _    _
+             _    _
+            _
+          __
+
+"
+            "")))
+  ;; And then hack it.
+  (gnus-indent-rigidly (point-min) (point-max)
+                      (/ (max (- (window-width) (or x 46)) 0) 2))
+  (goto-char (point-min))
+  (forward-line 1)
+  (let* ((pheight (count-lines (point-min) (point-max)))
+        (wheight (window-height))
+        (rest (- wheight pheight)))
+    (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+  ;; Fontify some.
+  (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+  (goto-char (point-min))
+  (setq mode-line-buffer-identification (concat " " gnus-version))
+  (setq gnus-simple-splash t)
+  (set-buffer-modified-p t))
+
 (defun gnus-encode-coding-string (string system)
   string)
 
     (fset 'gnus-summary-set-display-table (lambda ()))
     (fset 'gnus-encode-coding-string 'encode-coding-string)
     (fset 'gnus-decode-coding-string 'decode-coding-string)
-    
+
+    (and window-system
+        (module-installed-p 'bitmap)
+        (fset 'gnus-group-startup-message 'gnus-mule-group-startup-message))
+
     (when (boundp 'gnus-check-before-posting)
       (setq gnus-check-before-posting
            (delq 'long-lines
diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el
new file mode 100644 (file)
index 0000000..3737fb9
--- /dev/null
@@ -0,0 +1,95 @@
+;;; gnus-i18n.el --- Internationalization for Gnus
+
+;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Created: 1997/11/27
+;; Keywords: internationalization, news, mail
+
+;; This file is not part of GNU Emacs yet.
+
+;; This program 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.
+
+;; This program 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.
+
+;;; Code:
+
+;;; @ newsgroup default charset
+;;;
+
+(defvar gnus-newsgroup-default-charset-alist
+  '(("^\\(fj\\|tnn\\|japan\\)\\."      . iso-2022-jp-2)
+    ("^han\\."                         . euc-kr)
+    ("^relcom\\."                      . koi8-r)
+    ("^alt\\.chinese\\.text\\.big5"    . cn-big5)
+    ("^hk\\(star\\)?\\."               . cn-big5)
+    ("^tw\\."                          . cn-big5)
+    ("^alt\\.chinese"                  . hz-gb-2312)
+    )
+  "Alist of newsgroup patterns vs. corresponding default MIME charset.
+Each element looks like (REGEXP . SYMBOL).  REGEXP is pattern for
+newsgroup name.  SYMBOL is MIME charset or coding-system.")
+
+(defun gnus-set-newsgroup-default-charset (newsgroup charset)
+  "Set CHARSET for the NEWSGROUP as default MIME charset."
+  (let* ((ng-regexp (concat "^" (regexp-quote newsgroup) "\\($\\|\\.\\)"))
+        (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist))
+        )
+    (if pair
+       (setcdr pair charset)
+      (setq gnus-newsgroup-default-charset-alist
+           (cons (cons ng-regexp charset)
+                 gnus-newsgroup-default-charset-alist))
+      )))
+
+
+;;; @ localization
+;;;
+
+(defun gnus-set-summary-default-charset ()
+  "Set up `default-mime-charset' of summary buffer.
+It is specified by variable `gnus-newsgroup-default-charset-alist'
+\(cf. function `gnus-set-newsgroup-default-charset')."
+  (if (buffer-live-p gnus-summary-buffer)
+      (let ((charset
+            (catch 'found
+              (let ((group
+                     (save-excursion
+                       (set-buffer gnus-summary-buffer)
+                       gnus-newsgroup-name))
+                    (alist gnus-newsgroup-default-charset-alist))
+                (while alist
+                  (let ((pair (car alist)))
+                    (if (string-match (car pair) group)
+                        (throw 'found (cdr pair))
+                      ))
+                  (setq alist (cdr alist)))
+                ))))
+       (when charset
+         (save-excursion
+           (set-buffer gnus-summary-buffer)
+           (make-local-variable 'default-mime-charset)
+           (setq default-mime-charset charset)
+           )
+         (make-local-variable 'default-mime-charset)
+         (setq default-mime-charset charset)
+         ))))
+
+
+;;; @ end
+;;;
+
+(provide 'gnus-i18n)
+
+;;; gnus-i18n.el ends here
index f310eed..04b3cf6 100644 (file)
@@ -1,9 +1,10 @@
-;;; gnus-msg.el --- mail and post interface for Gnus
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;;         Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
@@ -290,8 +291,10 @@ post using the current select method."
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)
-       (when (gnus-eval-in-buffer-window gnus-original-article-buffer
-               (message-cancel-news))
+       (when (gnus-eval-in-buffer-window gnus-article-buffer
+               (save-excursion
+                 (set-buffer gnus-original-article-buffer)
+                 (message-cancel-news)))
          (gnus-summary-mark-as-read article gnus-canceled-mark)
          (gnus-cache-remove-article 1))
        (gnus-article-hide-headers-if-wanted))
@@ -485,60 +488,9 @@ If SILENT, don't prompt the user."
 ;;; as well include the Emacs version as well.
 ;;; The following function works with later GNU Emacs, and XEmacs.
 (defun gnus-extended-version ()
-  "Stringified Gnus version and Emacs version"
+  "Stringified Gnus version"
   (interactive)
-  (concat
-   gnus-version
-   "/"
-   (cond
-    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
-     (concat "Emacs " (substring emacs-version
-                                (match-beginning 1)
-                                (match-end 1))))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
-                  emacs-version)
-     (concat (substring emacs-version
-                       (match-beginning 1)
-                       (match-end 1))
-            (format " %d.%d" emacs-major-version emacs-minor-version)
-            (if (match-beginning 3)
-                (substring emacs-version
-                           (match-beginning 3)
-                           (match-end 3))
-              "")
-            (if (boundp 'xemacs-codename)
-                (concat " - \"" xemacs-codename "\""))))
-    (t emacs-version))))
-
-;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
-(defun gnus-inews-insert-mime-headers ()
-  "Insert MIME headers.  
-Assumes ISO-Latin-1 is used iff 8-bit characters are present."
-  (goto-char (point-min))
-  (let ((mail-header-separator
-        (progn
-          (goto-char (point-min))
-          (if (and (search-forward (concat "\n" mail-header-separator "\n")
-                                   nil t)
-                   (not (search-backward "\n\n" nil t)))
-              mail-header-separator
-            ""))))
-    (or (mail-position-on-field "Mime-Version")
-       (insert "1.0")
-       (cond ((save-restriction
-                (widen)
-                (goto-char (point-min))
-                (re-search-forward "[^\000-\177]" nil t))
-              (or (mail-position-on-field "Content-Type")
-                  (insert "text/plain; charset=ISO-8859-1"))
-              (or (mail-position-on-field "Content-Transfer-Encoding")
-                  (insert "8bit")))
-             (t (or (mail-position-on-field "Content-Type")
-                    (insert "text/plain; charset=US-ASCII"))
-                (or (mail-position-on-field "Content-Transfer-Encoding")
-                    (insert "7bit")))))))
-
-(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers)
+  gnus-version)
 
 \f
 ;;;
@@ -885,7 +837,7 @@ this is a reply."
       (save-restriction
        (message-narrow-to-headers)
        (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
-             (cur (current-buffer))
+             (coding-system-for-write 'raw-text)
              groups group method)
          (when gcc
            (message-remove-header "gcc")
@@ -913,7 +865,8 @@ this is a reply."
                (gnus-request-create-group group method))
              (save-excursion
                (nnheader-set-temp-buffer " *acc*")
-               (insert-buffer-substring cur)
+               (insert-buffer-substring message-encoding-buffer)
+               (gnus-run-hooks 'gnus-before-do-gcc-hook)
                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")
index 6264cd9..db74b92 100644 (file)
@@ -1,8 +1,9 @@
-;;; gnus-sum.el --- summary mode commands for Gnus
+;;; gnus-sum.el --- summary mode commands for Semi-gnus
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
 (require 'gnus-range)
 (require 'gnus-int)
 (require 'gnus-undo)
+(require 'std11)
+(require 'mime-view)
+
+(or (string< "1" eword-decode-version)
+    (error "Please install latest SEMI."))
+
 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
 
 (defcustom gnus-kill-summary-on-exit t
   "*If non-nil, kill the summary buffer when you exit from it.
@@ -325,7 +333,7 @@ variable."
   :group 'gnus-article-various
   :type 'boolean)
 
-(defcustom gnus-show-mime nil
+(defcustom gnus-show-mime t
   "*If non-nil, do mime processing of articles.
 The articles will simply be fed to the function given by
 `gnus-show-mime-method'."
@@ -659,18 +667,24 @@ is not run if `gnus-visual' is nil."
   :group 'gnus-summary-visual
   :type 'hook)
 
-(defcustom gnus-structured-field-decoder 'identity
+(defcustom gnus-structured-field-decoder
+  #'eword-decode-and-unfold-structured-field
   "Function to decode non-ASCII characters in structured field for summary."
   :group 'gnus-various
   :type 'function)
 
-(defcustom gnus-unstructured-field-decoder 'identity
+(defcustom gnus-unstructured-field-decoder
+  (function
+   (lambda (string)
+     (eword-decode-unstructured-field-body
+      (std11-unfold-string string) 'must-unfold)
+     ))
   "Function to decode non-ASCII characters in unstructured field for summary."
   :group 'gnus-various
   :type 'function)
 
 (defcustom gnus-parse-headers-hook
-  (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+  '(gnus-set-summary-default-charset)
   "*A hook called before parsing the headers."
   :group 'gnus-various
   :type 'hook)
@@ -1137,6 +1151,7 @@ increase the score of each group you read."
     [delete] gnus-summary-prev-page
     [backspace] gnus-summary-prev-page
     "\r" gnus-summary-scroll-up
+    "\e\r" gnus-summary-scroll-down
     "n" gnus-summary-next-unread-article
     "p" gnus-summary-prev-unread-article
     "N" gnus-summary-next-article
@@ -1218,6 +1233,7 @@ increase the score of each group you read."
     "t" gnus-article-hide-headers
     "g" gnus-summary-show-article
     "l" gnus-summary-goto-last-article
+    "v" gnus-summary-preview-mime-message
     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
     "\C-d" gnus-summary-enter-digest-group
     "\M-\C-d" gnus-summary-read-document
@@ -1361,7 +1377,6 @@ increase the score of each group you read."
     "e" gnus-article-emphasize
     "w" gnus-article-fill-cited-article
     "c" gnus-article-remove-cr
-    "q" gnus-article-de-quoted-unreadable
     "f" gnus-article-display-x-face
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message
@@ -1614,7 +1629,6 @@ increase the score of each group you read."
        ["Word wrap" gnus-article-fill-cited-article t]
        ["CR" gnus-article-remove-cr t]
        ["Show X-Face" gnus-article-display-x-face t]
-       ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
        ["UnHTMLize" gnus-article-treat-html t]
        ["Rot 13" gnus-summary-caesar-message t]
        ["Unix pipe" gnus-summary-pipe-message t]
@@ -4722,7 +4736,7 @@ taken into consideration."
       (let ((max (max (point) (mark)))
            articles article)
        (save-excursion
-         (goto-char (min (min (point) (mark))))
+         (goto-char (min (point) (mark)))
          (while
              (and
               (push (setq article (gnus-summary-article-number)) articles)
@@ -5237,6 +5251,28 @@ which existed when entering the ephemeral is reset."
       (gnus-summary-recenter)
       (gnus-summary-position-point))))
 
+(defun gnus-summary-preview-mime-message (arg)
+  "MIME decode and play this message."
+  (interactive "P")
+  (let ((gnus-break-pages nil))
+    (gnus-summary-select-article t t)
+    )
+  (pop-to-buffer gnus-original-article-buffer t)
+  (let (buffer-read-only)
+    (if (text-property-any (point-min) (point-max) 'invisible t)
+       (remove-text-properties (point-min) (point-max)
+                               gnus-hidden-properties)
+      ))
+  (mime-view-mode nil nil nil gnus-original-article-buffer
+                 gnus-article-buffer)
+  )
+
+(defun gnus-summary-scroll-down ()
+  "Scroll down one line current article."
+  (interactive)
+  (gnus-summary-scroll-up -1)
+  )
+
 ;;; Dead summaries.
 
 (defvar gnus-dead-summary-mode-map nil)
@@ -8979,6 +9015,33 @@ save those articles instead."
           (gnus-summary-exit))
         buffers)))))
 
+
+;;; @ for mime-partial
+;;;
+
+(defun gnus-mime-partial-preview-function ()
+  (gnus-summary-preview-mime-message (gnus-summary-article-number))
+  )
+
+(autoload 'mime-combine-message/partials-automatically
+  "mime-partial"
+  "Internal method to combine message/partial messages automatically.")
+
+(set-atype 'mime-acting-condition
+          '((type . "message/partial")
+            (method . mime-combine-message/partials-automatically)
+            (major-mode . gnus-original-article-mode)
+            (summary-buffer-exp . gnus-summary-buffer)
+            ))
+
+(set-alist 'mime-view-partial-message-method-alist
+          'gnus-original-article-mode
+          'gnus-mime-partial-preview-function)
+
+
+;;; @ end
+;;;
+
 (gnus-ems-redefine)
 
 (provide 'gnus-sum)
index 15b2bc5..0b86f72 100644 (file)
@@ -246,11 +246,12 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "5.6.1"
-  "Version number for this version of Gnus.")
+(defconst gnus-version-number "6.0.8"
+  "Version number for this version of gnus.")
 
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
-  "Version string for this version of Gnus.")
+(defconst gnus-version
+  (format "Semi-gnus %s (based on Quassia Gnus v0.37)" gnus-version-number)
+  "Version string for this version of gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
   "If non-nil, the startup message will not be displayed.
@@ -1331,7 +1332,6 @@ want."
             gnus-article-emphasize
             gnus-article-fill-cited-article
             gnus-article-remove-cr
-            gnus-article-de-quoted-unreadable
             gnus-summary-stop-page-breaking
             ;; gnus-summary-caesar-message
             ;; gnus-summary-verbose-headers
@@ -1374,7 +1374,6 @@ want."
 (defvar gnus-original-article-buffer " *Original Article*")
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-ephemeral-servers nil)
-(defvar gnus-edit-form-buffer "*Gnus edit form*")
 
 (defvar gnus-agent nil
   "Whether we want to use the Gnus agent or not.")
@@ -1526,8 +1525,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
        (if (eq (nth 1 package) ':interactive)
            (cdddr package)
          (cdr package)))))
-   '(("metamail" metamail-buffer)
-     ("info" Info-goto-node)
+   '(("info" Info-goto-node)
      ("hexl" hexl-hex-string-to-integer)
      ("pp" pp pp-to-string pp-eval-expression)
      ("ps-print" ps-print-preprint)
@@ -1652,7 +1650,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       gnus-article-hide-headers gnus-article-hide-boring-headers
       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-display-x-face
       gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
       gnus-article-hide-pem gnus-article-hide-signature
       gnus-article-strip-leading-blank-lines gnus-article-date-local
index 288dc8a..7d92912 100644 (file)
@@ -2,6 +2,12 @@
 
 (defvar byte-compile-default-warnings)
 
+(or (featurep 'path-util)
+    (load "apel/path-util"))
+(add-path "apel")
+(add-path "mel")
+(add-path "semi")
+
 (defun maybe-fbind (args)
   (while args
     (or (fboundp (car args))
index 3269031..04180da 100644 (file)
@@ -2,7 +2,8 @@
 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: mail, news
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (require 'smtp)
+  )
 
 (require 'mailheader)
 (require 'nnheader)
@@ -39,6 +43,7 @@
 (if (string-match "XEmacs\\|Lucid" emacs-version)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
+(require 'mime-edit)
 
 (defgroup message '((user-mail-address custom-variable)
                    (user-full-name custom-variable))
@@ -122,6 +127,11 @@ mailbox format."
                (function :tag "Other"))
   :group 'message-sending)
 
+(defcustom message-encode-function 'message-maybe-encode
+  "*A function called to encode messages."
+  :group 'message-sending
+  :type 'function)
+
 (defcustom message-courtesy-message
   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
   "*This is inserted at the start of a mailed copy of a posted message.
@@ -277,13 +287,13 @@ If nil, Message won't autosave."
   :type 'directory)
 
 (defcustom message-forward-start-separator
-  "------- Start of forwarded message -------\n"
+  (concat (mime-make-tag "message" "rfc822") "\n")
   "*Delimiter inserted before forwarded messages."
   :group 'message-forwarding
   :type 'string)
 
 (defcustom message-forward-end-separator
-  "------- End of forwarded message -------\n"
+  ""
   "*Delimiter inserted after forwarded messages."
   :group 'message-forwarding
   :type 'string)
@@ -323,16 +333,17 @@ variable `mail-header-separator'.
 
 Legal values include `message-send-mail-with-sendmail' (the default),
 `message-send-mail-with-mh', `message-send-mail-with-qmail' and
-`smtpmail-send-it'."
+`message-send-mail-with-smtp'."
   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)
-               (function-item smtpmail-send-it)
+               (function-item message-send-mail-with-smtp)
                (function :tag "Other"))
   :group 'message-sending
   :group 'message-mail)
 
-(defcustom message-send-news-function 'message-send-news
+;; 1997-09-29 by MORIOKA Tomohiko
+(defcustom message-send-news-function 'message-send-news-with-gnus
   "Function to call to send the current buffer as news.
 The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'."
@@ -416,7 +427,8 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :group 'message-headers
   :type 'boolean)
 
-(defcustom message-setup-hook nil
+(defcustom message-setup-hook
+  '(message-maybe-setup-default-charset turn-on-mime-edit)
   "Normal hook, run each time a new outgoing message is initialized.
 The function `message-setup' runs this hook."
   :group 'message-various
@@ -434,7 +446,7 @@ the signature is inserted."
   :group 'message-various
   :type 'hook)
 
-(defcustom message-header-hook nil
+(defcustom message-header-hook '(eword-encode-header)
   "Hook run in a message mode buffer narrowed to the headers."
   :group 'message-various
   :type 'hook)
@@ -904,7 +916,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
-    (References . message-fill-header)
+    (References . message-fill-references)
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
@@ -1859,20 +1871,29 @@ the user from the mailer."
     (message-fix-before-sending)
     (run-hooks 'message-send-hook)
     (message "Sending...")
-    (let ((alist message-send-method-alist)
+    (let ((message-encoding-buffer
+          (message-generate-new-buffer-clone-locals " message encoding"))
+         (message-edit-buffer (current-buffer))
+         (message-mime-mode mime-edit-mode-flag)
+         (alist message-send-method-alist)
          (success t)
          elem sent)
-      (while (and success
-                 (setq elem (pop alist)))
-       (when (and (or (not (funcall (cadr elem)))
-                      (and (or (not (memq (car elem)
-                                          message-sent-message-via))
-                               (y-or-n-p
-                                (format
-                                 "Already sent message via %s; resend? "
-                                 (car elem))))
-                           (setq success (funcall (caddr elem) arg)))))
-         (setq sent t)))
+      (save-excursion
+       (set-buffer message-encoding-buffer)
+       (erase-buffer)
+       (insert-buffer message-edit-buffer)
+       (funcall message-encode-function)
+       (while (and success
+                   (setq elem (pop alist)))
+         (when (and (or (not (funcall (cadr elem)))
+                        (and (or (not (memq (car elem)
+                                            message-sent-message-via))
+                                 (y-or-n-p
+                                  (format
+                                   "Already sent message via %s; resend? "
+                                   (car elem))))
+                             (setq success (funcall (caddr elem) arg)))))
+           (setq sent t))))
       (when (and success sent)
        (message-do-fcc)
        ;;(when (fboundp 'mail-hist-put-headers-into-history)
@@ -1895,7 +1916,7 @@ the user from the mailer."
 
 (defun message-send-via-news (arg)
   "Send the current message via news."
-  (funcall message-send-news-function arg))
+  (message-send-news arg))
 
 (defun message-fix-before-sending ()
   "Do various things to make the message nice before sending it."
@@ -1929,8 +1950,7 @@ the user from the mailer."
   (require 'mail-utils)
   (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (case-fold-search nil)
-       (news (message-news-p))
-       (mailbuf (current-buffer)))
+       (news (message-news-p)))
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -1943,11 +1963,7 @@ the user from the mailer."
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
-         ;; Avoid copying text props.
-         (insert (format
-                  "%s" (save-excursion
-                         (set-buffer mailbuf)
-                         (buffer-string))))
+         (insert-buffer message-encoding-buffer)
          ;; Remove some headers.
          (save-restriction
            (message-narrow-to-headers)
@@ -1961,9 +1977,15 @@ the user from the mailer."
                     (or (message-fetch-field "cc")
                         (message-fetch-field "to")))
            (message-insert-courtesy-copy))
+         (mime-edit-maybe-split-and-send
+          (function
+           (lambda ()
+             (interactive)
+             (funcall message-send-mail-function)
+             )))
          (funcall message-send-mail-function))
       (kill-buffer tembuf))
-    (set-buffer mailbuf)
+    (set-buffer message-edit-buffer)
     (push 'mail message-sent-message-via)))
 
 (defun message-send-mail-with-sendmail ()
@@ -2090,13 +2112,151 @@ to find out how to use this."
     ;; Pass it on to mh.
     (mh-send-letter)))
 
+(defun message-send-mail-with-smtp ()
+  "Send the prepared message buffer with SMTP."
+  (require 'smtp)
+  (let ((errbuf (if mail-interactive
+                   (generate-new-buffer " smtp errors")
+                 0))
+       (case-fold-search nil)
+       resend-to-addresses
+       delimline)
+    (unwind-protect
+       (save-excursion
+         (goto-char (point-max))
+         ;; require one newline at the end.
+         (or (= (preceding-char) ?\n)
+             (insert ?\n))
+         ;; Change header-delimiter to be what sendmail expects.
+         (goto-char (point-min))
+         (re-search-forward
+          (concat "^" (regexp-quote mail-header-separator) "\n"))
+         (replace-match "\n")
+         (backward-char 1)
+         (setq delimline (point-marker))
+         (run-hooks 'message-send-mail-hook)
+         ;; (sendmail-synch-aliases)
+          ;; (if mail-aliases
+          ;;     (expand-mail-aliases (point-min) delimline))
+         (goto-char (point-min))
+         ;; ignore any blank lines in the header
+         (while (and (re-search-forward "\n\n\n*" delimline t)
+                     (< (point) delimline))
+           (replace-match "\n"))
+         (let ((case-fold-search t))
+           (goto-char (point-min))
+           (goto-char (point-min))
+           (while (re-search-forward "^Resent-to:" delimline t)
+             (setq resend-to-addresses
+                   (save-restriction
+                     (narrow-to-region (point)
+                                       (save-excursion
+                                         (end-of-line)
+                                         (point)))
+                     (append (mail-parse-comma-list)
+                             resend-to-addresses))))
+;;; Apparently this causes a duplicate Sender.
+;;;        ;; If the From is different than current user, insert Sender.
+;;;        (goto-char (point-min))
+;;;        (and (re-search-forward "^From:"  delimline t)
+;;;             (progn
+;;;               (require 'mail-utils)
+;;;               (not (string-equal
+;;;                     (mail-strip-quoted-names
+;;;                      (save-restriction
+;;;                        (narrow-to-region (point-min) delimline)
+;;;                        (mail-fetch-field "From")))
+;;;                     (user-login-name))))
+;;;             (progn
+;;;               (forward-line 1)
+;;;               (insert "Sender: " (user-login-name) "\n")))
+           ;; Don't send out a blank subject line
+           (goto-char (point-min))
+           (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
+               (replace-match ""))
+           ;; Put the "From:" field in unless for some odd reason
+           ;; they put one in themselves.
+           (goto-char (point-min))
+           (if (not (re-search-forward "^From:" delimline t))
+               (let* ((login user-mail-address)
+                      (fullname (user-full-name)))
+                 (cond ((eq mail-from-style 'angles)
+                        (insert "From: " fullname)
+                        (let ((fullname-start (+ (point-min) 6))
+                              (fullname-end (point-marker)))
+                          (goto-char fullname-start)
+                          ;; Look for a character that cannot appear unquoted
+                          ;; according to RFC 822.
+                          (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
+                                                 fullname-end 1)
+                              (progn
+                                ;; Quote fullname, escaping specials.
+                                (goto-char fullname-start)
+                                (insert "\"")
+                                (while (re-search-forward "[\"\\]"
+                                                          fullname-end 1)
+                                  (replace-match "\\\\\\&" t))
+                                (insert "\""))))
+                        (insert " <" login ">\n"))
+                       ((eq mail-from-style 'parens)
+                        (insert "From: " login " (")
+                        (let ((fullname-start (point)))
+                          (insert fullname)
+                          (let ((fullname-end (point-marker)))
+                            (goto-char fullname-start)
+                            ;; RFC 822 says \ and nonmatching parentheses
+                            ;; must be escaped in comments.
+                            ;; Escape every instance of ()\ ...
+                            (while (re-search-forward "[()\\]" fullname-end 1)
+                              (replace-match "\\\\\\&" t))
+                            ;; ... then undo escaping of matching parentheses,
+                            ;; including matching nested parentheses.
+                            (goto-char fullname-start)
+                            (while (re-search-forward 
+                                    "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+                                    fullname-end 1)
+                              (replace-match "\\1(\\3)" t)
+                              (goto-char fullname-start))))
+                        (insert ")\n"))
+                       ((null mail-from-style)
+                        (insert "From: " login "\n")))))
+           ;; Insert an extra newline if we need it to work around
+           ;; Sun's bug that swallows newlines.
+           (goto-char (1+ delimline))
+           (if (eval mail-mailer-swallows-blank-line)
+               (newline))
+           ;; Find and handle any FCC fields.
+           (goto-char (point-min))
+           (if (re-search-forward "^FCC:" delimline t)
+               (mail-do-fcc delimline))
+           (if mail-interactive
+               (save-excursion
+                 (set-buffer errbuf)
+                 (erase-buffer))))
+         ;;
+         ;;
+         ;;
+         (let ((recipient-address-list
+                (or resend-to-addresses
+                    (smtp-deduce-address-list (current-buffer)
+                                              (point-min) delimline))))
+           (smtp-do-bcc delimline)
+           
+           (if recipient-address-list
+               (if (not (smtp-via-smtp recipient-address-list
+                                       (current-buffer)))
+                   (error "Sending failed; SMTP protocol error"))
+             (error "Sending failed; no recipients"))
+           ))
+      (if (bufferp errbuf)
+         (kill-buffer errbuf)))))
+
 (defun message-send-news (&optional arg)
   (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
        (case-fold-search nil)
        (method (if (message-functionp message-post-method)
                    (funcall message-post-method arg)
                  message-post-method))
-       (messbuf (current-buffer))
        (message-syntax-checks
         (if arg
             (cons '(existing-newsgroups . disabled)
@@ -2119,11 +2279,7 @@ to find out how to use this."
            (set-buffer tembuf)
            (buffer-disable-undo (current-buffer))
            (erase-buffer)
-           ;; Avoid copying text props.
-           (insert (format
-                    "%s" (save-excursion
-                           (set-buffer messbuf)
-                           (buffer-string))))
+           (insert-buffer message-encoding-buffer)
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
@@ -2133,30 +2289,48 @@ to find out how to use this."
            ;; require one newline at the end.
            (or (= (preceding-char) ?\n)
                (insert ?\n))
-           (let ((case-fold-search t))
-             ;; Remove the delimiter.
-             (goto-char (point-min))
-             (re-search-forward
-              (concat "^" (regexp-quote mail-header-separator) "\n"))
-             (replace-match "\n")
-             (backward-char 1))
-           (run-hooks 'message-send-news-hook)
-           ;;(require (car method))
-           ;;(funcall (intern (format "%s-open-server" (car method)))
-           ;;(cadr method) (cddr method))
-           ;;(setq result
-           ;;    (funcall (intern (format "%s-request-post" (car method)))
-           ;;             (cadr method)))
-           (gnus-open-server method)
-           (setq result (gnus-request-post method)))
+           (mime-edit-maybe-split-and-send
+            (function
+             (lambda ()
+               (interactive)
+               (save-restriction
+                 (std11-narrow-to-header mail-header-separator)
+                 (goto-char (point-min))
+                 (when (re-search-forward "^Message-Id:" nil t)
+                   (delete-region (match-end 0)(std11-field-end))
+                   (insert (concat " " (message-make-message-id)))
+                   ))
+               (funcall message-send-news-function method)
+               )))
+           (setq result (funcall message-send-news-function method)))
        (kill-buffer tembuf))
-      (set-buffer messbuf)
+      (set-buffer message-edit-buffer)
       (if result
          (push 'news message-sent-message-via)
        (message "Couldn't send message via news: %s"
                 (nnheader-get-report (car method)))
        nil))))
 
+;; 1997-09-29 by MORIOKA Tomohiko
+(defun message-send-news-with-gnus (method)
+  (let ((case-fold-search t))
+    ;; Remove the delimiter.
+    (goto-char (point-min))
+    (re-search-forward
+     (concat "^" (regexp-quote mail-header-separator) "\n"))
+    (replace-match "\n")
+    (backward-char 1)
+    (run-hooks 'message-send-news-hook)
+    ;;(require (car method))
+    ;;(funcall (intern (format "%s-open-server" (car method)))
+    ;;(cadr method) (cddr method))
+    ;;(setq result
+    ;;   (funcall (intern (format "%s-request-post" (car method)))
+    ;;            (cadr method)))
+    (gnus-open-server method)
+    (gnus-request-post method)
+    ))
+
 ;;;
 ;;; Header generation & syntax checking.
 ;;;
@@ -2190,7 +2364,9 @@ to find out how to use this."
           (message-narrow-to-headers)
           (message-check-news-header-syntax)))
        ;; Check the body.
-       (message-check-news-body-syntax)))))
+       (save-excursion
+        (set-buffer message-edit-buffer)
+        (message-check-news-body-syntax))))))
 
 (defun message-check-news-header-syntax ()
   (and
@@ -2451,18 +2627,19 @@ to find out how to use this."
 (defun message-do-fcc ()
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
-       (buf (current-buffer))
+       (coding-system-for-write 'raw-text)
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (insert-buffer-substring buf)
+      (insert-buffer-substring message-encoding-buffer)
       (save-restriction
        (message-narrow-to-headers)
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))
+      (run-hooks 'message-header-hook 'message-before-do-fcc-hook)
       (goto-char (point-min))
       (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
       (replace-match "" t t)
@@ -2955,6 +3132,13 @@ Headers already prepared in the buffer are not modified."
     (widen)
     (forward-line 1)))
 
+(defun message-fill-references (header value)
+  (insert (capitalize (symbol-name header))
+         ": "
+         (std11-fill-msg-id-list-string
+          (if (consp value) (car value) value))
+         "\n"))
+
 (defun message-fill-header (header value)
   (let ((begin (point))
        (fill-column 990)
@@ -3399,7 +3583,7 @@ responses here are directed to other newsgroups."))
                distribution (message-fetch-field "distribution")))
        ;; Make sure that this article was written by the user.
        (unless (string-equal
-                (downcase (cadr (mail-extract-address-components from)))
+                (downcase (cadr (std11-extract-address-components from)))
                 (downcase (message-make-address)))
          (error "This article is not yours"))
        ;; Make control message.
@@ -3417,8 +3601,10 @@ responses here are directed to other newsgroups."))
                message-cancel-message)
        (message "Canceling your article...")
        (if (let ((message-syntax-checks
-                  'dont-check-for-anything-just-trust-me))
-             (funcall message-send-news-function))
+                  'dont-check-for-anything-just-trust-me)
+                 (message-encoding-buffer (current-buffer))
+                 (message-edit-buffer (current-buffer)))
+             (message-send-news))
            (message "Canceling your article...done"))
        (kill-buffer buf)))))
 
@@ -3530,7 +3716,10 @@ Optional NEWS will use news to forward instead of mail."
       (set-buffer (get-buffer-create " *message resend*"))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (message-setup `((To . ,address)))
+      ;; avoid to turn-on-mime-edit
+      (let (message-setup-hook)
+       (message-setup `((To . ,address)))
+       )
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To))
       (message-narrow-to-headers)
@@ -3561,7 +3750,9 @@ Optional NEWS will use news to forward instead of mail."
       (when (looking-at "From ")
        (replace-match "X-From-Line: "))
       ;; Send it.
-      (message-send-mail)
+      (let ((message-encoding-buffer (current-buffer))
+           (message-edit-buffer (current-buffer)))
+       (message-send-mail))
       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 
@@ -3717,7 +3908,8 @@ Do a `tab-to-tab-stop' if not in those headers."
 
 (defvar gnus-active-hashtb)
 (defun message-expand-group ()
-  "Expand the group name under point."  (let* ((b (save-excursion
+  "Expand the group name under point."
+  (let* ((b (save-excursion
              (save-restriction
                (narrow-to-region
                 (save-excursion
@@ -3811,6 +4003,47 @@ regexp varstr."
                (cdr local)))))
      locals)))
 
+
+;;; @ for MIME Edit mode
+;;;
+
+(defun message-maybe-setup-default-charset ()
+  (let ((charset
+        (and (boundp 'gnus-summary-buffer)
+              (buffer-live-p gnus-summary-buffer)
+             (save-excursion
+               (set-buffer gnus-summary-buffer)
+               default-mime-charset))))
+    (if charset
+       (progn
+         (make-local-variable 'default-mime-charset)
+         (setq default-mime-charset charset)
+         ))))
+
+(defun message-maybe-encode ()
+  (when message-mime-mode
+    (run-hooks 'mime-edit-translate-hook)
+    (if (catch 'mime-edit-error
+         (save-excursion
+           (mime-edit-translate-body)
+           ))
+       (error "Translation error!")
+      )
+    (end-of-invisible)
+    (run-hooks 'mime-edit-exit-hook)
+    ))
+
+(defun message-mime-insert-article (&optional message)
+  (interactive)
+  (let ((message-cite-function 'mime-edit-inserted-message-filter)
+        (message-reply-buffer gnus-original-article-buffer)
+       )
+    (message-yank-original nil)
+    ))
+
+(set-alist 'mime-edit-message-inserter-alist
+          'message-mode (function message-mime-insert-article))
+
 ;;; Miscellaneous functions
 
 ;; stolen (and renamed) from nnheader.el
index b37b539..44f3079 100644 (file)
@@ -59,10 +59,7 @@ on your system, you could say something like:
  (autoload 'mail-position-on-field "sendmail")
  (autoload 'message-remove-header "message")
  (autoload 'cancel-function-timers "timers")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-delete-line "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util")
- (autoload 'gnus-encode-coding-string "gnus-ems"))
+ (autoload 'gnus-point-at-eol "gnus-util"))
 
 ;;; Header access macros.
 
index 3362ed5..1bfd8ec 100644 (file)
@@ -1,10 +1,10 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
-;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Keywords: mail, pop3
-;; Version: 1.3l
+;; Version: 1.3l+
 
 ;; This file is part of GNU Emacs.
 
@@ -37,7 +37,7 @@
 (require 'mail-utils)
 (provide 'pop3)
 
-(defconst pop3-version "1.3l")
+(defconst pop3-version "1.3l+")
 
 (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
   "*POP3 maildrop.")
@@ -60,6 +60,9 @@ values are 'apop.")
   "Timestamp returned when initially connected to the POP server.
 Used for APOP authentication.")
 
+(defvar pop3-movemail-file-coding-system 'binary
+  "Crashbox made by pop3-movemail with this coding system.")
+
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 
@@ -91,7 +94,8 @@ Used for APOP authentication.")
       (pop3-retr process n crashbuf)
       (save-excursion
        (set-buffer crashbuf)
-       (append-to-file (point-min) (point-max) crashbox)
+       (let ((coding-system-for-write pop3-movemail-file-coding-system))
+         (append-to-file (point-min) (point-max) crashbox))
        (set-buffer (process-buffer process))
        (while (> (buffer-size) 5000)
          (goto-char (point-min))
@@ -111,7 +115,8 @@ Used for APOP authentication.")
 Returns the process associated with the connection."
   (let ((process-buffer
         (get-buffer-create (format "trace of POP session to %s" mailhost)))
-       (process))
+       (process)
+       (coding-system-for-read 'binary))
     (save-excursion
       (set-buffer process-buffer)
       (erase-buffer)
@@ -123,8 +128,7 @@ Returns the process associated with the connection."
       (setq pop3-timestamp
            (substring response (or (string-match "<" response) 0)
                       (+ 1 (or (string-match ">" response) -1)))))
-    process
-    ))
+    process))
 
 ;; Support functions
 
diff --git a/lisp/smtp.el b/lisp/smtp.el
new file mode 100644 (file)
index 0000000..7dde447
--- /dev/null
@@ -0,0 +1,457 @@
+;;; smtp.el --- basic functions to send mail with SMTP server
+
+;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc.
+
+;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; ESMTP support: Simon Leinen <simon@switch.ch>
+;; Keywords: SMTP, mail
+
+;; 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.
+
+;;; Code:
+
+(defgroup smtp nil
+  "SMTP protocol for sending mail."
+  :group 'mail)
+
+(defcustom smtp-default-server nil
+  "*Specify default SMTP server."
+  :type '(choice (const nil) string)
+  :group 'smtp)
+
+(defcustom smtp-server 
+  (or (getenv "SMTPSERVER") smtp-default-server)
+  "*The name of the host running SMTP server."
+  :type '(choice (const nil) string)
+  :group 'smtp)
+
+(defcustom smtp-service 25
+  "*SMTP service port number. smtp or 25 ."
+  :type 'integer
+  :group 'smtp)
+
+(defcustom smtp-local-domain nil
+  "*Local domain name without a host name.
+If the function (system-name) returns the full internet address,
+don't define this value."
+  :type '(choice (const nil) string)
+  :group 'smtp)
+
+(defcustom smtp-debug-info nil
+  "*smtp debug info printout. messages and process buffer."
+  :type 'boolean
+  :group 'smtp)
+
+(defcustom smtp-coding-system 'binary
+  "*Coding-system for SMTP output."
+  :type 'coding-system
+  :group 'smtp)
+
+
+(defun smtp-fqdn ()
+  (if smtp-local-domain
+      (concat (system-name) "." smtp-local-domain)
+    (system-name)))
+
+(defun smtp-via-smtp (recipient smtp-text-buffer)
+  (let ((process nil)
+       (host smtp-server)
+       (port smtp-service)
+       response-code
+       greeting
+       process-buffer
+       (supported-extensions '())
+       (coding-system-for-read smtp-coding-system)
+       (coding-system-for-write smtp-coding-system))
+    (unwind-protect
+       (catch 'done
+         ;; get or create the trace buffer
+         (setq process-buffer
+               (get-buffer-create
+                (format "*trace of SMTP session to %s*" host)))
+
+         ;; clear the trace buffer of old output
+         (save-excursion
+           (set-buffer process-buffer)
+           (erase-buffer))
+
+         ;; open the connection to the server
+         (setq process (open-network-stream "SMTP" process-buffer host port))
+         (and (null process) (throw 'done nil))
+
+         ;; set the send-filter
+         (set-process-filter process 'smtp-process-filter)
+
+         (save-excursion
+           (set-buffer process-buffer)
+           (make-local-variable 'smtp-read-point)
+           (setq smtp-read-point (point-min))
+
+           (if (or (null (car (setq greeting (smtp-read-response process))))
+                   (not (integerp (car greeting)))
+                   (>= (car greeting) 400))
+               (throw 'done nil)
+             )
+
+           ;; EHLO
+           (smtp-send-command process (format "EHLO %s" (smtp-fqdn)))
+
+           (if (or (null (car (setq response-code (smtp-read-response process))))
+                   (not (integerp (car response-code)))
+                   (>= (car response-code) 400))
+               (progn
+                 ;; HELO
+                 (smtp-send-command process (format "HELO %s" (smtp-fqdn)))
+
+                 (if (or (null (car (setq response-code (smtp-read-response process))))
+                         (not (integerp (car response-code)))
+                         (>= (car response-code) 400))
+                     (throw 'done nil)))
+             (let ((extension-lines (cdr (cdr response-code))))
+               (while extension-lines
+                 (let ((name (intern (downcase (substring (car extension-lines) 4)))))
+                   (and name
+                        (cond ((memq name '(verb xvrb 8bitmime onex xone
+                                                 expn size dsn etrn
+                                                 help xusr))
+                               (setq supported-extensions
+                                     (cons name supported-extensions)))
+                              (t (message "unknown extension %s"
+                                          name)))))
+                 (setq extension-lines (cdr extension-lines)))))
+
+           (if (or (member 'onex supported-extensions)
+                   (member 'xone supported-extensions))
+               (progn
+                 (smtp-send-command process (format "ONEX"))
+                 (if (or (null (car (setq response-code (smtp-read-response process))))
+                         (not (integerp (car response-code)))
+                         (>= (car response-code) 400))
+                     (throw 'done nil))))
+
+           (if (and smtp-debug-info
+                    (or (member 'verb supported-extensions)
+                        (member 'xvrb supported-extensions)))
+               (progn
+                 (smtp-send-command process (format "VERB"))
+                 (if (or (null (car (setq response-code (smtp-read-response process))))
+                         (not (integerp (car response-code)))
+                         (>= (car response-code) 400))
+                     (throw 'done nil))))
+
+           (if (member 'xusr supported-extensions)
+               (progn
+                 (smtp-send-command process (format "XUSR"))
+                 (if (or (null (car (setq response-code (smtp-read-response process))))
+                         (not (integerp (car response-code)))
+                         (>= (car response-code) 400))
+                     (throw 'done nil))))
+
+           ;; MAIL FROM: <sender>
+           (let ((size-part
+                  (if (member 'size supported-extensions)
+                      (format " SIZE=%d"
+                              (save-excursion
+                                (set-buffer smtp-text-buffer)
+                                ;; size estimate:
+                                (+ (- (point-max) (point-min))
+                                   ;; Add one byte for each change-of-line
+                                   ;; because or CR-LF representation:
+                                   (count-lines (point-min) (point-max))
+                                   ;; For some reason, an empty line is
+                                   ;; added to the message.  Maybe this
+                                   ;; is a bug, but it can't hurt to add
+                                   ;; those two bytes anyway:
+                                   2)))
+                    ""))
+                 (body-part
+                  (if (member '8bitmime supported-extensions)
+                      ;; FIXME:
+                      ;; Code should be added here that transforms
+                      ;; the contents of the message buffer into
+                      ;; something the receiving SMTP can handle.
+                      ;; For a receiver that supports 8BITMIME, this
+                      ;; may mean converting BINARY to BASE64, or
+                      ;; adding Content-Transfer-Encoding and the
+                      ;; other MIME headers.  The code should also
+                      ;; return an indication of what encoding the
+                      ;; message buffer is now, i.e. ASCII or
+                      ;; 8BITMIME.
+                      (if nil
+                          " BODY=8BITMIME"
+                        "")
+                    "")))
+;            (smtp-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtp-fqdn)))
+             (smtp-send-command process (format "MAIL FROM: <%s>%s%s"
+                                                    user-mail-address
+                                                    size-part
+                                                    body-part))
+
+             (if (or (null (car (setq response-code (smtp-read-response process))))
+                     (not (integerp (car response-code)))
+                     (>= (car response-code) 400))
+                 (throw 'done nil)
+               ))
+           
+           ;; RCPT TO: <recipient>
+           (let ((n 0))
+             (while (not (null (nth n recipient)))
+               (smtp-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
+               (setq n (1+ n))
+
+               (setq response-code (smtp-read-response process))
+               (if (or (null (car response-code))
+                       (not (integerp (car response-code)))
+                       (>= (car response-code) 400))
+                   (throw 'done nil)
+                 )
+               ))
+           
+           ;; DATA
+           (smtp-send-command process "DATA")
+
+           (if (or (null (car (setq response-code (smtp-read-response process))))
+                   (not (integerp (car response-code)))
+                   (>= (car response-code) 400))
+               (throw 'done nil)
+             )
+
+           ;; Mail contents
+           (smtp-send-data process smtp-text-buffer)
+
+           ;;DATA end "."
+           (smtp-send-command process ".")
+
+           (if (or (null (car (setq response-code (smtp-read-response process))))
+                   (not (integerp (car response-code)))
+                   (>= (car response-code) 400))
+               (throw 'done nil)
+             )
+
+           ;;QUIT
+;          (smtp-send-command process "QUIT")
+;          (and (null (car (smtp-read-response process)))
+;               (throw 'done nil))
+           t ))
+      (if process
+         (save-excursion
+           (set-buffer (process-buffer process))
+           (smtp-send-command process "QUIT")
+           (smtp-read-response process)
+
+;          (if (or (null (car (setq response-code (smtp-read-response process))))
+;                  (not (integerp (car response-code)))
+;                  (>= (car response-code) 400))
+;              (throw 'done nil)
+;            )
+           (delete-process process))))))
+
+(defun smtp-process-filter (process output)
+  (save-excursion
+    (set-buffer (process-buffer process))
+    (goto-char (point-max))
+    (insert output)))
+
+(defun smtp-read-response (process)
+  (let ((case-fold-search nil)
+       (response-strings nil)
+       (response-continue t)
+       (return-value '(nil ()))
+       match-end)
+
+    (while response-continue
+      (goto-char smtp-read-point)
+      (while (not (search-forward "\r\n" nil t))
+       (accept-process-output process)
+       (goto-char smtp-read-point))
+
+      (setq match-end (point))
+      (setq response-strings
+           (cons (buffer-substring smtp-read-point (- match-end 2))
+                 response-strings))
+       
+      (goto-char smtp-read-point)
+      (if (looking-at "[0-9]+ ")
+         (let ((begin (match-beginning 0))
+               (end (match-end 0)))
+           (if smtp-debug-info
+               (message "%s" (car response-strings)))
+
+           (setq smtp-read-point match-end)
+
+           ;; ignore lines that start with "0"
+           (if (looking-at "0[0-9]+ ")
+               nil
+             (setq response-continue nil)
+             (setq return-value
+                   (cons (string-to-int 
+                          (buffer-substring begin end)) 
+                         (nreverse response-strings)))))
+       
+       (if (looking-at "[0-9]+-")
+           (progn (if smtp-debug-info
+                    (message "%s" (car response-strings)))
+                  (setq smtp-read-point match-end)
+                  (setq response-continue t))
+         (progn
+           (setq smtp-read-point match-end)
+           (setq response-continue nil)
+           (setq return-value 
+                 (cons nil (nreverse response-strings)))
+           )
+         )))
+    (setq smtp-read-point match-end)
+    return-value))
+
+(defun smtp-send-command (process command)
+  (goto-char (point-max))
+  (if (= (aref command 0) ?P)
+      (insert "PASS <omitted>\r\n")
+    (insert command "\r\n"))
+  (setq smtp-read-point (point))
+  (process-send-string process command)
+  (process-send-string process "\r\n"))
+
+(defun smtp-send-data-1 (process data)
+  (goto-char (point-max))
+
+  (if smtp-debug-info
+      (insert data "\r\n"))
+
+  (setq smtp-read-point (point))
+  ;; Escape "." at start of a line
+  (if (eq (string-to-char data) ?.)
+      (process-send-string process "."))
+  (process-send-string process data)
+  (process-send-string process "\r\n")
+  )
+
+(defun smtp-send-data (process buffer)
+  (let
+      ((data-continue t)
+       (sending-data nil)
+       this-line
+       this-line-end)
+
+    (save-excursion
+      (set-buffer buffer)
+      (goto-char (point-min)))
+
+    (while data-continue
+      (save-excursion
+       (set-buffer buffer)
+       (beginning-of-line)
+       (setq this-line (point))
+       (end-of-line)
+       (setq this-line-end (point))
+       (setq sending-data nil)
+       (setq sending-data (buffer-substring this-line this-line-end))
+       (if (/= (forward-line 1) 0)
+           (setq data-continue nil)))
+
+      (smtp-send-data-1 process sending-data)
+      )
+    )
+  )
+
+(defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
+  "Get address list suitable for smtp RCPT TO: <address>."
+  (require 'mail-utils)  ;; pick up mail-strip-quoted-names
+  (let ((case-fold-search t)
+       (simple-address-list "")
+       this-line
+       this-line-end
+       addr-regexp
+       (smtp-address-buffer (generate-new-buffer " *smtp-mail*")))
+    (unwind-protect
+       (save-excursion
+         ;;
+         (set-buffer smtp-address-buffer)
+         (erase-buffer)
+         (insert-buffer-substring smtp-text-buffer
+                                  header-start header-end)
+         (goto-char (point-min))
+         ;; RESENT-* fields should stop processing of regular fields.
+         (save-excursion
+           (if (re-search-forward "^RESENT-TO:" header-end t)
+               (setq addr-regexp
+                     "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
+             (setq addr-regexp  "^\\(TO:\\|CC:\\|BCC:\\)")))
+
+         (while (re-search-forward addr-regexp header-end t)
+           (replace-match "")
+           (setq this-line (match-beginning 0))
+           (forward-line 1)
+           ;; get any continuation lines
+           (while (and (looking-at "^[ \t]+") (< (point) header-end))
+             (forward-line 1))
+           (setq this-line-end (point-marker))
+           (setq simple-address-list
+                 (concat simple-address-list " "
+                         (mail-strip-quoted-names
+                          (buffer-substring this-line this-line-end))))
+           )
+         (erase-buffer)
+         (insert-string " ")
+         (insert-string simple-address-list)
+         (insert-string "\n")
+         ;; newline --> blank
+         (subst-char-in-region (point-min) (point-max) 10 ?  t)
+         ;; comma   --> blank
+         (subst-char-in-region (point-min) (point-max) ?, ?  t)
+         ;; tab     --> blank
+         (subst-char-in-region (point-min) (point-max)  9 ?  t)
+
+         (goto-char (point-min))
+         ;; tidyness in case hook is not robust when it looks at this
+         (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
+
+         (goto-char (point-min))
+         (let (recipient-address-list)
+           (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
+             (backward-char 1)
+             (setq recipient-address-list
+                   (cons (buffer-substring (match-beginning 1) (match-end 1))
+                         recipient-address-list))
+             )
+           recipient-address-list)
+         )
+      (kill-buffer smtp-address-buffer))
+    ))
+
+(defun smtp-do-bcc (header-end)
+  "Delete BCC: and their continuation lines from the header area.
+There may be multiple BCC: lines, and each may have arbitrarily
+many continuation lines."
+  (let ((case-fold-search t))
+    (save-excursion
+      (goto-char (point-min))
+      ;; iterate over all BCC: lines
+      (while (re-search-forward "^BCC:" header-end t)
+       (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
+       ;; get rid of any continuation lines
+       (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
+         (replace-match ""))
+       )
+      ) ;; save-excursion
+    ) ;; let
+  )
+
+(provide 'smtp)
+
+;;; smtp.el ends here
diff --git a/lisp/smtpmail.el b/lisp/smtpmail.el
new file mode 100644 (file)
index 0000000..77a5947
--- /dev/null
@@ -0,0 +1,285 @@
+;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
+
+;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+
+;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
+;; ESMTP support: Simon Leinen <simon@switch.ch>
+;; Keywords: mail
+
+;; 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:
+
+;; Send Mail to smtp host from smtpmail temp buffer.
+
+;; Please add these lines in your .emacs(_emacs).
+;;
+;;(setq send-mail-function 'smtpmail-send-it)
+;;(setq smtp-default-server "YOUR SMTP HOST")
+;;(setq smtp-service "smtp")
+;;(setq smtp-local-domain "YOUR DOMAIN NAME")
+;;(setq smtp-debug-info t)
+;;(autoload 'smtpmail-send-it "smtpmail")
+;;(setq user-full-name "YOUR NAME HERE")
+
+;; To queue mail, set smtpmail-queue-mail to t and use 
+;; smtpmail-send-queued-mail to send.
+
+
+;;; Code:
+
+(require 'smtp)
+(require 'sendmail)
+(require 'time-stamp)
+
+;;;
+
+(defcustom smtpmail-queue-mail nil 
+  "*Specify if mail is queued (if t) or sent immediately (if nil).
+If queued, it is stored in the directory `smtpmail-queue-dir'
+and sent with `smtpmail-send-queued-mail'."
+  :type 'boolean
+  :group 'smtp)
+
+(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
+  "*Directory where `smtpmail.el' stores queued mail."
+  :type 'directory
+  :group 'smtp)
+
+(defvar smtpmail-queue-index-file "index"
+  "File name of queued mail index,
+This is relative to `smtpmail-queue-dir'.")
+
+(defvar smtpmail-queue-index (concat smtpmail-queue-dir
+                                    smtpmail-queue-index-file))
+
+(defvar smtpmail-recipient-address-list nil)
+
+
+;;;
+;;;
+;;;
+
+(defun smtpmail-send-it ()
+  (require 'mail-utils)
+  (let ((errbuf (if mail-interactive
+                   (generate-new-buffer " smtpmail errors")
+                 0))
+       (tembuf (generate-new-buffer " smtpmail temp"))
+       (case-fold-search nil)
+       resend-to-addresses
+       delimline
+       (mailbuf (current-buffer)))
+    (unwind-protect
+       (save-excursion
+         (set-buffer tembuf)
+         (erase-buffer)
+         (insert-buffer-substring mailbuf)
+         (goto-char (point-max))
+         ;; require one newline at the end.
+         (or (= (preceding-char) ?\n)
+             (insert ?\n))
+         ;; Change header-delimiter to be what sendmail expects.
+         (goto-char (point-min))
+         (re-search-forward
+           (concat "^" (regexp-quote mail-header-separator) "\n"))
+         (replace-match "\n")
+         (backward-char 1)
+         (setq delimline (point-marker))
+;;       (sendmail-synch-aliases)
+         (if mail-aliases
+             (expand-mail-aliases (point-min) delimline))
+         (goto-char (point-min))
+         ;; ignore any blank lines in the header
+         (while (and (re-search-forward "\n\n\n*" delimline t)
+                     (< (point) delimline))
+           (replace-match "\n"))
+         (let ((case-fold-search t))
+           (goto-char (point-min))
+           (goto-char (point-min))
+           (while (re-search-forward "^Resent-to:" delimline t)
+             (setq resend-to-addresses
+                   (save-restriction
+                     (narrow-to-region (point)
+                                       (save-excursion
+                                         (end-of-line)
+                                         (point)))
+                     (append (mail-parse-comma-list)
+                             resend-to-addresses))))
+;;; Apparently this causes a duplicate Sender.
+;;;        ;; If the From is different than current user, insert Sender.
+;;;        (goto-char (point-min))
+;;;        (and (re-search-forward "^From:"  delimline t)
+;;;             (progn
+;;;               (require 'mail-utils)
+;;;               (not (string-equal
+;;;                     (mail-strip-quoted-names
+;;;                      (save-restriction
+;;;                        (narrow-to-region (point-min) delimline)
+;;;                        (mail-fetch-field "From")))
+;;;                     (user-login-name))))
+;;;             (progn
+;;;               (forward-line 1)
+;;;               (insert "Sender: " (user-login-name) "\n")))
+           ;; Don't send out a blank subject line
+           (goto-char (point-min))
+           (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
+               (replace-match ""))
+           ;; Put the "From:" field in unless for some odd reason
+           ;; they put one in themselves.
+           (goto-char (point-min))
+           (if (not (re-search-forward "^From:" delimline t))
+               (let* ((login user-mail-address)
+                      (fullname (user-full-name)))
+                 (cond ((eq mail-from-style 'angles)
+                        (insert "From: " fullname)
+                        (let ((fullname-start (+ (point-min) 6))
+                              (fullname-end (point-marker)))
+                          (goto-char fullname-start)
+                          ;; Look for a character that cannot appear unquoted
+                          ;; according to RFC 822.
+                          (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
+                                                 fullname-end 1)
+                              (progn
+                                ;; Quote fullname, escaping specials.
+                                (goto-char fullname-start)
+                                (insert "\"")
+                                (while (re-search-forward "[\"\\]"
+                                                          fullname-end 1)
+                                  (replace-match "\\\\\\&" t))
+                                (insert "\""))))
+                        (insert " <" login ">\n"))
+                       ((eq mail-from-style 'parens)
+                        (insert "From: " login " (")
+                        (let ((fullname-start (point)))
+                          (insert fullname)
+                          (let ((fullname-end (point-marker)))
+                            (goto-char fullname-start)
+                            ;; RFC 822 says \ and nonmatching parentheses
+                            ;; must be escaped in comments.
+                            ;; Escape every instance of ()\ ...
+                            (while (re-search-forward "[()\\]" fullname-end 1)
+                              (replace-match "\\\\\\&" t))
+                            ;; ... then undo escaping of matching parentheses,
+                            ;; including matching nested parentheses.
+                            (goto-char fullname-start)
+                            (while (re-search-forward 
+                                    "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+                                    fullname-end 1)
+                              (replace-match "\\1(\\3)" t)
+                              (goto-char fullname-start))))
+                        (insert ")\n"))
+                       ((null mail-from-style)
+                        (insert "From: " login "\n")))))
+           ;; Insert an extra newline if we need it to work around
+           ;; Sun's bug that swallows newlines.
+           (goto-char (1+ delimline))
+           (if (eval mail-mailer-swallows-blank-line)
+               (newline))
+           ;; Find and handle any FCC fields.
+           (goto-char (point-min))
+           (if (re-search-forward "^FCC:" delimline t)
+               (mail-do-fcc delimline))
+           (if mail-interactive
+               (save-excursion
+                 (set-buffer errbuf)
+                 (erase-buffer))))
+         ;;
+         ;;
+         ;;
+         (setq smtpmail-recipient-address-list
+               (or resend-to-addresses
+                   (smtp-deduce-address-list tembuf (point-min) delimline)))
+
+         (smtp-do-bcc delimline)
+         ; Send or queue
+         (if (not smtpmail-queue-mail)
+             (if smtpmail-recipient-address-list
+                 (if (not (smtp-via-smtp
+                           smtpmail-recipient-address-list tembuf))
+                     (error "Sending failed; SMTP protocol error"))
+               (error "Sending failed; no recipients"))
+           (let* ((file-data (concat 
+                              smtpmail-queue-dir
+                              (time-stamp-strftime 
+                               "%02y%02m%02d-%02H%02M%02S")))
+                  (file-elisp (concat file-data ".el"))
+                  (buffer-data (create-file-buffer file-data))
+                  (buffer-elisp (create-file-buffer file-elisp))
+                  (buffer-scratch "*queue-mail*"))
+             (save-excursion
+               (set-buffer buffer-data)
+               (erase-buffer)
+               (insert-buffer tembuf)
+               (write-file file-data)
+               (set-buffer buffer-elisp)
+               (erase-buffer)
+               (insert (concat
+                        "(setq smtpmail-recipient-address-list '"
+                        (prin1-to-string smtpmail-recipient-address-list)
+                        ")\n"))                    
+               (write-file file-elisp)
+               (set-buffer (generate-new-buffer buffer-scratch))
+               (insert (concat file-data "\n"))
+               (append-to-file (point-min) 
+                               (point-max) 
+                               smtpmail-queue-index)
+               )
+             (kill-buffer buffer-scratch)
+             (kill-buffer buffer-data)
+             (kill-buffer buffer-elisp))))
+      (kill-buffer tembuf)
+      (if (bufferp errbuf)
+         (kill-buffer errbuf)))))
+
+(defun smtpmail-send-queued-mail ()
+  "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
+  (interactive)
+  ;;; Get index, get first mail, send it, get second mail, etc...
+  (let ((buffer-index (find-file-noselect smtpmail-queue-index))
+       (file-msg "")
+       (tembuf nil))
+    (save-excursion
+      (set-buffer buffer-index)
+      (beginning-of-buffer)
+      (while (not (eobp))
+       (setq file-msg (buffer-substring (point) (save-excursion
+                                                  (end-of-line)
+                                                  (point))))
+       (load file-msg)
+       (setq tembuf (find-file-noselect file-msg))
+       (if smtpmail-recipient-address-list
+           (if (not (smtp-via-smtp smtpmail-recipient-address-list tembuf))
+               (error "Sending failed; SMTP protocol error"))
+         (error "Sending failed; no recipients"))  
+       (delete-file file-msg)
+       (delete-file (concat file-msg ".el"))
+       (kill-buffer tembuf)
+       (kill-line 1))      
+      (set-buffer buffer-index)
+      (save-buffer smtpmail-queue-index)
+      (kill-buffer buffer-index)
+      )))
+
+
+;;;
+
+(provide 'smtpmail)
+
+;;; smtpmail.el ends here
diff --git a/texi/Makefile b/texi/Makefile
deleted file mode 100644 (file)
index ea5ef8f..0000000
+++ /dev/null
@@ -1,161 +0,0 @@
-TEXI2DVI=texi2dvi
-EMACS=emacs
-MAKEINFO=$(EMACS) -batch -q -no-site-file
-INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer
-XINFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer
-LATEX=latex
-DVIPS=dvips
-PERL=perl
-INFODIR=/usr/local/info
-
-all: gnus message
-
-most: texi2latex.elc latex latexps
-
-.SUFFIXES: .texi .dvi .ps
-
-.texi:
-       $(MAKEINFO) -eval '(find-file "$<")' $(XINFOSWI)
-
-dvi: gnus.dvi message.dvi
-
-.texi.dvi :
-       $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi
-       $(TEXI2DVI) gnustmp.texi
-       cp gnustmp.dvi $*.dvi
-       rm gnustmp.*
-
-refcard.dvi: refcard.tex gnuslogo.refcard gnusref.tex
-       $(LATEX) refcard.tex
-
-clean:
-       rm -f gnus.*.bak *.ky *.cp *.fn *.cps *.kys *.log *.aux *.dvi *.vr \
-       *.tp *.toc *.pg gnus.latexi *.aux *.[cgk]idx \
-       gnus.ilg gnus.ind gnus.[cgk]ind gnus.idx \
-       gnus.tmptexi *.tmplatexi gnus.tmplatexi1 texput.log *.orig *.rej \
-       gnus.latexi*~* tmp/*.ps xface.tex picons.tex smiley.tex *.latexi
-
-makeinfo: 
-       makeinfo -o gnus gnus.texi      
-       makeinfo -o message message.texi        
-
-texi2latex.elc: texi2latex.el
-       $(EMACS) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")'
-
-latex: gnus.texi texi2latex.elc
-       $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate
-
-latexps: 
-       make texi2latex.elc
-       rm -f gnus.aux
-       egrep -v "label.*Index|chapter.*Index" gnus.latexi > gnus.tmplatexi1
-       $(LATEX) gnus.tmplatexi1
-       ./splitindex
-       makeindex -o gnus.kind gnus.kidx
-       makeindex -o gnus.cind gnus.cidx
-       makeindex -o gnus.gind gnus.gidx
-       sed 's/\\char 5E\\relax {}/\\symbol{"5E}/' < gnus.kind > gnus.tmpkind
-       mv gnus.tmpkind gnus.kind
-       egrep -v "end{document}" gnus.tmplatexi1 > gnus.tmplatexi
-       cat postamble.tex >> gnus.tmplatexi
-       $(LATEX) gnus.tmplatexi 
-       $(LATEX) gnus.tmplatexi 
-       $(DVIPS) -f gnus.dvi > gnus.ps
-
-pss:   
-       make latex
-       make latexps
-
-psout:
-       make latex
-       make latexboth
-       make out
-
-latexboth: 
-       rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz 
-       make latexps
-       mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-a4.ps
-       gzip /local/tmp/larsi/gnus-manual-a4.ps 
-       sed 's/,a4paper//' gnus.latexi > gnus-standard.latexi 
-       mv gnus-standard.latexi gnus.latexi
-       make latexps
-       mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-standard.ps 
-       gzip /local/tmp/larsi/gnus-manual-standard.ps 
-
-out:
-       cp /local/tmp/larsi/gnus-manual-standard.ps.gz \
-       /local/tmp/larsi/gnus-manual-a4.ps.gz \
-       /local/ftp/pub/emacs/gnus/manual
-       mv /local/tmp/larsi/gnus-manual-standard.ps.gz \
-       /local/tmp/larsi/gnus-manual-a4.ps.gz \
-       /hom/larsi/www_docs/www.gnus.org/documents
-
-veryclean:
-       make clean
-       rm -f gnus.dvi gnus.ps
-
-distclean:
-       make clean
-       rm -f *.orig *.rej *.elc *~ gnus gnus-[0-9] gnus-[0-9][0-9]
-       rm -f message message-[0-9]
-
-install:
-       cp gnus gnus-[0-9] gnus-[0-9][0-9] $(INFODIR)
-       cp message $(INFODIR)
-
-
-tmps:
-       if [ ! -e tmp ]; then mkdir tmp; fi
-       make screens
-       make herdss
-       make etcs
-       make piconss
-       make xfaces
-       make smiley
-       make miscs
-
-herdss:
-       cd herds ; for i in new-herd-[0-9]*.gif; do echo $$i; giftopnm $$i | pnmcrop -white | pnmmargin -white 9 | pnmscale 2 | pnmconvol convol5.pnm  | ppmtopgm | pnmdepth 255 | pnmtops -width 100 -height 100 -noturn > ../tmp/`basename $$i .gif`.ps; done
-       cd herds ; giftopnm new-herd-section.gif | pnmscale 4 | pnmconvol convol11.pnm | ppmtopgm | pnmdepth 255 | pnmtops -noturn -width 100 -height 100 > ../tmp/new-herd-section.ps
-
-
-screens:
-       cd screen ; for i in *.gif; do echo $$i; giftopnm $$i | pnmmargin -black 1 | ppmtopgm | pnmtops -width 100 -height 100 -noturn > ../tmp/`basename $$i .gif`.ps; done    
-
-miscs:
-       giftopnm misc/larsi.gif | ppmtopgm | pnmtops -noturn > tmp/larsi.ps
-       tifftopnm misc/eseptember.tif | pnmscale 4 | ppmtopgm | pnmtops -noturn  -width 100 -height 100 > tmp/september.ps
-       tifftopnm misc/fseptember.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn  -width 100 -height 100 > tmp/fseptember.ps
-       tifftopnm misc/fred.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn  -width 100 -height 100 > tmp/fred.ps
-       tifftopnm misc/ered.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn  -width 100 -height 100 > tmp/red.ps
-
-etcs:
-       cd etc; for i in gnus-*.xpm; do echo $$i; xpmtoppm $$i | ppmtopgm | pnmdepth 255 | pnmtops -noturn > ../tmp/`basename $$i .xpm`.ps; done
-
-piconss:
-       cd picons; for i in *.xbm; do echo $$i; xbmtopbm $$i | pnmtops -noturn > ../tmp/picons-`basename $$i .xbm`.ps; done
-       cd picons; for i in *.gif; do echo $$i; giftopnm $$i | ppmtopgm | pnmtops -noturn > ../tmp/picons-`basename $$i .gif`.ps; done
-       for i in tmp/picons-*.ps; do echo "\\gnuspicon{$$i}"; done > picons.tex
-
-xfaces:
-       cd xface; for i in *.gif; do echo $$i; giftopnm $$i | ppmtopgm | pnmtops -noturn > ../tmp/xface-`basename $$i .gif`.ps; done
-       for i in tmp/xface-*.ps; do \
-               if [ -n "$$a" ]; then a=""; echo "{$$i}"; else \
-               a="h"; echo -n "\\gnusxface{$$i}"; fi done > xface.tex; \
-               if [ -n "$$a" ]; then echo "{$$i}" >> xface.tex; fi
-
-smiley:
-       cd smilies; tifftopnm BigFace.tif | ppmtopgm | pnmtops > ../tmp/BigFace.ps
-       cd smilies; for i in *.xpm; do echo $$i; sed "s/none/#FFFFFF/" $$i | xpmtoppm | ppmtopgm | pnmdepth 255 | pnmtops > ../tmp/smiley-`basename $$i .xpm`.ps; done
-       for i in tmp/smiley-*.ps; do \
-               if [ -n "$$a" ]; then a=""; echo "{$$i}"; else \
-               a="h"; echo -n "\\gnussmiley{$$i}"; fi done > smiley.tex; \
-               if [ -n "$$a" ]; then echo "{$$i}" >> smiley.tex; fi
-
-pspackage:
-       tar czvf pspackage.tar.gz gnus-faq.texi gnus.texi herds misc pagestyle.sty picons pixidx.sty postamble.tex ps screen smilies splitindex texi2latex.el xface Makefile README etc
-
-complete:
-       make texi2latex.elc
-       make tmps
-       make pss