Mercurial > hg > xemacs-beta
comparison lisp/efs/dired-uu.el @ 22:8fc7fe29b841 r19-15b94
Import from CVS: tag r19-15b94
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:29 +0200 |
parents | |
children | 7e54bd776075 9f59509498e1 |
comparison
equal
deleted
inserted
replaced
21:b88636d63495 | 22:8fc7fe29b841 |
---|---|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2 ;; | |
3 ;; File: dired-uu.el | |
4 ;; Dired Version: $Revision: 1.1 $ | |
5 ;; RCS: | |
6 ;; Description: Commands for uuencoding/uudecoding marked files. | |
7 ;; Author: Sandy Rutherford <sandy@math.ubc.ca> | |
8 ;; | |
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
10 | |
11 ;;; Requirements and provisions | |
12 (provide 'dired-uu) | |
13 (require 'dired) | |
14 | |
15 (defvar dired-uu-files-to-decode nil) | |
16 ;; Fluid var to pass data inside dired-create-files. | |
17 | |
18 (defun dired-uucode-file (file ok-flag) | |
19 ;; uuencode or uudecode FILE. | |
20 ;; Don't really support the ok-flag, but needed for compatibility | |
21 (let ((handler (find-file-name-handler file 'dired-uucode-file))) | |
22 (cond (handler | |
23 (funcall handler 'dired-uucode-file file ok-flag)) | |
24 ((or (file-symlink-p file) (file-directory-p file)) | |
25 nil) | |
26 (t | |
27 (if (assoc file dired-uu-files-to-decode) | |
28 (let ((default-directory (file-name-directory file))) | |
29 (if (dired-check-process | |
30 (concat "Uudecoding " file) shell-file-name "-c" | |
31 (format "uudecode %s" file)) | |
32 (signal 'file-error (list "Error uudecoding" file)))) | |
33 (let ((nfile (concat file ".uu"))) | |
34 (if (dired-check-process | |
35 (concat "Uuencoding " file) shell-file-name "-c" | |
36 (format "uuencode %s %s > %s" | |
37 file (file-name-nondirectory file) nfile)) | |
38 (signal 'file-error (list "Error uuencoding" file))))))))) | |
39 | |
40 (defun dired-uucode-out-file (file) | |
41 ;; Returns the name of the output file for the uuencoded FILE. | |
42 (let ((buff (get-buffer-create " *dired-check-process output*")) | |
43 (case-fold-search t)) | |
44 (save-excursion | |
45 (set-buffer buff) | |
46 (erase-buffer) | |
47 (if (string-equal "18." (substring emacs-version 0 3)) | |
48 (call-process "head" file buff nil "-n" "1") | |
49 (insert-file-contents file nil 0 80)) | |
50 (goto-char (point-min)) | |
51 (if (looking-at "begin [0-9]+ \\([^\n]*\\)\n") | |
52 (expand-file-name | |
53 (buffer-substring (match-beginning 1) (match-end 1)) | |
54 (file-name-directory file)) | |
55 nil)))) | |
56 | |
57 (defun dired-do-uucode (&optional arg files to-decode) | |
58 "Uuencode or uudecode marked (or next ARG) files." | |
59 (interactive | |
60 (let* ((dir (dired-current-directory)) | |
61 (files (dired-get-marked-files nil current-prefix-arg)) | |
62 (arg (prefix-numeric-value current-prefix-arg)) | |
63 (total (length files)) | |
64 rfiles decoders ofile decode encode hint-p) | |
65 (mapcar | |
66 (function | |
67 (lambda (fn) | |
68 (if (setq ofile (dired-uucode-out-file fn)) | |
69 (setq decoders (cons (cons fn ofile) decoders))))) | |
70 files) | |
71 (setq decode (length decoders) | |
72 encode (- total decode) | |
73 hint-p (not (or (zerop decode) (zerop encode)))) | |
74 (setq rfiles | |
75 (mapcar | |
76 (function | |
77 (lambda (fn) | |
78 (if hint-p | |
79 (concat | |
80 (if (assoc fn decoders) " [de] " " [en] ") | |
81 (dired-make-relative fn dir t)) | |
82 (dired-make-relative fn dir t)))) | |
83 files)) | |
84 (or (memq 'uuencode dired-no-confirm) | |
85 (dired-mark-pop-up nil 'uuencode rfiles 'y-or-n-p | |
86 (cond | |
87 ((null decoders) | |
88 (if (= encode 1) | |
89 (format "Uuencode %s? " (car rfiles)) | |
90 (format "Uuencode %d file%s? " | |
91 encode (dired-plural-s encode)))) | |
92 ((zerop encode) | |
93 (if (= decode 1) | |
94 (format "Uudecode %s? " (car rfiles)) | |
95 (format "Uudecode %d file%s? " | |
96 decode (dired-plural-s decode)))) | |
97 (t | |
98 (format "Uudecode %d and uuencode %d file%s? " | |
99 decode encode (dired-plural-s encode))))) | |
100 (setq arg 0)) | |
101 (list arg files decoders))) | |
102 (let ((dired-uu-files-to-decode to-decode) | |
103 out-file) | |
104 (if (not (zerop arg)) | |
105 (dired-create-files | |
106 'dired-uucode-file | |
107 "Uuencode or Uudecode" | |
108 files | |
109 (function | |
110 (lambda (fn) | |
111 (if (setq out-file (assoc fn dired-uu-files-to-decode)) | |
112 (cdr out-file) | |
113 (concat fn ".uu")))) | |
114 dired-keep-marker-uucode nil t)))) | |
115 | |
116 ;;; end of dired-uu.el |