** 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.
+
+
+Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.39 is released.
+
+1998-10-25 00:34:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-mixed): Multipart in
+ mixed part.
+
+Tue Oct 20 23:36:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
+
+1998-10-24 20:51:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.38 is released.
+
+1998-10-24 07:54:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.37 is released.
+
+1998-10-24 07:29:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <verna@inf.enst.fr>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus.el: Changed following-char to char-after throughout.
+
+1998-10-22 04:05:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-display-external): Protect more and message.
+
+Wed Oct 21 03:26:30 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-article-push-button): Go to the
+ position.
+
+Tue Oct 20 23:37:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-mixed): Multipart in
+ mixed part.
+
+Tue Oct 20 23:36:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
+
+1998-10-21 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit): Destroy parts.
+ (gnus-summary-exit-no-update): Ditto.
+
+1998-10-20 22:02:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.36 is released.
+
+1998-10-20 18:13:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <larsi@gnus.org>
+
+ * mm-decode.el (mm-display-external): Check before selecting.
+
+Sat Sep 26 02:03:00 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.35 is released.
+
+1998-10-20 00:00:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <jas@pdc.kth.se>
+
+ * mailcap.el (mailcap-parse-mailcaps): Only open regular
+ files.
+
+1998-09-26 22:28:01 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-group.el (gnus-add-marked-articles): Request backend update
+ of flags.
+
+1998-09-26 19:39:31 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-sum.el (gnus-update-read-articles):
+ (gnus-update-marks): Request backend update of mark.
+
+1998-09-26 19:33:58 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus.texi (Optional Backend Functions): New item,
+ nnchoke-request-set-mark.
+
+1998-09-26 16:27:27 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-range.el (gnus-remove-from-range): Don't add stuff in
+ list to range.
+
+1998-10-19 23:45:13 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Don't expire.
+
+1998-10-14 SL Baur <steve@altair.xemacs.org>
+
+ * gnus-sum.el: Move gnus-save-hidden-threads above where it is
+ first used.
+
+1998-10-10 SL Baur <steve@altair.xemacs.org>
+
+ * 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 <ksw@dna.lth.se>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Erase old forward
+ buffer.
+
+1998-10-19 23:38:11 Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
+
+ * nnagent.el (nnagent-open-server): Error message.
+
+1998-10-19 23:35:08 Joerg Lenneis <lenneis@statrix2.wu-wien.ac.at>
+
+ * nnheader.el (nnheader-article-p): Recognize lower-case headers.
+
+1998-10-19 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <hniksic@srce.hr>
+
+ * 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 <hniksic@srce.hr>
+
+ * 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 <larsi@gnus.org>
+
+ * mailcap.el (mailcap-mime-data): Save sound.
+
+1998-09-24 Hrvoje Niksic <hniksic@srce.hr>
+
+ * message.el (message-ignored-supersedes-headers): Include
+ `NNTP-Posting-Date'.
+
+1998-10-19 01:25:27 Jonas Steverud <d4jonas@dtek.chalmers.se>
+
+ * gnus-art.el (gnus-article-dumbquotes-table): New variable.
+
+1998-10-19 00:50:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Use
+ uudecode.
+
+1998-10-18 18:20:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-display-external): Don't switch on save.
+
+1998-10-18 18:14:06 Andy Piper <andyp@parallax.co.uk>
+
+ * nnmail.el (nnmail-movemail-args): New variable.
+
+1998-10-18 00:17:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-translate-strings):
+
+1998-10-17 22:51:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <mmp@graphics.stanford.edu>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old
+ forward buffer first.
+
+1998-10-17 21:16:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <steve@altair.xemacs.org>
+
+ * 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 <ljz@asfast.com>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Fix.
+
Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.34 is released.
* mm-decode.el (mm-inlinable-part-p): New function.
+1998-09-25 22:28:01 Simon Josefsson <jas@pdc.kth.se>
+
+ * mm-util.el (mm-disable-multibyte): New function.
+
Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.33 is released.
(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"))
--- /dev/null
+;;; binhex.el -- elisp native binhex decode
+;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Create Date: Oct 1, 1998
+;; $Revision: 1.1.1.1 $
+;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
+;; 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
+
+
(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))
(require 'mm-decode)
(require 'mm-view)
(require 'wid-edit)
+(require 'mm-uu)
(defgroup gnus-article nil
"Article display."
(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)
(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.
(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)
(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
(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
(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.
;; 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)
(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
(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.
(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
(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
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
;;; 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."
(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 ()
(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 ")")
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."
(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 ? )
(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
(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))))
(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
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
`(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."
(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)
(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)
(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))
(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))
"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
(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
(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))
(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))
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)) .
(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))
(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))))))
(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)))
;; 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)))
(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
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)
(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)
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)
(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)))
(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))
(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
(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)))
;; 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.
(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))
(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))
(not (eq 'byte-code (car form)))
;; Under XEmacs, it's (funcall #<compiled-function ...>)
(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))))))
(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
(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:
(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
(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))
(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)
(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)
(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
(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.
(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
(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)
(?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)
;; 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.
["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]
(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.
(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)))))
(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
(setq heads nil)))))
gnus-newsgroup-dependencies)))
-;; The following macros and functions were written by Felix Lee
-;; <flee@cse.psu.edu>.
-
(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)))
(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)
(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))
(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 ...]...) ...])'
(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))
;; 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))))
(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))
(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)))
(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)
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)
(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."
(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
(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
(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))))
(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)
"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))
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
(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)
(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))))
(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))
(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))))))
(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)
(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
: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)
()))
"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))
'((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"))
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
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)
%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
(let (c)
(ietf-drums-init string)
(while (not (eobp))
- (setq c (following-char))
+ (setq c (char-after))
(cond
((eq c ?\")
(forward-sexp 1))
(ietf-drums-init string)
(let (c)
(while (not (eobp))
- (setq c (following-char))
+ (setq c (char-after))
(cond
((eq c ?\")
(forward-sexp 1))
(ietf-drums-init string)
(let (result c)
(while (not (eobp))
- (setq c (following-char))
+ (setq c (char-after))
(cond
((eq c ?\")
(forward-sexp 1))
(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))
(let ((beg (point))
pairs c)
(while (not (eobp))
- (setq c (following-char))
+ (setq c (char-after))
(cond
((memq c '(?\" ?< ?\())
(forward-sexp 1))
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
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
)))
(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/*"))
(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 ()
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)))
(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")
(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))
(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))
(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 ";"))
(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")
(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)
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)))
: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."
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)
(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)))))
(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)
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)
(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")
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."
"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.
;;; 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)
(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))
(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."
(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.
(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)
(search-backward ":" )
(widen)
(forward-char 1)
- (if (= (following-char) ? )
+ (if (eq (char-after) ? )
(forward-char 1)
(insert " ")))
(t
(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)))
;; 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
`((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)))))
(goto-char (min start end))
(while (< (point) end1)
(or (looking-at "[_\^@- ]")
- (insert (following-char) "\b"))
+ (insert (char-after) "\b"))
(forward-char 1)))))
;;;###autoload
(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)
(eval-and-compile
(or (fboundp 'base64-decode-region)
- (autoload 'base64-decode-region "base64" nil t)))
+ (require 'base64)))
+
(require 'mm-util)
(require 'rfc2047)
(require 'qp)
(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))
)
((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))
(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))))))
(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))
("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))
(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")
(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)
result
(cond
((equal type "multipart")
- (mm-dissect-multipart ctl))
+ (cons (car ctl) (mm-dissect-multipart ctl)))
(t
(mm-dissect-singlepart
ctl
(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)))
(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 ()
"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))
(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."
(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))
(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."
(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)
(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)
(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
(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
--- /dev/null
+;;; mm-uu.el -- Return uu stuffs as mm handles
+;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; $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
(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
+(require 'mm-decode)
;;;
;;; Functions for displaying various formats inline
(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))
(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")))
(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)))
"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
(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)))))
(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
(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
)))
(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)
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)
(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)
: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
(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
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))
(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 ")
(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 ")
(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")
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)
(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."
(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))
(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))
;; Ensure a trailing \t.
(end-of-line)
- (or (= (char-after (1- (point))) ?\t)
+ (or (eq (char-after (1- (point))) ?\t)
(insert ?\t)))
;;; 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 <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3l
+;; Version: 1.3m
;; This file is part of GNU Emacs.
(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.")
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)
(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
(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.
(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)))
--- /dev/null
+;;; rfc1843.el --- HZ (rfc1843) decoding
+;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; $Revision: 1.1.1.1 $
+;; Keywords: news HZ
+;; Time-stamp: <Tue Oct 6 23:48:49 EDT 1998 zsh>
+
+;; 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
(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)
(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
(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)))
(unless (eq c ?=)
(error "Invalid header: %s" string))
(forward-char 1)
- (setq c (following-char))
+ (setq c (char-after))
(cond
((eq c ?\")
(setq value
(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))
(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)
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $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
(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))
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
(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
(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)
(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
(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))
(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)))))))
(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
+1998-10-25 01:51:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Headers): Addition.
+
+1998-10-24 08:37:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Summary Buffer Lines): Addition.
+ (To): New.
+ (To): Addition.
+
+1998-10-15 18:15:34 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus.texi (Group Info): Must be list of ranges.
+
+1998-10-19 01:27:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Article Washing): Addition.
+
+1998-10-18 00:20:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Changing Servers): Addition.
+
+1998-10-17 21:34:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Windows Configuration): Addition.
+
1998-10-01 07:55:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Splitting Mail): Fix.
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
@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
@example
(mail-content-type-get
'("image/gif" (name . "b980912.gif")) 'name)
-=> "b980912.gif"
+@result{} "b980912.gif"
@end example
@item mail-header-remove-comments
@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
@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
@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
@example
(mail-header-parse-address
"Hrvoje Niksic <hniksic@@srce.hr>")
-=> ("hniksic@@srce.hr" . "Hrvoje Niksic")
+@result{} ("hniksic@@srce.hr" . "Hrvoje Niksic")
@end example
@item mail-header-parse-addresses
@example
(mail-header-parse-addresses
"Hrvoje Niksic <hniksic@@srce.hr>, Steinar Bang <sb@@metis.no>")
-=> (("hniksic@@srce.hr" . "Hrvoje Niksic")
+@result{} (("hniksic@@srce.hr" . "Hrvoje Niksic")
("sb@@metis.no" . "Steinar Bang"))
@end example
@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
@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
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
@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.
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
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
@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
@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
@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
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
@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
\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
@tex
@titlepage
-@title Pterodactyl Gnus 0.34 Manual
+@title Pterodactyl Gnus 0.39 Manual
@author by Lars Magne Ingebrigtsen
@page
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
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
@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
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
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
@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)
@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
``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
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}).
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
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.
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.
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
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
@lisp
(gnus-check-backend-function "request-scan" "nnml:misc")
-=> t
+@result{} t
@end lisp
@item gnus-read-method
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
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
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)))
\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
@tex
@titlepage
-@title Pterodactyl Message 0.34 Manual
+@title Pterodactyl Message 0.39 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / elisp / gnus.git- / commitdiff