From: tomo Date: Fri, 20 Mar 1998 16:38:03 +0000 (+0000) Subject: This commit was manufactured by cvs2svn to create tag 'for-semi-1_1'. X-Git-Tag: for-semi-1_1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a0184aa5635fa2cf100200c2637c40dabb9c4925;hp=9a7a1b9ad486edec41a3890cd11ab17113ed0041;p=elisp%2Fgnus.git- This commit was manufactured by cvs2svn to create tag 'for-semi-1_1'. --- diff --git a/ChangeLog b/ChangeLog index db57397..25fdc8a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,296 @@ +1998-03-20 Shuhei KOBAYASHI + + * lisp/gnus.el (gnus-version-number): Update to 6.1.1. + (gnus-version): Include corresponding SEMI version. + + * Sync up with Gnus 5.6.3. + +1998-03-15 Shuhei KOBAYASHI + + * lisp/gnus-agent.el (gnus-agent-crosspost): Use + `nnheader-insert-file-contents'. + (gnus-agent-braid-nov): Ditto. + (gnus-agent-expire): Ditto. + + * lisp/gnus-cache.el (gnus-cache-request-article): Ditto. + (gnus-cache-retrieve-headers): Ditto. + (gnus-cache-change-buffer): Ditto. + (gnus-cache-braid-nov): Ditto. + + * lisp/gnus-sum.el (gnus-summary-import-article): Ditto. + + * lisp/nnkiboze.el (nnkiboze-retrieve-headers): Ditto. + + * lisp/message.el (message-generate-headers): Fix regexp. + (cf. [semi-gnus-ja:107]) + +1998-03-14 MORIOKA Tomohiko + + * lisp/gnus-art.el: Add setting for + `mime-raw-buffer-coding-system-alist'. + +1998-03-13 MORIOKA Tomohiko + + * lisp/gnus-art.el: Rename `mime-view-quitting-method-for-gnus' -> + `mime-preview-quitting-method-for-gnus'. + + * lisp/gnus-art.el: Rename `mime-view-quitting-method-alist' -> + `mime-preview-quitting-method-alist'. + + * lisp/gnus-art.el: Rename `mime-view-kill-buffer' -> + `mime-preview-kill-buffer'. + + * lisp/gnus.el (gnus-version-number): Update to 6.0.10. + + * lisp/gnus-sum.el: Add code to check latest SEMI. + (mime-acting-condition): Separate type and subtype; rename + `mime-combine-message/partials-automatically' -> + `mime-method-to-combine-message/partial-pieces'. + +1998-03-08 Shuhei KOBAYASHI + + * lisp/gnus.el (gnus-version-number): Update to 6.0.9. + + * README.semi (How to get?): Add description of daily snapshot. + (How to join development): Change mailing list command address. + + * Sync up with Gnus 5.6.2. + +1998-03-01 Tatsuya Ichikawa + + * lisp/gnus-ems.el: Change variable name + gnus-bdf-image-file to gnus-mule-bitmap-image-file. + +1998-02-28 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 + + * lisp/gnus.el, lisp/message.el: Sync up with qgnus-0.32. + +1998-02-23 MORIOKA Tomohiko + + * 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 + + * README.semi (How to get?): The command `update' must come before + `-r semi-gnus'. (cf. [tm-en:1559]) + +1998-02-17 MORIOKA Tomohiko + + * 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 + + * lisp/gnus.el (gnus-version-number): Update to 6.0.5. + +1998-02-17 MORIOKA Tomohiko + + * 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 + + * lisp/gnus-art.el (gnus-article-decode-rfc1522): Decode header by + localized code. + +1998-02-16 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * lisp/lpath.el: Require path-util; add load-path of APEL, MEL and + SEMI. + +1998-01-12 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * lisp/gnus.el (gnus-version-number): Update to version 6.0.3. + +1998-01-11 MORIOKA Tomohiko + + * 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 * lisp/smtpmail.el (smtpmail-via-smtp): Bind diff --git a/Makefile b/Makefile deleted file mode 100644 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 index 0000000..e1c4535 --- /dev/null +++ b/README.semi @@ -0,0 +1,71 @@ +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 \ + checkout -r semi-gnus gnus + +(2) compile + + ;; as same as Gnus + + % cd gnus + + % make EMACS= + +(3) update + + Please do following in your Open gnus directory: + + % cvs update -r semi-gnus + + + (semi-)daily snapshot is also available from + + ftp://ftp.jaist.ac.jp/pub/GNU/elisp/semi-gnus/ + + Note that this snapshot is automatically created from our repository +and will usually not be tested, and may not even work. + + +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 an empty e-mail to + + semi-gnus-en-help@meadow.scphys.kyoto-u.ac.jp (English) + semi-gnus-ja-help@meadow.scphys.kyoto-u.ac.jp (Japanese) + + In addition, we need developers. If you would like to develop it, +please send mail to cvs@chamonix.jaist.ac.jp. diff --git a/lisp/Makefile b/lisp/Makefile deleted file mode 100644 index b949400..0000000 --- a/lisp/Makefile +++ /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 *~ - diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 868ba89..1026465 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -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 @@ -689,7 +689,7 @@ the actual number of articles toggled is returned." (when (= (point-max) (point-min)) (push (cons group (current-buffer)) gnus-agent-buffer-alist) (ignore-errors - (insert-file-contents + (nnheader-insert-file-contents (gnus-agent-article-name ".overview" group)))) (nnheader-find-nov-line (string-to-number (cdar crosses))) (insert (string-to-number (cdar crosses))) @@ -730,6 +730,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 + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (point-at-eol)) + (insert "\t") + (forward-line 1)) + ;; Tatsuya Ichikawa + ;; 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) @@ -758,7 +769,7 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (if (or (= (point-min) (point-max)) (progn @@ -1266,7 +1277,7 @@ The following commands are available: (set-buffer overview) (erase-buffer) (when (file-exists-p nov-file) - (insert-file-contents nov-file)) + (nnheader-insert-file-contents nov-file)) (goto-char (point-min)) (while (setq elem (pop articles)) (setq article (car elem)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 52c5f27..1e8c8a0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -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 -;; Keywords: news +;; MORIOKA Tomohiko +;; 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 @@ -924,84 +927,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. @@ -1918,7 +1851,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) @@ -2023,6 +1956,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. @@ -2124,9 +2092,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)) @@ -3276,6 +3242,49 @@ 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-preview-quitting-method-for-gnus () + (if (not gnus-show-mime) + (mime-preview-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-raw-buffer-coding-system-alist + 'gnus-original-article-mode + 'raw-text) + +(set-alist 'mime-view-content-header-filter-alist + 'gnus-original-article-mode + #'gnus-content-header-filter) + +(set-alist 'mime-text-decoder-alist + 'gnus-original-article-mode + #'mime-text-decode-buffer) + +(set-alist 'mime-preview-quitting-method-alist + 'gnus-original-article-mode + #'mime-preview-quitting-method-for-gnus) + +(set-alist 'mime-view-show-summary-method + 'gnus-original-article-mode + #'mime-preview-quitting-method-for-gnus) + + +;;; @ end +;;; + (gnus-ems-redefine) (provide 'gnus-art) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 3078158..00d1f4a 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -252,7 +252,7 @@ variable to \"^nnml\"." (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) - (insert-file-contents file) + (nnheader-insert-file-contents file) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -298,7 +298,7 @@ variable to \"^nnml\"." ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents cache-file) + (nnheader-insert-file-contents cache-file) 'nov) ((eq type 'nov) ;; We have both cached and uncached NOV headers, so we @@ -474,7 +474,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) + (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) @@ -517,7 +517,7 @@ Returns the list of articles removed." (save-excursion (set-buffer cache-buf) (erase-buffer) - (insert-file-contents (gnus-cache-file-name group (car cached))) + (nnheader-insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -568,7 +568,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" ;; We simply read the active file. (save-excursion (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) + (nnheader-insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format nil (setq gnus-cache-active-hashtb (gnus-make-hashtable diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 49312d3..9f86512 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -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 +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. @@ -143,6 +144,16 @@ ;;; 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. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, @@ -157,6 +168,7 @@ (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) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index d7e8fb8..734723a 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -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 +;; Tatsuya Ichikawa ;; Keywords: news ;; This file is part of GNU Emacs. @@ -78,6 +79,56 @@ (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) @@ -182,7 +233,11 @@ (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 index 0000000..3737fb9 --- /dev/null +++ b/lisp/gnus-i18n.el @@ -0,0 +1,95 @@ +;;; gnus-i18n.el --- Internationalization for Gnus + +;; Copyright (C) 1996,1997 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index aa9cbc0..95aa5f7 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -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 -;; Lars Magne Ingebrigtsen -;; Keywords: news +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -292,8 +293,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)) @@ -487,60 +490,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" . -(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) ;;; @@ -887,7 +839,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") @@ -915,7 +867,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) "$") diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index cb5476b..79e31a3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -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 -;; Keywords: news +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -33,7 +34,14 @@ (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) +(require 'std11) +(require 'mime-view) + +(or (get-unified-alist mime-acting-condition '((type . text))) + (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] @@ -4720,7 +4734,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) @@ -5235,6 +5249,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) @@ -7182,7 +7218,7 @@ latter case, they will be copied into the relevant groups." (set-buffer (get-buffer-create " *import file*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (unless (nnheader-article-p) ;; This doesn't look like an article, so we fudge some headers. @@ -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-method-to-combine-message/partial-pieces + "mime-partial" + "Internal method to combine message/partial messages automatically.") + +(set-atype 'mime-acting-condition + '((type . message)(subtype . partial) + (method . mime-method-to-combine-message/partial-pieces) + (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) diff --git a/lisp/gnus.el b/lisp/gnus.el index 1a5ac7e..9104200 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -246,11 +246,13 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.6.3" - "Version number for this version of Gnus.") +(defconst gnus-version-number "6.1.1" + "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 Gnus 5.6.3; for SEMI 1.1)" + 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 +1333,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 @@ -1525,8 +1526,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) @@ -1651,7 +1651,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 diff --git a/lisp/lpath.el b/lisp/lpath.el index 288dc8a..7d92912 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -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)) diff --git a/lisp/message.el b/lisp/message.el index fad9df7..3b2921c 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -29,7 +30,10 @@ ;;; 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) @@ -905,7 +917,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.") @@ -1860,20 +1872,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) @@ -1896,7 +1917,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." @@ -1930,8 +1951,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. @@ -1944,11 +1964,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) @@ -1962,9 +1978,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 () @@ -2091,13 +2113,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) @@ -2120,11 +2280,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) @@ -2134,30 +2290,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. ;;; @@ -2191,7 +2365,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 @@ -2452,18 +2628,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) @@ -2902,7 +3079,7 @@ Headers already prepared in the buffer are not modified." (insert "Original-") (beginning-of-line)) (when (or (message-news-p) - (string-match "^[^@]@.+\\..+" secure-sender)) + (string-match "^[^@]+@.+\\..+" secure-sender)) (insert "Sender: " secure-sender "\n"))))))) (defun message-insert-courtesy-copy () @@ -2956,6 +3133,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) @@ -3402,7 +3586,7 @@ responses here are directed to other newsgroups.")) ;; Make sure that this article was written by the user. (unless (string-equal (downcase - (or sender (cadr (mail-extract-address-components from)))) + (or sender (cadr (std11-extract-address-components from)))) (downcase (message-make-address))) (error "This article is not yours")) ;; Make control message. @@ -3420,8 +3604,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))))) @@ -3533,7 +3719,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) @@ -3564,7 +3753,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))) @@ -3720,7 +3911,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 @@ -3814,6 +4006,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 diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 54c3ee0..e517e70 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -230,7 +230,7 @@ Finds out what articles are to be part of the nnkiboze groups." (load newsrc-file)) (nnheader-temp-write nov-file (when (file-exists-p nov-file) - (insert-file-contents nov-file)) + (nnheader-insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. diff --git a/lisp/pop3.el b/lisp/pop3.el index 3362ed5..1bfd8ec 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -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 ;; 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 index 0000000..7dde447 --- /dev/null +++ b/lisp/smtp.el @@ -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 +;; ESMTP support: Simon Leinen +;; 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: + (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: + (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 \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:
." + (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 index 0000000..77a5947 --- /dev/null +++ b/lisp/smtpmail.el @@ -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 +;; Maintainer: Brian D. Carlstrom +;; ESMTP support: Simon Leinen +;; 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 index ea5ef8f..0000000 --- a/texi/Makefile +++ /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