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