+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.
--- /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.2.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
+
+
(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)
(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)
(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."
;; 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)
(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
;;; 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*")))))
+ (set-buffer-major-mode buffer)
+ (switch-to-buffer buffer)
(insert contents)
(goto-char (point-min))))
(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 ")")
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 from to :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))
(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)
(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))))
(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
(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
(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)))
(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/*"))
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)))
(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)
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)
(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))
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)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(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))))
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)
(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))
(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
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.023"
+(defconst gnus-version-number "6.10.024"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.34"
+(defconst gnus-original-version-number "0.35"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
"Version number for this version of Gnus.")
(defconst gnus-version
- (format "%s %s (based on %s %s ; for SEMI 1.8/1.9, FLIM 1.8/1.9/1.10)"
- gnus-product-name gnus-version-number
+ (format "%s %s (based on %s %s ; for SEMI 1.8-1.10, FLIM 1.8-1.11)"
+ gnus-product-name gnus-version-number
gnus-original-product-name gnus-original-version-number)
"Version string for this version of gnus.")
url-view-url w3-prepare-buffer
set-buffer-multibyte
find-non-ascii-charset-region char-charset
- find-charset-region base64-decode-string
- base64-encode-string
+ find-charset-region
find-coding-systems-region get-charset-property
coding-system-get w3-region
rmail-summary-exists rmail-select-summary
url-view-url w3-prepare-buffer
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
)))
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)
(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")
"Send the current message via news."
(message-send-news 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)
(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-followup-subject (subject)
"Make a followup Subject."
(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
- ((and (equal (downcase mct) "never")
+ ((and (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))
(or (not (eq message-use-mail-copies-to 'ask))
(message-y-or-n-p
(concat "Obey Mail-Copies-To: never? ") t "\
directs you not to send your response to the author.")))
(setq never-mct t)
(setq mct nil))
- ((and (equal (downcase mct) "always")
+ ((and (or (equal (downcase mct) "always")
+ (equal (downcase mct) "poster"))
(or (not (eq message-use-mail-copies-to 'ask))
(message-y-or-n-p
(concat "Obey Mail-Copies-To: always? ") t "\
;; Handle special values of Mail-Copies-To.
(when mct
(cond
- ((and (equal (downcase mct) "never")
+ ((and (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))
(or (not (eq message-use-mail-copies-to 'ask))
(message-y-or-n-p
(concat "Obey Mail-Copies-To: never? ") t "\
`Mail-Copies-To: never'
directs you not to send your response to the author.")))
(setq mct nil))
- ((and (equal (downcase mct) "always")
+ ((and (or (equal (downcase mct) "always")
+ (equal (downcase mct) "poster"))
(or (not (eq message-use-mail-copies-to 'ask))
(message-y-or-n-p
(concat "Obey Mail-Copies-To: always? ") t "\
(eval-and-compile
(or (fboundp 'base64-decode-region)
- (autoload 'base64-decode-region "base64" nil t)))
+ (require 'base64)))
+
(require 'mm-util)
(require 'rfc2047)
(require 'qp)
)
((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))
(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))
(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")
(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)
"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))
(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)
(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."
(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)
(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
(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
+(require 'mm-decode)
;;;
;;; Functions for displaying various formats inline
(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)))
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)
: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
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))
(save-excursion
(set-buffer process-buffer)
(erase-buffer)
- (setq pop3-read-point (point-min))
- )
- (setq process
- (open-network-stream "POP" process-buffer mailhost port))
+ (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)
--- /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.2.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 (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
(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)
(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))
;; 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
(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
projects / elisp / gnus.git- / commitdiff