comparison lisp/gnus/gnus-uu.el @ 87097:781256628613

Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-941
author Miles Bader <miles@gnu.org>
date Thu, 06 Dec 2007 00:21:00 +0000
parents 8a486bfde38f
children b40a0f01cf1e 53108e6cea98
comparison
equal deleted inserted replaced
87096:a99a2e8bc21e 87097:781256628613
33 (require 'gnus) 33 (require 'gnus)
34 (require 'gnus-art) 34 (require 'gnus-art)
35 (require 'message) 35 (require 'message)
36 (require 'gnus-msg) 36 (require 'gnus-msg)
37 (require 'mm-decode) 37 (require 'mm-decode)
38 (require 'yenc)
38 39
39 (defgroup gnus-extract nil 40 (defgroup gnus-extract nil
40 "Extracting encoded files." 41 "Extracting encoded files."
41 :prefix "gnus-uu-" 42 :prefix "gnus-uu-"
42 :group 'gnus) 43 :group 'gnus)
344 (defvar gnus-uu-postscript-end-string "^%%EOF$") 345 (defvar gnus-uu-postscript-end-string "^%%EOF$")
345 346
346 (defvar gnus-uu-file-name nil) 347 (defvar gnus-uu-file-name nil)
347 (defvar gnus-uu-uudecode-process nil) 348 (defvar gnus-uu-uudecode-process nil)
348 (defvar gnus-uu-binhex-article-name nil) 349 (defvar gnus-uu-binhex-article-name nil)
350 (defvar gnus-uu-yenc-article-name nil)
349 351
350 (defvar gnus-uu-work-dir nil) 352 (defvar gnus-uu-work-dir nil)
351 353
352 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*") 354 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
353 355
409 gnus-uu-default-dir 411 gnus-uu-default-dir
410 gnus-uu-default-dir)))) 412 gnus-uu-default-dir))))
411 (setq gnus-uu-binhex-article-name 413 (setq gnus-uu-binhex-article-name
412 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) 414 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
413 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) 415 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
416
417 (defun gnus-uu-decode-yenc (n dir)
418 "Decode the yEnc-encoded current article."
419 (interactive
420 (list current-prefix-arg
421 (file-name-as-directory
422 (read-file-name "yEnc decode and save in dir: "
423 gnus-uu-default-dir
424 gnus-uu-default-dir))))
425 (setq gnus-uu-yenc-article-name nil)
426 (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t))
414 427
415 (defun gnus-uu-decode-uu-view (&optional n) 428 (defun gnus-uu-decode-uu-view (&optional n)
416 "Uudecodes and views the current article." 429 "Uudecodes and views the current article."
417 (interactive "P") 430 (interactive "P")
418 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) 431 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
1014 (mm-append-to-file start-char (point) gnus-uu-binhex-article-name)))) 1027 (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
1015 (if (memq 'begin state) 1028 (if (memq 'begin state)
1016 (cons gnus-uu-binhex-article-name state) 1029 (cons gnus-uu-binhex-article-name state)
1017 state))) 1030 state)))
1018 1031
1032 ;; yEnc
1033
1034 (defun gnus-uu-yenc-article (buffer in-state)
1035 (save-excursion
1036 (set-buffer gnus-original-article-buffer)
1037 (widen)
1038 (let ((file-name (yenc-extract-filename))
1039 state start-char)
1040 (when (not file-name)
1041 (setq state (list 'wrong-type)))
1042
1043 (if (memq 'wrong-type state)
1044 ()
1045 (when (yenc-first-part-p)
1046 (setq gnus-uu-yenc-article-name
1047 (expand-file-name file-name gnus-uu-work-dir))
1048 (push 'begin state))
1049 (when (yenc-last-part-p)
1050 (push 'end state))
1051 (unless state
1052 (push 'middle state))
1053 (mm-with-unibyte-buffer
1054 (insert-buffer gnus-original-article-buffer)
1055 (yenc-decode-region (point-min) (point-max))
1056 (when (and (member 'begin state)
1057 (file-exists-p gnus-uu-yenc-article-name))
1058 (delete-file gnus-uu-yenc-article-name))
1059 (mm-append-to-file (point-min) (point-max)
1060 gnus-uu-yenc-article-name)))
1061 (if (memq 'begin state)
1062 (cons file-name state)
1063 state))))
1064
1019 ;; PostScript 1065 ;; PostScript
1020 1066
1021 (defun gnus-uu-decode-postscript-article (process-buffer in-state) 1067 (defun gnus-uu-decode-postscript-article (process-buffer in-state)
1022 (let ((state (list 'ok)) 1068 (let ((state (list 'ok))
1023 start-char end-char file-name) 1069 start-char end-char file-name)