Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 1774ae25842f79d393cc8dd84a43e8eb9224d4ce 1 parent 2eb41e1
@larsmagne larsmagne authored
Showing with 1,334 additions and 288 deletions.
  1. +200 −0 lisp/ChangeLog
  2. +316 −0 lisp/binhex.el
  3. +122 −40 lisp/gnus-art.el
  4. +2 −1  lisp/gnus-draft.el
  5. +2 −1  lisp/gnus-eform.el
  6. +1 −0  lisp/gnus-ems.el
  7. +10 −10 lisp/gnus-group.el
  8. +10 −0 lisp/gnus-int.el
  9. +1 −0  lisp/gnus-msg.el
  10. +1 −1  lisp/gnus-range.el
  11. +8 −6 lisp/gnus-sum.el
  12. +6 −0 lisp/gnus-util.el
  13. +3 −1 lisp/gnus-uu.el
  14. +15 −1 lisp/gnus-xmas.el
  15. +1 −1  lisp/gnus.el
  16. +2 −2 lisp/lpath.el
  17. +4 −3 lisp/mailcap.el
  18. +73 −67 lisp/message.el
  19. +4 −3 lisp/mm-bodies.el
  20. +32 −22 lisp/mm-decode.el
  21. +5 −0 lisp/mm-util.el
  22. +1 −0  lisp/mm-view.el
  23. +2 −1  lisp/nnagent.el
  24. +1 −1  lisp/nndoc.el
  25. +1 −1  lisp/nnheader.el
  26. +10 −1 lisp/nnmail.el
  27. +6 −4 lisp/pop3.el
  28. +172 −0 lisp/rfc1843.el
  29. +2 −2 lisp/rfc2047.el
  30. +2 −1  lisp/score-mode.el
  31. +49 −38 lisp/uudecode.el
  32. +16 −0 texi/ChangeLog
  33. +186 −69 texi/emacs-mime.texi
  34. +65 −8 texi/gnus.texi
  35. +3 −3 texi/message.texi
