Mercurial > emacs
view lisp/gnus/binhex.el @ 67418:28264c86d408
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 157-168)
- Merge from emacs--cvs-trunk--0
- Update from CVS
- Update from CVS: texi/message.texi: Fix default values.
2005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/mm-decode.el (mm-discouraged-alternatives): Fix custom type.
Suggest image/.* in the doc string.
2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/mm-decode.el (mm-display-external): Use nametemplate (defined in
RFC1524) if it is in mailcap or add a suffix according to
mailcap-mime-extensions when generating a temp filename; postpone
deleting a temp file for 2 seconds for some wrappers, shell
scripts, and so on, which might exit right after having started a
viewer command as a background job.
2005-12-06 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-art.el (gnus-default-article-saver): Add user-defined
`function' to custom type.
2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
* lisp/gnus/mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
parens.
2005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
long lines.
(gnus-cache-delete-group): Wrap doc strings.
* lisp/gnus/gnus-agent.el (gnus-agent-rename-group)
(gnus-agent-delete-group): Wrap doc strings.
2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
* lisp/gnus/rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
of current-time-string.
2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change)
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
date header.
2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
* lisp/gnus/imap.el (imap-kerberos4-open): Ignore SSL stuff.
2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc>
* lisp/gnus/gnus-agent.el (gnus-agent-article-alist-save-format): Changed
internal variable to a custom variable. Changed default value
from compressed(2) to uncompressed(1).
(gnus-agent-read-agentview): Reversed revision 7.8 to restore
support for uncompressed agentview files. Taken together, reading
the agentview file should now be 6-7 times faster.
(gnus-agent-long-article,
gnus-agent-short-article, gnus-agent-score): Renamed category
keywords to match gnus-cus.
(gnus-agent-summary-fetch-series): Modified to protect against
gnus-agent-summary-fetch-group clearing processable flags.
(gnus-agent-synchronize-group-flags): Update live group buffer as
synchronization may occur due to the user toggling the plugged
status.
(gnus-agent-braid-nov): Now tests new nov entries
for duplicates which are removed. The invalid sort check then
triggers a rescan after the sort as sorting may have moved
duplicate entries such that they can be cheaply detected.
(gnus-agent-read-local): Trivial fix to format of
error message to display actual error condition.
(gnus-agent-save-local): Avoid saving symbols that are bound to
nil as they simply result in a warning message in
gnus-agent-read-local.
(gnus-agent-fetch-group-1): Clear downloadable flag when article
successfully downloaded.
(gnus-agent-regenerate-group): Use
gnus-agent-synchronize-group-flags to reset read status in both
gnus and server.
* lisp/gnus/nntp.el (nntp-end-of-line): Doc fix.
(nntp-authinfo-rejected): New error condition.
(nntp-wait-for): Use new error condition to signal authentication
error.
(nntp-retrieve-data): Rethrow new error condition to break out of
recursive call to nntp-send-authinfo.
2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-start.el (gnus-dribble-read-file): Use make-local-variable
rather than make-variable-buffer-local for file-precious-flag.
2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
* lisp/gnus/gnus-start.el (gnus-dribble-read-file): Set file-precious-flag,
as a buffer-local variable. This avoids creating truncated
dribble files as a result of a hang up, eg.
2005-11-04 Ken Manheimer <ken.manheimer@gmail.com>
* lisp/gnus/pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region)
(pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
(pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
(pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
argument to all these routines, so the passphrase can be managed
externally and passed in to the system.
(pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for
pgg-add-passphrase-to-cache function.
* lisp/gnus/pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region)
(pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric)
(pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt)
(pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase'
argument to all these routines, so the passphrase can be managed
externally and passed in to the system.
(pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache
function.
2005-10-30 Chong Yidong <cyd@stupidchicken.com>
* lisp/gnus/imap.el (imap-open): Handle case where buffer is a buffer
object.
2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
* lisp/gnus/pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right
part of the decoded armor to find the key-identifier.
(pgg-gpg-lookup-key-owner): New function to return the
human-readable identifier of a key owner.
(pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the
key itself.
(pgg-gpg-decrypt-region): Prompt with the key owner (rather than
the key value) if we have a key and can match it against a secret
key. Also, added a note pointing out fact that the prompt only
indicates the first matching key.
* lisp/gnus/pgg.el (pgg-decrypt): Passing along 'passphrase' in call to
pgg-decrypt-region.
(pgg-pending-timers): A new hash for tracking the passphrase cache
timers, so that new ones supercede old ones.
(pgg-add-passphrase-to-cache): Rename from
`pgg-add-passphrase-cache' to reduce confusion (all callers
changed). Modified to cancel old timers when new ones are added.
(pgg-remove-passphrase-from-cache): Rename from
`pgg-remove-passphrase-cache' to reduce confusion (all callers
changed). Modified to cancel old timers when their keys are
removed from the cache.
(pgg-cancel-timer): In Emacs, an alias for cancel-timer; in
XEmacs, an indirection to delete-itimer.
(pgg-read-passphrase-from-cache, pgg-read-passphrase):
Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so
users can only check cache without risk of prompting. Correct bug in
notruncate behavior.
(pgg-read-passphrase-from-cache, pgg-read-passphrase)
(pgg-add-passphrase-cache, pgg-remove-passphrase-cache):
Add informative docstrings.
(pgg-decrypt): Convey provided passphrase in subordinate call to
pgg-decrypt-region.
2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com>
* lisp/gnus/pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region)
(pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region)
(pgg-decrypt, pgg-sign-region, pgg-sign): Add optional
'passphrase' argument, so the passphrase can be managed externally
and then passed in to the system.
* lisp/gnus/pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache)
(pgg-remove-passphrase-cache): Add optional 'notruncate' argument,
so the passphrase cache can be used reliably with identifiers
besides a pgp packet's key id.
* lisp/gnus/pgg-gpg.el (pgg-pgp-encrypt-region)
(pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
(pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
(pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
argument to all these routines, so the passphrase can be managed
externally and passed in to the system.
* lisp/gnus/pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional
'notruncate' argument, so the passphrase cache can be used
reliably with identifiers besides a pgp packet's key id.
2005-10-29 Sascha Wilde <swilde@sha-bang.de>
* lisp/gnus/pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for
symmetric encryption.
(pgg-gpg-symmetric-key-p): New function to check for an symmetric
encrypted session key.
(pgg-gpg-decrypt-region): When decrypting a symmetric encrypted
message ask for the passphrase in a proper way.
* lisp/gnus/pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
New user commands for symmetric encryption.
2005-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
* man/pgg.texi (User Commands): Fix description of pgg-verify-region.
(Selecting an implementation): Fix descriptions.
2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Various Message Variables): Addition.
2005-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi: Fix default values.
2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Header Commands): Clarify descriptions of
message-cross-post-followup-to, message-reduce-to-to-cc, and
message-insert-wide-reply.
(Various Commands): Fix kindex for message-kill-to-signature;
clarify description of message-tab.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Mailing Lists): Fix description about MFT.
* man/gnus.texi (Emacs Lisp): Use ~/.gnus.el instead of ~/.emacs.
2005-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Slow Terminal Connection): Replace old description
with new one.
2005-11-16 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Oort Gnus): Use ~/.gnus.el instead of ~/.emacs;
replace X-Draft-Headers with X-Draft-From.
2005-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Various Various): Fix the default value of
nnheader-max-head-length.
(Gnus Versions): Fix typo.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 09 Dec 2005 08:57:58 +0000 |
parents | fafd692d1e40 |
children | 1077b8039c32 2d92f5c9d6ae |
line wrap: on
line source
;;; binhex.el --- elisp native binhex decode ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: binhex news ;; This file is part of GNU Emacs. ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (autoload 'executable-find "executable") (eval-when-compile (require 'cl)) (eval-and-compile (defalias 'binhex-char-int (if (fboundp 'char-int) 'char-int 'identity))) (defcustom binhex-decoder-program "hexbin" "*Non-nil value should be a string that names a binhex decoder. The program should expect to read binhex data on its standard input and write the converted data to its standard output." :type 'string :group 'gnus-extract) (defcustom binhex-decoder-switches '("-d") "*List of command line flags passed to the command `binhex-decoder-program'." :group 'gnus-extract :type '(repeat string)) (defcustom binhex-use-external (executable-find binhex-decoder-program) "*Use external binhex program." :version "22.1" :group 'gnus-extract :type 'boolean) (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 (cond ((fboundp 'temp-directory) (temp-directory)) ((boundp 'temporary-file-directory) temporary-file-directory) ("/tmp/"))) (eval-and-compile (defalias 'binhex-insert-char (if (featurep 'xemacs) 'insert-char (lambda (char &optional count ignored buffer) "Insert COUNT copies of CHARACTER into BUFFER." (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) (with-current-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) (binhex-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 (binhex-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 (binhex-char-int (char-after pos))) (setq pos (1+ pos))) (buffer-substring pos (setq pos (+ pos len))) (prog1 (setq len (binhex-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)))) ;;;###autoload (defun binhex-decode-region-internal (start end &optional header-only) "Binhex decode region between START and END without using an external program. 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) (let (default-enable-multibyte-characters) (setq work-buffer (generate-new-buffer " *binhex-work*"))) (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 (point-min) 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)))) ;;;###autoload (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 (expand-file-name (concat (binhex-decode-region-internal start end t) ".data") binhex-temporary-file-directory))) (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)) (ignore-errors (if file-name (delete-file file-name)))))) ;;;###autoload (defun binhex-decode-region (start end) "Binhex decode region between START and END." (interactive "r") (if binhex-use-external (binhex-decode-region-external start end) (binhex-decode-region-internal start end))) (provide 'binhex) ;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 ;;; binhex.el ends here