included commits to RCS files with non-trunk default branches.
--- /dev/null
+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 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
+
+
+How to join development
+=======================
+
+ If you write bug-reports and/or suggestions for improvement, please
+send them to the tm Mailing List:
+
+ bug-tm-en@chamonix.jaist.ac.jp (English)
+ bug-tm-ja@chamonix.jaist.ac.jp (Japanese)
+
+ Via the tm ML, you can report SEMI related bugs, obtain the latest
+release of SEMI, and discuss future enhancements to SEMI. To join the
+tm ML, send e-mail to
+
+ tm-ja-admin@chamonix.jaist.ac.jp (Japanese)
+ tm-en-admin@chamonix.jaist.ac.jp (English)
+
+ Since the user registration is done manually, please write the mail
+body in human-recognizable language (^_^).
+
+ In addition, we need developers. If you would like to develop it,
+please send mail to cvs@chamonix.jaist.ac.jp.
-Sun Jan 4 14:38:36 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+1997-12-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * gnus.el: Quassia Gnus v0.21 is released.
+ * gnus.el (gnus-version-number): Update to version 6.0.1.
-Sun Jan 4 14:28:35 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+1997-12-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * gnus.el: Quassia Gnus v0.20 is released.
+ * message.el (message-resend): Enclose `message-setup' with `(let
+ (message-setup-hook) ...)' to avoid to `turn-on-mime-edit'; must
+ setup `message-encoding-buffer' and `message-edit-buffer' for
+ `message-send-mail'.
-1997-12-10 Per Abrahamsen <abraham@dina.kvl.dk>
+1997-12-08 Shuhei Kobayashi <shuhei-k@jaist.ac.jp>
- * gnus/gnus-msg.el (gnus-inews-insert-mime-headers): Added
- documentation.
- (gnus-inews-insert-mime-headers): Made it work with Emacs MULE.
- (gnus-inews-insert-mime-headers): Added as option to
- `message-header-hook'.
+ * pop3.el, message.el, gnus.el, gnus-sum.el, gnus-art.el,
+ ChangeLog: Synch'ed up to qgnus-0.18.
-1997-12-22 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus/gnus-art.el (gnus-button-alist): Assume msg-id after "in
- message".
-
-1997-12-22 Simon Josefsson <jas@faun.nada.kth.se>
-
- * nnmail.el (nnmail-get-new-mail): Make nnmail-tmp-directory
-
-1997-12-28 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus/gnus-group.el (gnus-group-fetch-faq): Convert `.' in group
- name to `/'.
-
-Sun Jan 4 13:35:14 1998 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * nndraft.el (nndraft-request-associate-buffer): Open the damn
- server first. Sheesh.
-
- * gnus-draft.el (gnus-draft-send): Bind message-send-hook to nil.
-
- * gnus-sum.el (gnus-summary-catchup): Don't nix out downloadable.
- (gnus-summary-highlight): Highlight down/un as unread.
-
-Sun Jan 4 13:27:31 1998 Kim-Minh Kaplan <KimMinh.Kaplan@utopia.eunet.fr>
-
- * gnus-start.el (gnus-strip-killed-list): Fix syntax.
-
-Sun Jan 4 13:18:04 1998 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * nnsoup.el (nnsoup-store-reply): Bind mail-header-separator to
- "".
-
- * gnus-xmas.el (gnus-xmas-agent-server-menu-add): New.
-
- * nnoo.el (nnoo-change-server): Get the right values.
-
-1998-01-04 Aki Vehtari <Aki.Vehtari@hut.fi>
-
- * gnus-art.el (gnus-signature-limit): Add default values for
- choices suggested by Per Abrahamsen <abraham@dina.kvl.dk>.
- (gnus-prompt-before-saving): Add :value t for sexp tag.
- (gnus-split-methods): Add default values for choices.
-
- * gnus-score.el (gnus-home-score-file): Add non-nil default for
- function.
- (gnus-home-adapt-file): Ditto.
-
- * gnus-sum.el (gnus-move-split-methods): Add default values for
- choices.
-
- * nnmail.el (nnmail-list-identifiers): Add default values for
- choices suggested by Per Abrahamsen <abraham@dina.kvl.dk>.
-
-Sun Jan 4 11:31:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Quassia Gnus v0.19 is released.
-
-Sun Jan 4 10:42:53 1998 Felix Lee <flee@teleport.com>
-
- * nntp.el (nntp-open-rlogin): Use a list of parameters.
-
-Sun Jan 4 10:25:05 1998 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus-agent.el (gnus-agent-fetch-groups): New command.
-
- * gnus-sum.el (gnus-summary-print-article): Changed order of
- parameters.
-
-Sun Jan 4 10:24:07 1998 Michael R. Cook <mcook@cognex.com>
-
- * gnus-sum.el (gnus-summary-print-article): Use process/prefix.
-
-Sun Jan 4 05:29:38 1998 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus-uu.el: Changed spurious defconsts to defvars.
-
- * nnmail.el (nnmail-get-spool-files): Quote group name.
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Fetch ticked articles.
- (gnus-agent-fetch-group-1): Never mind.
-
-Sat Dec 20 22:33:17 1997 Pete Ware <ware@cis.ohio-state.edu>
-
- * message.el (message-rename-buffer): Check for nil dirs.
-
-Fri Dec 19 21:45:59 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * nnml.el (nnml-request-create-group): Check for files.
-
-Fri Dec 19 21:39:43 1997 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-mode): Fixed font-lock.
-
-Fri Dec 19 21:26:08 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus-cache.el (gnus-cache-read-active): Check for empty files.
-
-Sun Dec 14 11:46:50 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus-uu.el (gnus-uu-save-article): Quote all lines beginning
- with a dash.
-
-1997-12-10 SL Baur <steve@altair.xemacs.org>
-
- * gnus-start.el (gnus-read-descriptions-file): Really bind and gag
- Mule.
-
-Fri Dec 5 15:15:05 1997 Danny Siu <dsiu@adobe.com>
-
- * nndoc.el (nndoc-babyl-body-begin): quote the regexp for the
- string "*** EOOH ***" properly.
- (nndoc-babyl-head-begin): Same as above.
-
-Sun Dec 14 11:11:22 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus-uu.el (gnus-uu-pre-uudecode-hook): New hook.
-
- * gnus-sum.el (gnus-summary-read-group-1): Set mode line after
- configuring.
-
-Sun Dec 14 11:03:26 1997 Wes Hardaker <wjhardaker@ucdavis.edu>
-
- * gnus-score.el (gnus-adaptive-word-minimum): New variable.
- (gnus-score-adaptive): Use it.
-
-Sun Dec 14 09:19:18 1997 Roland B. Roberts <roberts@panix.com>
-
- * gnus-group.el: Fixed hardcoded levels.
+ * smiley.el, pop3.el, nnweb.el, nntp.el, nnml.el, nnmail.el,
+ nnheader.el, nndraft.el, message.el, lpath.el, gnus.el,
+ gnus-util.el, gnus-sum.el, gnus-start.el, gnus-picon.el,
+ gnus-nocem.el, gnus-mh.el, gnus-group.el, gnus-ems.el,
+ gnus-cite.el, gnus-art.el, gnus-agent.el, dgnushack.el, ChangeLog:
+ Importing qgnus-0.18
Sat Dec 6 17:40:33 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus-art.el (article-make-date-line): Don't add extra newlines.
+1997-11-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * gnus.el (gnus-version): Rename to "Semi-gnus".
+
+1997-11-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * gnus-draft.el (gnus-draft-decoding-function): New variable.
+ (gnus-draft-setup): Use `gnus-draft-decoding-function'.
+
1997-11-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* nnmail.el (nnmail-file-coding-system): Use `raw-text' in
* gnus-move.el (gnus-move-group-to-server): Protect agains
nil-ness.
+1997-11-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * gnus-i18n.el: New file.
+
+ * nnmail.el (nnmail-file-coding-system): Use `raw-text' in
+ default.
+
+ * nnheader.el (nnheader-file-coding-system): Use `raw-text' in
+ default.
+
+ * message.el (message-encode-function): New variable.
+ (message-forward-start-separator): Modify for mime-edit.
+ (message-forward-end-separator): Modify for mime-edit.
+ (message-setup-hook): Use `(message-maybe-setup-default-charset
+ turn-on-mime-edit)' in default.
+ (message-header-hook): Use `(eword-encode-header)' in default.
+
+ (message-send): Use local variable `message-encoding-buffer',
+ `message-edit-buffer' and `message-mime-mode' as public variables;
+ use `message-encode-function'.
+ (message-send-mail): Use `message-encoding-buffer' to get contents
+ of body; abolish `message-encode-mail-hook'; use
+ `mime-edit-maybe-split-and-send'; use `message-edit-buffer' to
+ refer original editing buffer.
+ (message-send-news): Use `message-encoding-buffer' to get contents
+ of body; abolish `message-encode-news-hook'; use
+ `mime-edit-maybe-split-and-send'; use `message-edit-buffer' to
+ refer original editing buffer.
+ (message-check-news-syntax): Call `message-check-news-body-syntax'
+ in `mime-edit-buffer'.
+ (message-do-fcc): Use `message-encoding-buffer' to get contents;
+ run `message-header-hook'.
+ (message-cancel-news): Use `std11-extract-address-components'
+ instead of `mail-extract-address-components'; bind
+ `message-encoding-buffer' and `message-edit-buffer'.
+
+ (message-maybe-setup-default-charset): New function.
+ (message-maybe-encode): New function.
+ (message-mime-insert-article): New function.
+ Add setting for mime-view.
+
+ * gnus-sum.el: Autoload gnus-i18n.
+
+ (gnus-show-mime): `t' in default.
+ (gnus-structured-field-decoder): Use
+ `eword-decode-structured-field-body' in default.
+ (gnus-unstructured-field-decoder): Use
+ `eword-decode-unstructured-field-body' in default.
+
+ (gnus-parse-headers-hook): Use
+ `(gnus-set-summary-default-charset)' in default.
+
+ (gnus-summary-mode-map): Add binding for
+ `gnus-summary-scroll-down' and
+ `gnus-summary-preview-mime-message'.
+
+ (gnus-summary-preview-mime-message): New function.
+ (gnus-mime-partial-preview-function): New function.
+ Add setting for mime-view.
+
+ * gnus-msg.el (gnus-summary-cancel-article): Display
+ `gnus-article-buffer' instead ofb `gnus-original-article-buffer'.
+ (gnus-extended-version): Don't return version of emacsen.
+ (gnus-inews-do-gcc): Refer `message-encoding-buffer'.
+
+ * gnus-art.el (gnus-show-mime-method): Use
+ `gnus-article-preview-mime-message' instead of `metamail-buffer'
+ in default.
+ (gnus-decode-encoded-word-method): Use
+ `gnus-article-decode-encoded-word' instead of
+ `gnus-article-de-quoted-unreadable' in default.
+
+ Abolish `gnus-hack-decode-rfc1522', `gnus-decode-rfc1522',
+ `article-decode-rfc1522', `article-de-quoted-unreadable',
+ `article-mime-decode-quoted-printable-buffer' and
+ `article-mime-decode-quoted-printable'.
+ (gnus-article-decode-rfc1522): New implementation (use
+ `eword-decode-header').
+
+ (gnus-article-preview-mime-message): New function.
+ (gnus-article-decode-encoded-word): New function.
+ (gnus-content-header-filter): New function.
+ (mime-view-quitting-method-for-gnus): New function.
+ Add setting for mime-view.
+
Tue Nov 25 19:03:38 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Quassia Gnus v0.16 is released.
* message.el (message-ignored-supersedes-headers): Typo.
+1997-11-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * message.el: Abolish `message-max-size' because it is not used.
+
+1997-11-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * nnmh.el (nnmh-request-list-1): fix maybe.
+
+ * message.el (message-do-fcc): Guard `coding-system-for-write' by
+ `raw-text'; run `message-before-do-fcc-hook'.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Guard `coding-system-for-write'
+ by `raw-text'; run `gnus-before-do-gcc-hook'.
+
Mon Nov 24 18:46:37 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Quassia Gnus v0.15 is released.
* gnus-sum.el (gnus-nov-read-integer): Really skip to next field.
+1997-09-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * message.el (message-send-news-function): Use
+ `message-send-news-with-gnus' in default.
+ (message-send-via-news): Use `message-send-news' instead of
+ `message-send-news-function'.
+ (message-send-mail): Don't avoid text properties; run
+ `message-encode-mail-hook'.
+ (message-send-news): Don't avoid text properties; run
+ `message-encode-news-hook'; use `message-send-news-function'.
+ (message-send-news-with-gnus): New function.
+ (message-cancel-news): Use `message-send-news' instead of
+ `message-send-news-function'.
+
Sat Sep 27 04:32:45 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Quassia Gnus v0.11 is released.
-;;; gnus-art.el --- article mode commands for Gnus
+;;; gnus-art.el --- article mode commands for Open gnus
;; Copyright (C) 1996,97 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-spec)
(require 'gnus-int)
(require 'browse-url)
+(require 'alist)
+(require 'mime-view)
(defgroup gnus-article nil
"Article display."
will be called without any parameters, and if it returns nil, there is
no signature in the buffer. If it is a string, it will be used as a
regexp. If it matches, the text in question is not a signature."
- :type '(choice (integer :value 200)
- (number :value 4.0)
- (function :value fun)
- (regexp :value ".*"))
+ :type '(choice integer number function regexp)
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties '(invisible t intangible t)
:group 'gnus-article-saving
:type '(choice (item always)
(item :tag "never" nil)
- (sexp :tag "once" :format "%t\n" :value t)))
+ (sexp :tag "once" :format "%t")))
(defcustom gnus-saved-headers gnus-visible-headers
"Headers to keep if `gnus-save-all-headers' is nil.
a possible file name; and if it returns a non-nil list, that list will
be used as possible file names."
:group 'gnus-article-saving
- :type '(repeat (choice (list :value (fun) function)
- (cons :value ("" "") regexp (repeat string))
- (sexp :value nil))))
+ :type '(repeat (choice (list function)
+ (cons regexp (repeat string))
+ sexp)))
(defcustom gnus-strict-mime t
"*If nil, MIME-decode even if there is no Mime-Version header."
: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
(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-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 gnus-article-decode-rfc1522 ()
+ "Decode MIME encoded-words in header fields."
+ (let (buffer-read-only)
+ (eword-decode-header)
+ ))
+
+;; (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 article-hide-pgp (&optional arg)
"Toggle hiding of any PGP headers and signatures in the current article.
(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'."
+ (goto-char (point-min))
+ (let ((charset (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset)))
+ (save-restriction
+ (std11-narrow-to-header)
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t:]+:" nil t)
+ (let ((start (match-beginning 0))
+ (end (std11-field-end))
+ )
+ (save-restriction
+ (narrow-to-region start end)
+ (decode-mime-charset-region start end charset)
+ (goto-char (point-max))
+ )))
+ (eword-decode-header)
+ )
+ (decode-mime-charset-region (point) (point-max) charset)
+ (mime-maybe-hide-echo-buffer)
+ )
+ (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.
("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
- ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
(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'."
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t:]+:" nil t)
+ (let ((start (match-beginning 0))
+ (end (std11-field-end))
+ )
+ (save-restriction
+ (narrow-to-region start end)
+ (decode-mime-charset-region start end default-mime-charset)
+ (goto-char (point-max))
+ )))
+ (eword-decode-header)
+ )
+
+(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)
;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME, offline
;; This file is part of GNU Emacs.
(defun gnus-draft-send (article &optional group)
"Send message ARTICLE."
(gnus-draft-setup article (or group "nndraft:queue"))
- (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)
- message-send-hook)
+ (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
(message-send-and-exit)))
(defun gnus-draft-send-all-messages ()
;;; 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)
--- /dev/null
+;;; 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
-;;; gnus-msg.el --- mail and post interface for Gnus
+;;; gnus-msg.el --- mail and post interface for Open gnus
;; Copyright (C) 1995,96,97 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.
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))
;;; 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))))
+ gnus-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
(cond ((save-restriction
(widen)
(goto-char (point-min))
- (re-search-forward "[^\000-\177]" nil t))
+ (re-search-forward "[\200-\377]" nil t))
(or (mail-position-on-field "Content-Type")
(insert "text/plain; charset=ISO-8859-1"))
(or (mail-position-on-field "Content-Transfer-Encoding")
(or (mail-position-on-field "Content-Transfer-Encoding")
(insert "7bit")))))))
-(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers)
-
\f
;;;
;;; Gnus Mail Functions
(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")
(gnus-request-create-group group method))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
+ (insert-buffer-substring message-encoding-buffer)
+ (run-hooks 'gnus-before-do-gcc-hook)
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
-;;; gnus-sum.el --- summary mode commands for Gnus
+;;; gnus-sum.el --- summary mode commands for Open gnus
;; Copyright (C) 1996,97 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)
(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.
: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'."
"*Variable used to suggest where articles are to be moved to.
It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-mail
- :type '(repeat (choice (list :value (fun) function)
- (cons :value ("" "") regexp (repeat string))
- (sexp :value nil))))
+ :type '(repeat (choice (list function)
+ (cons regexp (repeat string))
+ sexp)))
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
:type 'hook)
;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-(defcustom gnus-structured-field-decoder 'identity
+(defcustom gnus-structured-field-decoder
+ (function
+ (lambda (string)
+ (eword-decode-structured-field-body
+ (std11-unfold-string string) 'must-unfold)
+ ))
"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)
. gnus-summary-high-unread-face)
((and (< score default) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((memq mark (list gnus-unread-mark gnus-downloadable-mark
- gnus-undownloaded-mark))
+ ((and (= mark gnus-unread-mark))
. gnus-summary-normal-unread-face)
((> score default)
. gnus-summary-high-read-face)
[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
"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
;; article in the group.
(goto-char (point-min))
(gnus-summary-position-point)
- (gnus-configure-windows 'summary 'force)
- (gnus-set-mode-line 'summary))
+ (gnus-set-mode-line 'summary)
+ (gnus-configure-windows 'summary 'force))
(when (get-buffer-window gnus-group-buffer t)
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(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)
(when gnus-page-broken
(gnus-narrow-to-page))))
-(defun gnus-summary-print-article (&optional filename n)
- "Generate and print a PostScript image of the N next (mail) articles.
+(defun gnus-summary-print-article (&optional filename)
+ "Generate and print a PostScript image of the article buffer.
-If N is negative, print the N previous articles. If N is nil and articles
-have been marked with the process mark, print these instead.
-
-If the optional second argument FILENAME is nil, send the image to the
-printer. If FILENAME is a string, save the PostScript image in a file with
-that name. If FILENAME is a number, prompt the user for the name of the file
+If the optional argument FILENAME is nil, send the image to the printer.
+If FILENAME is a string, save the PostScript image in a file with that
+name. If FILENAME is a number, prompt the user for the name of the file
to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)
- current-prefix-arg))
- (dolist (nbr (gnus-summary-work-articles n))
- (gnus-summary-select-article 'all nil 'pseudo nbr)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-article-delete-invisible-text)
- (run-hooks 'gnus-ps-print-hook)
- (ps-print-buffer-with-faces filename))
- (kill-buffer buffer))))))
+ (interactive (list (ps-print-preprint current-prefix-arg)))
+ (gnus-summary-select-article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-article-delete-invisible-text)
+ (run-hooks 'gnus-ps-print-hook)
+ (ps-print-buffer-with-faces filename))
+ (kill-buffer buffer)))))
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
(when all
(setq gnus-newsgroup-marked nil
gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable))
+ (setq gnus-newsgroup-unreads nil))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
(lambda (buf) (switch-to-buffer buf) (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)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.21"
- "Version number for this version of Gnus.")
+(defconst gnus-version-number "6.0.1"
+ "Version number for this version of gnus.")
-(defconst gnus-version (format "Quassia 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.18)" 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.
;; Copyright (C) 1996,97 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.
(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))
(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.
: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)
: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'."
: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
: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)
(0 'message-cited-text-face))))
"Additional expressions to highlight in Message mode.")
-;; XEmacs does it like this. For Emacs, we have to set the
-;; `font-lock-defaults' buffer-local variable.
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
(defvar message-face-alist
(mail-abbrevs-setup)
(funcall (intern "mail-aliases-setup"))))
(message-set-auto-save-file-name)
- (run-hooks 'text-mode-hook 'message-mode-hook)
- (unless (string-match "XEmacs" emacs-version)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))))
+ (run-hooks 'text-mode-hook 'message-mode-hook))
\f
(read-string "New buffer name: " name-default)
name-default))
(default-directory
- (if message-autosave-directory
- (file-name-as-directory message-autosave-directory)
- default-directory)))
+ (file-name-as-directory message-autosave-directory)))
(rename-buffer name t)))))
(defun message-fill-yanked-message (&optional justifyp)
(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)
(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."
(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.
(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)
(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 ()
(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)
(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)
;; 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.
;;;
(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
(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)
+ (run-hooks 'message-before-do-fcc-hook)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
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.
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)))))
(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)
(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)))
(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
This can also be a list of regexps."
:group 'nnmail-prepare
:type '(choice (const :tag "none" nil)
- (regexp :value ".*")
- (repeat :value (".*") regexp)))
+ regexp
+ (repeat regexp)))
(defcustom nnmail-pre-get-new-mail-hook nil
"Hook called just before starting to handle new incoming mail."
nnmail-use-procmail)
(directory-files
nnmail-procmail-directory
- t (concat (if group (concat "^" (regexp-quote group)) "")
+ t (concat (if group (concat "^" group) "")
nnmail-procmail-suffix "$"))))
(p procmails)
(crash (when (and (file-exists-p nnmail-crash-box)
(file-name-nondirectory
(concat (file-name-as-directory temp) "Incoming")))
(concat (file-name-as-directory temp) "Incoming")))))
- (unless (file-exists-p (file-name-directory incoming))
- (make-directory (file-name-directory incoming) t))
(rename-file nnmail-crash-box incoming t)
(push incoming incomings))))
;; If we did indeed read any incoming spools, we save all info.
(string-to-int (file-name-nondirectory file)))))
(deffoo nnmh-request-group (group &optional server dont-check)
- (nnheader-init-server-buffer)
(nnmh-possibly-change-directory group server)
(let ((pathname (nnmail-group-pathname group nnmh-directory))
(pathname-coding-system 'binary)
(deffoo nnmh-request-list (&optional server dir)
(nnheader-insert "")
- (nnmh-possibly-change-directory nil server)
(let ((pathname-coding-system 'binary)
(nnmh-toplev
(file-truename (or dir (file-name-as-directory nnmh-directory)))))
;; Recurse down all directories.
(let ((dirs (and (file-readable-p dir)
(> (nth 1 (file-attributes (file-chase-links dir))) 2)
- (nnheader-directory-files dir t nil t)))
+ (directory-files dir t nil t)))
rdir)
;; Recurse down directories.
(while (setq rdir (pop dirs))
- (when (and (file-directory-p rdir)
+ (when (and (not (member (file-name-nondirectory rdir) '("." "..")))
+ (file-directory-p rdir)
(file-readable-p rdir)
- (not (equal (file-truename rdir)
- (file-truename dir))))
+ (not (string= (file-truename rdir)
+ (file-truename dir))))
(nnmh-request-list-1 rdir))))
;; For each directory, generate an active file line.
(unless (string= (expand-file-name nnmh-toplev) dir)
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3k
+;; Version: 1.3j
;; This file is part of GNU Emacs.
(require 'mail-utils)
(provide 'pop3)
-(defconst pop3-version "1.3k")
+(defconst pop3-version "1.3j")
(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
"Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")
+(defvar pop3-movemail-file-coding-system nil
+ "Crashbox made by pop3-movemail with this coding system.")
+
(defvar pop3-read-point nil)
(defvar pop3-debug nil)
(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))
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
(accept-process-output process 3)
- ;; bill@att.com ... to save wear and tear on the heap
- ;; uncommented because the condensed version below is a problem for
- ;; some.
- (if (> (buffer-size) 20000) (sleep-for 1))
- (if (> (buffer-size) 50000) (sleep-for 1))
- (if (> (buffer-size) 100000) (sleep-for 1))
- (if (> (buffer-size) 200000) (sleep-for 1))
- (if (> (buffer-size) 500000) (sleep-for 1))
- ;; bill@att.com
+; ;; bill@att.com ... to save wear and tear on the heap
+; (if (> (buffer-size) 20000) (sleep-for 1))
+; (if (> (buffer-size) 50000) (sleep-for 1))
+; (if (> (buffer-size) 100000) (sleep-for 1))
+; (if (> (buffer-size) 200000) (sleep-for 1))
+; (if (> (buffer-size) 500000) (sleep-for 1))
+; ;; bill@att.com
;; condensed into:
- ;; (sometimes causes problems for really large messages.)
-; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
+ (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
(goto-char start))
(setq pop3-read-point (point-marker))
;; this code does not seem to work for some POP servers...
projects / elisp / gnus.git- / commitdiff