1 ;;; binhex.el -- elisp native binhex decode
2 ;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Create Date: Oct 1, 1998
7 ;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
10 ;; This file is not part of GNU Emacs, but the same permissions
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
32 (if (not (fboundp 'char-int))
33 (fset 'char-int 'identity))
35 (defvar binhex-decoder-program "hexbin"
36 "*Non-nil value should be a string that names a uu decoder.
37 The program should expect to read binhex data on its standard
38 input and write the converted data to its standard output.")
40 (defvar binhex-decoder-switches '("-d")
41 "*List of command line flags passed to the command named by binhex-decoder-program.")
43 (defconst binhex-alphabet-decoding-alist
44 '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
45 ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11)
46 ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17)
47 ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23)
48 ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29)
49 ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35)
50 ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41)
51 ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47)
52 ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53)
53 ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59)
54 ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63)))
56 (defun binhex-char-map (char)
57 (cdr (assq char binhex-alphabet-decoding-alist)))
60 (defconst binhex-begin-line
61 "^:...............................................................$")
62 (defconst binhex-body-line
63 "^[^:]...............................................................$")
64 (defconst binhex-end-line ":$")
66 (defvar binhex-temporary-file-directory
67 (cond ((fboundp 'temp-directory) (temp-directory))
68 ((boundp 'temporary-file-directory) temporary-file-directory)
71 (if (string-match "XEmacs" emacs-version)
72 (defalias 'binhex-insert-char 'insert-char)
73 (defun binhex-insert-char (char &optional count ignored buffer)
74 (if (or (null buffer) (eq buffer (current-buffer)))
75 (insert-char char count)
76 (with-current-buffer buffer
77 (insert-char char count)))))
79 (defvar binhex-crc-table
80 [0 4129 8258 12387 16516 20645 24774 28903
81 33032 37161 41290 45419 49548 53677 57806 61935
82 4657 528 12915 8786 21173 17044 29431 25302
83 37689 33560 45947 41818 54205 50076 62463 58334
84 9314 13379 1056 5121 25830 29895 17572 21637
85 42346 46411 34088 38153 58862 62927 50604 54669
86 13907 9842 5649 1584 30423 26358 22165 18100
87 46939 42874 38681 34616 63455 59390 55197 51132
88 18628 22757 26758 30887 2112 6241 10242 14371
89 51660 55789 59790 63919 35144 39273 43274 47403
90 23285 19156 31415 27286 6769 2640 14899 10770
91 56317 52188 64447 60318 39801 35672 47931 43802
92 27814 31879 19684 23749 11298 15363 3168 7233
93 60846 64911 52716 56781 44330 48395 36200 40265
94 32407 28342 24277 20212 15891 11826 7761 3696
95 65439 61374 57309 53244 48923 44858 40793 36728
96 37256 33193 45514 41451 53516 49453 61774 57711
97 4224 161 12482 8419 20484 16421 28742 24679
98 33721 37784 41979 46042 49981 54044 58239 62302
99 689 4752 8947 13010 16949 21012 25207 29270
100 46570 42443 38312 34185 62830 58703 54572 50445
101 13538 9411 5280 1153 29798 25671 21540 17413
102 42971 47098 34713 38840 59231 63358 50973 55100
103 9939 14066 1681 5808 26199 30326 17941 22068
104 55628 51565 63758 59695 39368 35305 47498 43435
105 22596 18533 30726 26663 6336 2273 14466 10403
106 52093 56156 60223 64286 35833 39896 43963 48026
107 19061 23124 27191 31254 2801 6864 10931 14994
108 64814 60687 56684 52557 48554 44427 40424 36297
109 31782 27655 23652 19525 15522 11395 7392 3265
110 61215 65342 53085 57212 44955 49082 36825 40952
111 28183 32310 20053 24180 11923 16050 3793 7920])
113 (defun binhex-update-crc (crc char &optional count)
114 (if (null count) (setq count 1))
116 (setq crc (logxor (logand (lsh crc 8) 65280)
117 (aref binhex-crc-table
118 (logxor (logand (lsh crc -8) 255)
123 (defun binhex-verify-crc (buffer start end)
124 (with-current-buffer buffer
125 (let ((pos start) (crc 0) (last (- end 2)))
127 (setq crc (binhex-update-crc crc (char-after pos))
129 (if (= crc (binhex-string-big-endian (buffer-substring last end)))
131 (error "CRC error")))))
133 (defun binhex-string-big-endian (string)
134 (let ((ret 0) (i 0) (len (length string)))
136 (setq ret (+ (lsh ret 8) (char-int (aref string i)))
140 (defun binhex-string-little-endian (string)
141 (let ((ret 0) (i 0) (shift 0) (len (length string)))
143 (setq ret (+ ret (lsh (char-int (aref string i)) shift))
148 (defun binhex-header (buffer)
149 (with-current-buffer buffer
150 (let ((pos (point-min)) len)
153 (setq len (char-int (char-after pos)))
155 (buffer-substring pos (setq pos (+ pos len)))
157 (setq len (char-int (char-after pos)))
159 (buffer-substring pos (setq pos (+ pos 4)))
160 (buffer-substring pos (setq pos (+ pos 4)))
161 (binhex-string-big-endian
162 (buffer-substring pos (setq pos (+ pos 2))))
163 (binhex-string-big-endian
164 (buffer-substring pos (setq pos (+ pos 4))))
165 (binhex-string-big-endian
166 (buffer-substring pos (setq pos (+ pos 4))))))))
168 (defvar binhex-last-char)
169 (defvar binhex-repeat)
171 (defun binhex-push-char (char &optional count ignored buffer)
175 (binhex-insert-char (setq binhex-last-char 144) 1
177 (binhex-insert-char binhex-last-char (- char 1)
179 (setq binhex-last-char nil))
180 (setq binhex-repeat nil))
182 (setq binhex-repeat t))
184 (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
186 (defun binhex-decode-region (start end &optional header-only)
187 "Binhex decode region between START and END.
188 If HEADER-ONLY is non-nil only decode header and return filename."
190 (let ((work-buffer nil)
194 (non-data-chars " \t\n\r:")
195 file-name-length data-fork-start
197 binhex-last-char binhex-repeat)
201 (when (re-search-forward binhex-begin-line end t)
202 (if (boundp 'enable-multibyte-characters)
204 (default-value 'enable-multibyte-characters)))
205 (setq-default enable-multibyte-characters nil)
207 (generate-new-buffer " *binhex-work*"))
208 (setq-default enable-multibyte-characters multibyte))
209 (setq work-buffer (generate-new-buffer " *binhex-work*")))
210 (buffer-disable-undo work-buffer)
212 (setq bits 0 counter 0)
214 (skip-chars-forward non-data-chars end)
215 (setq inputpos (point))
218 (while (and (< inputpos lim)
219 (setq tmp (binhex-char-map (char-after inputpos))))
220 (setq bits (+ bits tmp)
222 inputpos (1+ inputpos))
224 (binhex-push-char (lsh bits -16) 1 nil work-buffer)
225 (binhex-push-char (logand (lsh bits -8) 255) 1 nil
227 (binhex-push-char (logand bits 255) 1 nil
229 (setq bits 0 counter 0))
230 (t (setq bits (lsh bits 6)))))
231 (if (null file-name-length)
232 (with-current-buffer work-buffer
233 (setq file-name-length (char-after (point-min))
234 data-fork-start (+ (point-min)
235 file-name-length 22))))
236 (if (and (null header)
237 (with-current-buffer work-buffer
238 (>= (buffer-size) data-fork-start)))
240 (binhex-verify-crc work-buffer
242 (setq header (binhex-header work-buffer))
243 (if header-only (setq tmp nil counter 0))))
244 (setq tmp (and tmp (not (eq inputpos end)))))
247 (binhex-push-char (logand (lsh bits -16) 255) 1 nil
249 (binhex-push-char (logand (lsh bits -8) 255) 1 nil
252 (binhex-push-char (logand (lsh bits -10) 255) 1 nil
255 (binhex-verify-crc work-buffer
257 (+ data-fork-start (aref header 6) 2))
258 (or (markerp end) (setq end (set-marker (make-marker) end)))
260 (insert-buffer-substring work-buffer
261 data-fork-start (+ data-fork-start
263 (delete-region (point) end)))
264 (and work-buffer (kill-buffer work-buffer)))
265 (if header (aref header 1))))
267 (defun binhex-decode-region-external (start end)
268 "Binhex decode region between START and END using external decoder"
270 (let ((cbuf (current-buffer)) firstline work-buffer status
271 (file-name (concat binhex-temporary-file-directory
272 (binhex-decode-region start end t)
276 (when (re-search-forward binhex-begin-line nil t)
277 (let ((cdir default-directory) default-process-coding-system)
280 (set-buffer (setq work-buffer
281 (generate-new-buffer " *binhex-work*")))
282 (buffer-disable-undo work-buffer)
283 (insert-buffer-substring cbuf firstline end)
284 (cd binhex-temporary-file-directory)
285 (apply 'call-process-region
288 binhex-decoder-program
292 binhex-decoder-switches))
293 (cd cdir) (set-buffer cbuf)))
294 (if (and file-name (file-exists-p file-name))
297 (delete-region start end)
299 (insert-file-contents-literally file-name)))
300 (error "Can not binhex")))
301 (and work-buffer (kill-buffer work-buffer))
303 (if file-name (delete-file file-name))))))
307 ;;; binhex.el ends here