View
200 lisp/ChangeLog
@@ -1,3 +1,199 @@
+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.
@@ -125,6 +321,10 @@ Sat Sep 26 03:04:18 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
* 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.
View
316 lisp/binhex.el
@@ -0,0 +1,316 @@
+;;; 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.2 $
+;; 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
+
+
View
162 lisp/gnus-art.el
@@ -546,6 +546,26 @@ displayed by the first non-nil matching CONTENT face."
(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
"Function used to decode headers.")
+(defvar gnus-article-dumbquotes-map
+ '(("\202" . ",")
+ ("\203" . "f")
+ ("\204" . ",,")
+ ("\213" . "<")
+ ("\214" . "OE")
+ ("\205" . "...")
+ ("\221" . "`")
+ ("\222" . "'")
+ ("\223" . "``")
+ ("\224" . "''")
+ ("\225" . "*")
+ ("\226" . "-")
+ ("\227" . "-")
+ ("\231" . "(TM)")
+ ("\233" . ">")
+ ("\234" . "oe")
+ ("\264" . "'"))
+ "Table for MS-to-Latin1 translation.")
+
;;; Internal variables
(defvar gnus-article-mime-handle-alist nil)
@@ -808,7 +828,7 @@ always hide."
(defun article-treat-dumbquotes ()
"Translate M******** sm*rtq**t*s into proper text."
(interactive)
- (article-translate-characters "\221\222\223\224" "`'\"\""))
+ (article-translate-strings gnus-article-dumbquotes-map))
(defun article-translate-characters (from to)
"Translate all characters in the body of the article according to FROM and TO.
@@ -828,6 +848,19 @@ characters to translate to."
(incf i))
(translate-region (point) (point-max) x)))))
+(defun article-translate-strings (map)
+ "Translate all string in the body of the article according to MAP.
+MAP is an alist where the elements are on the form (\"from\" \"to\")."
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (let ((buffer-read-only nil)
+ elem)
+ (while (setq elem (pop map))
+ (save-excursion
+ (while (search-forward (car elem) nil t)
+ (replace-match (cadr elem)))))))))
+
(defun article-treat-overstrike ()
"Translate overstrikes into bold text."
(interactive)
@@ -1011,7 +1044,9 @@ or not."
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
- (quoted-printable-decode-region (point) (point-max))))))
+ (quoted-printable-decode-region (point) (point-max))
+ (when mm-default-coding-system
+ (mm-decode-body mm-default-coding-system))))))
(defun article-mime-decode-quoted-printable-buffer ()
"Decode Quoted-Printable in the current buffer."
@@ -1031,6 +1066,9 @@ always hide."
;; Hide the "header".
(when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
(delete-region (1+ (match-beginning 0)) (match-end 0))
+ ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too
+ (when (looking-at "Hash:.*$")
+ (delete-region (point) (1+ (gnus-point-at-eol))))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
@@ -1733,7 +1771,8 @@ The directory to save in defaults to `gnus-article-save-directory'."
(defun gnus-summary-save-in-pipe (&optional command)
"Pipe this article to subprocess."
(setq command
- (cond ((eq command 'default)
+ (cond ((and (eq command 'default)
+ gnus-last-shell-command)
gnus-last-shell-command)
(command command)
(t (read-string
@@ -2006,6 +2045,7 @@ commands:
(set-buffer (gnus-get-buffer-create name))
(gnus-article-mode)
(make-local-variable 'gnus-summary-buffer)
+ (gnus-summary-set-local-parameters gnus-newsgroup-name)
(current-buffer)))))
;; Set article window start at LINE, where LINE is the number of lines
@@ -2138,6 +2178,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
buffer-read-only)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
+ (setq buffer-read-only nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(gnus-run-hooks 'gnus-article-prepare-hook)
(when gnus-display-mime-function
@@ -2150,32 +2191,46 @@ If ALL-HEADERS is non-nil, no headers are hidden."
;;; Gnus MIME viewing functions
;;;
-(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}\n"
+(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n"
"The following specs can be used:
%t The MIME type
%n The `name' parameter
%d The description, if any
%l The length of the encoded part
-%p The part identifier")
+%p The part identifier
+%e Dots if the part isn't displayed")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(?n gnus-tmp-name ?s)
(?d gnus-tmp-description ?s)
(?p gnus-tmp-id ?s)
- (?l gnus-tmp-length ?d)))
+ (?l gnus-tmp-length ?d)
+ (?e gnus-tmp-dots ?s)))
+
+(defvar gnus-mime-button-commands
+ '((gnus-article-press-button "\r" "Toggle Display")
+ ;(gnus-mime-view-part "\M-\r" "View Interactively...")
+ (gnus-mime-view-part "v" "View Interactively...")
+ (gnus-mime-save-part "o" "Save...")
+ (gnus-mime-copy-part "c" "View In Buffer")
+ (gnus-mime-inline-part "i" "View Inline")
+ (gnus-mime-pipe-part "|" "Pipe To Command...")))
(defvar gnus-mime-button-map nil)
(unless gnus-mime-button-map
- (setq gnus-mime-button-map (copy-keymap gnus-article-mode-map))
+ (setq gnus-mime-button-map (make-sparse-keymap))
+ (set-keymap-parent gnus-mime-button-map gnus-article-mode-map)
(define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button)
- (define-key gnus-mime-button-map "\r" 'gnus-article-press-button)
- (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part)
- (define-key gnus-mime-button-map "v" 'gnus-mime-view-part)
- (define-key gnus-mime-button-map "o" 'gnus-mime-save-part)
- (define-key gnus-mime-button-map "c" 'gnus-mime-copy-part)
- (define-key gnus-mime-button-map "i" 'gnus-mime-inline-part)
- (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part))
+ (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu)
+ (mapcar (lambda (c)
+ (define-key gnus-mime-button-map (cadr c) (car c)))
+ gnus-mime-button-commands))
+
+(defun gnus-mime-button-menu (event)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e")
+ )
(defun gnus-mime-view-all-parts ()
"View all the MIME parts."
@@ -2206,9 +2261,17 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(defun gnus-mime-copy-part ()
"Put the the MIME part under point into a new buffer."
(interactive)
- (let* ((data (get-text-property (point) 'gnus-data))
- (contents (mm-get-part data)))
- (switch-to-buffer (generate-new-buffer "*decoded*"))
+ (let* ((handle (get-text-property (point) 'gnus-data))
+ (contents (mm-get-part handle))
+ (buffer (generate-new-buffer
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-type handle)
+ 'filename)
+ "*decoded*")))))
+ (set-buffer-major-mode buffer)
+ (switch-to-buffer buffer)
(insert contents)
(goto-char (point-min))))
@@ -2235,22 +2298,34 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(error "No such part"))
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
(gnus-article-goto-part n)
- (mm-display-part handle))))
+ (gnus-set-window-start)
+ (gnus-mm-display-part handle))))
+
+(defun gnus-mm-display-part (handle)
+ "Display HANDLE and fix MIME button."
+ (let ((id (get-text-property (point) 'gnus-part))
+ 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))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
(goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
-(defun gnus-insert-mime-button (handle)
+(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
(gnus-tmp-type (car (mm-handle-type handle)))
(gnus-tmp-description (mm-handle-description handle))
+ (gnus-tmp-dots
+ (if (if displayed (car displayed)
+ (mm-handle-displayed-p handle))
+ "" "..."))
(gnus-tmp-length (save-excursion
(set-buffer (mm-handle-buffer handle))
(buffer-size)))
- (gnus-tmp-id (1+ (length gnus-article-mime-handle-alist)))
b e)
- (push (cons gnus-tmp-id handle) gnus-article-mime-handle-alist)
(setq gnus-tmp-name
(if gnus-tmp-name
(concat " (" gnus-tmp-name ")")
@@ -2264,13 +2339,13 @@ If ALL-HEADERS is non-nil, no headers are hidden."
gnus-mime-button-line-format gnus-mime-button-line-format-alist
`(local-map ,gnus-mime-button-map
keymap ,gnus-mime-button-map
- gnus-callback mm-display-part
+ gnus-callback gnus-mm-display-part
gnus-part ,gnus-tmp-id
gnus-type annotation
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))
@@ -2286,7 +2361,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(setq ctl (condition-case ()
(mail-header-parse-content-type ct) (error nil)))))
(let* ((handles (mm-dissect-buffer))
- handle name type b e)
+ handle name type b e display)
(mapcar 'mm-destroy-part gnus-article-mime-handles)
(setq gnus-article-mime-handles handles
gnus-article-mime-handle-alist nil)
@@ -2296,14 +2371,19 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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")
+ (setq display nil)
(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")))
+ (setq display 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 display)))
+ (insert "\n\n")
+ (when display
(forward-line -2)
(mm-display-part handle t)
(goto-char (point-max))))
@@ -2786,8 +2866,10 @@ If given a prefix, show the hidden text instead."
(defvar gnus-article-edit-mode-map nil)
+;; Should we be using derived.el for this?
(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
+ (setq gnus-article-edit-mode-map (make-sparse-keymap))
+ (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
(gnus-define-keys gnus-article-edit-mode-map
"\C-c\C-c" gnus-article-edit-done
@@ -2873,7 +2955,19 @@ groups."
(save-excursion
(set-buffer buf)
(let ((buffer-read-only nil))
- (funcall func arg)))
+ (funcall func arg))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current))))
(set-buffer buf)
(set-window-start (get-buffer-window buf) start)
(set-window-point (get-buffer-window buf) (point))))
@@ -2890,18 +2984,6 @@ groups."
(insert buf)
(let ((winconf gnus-prev-winconf))
(gnus-article-mode)
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
(save-current-buffer
View
3  lisp/gnus-draft.el
@@ -135,7 +135,8 @@
(message-remove-header gnus-agent-meta-information-header)))
;; Then we send it. If we have no meta-information, we just send
;; it and let Message figure out how.
- (when (and (or (gnus-server-opened method)
+ (when (and (or (null method)
+ (gnus-server-opened method)
(gnus-open-server method))
(if type
(let ((message-this-is-news (eq type 'news))
View
3  lisp/gnus-eform.el
@@ -53,7 +53,8 @@
(defvar gnus-edit-form-mode-map nil)
(unless gnus-edit-form-mode-map
- (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map))
+ (setq gnus-edit-form-mode-map (make-sparse-keymap))
+ (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map)
(gnus-define-keys gnus-edit-form-mode-map
"\C-c\C-c" gnus-edit-form-done
"\C-c\C-k" gnus-edit-form-exit))
View
1  lisp/gnus-ems.el
@@ -33,6 +33,7 @@
"Non-nil if running under XEmacs.")
(defvar gnus-mouse-2 [mouse-2])
+(defvar gnus-mouse-3 [mouse-3])
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
View
20 lisp/gnus-group.el
@@ -3336,26 +3336,26 @@ and the second element is the address."
(defun gnus-add-marked-articles (group type articles &optional info force)
;; Add ARTICLES of TYPE to the info of GROUP.
- ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
+ ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
;; add, but replace marked articles of TYPE with ARTICLES.
(let ((info (or info (gnus-get-info group)))
marked m)
(or (not info)
(and (not (setq marked (nthcdr 3 info)))
(or (null articles)
- (setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t)))))))
(and (not (setq m (assq type (car marked))))
(or (null articles)
- (setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
- (car marked)))))
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))))
(if force
(if (null articles)
- (setcar (nthcdr 3 info)
- (gnus-delete-alist type (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
+ (setcar (nthcdr 3 info)
+ (gnus-delete-alist type (car marked)))
+ (setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
View
10 lisp/gnus-int.el
@@ -308,6 +308,16 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(funcall (gnus-get-function gnus-command-method 'request-type)
(gnus-group-real-name group) article))))
+(defun gnus-request-set-mark (group action)
+ "Set marks on articles in the backend."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (if (not (gnus-check-backend-function
+ 'request-set-mark (car gnus-command-method)))
+ action
+ (funcall (gnus-get-function gnus-command-method 'request-set-mark)
+ (gnus-group-real-name group) action
+ (nth 1 gnus-command-method)))))
+
(defun gnus-request-update-mark (group article mark)
"Allow the backend to change the mark the user tries to put on an article."
(let ((gnus-command-method (gnus-find-method-for-group group)))
View
1  lisp/gnus-msg.el
@@ -620,6 +620,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding."
(set-buffer gnus-original-article-buffer)
(setq text (buffer-string)))
(set-buffer (gnus-get-buffer-create " *Gnus forward*"))
+ (erase-buffer)
(insert text)
(run-hooks 'gnus-article-decode-hook)
(let ((message-included-forward-headers
View
2  lisp/gnus-range.el
@@ -229,7 +229,7 @@ Note: LIST has to be sorted over `<'."
Note: LIST has to be sorted over `<'."
;; !!! This function shouldn't look like this, but I've got a headache.
(gnus-compress-sequence
- (gnus-sorted-complement
+ (gnus-set-difference
(gnus-uncompress-range ranges) list)))
(defun gnus-member-of-range (number ranges)
View
14 lisp/gnus-sum.el
@@ -34,6 +34,7 @@
(require 'gnus-int)
(require 'gnus-undo)
(require 'gnus-util)
+(require 'mm-decode)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
@@ -1516,7 +1517,7 @@ increase the score of each group you read."
["Words" gnus-article-decode-mime-words t]
["Charset" gnus-article-decode-charset t]
["QP" gnus-article-de-quoted-unreadable t]
- ["View all" gnus-mime-view-all-parts])
+ ["View all" gnus-mime-view-all-parts t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
@@ -4139,7 +4140,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- type list newmarked symbol)
+ type list newmarked symbol delta-marks)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
(while (setq type (pop types))
@@ -5168,7 +5169,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (gnus-run-hooks (delq 'gnus-summary-expire-articles
+ (copy-list gnus-summary-prepare-exit-hook)))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
@@ -8956,8 +8958,9 @@ save those articles instead."
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
+ (setq read (if (> (length read) 1) (nreverse read) read))
(if compute
- (if (> (length read) 1) (nreverse read) read)
+ read
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-undo-register
@@ -8967,8 +8970,7 @@ save those articles instead."
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
(gnus-group-update-group ,group t))))
;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
+ (gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
t))))
View
6 lisp/gnus-util.el
@@ -908,6 +908,12 @@ ARG is passed to the first function."
re
(unless (string-match "\\$$" re) ".*$")))
+(defun gnus-set-window-start (&optional point)
+ "Set the window start to POINT, or (point) if nil."
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (when win
+ (set-window-start win (or point (point))))))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
View
4 lisp/gnus-uu.el
@@ -1796,7 +1796,9 @@ is t."
(gnus-summary-post-news)
- (use-local-map (copy-keymap (current-local-map)))
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map (current-local-map))
+ (use-local-map map))
(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
(local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
View
16 lisp/gnus-xmas.el
@@ -386,6 +386,7 @@ call it with the value of the `gnus-data' text property."
(defun gnus-xmas-define ()
(setq gnus-mouse-2 [button2])
+ (setq gnus-mouse-3 [button3])
(setq gnus-widget-button-keymap widget-button-keymap)
(unless (memq 'underline (face-list))
@@ -463,7 +464,8 @@ call it with the value of the `gnus-data' text property."
(fset 'gnus-key-press-event-p 'key-press-event-p)
(fset 'gnus-region-active-p 'region-active-p)
(fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
-
+ (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu)
+
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
(add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
@@ -792,6 +794,18 @@ XEmacs compatibility workaround."
(defun gnus-xmas-annotation-in-region-p (b e)
(map-extents (lambda (e u) t) nil b e nil nil 'mm t))
+(defun gnus-xmas-mime-button-menu (event)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e")
+ (let ((response (get-popup-menu-response
+ `("MIME Part"
+ ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t])
+ gnus-mime-button-commands)))))
+ (set-buffer (event-buffer event))
+ (goto-char (event-point event))
+ (funcall (event-function response) (event-object response))))
+
+
(provide 'gnus-xmas)
;;; gnus-xmas.el ends here
View
2  lisp/gnus.el
@@ -250,7 +250,7 @@ is restarted, and sometimes reloaded."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.34"
+(defconst gnus-version-number "0.35"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
View
4 lisp/lpath.el
@@ -34,7 +34,7 @@
set-buffer-multibyte
find-non-ascii-charset-region char-charset
mule-write-region-no-coding-system
- find-charset-region base64-decode-string
+ find-charset-region
find-coding-systems-region get-charset-property
coding-system-get w3-region
rmail-summary-exists rmail-select-summary
@@ -69,7 +69,7 @@
mm-copy-tree url-view-url w3-prepare-buffer
mule-write-region-no-coding-system char-int
annotationp delete-annotation make-image-specifier
- make-annotation base64-decode-string base64-encode-region
+ make-annotation
w3-do-setup w3-region
rmail-summary-exists rmail-select-summary rmail-update-summary
)))
View
7 lisp/mailcap.el
@@ -117,7 +117,7 @@
(viewer . "maplay %s")
(type . "audio/x-mpeg"))
(".*"
- (viewer . mm-view-sound-file)
+ (viewer . mailcap-save-binary-file)
(test . (or (featurep 'nas-sound)
(featurep 'native-sound)))
(type . "audio/*"))
@@ -322,7 +322,8 @@ If FORCE, re-parse even if already parsed."
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
+ (if (and (file-exists-p fname) (file-readable-p fname)
+ (file-regular-p fname))
(mailcap-parse-mailcap (car fnames)))
(setq fnames (cdr fnames))))
(setq mailcap-parsed-p t)))
@@ -632,7 +633,7 @@ this type is returned."
(if (mailcap-viewer-passes-test (car viewers) info)
(setq passed (cons (car viewers) passed)))
(setq viewers (cdr viewers)))
- (setq passed (sort passed 'mailcap-viewer-lessp))
+ (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
(setq viewer (car passed))))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
View
140 lisp/message.el
@@ -212,7 +212,7 @@ included. Organization, Lines and User-Agent are optional."
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
@@ -646,10 +646,10 @@ the prefix.")
The default is `abbrev', which uses mailabbrev. nil switches
mail aliases off.")
-(defcustom message-autosave-directory
+(defcustom message-auto-save-directory
(nnheader-concat message-directory "drafts/")
- "*Directory where Message autosaves buffers if Gnus isn't running.
-If nil, Message won't autosave."
+ "*Directory where Message auto-saves buffers if Gnus isn't running.
+If nil, Message won't auto-save."
:group 'message-buffers
:type 'directory)
@@ -1227,7 +1227,8 @@ Point is left at the beginning of the narrowed-to region."
(defvar message-mode-map nil)
(unless message-mode-map
- (setq message-mode-map (copy-keymap text-mode-map))
+ (setq message-mode-map (make-keymap))
+ (set-keymap-parent message-mode-map text-mode-map)
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
@@ -1327,6 +1328,7 @@ C-c C-w message-insert-signature (insert `message-signature-file' file).
C-c C-y message-yank-original (insert current message, if any).
C-c C-q message-fill-yanked-message (fill what was yanked).
C-c C-e message-elide-region (elide the text between point and mark).
+C-c C-v message-delete-not-region (remove the text outside the region).
C-c C-z message-kill-to-signature (kill the text up to the signature).
C-c C-r message-caesar-buffer-body (rot13 the message body)."
(interactive)
@@ -1503,7 +1505,8 @@ With the prefix argument FORCE, insert the header anyway."
(let ((co (message-fetch-reply-field "mail-copies-to")))
(when (and (null force)
co
- (equal (downcase co) "never"))
+ (or (equal (downcase co) "never")
+ (equal (downcase co) "nobody")))
(error "The user has requested not to have copies sent via mail")))
(when (and (message-position-on-field "To")
(mail-fetch-field "to")
@@ -1945,46 +1948,42 @@ or error messages, and inform user.
Otherwise any failure is reported in a message back to
the user from the mailer."
(interactive "P")
- ;; Disabled test.
- (when (or (buffer-modified-p)
- (message-check-element 'unchanged)
- (y-or-n-p "No changes in the buffer; really send? "))
- ;; Make it possible to undo the coming changes.
- (undo-boundary)
- (let ((inhibit-read-only t))
- (put-text-property (point-min) (point-max) 'read-only nil))
- (message-fix-before-sending)
- (run-hooks 'message-send-hook)
- (message "Sending...")
- (let ((alist message-send-method-alist)
- (success t)
- elem sent)
- (while (and success
- (setq elem (pop alist)))
- (when (and (or (not (funcall (cadr elem)))
- (and (or (not (memq (car elem)
- message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
- (setq success (funcall (caddr elem) arg)))))
- (setq sent t)))
- (when (and success sent)
- (message-do-fcc)
- ;;(when (fboundp 'mail-hist-put-headers-into-history)
- ;; (mail-hist-put-headers-into-history))
- (run-hooks 'message-sent-hook)
- (message "Sending...done")
- ;; Mark the buffer as unmodified and delete autosave.
- (set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t)
- (message-disassociate-draft)
- ;; Delete other mail buffers and stuff.
- (message-do-send-housekeeping)
- (message-do-actions message-send-actions)
- ;; Return success.
- t))))
+ ;; Make it possible to undo the coming changes.
+ (undo-boundary)
+ (let ((inhibit-read-only t))
+ (put-text-property (point-min) (point-max) 'read-only nil))
+ (message-fix-before-sending)
+ (run-hooks 'message-send-hook)
+ (message "Sending...")
+ (let ((alist message-send-method-alist)
+ (success t)
+ elem sent)
+ (while (and success
+ (setq elem (pop alist)))
+ (when (and (or (not (funcall (cadr elem)))
+ (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg)))))
+ (setq sent t)))
+ (when (and success sent)
+ (message-do-fcc)
+ ;;(when (fboundp 'mail-hist-put-headers-into-history)
+ ;; (mail-hist-put-headers-into-history))
+ (run-hooks 'message-sent-hook)
+ (message "Sending...done")
+ ;; Mark the buffer as unmodified and delete auto-save.
+ (set-buffer-modified-p nil)
+ (delete-auto-save-file-if-necessary t)
+ (message-disassociate-draft)
+ ;; Delete other mail buffers and stuff.
+ (message-do-send-housekeeping)
+ (message-do-actions message-send-actions)
+ ;; Return success.
+ t)))
(defun message-send-via-mail (arg)
"Send the current message via mail."
@@ -1994,6 +1993,15 @@ the user from the mailer."
"Send the current message via news."
(funcall message-send-news-function arg))
+(defmacro message-check (type &rest forms)
+ "Eval FORMS if TYPE is to be checked."
+ `(or (message-check-element ,type)
+ (save-excursion
+ ,@forms)))
+
+(put 'message-check 'lisp-indent-function 1)
+(put 'message-check 'edebug-form-spec '(form body))
+
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; Make sure there's a newline at the end of the message.
@@ -2266,15 +2274,6 @@ to find out how to use this."
;;; Header generation & syntax checking.
;;;
-(defmacro message-check (type &rest forms)
- "Eval FORMS if TYPE is to be checked."
- `(or (message-check-element ,type)
- (save-excursion
- ,@forms)))
-
-(put 'message-check 'lisp-indent-function 1)
-(put 'message-check 'edebug-form-spec '(form body))
-
(defun message-check-element (type)
"Returns non-nil if this type is not to be checked."
(if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
@@ -2638,12 +2637,15 @@ If NOW, use that time instead."
(sign "+"))
(when (< zone 0)
(setq sign ""))
- ;; We do all of this because XEmacs doesn't have the %z spec.
- (concat (format-time-string
- "%d %b %Y %H:%M:%S " (or now (current-time)))
- (format "%s%02d%02d"
- sign (/ zone 3600)
- (% zone 3600)))))
+ (concat
+ (format-time-string "%d" now)
+ ;; The month name of the %b spec is locale-specific. Pfff.
+ (format " %s "
+ (capitalize (car (rassoc (nth 4 (decode-time now))
+ parse-time-months))))
+ (format-time-string "%Y %H:%M:%S " now)
+ ;; We do all of this because XEmacs doesn't have the %z spec.
+ (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600)))))
(defun message-make-message-id ()
"Make a unique Message-ID."
@@ -3254,12 +3256,12 @@ Headers already prepared in the buffer are not modified."
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
- (when message-autosave-directory
+ (when message-auto-save-directory
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(setq buffer-file-name (expand-file-name "*message*"
- message-autosave-directory))
+ message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)))
@@ -3341,10 +3343,12 @@ OTHER-HEADERS is an alist of header/value pairs."
;; Handle special values of Mail-Copies-To.
(when mct
- (cond ((equal (downcase mct) "never")
+ (cond ((or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))
(setq never-mct t)
(setq mct nil))
- ((equal (downcase mct) "always")
+ ((or (equal (downcase mct) "always")
+ (equal (downcase mct) "poster"))
(setq mct (or reply-to from)))))
(unless follow-to
@@ -3511,8 +3515,10 @@ responses here are directed to other newsgroups."))
`((References . ,(concat (or references "") (and references " ")
(or message-id "")))))
,@(when (and mct
- (not (equal (downcase mct) "never")))
- (list (cons 'Cc (if (equal (downcase mct) "always")
+ (not (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))))
+ (list (cons 'Cc (if (or (equal (downcase mct) "always")
+ (equal (downcase mct) "poster"))
(or reply-to from "")
mct)))))
View
7 lisp/mm-bodies.el
@@ -26,7 +26,8 @@
(eval-and-compile
(or (fboundp 'base64-decode-region)
- (autoload 'base64-decode-region "base64" nil t)))
+ (require 'base64)))
+
(require 'mm-util)
(require 'rfc2047)
(require 'qp)
@@ -113,12 +114,12 @@ If no encoding was done, nil is returned."
)
((eq encoding 'x-uuencode)
(condition-case ()
- (uu-decode-region (point-min) (point-max))
+ (uudecode-decode-region (point-min) (point-max))
(error nil)))
(t
(error "Can't decode encoding %s" 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))
View
54 lisp/mm-decode.el
@@ -28,6 +28,23 @@
(require 'mailcap)
(require 'mm-bodies)
+;;; Convenience macros.
+
+(defmacro mm-handle-buffer (handle)
+ `(nth 0 ,handle))
+(defmacro mm-handle-type (handle)
+ `(nth 1 ,handle))
+(defmacro mm-handle-encoding (handle)
+ `(nth 2 ,handle))
+(defmacro mm-handle-undisplayer (handle)
+ `(nth 3 ,handle))
+(defmacro mm-handle-set-undisplayer (handle function)
+ `(setcar (nthcdr 3 ,handle) ,function))
+(defmacro mm-handle-disposition (handle)
+ `(nth 4 ,handle))
+(defmacro mm-handle-description (handle)
+ `(nth 5 ,handle))
+
(defvar mm-inline-media-tests
'(("image/jpeg" mm-inline-image (featurep 'jpeg))
("image/png" mm-inline-image (featurep 'png))
@@ -51,10 +68,12 @@
(defvar mm-user-display-methods
'(("image/.*" . inline)
- ("text/.*" . inline)))
+ ("text/.*" . inline)
+ ("message/delivery-status" . inline)))
(defvar mm-user-automatic-display
- '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif"))
+ '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif"
+ "message/delivery-status"))
(defvar mm-alternative-precedence
'("text/plain" "text/enriched" "text/richtext" "text/html")
@@ -69,23 +88,6 @@
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
-;;; Convenience macros.
-
-(defmacro mm-handle-buffer (handle)
- `(nth 0 ,handle))
-(defmacro mm-handle-type (handle)
- `(nth 1 ,handle))
-(defmacro mm-handle-encoding (handle)
- `(nth 2 ,handle))
-(defmacro mm-handle-undisplayer (handle)
- `(nth 3 ,handle))
-(defmacro mm-handle-set-undisplayer (handle function)
- `(setcar (nthcdr 3 ,handle) ,function))
-(defmacro mm-handle-disposition (handle)
- `(nth 4 ,handle))
-(defmacro mm-handle-description (handle)
- `(nth 5 ,handle))
-
;;; The functions.
(defun mm-dissect-buffer (&optional no-strict-mime)
@@ -186,7 +188,7 @@
"Display the MIME part represented by HANDLE."
(save-excursion
(mailcap-parse-mailcaps)
- (if (mm-handle-undisplayer handle)
+ (if (mm-handle-displayed-p handle)
(mm-remove-part handle)
(let* ((type (car (mm-handle-type handle)))
(method (mailcap-mime-info type))
@@ -209,7 +211,10 @@
(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)
+ (set-buffer (generate-new-buffer "*mm*"))
+ (select-window (get-buffer-window cur t))
+ (switch-to-buffer (generate-new-buffer "*mm*")))
(buffer-disable-undo)
(mm-set-buffer-file-coding-system 'no-conversion)
(insert-buffer-substring cur)
@@ -277,7 +282,8 @@
(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."
@@ -324,6 +330,10 @@ This overrides entries in the mailcap file."
(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)
View
5 lisp/mm-util.el
@@ -171,6 +171,11 @@ used as the line break code type of the coding system."
(when (fboundp 'set-buffer-multibyte)
(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
View
1  lisp/mm-view.el
@@ -26,6 +26,7 @@
(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
+(require 'mm-decode)
;;;
;;; Functions for displaying various formats inline
View
3  lisp/nnagent.el
@@ -73,7 +73,8 @@
(ftp-error (setq err (format "%s" arg)))))
(nnagent-close-server)
(nnheader-report
- 'nnagent (or err "No such file or directory: %s" dir)))
+ 'nnagent (or err
+ (format "No such file or directory: %s" dir))))
((not (file-directory-p (file-truename dir)))
(nnagent-close-server)
(nnheader-report 'nnagent "Not a directory: %s" dir))
View
2  lisp/nndoc.el
@@ -454,7 +454,7 @@ from the document.")
(when (and limit
(re-search-forward
(concat "\
-^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*"
+^Content-Type:[ \t]*multipart/[a-z]+ *;\\(.*;\\)*"
"[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]")
limit t))
t)))
View
2  lisp/nnheader.el
@@ -446,7 +446,7 @@ the line could be found."
nil
(narrow-to-region (point-min) (1- (point)))
(goto-char (point-min))
- (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+ (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
(goto-char (match-end 0)))
(prog1
(eobp)
View
11 lisp/nnmail.el
@@ -241,6 +241,13 @@ to be moved to."
:group 'nnmail-retrieve
:type 'string)
+(defcustom nnmail-movemail-args nil
+ "*Extra arguments to give to `nnmail-movemail-program' to move mail from the inbox.
+The default is nil"
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
+ :type 'string)
+
(defcustom nnmail-pop-password-required nil
"*Non-nil if a password is required when reading mail using POP."
:group 'nnmail-retrieve
@@ -597,7 +604,9 @@ parameter. It should return nil, `warn' or `delete'."
nnmail-movemail-program exec-directory)
nil errors nil inbox tofile)
(when nnmail-internal-password
- (list nnmail-internal-password)))))))
+ (list nnmail-internal-password))
+ (when nnmail-movemail-args
+ nnmail-movemail-args))))))
(push inbox nnmail-moved-inboxes)
(if (and (not (buffer-modified-p errors))
(zerop result))
View
10 lisp/pop3.el
@@ -111,14 +111,16 @@ Used for APOP authentication.")
Returns the process associated with the connection."
(let ((process-buffer
(get-buffer-create (format "trace of POP session to %s" mailhost)))
- (process))
+ (process)
+ (coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion)
+ )
(save-excursion
(set-buffer process-buffer)
- (erase-buffer)
- (setq pop3-read-point (point-min))
- )
+ (erase-buffer))
(setq process
(open-network-stream "POP" process-buffer mailhost port))
+ (setq pop3-read-point (point-min))
(let ((response (pop3-read-response process t)))
(setq pop3-timestamp
(substring response (or (string-match "<" response) 0)
View
172 lisp/rfc1843.el
@@ -0,0 +1,172 @@
+;;; rfc1843.el --- HZ (rfc1843) decoding
+;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; $Revision: 1.3 $
+;; 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 (following-char) ?\n)
+ (delete-char -1)
+ (delete-char 1))
+ ((eq (following-char) ?~)
+ (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
View
4 lisp/rfc2047.el
@@ -27,8 +27,8 @@
(eval-and-compile
(eval
'(unless (fboundp 'base64-decode-string)
- (autoload 'base64-decode-string "base64")
- (autoload 'base64-encode-region "base64" nil t))))
+ (require 'base64))))
+
(require 'qp)
(require 'mm-util)
(require 'ietf-drums)
View
3  lisp/score-mode.el
@@ -39,7 +39,8 @@
(defvar gnus-score-mode-map nil)
(unless gnus-score-mode-map
- (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
+ (setq gnus-score-mode-map (make-sparse-keymap))
+ (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map)
(define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
(define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
(define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
View
87 lisp/uudecode.el
@@ -2,27 +2,29 @@
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 1.1 $
+;; $Revision: 1.3 $
;; Keywords: uudecode
-;; This file is part of GNU Emacs.
-;;
+;; This file is not part of GNU Emacs, but the same permissions
+;; apply.
+
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
-;;
+
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;
+
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;; Commentary:
+;;; Commentary:
+
;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and
;; base64.el
@@ -31,34 +33,37 @@
(if (not (fboundp 'char-int))
(fset 'char-int 'identity))
-(defvar uu-decoder-program "uudecode"
+(defvar uudecode-decoder-program "uudecode"
"*Non-nil value should be a string that names a uu decoder.
The program should expect to read uu data on its standard
input and write the converted data to its standard output.")
-(defvar uu-decoder-switches nil
- "*List of command line flags passed to the command named by uu-decoder-program.")
+(defvar uudecode-decoder-switches nil
+ "*List of command line flags passed to the command named by uudecode-decoder-program.")
-(defvar uu-alphabet "\040-\140")
+(defconst uudecode-alphabet "\040-\140")
-(defvar uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defvar uu-end-string "^end[ \t]*$")
+(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defconst uudecode-end-line "^end[ \t]*$")
-(defvar uu-body-line
+(defconst uudecode-body-line
(let ((i 61) (str "^M"))
(while (> (setq i (1- i)) 0)
(setq str (concat str "[^a-z]")))
(concat str ".?$")))
-(defvar uu-temporary-file-directory "/tmp/")
+(defvar uudecode-temporary-file-directory "/tmp/")
-(defun uu-decode-region-external (start end &optional file-name)
- "Decode uuencoded files using an external program."
+;;;###autoload
+(defun uudecode-decode-region-external (start end &optional file-name)
+ "uudecode region between START and END with external decoder.
+
+If FILE-NAME is non-nil, save the result to FILE-NAME."
(interactive "r\nP")
(let ((cbuf (current-buffer)) tempfile firstline work-buffer status)
(save-excursion
(goto-char start)
- (when (re-search-forward uu-begin-string nil t)
+ (when (re-search-forward uudecode-begin-line nil t)
(forward-line 1)
(setq firstline (point))
(cond ((null file-name))
@@ -68,7 +73,7 @@ input and write the converted data to its standard output.")
nil nil nil
(match-string 1)))))
(setq tempfile (expand-file-name
- (or file-name (concat uu-temporary-file-directory
+ (or file-name (concat uudecode-temporary-file-directory
(make-temp-name "uu")))))
(let ((cdir default-directory) default-process-coding-system)
(unwind-protect
@@ -82,11 +87,11 @@ input and write the converted data to its standard output.")
(apply 'call-process-region
(point-min)
(point-max)
- uu-decoder-program
+ uudecode-decoder-program
nil
nil
nil
- uu-decoder-switches))
+ uudecode-decoder-switches))
(cd cdir) (set-buffer cbuf)))
(if (file-exists-p tempfile)
(unless file-name
@@ -98,25 +103,30 @@ input and write the converted data to its standard output.")
(and work-buffer (kill-buffer work-buffer))
(condition-case ()
(or file-name (delete-file tempfile))
- (error)))))
+ (error))
+ )))
-(defun uu-insert-char (char &optional count ignored buffer)
+(defun uudecode-insert-char (char &optional count ignored buffer)
(condition-case nil
(progn
(insert-char char count ignored buffer)
- (fset 'uu-insert-char 'insert-char))
+ (fset 'uudecode-insert-char 'insert-char))
(wrong-number-of-arguments
- (fset 'uu-insert-char 'uu-xemacs-insert-char)
- (uu-insert-char char count ignored buffer))))
+ (fset 'uudecode-insert-char 'uudecode-xemacs-insert-char)
+ (uudecode-insert-char char count ignored buffer))))
-(defun uu-xemacs-insert-char (char &optional count ignored buffer)
+(defun uudecode-xemacs-insert-char (char &optional count ignored buffer)
(if (or (null buffer) (eq buffer (current-buffer)))
(insert-char char count)
(save-excursion
(set-buffer buffer)
(insert-char char count))))
-(defun uu-decode-region (start end &optional file-name)
+;;;###autoload
+
+(defun uudecode-decode-region (start end &optional file-name)
+ "uudecode region between START and END.
+If FILE-NAME is non-nil, save the result to FILE-NAME."
(interactive "r\nP")
(let ((work-buffer nil)
(done nil)
@@ -124,11 +134,11 @@ input and write the converted data to its standard output.")
(remain 0)
(bits 0)
(lim 0) inputpos
- (non-data-chars (concat "^" uu-alphabet)))
+ (non-data-chars (concat "^" uudecode-alphabet)))
(unwind-protect
(save-excursion
(goto-char start)
- (when (re-search-forward uu-begin-string nil t)
+ (when (re-search-forward uudecode-begin-line nil t)
(cond ((null file-name))
((stringp file-name))
(t
@@ -144,7 +154,7 @@ input and write the converted data to its standard output.")
(setq inputpos (point))
(setq remain 0 bits 0 counter 0)
(cond
- ((> (skip-chars-forward uu-alphabet end) 0)
+ ((> (skip-chars-forward uudecode-alphabet end) 0)
(setq lim (point))
(setq remain
(logand (- (char-int (char-after inputpos)) 32) 63))
@@ -159,10 +169,11 @@ input and write the converted data to its standard output.")
(setq counter (1+ counter)
inputpos (1+ inputpos))
(cond ((= counter 4)
- (uu-insert-char (lsh bits -16) 1 nil work-buffer)
- (uu-insert-char (logand (lsh bits -8) 255) 1 nil
- work-buffer)
- (uu-insert-char (logand bits 255) 1 nil
+ (uudecode-insert-char
+ (lsh bits -16) 1 nil work-buffer)
+ (uudecode-insert-char
+ (logand (lsh bits -8) 255) 1 nil work-buffer)
+ (uudecode-insert-char (logand bits 255) 1 nil
work-buffer)
(setq bits 0 counter 0))
(t (setq bits (lsh bits 6)))))))
@@ -172,15 +183,15 @@ input and write the converted data to its standard output.")
(error "uucode line ends unexpectly")
(setq done t))
((and (= (point) end) (not done))
- (error "uucode ends unexpectly")
+ ;(error "uucode ends unexpectly")
(setq done t))
((= counter 3)
- (uu-insert-char (logand (lsh bits -16) 255) 1 nil
+ (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
work-buffer)
- (uu-insert-char (logand (lsh bits -8) 255) 1 nil
+ (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
work-buffer))
((= counter 2)
- (uu-insert-char (logand (lsh bits -10) 255) 1 nil
+ (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
work-buffer)))
(skip-chars-forward non-data-chars end))
(if file-name
View
16 texi/ChangeLog
@@ -1,3 +1,19 @@
+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.
View
255 texi/emacs-mime.texi
@@ -86,40 +86,21 @@ recommended that anyone who intends writing @sc{mime}-compliant software
read at least RFC2045 and RFC2047.
@menu
+* Interface Functions:: An abstraction over the basic functions.
* Basic Functions:: Utility and basic parsing functions.
* Decoding and Viewing:: A framework for decoding and viewing.
+* Standards:: A summary of RFCs and working documents used.
* Index:: Function and variable index.
@end menu
-@node Basic Functions
-@chapter Basic Functions
+@node Interface Functions
+@chapter Interface Functions
+@cindex interface functions
+@cindex mail-parse
-This chapter describes the basic, ground-level functions for parsing and
-handling. Covered here is parsing @code{From} lines, removing comments
-from header lines, decoding encoded words, parsing date headers and so
-on. High-level functionality is dealt with in the next chapter
-(@pxref{Decoding and Viewing}).
-
-@menu
-* mail-parse:: The generalized @sc{mime} and mail interface.
-* rfc2231:: Parsing @code{Content-Type} headers.
-* drums:: Handling mail headers defined by RFC822bis.
-* rfc2047:: En/decoding encoded words in headers.
-* time-date:: Functions for parsing dates and manipulating time.
-* qp:: Quoted-Printable en/decoding.
-* base64:: Base64 en/decoding.
-* mailcap:: How parts are displayed is specified by the @file{.mailcap} file
-@end menu
-
-
-@node mail-parse
-@section mail-parse
-
-It is perhaps misleading to place the @code{mail-parse} library in this
-chapter. It is not a basic low-level library---rather, it is an
-abstraction over the actual low-level libraries that are described in the
-subsequent sections.
+The @code{mail-parse} library is an abstraction over the actual
+low-level libraries that are described in the next chapter.
Standards change, and so programs have to change to fit in the new
mold. For instance, RFC2045 describes a syntax for the
@@ -165,7 +146,7 @@ Here's an example:
@example
(mail-header-parse-content-type
"image/gif; name=\"b980912.gif\"")
-=> ("image/gif" (name . "b980912.gif"))
+@result{} ("image/gif" (name . "b980912.gif"))
@end example
@item mail-header-parse-content-disposition
@@ -181,7 +162,7 @@ Returns the value of the attribute.
@example
(mail-content-type-get
'("image/gif" (name . "b980912.gif")) 'name)
-=> "b980912.gif"
+@result{} "b980912.gif"
@end example
@item mail-header-remove-comments
@@ -191,7 +172,7 @@ Return a comment-free version of a header.
@example
(mail-header-remove-comments
"Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
-=> "Gnus/5.070027 "
+@result{} "Gnus/5.070027 "
@end example
@item mail-header-remove-whitespace
@@ -202,7 +183,7 @@ and comments is preserved.
@example
(mail-header-remove-whitespace
"image/gif; name=\"Name with spaces\"")
-=> "image/gif;name=\"Name with spaces\""
+@result{} "image/gif;name=\"Name with spaces\""
@end example
@item mail-header-get-comment
@@ -212,7 +193,7 @@ Return the last comment in a header.
@example
<