comparison lisp/gnus/binhex.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; binhex.el --- elisp native binhex decode
;; Copyright (c) 1998 Free Software Foundation, Inc.

;; Author: Shenghuo Zhu <[e-mail]>
;; Create Date: Oct 1, 1998
;; Keywords: binhex news

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(defalias 'binhex-char-int
  (if (fboundp 'char-int)
      'char-int
    'identity))

(defvar binhex-decoder-program "hexbin"
  "*Non-nil value should be a string that names a uu decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output.")

(defvar binhex-decoder-switches '("-d")
  "*List of command line flags passed to the command `binhex-decoder-program'.")

(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)

(defvar binhex-temporary-file-directory
  (cond ((fboundp 'temp-directory) (temp-directory))
	((boundp 'temporary-file-directory) temporary-file-directory)
	("/tmp/")))

(if (featurep 'xemacs)
    (defalias 'binhex-insert-char 'insert-char)
  (defun binhex-insert-char (char &optional count ignored 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

   ((= char 144)
    (setq binhex-repeat t))
   (t
    (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))

(defun binhex-decode-region (start end &optional header-only)
  "Binhex decode region between START and END.
If HEADER-ONLY is non-nil only decode header and return filename."
  (interactive "r")
  (let ((work-buffer nil)
	(counter 0)
	(bits 0) (tmp t)

							(aref header 6)))
	    (delete-region (point) end)))
      (and work-buffer (kill-buffer work-buffer)))
    (if header (aref header 1))))

(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 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)

	  (error "Can not binhex")))
      (and work-buffer (kill-buffer work-buffer))
      (ignore-errors
	(if file-name (delete-file file-name))))))

(provide 'binhex)

;;; binhex.el ends here

88155:d7ddb3e565de

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

;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Shenghuo Zhu <[e-mail]>
;; Keywords: binhex news

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

;; 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)

(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

   ((= 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)

							(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)

	  (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