From: ichikawa Date: Sun, 25 Oct 1998 13:30:09 +0000 (+0000) Subject: Importing pgnus-0.39 X-Git-Tag: pgnus0_39~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=3744aa624a1af97f360196755fdeeb6382da8aca;p=elisp%2Fgnus.git- Importing pgnus-0.39 --- diff --git a/GNUS-NEWS b/GNUS-NEWS index a2ca24f..a0ba334 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -1,5 +1,11 @@ ** Gnus changes. +*** Gnus is now a MIME-capable reader. See the manual for details. + *** gnus-auto-select-first can now be a function to be called to position point. +*** The user can now decide which extra headers should be included in +summary buffers and NOV files. + + diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7667891..8eb0615 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,442 @@ +Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.39 is released. + +1998-10-25 00:34:39 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-ignored-mime-types): New variable. + (gnus-mime-display-single): Use it. + (gnus-treatment-function-alist): New variable. + + * gnus.el (gnus-mime): New group. + + * gnus-art.el (gnus-mime-display-alternative): Don't destroy + things for other parts. + (gnus-mime-display-alternative): Place point. + + * gnus.el: autoload gnus-uu-post-news. + + * mailcap.el (mailcap-mailcap-entry-passes-test): Also check + needsterm/DISPLAY. + + * mm-decode.el (mm-display-part): Default to inline text/.* + parts. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Default to + 8bit. + + * gnus-art.el (gnus-mime-copy-part): Use normal-mode. + (gnus-mime-display-single): Inline all text parts. + (gnus-article-narrow-to-signature): Removed mime:: stubs. + +1998-10-24 21:38:37 Lars Magne Ingebrigtsen + + * nnml.el (nnml-possibly-create-directory): Rewrite. + (nnml-request-create-group): Change to right server. + + * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p. + + * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width. + + * gnus.el: rmail-output-to-rmail-file autoload. + + * gnus-util.el (gnus-output-to-rmail): Didn't work if not in + Gnus. + + * nnheader.el (nnheader-parse-head): Checked wrong variable. + + * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks. + +Tue Oct 20 23:37:43 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-mixed): Multipart in + mixed part. + +Tue Oct 20 23:36:43 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + + * gnus-sum.el (gnus-summary-exit-no-update): Ditto. + +Tue Oct 20 16:22:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. + +1998-10-24 20:51:53 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a + value. + + * gnus-art.el (gnus-article-hidden-text-p): Return nil when not + hidden. + + * gnus-spec.el (gnus-update-format-specifications): Use the + article mode line spec. + + * gnus-art.el (gnus-insert-mime-button): Put right type. + (gnus-insert-prev-page-button): Ditto. + (gnus-insert-next-page-button): Dutti. + + * pop3.el: New version installed. + +Sat Oct 24 16:48:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline + and display last part. + +Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.38 is released. + +1998-10-24 07:54:58 Lars Magne Ingebrigtsen + + * gnus-art.el (article-mime-decode-quoted-printable-buffer): + Removed. + (article-de-quoted-unreadable): Narrow to default. + + * qp.el (quoted-printable-encode-region): Encode before QP-ing. + + * gnus-art.el (article-decode-charset): Decode even when broken + MIME. + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return + name. + + * gnus-msg.el (gnus-copy-article-buffer): Delete headers. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Use + nnheader. + + * nnmail.el (nnmail-extra-headers): New variable. + + * nnheader.el (nnheader-insert-nov): Insert extra. + + * gnus.el (gnus-summary-line-format): Doc fix. + + * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra. + (gnus-nov-parse-line): Ditto. + (gnus-nov-parse-extra): New macro. + (gnus-header): New function. + (gnus-update-summary-mark-positions): Change. + (gnus-ignored-from-addresses): New variable. + (gnus-summary-insert-from-or-to): New function. + + * gnus.el (gnus-extra-headers): New variable. + + * nnheader.el (make-mail-header): Expand. + (mail-header-extra): New macro. + (mail-header-set-extra): Ditto. + (make-full-mail-header): Expand. + +Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.37 is released. + +1998-10-24 07:29:11 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-body): Check for multibyticity. + + * mm-util.el (mm-enable-multibyte): Don't always switch multibyte + on. + +1998-10-22 Didier Verna + + * gnus-spec.el (gnus-balloon-face-function): new function + (gnus-parse-format): understand the %< %> specifiers + (gnus-parse-complex-format): ditto. + +1998-10-24 06:31:33 Lars Magne Ingebrigtsen + + * gnus.el: Changed following-char to char-after throughout. + +1998-10-22 04:05:55 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Protect more and message. + +Wed Oct 21 03:26:30 1998 Shenghuo ZHU + + * gnus-xmas.el (gnus-xmas-article-push-button): Go to the + position. + +Tue Oct 20 23:37:43 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-mixed): Multipart in + mixed part. + +Tue Oct 20 23:36:43 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. + + * gnus-sum.el (gnus-summary-exit-no-update): Ditto. + +Tue Oct 20 16:22:51 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. + +1998-10-21 Hrvoje Niksic + + * mailcap.el (mailcap-save-binary-file): Use unwind-protect. + + * mm-decode.el (mm-display-external): Set undisplayer to mm + buffer, not the current buffer; use unwind-protect. + +1998-10-21 00:07:59 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-exit): Destroy parts. + (gnus-summary-exit-no-update): Ditto. + +1998-10-20 22:02:05 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-inline-media-tests): Look for w3. + + * mailcap.el (mailcap-mime-data): Inline html. + +Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.36 is released. + +1998-10-20 18:13:08 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + (gnus-article-dumbquotes-map): Don't dot. + + * pop3.el (pop3-open-server): Set point right. + + * mm-decode.el (mm-dissect-multipart): Dissect hierarchically. + (mm-dissect-buffer): Ditto. + (mm-destroy-part): Ignore non-handles. + (mm-remove-part): Ditto. + (mm-destroy-parts): New function. + (mm-remove-parts): Ditto. + + * gnus-art.el (gnus-mm-display-part): Don't move point. + +Tue Oct 20 02:16:36 1998 Shenghuo ZHU + + * mm-uu.el : New file. + + * gnus-art.el (gnus-display-mime): Dissect uu stuffs. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as + a function. + +1998-10-20 00:35:05 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Check before selecting. + +Sat Sep 26 02:03:00 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite. + + * gnus-sum.el (gnus-decode-encoded-word-methods): New variable. + + * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New + variable. + + * gnus-sum.el (gnus-encoded-word-method-alist): Deleted. + + * gnus-art.el (gnus-decode-header-methods): New variable. + + * gnus-art.el (gnus-decode-header-methods-cache): New variable. + + * gnus-art.el (gnus-multi-decode-header): New function. + +Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.35 is released. + +1998-10-20 00:00:36 Lars Magne Ingebrigtsen + + * uudecode.el (uudecode-decode-region-external): Insert + literally. + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. + + * mm-bodies.el (mm-decode-body): Optional encoding. + +1998-10-19 23:57:57 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-mouse-3): New variable. + + * binhex.el (binhex-decode-region-external): Don't use -internally. + +1998-10-16 14:54:02 Simon Josefsson + + * mailcap.el (mailcap-parse-mailcaps): Only open regular + files. + +1998-09-26 22:28:01 Simon Josefsson + + * gnus-group.el (gnus-add-marked-articles): Request backend update + of flags. + +1998-09-26 19:39:31 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): + (gnus-update-marks): Request backend update of mark. + +1998-09-26 19:33:58 Simon Josefsson + + * gnus.texi (Optional Backend Functions): New item, + nnchoke-request-set-mark. + +1998-09-26 16:27:27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Don't add stuff in + list to range. + +1998-10-19 23:45:13 Simon Josefsson + + * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. + +1998-10-14 SL Baur + + * gnus-sum.el: Move gnus-save-hidden-threads above where it is + first used. + +1998-10-10 SL Baur + + * mm-view.el: Require mm-decode for macros. + + * mm-decode.el (mm-handle-type): Move macro declarations above the + place where they are used. + +Sun Oct 18 13:59:07 1998 Kurt Swanson + + * gnus-msg.el (gnus-summary-mail-forward): Erase old forward + buffer. + +1998-10-19 23:38:11 Katsumi Yamaoka + + * nnagent.el (nnagent-open-server): Error message. + +1998-10-19 23:35:08 Joerg Lenneis + + * nnheader.el (nnheader-article-p): Recognize lower-case headers. + +1998-10-19 Hrvoje Niksic + + * score-mode.el (gnus-score-mode-map): Ditto. + + * message.el (message-mode-map): Ditto. + + * gnus-uu.el (gnus-uu-post-news): Ditto. + + * gnus-kill.el (gnus-kill-file-mode-map): Ditto. + + * gnus-eform.el (gnus-edit-form-mode-map): Ditto. + + * gnus-art.el (gnus-article-edit-mode-map): Use + `set-keymap-parent' rather than `copy-keymap'. + +1998-10-18 Hrvoje Niksic + + * gnus-art.el (gnus-mime-button-commands): New variable. + (gnus-mime-button-map): Initialize it from + `gnus-mime-button-commands'. + (gnus-mime-button-menu): New function. + (gnus-insert-mime-button): Use `gnus-mime-button-map'. + +1998-10-11 Hrvoje Niksic + + * message.el (message-insert-to): Make `nobody' and `poster' + synonymous to `never' and `always' in Mail-Copies-To. + (message-reply): Ditto. + (message-followup): Ditto. + +1998-10-19 23:17:41 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Save sound. + +1998-09-24 Hrvoje Niksic + + * message.el (message-ignored-supersedes-headers): Include + `NNTP-Posting-Date'. + +1998-10-19 01:25:27 Jonas Steverud + + * gnus-art.el (gnus-article-dumbquotes-table): New variable. + +1998-10-19 00:50:22 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + uudecode. + +1998-10-18 18:20:34 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Don't switch on save. + +1998-10-18 18:14:06 Andy Piper + + * nnmail.el (nnmail-movemail-args): New variable. + +1998-10-18 00:17:02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + +1998-10-17 22:51:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Use it. + (gnus-mm-display-part): New function. + (article-de-quoted-unreadable): Yse mm-default-coding-system. + + * mm-decode.el (mm-handle-displayed-p): New function. + + * gnus-art.el (gnus-mime-copy-part): Create better names. + (gnus-mime-button-line-format): Include dots spec. + +1998-10-15 Matt Pharr + + * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old + forward buffer first. + +1998-10-17 21:16:46 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-set-window-start): New function. + + * message.el (message-send): Don't check changed. + +1998-10-12 15:26:41 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Set params. + + * mm-decode.el (mm-user-display-methods): Inline + "message/delivery-status". + +1998-10-11 07:06:38 Lars Magne Ingebrigtsen + + * message.el (message-auto-save-directory): Rename. + (message-mode): Dof fix. + + * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". + (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. + + * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. + + * message.el (message-make-date): Avoid locale. + + * gnus-art.el (gnus-article-edit-done): Allow update before doing + cache. + + * mm-decode.el (mm-display-inline): Goto point-min. + + * gnus-art.el (gnus-article-prepare-display): Not read-only. + + * mm-decode.el (mm-display-external): Reverse before sorting. + + * gnus-draft.el (gnus-draft-send): Allow mail. + +1998-10-10 SL Baur + + * message.el (message-check): Move message-check macro above where + it is first used. + + * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. + +1998-10-11 06:45:37 Lloyd Zusman + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix. + Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.34 is released. @@ -125,6 +564,10 @@ Sat Sep 26 03:04:18 1998 Shenghuo ZHU * mm-decode.el (mm-inlinable-part-p): New function. +1998-09-25 22:28:01 Simon Josefsson + + * mm-util.el (mm-disable-multibyte): New function. + Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.33 is released. diff --git a/lisp/base64.el b/lisp/base64.el index c874b22..5abc827 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -162,7 +162,7 @@ base64-encoder-program.") (error "at least %d bits missing at end of base64 encoding" (* (- 4 counter) 6))) (setq done t)) - ((= (char-after (point)) ?=) + ((eq (char-after (point)) ?=) (setq done t) (cond ((= counter 1) (error "at least 2 bits missing at end of base64 encoding")) diff --git a/lisp/binhex.el b/lisp/binhex.el new file mode 100644 index 0000000..e4e3aa2 --- /dev/null +++ b/lisp/binhex.el @@ -0,0 +1,316 @@ +;;; binhex.el -- elisp native binhex decode +;; Copyright (c) 1998 by Shenghuo Zhu + +;; Author: Shenghuo Zhu +;; Create Date: Oct 1, 1998 +;; $Revision: 1.1.1.1 $ +;; Time-stamp: +;; Keywords: binhex + +;; This file is not part of GNU Emacs, but the same permissions +;; apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(if (not (fboundp 'char-int)) + (fset 'char-int 'identity)) + +(defvar binhex-decoder-program "hexbin" + "*Non-nil value should be a string that names a uu decoder. +The program should expect to read binhex data on its standard +input and write the converted data to its standard output.") + +(defvar binhex-decoder-switches '("-d") + "*List of command line flags passed to the command named by binhex-decoder-program.") + +(defconst binhex-alphabet-decoding-alist + '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) + ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) + ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) + ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23) + ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29) + ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35) + ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41) + ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47) + ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53) + ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59) + ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63))) + +(defun binhex-char-map (char) + (cdr (assq char binhex-alphabet-decoding-alist))) + +;;;###autoload +(defconst binhex-begin-line + "^:...............................................................$") +(defconst binhex-body-line + "^[^:]...............................................................$") +(defconst binhex-end-line ":$") + +(defvar binhex-temporary-file-directory "/tmp/") + +(defun binhex-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (insert-char char count ignored buffer) + (fset 'binhex-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'binhex-insert-char 'binhex-xemacs-insert-char) + (binhex-insert-char char count ignored buffer)))) + +(defun binhex-xemacs-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (save-excursion + (set-buffer buffer) + (insert-char char count)))) + +(defvar binhex-crc-table + [0 4129 8258 12387 16516 20645 24774 28903 + 33032 37161 41290 45419 49548 53677 57806 61935 + 4657 528 12915 8786 21173 17044 29431 25302 + 37689 33560 45947 41818 54205 50076 62463 58334 + 9314 13379 1056 5121 25830 29895 17572 21637 + 42346 46411 34088 38153 58862 62927 50604 54669 + 13907 9842 5649 1584 30423 26358 22165 18100 + 46939 42874 38681 34616 63455 59390 55197 51132 + 18628 22757 26758 30887 2112 6241 10242 14371 + 51660 55789 59790 63919 35144 39273 43274 47403 + 23285 19156 31415 27286 6769 2640 14899 10770 + 56317 52188 64447 60318 39801 35672 47931 43802 + 27814 31879 19684 23749 11298 15363 3168 7233 + 60846 64911 52716 56781 44330 48395 36200 40265 + 32407 28342 24277 20212 15891 11826 7761 3696 + 65439 61374 57309 53244 48923 44858 40793 36728 + 37256 33193 45514 41451 53516 49453 61774 57711 + 4224 161 12482 8419 20484 16421 28742 24679 + 33721 37784 41979 46042 49981 54044 58239 62302 + 689 4752 8947 13010 16949 21012 25207 29270 + 46570 42443 38312 34185 62830 58703 54572 50445 + 13538 9411 5280 1153 29798 25671 21540 17413 + 42971 47098 34713 38840 59231 63358 50973 55100 + 9939 14066 1681 5808 26199 30326 17941 22068 + 55628 51565 63758 59695 39368 35305 47498 43435 + 22596 18533 30726 26663 6336 2273 14466 10403 + 52093 56156 60223 64286 35833 39896 43963 48026 + 19061 23124 27191 31254 2801 6864 10931 14994 + 64814 60687 56684 52557 48554 44427 40424 36297 + 31782 27655 23652 19525 15522 11395 7392 3265 + 61215 65342 53085 57212 44955 49082 36825 40952 + 28183 32310 20053 24180 11923 16050 3793 7920]) + +(defun binhex-update-crc (crc char &optional count) + (if (null count) (setq count 1)) + (while (> count 0) + (setq crc (logxor (logand (lsh crc 8) 65280) + (aref binhex-crc-table + (logxor (logand (lsh crc -8) 255) + char))) + count (1- count))) + crc) + +(defun binhex-verify-crc (buffer start end) + (with-current-buffer buffer + (let ((pos start) (crc 0) (last (- end 2))) + (while (< pos last) + (setq crc (binhex-update-crc crc (char-after pos)) + pos (1+ pos))) + (if (= crc (binhex-string-big-endian (buffer-substring last end))) + nil + (error "CRC error"))))) + +(defun binhex-string-big-endian (string) + (let ((ret 0) (i 0) (len (length string))) + (while (< i len) + (setq ret (+ (lsh ret 8) (char-int (aref string i))) + i (1+ i))) + ret)) + +(defun binhex-string-little-endian (string) + (let ((ret 0) (i 0) (shift 0) (len (length string))) + (while (< i len) + (setq ret (+ ret (lsh (char-int (aref string i)) shift)) + i (1+ i) + shift (+ shift 8))) + ret)) + +(defun binhex-header (buffer) + (with-current-buffer buffer + (let ((pos (point-min)) len) + (vector + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos len))) + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos 4))) + (buffer-substring pos (setq pos (+ pos 4))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 2)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))))))) + +(defvar binhex-last-char) +(defvar binhex-repeat) + +(defun binhex-push-char (char &optional count ignored buffer) + (cond + (binhex-repeat + (if (eq char 0) + (binhex-insert-char (setq binhex-last-char 144) 1 + ignored buffer) + (binhex-insert-char binhex-last-char (- char 1) + ignored buffer) + (setq binhex-last-char nil)) + (setq binhex-repeat nil)) + ((= char 144) + (setq binhex-repeat t)) + (t + (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) + +(defun binhex-decode-region (start end &optional header-only) + "Binhex decode region between START and END. +If HEADER-ONLY is non-nil only decode header and return filename." + (interactive "r") + (let ((work-buffer nil) + (counter 0) + (bits 0) (tmp t) + (lim 0) inputpos + (non-data-chars " \t\n\r:") + file-name-length data-fork-start + header + binhex-last-char binhex-repeat) + (unwind-protect + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line end t) + (if (boundp 'enable-multibyte-characters) + (let ((multibyte + (default-value enable-multibyte-characters))) + (setq-default enable-multibyte-characters nil) + (setq work-buffer + (generate-new-buffer " *binhex-work*")) + (setq-default enable-multibyte-characters multibyte)) + (setq work-buffer (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (beginning-of-line) + (setq bits 0 counter 0) + (while tmp + (skip-chars-forward non-data-chars end) + (setq inputpos (point)) + (end-of-line) + (setq lim (point)) + (while (and (< inputpos lim) + (setq tmp (binhex-char-map (char-after inputpos)))) + (setq bits (+ bits tmp) + counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (binhex-push-char (lsh bits -16) 1 nil work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (binhex-push-char (logand bits 255) 1 nil + work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))) + (if (null file-name-length) + (with-current-buffer work-buffer + (setq file-name-length (char-after (point-min)) + data-fork-start (+ (point-min) + file-name-length 22)))) + (if (and (null header) + (with-current-buffer work-buffer + (>= (buffer-size) data-fork-start))) + (progn + (binhex-verify-crc work-buffer + 1 data-fork-start) + (setq header (binhex-header work-buffer)) + (if header-only (setq tmp nil counter 0)))) + (setq tmp (and tmp (not (eq inputpos end))))) + (cond + ((= counter 3) + (binhex-push-char (logand (lsh bits -16) 255) 1 nil + work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer)) + ((= counter 2) + (binhex-push-char (logand (lsh bits -10) 255) 1 nil + work-buffer)))) + (if header-only nil + (binhex-verify-crc work-buffer + data-fork-start + (+ data-fork-start (aref header 6) 2)) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer + data-fork-start (+ data-fork-start + (aref header 6))) + (delete-region (point) end))) + (and work-buffer (kill-buffer work-buffer))) + (if header (aref header 1)))) + +(defun binhex-decode-region-external (start end) + "Binhex decode region between START and END using external decoder" + (interactive "r") + (let ((cbuf (current-buffer)) firstline work-buffer status + (file-name (concat binhex-temporary-file-directory + (binhex-decode-region start end t) + ".data"))) + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line nil t) + (let ((cdir default-directory) default-process-coding-system) + (unwind-protect + (progn + (set-buffer (setq work-buffer + (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (insert-buffer-substring cbuf firstline end) + (cd binhex-temporary-file-directory) + (apply 'call-process-region + (point-min) + (point-max) + binhex-decoder-program + nil + nil + nil + binhex-decoder-switches)) + (cd cdir) (set-buffer cbuf))) + (if (and file-name (file-exists-p file-name)) + (progn + (goto-char start) + (delete-region start end) + (let (format-alist) + (insert-file-contents-literally file-name))) + (error "Can not binhex"))) + (and work-buffer (kill-buffer work-buffer)) + (condition-case () + (if file-name (delete-file file-name)) + (error)) + ))) + +(provide 'binhex) + +;;; binhex.el ends here + + diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 20c2380..6c595f1 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -115,6 +115,8 @@ for download via the Agent.") (gnus-category-read) (setq gnus-agent-overview-buffer (gnus-get-buffer-create " *Gnus agent overview*")) + (with-current-buffer gnus-agent-overview-buffer + (mm-enable-multibyte)) (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 7c15648..0bb90f5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -38,6 +38,7 @@ (require 'mm-decode) (require 'mm-view) (require 'wid-edit) +(require 'mm-uu) (defgroup gnus-article nil "Article display." @@ -546,8 +547,45 @@ displayed by the first non-nil matching CONTENT face." (defvar gnus-decode-header-function 'mail-decode-encoded-word-region "Function used to decode headers.") +(defvar gnus-article-dumbquotes-map + '(("\202" ",") + ("\203" "f") + ("\204" ",,") + ("\213" "<") + ("\214" "OE") + ("\205" "...") + ("\221" "`") + ("\222" "'") + ("\223" "``") + ("\224" "''") + ("\225" "*") + ("\226" "-") + ("\227" "-") + ("\231" "(TM)") + ("\233" ">") + ("\234" "oe") + ("\264" "'")) + "Table for MS-to-Latin1 translation.") + +(defcustom gnus-ignored-mime-types '("text/x-vcard") + "List of MIME types that should be ignored by Gnus." + :group 'gnus-mime + :type '(repeat regexp)) + +(defcustom gnus-treat-body-highlight-signature t + "Highlight the signature." + :group 'gnus-article + :type '(choice (const :tag "Off" nil) + (const :tag "On" t) + (const :tag "Last" last) + (integer :tag "Less"))) + ;;; Internal variables +(defvar gnus-treatment-function-alist () + '((gnus-treat-body-highlight-signature gnus-article-highlight-signature nil) + )) + (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) (defvar gnus-article-current-summary nil) @@ -808,7 +846,7 @@ always hide." (defun article-treat-dumbquotes () "Translate M******** sm*rtq**t*s into proper text." (interactive) - (article-translate-characters "\221\222\223\224" "`'\"\"")) + (article-translate-strings gnus-article-dumbquotes-map)) (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. @@ -828,6 +866,19 @@ characters to translate to." (incf i)) (translate-region (point) (point-max) x))))) +(defun article-translate-strings (map) + "Translate all string in the body of the article according to MAP. +MAP is an alist where the elements are on the form (\"from\" \"to\")." + (save-excursion + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (let ((buffer-read-only nil) + elem) + (while (setq elem (pop map)) + (save-excursion + (while (search-forward (car elem) nil t) + (replace-match (cadr elem))))))))) + (defun article-treat-overstrike () "Translate overstrikes into bold text." (interactive) @@ -836,7 +887,7 @@ characters to translate to." (when (search-forward "\n\n" nil t) (let ((buffer-read-only nil)) (while (search-forward "\b" nil t) - (let ((next (following-char)) + (let ((next (char-after)) (previous (char-after (- (point) 2)))) ;; We do the boldification/underlining by hiding the ;; overstrikes and putting the proper text property @@ -985,7 +1036,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (widen) (forward-line 1) (narrow-to-region (point) (point-max)) - (when (or (not ct) + (when (or (not ctl) (equal (car ctl) "text/plain")) (mm-decode-body charset (and cte (intern (downcase @@ -1011,11 +1062,11 @@ or not." (and type (string-match "quoted-printable" (downcase type)))) (goto-char (point-min)) (search-forward "\n\n" nil 'move) - (quoted-printable-decode-region (point) (point-max)))))) - -(defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (quoted-printable-decode-region (point-min) (point-max))) + (save-restriction + (narrow-to-region (point) (point-max)) + (quoted-printable-decode-region (point-min) (point-max)) + (when mm-default-coding-system + (mm-decode-body mm-default-coding-system))))))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. @@ -1031,6 +1082,9 @@ always hide." ;; Hide the "header". (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) (delete-region (1+ (match-beginning 0)) (match-end 0)) + ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too + (when (looking-at "Hash:.*$") + (delete-region (point) (1+ (gnus-point-at-eol)))) (setq beg (point)) ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) @@ -1155,21 +1209,10 @@ always hide." (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) (defun gnus-article-narrow-to-signature () "Narrow to the signature; return t if a signature is found, else nil." (widen) (let ((inhibit-point-motion-hooks t)) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - (when (gnus-article-search-signature) (forward-line 1) ;; Check whether we have some limits to what we consider @@ -1275,7 +1318,7 @@ means show, 0 means toggle." (text-property-any (1+ pos) (point-max) 'article-type type))) (if pos 'hidden - 'shown))) + nil))) (defun gnus-article-show-hidden-text (type &optional hide) "Show all hidden text of type TYPE. @@ -1733,7 +1776,8 @@ The directory to save in defaults to `gnus-article-save-directory'." (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (setq command - (cond ((eq command 'default) + (cond ((and (eq command 'default) + gnus-last-shell-command) gnus-last-shell-command) (command command) (t (read-string @@ -2006,6 +2050,7 @@ commands: (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) + (gnus-summary-set-local-parameters gnus-newsgroup-name) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines @@ -2138,6 +2183,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." buffer-read-only) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) + (setq buffer-read-only nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (gnus-run-hooks 'gnus-article-prepare-hook) (when gnus-display-mime-function @@ -2150,32 +2196,46 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;;; Gnus MIME viewing functions ;;; -(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}\n" +(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n" "The following specs can be used: %t The MIME type %n The `name' parameter %d The description, if any %l The length of the encoded part -%p The part identifier") +%p The part identifier +%e Dots if the part isn't displayed") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) (?n gnus-tmp-name ?s) (?d gnus-tmp-description ?s) (?p gnus-tmp-id ?s) - (?l gnus-tmp-length ?d))) + (?l gnus-tmp-length ?d) + (?e gnus-tmp-dots ?s))) + +(defvar gnus-mime-button-commands + '((gnus-article-press-button "\r" "Toggle Display") + ;(gnus-mime-view-part "\M-\r" "View Interactively...") + (gnus-mime-view-part "v" "View Interactively...") + (gnus-mime-save-part "o" "Save...") + (gnus-mime-copy-part "c" "View In Buffer") + (gnus-mime-inline-part "i" "View Inline") + (gnus-mime-pipe-part "|" "Pipe To Command..."))) (defvar gnus-mime-button-map nil) (unless gnus-mime-button-map - (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map)) + (setq gnus-mime-button-map (make-sparse-keymap)) + (set-keymap-parent gnus-mime-button-map gnus-article-mode-map) (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) - (define-key gnus-mime-button-map "\r" 'gnus-article-press-button) - (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part) - (define-key gnus-mime-button-map "v" 'gnus-mime-view-part) - (define-key gnus-mime-button-map "o" 'gnus-mime-save-part) - (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part) - (define-key gnus-mime-button-map "i" 'gnus-mime-inline-part) - (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part)) + (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu) + (mapcar (lambda (c) + (define-key gnus-mime-button-map (cadr c) (car c))) + gnus-mime-button-commands)) + +(defun gnus-mime-button-menu (event) + "Construct a context-sensitive menu of MIME commands." + (interactive "e") + ) (defun gnus-mime-view-all-parts () "View all the MIME parts." @@ -2206,10 +2266,18 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-copy-part () "Put the the MIME part under point into a new buffer." (interactive) - (let* ((data (get-text-property (point) 'gnus-data)) - (contents (mm-get-part data))) - (switch-to-buffer (generate-new-buffer "*decoded*")) + (let* ((handle (get-text-property (point) 'gnus-data)) + (contents (mm-get-part handle)) + (buffer (generate-new-buffer + (file-name-nondirectory + (or + (mail-content-type-get (mm-handle-type handle) 'name) + (mail-content-type-get (mm-handle-type handle) + 'filename) + "*decoded*"))))) + (switch-to-buffer buffer) (insert contents) + (normal-mode) (goto-char (point-min)))) (defun gnus-mime-inline-part () @@ -2235,22 +2303,36 @@ If ALL-HEADERS is non-nil, no headers are hidden." (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (gnus-article-goto-part n) - (mm-display-part handle)))) + (gnus-set-window-start) + (gnus-mm-display-part handle)))) + +(defun gnus-mm-display-part (handle) + "Display HANDLE and fix MIME button." + (let ((id (get-text-property (point) 'gnus-part)) + (point (point)) + buffer-read-only) + (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) + (gnus-insert-mime-button + handle id (list (not (mm-handle-displayed-p handle)))) + (mm-display-part handle) + (goto-char point))) (defun gnus-article-goto-part (n) "Go to MIME part N." (goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) -(defun gnus-insert-mime-button (handle) +(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name)) (gnus-tmp-type (car (mm-handle-type handle))) (gnus-tmp-description (mm-handle-description handle)) + (gnus-tmp-dots + (if (if displayed (car displayed) + (mm-handle-displayed-p handle)) + "" "...")) (gnus-tmp-length (save-excursion (set-buffer (mm-handle-buffer handle)) (buffer-size))) - (gnus-tmp-id (1+ (length gnus-article-mime-handle-alist))) b e) - (push (cons gnus-tmp-id handle) gnus-article-mime-handle-alist) (setq gnus-tmp-name (if gnus-tmp-name (concat " (" gnus-tmp-name ")") @@ -2264,82 +2346,126 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-mime-button-line-format gnus-mime-button-line-format-alist `(local-map ,gnus-mime-button-map keymap ,gnus-mime-button-map - gnus-callback mm-display-part + gnus-callback gnus-mm-display-part gnus-part ,gnus-tmp-id - gnus-type annotation + article-type annotation gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap))) + :button-keymap gnus-mime-button-map))) (defun gnus-widget-press-button (elems el) (goto-char (widget-get elems :from)) (let ((url-standalone-mode (not gnus-plugged))) (gnus-article-press-button))) -(defun gnus-display-mime () +(defun gnus-display-mime (&optional ihandles) "Insert MIME buttons in the buffer." - (let (ct ctl) - (save-restriction - (mail-narrow-to-head) - (when (setq ct (mail-fetch-field "content-type")) - (setq ctl (condition-case () - (mail-header-parse-content-type ct) (error nil))))) - (let* ((handles (mm-dissect-buffer)) - handle name type b e) - (mapcar 'mm-destroy-part gnus-article-mime-handles) - (setq gnus-article-mime-handles handles - gnus-article-mime-handle-alist nil) - (when handles + (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) + handle name type b e display) + (when handles + (unless ihandles + ;; Top-level call; we clean up. + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handles handles + gnus-article-mime-handle-alist nil) (goto-char (point-min)) (search-forward "\n\n" nil t) - (delete-region (point) (point-max)) - (if (not (equal (car ctl) "multipart/alternative")) - (while (setq handle (pop handles)) - (gnus-insert-mime-button handle) - (insert "\n\n") - (when (and (mm-automatic-display-p - (car (mm-handle-type handle))) - (mm-inlinable-part-p (car (mm-handle-type handle))) - (or (not (mm-handle-disposition handle)) - (equal (car (mm-handle-disposition handle)) - "inline"))) - (forward-line -2) - (mm-display-part handle t) - (goto-char (point-max)))) - ;; Here we have multipart/alternative - (gnus-mime-display-alternative handles)))))) - -(defun gnus-mime-display-alternative (handles &optional preferred) + (delete-region (point) (point-max))) + (if (stringp (car handles)) + (if (equal (car handles) "multipart/alternative") + (gnus-mime-display-alternative (cdr handles)) + (gnus-mime-display-mixed (cdr handles))) + (gnus-mime-display-single handles))))) + +(defun gnus-mime-display-mixed (handles) + (let (handle) + (while (setq handle (pop handles)) + (if (stringp (car handle)) + (if (equal (car handle) "multipart/alternative") + (gnus-mime-display-alternative (cdr handle)) + (gnus-mime-display-mixed (cdr handle))) + (gnus-mime-display-single handle))))) + +(defun gnus-mime-display-single (handle) + (let ((type (car (mm-handle-type handle))) + (ignored gnus-ignored-mime-types) + display text) + (catch 'ignored + (progn + (while ignored + (when (string-match (pop ignored) type) + (throw 'ignored nil))) + (if (and (mm-automatic-display-p type) + (mm-inlinable-part-p type) + (or (not (mm-handle-disposition handle)) + (equal (car (mm-handle-disposition handle)) + "inline"))) + (setq display t) + (when (equal (car (split-string type "/")) + "text") + (setq text t))) + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (gnus-insert-mime-button handle id (list (or display text)))) + (insert "\n\n") + (cond + (display + (forward-line -2) + (mm-display-part handle t) + (goto-char (point-max))) + (text + (forward-line -2) + (insert "\n") + (mm-insert-inline handle (mm-get-part handle)) + (goto-char (point-max)))))))) + +(defun gnus-mime-display-alternative (handles &optional preferred ibegend) (let* ((preferred (mm-preferred-alternative handles preferred)) (ihandles handles) - handle buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (delete-region (point) (point-max)) - (mapcar 'mm-remove-part gnus-article-mime-handles) - (setq gnus-article-mime-handles handles) - (while (setq handle (pop handles)) - (gnus-add-text-properties - (point) - (progn - (insert (format "[%c] %-18s" - (if (equal handle preferred) ?* ? ) - (car (mm-handle-type handle)))) - (point)) - `(local-map ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - keymap ,gnus-mime-button-map - gnus-callback - (lambda (handles) - (gnus-mime-display-alternative - ',ihandles ,(car (mm-handle-type handle)))) - gnus-data ,handle)) - (insert " ")) - (insert "\n\n") - (when preferred - (mm-display-part preferred)))) + (point (point)) + handle buffer-read-only from props begend) + (save-restriction + (when ibegend + (narrow-to-region (car ibegend) (cdr ibegend)) + (delete-region (point-min) (point-max)) + (mm-remove-parts handles)) + (setq begend (list (point-marker))) + (while (setq handle (pop handles)) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "[%c] %-18s" + (if (equal handle preferred) ?* ? ) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle))))) + (point)) + `(gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ,(if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle))) + ',begend)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + (insert " ")) + (insert "\n\n") + (when preferred + (if (stringp (car preferred)) + (gnus-display-mime preferred) + (mm-display-part preferred) + (goto-char (point-max)) + (setcdr begend (point-marker))))) + (when ibegend + (goto-char point)))) (defun gnus-article-wash-status () "Return a string which display status of article washing." @@ -2353,7 +2479,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (signature (gnus-article-hidden-text-p 'signature)) (overstrike (gnus-article-hidden-text-p 'overstrike)) (emphasis (gnus-article-hidden-text-p 'emphasis))) - (format "%c%c%c%c%c%c%c" + (format "%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) (if (or pgp pem) ?p ? ) @@ -2786,8 +2912,10 @@ If given a prefix, show the hidden text instead." (defvar gnus-article-edit-mode-map nil) +;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) + (setq gnus-article-edit-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-article-edit-mode-map text-mode-map) (gnus-define-keys gnus-article-edit-mode-map "\C-c\C-c" gnus-article-edit-done @@ -2873,7 +3001,19 @@ groups." (save-excursion (set-buffer buf) (let ((buffer-read-only nil)) - (funcall func arg))) + (funcall func arg)) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + ;; Flush original article as well. + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current)))) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) @@ -2890,18 +3030,6 @@ groups." (insert buf) (let ((winconf gnus-prev-winconf)) (gnus-article-mode) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; Flush original article as well. - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. (save-current-buffer @@ -3405,7 +3533,7 @@ forbidden in URL encoding." gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map gnus-callback gnus-article-button-prev-page - gnus-type annotation)))) + article-type annotation)))) (defvar gnus-next-page-map nil) (unless gnus-next-page-map @@ -3436,7 +3564,7 @@ forbidden in URL encoding." `(gnus-next t local-map ,gnus-next-page-map gnus-callback gnus-article-button-next-page - gnus-type annotation)))) + article-type annotation)))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -3454,6 +3582,44 @@ forbidden in URL encoding." (gnus-article-prev-page) (select-window win))) +(defvar gnus-decode-header-methods + '(mail-decode-encoded-word-region) + "List of methods used to decode headers + +This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is +FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +whose names match REGEXP. + +For example: +((\"chinese\" . gnus-decode-encoded-word-region-by-guess) + mail-decode-encoded-word-region + (\"chinese\" . rfc1843-decode-region)) +") + +(defvar gnus-decode-header-methods-cache nil) + +(defun gnus-multi-decode-header (start end) + "Apply the functions from `gnus-encoded-word-methods' that match." + (unless (and gnus-decode-header-methods-cache + (eq gnus-newsgroup-name + (car gnus-decode-header-methods-cache))) + (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) + (mapc '(lambda (x) + (if (symbolp x) + (nconc gnus-decode-header-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-header-methods-cache + (list (cdr x)))))) + gnus-decode-header-methods)) + (let ((xlist gnus-decode-header-methods-cache)) + (pop xlist) + (save-restriction + (narrow-to-region start end) + (while xlist + (funcall (pop xlist) (point-min) (point-max)))))) + (gnus-ems-redefine) (provide 'gnus-art) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index a72ba8c..56d16b1 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -201,17 +201,7 @@ it's not cached." (beginning-of-line)) (forward-line 1)) (beginning-of-line) - ;; [number subject from date id references chars lines xref] - (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" - (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) - (mail-header-date headers) - (mail-header-id headers) - (or (mail-header-references headers) "") - (or (mail-header-chars headers) "") - (or (mail-header-lines headers) "") - (or (mail-header-xref headers) ""))) + (nnheader-insert-nov headers) ;; Update the active info. (set-buffer gnus-summary-buffer) (gnus-cache-update-active group number) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 8a4fdb9..27b4ad6 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -135,7 +135,8 @@ (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (when (and (or (gnus-server-opened method) + (when (and (or (null method) + (gnus-server-opened method) (gnus-open-server method)) (if type (let ((message-this-is-news (eq type 'news)) diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el index 6a93242..dff64d7 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -53,7 +53,8 @@ (defvar gnus-edit-form-mode-map nil) (unless gnus-edit-form-mode-map - (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) + (setq gnus-edit-form-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map) (gnus-define-keys gnus-edit-form-mode-map "\C-c\C-c" gnus-edit-form-done "\C-c\C-k" gnus-edit-form-exit)) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index af1f5e8..2438b31 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -33,6 +33,7 @@ "Non-nil if running under XEmacs.") (defvar gnus-mouse-2 [mouse-2]) +(defvar gnus-mouse-3 [mouse-3]) (defvar gnus-down-mouse-2 [down-mouse-2]) (defvar gnus-widget-button-keymap nil) (defvar gnus-mode-line-modified @@ -73,7 +74,7 @@ (valstr (if (numberp val) (int-to-string val) val))) (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) + (truncate-string-to-width valstr (, max-width)) valstr)))) (eval-and-compile @@ -99,14 +100,7 @@ (while funcs (unless (fboundp (car funcs)) (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs)))))) - (unless (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (unless (fboundp 'face-list) - (defun face-list (&rest args)))) + (setq funcs (cdr funcs))))))) (eval-and-compile (let ((case-fold-search t)) @@ -173,7 +167,7 @@ (format "%4d: %-20s" gnus-tmp-lines (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) + (truncate-string-to-width gnus-tmp-name 20) gnus-tmp-name)) gnus-tmp-closing-bracket) (point)) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 1ec6d40..6c6bb82 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -299,6 +299,18 @@ variable." gnus-group-news-3-empty-face) ((and (not mailp) (eq level 3)) . gnus-group-news-3-face) + ((and (= unread 0) (not mailp) (eq level 4)) . + gnus-group-news-4-empty-face) + ((and (not mailp) (eq level 4)) . + gnus-group-news-4-face) + ((and (= unread 0) (not mailp) (eq level 5)) . + gnus-group-news-5-empty-face) + ((and (not mailp) (eq level 5)) . + gnus-group-news-5-face) + ((and (= unread 0) (not mailp) (eq level 6)) . + gnus-group-news-6-empty-face) + ((and (not mailp) (eq level 6)) . + gnus-group-news-6-face) ((and (= unread 0) (not mailp)) . gnus-group-news-low-empty-face) ((and (not mailp)) . @@ -1328,7 +1340,7 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (subst-char-in-region - (point) (1+ (point)) (following-char) + (point) (1+ (point)) (char-after) (if unmark (progn (setq gnus-group-marked (delete group gnus-group-marked)) @@ -3336,26 +3348,26 @@ and the second element is the address." (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't + ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) + (setcdr (nthcdr 2 info) + (list (list (cons type (gnus-compress-sequence + articles t))))))) (and (not (setq m (assq type (car marked)))) (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) + (setcar marked + (cons (cons type (gnus-compress-sequence articles t) ) + (car marked))))) (if force (if (null articles) - (setcar (nthcdr 3 info) - (gnus-delete-alist type (car marked))) - (setcdr m (gnus-compress-sequence articles t))) + (setcar (nthcdr 3 info) + (gnus-delete-alist type (car marked))) + (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index f94c202..d72d966 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -308,6 +308,16 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article)))) +(defun gnus-request-set-mark (group action) + "Set marks on articles in the backend." + (let ((gnus-command-method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function + 'request-set-mark (car gnus-command-method))) + action + (funcall (gnus-get-function gnus-command-method 'request-set-mark) + (gnus-group-real-name group) action + (nth 1 gnus-command-method))))) + (defun gnus-request-update-mark (group article mark) "Allow the backend to change the mark the user tries to put on an article." (let ((gnus-command-method (gnus-find-method-for-group group))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0b0bc68..09a3f47 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -395,7 +395,7 @@ header line with the old Message-ID." ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) + (or (search-forward "\n\n" nil t) (point-max))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) (article-decode-encoded-words))) @@ -620,6 +620,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (set-buffer gnus-original-article-buffer) (setq text (buffer-string))) (set-buffer (gnus-get-buffer-create " *Gnus forward*")) + (erase-buffer) (insert text) (run-hooks 'gnus-article-decode-hook) (let ((message-included-forward-headers diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 7535a25..8659779 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -271,7 +271,7 @@ matches an previously scanned and verified nocem message." gnus-nocem-real-group-hashtb) ;; Valid group. (beginning-of-line) - (while (= (following-char) ?\t) + (while (eq (char-after) ?\t) (forward-line -1)) (setq id (buffer-substring (point) (1- (search-forward "\t")))) (unless (gnus-gethash id gnus-nocem-hashtb) @@ -279,7 +279,7 @@ matches an previously scanned and verified nocem message." (gnus-sethash id t gnus-nocem-hashtb) (push id ncm)) (forward-line 1) - (while (= (following-char) ?\t) + (while (eq (char-after) ?\t) (forward-line 1)))))) (when ncm (setq gnus-nocem-touched-alist t) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 672e726..895505e 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -229,7 +229,7 @@ Note: LIST has to be sorted over `<'." Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. (gnus-compress-sequence - (gnus-sorted-complement + (gnus-set-difference (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 68d0f3c..b50341d 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -705,7 +705,7 @@ Two predefined functions are available: (while (progn (forward-line -1) (forward-char col) - (= (following-char) ? )) + (eq (char-after) ? )) (delete-char 1) (insert (caddr gnus-tree-parent-child-edges))) (goto-char beg))) @@ -763,7 +763,7 @@ Two predefined functions are available: (forward-char -1) ;; Draw "-" lines leftwards. (while (and (> (point) 1) - (= (char-after (1- (point))) ? )) + (eq (char-after (1- (point))) ? )) (delete-char -1) (insert (car gnus-tree-parent-child-edges)) (forward-char -1)) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index d910ae6..0cd6ed1 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -201,9 +201,7 @@ (gnus-parse-format new-format (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) + (intern (format "gnus-%s-line-format-alist" type))) (not (string-match "mode$" (symbol-name type)))))) ;; Enter the new format spec into the list. (if entry @@ -241,6 +239,12 @@ (point) (progn ,@form (point)) '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) +(defun gnus-balloon-face-function (form type) + `(gnus-put-text-property + (point) (progn ,@form (point)) + 'balloon-help + ,(intern (format "gnus-balloon-face-%d" type)))) + (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." (let ((max (abs max-width))) @@ -287,8 +291,10 @@ ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. + ;; If the FORMAT string contains the specifiers %< and %>, the text between + ;; them will have the balloon-help text property. (if (string-match - "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" + "\\`\\(.*\\)%[0-9]?[{(<]\\(.*\\)%[0-9]?[})>]\\(.*\n?\\)\\'" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. @@ -303,13 +309,17 @@ (replace-match "\\\"" nil t)) (goto-char (point-min)) (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) + (while (re-search-forward "%\\([0-9]+\\)?\\([{}()<>]\\)" nil t) (let ((number (if (match-beginning 1) (match-string 1) "0")) (delim (aref (match-string 2) 0))) (if (or (= delim ?\() - (= delim ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") + (= delim ?\{) + (= delim ?\<)) + (replace-match (concat "\"(" + (cond ((= delim ?\() "mouse") + ((= delim ?\{) "face") + (t "balloon")) " " number " \"")) (replace-match "\")\"")))) (goto-char (point-max)) @@ -390,9 +400,9 @@ (t nil))) ;; User-defined spec -- find the spec name. - (when (= (setq spec (following-char)) ?u) + (when (eq (setq spec (char-after)) ?u) (forward-char 1) - (setq user-defined (following-char))) + (setq user-defined (char-after))) (forward-char 1) (delete-region spec-beg (point)) @@ -519,7 +529,7 @@ If PROPS, insert the result." (not (eq 'byte-code (car form))) ;; Under XEmacs, it's (funcall #) (not (and (eq 'funcall (car form)) - (compiled-function-p (cadr form))))) + (byte-code-function-p (cadr form))))) (fset 'gnus-tmp-func `(lambda () ,form)) (byte-compile 'gnus-tmp-func) (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 849a2da..560c0e9 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -706,7 +706,7 @@ buffer. (save-excursion (beginning-of-line) ;; If this group it killed, then we want to subscribe it. - (when (= (following-char) ?K) + (when (eq (char-after) ?K) (setq sub t)) (setq group (gnus-browse-group-name)) (when (and sub diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 5b9d98a..eec5d5e 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1705,7 +1705,6 @@ newsgroup." (gnus-message 5 "%sdone" mesg)))))) (setq methods (cdr methods)))))) - (defun gnus-ignored-newsgroups-has-to-p () "Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element." ;; note this regexp is the same as: @@ -1772,13 +1771,13 @@ newsgroup." (progn (skip-chars-forward " \t") (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) + (or (eq (char-after) ?=) + (eq (char-after) ?x) + (eq (char-after) ?j))))) (progn (set group (cons min max)) ;; if group is moderated, stick in moderation table - (when (= (following-char) ?m) + (when (eq (char-after) ?m) (unless gnus-moderated-hashtb (setq gnus-moderated-hashtb (gnus-make-hashtable))) (gnus-sethash (symbol-name group) t @@ -1836,7 +1835,7 @@ newsgroup." (let (min max group) (while (not (eobp)) (condition-case () - (when (= (following-char) ?2) + (when (eq (char-after) ?2) (read cur) (read cur) (setq min (read cur) max (read cur)) @@ -2053,7 +2052,7 @@ If FORCE is non-nil, the .newsrc file is read." (unless (boundp symbol) (set symbol nil)) ;; It was a group name. - (setq subscribed (= (following-char) ?:) + (setq subscribed (eq (char-after) ?:) group (symbol-name symbol) reads nil) (if (eolp) @@ -2077,7 +2076,7 @@ If FORCE is non-nil, the .newsrc file is read." (read buf))) (widen) ;; If the next character is a dash, then this is a range. - (if (= (following-char) ?-) + (if (eq (char-after) ?-) (progn ;; We read the upper bound of the range. (forward-char 1) @@ -2099,8 +2098,8 @@ If FORCE is non-nil, the .newsrc file is read." (push num1 reads)) ;; If the next char in ?\n, then we have reached the end ;; of the line and return nil. - (/= (following-char) ?\n)) - ((= (following-char) ?\n) + (not (eq (char-after) ?\n))) + ((eq (char-after) ?\n) ;; End of line, so we end. nil) (t @@ -2226,7 +2225,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-point-at-eol))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) - (if (= (char-after (match-beginning 0)) ?!) + (if (eq (char-after (match-beginning 0)) ?!) ;; If the word begins with a bang (!), this is a "not" ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 57adb60..6d38a3b 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -34,6 +34,7 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +(require 'mm-decode) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (defcustom gnus-kill-summary-on-exit t @@ -771,6 +772,16 @@ which it may alter in any way.") (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string "Variable that says which function should be used to decode a string with encoded words.") +(defcustom gnus-extra-headers nil + "*Extra headers to parse." + :group 'gnus-summary + :type '(repeat symbol)) + +(defcustom gnus-ignored-from-addresses nil + "*Regexp of From headers that may be suppressed in favor of To headers." + :group 'gnus-summary + :type 'regexp) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -831,6 +842,7 @@ which it may alter in any way.") (?l (bbb-grouplens-score gnus-tmp-header) ?s) (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) + (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s) (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) @@ -996,22 +1008,42 @@ variable (string, integer, character, etc).") ;; MIME stuff. -(defvar gnus-encoded-word-method-alist - '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string) - (".*" mail-decode-encoded-word-string)) - "Alist of regexps (to match group names) and lists of functions to be applied.") +(defvar gnus-decode-encoded-word-methods + '(mail-decode-encoded-word-string) + "List of methods used to decode encoded words. + +This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is +FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +whose names match REGEXP. + +For example: +((\"chinese\" . gnus-decode-encoded-word-string-by-guess) + mail-decode-encoded-word-string + (\"chinese\" . rfc1843-decode-string)) +") + +(defvar gnus-decode-encoded-word-methods-cache nil) (defun gnus-multi-decode-encoded-word-string (string) - "Apply the functions from `gnus-encoded-word-method-alist' that match." - (let ((alist gnus-encoded-word-method-alist) - elem) - (while (setq elem (pop alist)) - (when (string-match (car elem) gnus-newsgroup-name) - (pop elem) - (while elem - (setq string (funcall (pop elem) string))) - (setq alist nil))) - string)) + "Apply the functions from `gnus-encoded-word-methods' that match." + (unless (and gnus-decode-encoded-word-methods-cache + (eq gnus-newsgroup-name + (car gnus-decode-encoded-word-methods-cache))) + (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) + (mapc '(lambda (x) + (if (symbolp x) + (nconc gnus-decode-encoded-word-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-encoded-word-methods-cache + (list (cdr x)))))) + gnus-decode-encoded-word-methods)) + (let ((xlist gnus-decode-encoded-word-methods-cache)) + (pop xlist) + (while xlist + (setq string (funcall (pop xlist) string)))) + string) ;; Subject simplification. @@ -1516,7 +1548,7 @@ increase the score of each group you read." ["Words" gnus-article-decode-mime-words t] ["Charset" gnus-article-decode-charset t] ["QP" gnus-article-de-quoted-unreadable t] - ["View all" gnus-mime-view-all-parts]) + ["View all" gnus-mime-view-all-parts t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] @@ -2252,7 +2284,7 @@ marks of articles." (while (setq point (pop config)) (when (and (< point (point-max)) (goto-char point) - (= (following-char) ?\n)) + (eq (char-after) ?\n)) (subst-char-in-region point (1+ point) ?\n ?\r))))) ;; Various summary mode internalish functions. @@ -2386,7 +2418,7 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) + [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) @@ -2410,6 +2442,27 @@ marks of articles." (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) +(defun gnus-summary-from-or-to-or-newsgroups (header) + (let ((to (cdr (assq 'To (mail-header-extra header)))) + (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))) + (cond + ((and to + gnus-ignored-from-addresses + (string-match gnus-ignored-from-addresses + (mail-header-from header))) + (or (car (funcall gnus-extract-address-components + (funcall gnus-decode-encoded-word-function to))) + (funcall gnus-decode-encoded-word-function to))) + ((and newsgroups + gnus-ignored-from-addresses + (string-match gnus-ignored-from-addresses + (mail-header-from header))) + newsgroups) + (t + (or (car (funcall gnus-extract-address-components + (mail-header-from header))) + (mail-header-from header)))))) + (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread gnus-tmp-replied @@ -3056,12 +3109,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) -;; The following macros and functions were written by Felix Lee -;; . - (defmacro gnus-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 (let ((num (ignore-errors (read buffer)))) (if (numberp num) num 0))) @@ -3074,6 +3124,16 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defmacro gnus-nov-field () '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) +(defmacro gnus-nov-parse-extra () + '(let (out string) + (while (not (memq (char-after) '(?\n nil))) + (setq string (gnus-nov-field)) + (when (string-match "^\\([^ :]\\): " string) + (push (cons (intern (match-string 1)) + (substring string (match-end 0))) + out))) + out)) + ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) @@ -3101,8 +3161,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (gnus-nov-field) ; refs (gnus-nov-read-integer) ; chars (gnus-nov-read-integer) ; lines - (unless (= (following-char) ?\n) - (gnus-nov-field))))) ; misc + (unless (eq (char-after) ?\n) + (gnus-nov-field)) ; misc + (gnus-nov-parse-extra)))) ; extra (widen)) @@ -3578,6 +3639,12 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-root-expunged nil) (defvar gnus-tmp-dummy-line nil) +(defvar gnus-tmp-header) +(defun gnus-extra-header (type &optional header) + "Return the extra header of TYPE." + (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) + "")) + (defun gnus-summary-prepare-threads (threads) "Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' @@ -4139,7 +4206,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) - type list newmarked symbol) + type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) @@ -4238,7 +4305,7 @@ If WHERE is `summary', the summary mode line format will be used." ;; We might have to chop a bit of the string off... (when (> (length mode-string) max-len) (setq mode-string - (concat (truncate-string mode-string (- max-len 3)) + (concat (truncate-string-to-width mode-string (- max-len 3)) "..."))) ;; Pad the mode string a bit. (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) @@ -4516,7 +4583,19 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) + (nnheader-header-value))) + ;; Extra. + (when gnus-extra-headers + (let ((extra gnus-extra-headers) + out) + (while extra + (goto-char p) + (when (search-forward + (concat "\n" (symbol-name (car extra)) ": ") nil t) + (push (cons (car extra) (nnheader-header-value)) + out)) + (pop extra)) + out)))) (when (equal id ref) (setq ref nil)) @@ -4600,7 +4679,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) + (when (or (and (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -5124,7 +5203,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) - (mapcar 'mm-destroy-part gnus-article-mime-handles))) + (mm-destroy-parts gnus-article-mime-handles))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5168,11 +5247,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) - (gnus-run-hooks 'gnus-summary-prepare-exit-hook) + (gnus-run-hooks (delq 'gnus-summary-expire-articles + (copy-list gnus-summary-prepare-exit-hook))) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) - (mapcar 'mm-destroy-part gnus-article-mime-handles))) + (mm-destroy-parts gnus-article-mime-handles))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -7806,19 +7886,19 @@ marked." (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when (looking-at "\r") - (incf forward)) - (when (and forward - (<= (+ forward (point)) (point-max))) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) + (when forward + (when (looking-at "\r") + (incf forward)) + (when (<= (+ forward (point)) (point-max)) + ;; Go to the right position on the line. + (goto-char (+ forward (point))) + ;; Replace the old mark with the new mark. + (subst-char-in-region (point) (1+ (point)) (char-after) mark) + ;; Optionally update the marks by some user rule. + (when (eq type 'unread) + (gnus-data-set-mark + (gnus-data-find (gnus-summary-article-number)) mark) + (gnus-summary-update-line (eq mark gnus-unread-mark))))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." @@ -8622,6 +8702,7 @@ save those articles instead." (defun gnus-valid-move-group-p (group) (and (boundp group) (symbol-name group) + (symbol-value group) (memq 'respool (assoc (symbol-name (car (gnus-find-method-for-group @@ -8956,8 +9037,9 @@ save those articles instead." (setq unread (cdr unread))) (when (<= prev (cdr active)) (push (cons prev (cdr active)) read)) + (setq read (if (> (length read) 1) (nreverse read) read)) (if compute - (if (> (length read) 1) (nreverse read) read) + read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register @@ -8967,8 +9049,7 @@ save those articles instead." (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) + (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 80496f8..30b2cde 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -647,7 +647,7 @@ with potentially long computations." (setq filename (expand-file-name filename)) (setq rmail-default-rmail-file filename) (let ((artbuf (current-buffer)) - (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))) + (tmpbuf (get-buffer-create " *Gnus-output*"))) (save-excursion (or (get-file-buffer filename) (file-exists-p filename) @@ -698,7 +698,7 @@ with potentially long computations." "Append the current article to a mail file named FILENAME." (setq filename (expand-file-name filename)) (let ((artbuf (current-buffer)) - (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))) + (tmpbuf (get-buffer-create " *Gnus-output*"))) (save-excursion ;; Create the file, if it doesn't exist. (when (and (not (get-file-buffer filename)) @@ -908,6 +908,12 @@ ARG is passed to the first function." re (unless (string-match "\\$$" re) ".*$"))) +(defun gnus-set-window-start (&optional point) + "Set the window start to POINT, or (point) if nil." + (let ((win (get-buffer-window (current-buffer) t))) + (when win + (set-window-start win (or point (point)))))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index a90aba3..19f07a2 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1796,7 +1796,9 @@ is t." (gnus-summary-post-news) - (use-local-map (copy-keymap (current-local-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (current-local-map)) + (use-local-map map)) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 7925cff..6f99327 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -246,6 +246,7 @@ call it with the value of the `gnus-data' text property." (let* ((pos (event-closest-point event)) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) + (goto-char pos) (when fun (funcall fun data)))) @@ -386,6 +387,7 @@ call it with the value of the `gnus-data' text property." (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) + (setq gnus-mouse-3 [button3]) (setq gnus-widget-button-keymap widget-button-keymap) (unless (memq 'underline (face-list)) @@ -432,7 +434,7 @@ call it with the value of the `gnus-data' text property." (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (indirect-function func))) - (if (compiled-function-p fval) + (if (byte-code-function-p fval) (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) @@ -463,7 +465,8 @@ call it with the value of the `gnus-data' text property." (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) (fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) - + (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) @@ -792,6 +795,17 @@ XEmacs compatibility workaround." (defun gnus-xmas-annotation-in-region-p (b e) (map-extents (lambda (e u) t) nil b e nil nil 'mm t)) +(defun gnus-xmas-mime-button-menu (event) + "Construct a context-sensitive menu of MIME commands." + (interactive "e") + (let ((response (get-popup-menu-response + `("MIME Part" + ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) + gnus-mime-button-commands))))) + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (funcall (event-function response) (event-object response)))) + (provide 'gnus-xmas) ;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index 54163e2..792404c 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -245,12 +245,16 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Various Various") :group 'gnus) +(defgroup gnus-mime nil + "Variables for controlling the Gnus MIME interface." + :group 'gnus) + (defgroup gnus-exit nil "Exiting gnus." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.34" +(defconst gnus-version-number "0.39" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -360,6 +364,72 @@ be set in `.emacs' instead." ())) "Level 3 empty newsgroup face.") +(defface gnus-group-news-4-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 4 newsgroup face.") + +(defface gnus-group-news-4-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 4 empty newsgroup face.") + +(defface gnus-group-news-5-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 5 newsgroup face.") + +(defface gnus-group-news-5-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 5 empty newsgroup face.") + +(defface gnus-group-news-6-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 6 newsgroup face.") + +(defface gnus-group-news-6-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 6 empty newsgroup face.") + (defface gnus-group-news-low-face '((((class color) (background dark)) @@ -1482,7 +1552,6 @@ want." '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") (gnus-server-mode "(gnus)The Server Buffer") (gnus-browse-mode "(gnus)Browse Foreign Server") (gnus-tree-mode "(gnus)Tree Display")) @@ -1577,9 +1646,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") message-send-and-exit message-yank-original) ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("rmailout" rmail-output) + ("rmailout" rmail-output rmail-output-to-rmail-file) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message rmail-output-to-rmail-file) + rmail-show-message) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t @@ -1647,7 +1716,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over) + gnus-uu-mark-over gnus-uu-post-news) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -1745,6 +1814,7 @@ with some simple extensions. %a Extracted name of the poster (string) %A Extracted address of the poster (string) %F Contents of the From: header (string) +%f Contents of the From: or To: headers (string) %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 2ef7d61..713b14a 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -102,7 +102,7 @@ (let (c) (ietf-drums-init string) (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (cond ((eq c ?\") (forward-sexp 1)) @@ -118,7 +118,7 @@ (ietf-drums-init string) (let (c) (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (cond ((eq c ?\") (forward-sexp 1)) @@ -136,7 +136,7 @@ (ietf-drums-init string) (let (result c) (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (cond ((eq c ?\") (forward-sexp 1)) @@ -155,7 +155,7 @@ (let (display-name mailbox c display-string) (ietf-drums-init string) (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (cond ((or (eq c ? ) (eq c ?\t)) @@ -196,7 +196,7 @@ (let ((beg (point)) pairs c) (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (cond ((memq c '(?\" ?< ?\()) (forward-sexp 1)) diff --git a/lisp/lpath.el b/lisp/lpath.el index 1b3af0a..110cb42 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -34,7 +34,7 @@ set-buffer-multibyte find-non-ascii-charset-region char-charset mule-write-region-no-coding-system - find-charset-region base64-decode-string + find-charset-region find-coding-systems-region get-charset-property coding-system-get w3-region rmail-summary-exists rmail-select-summary @@ -69,7 +69,7 @@ mm-copy-tree url-view-url w3-prepare-buffer mule-write-region-no-coding-system char-int annotationp delete-annotation make-image-specifier - make-annotation base64-decode-string base64-encode-region + make-annotation w3-do-setup w3-region rmail-summary-exists rmail-select-summary rmail-update-summary ))) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 7caa74f..6e85b13 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -117,7 +117,7 @@ (viewer . "maplay %s") (type . "audio/x-mpeg")) (".*" - (viewer . mm-view-sound-file) + (viewer . mailcap-save-binary-file) (test . (or (featurep 'nas-sound) (featurep 'native-sound))) (type . "audio/*")) @@ -272,11 +272,12 @@ not.") (defun mailcap-save-binary-file () (goto-char (point-min)) - (let ((file (read-file-name - "Filename to save as: " - (or mailcap-download-directory "~/"))) - (require-final-newline nil)) - (write-region (point-min) (point-max) file) + (unwind-protect + (let ((file (read-file-name + "Filename to save as: " + (or mailcap-download-directory "~/"))) + (require-final-newline nil)) + (write-region (point-min) (point-max) file)) (kill-buffer (current-buffer)))) (defun mailcap-maybe-eval () @@ -322,7 +323,8 @@ If FORCE, re-parse even if already parsed." fname) (while fnames (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname)) + (if (and (file-exists-p fname) (file-readable-p fname) + (file-regular-p fname)) (mailcap-parse-mailcap (car fnames))) (setq fnames (cdr fnames)))) (setq mailcap-parsed-p t))) @@ -359,7 +361,7 @@ If FORCE, re-parse even if already parsed." (downcase-region save-pos (point)) (setq minor (cond - ((= ?* (or (char-after save-pos) 0)) ".*") + ((eq ?* (or (char-after save-pos) 0)) ".*") ((= (point) save-pos) ".*") (t (buffer-substring save-pos (point))))) (skip-chars-forward "; \t\n") @@ -369,7 +371,7 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward "; \t\n") (setq save-pos (point)) (skip-chars-forward "^;\n") - (if (= (or (char-after save-pos) 0) ?') + (if (eq (or (char-after save-pos) 0) ?') (setq viewer (progn (narrow-to-region (1+ save-pos) (point)) (goto-char (point-min)) @@ -410,7 +412,7 @@ If FORCE, re-parse even if already parsed." (downcase-region name-pos (point)) (setq name (buffer-substring name-pos (point))) (skip-chars-forward " \t\n") - (if (/= (or (char-after (point)) 0) ?=) ; There is no value + (if (not (eq (or (char-after (point)) 0) ?=)) ; There is no value (setq value nil) (skip-chars-forward " \t\n=") (setq val-pos (point)) @@ -424,7 +426,7 @@ If FORCE, re-parse even if already parsed." (error (goto-char (point-max))))) (while (not done) (skip-chars-forward "^;") - (if (= (or (char-after (1- (point))) 0) ?\\ ) + (if (eq (or (char-after (1- (point))) 0) ?\\ ) (progn (subst-char-in-region (1- (point)) (point) ?\\ ? ) (skip-chars-forward ";")) @@ -440,7 +442,9 @@ If FORCE, re-parse even if already parsed." (test (assq 'test info)) ; The test clause ) (setq status (and test (split-string (cdr test) " "))) - (if (and (assoc "needsx11" info) (not (getenv "DISPLAY"))) + (if (and (or (assoc "needsterm" info) + (assoc "needsx11" info)) + (not (getenv "DISPLAY"))) (setq status nil) (cond ((and (equal (nth 0 status) "test") @@ -632,7 +636,7 @@ this type is returned." (if (mailcap-viewer-passes-test (car viewers) info) (setq passed (cons (car viewers) passed))) (setq viewers (cdr viewers))) - (setq passed (sort passed 'mailcap-viewer-lessp)) + (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) diff --git a/lisp/mailheader.el b/lisp/mailheader.el index 5e2b097..6eb5669 100644 --- a/lisp/mailheader.el +++ b/lisp/mailheader.el @@ -60,7 +60,7 @@ that name." start end) (while (and (setq start (point)) (> (skip-chars-forward "^\0- :") 0) - (= (following-char) ?:) + (eq (char-after) ?:) (setq end (point)) (progn (forward-char) (> (skip-chars-forward " \t") 0))) diff --git a/lisp/message.el b/lisp/message.el index f3c7de3..9eadf92 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -212,7 +212,7 @@ included. Organization, Lines and User-Agent are optional." :group 'message-headers :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -646,10 +646,10 @@ the prefix.") The default is `abbrev', which uses mailabbrev. nil switches mail aliases off.") -(defcustom message-autosave-directory +(defcustom message-auto-save-directory (nnheader-concat message-directory "drafts/") - "*Directory where Message autosaves buffers if Gnus isn't running. -If nil, Message won't autosave." + "*Directory where Message auto-saves buffers if Gnus isn't running. +If nil, Message won't auto-save." :group 'message-buffers :type 'directory) @@ -997,12 +997,12 @@ The cdr of ech entry is a function for applying the face to a region.") (not paren)))) (push (buffer-substring beg (point)) elems) (setq beg (match-end 0))) - ((= (following-char) ?\") + ((eq (char-after) ?\") (setq quoted (not quoted))) - ((and (= (following-char) ?\() + ((and (eq (char-after) ?\() (not quoted)) (setq paren t)) - ((and (= (following-char) ?\)) + ((and (eq (char-after) ?\)) (not quoted)) (setq paren nil)))) (nreverse elems))))) @@ -1227,7 +1227,8 @@ Point is left at the beginning of the narrowed-to region." (defvar message-mode-map nil) (unless message-mode-map - (setq message-mode-map (copy-keymap text-mode-map)) + (setq message-mode-map (make-keymap)) + (set-keymap-parent message-mode-map text-mode-map) (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) @@ -1327,6 +1328,7 @@ C-c C-w message-insert-signature (insert `message-signature-file' file). C-c C-y message-yank-original (insert current message, if any). C-c C-q message-fill-yanked-message (fill what was yanked). C-c C-e message-elide-region (elide the text between point and mark). +C-c C-v message-delete-not-region (remove the text outside the region). C-c C-z message-kill-to-signature (kill the text up to the signature). C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) @@ -1503,7 +1505,8 @@ With the prefix argument FORCE, insert the header anyway." (let ((co (message-fetch-reply-field "mail-copies-to"))) (when (and (null force) co - (equal (downcase co) "never")) + (or (equal (downcase co) "never") + (equal (downcase co) "nobody"))) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") (mail-fetch-field "to") @@ -1945,46 +1948,42 @@ or error messages, and inform user. Otherwise any failure is reported in a message back to the user from the mailer." (interactive "P") - ;; Disabled test. - (when (or (buffer-modified-p) - (message-check-element 'unchanged) - (y-or-n-p "No changes in the buffer; really send? ")) - ;; Make it possible to undo the coming changes. - (undo-boundary) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) - (run-hooks 'message-send-hook) - (message "Sending...") - (let ((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))) - (when (and success sent) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete autosave. - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t) - (message-disassociate-draft) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t)))) + ;; Make it possible to undo the coming changes. + (undo-boundary) + (let ((inhibit-read-only t)) + (put-text-property (point-min) (point-max) 'read-only nil)) + (message-fix-before-sending) + (run-hooks 'message-send-hook) + (message "Sending...") + (let ((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))) + (when (and success sent) + (message-do-fcc) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) + (run-hooks 'message-sent-hook) + (message "Sending...done") + ;; Mark the buffer as unmodified and delete auto-save. + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t) + (message-disassociate-draft) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t))) (defun message-send-via-mail (arg) "Send the current message via mail." @@ -1994,6 +1993,15 @@ the user from the mailer." "Send the current message via news." (funcall message-send-news-function arg)) +(defmacro message-check (type &rest forms) + "Eval FORMS if TYPE is to be checked." + `(or (message-check-element ,type) + (save-excursion + ,@forms))) + +(put 'message-check 'lisp-indent-function 1) +(put 'message-check 'edebug-form-spec '(form body)) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. @@ -2266,15 +2274,6 @@ to find out how to use this." ;;; Header generation & syntax checking. ;;; -(defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - -(put 'message-check 'lisp-indent-function 1) -(put 'message-check 'edebug-form-spec '(form body)) - (defun message-check-element (type) "Returns non-nil if this type is not to be checked." (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) @@ -2548,7 +2547,7 @@ to find out how to use this." (while (not (eobp)) (when (not (looking-at "[ \t\n]")) (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (following-char)))) + (char-after)))) (forward-char 1))) sum)) @@ -2638,12 +2637,15 @@ If NOW, use that time instead." (sign "+")) (when (< zone 0) (setq sign "")) - ;; We do all of this because XEmacs doesn't have the %z spec. - (concat (format-time-string - "%d %b %Y %H:%M:%S " (or now (current-time))) - (format "%s%02d%02d" - sign (/ zone 3600) - (% zone 3600))))) + (concat + (format-time-string "%d" now) + ;; The month name of the %b spec is locale-specific. Pfff. + (format " %s " + (capitalize (car (rassoc (nth 4 (decode-time now)) + parse-time-months)))) + (format-time-string "%Y %H:%M:%S " now) + ;; We do all of this because XEmacs doesn't have the %z spec. + (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600))))) (defun message-make-message-id () "Make a unique Message-ID." @@ -2945,7 +2947,7 @@ Headers already prepared in the buffer are not modified." (progn ;; The header was found. We insert a space after the ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) + (if (/= (char-after) ? ) (insert " ") (forward-char 1)) ;; Find out whether the header is empty... (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. @@ -3054,7 +3056,7 @@ Headers already prepared in the buffer are not modified." (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) + (if (or (eq (char-after) ?,) (eobp)) (when (not quoted) (if (and (> (current-column) 78) @@ -3119,7 +3121,7 @@ Headers already prepared in the buffer are not modified." (search-backward ":" ) (widen) (forward-char 1) - (if (= (following-char) ? ) + (if (eq (char-after) ? ) (forward-char 1) (insert " "))) (t @@ -3254,12 +3256,12 @@ Headers already prepared in the buffer are not modified." (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory + (when message-auto-save-directory (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) (setq buffer-file-name (expand-file-name "*message*" - message-autosave-directory)) + message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime))) @@ -3341,10 +3343,12 @@ OTHER-HEADERS is an alist of header/value pairs." ;; Handle special values of Mail-Copies-To. (when mct - (cond ((equal (downcase mct) "never") + (cond ((or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) (setq never-mct t) (setq mct nil)) - ((equal (downcase mct) "always") + ((or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) (setq mct (or reply-to from))))) (unless follow-to @@ -3511,8 +3515,10 @@ responses here are directed to other newsgroups.")) `((References . ,(concat (or references "") (and references " ") (or message-id ""))))) ,@(when (and mct - (not (equal (downcase mct) "never"))) - (list (cons 'Cc (if (equal (downcase mct) "always") + (not (or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")))) + (list (cons 'Cc (if (or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) (or reply-to from "") mct))))) @@ -3893,7 +3899,7 @@ which specify the range to operate on." (goto-char (min start end)) (while (< (point) end1) (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) + (insert (char-after) "\b")) (forward-char 1))))) ;;;###autoload @@ -3907,7 +3913,7 @@ which specify the range to operate on." (move-marker end1 (max start end)) (goto-char (min start end)) (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) + (if (eq (char-after) (char-after (- (point) 2))) (delete-char -2)))))) (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 044f52c..b7611c3 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -26,7 +26,8 @@ (eval-and-compile (or (fboundp 'base64-decode-region) - (autoload 'base64-decode-region "base64" nil t))) + (require 'base64))) + (require 'mm-util) (require 'rfc2047) (require 'qp) @@ -61,7 +62,7 @@ If no encoding was done, nil is returned." (not (mm-coding-system-equal mime-charset buffer-file-coding-system))) (while (not (eobp)) - (if (eq (char-charset (following-char)) 'ascii) + (if (eq (char-charset (char-after)) 'ascii) (when start (save-restriction (narrow-to-region start (point)) @@ -113,12 +114,17 @@ If no encoding was done, nil is returned." ) ((eq encoding 'x-uuencode) (condition-case () - (uu-decode-region (point-min) (point-max)) + (uudecode-decode-region (point-min) (point-max)) + (error nil))) + ((functionp encoding) + (condition-case () + (funcall encoding (point-min) (point-max)) (error nil))) (t - (error "Can't decode encoding %s" encoding)))) + (message "Unknown encoding %s; defaulting to 8bit" encoding) + ))) -(defun mm-decode-body (charset encoding) +(defun mm-decode-body (charset &optional encoding) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (setq charset (or charset rfc2047-default-charset)) @@ -130,6 +136,7 @@ The characters in CHARSET should then be decoded." (when (and charset (setq mule-charset (mm-charset-to-coding-system charset)) buffer-file-coding-system + enable-multibyte-characters (or (not (eq mule-charset 'ascii)) (setq mule-charset rfc2047-default-charset))) (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 617d331..6344209 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -28,6 +28,23 @@ (require 'mailcap) (require 'mm-bodies) +;;; Convenience macros. + +(defmacro mm-handle-buffer (handle) + `(nth 0 ,handle)) +(defmacro mm-handle-type (handle) + `(nth 1 ,handle)) +(defmacro mm-handle-encoding (handle) + `(nth 2 ,handle)) +(defmacro mm-handle-undisplayer (handle) + `(nth 3 ,handle)) +(defmacro mm-handle-set-undisplayer (handle function) + `(setcar (nthcdr 3 ,handle) ,function)) +(defmacro mm-handle-disposition (handle) + `(nth 4 ,handle)) +(defmacro mm-handle-description (handle) + `(nth 5 ,handle)) + (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image (featurep 'jpeg)) ("image/png" mm-inline-image (featurep 'png)) @@ -39,7 +56,7 @@ ("text/plain" mm-inline-text t) ("text/enriched" mm-inline-text t) ("text/richtext" mm-inline-text t) - ("text/html" mm-inline-text (featurep 'w3)) + ("text/html" mm-inline-text (locate-library "w3")) ("message/delivery-status" mm-inline-text t) ("audio/wav" mm-inline-audio (and (or (featurep 'nas-sound) (featurep 'native-sound)) @@ -51,10 +68,12 @@ (defvar mm-user-display-methods '(("image/.*" . inline) - ("text/.*" . inline))) + ("text/.*" . inline) + ("message/delivery-status" . inline))) (defvar mm-user-automatic-display - '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif")) + '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif" + "message/delivery-status" "multipart/.*")) (defvar mm-alternative-precedence '("text/plain" "text/enriched" "text/richtext" "text/html") @@ -69,23 +88,6 @@ (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) -;;; Convenience macros. - -(defmacro mm-handle-buffer (handle) - `(nth 0 ,handle)) -(defmacro mm-handle-type (handle) - `(nth 1 ,handle)) -(defmacro mm-handle-encoding (handle) - `(nth 2 ,handle)) -(defmacro mm-handle-undisplayer (handle) - `(nth 3 ,handle)) -(defmacro mm-handle-set-undisplayer (handle function) - `(setcar (nthcdr 3 ,handle) ,function)) -(defmacro mm-handle-disposition (handle) - `(nth 4 ,handle)) -(defmacro mm-handle-description (handle) - `(nth 5 ,handle)) - ;;; The functions. (defun mm-dissect-buffer (&optional no-strict-mime) @@ -112,7 +114,7 @@ result (cond ((equal type "multipart") - (mm-dissect-multipart ctl)) + (cons (car ctl) (mm-dissect-multipart ctl))) (t (mm-dissect-singlepart ctl @@ -130,7 +132,7 @@ (defun mm-dissect-singlepart (ctl cte &optional force cdl description) (when (or force (not (equal "text/plain" (car ctl)))) - (let ((res (list (list (mm-copy-to-buffer) ctl cte nil cdl description)))) + (let ((res (list (mm-copy-to-buffer) ctl cte nil cdl description))) (push (car res) mm-dissection-list) res))) @@ -156,14 +158,14 @@ (save-excursion (save-restriction (narrow-to-region start (point)) - (setq parts (nconc (mm-dissect-buffer t) parts))))) + (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) (forward-line 2) (setq start (point))) (when start (save-excursion (save-restriction (narrow-to-region start end) - (setq parts (nconc (mm-dissect-buffer t) parts))))) + (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) (nreverse parts))) (defun mm-copy-to-buffer () @@ -186,7 +188,7 @@ "Display the MIME part represented by HANDLE." (save-excursion (mailcap-parse-mailcaps) - (if (mm-handle-undisplayer handle) + (if (mm-handle-displayed-p handle) (mm-remove-part handle) (let* ((type (car (mm-handle-type handle))) (method (mailcap-mime-info type)) @@ -198,8 +200,13 @@ (when (or user-method method (not no-default)) - (mm-display-external - handle (or user-method method 'mailcap-save-binary-file)))))))) + (if (and (not user-method) + (not method) + (equal "text" (car (split-string type)))) + (mm-insert-inline handle (mm-get-part handle)) + (mm-display-external + handle (or user-method method + 'mailcap-save-binary-file))))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." @@ -209,12 +216,24 @@ (mm-handle-encoding handle) (car (mm-handle-type handle))) (if (functionp method) (let ((cur (current-buffer))) - (switch-to-buffer (generate-new-buffer "*mm*")) + (if (eq method 'mailcap-save-binary-file) + (progn + (set-buffer (generate-new-buffer "*mm*")) + (setq method nil)) + (let ((win (get-buffer-window cur t))) + (when win + (select-window win))) + (switch-to-buffer (generate-new-buffer "*mm*"))) (buffer-disable-undo) (mm-set-buffer-file-coding-system 'no-conversion) (insert-buffer-substring cur) - (funcall method) - (mm-handle-set-undisplayer handle (current-buffer))) + (message "Viewing with %s" method) + (let ((mm (current-buffer))) + (unwind-protect + (if method + (funcall method) + (mm-save-part handle)) + (mm-handle-set-undisplayer handle mm)))) (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory))) (filename (mail-content-type-get (mm-handle-disposition handle) 'filename)) @@ -231,53 +250,89 @@ (setq file (make-temp-name (expand-file-name "mm." dir)))) (write-region (point-min) (point-max) file nil 'nomesg nil 'no-conversion) - (setq process - (if needsterm - (start-process "*display*" nil - "xterm" - "-e" shell-file-name "-c" - (format method - (mm-quote-arg file))) - (start-process "*display*" (generate-new-buffer "*mm*") - shell-file-name - "-c" (format method - (mm-quote-arg file))))) - (mm-handle-set-undisplayer handle (cons file process)) + (message "Viewing with %s" method) + (unwind-protect + (setq process + (if needsterm + (start-process "*display*" nil + "xterm" + "-e" shell-file-name "-c" + (format method + (mm-quote-arg file))) + (start-process "*display*" (generate-new-buffer "*mm*") + shell-file-name + "-c" (format method + (mm-quote-arg file))))) + (mm-handle-set-undisplayer handle (cons file process))) (message "Displaying %s..." (format method file)))))) +(defun mm-remove-parts (handles) + "Remove the displayed MIME parts represented by HANDLE." + (if (and (listp handles) + (bufferp (car handles))) + (mm-remove-part handles) + (let (handle) + (while (setq handle (pop handles)) + (cond + ((stringp handle) + ) + ((and (listp handle) + (stringp (car handle))) + (mm-remove-parts (cdr handle))) + (t + (mm-remove-part handle))))))) + +(defun mm-destroy-parts (handles) + "Remove the displayed MIME parts represented by HANDLE." + (if (and (listp handles) + (bufferp (car handles))) + (mm-destroy-part handles) + (let (handle) + (while (setq handle (pop handles)) + (cond + ((stringp handle) + ) + ((and (listp handle) + (stringp (car handle))) + (mm-destroy-parts (cdr handle))) + (t + (mm-destroy-part handle))))))) + (defun mm-remove-part (handle) "Remove the displayed MIME part represented by HANDLE." - (let ((object (mm-handle-undisplayer handle))) - (condition-case () - (cond - ;; Internally displayed part. - ((mm-annotationp object) - (delete-annotation object)) - ((or (functionp object) - (and (listp object) - (eq (car object) 'lambda))) - (funcall object)) - ;; Externally displayed part. - ((consp object) - (condition-case () - (delete-file (car object)) - (error nil)) - (condition-case () - (delete-directory (file-name-directory (car object))) - (error nil)) - (condition-case () - (kill-process (cdr object)) - (error nil))) - ((bufferp object) - (when (buffer-live-p object) - (kill-buffer object)))) - (error nil)) - (mm-handle-set-undisplayer handle nil))) + (when (listp handle) + (let ((object (mm-handle-undisplayer handle))) + (condition-case () + (cond + ;; Internally displayed part. + ((mm-annotationp object) + (delete-annotation object)) + ((or (functionp object) + (and (listp object) + (eq (car object) 'lambda))) + (funcall object)) + ;; Externally displayed part. + ((consp object) + (condition-case () + (delete-file (car object)) + (error nil)) + (condition-case () + (delete-directory (file-name-directory (car object))) + (error nil)) + (condition-case () + (kill-process (cdr object)) + (error nil))) + ((bufferp object) + (when (buffer-live-p object) + (kill-buffer object)))) + (error nil)) + (mm-handle-set-undisplayer handle nil)))) (defun mm-display-inline (handle) (let* ((type (car (mm-handle-type handle))) (function (cadr (assoc type mm-inline-media-tests)))) - (funcall function handle))) + (funcall function handle) + (goto-char (point-min)))) (defun mm-inlinable-p (type) "Say whether TYPE can be displayed inline." @@ -320,10 +375,15 @@ This overrides entries in the mailcap file." (defun mm-destroy-part (handle) "Destroy the data structures connected to HANDLE." - (mm-remove-part handle) - (when (buffer-live-p (mm-handle-buffer handle)) - (kill-buffer (mm-handle-buffer handle)))) - + (when (listp handle) + (mm-remove-part handle) + (when (buffer-live-p (mm-handle-buffer handle)) + (kill-buffer (mm-handle-buffer handle))))) + +(defun mm-handle-displayed-p (handle) + "Say whether HANDLE is displayed or not." + (mm-handle-undisplayer handle)) + (defun mm-quote-arg (arg) "Return a version of ARG that is safe to evaluate in a shell." (let ((pos 0) new-pos accum) @@ -404,10 +464,14 @@ This overrides entries in the mailcap file." (while (setq p (pop prec)) (setq h handles) (while h - (setq type (car (mm-handle-type (car h)))) + (setq type + (if (stringp (caar h)) + (caar h) + (car (mm-handle-type (car h))))) (when (and (equal p type) (mm-automatic-display-p type) - (or (not (mm-handle-disposition (car h))) + (or (stringp (caar h)) + (not (mm-handle-disposition (car h))) (equal (car (mm-handle-disposition (car h))) "inline"))) (setq result (car h) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index a24d3a8..79454d0 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -168,9 +168,15 @@ used as the line break code type of the coding system." (defsubst mm-enable-multibyte () "Enable multibyte in the current buffer." - (when (fboundp 'set-buffer-multibyte) + (when (and (fboundp 'set-buffer-multibyte) + (default-value enable-multibyte-characters)) (set-buffer-multibyte t))) +(defsubst mm-disable-multibyte () + "Disable multibyte in the current buffer." + (when (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil))) + (defun mm-mime-charset (charset b e) (if (fboundp 'coding-system-get) (or @@ -201,20 +207,21 @@ See also `with-temp-file' and `with-output-to-string'." (with-temp-buffer ,@forms) (let ((,multibyte (default-value enable-multibyte-characters)) ,temp-buffer) - (setq-default enable-multibyte-characters nil) - (setq ,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp*"))) (unwind-protect - (with-current-buffer ,temp-buffer - (let (buffer-file-coding-system) - ,@forms)) - (and (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer)) + (progn + (setq-default enable-multibyte-characters nil) + (setq ,temp-buffer + (get-buffer-create (generate-new-buffer-name " *temp*"))) + (unwind-protect + (with-current-buffer ,temp-buffer + (let (buffer-file-coding-system) + ,@forms)) + (and (buffer-name ,temp-buffer) + (kill-buffer ,temp-buffer)))) (setq-default enable-multibyte-characters ,multibyte)))))) (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) - (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el new file mode 100644 index 0000000..6a82940 --- /dev/null +++ b/lisp/mm-uu.el @@ -0,0 +1,153 @@ +;;; mm-uu.el -- Return uu stuffs as mm handles +;; Copyright (c) 1998 by Shenghuo Zhu + +;; Author: Shenghuo Zhu +;; $Revision: 1.1.1.1 $ +;; Keywords: news postscript uudecode binhex shar + +;; This file is not part of GNU Emacs, but the same permissions +;; apply. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; + +;;; Code: + +(eval-and-compile + (autoload 'binhex-decode-region "binhex") + (autoload 'binhex-decode-region-external "binhex") + (autoload 'uudecode-decode-region "uudecode") + (autoload 'uudecode-decode-region-external "uudecode")) + +(defun mm-uu-copy-to-buffer (from to) + "Copy the contents of the current buffer to a fresh buffer." + (save-excursion + (let ((obuf (current-buffer))) + (set-buffer (generate-new-buffer " *mm-uu*")) + (insert-buffer-substring obuf from to) + (current-buffer)))) + +;;; postscript + +(defconst mm-uu-postscript-begin-line "^%!PS-") +(defconst mm-uu-postscript-end-line "^%%EOF$") + +(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst mm-uu-uu-end-line "^end[ \t]*$") +(defvar mm-uu-decode-function 'uudecode-decode-region) + +(defconst mm-uu-binhex-begin-line + "^:...............................................................$") +(defconst mm-uu-binhex-end-line ":$") +(defvar mm-uu-binhex-decode-function 'binhex-decode-region) + +(defconst mm-uu-shar-begin-line "^#! */bin/sh") +(defconst mm-uu-shar-end-line "^exit 0") + +(defvar mm-uu-begin-line + (concat mm-uu-postscript-begin-line "\\|" + mm-uu-uu-begin-line "\\|" + mm-uu-binhex-begin-line "\\|" + mm-uu-shar-begin-line)) + +(defvar mm-uu-identifier-alist + '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar))) + +;;;### autoload + +(defun mm-uu-dissect () + "Dissect the current buffer and return a list of uu handles." + (save-excursion + (save-restriction + (mail-narrow-to-head) + (goto-char (point-max))) + (forward-line) + (let ((text-start (point)) start-char end-char + type file-name end-line result) + (while (re-search-forward mm-uu-begin-line nil t) + (beginning-of-line) + (setq start-char (point)) + (forward-line) ;; in case of failure + (setq type (cdr (assq (aref (match-string 0) 0) + mm-uu-identifier-alist))) + (setq file-name + (if (eq type 'uu) + (and (match-string 1) + (let ((nnheader-file-name-translation-alist + '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + (nnheader-translate-file-chars (match-string 1)))))) + (setq end-line (symbol-value + (intern (concat "mm-uu-" (symbol-name type) + "-end-line")))) + (when (re-search-forward end-line nil t) + (forward-line) + (setq end-char (point)) + (when (or (not (eq type 'binhex)) + (setq file-name + (condition-case nil + (binhex-decode-region start-char end-char t) + (error nil)))) + (if (> start-char text-start) + (push + (list (mm-uu-copy-to-buffer text-start start-char) + '("text/plain") nil nil nil nil) + result)) + (push + (cond + ((eq type 'postscript) + (list (mm-uu-copy-to-buffer start-char end-char) + '("application/postscript") nil nil nil nil)) + ((eq type 'uu) + (list (mm-uu-copy-to-buffer start-char end-char) + (list (or (and file-name + (string-match "\\.[^\\.]+$" file-name) + (mailcap-extension-to-mime + (match-string 0 file-name))) + "application/octet-stream")) + mm-uu-decode-function nil + (if (and file-name (not (equal file-name ""))) + (list "attachment" (cons 'filename file-name))) + file-name)) + ((eq type 'binhex) + (list (mm-uu-copy-to-buffer start-char end-char) + (list (or (and file-name + (string-match "\\.[^\\.]+$" file-name) + (mailcap-extension-to-mime + (match-string 0 file-name))) + "application/octet-stream")) + mm-uu-binhex-decode-function nil + (if (and file-name (not (equal file-name ""))) + (list "attachment" (cons 'filename file-name))) + file-name)) + ((eq type 'shar) + (list (mm-uu-copy-to-buffer start-char end-char) + '("application/x-shar") nil nil nil nil))) + result) + (setq text-start end-char)))) + (when result + (if (> (point-max) (1+ text-start)) + (push + (list (mm-uu-copy-to-buffer text-start (point-max)) + '("text/plain") nil nil nil nil) + result)) + (setq result (cons "multipart/mixed" (nreverse result)))) + result))) + +(provide 'mm-uu) + +;;; mm-uu.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 14ec63b..2d2a1d6 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -26,6 +26,7 @@ (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) +(require 'mm-decode) ;;; ;;; Functions for displaying various formats inline diff --git a/lisp/nnagent.el b/lisp/nnagent.el index e77eb72..15fa72c 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -73,7 +73,8 @@ (ftp-error (setq err (format "%s" arg))))) (nnagent-close-server) (nnheader-report - 'nnagent (or err "No such file or directory: %s" dir))) + 'nnagent (or err + (format "No such file or directory: %s" dir)))) ((not (file-directory-p (file-truename dir))) (nnagent-close-server) (nnheader-report 'nnagent "Not a directory: %s" dir)) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 0fe68e4..2c11c48 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -188,7 +188,7 @@ from the document.") (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry))) (goto-char (point-max)) - (unless (= (char-after (1- (point))) ?\n) + (unless (eq (char-after (1- (point))) ?\n) (insert "\n")) (insert (format "Lines: %d\n" (nth 4 entry))) (insert ".\n"))) @@ -455,7 +455,7 @@ from the document.") (when (and limit (re-search-forward (concat "\ -^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*" +^Content-Type:[ \t]*multipart/[a-z]+ *;\\(.*;\\)*" "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]") limit t)) t))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 41c064e..302924d 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -140,14 +140,23 @@ on your system, you could say something like: "Set article xref of HEADER to xref." `(aset ,header 8 ,xref)) +(defmacro mail-header-extra (header) + "Return the extra headers in HEADER." + `(aref ,header 9)) + +(defmacro mail-header-set-extra (header extra) + "Set the extra headers in HEADER to EXTRA." + `(aset ,header 9 ',extra)) + (defun make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) + (make-vector 10 init)) (defun make-full-mail-header (&optional number subject from date id - references chars lines xref) + references chars lines xref + extra) "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref)) + (vector number subject from date id references chars lines xref extra)) ;; fake message-ids: generation and detection @@ -257,7 +266,20 @@ on your system, you could say something like: (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) + (nnheader-header-value))) + + ;; Extra. + (when nnmail-extra-headers + (let ((extra nnmail-extra-headers) + out) + (while extra + (goto-char p) + (when (search-forward + (concat "\n" (symbol-name (car extra)) ": ") nil t) + (push (cons (car extra) (nnheader-header-value)) + out)) + (pop extra)) + out)))) (when naked (goto-char (point-min)) (delete-char 1))))) @@ -270,14 +292,12 @@ on your system, you could say something like: (defmacro nnheader-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 (let ((num (ignore-errors (read (current-buffer))))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) -;; (defvar nnheader-none-counter 0) - (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) (vector @@ -290,7 +310,7 @@ on your system, you could say something like: (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) + (if (eq (char-after) ?\n) nil (nnheader-nov-field)) ; misc ))) @@ -310,8 +330,14 @@ on your system, you could say something like: (insert "\t") (princ (or (mail-header-lines header) 0) (current-buffer)) (insert "\t") - (when (mail-header-xref header) + (when (or (mail-header-xref header) + (mail-header-extra header)) (insert "Xref: " (mail-header-xref header) "\t")) + (when (mail-header-extra header) + (let ((extra (mail-header-extra header))) + (while extra + (insert (symbol-name (caar extra)) + ": " (cdar extra) "\t")))) (insert "\n")) (defun nnheader-insert-article-line (article) @@ -446,7 +472,7 @@ the line could be found." nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) - (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") + (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) @@ -715,7 +741,7 @@ If FILE, find the \".../etc/PACKAGE\" file instead." (when (string-match (car ange-ftp-path-format) path) (ange-ftp-re-read-dir path))))) -(defvar nnheader-file-coding-system 'raw-text +(defvar nnheader-file-coding-system 'no-conversion "Coding system used in file backends of Gnus.") (defun nnheader-insert-file-contents (filename &optional visit beg end replace) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index f3eba42..5f43048 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -241,6 +241,13 @@ to be moved to." :group 'nnmail-retrieve :type 'string) +(defcustom nnmail-movemail-args nil + "*Extra arguments to give to `nnmail-movemail-program' to move mail from the inbox. +The default is nil" + :group 'nnmail-files + :group 'nnmail-retrieve + :type 'string) + (defcustom nnmail-pop-password-required nil "*Non-nil if a password is required when reading mail using POP." :group 'nnmail-retrieve @@ -442,6 +449,11 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) +(defcustom nnmail-extra-headers nil + "*Extra headers to parse." + :group 'nnmail + :type '(repeat symbol)) + ;;; Internal variables. (defvar nnmail-split-history nil @@ -597,7 +609,9 @@ parameter. It should return nil, `warn' or `delete'." nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password - (list nnmail-internal-password))))))) + (list nnmail-internal-password)) + (when nnmail-movemail-args + nnmail-movemail-args)))))) (push inbox nnmail-moved-inboxes) (if (and (not (buffer-modified-p errors)) (zerop result)) @@ -794,7 +808,7 @@ is a spool. If not using procmail, return GROUP." (when (and (or (bobp) (save-excursion (forward-line -1) - (= (following-char) ?\n))) + (eq (char-after) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -823,7 +837,7 @@ is a spool. If not using procmail, return GROUP." (when (and (or (bobp) (save-excursion (forward-line -1) - (= (following-char) ?\n))) + (eq (char-after) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -1693,11 +1707,11 @@ If ARGS, PROMPT is used as an argument to `format'." (goto-char (point-min)) (while (re-search-forward "[^ \t=]+" nil t) (setq name (match-string 0)) - (if (not (= (following-char) ?=)) + (if (not (eq (char-after) ?=)) ;; Implied "yes". (setq value "yes") (forward-char 1) - (if (not (= (following-char) ?\")) + (if (not (eq (char-after) ?\")) (if (not (looking-at "[^ \t]")) ;; Implied "no". (setq value "no") diff --git a/lisp/nnml.el b/lisp/nnml.el index 4f92163..8847ae3 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -225,6 +225,7 @@ all. This may very well take some time.") t) (deffoo nnml-request-create-group (group &optional server args) + (nnml-possibly-change-directory nil server) (nnmail-activate 'nnml) (cond ((assoc group nnml-group-alist) @@ -574,15 +575,9 @@ all. This may very well take some time.") (file-exists-p nnml-current-directory)))) (defun nnml-possibly-create-directory (group) - (let (dir dirs) - (setq dir (nnmail-group-pathname group nnml-directory)) - (while (not (file-directory-p dir)) - (push dir dirs) - (setq dir (file-name-directory (directory-file-name dir)))) - (while dirs - (make-directory (directory-file-name (car dirs))) - (nnheader-message 5 "Creating mail directory %s" (car dirs)) - (setq dirs (cdr dirs))))) + (let ((dir (nnmail-group-pathname group nnml-directory))) + (make-directory (directory-file-name dir) t) + (nnheader-message 5 "Creating mail directory %s" dir))) (defun nnml-save-mail (group-art) "Called narrowed to an article." diff --git a/lisp/nntp.el b/lisp/nntp.el index 228f50a..354dc72 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -396,7 +396,7 @@ If this variable is nil, which is the default, no timers are set.") (cond ;; A result that starts with a 2xx code is terminated by ;; a line with only a "." on it. - ((eq (following-char) ?2) + ((eq (char-after) ?2) (if (re-search-forward "\n\\.\r?\n" nil t) t nil)) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index a6e92f5..b1d4119 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -385,7 +385,7 @@ to virtual article number.") (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. - (while (= (char-after (1- (point))) ? ) + (while (eq (char-after (1- (point))) ? ) (forward-char -1) (delete-char 1)) @@ -417,7 +417,7 @@ to virtual article number.") ;; Ensure a trailing \t. (end-of-line) - (or (= (char-after (1- (point))) ?\t) + (or (eq (char-after (1- (point))) ?\t) (insert ?\t))) diff --git a/lisp/pop3.el b/lisp/pop3.el index 3362ed5..b90cd03 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,1997,1998 Free Software Foundation, Inc. ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 -;; Version: 1.3l +;; Version: 1.3m ;; 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.3m") (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil) "*POP3 maildrop.") @@ -111,7 +111,10 @@ 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 'no-conversion) ;; because FSF Emacs 20 + (coding-system-for-write 'no-conversion) ;; is st00pid + ) (save-excursion (set-buffer process-buffer) (erase-buffer) diff --git a/lisp/qp.el b/lisp/qp.el index e26f927..4671451 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -32,11 +32,11 @@ (save-excursion (goto-char from) (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) + (cond ((eq (char-after) ?\n) (delete-char -1) (delete-char 1)) ((and - (memq (following-char) quoted-printable-encoding-characters) + (memq (char-after) quoted-printable-encoding-characters) (memq (char-after (1+ (point))) quoted-printable-encoding-characters)) (subst-char-in-region @@ -64,13 +64,14 @@ matched by that regexp." (save-excursion (save-restriction (narrow-to-region from to) + (mm-encode-body) (goto-char (point-min)) (while (and (skip-chars-forward (or class "^\000-\007\013\015-\037\200-\377=")) (not (eobp))) (insert (prog1 - (upcase (format "=%x" (char-after (point)))) + (upcase (format "=%x" (char-after))) (delete-char 1)))) (when fold ;; Fold long lines. @@ -85,7 +86,7 @@ matched by that regexp." (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." - (with-temp-buffer + (mm-with-unibyte-buffer (insert string) (quoted-printable-encode-region (point-min) (point-max)) (buffer-string))) diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el new file mode 100644 index 0000000..b9a3015 --- /dev/null +++ b/lisp/rfc1843.el @@ -0,0 +1,172 @@ +;;; rfc1843.el --- HZ (rfc1843) decoding +;; Copyright (c) 1998 by Shenghuo Zhu + +;; Author: Shenghuo Zhu +;; $Revision: 1.1.1.1 $ +;; Keywords: news HZ +;; Time-stamp: + +;; This file is not part of GNU Emacs, but the same permissions +;; apply. + +;; 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: + +;; Usage: +;; (require 'rfc1843) +;; (rfc1843-gnus-setup) +;; +;; Test: +;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}") + +;;; Code: + +(require 'mm-util) + +(defvar rfc1843-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\(~}\\|$\\)") + +(defvar rfc1843-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\(~}\\|$\\)") + +(defvar rfc1843-hzp-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\ +[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") + +(defvar rfc1843-hzp-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\|\ +[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)") + +(defcustom rfc1843-decode-loosely nil + "Loosely check HZ encoding if non-nil. +When it is set non-nil, only buffers or strings with strictly +HZ-encoded are decoded." + :type 'boolean + :group 'gnus) + +(defcustom rfc1843-decode-hzp t + "HZ+ decoding support if non-nil. +HZ+ specification (also known as HZP) is to provide a standardized +7-bit representation of mixed Big5, GB, and ASCII text for convenient +e-mail transmission, news posting, etc. +The document of HZ+ 0.78 specification can be found at +ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" + :type 'boolean + :group 'gnus) + +(defcustom rfc1843-newsgroups-regexp "chinese\\|hz" + "Regexp of newsgroups in which might be HZ encoded." + :type 'string + :group 'gnus) + +(defun rfc1843-decode-region (from to) + "Decode HZ in the region between FROM and TO." + (interactive "r") + (let (str firstc) + (save-excursion + (goto-char from) + (if (or rfc1843-decode-loosely + (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp-strictly + rfc1843-word-regexp-strictly) to t)) + (save-restriction + (narrow-to-region from to) + (goto-char (point-min)) + (while (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp + rfc1843-word-regexp) (point-max) t) + (setq str (match-string 1)) + (setq firstc (aref str 0)) + (insert (mm-decode-coding-string + (rfc1843-decode + (prog1 + (substring str 1) + (delete-region (match-beginning 0) (match-end 0))) + firstc) + (if (eq firstc ?{) 'cn-gb-2312 'cn-big5)))) + (goto-char (point-min)) + (while (search-forward "~" (point-max) t) + (cond ((eq (char-after) ?\n) + (delete-char -1) + (delete-char 1)) + ((eq (char-after) ?~) + (delete-char 1))))))))) + +(defun rfc1843-decode-string (string) + "Decode HZ STRING and return the results." + (let ((m (mm-multibyte-p))) + (with-temp-buffer + (when m + (mm-enable-multibyte)) + (insert string) + (inline + (rfc1843-decode-region (point-min) (point-max))) + (buffer-string)))) + +(defun rfc1843-decode (word &optional firstc) + "Decode HZ WORD and return it" + (let ((i -1) (s (substring word 0)) v) + (if (or (not firstc) (eq firstc ?{)) + (while (< (incf i) (length s)) + (if (eq (setq v (aref s i)) ? ) nil + (aset s i (+ 128 v)))) + (while (< (incf i) (length s)) + (if (eq (setq v (aref s i)) ? ) nil + (setq v (+ (* 94 v) (aref s (1+ i)) -3135)) + (aset s i (+ (/ v 157) (if (eq firstc ?<) 201 161))) + (setq v (% v 157)) + (aset s (incf i) (+ v (if (< v 63) 64 98)))))) + s)) + +(defun rfc1843-decode-article-body () + "Decode HZ encoded text in the article body." + (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + gnus-newsgroup-name) + (save-excursion + (save-restriction + (message-narrow-to-head) + (goto-char (point-max)) + (widen) + (rfc1843-decode-region (point) (point-max)))))) + +(defvar rfc1843-old-gnus-decode-header-function nil) +(defvar gnus-decode-header-methods) +(defvar gnus-decode-encoded-word-methods) + +(defun rfc1843-gnus-setup () + "Setup HZ decoding for Gnus." + (require 'gnus-art) + (require 'gnus-sum) + (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t) + (setq gnus-decode-encoded-word-function + 'gnus-multi-decode-encoded-word-string + gnus-decode-header-function + 'gnus-multi-decode-header + gnus-decode-encoded-word-methods + (nconc gnus-decode-encoded-word-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-string))) + gnus-decode-header-methods + (nconc gnus-decode-header-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-region))))) + +(provide 'rfc1843) + +;;; rfc1843.el ends here diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index ea36d60..4c2a8d1 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -27,8 +27,8 @@ (eval-and-compile (eval '(unless (fboundp 'base64-decode-string) - (autoload 'base64-decode-string "base64") - (autoload 'base64-encode-region "base64" nil t)))) + (require 'base64)))) + (require 'qp) (require 'mm-util) (require 'ietf-drums) diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index e7a0417..cb0d53d 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -46,18 +46,18 @@ The list will be on the form (let ((table (copy-syntax-table ietf-drums-syntax-table))) (modify-syntax-entry ?\' "w" table) (set-syntax-table table)) - (setq c (following-char)) + (setq c (char-after)) (when (and (memq c ttoken) (not (memq c stoken))) (setq type (downcase (buffer-substring (point) (progn (forward-sexp 1) (point))))) ;; Do the params (while (not (eobp)) - (setq c (following-char)) + (setq c (char-after)) (unless (eq c ?\;) (error "Invalid header: %s" string)) (forward-char 1) - (setq c (following-char)) + (setq c (char-after)) (if (and (memq c ttoken) (not (memq c stoken))) (setq attribute @@ -66,21 +66,21 @@ The list will be on the form (buffer-substring (point) (progn (forward-sexp 1) (point)))))) (error "Invalid header: %s" string)) - (setq c (following-char)) + (setq c (char-after)) (setq encoded nil) (when (eq c ?*) (forward-char 1) - (setq c (following-char)) + (setq c (char-after)) (when (memq c ntoken) (setq number (string-to-number (buffer-substring (point) (progn (forward-sexp 1) (point))))) - (setq c (following-char)) + (setq c (char-after)) (when (eq c ?*) (setq encoded t) (forward-char 1) - (setq c (following-char))))) + (setq c (char-after))))) ;; See if we have any previous continuations. (when (and prev-attribute (not (eq prev-attribute attribute))) @@ -90,7 +90,7 @@ The list will be on the form (unless (eq c ?=) (error "Invalid header: %s" string)) (forward-char 1) - (setq c (following-char)) + (setq c (char-after)) (cond ((eq c ?\") (setq value diff --git a/lisp/score-mode.el b/lisp/score-mode.el index d625940..e2160eb 100644 --- a/lisp/score-mode.el +++ b/lisp/score-mode.el @@ -39,7 +39,8 @@ (defvar gnus-score-mode-map nil) (unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) + (setq gnus-score-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) diff --git a/lisp/smiley.el b/lisp/smiley.el index e6c13f7..ac1a65f 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -294,10 +294,10 @@ Mouse button3 - menu")) (save-excursion (goto-char start) (when (and (re-search-backward "[()]" nil t) - (= (following-char) ?\() + (eq (char-after) ?\() (goto-char end) (or (not (re-search-forward "[()]" nil t)) - (= (char-after (1- (point))) ?\())) + (eq (char-after (1- (point))) ?\())) t))) (defvar gnus-article-buffer) diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 2be3e6a..3d03c5d 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -2,27 +2,29 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1 $ +;; $Revision: 5.2 $ ;; Keywords: uudecode -;; This file is part of GNU Emacs. -;; +;; This file is not part of GNU Emacs, but the same permissions +;; apply. + ;; 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: +;;; Commentary: + ;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and ;; base64.el @@ -31,34 +33,37 @@ (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) -(defvar uu-decoder-program "uudecode" +(defvar uudecode-decoder-program "uudecode" "*Non-nil value should be a string that names a uu decoder. The program should expect to read uu data on its standard input and write the converted data to its standard output.") -(defvar uu-decoder-switches nil - "*List of command line flags passed to the command named by uu-decoder-program.") +(defvar uudecode-decoder-switches nil + "*List of command line flags passed to the command named by uudecode-decoder-program.") -(defvar uu-alphabet "\040-\140") +(defconst uudecode-alphabet "\040-\140") -(defvar uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defvar uu-end-string "^end[ \t]*$") +(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst uudecode-end-line "^end[ \t]*$") -(defvar uu-body-line +(defconst uudecode-body-line (let ((i 61) (str "^M")) (while (> (setq i (1- i)) 0) (setq str (concat str "[^a-z]"))) (concat str ".?$"))) -(defvar uu-temporary-file-directory "/tmp/") +(defvar uudecode-temporary-file-directory "/tmp/") -(defun uu-decode-region-external (start end &optional file-name) - "Decode uuencoded files using an external program." +;;;###autoload +(defun uudecode-decode-region-external (start end &optional file-name) + "uudecode region between START and END with external decoder. + +If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") (let ((cbuf (current-buffer)) tempfile firstline work-buffer status) (save-excursion (goto-char start) - (when (re-search-forward uu-begin-string nil t) + (when (re-search-forward uudecode-begin-line nil t) (forward-line 1) (setq firstline (point)) (cond ((null file-name)) @@ -68,7 +73,7 @@ input and write the converted data to its standard output.") nil nil nil (match-string 1))))) (setq tempfile (expand-file-name - (or file-name (concat uu-temporary-file-directory + (or file-name (concat uudecode-temporary-file-directory (make-temp-name "uu"))))) (let ((cdir default-directory) default-process-coding-system) (unwind-protect @@ -82,11 +87,11 @@ input and write the converted data to its standard output.") (apply 'call-process-region (point-min) (point-max) - uu-decoder-program + uudecode-decoder-program nil nil nil - uu-decoder-switches)) + uudecode-decoder-switches)) (cd cdir) (set-buffer cbuf))) (if (file-exists-p tempfile) (unless file-name @@ -98,25 +103,30 @@ input and write the converted data to its standard output.") (and work-buffer (kill-buffer work-buffer)) (condition-case () (or file-name (delete-file tempfile)) - (error))))) + (error)) + ))) -(defun uu-insert-char (char &optional count ignored buffer) +(defun uudecode-insert-char (char &optional count ignored buffer) (condition-case nil (progn (insert-char char count ignored buffer) - (fset 'uu-insert-char 'insert-char)) + (fset 'uudecode-insert-char 'insert-char)) (wrong-number-of-arguments - (fset 'uu-insert-char 'uu-xemacs-insert-char) - (uu-insert-char char count ignored buffer)))) + (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char) + (uudecode-insert-char char count ignored buffer)))) -(defun uu-xemacs-insert-char (char &optional count ignored buffer) +(defun uudecode-xemacs-insert-char (char &optional count ignored buffer) (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) (save-excursion (set-buffer buffer) (insert-char char count)))) -(defun uu-decode-region (start end &optional file-name) +;;;###autoload + +(defun uudecode-decode-region (start end &optional file-name) + "uudecode region between START and END. +If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") (let ((work-buffer nil) (done nil) @@ -124,11 +134,11 @@ input and write the converted data to its standard output.") (remain 0) (bits 0) (lim 0) inputpos - (non-data-chars (concat "^" uu-alphabet))) + (non-data-chars (concat "^" uudecode-alphabet))) (unwind-protect (save-excursion (goto-char start) - (when (re-search-forward uu-begin-string nil t) + (when (re-search-forward uudecode-begin-line nil t) (cond ((null file-name)) ((stringp file-name)) (t @@ -144,7 +154,7 @@ input and write the converted data to its standard output.") (setq inputpos (point)) (setq remain 0 bits 0 counter 0) (cond - ((> (skip-chars-forward uu-alphabet end) 0) + ((> (skip-chars-forward uudecode-alphabet end) 0) (setq lim (point)) (setq remain (logand (- (char-int (char-after inputpos)) 32) 63)) @@ -159,10 +169,11 @@ input and write the converted data to its standard output.") (setq counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) - (uu-insert-char (lsh bits -16) 1 nil work-buffer) - (uu-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer) - (uu-insert-char (logand bits 255) 1 nil + (uudecode-insert-char + (lsh bits -16) 1 nil work-buffer) + (uudecode-insert-char + (logand (lsh bits -8) 255) 1 nil work-buffer) + (uudecode-insert-char (logand bits 255) 1 nil work-buffer) (setq bits 0 counter 0)) (t (setq bits (lsh bits 6))))))) @@ -172,15 +183,15 @@ input and write the converted data to its standard output.") (error "uucode line ends unexpectly") (setq done t)) ((and (= (point) end) (not done)) - (error "uucode ends unexpectly") + ;(error "uucode ends unexpectly") (setq done t)) ((= counter 3) - (uu-insert-char (logand (lsh bits -16) 255) 1 nil + (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil work-buffer) - (uu-insert-char (logand (lsh bits -8) 255) 1 nil + (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil work-buffer)) ((= counter 2) - (uu-insert-char (logand (lsh bits -10) 255) 1 nil + (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil work-buffer))) (skip-chars-forward non-data-chars end)) (if file-name diff --git a/texi/ChangeLog b/texi/ChangeLog index 420b033..51be9d0 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,29 @@ +1998-10-25 01:51:56 Lars Magne Ingebrigtsen + + * gnus.texi (Headers): Addition. + +1998-10-24 08:37:12 Lars Magne Ingebrigtsen + + * gnus.texi (Summary Buffer Lines): Addition. + (To): New. + (To): Addition. + +1998-10-15 18:15:34 Simon Josefsson + + * gnus.texi (Group Info): Must be list of ranges. + +1998-10-19 01:27:26 Lars Magne Ingebrigtsen + + * gnus.texi (Article Washing): Addition. + +1998-10-18 00:20:58 Lars Magne Ingebrigtsen + + * gnus.texi (Changing Servers): Addition. + +1998-10-17 21:34:57 Lars Magne Ingebrigtsen + + * gnus.texi (Windows Configuration): Addition. + 1998-10-01 07:55:35 Lars Magne Ingebrigtsen * gnus.texi (Splitting Mail): Fix. diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 8a09c30..122f513 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -86,40 +86,21 @@ recommended that anyone who intends writing @sc{mime}-compliant software read at least RFC2045 and RFC2047. @menu +* Interface Functions:: An abstraction over the basic functions. * Basic Functions:: Utility and basic parsing functions. * Decoding and Viewing:: A framework for decoding and viewing. +* Standards:: A summary of RFCs and working documents used. * Index:: Function and variable index. @end menu -@node Basic Functions -@chapter Basic Functions +@node Interface Functions +@chapter Interface Functions +@cindex interface functions +@cindex mail-parse -This chapter describes the basic, ground-level functions for parsing and -handling. Covered here is parsing @code{From} lines, removing comments -from header lines, decoding encoded words, parsing date headers and so -on. High-level functionality is dealt with in the next chapter -(@pxref{Decoding and Viewing}). - -@menu -* mail-parse:: The generalized @sc{mime} and mail interface. -* rfc2231:: Parsing @code{Content-Type} headers. -* drums:: Handling mail headers defined by RFC822bis. -* rfc2047:: En/decoding encoded words in headers. -* time-date:: Functions for parsing dates and manipulating time. -* qp:: Quoted-Printable en/decoding. -* base64:: Base64 en/decoding. -* mailcap:: How parts are displayed is specified by the @file{.mailcap} file -@end menu - - -@node mail-parse -@section mail-parse - -It is perhaps misleading to place the @code{mail-parse} library in this -chapter. It is not a basic low-level library---rather, it is an -abstraction over the actual low-level libraries that are described in the -subsequent sections. +The @code{mail-parse} library is an abstraction over the actual +low-level libraries that are described in the next chapter. Standards change, and so programs have to change to fit in the new mold. For instance, RFC2045 describes a syntax for the @@ -165,7 +146,7 @@ Here's an example: @example (mail-header-parse-content-type "image/gif; name=\"b980912.gif\"") -=> ("image/gif" (name . "b980912.gif")) +@result{} ("image/gif" (name . "b980912.gif")) @end example @item mail-header-parse-content-disposition @@ -181,7 +162,7 @@ Returns the value of the attribute. @example (mail-content-type-get '("image/gif" (name . "b980912.gif")) 'name) -=> "b980912.gif" +@result{} "b980912.gif" @end example @item mail-header-remove-comments @@ -191,7 +172,7 @@ Return a comment-free version of a header. @example (mail-header-remove-comments "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") -=> "Gnus/5.070027 " +@result{} "Gnus/5.070027 " @end example @item mail-header-remove-whitespace @@ -202,7 +183,7 @@ and comments is preserved. @example (mail-header-remove-whitespace "image/gif; name=\"Name with spaces\"") -=> "image/gif;name=\"Name with spaces\"" +@result{} "image/gif;name=\"Name with spaces\"" @end example @item mail-header-get-comment @@ -212,7 +193,7 @@ Return the last comment in a header. @example (mail-header-get-comment "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)") -=> "Finnish Landrace" +@result{} "Finnish Landrace" @end example @item mail-header-parse-address @@ -223,7 +204,7 @@ plaintext name. @example (mail-header-parse-address "Hrvoje Niksic ") -=> ("hniksic@@srce.hr" . "Hrvoje Niksic") +@result{} ("hniksic@@srce.hr" . "Hrvoje Niksic") @end example @item mail-header-parse-addresses @@ -234,7 +215,7 @@ the one described above. @example (mail-header-parse-addresses "Hrvoje Niksic , Steinar Bang ") -=> (("hniksic@@srce.hr" . "Hrvoje Niksic") +@result{} (("hniksic@@srce.hr" . "Hrvoje Niksic") ("sb@@metis.no" . "Steinar Bang")) @end example @@ -268,7 +249,7 @@ Encode the words that need encoding in a string, and return the result. @example (mail-encode-encoded-word-string "This is naïve, baby") -=> "This is =?iso-8859-1?q?na=EFve,?= baby" +@result{} "This is =?iso-8859-1?q?na=EFve,?= baby" @end example @item mail-decode-encoded-word-region @@ -282,16 +263,40 @@ Decode the encoded words in the string and return the result. @example (mail-decode-encoded-word-string "This is =?iso-8859-1?q?na=EFve,?= baby") -=> "This is naïve, baby" +@result{} "This is naïve, baby" @end example @end table -Currently, @code{mail-parse} is an abstraction over @code{drums}, +Currently, @code{mail-parse} is an abstraction over @code{ietf-drums}, @code{rfc2047} and @code{rfc2231}. These are documented in the subsequent sections. + +@node Basic Functions +@chapter Basic Functions + +This chapter describes the basic, ground-level functions for parsing and +handling. Covered here is parsing @code{From} lines, removing comments +from header lines, decoding encoded words, parsing date headers and so +on. High-level functionality is dealt with in the next chapter +(@pxref{Decoding and Viewing}). + +@menu +* rfc2231:: Parsing @code{Content-Type} headers. +* ietf-drums:: Handling mail headers defined by RFC822bis. +* rfc2047:: En/decoding encoded words in headers. +* time-date:: Functions for parsing dates and manipulating time. +* qp:: Quoted-Printable en/decoding. +* base64:: Base64 en/decoding. +* binhex:: Binhex decoding. +* uudecode:: Uuencode decoding. +* rfc1843:: Decoding HZ-encoded text. +* mailcap:: How parts are displayed is specified by the @file{.mailcap} file +@end menu + + @node rfc2231 @section rfc2231 @@ -325,7 +330,7 @@ elements. title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn't it!\"") -=> ("application/x-stuff" +@result{} ("application/x-stuff" (title . "This is even more ***fun*** isn't it!")) @end example @@ -337,8 +342,8 @@ the value of the specified attribute. @end table -@node drums -@section drums +@node ietf-drums +@section ietf-drums @dfn{drums} is an IETF working group that is working on the replacement for RFC822. @@ -346,35 +351,35 @@ for RFC822. The functions provided by this library include: @table @code -@item drums-remove-comments -@findex drums-remove-comments +@item ietf-drums-remove-comments +@findex ietf-drums-remove-comments Remove the comments from the argument and return the results. -@item drums-remove-whitespace -@findex drums-remove-whitespace +@item ietf-drums-remove-whitespace +@findex ietf-drums-remove-whitespace Remove linear white space from the string and return the results. Spaces inside quoted strings and comments are left untouched. -@item drums-get-comment -@findex drums-get-comment +@item ietf-drums-get-comment +@findex ietf-drums-get-comment Return the last most comment from the string. -@item drums-parse-address -@findex drums-parse-address +@item ietf-drums-parse-address +@findex ietf-drums-parse-address Parse an address string and return a list that contains the mailbox and the plain text name. -@item drums-parse-addresses -@findex drums-parse-addresses +@item ietf-drums-parse-addresses +@findex ietf-drums-parse-addresses Parse a string that contains any number of comma-separated addresses and return a list that contains mailbox/plain text pairs. -@item drums-parse-date -@findex drums-parse-date +@item ietf-drums-parse-date +@findex ietf-drums-parse-date Parse a date string and return an Emacs time structure. -@item drums-narrow-to-header -@findex drums-narrow-to-header +@item ietf-drums-narrow-to-header +@findex ietf-drums-narrow-to-header Narrow the buffer to the header section of the current buffer. @end table @@ -470,7 +475,7 @@ document this library here. It deals with parsing @code{Date} headers and manipulating time. (Not by using tesseracts, though, I'm sorry to say.) -These functions converts between five formats: A date string, an Emacs +These functions convert between five formats: A date string, an Emacs time structure, a decoded time list, a second number, and a day number. The functions have quite self-explanatory names, so the following just @@ -478,41 +483,41 @@ gives an overview of which functions are available. @example (parse-time-string "Sat Sep 12 12:21:54 1998 +0200") -=> (54 21 12 12 9 1998 6 nil 7200) +@result{} (54 21 12 12 9 1998 6 nil 7200) (date-to-time "Sat Sep 12 12:21:54 1998 +0200") -=> (13818 19266) +@result{} (13818 19266) (time-to-seconds '(13818 19266)) -=> 905595714.0 +@result{} 905595714.0 (seconds-to-time 905595714.0) -=> (13818 19266 0) +@result{} (13818 19266 0) (time-to-day '(13818 19266)) -=> 729644 +@result{} 729644 (days-to-time 729644) -=> (961933 65536) +@result{} (961933 65536) (time-since '(13818 19266)) -=> (0 430) +@result{} (0 430) (time-less-p '(13818 19266) '(13818 19145)) -=> nil +@result{} nil (subtract-time '(13818 19266) '(13818 19145)) -=> (0 121) +@result{} (0 121) (days-between "Sat Sep 12 12:21:54 1998 +0200" "Sat Sep 07 12:21:54 1998 +0200") -=> 5 +@result{} 5 (date-leap-year-p 2000) -=> t +@result{} t (time-to-day-in-year '(13818 19266)) -=> 255 +@result{} 255 @end example @@ -559,6 +564,7 @@ results. @node base64 @section base64 +@cindex base64 Base64 is an encoding that encodes three bytes into four characters, thereby increasing the size by about 33%. The alphabet used for @@ -591,6 +597,69 @@ decoded, @code{nil} is returned. @end table +@node binhex +@section binhex +@cindex binhex +@cindex Apple +@cindex Macintosh + +@code{binhex} is an encoding that originated in Macintosh environments. +The following function is supplied to deal with these: + +@table @code +@item binhex-decode-region +@findex binhex-decode-region +Decode the encoded text in the region. If given a third parameter, only +decode the @code{binhex} header and return the filename. + +@end table + + +@node uudecode +@section uudecode +@cindex uuencode +@cindex uudecode + +@code{uuencode} is probably still the most popular encoding of binaries +used on Usenet, although @code{base64} rules the mail world. + +The following function is supplied by this package: + +@table @code +@item uudecode-decode-region +@findex uudecode-decode-region +Decode the text in the region. +@end table + + +@node rfc1843 +@section rfc1843 +@cindex rfc1843 +@cindex HZ +@cindex Chinese + +RFC1843 deals with mixing Chinese and ASCII characters in messages. In +essence, RFC1843 switches between ASCII and Chinese by doing this: + +@example +This sentence is in ASCII. +The next sentence is in GB.~@{<:Ky2;S@{#,NpJ)l6HK!#~@}Bye. +@end example + +Simple enough, and widely used in China. + +The following functions are available to handle this encoding: + +@table @code +@item rfc1843-decode-region +Decode HZ-encoded text in the region. + +@item rfc1843-decode-string +Decode a HZ-encoded string and return the result. + +@end table + + @node mailcap @section mailcap @@ -599,8 +668,8 @@ handlers and describes how elements are supposed to be displayed. Here's an example file: @example -image/*; xv -8 %s -audio/x-pn-realaudio; rvplayer %s +image/*; gimp -8 %s +audio/wav; wavplayer %s @end example This says that all image files should be displayed with @samp{xv}, and @@ -743,6 +812,54 @@ Prompt for a mailcap method to use to view the part. @end table +@node Standards +@chapter Standards + +The Emacs @sc{mime} library implements handling of various elements +according to a (somewhat) large number of RFCs, drafts and standards +documents. This chapter lists the relevant ones. They can all be +fetched from @samp{http://www.stud.ifi.uio.no/~larsi/notes/}. + +@table @dfn +@item RFC822 +@itemx STD11 +Standard for the Format of ARPA Internet Text Messages. + +@item RFC1036 +Standard for Interchange of USENET Messages + +@item RFC2045 +Format of Internet Message Bodies + +@item RFC2046 +Media Types + +@item RFC2047 +Message Header Extensions for Non-ASCII Text + +@item RFC2048 +Registration Procedures + +@item RFC2049 +Conformance Criteria and Examples + +@item RFC2231 +MIME Parameter Value and Encoded Word Extensions: Character Sets, +Languages, and Continuations + +@item RFC1843 +HZ - A Data Format for Exchanging Files of Arbitrarily Mixed Chinese and +ASCII characters + +@item draft-ietf-drums-msg-fmt-05.txt +Draft for the successor of RFC822 + +@item RFC1892 +The Multipart/Report Content Type for the Reporting of Mail System +Administrative Messages + +@end table + @node Index @chapter Index diff --git a/texi/gnus.texi b/texi/gnus.texi index a315f96..240437a 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.34 Manual +@settitle Pterodactyl Gnus 0.39 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.34 Manual +@title Pterodactyl Gnus 0.39 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.34. +This manual corresponds to Pterodactyl Gnus 0.39. @end ifinfo @@ -823,6 +823,10 @@ and read ranges have become worthless. You can use the @kbd{M-x gnus-group-clear-data-on-native-groups} command to clear out all data that you have on your native groups. Use with caution. +After changing servers, you @strong{must} move the cache hierarchy away, +since the cached articles will have wrong article numbers, which will +affect which articles Gnus thinks are read. + @node Startup Files @section Startup Files @@ -3249,6 +3253,7 @@ You can have as many summary buffers open as you wish. @menu * Summary Buffer Lines:: You can specify how summary lines should look. +* To From Newsgroups:: How to not display your own name. * Summary Buffer Mode Line:: You can say how the mode line should look. * Summary Highlighting:: Making the summary buffer all pretty and nice. @end menu @@ -3302,6 +3307,9 @@ had a different subject, @code{gnus-summary-same-subject} otherwise. Full @code{From} header. @item n The name (from the @code{From} header). +@item f +The name, code @code{To} header or the @code{Newsgroups} header +(@pxref{To From Newsgroups}). @item a The name (from the @code{From} header). This differs from the @code{n} spec in that it uses the function designated by the @@ -3391,6 +3399,69 @@ The smart choice is to have these specs as far to the left as possible. This restriction may disappear in later versions of Gnus. +@node To From Newsgroups +@subsection To From Newsgroups +@cindex To +@cindex Newsgroups + +In some groups (particularly in archive groups), the @code{From} header +isn't very interesting, since all the articles there are written by +you. To display the information in the @code{To} or @code{Newsgroups} +headers instead, you need to decide three things: What information to +gather; where to display it; and when to display it. + +@enumerate +@item +@vindex gnus-extra-headers +The reading of extra header information is controlled by the +@code{gnus-extra-headers}. This is a list of header symbols. For +instance: + +@lisp +(setq gnus-extra-headers + '(To Newsgroups X-Newsreader)) +@end lisp + +This will result in Gnus trying to obtain these three headers, and +storing it in header structures for later easy retrieval. + +@item +@findex gnus-extra-header +The value of these extra headers can be accessed via the +@code{gnus-extra-header} function. Here's a format line spec that will +access the @code{X-Newsreader} header: + +@example +"%~(form (gnus-extra-header 'X-Newsreader))@@" +@end example + +@item +@vindex gnus-ignored-from-addresses +The @code{gnus-ignored-from-addresses} variable says when the @samp{%f} +summary line spec returns the @code{To}, @code{Newsreader} or +@code{From} header. If this regexp matches the contents of the +@code{From} header, the value of the @code{To} or @code{Newsreader} +headers are used instead. + +@end enumerate + +@vindex nnmail-extra-headers +A related variable is @code{nnmail-extra-headers}, which controls when +to include extra headers when generating active files. + +In summary, you'd typically do something like the following: + +@lisp +(setq gnus-extra-headers + '(To Newsgroups)) +(setq nnmail-extra-headers gnus-extra-headers) +(setq gnus-summary-line-format + "%U%R%z%I%(%[%4L: %-20,20f%]%) %s\n") +(setq gnus-ignored-from-addresses + "Your Name Here") +@end lisp + + @node Summary Buffer Mode Line @subsection Summary Buffer Mode Line @@ -6477,7 +6548,13 @@ Treat overstrike (@code{gnus-article-treat-overstrike}). @item W d @kindex W d (Summary) @findex gnus-article-treat-dumbquotes -Treat M******** sm*rtq**t*s (@code{gnus-article-treat-dumbquotes}). +@vindex gnus-article-dumbquotes-map +@cindex Smartquotes +@cindex M******** sm*rtq**t*s +@cindex Latin 1 +Treat M******** sm*rtq**t*s according to +@code{gnus-article-dumbquotes-map} +(@code{gnus-article-treat-dumbquotes}). @item W w @kindex W w (Summary) @@ -6833,6 +6910,17 @@ View all the @sc{mime} parts in the current article @end table +Relevant variables: + +@table @code +@item gnus-ignored-mime-types +@vindex gnus-ignored-mime-types +This is a list of regexps. @sc{mime} types that match a regexp from +this list will be completely ignored by Gnus. The default value is +@code{("text/x-vcard")}. + +@end table + @node Article Commands @section Article Commands @@ -14572,6 +14660,11 @@ won't change the window configuration. If you always want to force the ``right'' window configuration, you can set @code{gnus-always-force-window-configuration} to non-@code{nil}. +If you're using tree displays (@pxref{Tree Display}), and the tree +window is displayed vertically next to another window, you may also want +to fiddle with @code{gnus-tree-minimize-window} to avoid having the +windows resized. + @node Faces and Fonts @section Faces and Fonts @@ -16062,6 +16155,10 @@ Luis Fernandes---design and graphics. Erik Naggum---help, ideas, support, code and stuff. @item +Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el and many other things +connected with @sc{mime} and other types of en/decoding. + +@item Wes Hardaker---@file{gnus-picon.el} and the manual section on @dfn{picons} (@pxref{Picons}). @@ -16296,10 +16393,9 @@ Stefan Waldherr, Pete Ware, Barry A. Warsaw, Christoph Wedler, -Joe Wells, -Katsumi Yamaoka, @c Yamaoka +Joe Wells and -Shenghuo Zhu. @c Zhu +Katsumi Yamaoka, @c Yamaoka. For a full overview of what each person has done, the ChangeLogs included in the Gnus alpha distributions should give ample reading @@ -17576,7 +17672,7 @@ mail-copies-to: never. new group parameter -- `post-to-server' that says to post using the current server. Also a variable to do the same. @item - the slave dribble files should autosave to the slave file names. + the slave dribble files should auto-save to the slave file names. @item a group parameter that says what articles to display on group entry, based on article marks. @@ -18050,7 +18146,7 @@ home-brewed stuff for better reliability. add a way to select which NoCeM type to apply -- spam, troll, etc. @item - nndraft-request-group should tally autosave files. + nndraft-request-group should tally auto-save files. @item implement nntp-retry-on-break and nntp-command-timeout. @@ -18189,10 +18285,6 @@ exits the group. The jingle is only played on the second invocation of Gnus. @item -gnus-ignored-mime-types to avoid seeing buttons for Vcards and the -like. - -@item Bouncing articles should do MIME. @item @@ -18200,6 +18292,9 @@ Crossposted articles should "inherit" the % or @ mark from the other groups it has been crossposted to, or something. (Agent.) @item +`S D r' should allow expansion of aliases. + +@item Solve the halting problem. @c TODO @@ -18805,7 +18900,7 @@ Takes two parameters, @var{function} and @var{group}. If the backend @lisp (gnus-check-backend-function "request-scan" "nnml:misc") -=> t +@result{} t @end lisp @item gnus-read-method @@ -19147,6 +19242,48 @@ and @var{article} may be @code{nil}. There should be no result data from this function. +@item (nnchoke-request-set-mark GROUP ACTION &optional SERVER) + +Set/remove/add marks on articles. Normally Gnus handles the article +marks (such as read, ticked, expired etc) internally, and store them in +@code{~/.newsrc.eld}. Some backends (such as IMAP) however carry all +information about the articles on the server, so Gnus need to propagate +the mark information to the server. + +ACTION is a list of mark setting requests, having this format: + +@example +(RANGE ACTION MARK) +@end example + +Range is a range of articles you wish to update marks on. Action is +@code{set}, @code{add} or @code{del}, respectively used for removing all +existing marks and setting them as specified, adding (preserving the +marks not mentioned) mark and removing (preserving the marks not +mentioned) marks. Mark is a list of marks; where each mark is a +symbol. Currently used marks are @code{read}, @code{tick}, @code{reply}, +@code{expire}, @code{killed}, @code{dormant}, @code{save}, +@code{download} and @code{unsend}, but your backend should, if possible, +not limit itself to theese. + +Given contradictory actions, the last action in the list should be the +effective one. That is, if your action contains a request to add the +@code{tick} mark on article 1 and, later in the list, a request to +remove the mark on the same article, the mark should in fact be removed. + +An example action list: + +@example +(((5 12 30) 'del '(tick)) + ((10 . 90) 'add '(read expire)) + ((92 94) 'del '(read))) +@end example + +The function should return a range of articles it wasn't able to set the +mark on (currently not used for anything). + +There should be no result data from this function. + @item (nnchoke-request-update-mark GROUP ARTICLE MARK) If the user tries to set a mark that the backend doesn't like, this @@ -19673,12 +19810,12 @@ basically, with each header (ouch) having one slot. These slots are, in order: @code{number}, @code{subject}, @code{from}, @code{date}, @code{id}, @code{references}, @code{chars}, @code{lines}, -@code{xref}. There are macros for accessing and setting these -slots---they all have predictable names beginning with +@code{xref}, and @code{extra}. There are macros for accessing and +setting these slots---they all have predictable names beginning with @code{mail-header-} and @code{mail-header-set-}, respectively. -The @code{xref} slot is really a @code{misc} slot. Any extra info will -be put in there. +All these slots contain strings, except the @code{extra} slot, which +contains an alist of header/value pairs (@pxref{To From Newsgroups}). @node Ranges @@ -19772,7 +19909,7 @@ Here are two example group infos; one is a very simple group while the second is a more complex one: @example -("no.group" 5 (1 . 54324)) +("no.group" 5 ((1 . 54324))) ("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) ((tick (15 . 19)) (replied 3 6 (19 . 3))) diff --git a/texi/message.texi b/texi/message.texi index 72963c0..237dd93 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.34 Manual +@settitle Pterodactyl Message 0.39 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.34 Manual +@title Pterodactyl Message 0.39 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.34. Message is +This manual corresponds to Pterodactyl Message 0.39. Message is distributed with the Gnus distribution bearing the same version number as this manual.