Mercurial > emacs

changeset 86957:f71efa3d1ab2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move to ../mail.
author Glenn Morris <rgm@gnu.org>
date Sun, 02 Dec 2007 18:47:51 +0000
parents 0aa520349535
children c96b81564c70
files lisp/gnus/binhex.el lisp/gnus/uudecode.el
diffstat 2 files changed, 0 insertions(+), 565 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/binhex.el	Sun Dec 02 18:39:00 2007 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,328 +0,0 @@
-;;; binhex.el --- elisp native binhex decode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 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 3, 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:
-
-(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))))
-	      (when (and (null header)
-			 (with-current-buffer work-buffer
-			   (>= (buffer-size) data-fork-start)))
-		(binhex-verify-crc work-buffer
-				   (point-min) data-fork-start)
-		(setq header (binhex-header work-buffer))
-		(when 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
--- a/lisp/gnus/uudecode.el	Sun Dec 02 18:39:00 2007 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,237 +0,0 @@
-;;; uudecode.el -- elisp native uudecode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: uudecode 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 3, 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:
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (defalias 'uudecode-char-int
-    (if (fboundp 'char-int)
-	'char-int
-      'identity)))
-
-(defcustom uudecode-decoder-program "uudecode"
-  "*Non-nil value should be a string that names a uu decoder.
-The program should expect to read uu data on its standard
-input and write the converted data to its standard output."
-  :type 'string
-  :group 'gnus-extract)
-
-(defcustom uudecode-decoder-switches nil
-  "*List of command line flags passed to `uudecode-decoder-program'."
-  :group 'gnus-extract
-  :type '(repeat string))
-
-(defcustom uudecode-use-external
-  (executable-find uudecode-decoder-program)
-  "*Use external uudecode program."
-  :version "22.1"
-  :group 'gnus-extract
-  :type 'boolean)
-
-(defconst uudecode-alphabet "\040-\140")
-
-(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst uudecode-end-line "^end[ \t]*$")
-
-(defconst uudecode-body-line
-  (let ((i 61) (str "^M"))
-    (while (> (setq i (1- i)) 0)
-      (setq str (concat str "[^a-z]")))
-    (concat str ".?$")))
-
-(defvar uudecode-temporary-file-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp")))
-
-;;;###autoload
-(defun uudecode-decode-region-external (start end &optional file-name)
-  "Uudecode region between START and END using external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME.  The program
-used is specified by `uudecode-decoder-program'."
-  (interactive "r\nP")
-  (let ((cbuf (current-buffer)) tempfile firstline status)
-    (save-excursion
-      (goto-char start)
-      (when (re-search-forward uudecode-begin-line nil t)
-	(forward-line 1)
-	(setq firstline (point))
-	(cond ((null file-name))
-	      ((stringp file-name))
-	      (t
-	       (setq file-name (read-file-name "File to Name:"
-					       nil nil nil
-					       (match-string 1)))))
-	(setq tempfile (if file-name
-			   (expand-file-name file-name)
-			   (if (fboundp 'make-temp-file)
-			       (let ((temporary-file-directory
-				      uudecode-temporary-file-directory))
-				 (make-temp-file "uu"))
-			     (expand-file-name
-			      (make-temp-name "uu")
-			      uudecode-temporary-file-directory))))
-	(let ((cdir default-directory)
-	      (default-process-coding-system
-		(if (featurep 'xemacs)
-		    ;; In XEmacs, `nil' is not a valid coding system.
-		    '(binary . binary)
-		  nil)))
-	  (unwind-protect
-	      (with-temp-buffer
-		(insert "begin 600 " (file-name-nondirectory tempfile) "\n")
-		(insert-buffer-substring cbuf firstline end)
-		(cd (file-name-directory tempfile))
-		(apply 'call-process-region
-		       (point-min)
-		       (point-max)
-		       uudecode-decoder-program
-		       nil
-		       nil
-		       nil
-		       uudecode-decoder-switches))
-	    (cd cdir) (set-buffer cbuf)))
-	(if (file-exists-p tempfile)
-	    (unless file-name
-	      (goto-char start)
-	      (delete-region start end)
-	      (let (format-alist)
-		(insert-file-contents-literally tempfile)))
-	  (message "Can not uudecode")))
-      (ignore-errors (or file-name (delete-file tempfile))))))
-
-(eval-and-compile
-  (defalias 'uudecode-string-to-multibyte
-    (cond
-     ((featurep 'xemacs)
-      'identity)
-     ((fboundp 'string-to-multibyte)
-      'string-to-multibyte)
-     (t
-      (lambda (string)
-	"Return a multibyte string with the same individual chars as string."
-	(mapconcat
-	 (lambda (ch) (string-as-multibyte (char-to-string ch)))
-	 string ""))))))
-
-;;;###autoload
-(defun uudecode-decode-region-internal (start end &optional file-name)
-  "Uudecode region between START and END without using an external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
-  (interactive "r\nP")
-  (let ((done nil)
-	(counter 0)
-	(remain 0)
-	(bits 0)
-	(lim 0) inputpos result
-	(non-data-chars (concat "^" uudecode-alphabet)))
-    (save-excursion
-      (goto-char start)
-      (when (re-search-forward uudecode-begin-line nil t)
-	(cond ((null file-name))
-	      ((stringp file-name))
-	      (t
-	       (setq file-name (expand-file-name
-				(read-file-name "File to Name:"
-						nil nil nil
-						(match-string 1))))))
-	(forward-line 1)
-	(skip-chars-forward non-data-chars end)
-	(while (not done)
-	  (setq inputpos (point))
-	  (setq remain 0 bits 0 counter 0)
-	  (cond
-	   ((> (skip-chars-forward uudecode-alphabet end) 0)
-	    (setq lim (point))
-	    (setq remain
-		  (logand (- (uudecode-char-int (char-after inputpos)) 32)
-			  63))
-	    (setq inputpos (1+ inputpos))
-	    (if (= remain 0) (setq done t))
-	    (while (and (< inputpos lim) (> remain 0))
-	      (setq bits (+ bits
-			    (logand
-			     (-
-			      (uudecode-char-int (char-after inputpos)) 32)
-			     63)))
-	      (if (/= counter 0) (setq remain (1- remain)))
-	      (setq counter (1+ counter)
-		    inputpos (1+ inputpos))
-	      (cond ((= counter 4)
-		     (setq result (cons
-				   (concat
-				    (char-to-string (lsh bits -16))
-				    (char-to-string (logand (lsh bits -8) 255))
-				    (char-to-string (logand bits 255)))
-				   result))
-		     (setq bits 0 counter 0))
-		    (t (setq bits (lsh bits 6)))))))
-	  (cond
-	   (done)
-	   ((> 0 remain)
-	    (error "uucode line ends unexpectly")
-	    (setq done t))
-	   ((and (= (point) end) (not done))
-	    ;;(error "uucode ends unexpectly")
-	    (setq done t))
-	   ((= counter 3)
-	    (setq result (cons
-			  (concat
-			   (char-to-string (logand (lsh bits -16) 255))
-			   (char-to-string (logand (lsh bits -8) 255)))
-			  result)))
-	   ((= counter 2)
-	    (setq result (cons
-			  (char-to-string (logand (lsh bits -10) 255))
-			  result))))
-	  (skip-chars-forward non-data-chars end))
-	(if file-name
-	    (let (default-enable-multibyte-characters)
-	      (with-temp-file file-name
-		(insert (apply 'concat (nreverse result)))))
-	  (or (markerp end) (setq end (set-marker (make-marker) end)))
-	  (goto-char start)
-	  (if enable-multibyte-characters
-	      (mapc #'(lambda (x) (insert (uudecode-string-to-multibyte x)))
-		    (nreverse result))
-	    (insert (apply 'concat (nreverse result))))
-	  (delete-region (point) end))))))
-
-;;;###autoload
-(defun uudecode-decode-region (start end &optional file-name)
-  "Uudecode region between START and END.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
-  (if uudecode-use-external
-      (uudecode-decode-region-external start end file-name)
-    (uudecode-decode-region-internal start end file-name)))
-
-(provide 'uudecode)
-
-;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
-;;; uudecode.el ends here