1 |
;;; binhex.el --- elisp native binhex decode |
;;; binhex.el --- elisp native binhex decode |
2 |
;; Copyright (c) 1998 Free Software Foundation, Inc. |
;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> |
|
;; Create Date: Oct 1, 1998 |
|
5 |
;; Keywords: binhex news |
;; Keywords: binhex news |
6 |
|
|
7 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
25 |
|
|
26 |
;;; Code: |
;;; Code: |
27 |
|
|
28 |
|
(autoload 'executable-find "executable") |
29 |
|
|
30 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
31 |
|
|
32 |
(defalias 'binhex-char-int |
(eval-and-compile |
33 |
(if (fboundp 'char-int) |
(defalias 'binhex-char-int |
34 |
'char-int |
(if (fboundp 'char-int) |
35 |
'identity)) |
'char-int |
36 |
|
'identity))) |
37 |
|
|
38 |
(defvar binhex-decoder-program "hexbin" |
(defcustom binhex-decoder-program "hexbin" |
39 |
"*Non-nil value should be a string that names a uu decoder. |
"*Non-nil value should be a string that names a binhex decoder. |
40 |
The program should expect to read binhex data on its standard |
The program should expect to read binhex data on its standard |
41 |
input and write the converted data to its standard output.") |
input and write the converted data to its standard output." |
42 |
|
:type 'string |
43 |
(defvar binhex-decoder-switches '("-d") |
:group 'gnus-extract) |
44 |
"*List of command line flags passed to the command `binhex-decoder-program'.") |
|
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) |
55 |
|
|
56 |
(defconst binhex-alphabet-decoding-alist |
(defconst binhex-alphabet-decoding-alist |
57 |
'(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) |
'(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) |
81 |
((boundp 'temporary-file-directory) temporary-file-directory) |
((boundp 'temporary-file-directory) temporary-file-directory) |
82 |
("/tmp/"))) |
("/tmp/"))) |
83 |
|
|
84 |
(if (featurep 'xemacs) |
(eval-and-compile |
85 |
(defalias 'binhex-insert-char 'insert-char) |
(defalias 'binhex-insert-char |
86 |
(defun binhex-insert-char (char &optional count ignored buffer) |
(if (featurep 'xemacs) |
87 |
(if (or (null buffer) (eq buffer (current-buffer))) |
'insert-char |
88 |
(insert-char char count) |
(lambda (char &optional count ignored buffer) |
89 |
(with-current-buffer buffer |
"Insert COUNT copies of CHARACTER into BUFFER." |
90 |
(insert-char char count))))) |
(if (or (null buffer) (eq buffer (current-buffer))) |
91 |
|
(insert-char char count) |
92 |
|
(with-current-buffer buffer |
93 |
|
(insert-char char count))))))) |
94 |
|
|
95 |
(defvar binhex-crc-table |
(defvar binhex-crc-table |
96 |
[0 4129 8258 12387 16516 20645 24774 28903 |
[0 4129 8258 12387 16516 20645 24774 28903 |
199 |
(t |
(t |
200 |
(binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) |
(binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) |
201 |
|
|
202 |
(defun binhex-decode-region (start end &optional header-only) |
;;;###autoload |
203 |
"Binhex decode region between START and END. |
(defun binhex-decode-region-internal (start end &optional header-only) |
204 |
|
"Binhex decode region between START and END without using an external program. |
205 |
If HEADER-ONLY is non-nil only decode header and return filename." |
If HEADER-ONLY is non-nil only decode header and return filename." |
206 |
(interactive "r") |
(interactive "r") |
207 |
(let ((work-buffer nil) |
(let ((work-buffer nil) |
274 |
(and work-buffer (kill-buffer work-buffer))) |
(and work-buffer (kill-buffer work-buffer))) |
275 |
(if header (aref header 1)))) |
(if header (aref header 1)))) |
276 |
|
|
277 |
|
;;;###autoload |
278 |
(defun binhex-decode-region-external (start end) |
(defun binhex-decode-region-external (start end) |
279 |
"Binhex decode region between START and END using external decoder." |
"Binhex decode region between START and END using external decoder." |
280 |
(interactive "r") |
(interactive "r") |
281 |
(let ((cbuf (current-buffer)) firstline work-buffer status |
(let ((cbuf (current-buffer)) firstline work-buffer status |
282 |
(file-name (expand-file-name |
(file-name (expand-file-name |
283 |
(concat (binhex-decode-region start end t) ".data") |
(concat (binhex-decode-region-internal start end t) |
284 |
|
".data") |
285 |
binhex-temporary-file-directory))) |
binhex-temporary-file-directory))) |
286 |
(save-excursion |
(save-excursion |
287 |
(goto-char start) |
(goto-char start) |
314 |
(ignore-errors |
(ignore-errors |
315 |
(if file-name (delete-file file-name)))))) |
(if file-name (delete-file file-name)))))) |
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 |
|
|
325 |
(provide 'binhex) |
(provide 'binhex) |
326 |
|
|
327 |
;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 |
;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 |