[bpt/emacs.git] / lisp / gnus / binhex.el

;;; binhex.el --- elisp native binhex decode

;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006 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
Commit	Line	Data
715a2ca2	1	;;; binhex.el --- elisp native binhex decode
e84b4b86 TTN	2
e84b4b86 TTN	3	;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
88e6695f	4	;; 2005, 2006 Free Software Foundation, Inc.
c113de23 GM	5
c113de23 GM	6	;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
c113de23 GM	7	;; Keywords: binhex news
	8
	9	;; This file is part of GNU Emacs.
	10
	11	;; GNU Emacs is free software; you can redistribute it and/or modify
	12	;; it under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation; either version 2, or (at your option)
	14	;; any later version.
	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56 LK	23	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	24	;; Boston, MA 02110-1301, USA.
c113de23 GM	25
	26	;;; Commentary:
	27
	28	;;; Code:
	29
23f87bed MB	30	(autoload 'executable-find "executable")
23f87bed MB	31
c113de23 GM	32	(eval-when-compile (require 'cl))
c113de23 GM	33
23f87bed MB	34	(eval-and-compile
	35	(defalias 'binhex-char-int
	36	(if (fboundp 'char-int)
	37	'char-int
	38	'identity)))
c113de23	39
23f87bed MB	40	(defcustom binhex-decoder-program "hexbin"
23f87bed MB	41	"*Non-nil value should be a string that names a binhex decoder.
c113de23	42	The program should expect to read binhex data on its standard
23f87bed MB	43	input and write the converted data to its standard output."
	44	:type 'string
	45	:group 'gnus-extract)
	46
	47	(defcustom binhex-decoder-switches '("-d")
	48	"*List of command line flags passed to the command `binhex-decoder-program'."
	49	:group 'gnus-extract
	50	:type '(repeat string))
c113de23	51
23f87bed MB	52	(defcustom binhex-use-external
	53	(executable-find binhex-decoder-program)
	54	"*Use external binhex program."
bf247b6e	55	:version "22.1"
23f87bed MB	56	:group 'gnus-extract
23f87bed MB	57	:type 'boolean)
c113de23 GM	58
	59	(defconst binhex-alphabet-decoding-alist
	60	'(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
	61	( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11)
	62	( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17)
	63	( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23)
	64	( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29)
	65	( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35)
	66	( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41)
	67	( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47)
	68	( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53)
	69	( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59)
	70	( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63)))
	71
	72	(defun binhex-char-map (char)
	73	(cdr (assq char binhex-alphabet-decoding-alist)))
	74
	75	;;;###autoload
	76	(defconst binhex-begin-line
	77	"^:...............................................................$")
	78	(defconst binhex-body-line
	79	"^[^:]...............................................................$")
	80	(defconst binhex-end-line ":$")
	81
	82	(defvar binhex-temporary-file-directory
	83	(cond ((fboundp 'temp-directory) (temp-directory))
	84	((boundp 'temporary-file-directory) temporary-file-directory)
	85	("/tmp/")))
	86
23f87bed MB	87	(eval-and-compile
	88	(defalias 'binhex-insert-char
	89	(if (featurep 'xemacs)
	90	'insert-char
	91	(lambda (char &optional count ignored buffer)
	92	"Insert COUNT copies of CHARACTER into BUFFER."
	93	(if (or (null buffer) (eq buffer (current-buffer)))
	94	(insert-char char count)
	95	(with-current-buffer buffer
	96	(insert-char char count)))))))
c113de23 GM	97
	98	(defvar binhex-crc-table
	99	[0 4129 8258 12387 16516 20645 24774 28903
	100	33032 37161 41290 45419 49548 53677 57806 61935
	101	4657 528 12915 8786 21173 17044 29431 25302
	102	37689 33560 45947 41818 54205 50076 62463 58334
	103	9314 13379 1056 5121 25830 29895 17572 21637
	104	42346 46411 34088 38153 58862 62927 50604 54669
	105	13907 9842 5649 1584 30423 26358 22165 18100
	106	46939 42874 38681 34616 63455 59390 55197 51132
	107	18628 22757 26758 30887 2112 6241 10242 14371
	108	51660 55789 59790 63919 35144 39273 43274 47403
	109	23285 19156 31415 27286 6769 2640 14899 10770
	110	56317 52188 64447 60318 39801 35672 47931 43802
	111	27814 31879 19684 23749 11298 15363 3168 7233
	112	60846 64911 52716 56781 44330 48395 36200 40265
	113	32407 28342 24277 20212 15891 11826 7761 3696
	114	65439 61374 57309 53244 48923 44858 40793 36728
	115	37256 33193 45514 41451 53516 49453 61774 57711
	116	4224 161 12482 8419 20484 16421 28742 24679
	117	33721 37784 41979 46042 49981 54044 58239 62302
	118	689 4752 8947 13010 16949 21012 25207 29270
	119	46570 42443 38312 34185 62830 58703 54572 50445
	120	13538 9411 5280 1153 29798 25671 21540 17413
	121	42971 47098 34713 38840 59231 63358 50973 55100
	122	9939 14066 1681 5808 26199 30326 17941 22068
	123	55628 51565 63758 59695 39368 35305 47498 43435
	124	22596 18533 30726 26663 6336 2273 14466 10403
	125	52093 56156 60223 64286 35833 39896 43963 48026
	126	19061 23124 27191 31254 2801 6864 10931 14994
	127	64814 60687 56684 52557 48554 44427 40424 36297
	128	31782 27655 23652 19525 15522 11395 7392 3265
	129	61215 65342 53085 57212 44955 49082 36825 40952
	130	28183 32310 20053 24180 11923 16050 3793 7920])
	131
	132	(defun binhex-update-crc (crc char &optional count)
	133	(if (null count) (setq count 1))
	134	(while (> count 0)
	135	(setq crc (logxor (logand (lsh crc 8) 65280)
	136	(aref binhex-crc-table
	137	(logxor (logand (lsh crc -8) 255)
	138	char)))
	139	count (1- count)))
	140	crc)
	141
	142	(defun binhex-verify-crc (buffer start end)
	143	(with-current-buffer buffer
	144	(let ((pos start) (crc 0) (last (- end 2)))
	145	(while (< pos last)
	146	(setq crc (binhex-update-crc crc (char-after pos))
	147	pos (1+ pos)))
	148	(if (= crc (binhex-string-big-endian (buffer-substring last end)))
	149	nil
	150	(error "CRC error")))))
	151
	152	(defun binhex-string-big-endian (string)
	153	(let ((ret 0) (i 0) (len (length string)))
	154	(while (< i len)
dd8955f0	155	(setq ret (+ (lsh ret 8) (binhex-char-int (aref string i)))
c113de23 GM	156	i (1+ i)))
	157	ret))
	158
	159	(defun binhex-string-little-endian (string)
	160	(let ((ret 0) (i 0) (shift 0) (len (length string)))
	161	(while (< i len)
dd8955f0	162	(setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift))
c113de23 GM	163	i (1+ i)
	164	shift (+ shift 8)))
	165	ret))
	166
	167	(defun binhex-header (buffer)
	168	(with-current-buffer buffer
	169	(let ((pos (point-min)) len)
	170	(vector
	171	(prog1
dd8955f0	172	(setq len (binhex-char-int (char-after pos)))
c113de23 GM	173	(setq pos (1+ pos)))
	174	(buffer-substring pos (setq pos (+ pos len)))
	175	(prog1
dd8955f0	176	(setq len (binhex-char-int (char-after pos)))
c113de23 GM	177	(setq pos (1+ pos)))
	178	(buffer-substring pos (setq pos (+ pos 4)))
	179	(buffer-substring pos (setq pos (+ pos 4)))
	180	(binhex-string-big-endian
	181	(buffer-substring pos (setq pos (+ pos 2))))
	182	(binhex-string-big-endian
	183	(buffer-substring pos (setq pos (+ pos 4))))
	184	(binhex-string-big-endian
	185	(buffer-substring pos (setq pos (+ pos 4))))))))
	186
	187	(defvar binhex-last-char)
	188	(defvar binhex-repeat)
	189
	190	(defun binhex-push-char (char &optional count ignored buffer)
	191	(cond
	192	(binhex-repeat
	193	(if (eq char 0)
	194	(binhex-insert-char (setq binhex-last-char 144) 1
	195	ignored buffer)
	196	(binhex-insert-char binhex-last-char (- char 1)
	197	ignored buffer)
	198	(setq binhex-last-char nil))
	199	(setq binhex-repeat nil))
	200	((= char 144)
	201	(setq binhex-repeat t))
	202	(t
	203	(binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
	204
23f87bed MB	205	;;;###autoload
	206	(defun binhex-decode-region-internal (start end &optional header-only)
	207	"Binhex decode region between START and END without using an external program.
c113de23 GM	208	If HEADER-ONLY is non-nil only decode header and return filename."
	209	(interactive "r")
	210	(let ((work-buffer nil)
	211	(counter 0)
	212	(bits 0) (tmp t)
	213	(lim 0) inputpos
	214	(non-data-chars " \t\n\r:")
	215	file-name-length data-fork-start
	216	header
	217	binhex-last-char binhex-repeat)
	218	(unwind-protect
	219	(save-excursion
	220	(goto-char start)
	221	(when (re-search-forward binhex-begin-line end t)
dd8955f0	222	(let (default-enable-multibyte-characters)
c113de23	223	(setq work-buffer (generate-new-buffer " binhex-work")))
c113de23 GM	224	(beginning-of-line)
	225	(setq bits 0 counter 0)
	226	(while tmp
	227	(skip-chars-forward non-data-chars end)
	228	(setq inputpos (point))
	229	(end-of-line)
	230	(setq lim (point))
	231	(while (and (< inputpos lim)
	232	(setq tmp (binhex-char-map (char-after inputpos))))
	233	(setq bits (+ bits tmp)
	234	counter (1+ counter)
	235	inputpos (1+ inputpos))
	236	(cond ((= counter 4)
	237	(binhex-push-char (lsh bits -16) 1 nil work-buffer)
	238	(binhex-push-char (logand (lsh bits -8) 255) 1 nil
	239	work-buffer)
	240	(binhex-push-char (logand bits 255) 1 nil
	241	work-buffer)
	242	(setq bits 0 counter 0))
	243	(t (setq bits (lsh bits 6)))))
	244	(if (null file-name-length)
	245	(with-current-buffer work-buffer
	246	(setq file-name-length (char-after (point-min))
	247	data-fork-start (+ (point-min)
	248	file-name-length 22))))
	249	(if (and (null header)
	250	(with-current-buffer work-buffer
	251	(>= (buffer-size) data-fork-start)))
	252	(progn
	253	(binhex-verify-crc work-buffer
e429e0b8	254	(point-min) data-fork-start)
c113de23 GM	255	(setq header (binhex-header work-buffer))
	256	(if header-only (setq tmp nil counter 0))))
	257	(setq tmp (and tmp (not (eq inputpos end)))))
	258	(cond
	259	((= counter 3)
	260	(binhex-push-char (logand (lsh bits -16) 255) 1 nil
	261	work-buffer)
	262	(binhex-push-char (logand (lsh bits -8) 255) 1 nil
	263	work-buffer))
	264	((= counter 2)
	265	(binhex-push-char (logand (lsh bits -10) 255) 1 nil
	266	work-buffer))))
	267	(if header-only nil
	268	(binhex-verify-crc work-buffer
	269	data-fork-start
	270	(+ data-fork-start (aref header 6) 2))
	271	(or (markerp end) (setq end (set-marker (make-marker) end)))
	272	(goto-char start)
	273	(insert-buffer-substring work-buffer
	274	data-fork-start (+ data-fork-start
	275	(aref header 6)))
	276	(delete-region (point) end)))
	277	(and work-buffer (kill-buffer work-buffer)))
	278	(if header (aref header 1))))
	279
23f87bed	280	;;;###autoload
c113de23 GM	281	(defun binhex-decode-region-external (start end)
	282	"Binhex decode region between START and END using external decoder."
	283	(interactive "r")
	284	(let ((cbuf (current-buffer)) firstline work-buffer status
dd8955f0	285	(file-name (expand-file-name
23f87bed MB	286	(concat (binhex-decode-region-internal start end t)
23f87bed MB	287	".data")
dd8955f0	288	binhex-temporary-file-directory)))
c113de23 GM	289	(save-excursion
	290	(goto-char start)
	291	(when (re-search-forward binhex-begin-line nil t)
	292	(let ((cdir default-directory) default-process-coding-system)
	293	(unwind-protect
	294	(progn
	295	(set-buffer (setq work-buffer
	296	(generate-new-buffer " binhex-work")))
	297	(buffer-disable-undo work-buffer)
	298	(insert-buffer-substring cbuf firstline end)
	299	(cd binhex-temporary-file-directory)
	300	(apply 'call-process-region
	301	(point-min)
	302	(point-max)
	303	binhex-decoder-program
	304	nil
	305	nil
	306	nil
	307	binhex-decoder-switches))
	308	(cd cdir) (set-buffer cbuf)))
	309	(if (and file-name (file-exists-p file-name))
	310	(progn
	311	(goto-char start)
	312	(delete-region start end)
	313	(let (format-alist)
	314	(insert-file-contents-literally file-name)))
	315	(error "Can not binhex")))
	316	(and work-buffer (kill-buffer work-buffer))
	317	(ignore-errors
	318	(if file-name (delete-file file-name))))))
	319
23f87bed MB	320	;;;###autoload
	321	(defun binhex-decode-region (start end)
	322	"Binhex decode region between START and END."
	323	(interactive "r")
	324	(if binhex-use-external
	325	(binhex-decode-region-external start end)
	326	(binhex-decode-region-internal start end)))
	327
c113de23 GM	328	(provide 'binhex)
c113de23 GM	329
ab5796a9	330	;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
c113de23	331	;;; binhex.el ends here