Mercurial > emacs

comparison lisp/gnus/binhex.el @ 56927:55fd4f77387a after-merge-gnus-5_10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0 tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS
author Miles Bader <miles@gnu.org>
date Sat, 04 Sep 2004 13:13:48 +0000
parents 695cf19ef79e
children 497f0d2ca551 cce1c0ee76ee
comparison
equal deleted inserted replaced
56926:f8e248e9a717 56927:55fd4f77387a
1 ;;; binhex.el --- elisp native binhex decode 1 ;;; binhex.el --- elisp native binhex decode
2 ;; Copyright (c) 1998 Free Software Foundation, Inc. 2 ;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
3 3
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Create Date: Oct 1, 1998
6 ;; Keywords: binhex news 5 ;; Keywords: binhex news
7 6
8 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
9 8
10 ;; GNU Emacs is free software; you can redistribute it and/or modify 9 ;; GNU Emacs is free software; you can redistribute it and/or modify
24 23
25 ;;; Commentary: 24 ;;; Commentary:
26 25
27 ;;; Code: 26 ;;; Code:
28 27
28 (autoload 'executable-find "executable")
29
29 (eval-when-compile (require 'cl)) 30 (eval-when-compile (require 'cl))
30 31
31 (defalias 'binhex-char-int 32 (eval-and-compile
32 (if (fboundp 'char-int) 33 (defalias 'binhex-char-int
33 'char-int 34 (if (fboundp 'char-int)
34 'identity)) 35 'char-int
35 36 'identity)))
36 (defvar binhex-decoder-program "hexbin" 37
37 "*Non-nil value should be a string that names a uu decoder. 38 (defcustom binhex-decoder-program "hexbin"
39 "*Non-nil value should be a string that names a binhex decoder.
38 The program should expect to read binhex data on its standard 40 The program should expect to read binhex data on its standard
39 input and write the converted data to its standard output.") 41 input and write the converted data to its standard output."
40 42 :type 'string
41 (defvar binhex-decoder-switches '("-d") 43 :group 'gnus-extract)
42 "*List of command line flags passed to the command `binhex-decoder-program'.") 44
45 (defcustom binhex-decoder-switches '("-d")
46 "*List of command line flags passed to the command `binhex-decoder-program'."
47 :group 'gnus-extract
48 :type '(repeat string))
49
50 (defcustom binhex-use-external
51 (executable-find binhex-decoder-program)
52 "*Use external binhex program."
53 :group 'gnus-extract
54 :type 'boolean)
43 55
44 (defconst binhex-alphabet-decoding-alist 56 (defconst binhex-alphabet-decoding-alist
45 '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) 57 '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
46 ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) 58 ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11)
47 ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) 59 ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17)
67 (defvar binhex-temporary-file-directory 79 (defvar binhex-temporary-file-directory
68 (cond ((fboundp 'temp-directory) (temp-directory)) 80 (cond ((fboundp 'temp-directory) (temp-directory))
69 ((boundp 'temporary-file-directory) temporary-file-directory) 81 ((boundp 'temporary-file-directory) temporary-file-directory)
70 ("/tmp/"))) 82 ("/tmp/")))
71 83
72 (if (featurep 'xemacs) 84 (eval-and-compile
73 (defalias 'binhex-insert-char 'insert-char) 85 (defalias 'binhex-insert-char
74 (defun binhex-insert-char (char &optional count ignored buffer) 86 (if (featurep 'xemacs)
75 (if (or (null buffer) (eq buffer (current-buffer))) 87 'insert-char
76 (insert-char char count) 88 (lambda (char &optional count ignored buffer)
77 (with-current-buffer buffer 89 "Insert COUNT copies of CHARACTER into BUFFER."
78 (insert-char char count))))) 90 (if (or (null buffer) (eq buffer (current-buffer)))
91 (insert-char char count)
92 (with-current-buffer buffer
93 (insert-char char count)))))))
79 94
80 (defvar binhex-crc-table 95 (defvar binhex-crc-table
81 [0 4129 8258 12387 16516 20645 24774 28903 96 [0 4129 8258 12387 16516 20645 24774 28903
82 33032 37161 41290 45419 49548 53677 57806 61935 97 33032 37161 41290 45419 49548 53677 57806 61935
83 4657 528 12915 8786 21173 17044 29431 25302 98 4657 528 12915 8786 21173 17044 29431 25302
182 ((= char 144) 197 ((= char 144)
183 (setq binhex-repeat t)) 198 (setq binhex-repeat t))
184 (t 199 (t
185 (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) 200 (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
186 201
187 (defun binhex-decode-region (start end &optional header-only) 202 ;;;###autoload
188 "Binhex decode region between START and END. 203 (defun binhex-decode-region-internal (start end &optional header-only)
204 "Binhex decode region between START and END without using an external program.
189 If HEADER-ONLY is non-nil only decode header and return filename." 205 If HEADER-ONLY is non-nil only decode header and return filename."
190 (interactive "r") 206 (interactive "r")
191 (let ((work-buffer nil) 207 (let ((work-buffer nil)
192 (counter 0) 208 (counter 0)
193 (bits 0) (tmp t) 209 (bits 0) (tmp t)
256 (aref header 6))) 272 (aref header 6)))
257 (delete-region (point) end))) 273 (delete-region (point) end)))
258 (and work-buffer (kill-buffer work-buffer))) 274 (and work-buffer (kill-buffer work-buffer)))
259 (if header (aref header 1)))) 275 (if header (aref header 1))))
260 276
277 ;;;###autoload
261 (defun binhex-decode-region-external (start end) 278 (defun binhex-decode-region-external (start end)
262 "Binhex decode region between START and END using external decoder." 279 "Binhex decode region between START and END using external decoder."
263 (interactive "r") 280 (interactive "r")
264 (let ((cbuf (current-buffer)) firstline work-buffer status 281 (let ((cbuf (current-buffer)) firstline work-buffer status
265 (file-name (expand-file-name 282 (file-name (expand-file-name
266 (concat (binhex-decode-region start end t) ".data") 283 (concat (binhex-decode-region-internal start end t)
284 ".data")
267 binhex-temporary-file-directory))) 285 binhex-temporary-file-directory)))
268 (save-excursion 286 (save-excursion
269 (goto-char start) 287 (goto-char start)
270 (when (re-search-forward binhex-begin-line nil t) 288 (when (re-search-forward binhex-begin-line nil t)
271 (let ((cdir default-directory) default-process-coding-system) 289 (let ((cdir default-directory) default-process-coding-system)
294 (error "Can not binhex"))) 312 (error "Can not binhex")))
295 (and work-buffer (kill-buffer work-buffer)) 313 (and work-buffer (kill-buffer work-buffer))
296 (ignore-errors 314 (ignore-errors
297 (if file-name (delete-file file-name)))))) 315 (if file-name (delete-file file-name))))))
298 316
317 ;;;###autoload
318 (defun binhex-decode-region (start end)
319 "Binhex decode region between START and END."
320 (interactive "r")
321 (if binhex-use-external
322 (binhex-decode-region-external start end)
323 (binhex-decode-region-internal start end)))
324
299 (provide 'binhex) 325 (provide 'binhex)
300 326
301 ;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 327 ;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
302 ;;; binhex.el ends here 328 ;;; binhex.el ends here