From 0c4b59d3908f205a5942cc34faffe6d3e7bb3250 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 20 Oct 1998 00:10:16 +0000 Subject: [PATCH] * lisp/gnus.el (gnus-version-number): Update to 6.10.024. Fix supported version for FLIM and SEMI. * Sync up with Pterodactyl Gnus 0.35. A snapshot is available from: ftp://ftp.jpl.org/pub/tmp/semi-gnus-pgnus-ichikawa-19981020-1.tar.gz --- lisp/ChangeLog | 200 ++++++++++++++++++++++++++++++++ lisp/binhex.el | 316 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-art.el | 161 ++++++++++++++++++------- lisp/gnus-eform.el | 3 +- lisp/gnus-ems.el | 1 + lisp/gnus-group.el | 20 ++-- lisp/gnus-int.el | 10 ++ lisp/gnus-mailcap.el | 7 +- lisp/gnus-range.el | 2 +- lisp/gnus-sum.el | 11 +- lisp/gnus-util.el | 6 + lisp/gnus-uu.el | 4 +- lisp/gnus-xmas.el | 16 ++- lisp/gnus.el | 8 +- lisp/lpath.el | 5 +- lisp/message.el | 62 +++++----- lisp/mm-bodies.el | 7 +- lisp/mm-decode.el | 54 +++++---- lisp/mm-util.el | 5 + lisp/mm-view.el | 1 + lisp/nndoc.el | 2 +- lisp/nnheader.el | 2 +- lisp/nnmail.el | 11 +- lisp/pop3.el | 6 +- lisp/rfc1843.el | 172 +++++++++++++++++++++++++++ lisp/rfc2047.el | 4 +- lisp/score-mode.el | 3 +- lisp/uudecode.el | 87 ++++++++------ 28 files changed, 1018 insertions(+), 168 deletions(-) create mode 100644 lisp/binhex.el create mode 100644 lisp/rfc1843.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7667891..cfe19aa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,199 @@ +Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.35 is released. + +1998-10-20 00:00:36 Lars Magne Ingebrigtsen + + * uudecode.el (uudecode-decode-region-external): Insert + literally. + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. + + * mm-bodies.el (mm-decode-body): Optional encoding. + +1998-10-19 23:57:57 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-mouse-3): New variable. + + * binhex.el (binhex-decode-region-external): Don't use -internally. + +1998-10-16 14:54:02 Simon Josefsson + + * mailcap.el (mailcap-parse-mailcaps): Only open regular + files. + +1998-09-26 22:28:01 Simon Josefsson + + * gnus-group.el (gnus-add-marked-articles): Request backend update + of flags. + +1998-09-26 19:39:31 Simon Josefsson + + * gnus-sum.el (gnus-update-read-articles): + (gnus-update-marks): Request backend update of mark. + +1998-09-26 19:33:58 Simon Josefsson + + * gnus.texi (Optional Backend Functions): New item, + nnchoke-request-set-mark. + +1998-09-26 16:27:27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Don't add stuff in + list to range. + +1998-10-19 23:45:13 Simon Josefsson + + * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. + +1998-10-14 SL Baur + + * gnus-sum.el: Move gnus-save-hidden-threads above where it is + first used. + +1998-10-10 SL Baur + + * mm-view.el: Require mm-decode for macros. + + * mm-decode.el (mm-handle-type): Move macro declarations above the + place where they are used. + +Sun Oct 18 13:59:07 1998 Kurt Swanson + + * gnus-msg.el (gnus-summary-mail-forward): Erase old forward + buffer. + +1998-10-19 23:38:11 Katsumi Yamaoka + + * nnagent.el (nnagent-open-server): Error message. + +1998-10-19 23:35:08 Joerg Lenneis + + * nnheader.el (nnheader-article-p): Recognize lower-case headers. + +1998-10-19 Hrvoje Niksic + + * score-mode.el (gnus-score-mode-map): Ditto. + + * message.el (message-mode-map): Ditto. + + * gnus-uu.el (gnus-uu-post-news): Ditto. + + * gnus-kill.el (gnus-kill-file-mode-map): Ditto. + + * gnus-eform.el (gnus-edit-form-mode-map): Ditto. + + * gnus-art.el (gnus-article-edit-mode-map): Use + `set-keymap-parent' rather than `copy-keymap'. + +1998-10-18 Hrvoje Niksic + + * gnus-art.el (gnus-mime-button-commands): New variable. + (gnus-mime-button-map): Initialize it from + `gnus-mime-button-commands'. + (gnus-mime-button-menu): New function. + (gnus-insert-mime-button): Use `gnus-mime-button-map'. + +1998-10-11 Hrvoje Niksic + + * message.el (message-insert-to): Make `nobody' and `poster' + synonymous to `never' and `always' in Mail-Copies-To. + (message-reply): Ditto. + (message-followup): Ditto. + +1998-10-19 23:17:41 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-data): Save sound. + +1998-09-24 Hrvoje Niksic + + * message.el (message-ignored-supersedes-headers): Include + `NNTP-Posting-Date'. + +1998-10-19 01:25:27 Jonas Steverud + + * gnus-art.el (gnus-article-dumbquotes-table): New variable. + +1998-10-19 00:50:22 Lars Magne Ingebrigtsen + + * mm-bodies.el (mm-decode-content-transfer-encoding): Use + uudecode. + +1998-10-18 18:20:34 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-display-external): Don't switch on save. + +1998-10-18 18:14:06 Andy Piper + + * nnmail.el (nnmail-movemail-args): New variable. + +1998-10-18 00:17:02 Lars Magne Ingebrigtsen + + * gnus-art.el (article-translate-strings): + +1998-10-17 22:51:31 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Use it. + (gnus-mm-display-part): New function. + (article-de-quoted-unreadable): Yse mm-default-coding-system. + + * mm-decode.el (mm-handle-displayed-p): New function. + + * gnus-art.el (gnus-mime-copy-part): Create better names. + (gnus-mime-button-line-format): Include dots spec. + +1998-10-15 Matt Pharr + + * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old + forward buffer first. + +1998-10-17 21:16:46 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-set-window-start): New function. + + * message.el (message-send): Don't check changed. + +1998-10-12 15:26:41 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Set params. + + * mm-decode.el (mm-user-display-methods): Inline + "message/delivery-status". + +1998-10-11 07:06:38 Lars Magne Ingebrigtsen + + * message.el (message-auto-save-directory): Rename. + (message-mode): Dof fix. + + * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". + (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. + + * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. + + * message.el (message-make-date): Avoid locale. + + * gnus-art.el (gnus-article-edit-done): Allow update before doing + cache. + + * mm-decode.el (mm-display-inline): Goto point-min. + + * gnus-art.el (gnus-article-prepare-display): Not read-only. + + * mm-decode.el (mm-display-external): Reverse before sorting. + + * gnus-draft.el (gnus-draft-send): Allow mail. + +1998-10-10 SL Baur + + * message.el (message-check): Move message-check macro above where + it is first used. + + * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. + +1998-10-11 06:45:37 Lloyd Zusman + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix. + Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.34 is released. @@ -125,6 +321,10 @@ Sat Sep 26 03:04:18 1998 Shenghuo ZHU * mm-decode.el (mm-inlinable-part-p): New function. +1998-09-25 22:28:01 Simon Josefsson + + * mm-util.el (mm-disable-multibyte): New function. + Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.33 is released. diff --git a/lisp/binhex.el b/lisp/binhex.el new file mode 100644 index 0000000..0c1cb02 --- /dev/null +++ b/lisp/binhex.el @@ -0,0 +1,316 @@ +;;; binhex.el -- elisp native binhex decode +;; Copyright (c) 1998 by Shenghuo Zhu + +;; Author: Shenghuo Zhu +;; Create Date: Oct 1, 1998 +;; $Revision: 1.1.2.1 $ +;; Time-stamp: +;; Keywords: binhex + +;; This file is not part of GNU Emacs, but the same permissions +;; apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(if (not (fboundp 'char-int)) + (fset 'char-int 'identity)) + +(defvar binhex-decoder-program "hexbin" + "*Non-nil value should be a string that names a uu decoder. +The program should expect to read binhex data on its standard +input and write the converted data to its standard output.") + +(defvar binhex-decoder-switches '("-d") + "*List of command line flags passed to the command named by binhex-decoder-program.") + +(defconst binhex-alphabet-decoding-alist + '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) + ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) + ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) + ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23) + ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29) + ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35) + ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41) + ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47) + ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53) + ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59) + ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63))) + +(defun binhex-char-map (char) + (cdr (assq char binhex-alphabet-decoding-alist))) + +;;;###autoload +(defconst binhex-begin-line + "^:...............................................................$") +(defconst binhex-body-line + "^[^:]...............................................................$") +(defconst binhex-end-line ":$") + +(defvar binhex-temporary-file-directory "/tmp/") + +(defun binhex-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (insert-char char count ignored buffer) + (fset 'binhex-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'binhex-insert-char 'binhex-xemacs-insert-char) + (binhex-insert-char char count ignored buffer)))) + +(defun binhex-xemacs-insert-char (char &optional count ignored buffer) + (if (or (null buffer) (eq buffer (current-buffer))) + (insert-char char count) + (save-excursion + (set-buffer buffer) + (insert-char char count)))) + +(defvar binhex-crc-table + [0 4129 8258 12387 16516 20645 24774 28903 + 33032 37161 41290 45419 49548 53677 57806 61935 + 4657 528 12915 8786 21173 17044 29431 25302 + 37689 33560 45947 41818 54205 50076 62463 58334 + 9314 13379 1056 5121 25830 29895 17572 21637 + 42346 46411 34088 38153 58862 62927 50604 54669 + 13907 9842 5649 1584 30423 26358 22165 18100 + 46939 42874 38681 34616 63455 59390 55197 51132 + 18628 22757 26758 30887 2112 6241 10242 14371 + 51660 55789 59790 63919 35144 39273 43274 47403 + 23285 19156 31415 27286 6769 2640 14899 10770 + 56317 52188 64447 60318 39801 35672 47931 43802 + 27814 31879 19684 23749 11298 15363 3168 7233 + 60846 64911 52716 56781 44330 48395 36200 40265 + 32407 28342 24277 20212 15891 11826 7761 3696 + 65439 61374 57309 53244 48923 44858 40793 36728 + 37256 33193 45514 41451 53516 49453 61774 57711 + 4224 161 12482 8419 20484 16421 28742 24679 + 33721 37784 41979 46042 49981 54044 58239 62302 + 689 4752 8947 13010 16949 21012 25207 29270 + 46570 42443 38312 34185 62830 58703 54572 50445 + 13538 9411 5280 1153 29798 25671 21540 17413 + 42971 47098 34713 38840 59231 63358 50973 55100 + 9939 14066 1681 5808 26199 30326 17941 22068 + 55628 51565 63758 59695 39368 35305 47498 43435 + 22596 18533 30726 26663 6336 2273 14466 10403 + 52093 56156 60223 64286 35833 39896 43963 48026 + 19061 23124 27191 31254 2801 6864 10931 14994 + 64814 60687 56684 52557 48554 44427 40424 36297 + 31782 27655 23652 19525 15522 11395 7392 3265 + 61215 65342 53085 57212 44955 49082 36825 40952 + 28183 32310 20053 24180 11923 16050 3793 7920]) + +(defun binhex-update-crc (crc char &optional count) + (if (null count) (setq count 1)) + (while (> count 0) + (setq crc (logxor (logand (lsh crc 8) 65280) + (aref binhex-crc-table + (logxor (logand (lsh crc -8) 255) + char))) + count (1- count))) + crc) + +(defun binhex-verify-crc (buffer start end) + (with-current-buffer buffer + (let ((pos start) (crc 0) (last (- end 2))) + (while (< pos last) + (setq crc (binhex-update-crc crc (char-after pos)) + pos (1+ pos))) + (if (= crc (binhex-string-big-endian (buffer-substring last end))) + nil + (error "CRC error"))))) + +(defun binhex-string-big-endian (string) + (let ((ret 0) (i 0) (len (length string))) + (while (< i len) + (setq ret (+ (lsh ret 8) (char-int (aref string i))) + i (1+ i))) + ret)) + +(defun binhex-string-little-endian (string) + (let ((ret 0) (i 0) (shift 0) (len (length string))) + (while (< i len) + (setq ret (+ ret (lsh (char-int (aref string i)) shift)) + i (1+ i) + shift (+ shift 8))) + ret)) + +(defun binhex-header (buffer) + (with-current-buffer buffer + (let ((pos (point-min)) len) + (vector + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos len))) + (prog1 + (setq len (char-int (char-after pos))) + (setq pos (1+ pos))) + (buffer-substring pos (setq pos (+ pos 4))) + (buffer-substring pos (setq pos (+ pos 4))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 2)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))) + (binhex-string-big-endian + (buffer-substring pos (setq pos (+ pos 4)))))))) + +(defvar binhex-last-char) +(defvar binhex-repeat) + +(defun binhex-push-char (char &optional count ignored buffer) + (cond + (binhex-repeat + (if (eq char 0) + (binhex-insert-char (setq binhex-last-char 144) 1 + ignored buffer) + (binhex-insert-char binhex-last-char (- char 1) + ignored buffer) + (setq binhex-last-char nil)) + (setq binhex-repeat nil)) + ((= char 144) + (setq binhex-repeat t)) + (t + (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) + +(defun binhex-decode-region (start end &optional header-only) + "Binhex decode region between START and END. +If HEADER-ONLY is non-nil only decode header and return filename." + (interactive "r") + (let ((work-buffer nil) + (counter 0) + (bits 0) (tmp t) + (lim 0) inputpos + (non-data-chars " \t\n\r:") + file-name-length data-fork-start + header + binhex-last-char binhex-repeat) + (unwind-protect + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line end t) + (if (boundp 'enable-multibyte-characters) + (let ((multibyte + (default-value enable-multibyte-characters))) + (setq-default enable-multibyte-characters nil) + (setq work-buffer + (generate-new-buffer " *binhex-work*")) + (setq-default enable-multibyte-characters multibyte)) + (setq work-buffer (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (beginning-of-line) + (setq bits 0 counter 0) + (while tmp + (skip-chars-forward non-data-chars end) + (setq inputpos (point)) + (end-of-line) + (setq lim (point)) + (while (and (< inputpos lim) + (setq tmp (binhex-char-map (char-after inputpos)))) + (setq bits (+ bits tmp) + counter (1+ counter) + inputpos (1+ inputpos)) + (cond ((= counter 4) + (binhex-push-char (lsh bits -16) 1 nil work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (binhex-push-char (logand bits 255) 1 nil + work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))) + (if (null file-name-length) + (with-current-buffer work-buffer + (setq file-name-length (char-after (point-min)) + data-fork-start (+ (point-min) + file-name-length 22)))) + (if (and (null header) + (with-current-buffer work-buffer + (>= (buffer-size) data-fork-start))) + (progn + (binhex-verify-crc work-buffer + 1 data-fork-start) + (setq header (binhex-header work-buffer)) + (if header-only (setq tmp nil counter 0)))) + (setq tmp (and tmp (not (eq inputpos end))))) + (cond + ((= counter 3) + (binhex-push-char (logand (lsh bits -16) 255) 1 nil + work-buffer) + (binhex-push-char (logand (lsh bits -8) 255) 1 nil + work-buffer)) + ((= counter 2) + (binhex-push-char (logand (lsh bits -10) 255) 1 nil + work-buffer)))) + (if header-only nil + (binhex-verify-crc work-buffer + data-fork-start + (+ data-fork-start (aref header 6) 2)) + (or (markerp end) (setq end (set-marker (make-marker) end))) + (goto-char start) + (insert-buffer-substring work-buffer + data-fork-start (+ data-fork-start + (aref header 6))) + (delete-region (point) end))) + (and work-buffer (kill-buffer work-buffer))) + (if header (aref header 1)))) + +(defun binhex-decode-region-external (start end) + "Binhex decode region between START and END using external decoder" + (interactive "r") + (let ((cbuf (current-buffer)) firstline work-buffer status + (file-name (concat binhex-temporary-file-directory + (binhex-decode-region start end t) + ".data"))) + (save-excursion + (goto-char start) + (when (re-search-forward binhex-begin-line nil t) + (let ((cdir default-directory) default-process-coding-system) + (unwind-protect + (progn + (set-buffer (setq work-buffer + (generate-new-buffer " *binhex-work*"))) + (buffer-disable-undo work-buffer) + (insert-buffer-substring cbuf firstline end) + (cd binhex-temporary-file-directory) + (apply 'call-process-region + (point-min) + (point-max) + binhex-decoder-program + nil + nil + nil + binhex-decoder-switches)) + (cd cdir) (set-buffer cbuf))) + (if (and file-name (file-exists-p file-name)) + (progn + (goto-char start) + (delete-region start end) + (let (format-alist) + (insert-file-contents-literally file-name))) + (error "Can not binhex"))) + (and work-buffer (kill-buffer work-buffer)) + (condition-case () + (if file-name (delete-file file-name)) + (error)) + ))) + +(provide 'binhex) + +;;; binhex.el ends here + + diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 668f7b9..45ae9cb 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -564,6 +564,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) @@ -826,7 +846,7 @@ always hide." (defun article-treat-dumbquotes () "Translate M******** sm*rtq**t*s into proper text." (interactive) - (article-translate-characters "\221\222\223\224" "`'\"\"")) + (article-translate-strings gnus-article-dumbquotes-map)) (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. @@ -846,6 +866,19 @@ characters to translate to." (incf i)) (translate-region (point) (point-max) x))))) +(defun article-translate-strings (map) + "Translate all string in the body of the article according to MAP. +MAP is an alist where the elements are on the form (\"from\" \"to\")." + (save-excursion + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (let ((buffer-read-only nil) + elem) + (while (setq elem (pop map)) + (save-excursion + (while (search-forward (car elem) nil t) + (replace-match (cadr elem))))))))) + (defun article-treat-overstrike () "Translate overstrikes into bold text." (interactive) @@ -1030,7 +1063,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." @@ -1050,6 +1085,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) @@ -1741,7 +1779,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 @@ -2007,6 +2046,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 @@ -2191,32 +2231,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." @@ -2247,9 +2301,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)))) @@ -2276,22 +2338,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 ")") @@ -2305,13 +2379,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 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)) @@ -2327,7 +2401,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) @@ -2337,14 +2411,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)))) @@ -2820,8 +2899,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 @@ -2907,7 +2988,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)))) @@ -2924,18 +3017,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 diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el index 6a93242..dff64d7 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -53,7 +53,8 @@ (defvar gnus-edit-form-mode-map nil) (unless gnus-edit-form-mode-map - (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) + (setq gnus-edit-form-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map) (gnus-define-keys gnus-edit-form-mode-map "\C-c\C-c" gnus-edit-form-done "\C-c\C-k" gnus-edit-form-exit)) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 68c4716..7dd16ff 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -34,6 +34,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 diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 1ec6d40..ebd839f 100644 --- a/lisp/gnus-group.el +++ b/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)))))) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 48ea531..818ddda 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -308,6 +308,16 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article)))) +(defun gnus-request-set-mark (group action) + "Set marks on articles in the backend." + (let ((gnus-command-method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function + 'request-set-mark (car gnus-command-method))) + action + (funcall (gnus-get-function gnus-command-method 'request-set-mark) + (gnus-group-real-name group) action + (nth 1 gnus-command-method))))) + (defun gnus-request-update-mark (group article mark) "Allow the backend to change the mark the user tries to put on an article." (let ((gnus-command-method (gnus-find-method-for-group group))) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 7caa74f..ab71695 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-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) diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 672e726..895505e 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -229,7 +229,7 @@ Note: LIST has to be sorted over `<'." Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. (gnus-compress-sequence - (gnus-sorted-complement + (gnus-set-difference (gnus-uncompress-range ranges) list))) (defun gnus-member-of-range (number ranges) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index cf346a1..e37c1c4 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -4164,7 +4164,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)) @@ -5202,7 +5202,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))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -9006,8 +9007,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 @@ -9017,8 +9019,7 @@ save those articles instead." (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) + (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 3e80289..c31a804 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -915,6 +915,12 @@ ARG is passed to the first function." re (unless (string-match "\\$$" re) ".*$"))) +(defun gnus-set-window-start (&optional point) + "Set the window start to POINT, or (point) if nil." + (let ((win (get-buffer-window (current-buffer) t))) + (when win + (set-window-start win (or point (point)))))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index ded0563..f33dd46 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1807,7 +1807,9 @@ is t." (gnus-summary-post-news) - (use-local-map (copy-keymap (current-local-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (current-local-map)) + (use-local-map map)) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 9658878..8724a98 100644 --- a/lisp/gnus-xmas.el +++ b/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) @@ -894,6 +896,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 diff --git a/lisp/gnus.el b/lisp/gnus.el index 948f33f..648b718 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,18 +253,18 @@ is restarted, and sometimes reloaded." (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.") diff --git a/lisp/lpath.el b/lisp/lpath.el index 8fa9e28..e02ac22 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -39,8 +39,7 @@ 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 @@ -75,7 +74,7 @@ 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 ))) diff --git a/lisp/message.el b/lisp/message.el index 9b43fd9..a9eedcb 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -752,10 +752,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) @@ -1366,7 +1366,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) @@ -1475,6 +1476,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) @@ -1667,7 +1669,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") @@ -2202,6 +2205,15 @@ the user from the mailer." "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. @@ -2526,15 +2538,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) @@ -2901,12 +2904,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-followup-subject (subject) "Make a followup Subject." @@ -3581,12 +3587,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))) @@ -3672,7 +3678,8 @@ OTHER-HEADERS is an alist of header/value pairs." ;; 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 "\ @@ -3682,7 +3689,8 @@ You should normally obey the Mail-Copies-To: header. 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 "\ @@ -3835,7 +3843,8 @@ that further discussion should take place only in " ;; 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 "\ @@ -3844,7 +3853,8 @@ You should normally obey the Mail-Copies-To: header. `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 "\ diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 044f52c..c77276c 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -26,7 +26,8 @@ (eval-and-compile (or (fboundp 'base64-decode-region) - (autoload 'base64-decode-region "base64" nil t))) + (require 'base64))) + (require 'mm-util) (require 'rfc2047) (require 'qp) @@ -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)) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 617d331..5a89631 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -28,6 +28,23 @@ (require 'mailcap) (require 'mm-bodies) +;;; Convenience macros. + +(defmacro mm-handle-buffer (handle) + `(nth 0 ,handle)) +(defmacro mm-handle-type (handle) + `(nth 1 ,handle)) +(defmacro mm-handle-encoding (handle) + `(nth 2 ,handle)) +(defmacro mm-handle-undisplayer (handle) + `(nth 3 ,handle)) +(defmacro mm-handle-set-undisplayer (handle function) + `(setcar (nthcdr 3 ,handle) ,function)) +(defmacro mm-handle-disposition (handle) + `(nth 4 ,handle)) +(defmacro mm-handle-description (handle) + `(nth 5 ,handle)) + (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image (featurep 'jpeg)) ("image/png" mm-inline-image (featurep 'png)) @@ -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) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index a24d3a8..f7c7ed5 100644 --- a/lisp/mm-util.el +++ b/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 diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 14ec63b..2d2a1d6 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -26,6 +26,7 @@ (require 'mail-parse) (require 'mailcap) (require 'mm-bodies) +(require 'mm-decode) ;;; ;;; Functions for displaying various formats inline diff --git a/lisp/nndoc.el b/lisp/nndoc.el index f417484..d80012b 100644 --- a/lisp/nndoc.el +++ b/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))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 99ef061..4284a3b 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -444,7 +444,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) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e93bcb7..459e712 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -241,6 +241,13 @@ to be moved to." :group 'nnmail-retrieve :type 'string) +(defcustom nnmail-movemail-args nil + "*Extra arguments to give to `nnmail-movemail-program' to move mail from the inbox. +The default is nil" + :group 'nnmail-files + :group 'nnmail-retrieve + :type 'string) + (defcustom nnmail-pop-password-required nil "*Non-nil if a password is required when reading mail using POP." :group 'nnmail-retrieve @@ -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)) diff --git a/lisp/pop3.el b/lisp/pop3.el index 1bfd8ec..8c4c08f 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -120,10 +120,8 @@ Returns the process associated with the connection." (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) diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el new file mode 100644 index 0000000..6254755 --- /dev/null +++ b/lisp/rfc1843.el @@ -0,0 +1,172 @@ +;;; rfc1843.el --- HZ (rfc1843) decoding +;; Copyright (c) 1998 by Shenghuo Zhu + +;; Author: Shenghuo Zhu +;; $Revision: 1.1.2.1 $ +;; Keywords: news HZ +;; Time-stamp: + +;; This file is not part of GNU Emacs, but the same permissions +;; apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Usage: +;; (require 'rfc1843) +;; (rfc1843-gnus-setup) +;; +;; Test: +;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}") + +;;; Code: + +(require 'mm-util) + +(defvar rfc1843-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\(~}\\|$\\)") + +(defvar rfc1843-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\(~}\\|$\\)") + +(defvar rfc1843-hzp-word-regexp + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\ +[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") + +(defvar rfc1843-hzp-word-regexp-strictly + "~\\({\\([\041-\167][\041-\176]\\)+\\|\ +[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)") + +(defcustom rfc1843-decode-loosely nil + "Loosely check HZ encoding if non-nil. +When it is set non-nil, only buffers or strings with strictly +HZ-encoded are decoded." + :type 'boolean + :group 'gnus) + +(defcustom rfc1843-decode-hzp t + "HZ+ decoding support if non-nil. +HZ+ specification (also known as HZP) is to provide a standardized +7-bit representation of mixed Big5, GB, and ASCII text for convenient +e-mail transmission, news posting, etc. +The document of HZ+ 0.78 specification can be found at +ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" + :type 'boolean + :group 'gnus) + +(defcustom rfc1843-newsgroups-regexp "chinese\\|hz" + "Regexp of newsgroups in which might be HZ encoded." + :type 'string + :group 'gnus) + +(defun rfc1843-decode-region (from to) + "Decode HZ in the region between FROM and TO." + (interactive "r") + (let (str firstc) + (save-excursion + (goto-char from) + (if (or rfc1843-decode-loosely + (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp-strictly + rfc1843-word-regexp-strictly) to t)) + (save-restriction + (narrow-to-region from to) + (goto-char (point-min)) + (while (re-search-forward (if rfc1843-decode-hzp + rfc1843-hzp-word-regexp + rfc1843-word-regexp) (point-max) t) + (setq str (match-string 1)) + (setq firstc (aref str 0)) + (insert (mm-decode-coding-string + (rfc1843-decode + (prog1 + (substring str 1) + (delete-region (match-beginning 0) (match-end 0))) + firstc) + (if (eq firstc ?{) 'cn-gb-2312 'cn-big5)))) + (goto-char (point-min)) + (while (search-forward "~" (point-max) t) + (cond ((eq (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 diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index ea36d60..4c2a8d1 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -27,8 +27,8 @@ (eval-and-compile (eval '(unless (fboundp 'base64-decode-string) - (autoload 'base64-decode-string "base64") - (autoload 'base64-encode-region "base64" nil t)))) + (require 'base64)))) + (require 'qp) (require 'mm-util) (require 'ietf-drums) diff --git a/lisp/score-mode.el b/lisp/score-mode.el index d625940..e2160eb 100644 --- a/lisp/score-mode.el +++ b/lisp/score-mode.el @@ -39,7 +39,8 @@ (defvar gnus-score-mode-map nil) (unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) + (setq gnus-score-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map) (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) diff --git a/lisp/uudecode.el b/lisp/uudecode.el index 2be3e6a..0aab25c 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -2,27 +2,29 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1 $ +;; $Revision: 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 -- 1.7.10.4