X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-uu.el;h=b0772e5eb93478eff94e02b341800902664d81ba;hb=59780d1fbddfc1792e3d27885c62b6ded64093ba;hp=ded05639d899b5c1aec4c9483cd71cd3c844dfdf;hpb=b14ba71ca00ad909b738bad1898f1908c0e6d2eb;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index ded0563..b0772e5 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,5 +1,5 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 198,995,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -57,8 +57,8 @@ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") ("\\.pas$" "cat %s | sed 's/\r$//'") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - ("\\.tga$" "tgatoppm %s | xv -") + ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display") + ("\\.tga$" "tgatoppm %s | ee -") ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") @@ -215,7 +215,10 @@ Note that this variable can be used in conjunction with the ;; Various variables users may set -(defcustom gnus-uu-tmp-dir "/tmp/" +(defcustom gnus-uu-tmp-dir + (cond ((fboundp 'temp-directory) (temp-directory)) + ((boundp 'temporary-file-directory) temporary-file-directory) + ("/tmp/")) "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract @@ -328,7 +331,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-shar-begin-string "^#! */bin/sh") (defvar gnus-uu-shar-file-name nil) -(defvar gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") +(defvar gnus-uu-shar-name-marker + "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") (defvar gnus-uu-postscript-begin-string "^%!PS-") (defvar gnus-uu-postscript-end-string "^%%EOF$") @@ -364,7 +368,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "k" gnus-summary-kill-process-mark "y" gnus-summary-yank-process-mark "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) + "i" gnus-uu-invert-processable + "m" gnus-summary-save-parts) (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) ;;"x" gnus-uu-extract-any @@ -381,17 +386,17 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "P" gnus-uu-decode-postscript-and-save) (gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) + (gnus-uu-extract-view-map "v" gnus-uu-extract-map) + "u" gnus-uu-decode-uu-view + "U" gnus-uu-decode-uu-and-save-view + "s" gnus-uu-decode-unshar-view + "S" gnus-uu-decode-unshar-and-save-view + "o" gnus-uu-decode-save-view + "O" gnus-uu-decode-save-view + "b" gnus-uu-decode-binhex-view + "B" gnus-uu-decode-binhex-view + "p" gnus-uu-decode-postscript-view + "P" gnus-uu-decode-postscript-and-save-view) ;; Commands. @@ -521,6 +526,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-get-buffer-create " *gnus-uu-forward*"))) (erase-buffer) (insert-file file) + (delete-file file) (let ((fs gnus-uu-digest-from-subject)) (when fs (setq from (caar fs) @@ -551,8 +557,6 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (delete-region (point) (gnus-point-at-eol)) (insert from)) (message-forward post)) - (delete-file file) - (kill-buffer buf) (setq gnus-uu-digest-from-subject nil))) (defun gnus-uu-digest-post-forward (&optional n) @@ -563,8 +567,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Process marking. (defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and set the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) + "Set the process mark on articles whose subjects match REGEXP. +When called interactively, prompt for REGEXP. +Optional UNMARK non-nil means unmark instead of mark." + (interactive "sMark (regexp): \nP") (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles (if unmark @@ -573,9 +579,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (message "")) (gnus-summary-position-point)) -(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and remove the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) +(defun gnus-uu-unmark-by-regexp (regexp) + "Remove the process mark from articles whose subjects match REGEXP. +When called interactively, prompt for REGEXP." + (interactive "sUnmark (regexp): ") (gnus-uu-mark-by-regexp regexp t)) (defun gnus-uu-mark-series () @@ -618,10 +625,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) + (gnus-save-hidden-threads + (let ((level (gnus-summary-thread-level))) + (while (and (gnus-summary-set-process-mark + (gnus-summary-article-number)) + (zerop (gnus-summary-next-subject 1 nil t)) + (> (gnus-summary-thread-level) level))))) (gnus-summary-position-point)) (defun gnus-uu-unmark-thread () @@ -650,7 +659,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-mark-over (&optional score) "Mark all articles with a score over SCORE (the prefix)." (interactive "P") - (let ((score (gnus-score-default score)) + (let ((score (or score gnus-summary-default-score 0)) (data gnus-newsgroup-data)) (save-excursion (while data @@ -950,7 +959,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (beginning-of-line) (forward-line 1) (when (file-exists-p gnus-uu-binhex-article-name) - (append-to-file start-char (point) gnus-uu-binhex-article-name)))) + (write-region-as-binary start-char (point) + gnus-uu-binhex-article-name 'append)))) (if (memq 'begin state) (cons gnus-uu-binhex-article-name state) state))) @@ -1200,9 +1210,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." &optional sloppy limit no-errors) (let ((state 'first) (gnus-asynchronous nil) + (gnus-inhibit-treatment t) has-been-begin article result-file result-files process-state gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook + gnus-article-display-hook gnus-article-prepare-hook gnus-display-mime-function article-series files) (while (and articles @@ -1343,9 +1354,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (when gnus-uu-default-dir (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) + (cond ((fboundp 'make-symbolic-link) + (rename-file file to-file) + (unless (file-exists-p file) + (make-symbolic-link to-file file))) + (t + (copy-file file to-file)))))) (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) @@ -1393,7 +1407,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; We replace certain characters that could make things messy. (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) (replace-match (concat "begin 644 " gnus-uu-file-name) t t) @@ -1807,7 +1821,9 @@ is t." (gnus-summary-post-news) - (use-local-map (copy-keymap (current-local-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (current-local-map)) + (use-local-map map)) (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)