Mercurial > emacs
comparison lisp/=gnus-uu.el @ 7977:ebee036f5d20
(gnus-uu-view-directory): Fixed viewing with the
`gnus-uu-asynchronous' variable set.
(gnus-uu-ctl-map): Removed the keystrokes `C-c C-v C-h' and
`C-c C-v h' from the keymap.
(gnus-uu-decode-and-view-all-articles,
(gnus-uu-decode-and-view-all-unread-articles,
(gnus-uu-decode-and-save-all-unread-articles,
(gnus-uu-decode-and-save-all-articles): Accept prefix arg for # files.
(gnus-uu-uustrip-article-as): Waits for uudecode to finish before
further treatment of the resulting files.
(gnus-uu-summary-next-subject): After decoding, if there are no
more unread articles, jump to the last article decoded.
(gnus-uu-post-encoded): Make last posting in a
series always have more than 4 lines.
(gnus-uu-interactive-save-original-file): Fixed
original file save when there's more that one original file.
(gnus-uu-view-file): Rewrote function and fixed
ask before view/save after view.
(gnus-uu-ask-to-save-file): New function.
(gnus-uu-interactive-set-up-windows): New function.
(gnus-uu-interactive-scan-directory) New function.
(gnus-uu-interactive-rescan-directory): New function.
(gnus-uu-ignore-files-by-name, gnus-uu-ignore-files-by-type): New vars.
(gnus-uu-interactive-execute): Change directory to work dir before executing.
(gnus-uu-view-directory, gnus-uu-check-for-generated-files):
Fixed bug deleting generated directories.
(gnus-uu-unpack-archives): Added error message for corrupted archives.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 20 Jun 1994 19:09:24 +0000 |
| parents | 6c08927dfafc |
| children | bc422f369d6c |
comparison
equal
deleted
inserted
replaced
| 7976:b72b84744a85 | 7977:ebee036f5d20 |
|---|---|
| 1 ;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus | 1 ;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus |
| 2 | |
| 2 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. |
| 3 | 4 |
| 4 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no> | 5 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no> |
| 5 ;; Created: 2 Oct 1993 | 6 ;; Created: 2 Oct 1993 |
| 6 ;; Version: v2.7.2 | 7 ;; Version: v2.8 |
| 7 ;; Last Modified: 1994/05/03 | 8 ;; Last Modified: 1994/06/01 |
| 8 ;; Keyword: news | 9 ;; Keyword: news |
| 9 | 10 |
| 10 ;; This file is part of GNU Emacs. | 11 ;; This file is part of GNU Emacs. |
| 11 | 12 |
| 12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 91 ;; | 92 ;; |
| 92 ;; v2.7.1: New functions for decoding/saving threads bound to `C-c | 93 ;; v2.7.1: New functions for decoding/saving threads bound to `C-c |
| 93 ;; C-v C-j'. Handy to save entire threads, not very useful for | 94 ;; C-v C-j'. Handy to save entire threads, not very useful for |
| 94 ;; decoding, as nobody posts encoded files in threads... | 95 ;; decoding, as nobody posts encoded files in threads... |
| 95 ;; | 96 ;; |
| 96 ;; V2.7.2: New functions for digesting and forwarding articles added | 97 ;; v2.7.2: New functions for digesting and forwarding articles added |
| 97 ;; on the suggestion of Per Abrahamsen. Also added a function for | 98 ;; on the suggestion of Per Abrahamsen. Also added a function for |
| 98 ;; marking threads. | 99 ;; marking threads. |
| 100 ;; | |
| 101 ;; v2.8: Fixed saving original files in interactive mode. Fixed ask | |
| 102 ;; before/save after view. Fixed setting up interactive buffers. Added | |
| 103 ;; scanning and rescanning from interactive mode. Added the | |
| 104 ;; `gnus-uu-ignore-file-by-name' and `...-by-type' variables to allow | |
| 105 ;; users to sift files they don't want to view. At the suggestion of | |
| 106 ;; boris@cs.rochester.edu, `C-c C-v C-h' has been undefined to allow | |
| 107 ;; users to view list of binding beginning with `C-c C-v'. Fixed | |
| 108 ;; viewing with `gnus-uu-asynchronous' set. The | |
| 109 ;; "decode-and-save/view-all-articles" functions now accepts the | |
| 110 ;; numeric prefix to delimit the maximum number of files to be | |
| 111 ;; decoded. | |
| 99 | 112 |
| 100 ;;; Code: | 113 ;;; Code: |
| 101 | 114 |
| 102 (require 'gnus) | 115 (require 'gnus) |
| 103 (require 'gnuspost) | 116 (require 'gnuspost) |
| 142 (define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles) | 155 (define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles) |
| 143 (define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles) | 156 (define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles) |
| 144 (define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles) | 157 (define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles) |
| 145 (define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles) | 158 (define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles) |
| 146 | 159 |
| 147 (define-key gnus-uu-ctl-map "\C-d" 'gnus-uu-threaded-decode-and-view) | |
| 148 (define-key gnus-uu-ctl-map "h" 'gnus-uu-threaded-decode-and-save) | |
| 149 (define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view) | 160 (define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view) |
| 150 (define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save) | 161 (define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save) |
| 151 | 162 |
| 152 (define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news) | 163 (define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news) |
| 153 | 164 |
| 384 This variable can be used to say what comamnds should be used to | 395 This variable can be used to say what comamnds should be used to |
| 385 unpack archives. | 396 unpack archives. |
| 386 | 397 |
| 387 | 398 |
| 388 Other Variables | 399 Other Variables |
| 400 | |
| 401 `gnus-uu-ignore-files-by-name' | |
| 402 Files with name matching this regular expression won't be viewed. | |
| 403 | |
| 404 `gnus-uu-ignore-files-by-type' | |
| 405 Files with a MIME type matching this variable won't be viewed. | |
| 406 Note that gnus-uu tries to guess what type the file is based on | |
| 407 the name. gnus-uu is not a MIME package, so this is slightly | |
| 408 kludgy. | |
| 389 | 409 |
| 390 `gnus-uu-tmp-dir' | 410 `gnus-uu-tmp-dir' |
| 391 Where gnus-uu does its work. | 411 Where gnus-uu does its work. |
| 392 | 412 |
| 393 `gnus-uu-do-not-unpack-archives' | 413 `gnus-uu-do-not-unpack-archives' |
| 493 '("\\.ps$" "ghostview") | 513 '("\\.ps$" "ghostview") |
| 494 '("\\.dvi$" "xdvi") | 514 '("\\.dvi$" "xdvi") |
| 495 '("\\.[1-6]$" "xterm -e man -l") | 515 '("\\.[1-6]$" "xterm -e man -l") |
| 496 '("\\.html$" "xmosaic") | 516 '("\\.html$" "xmosaic") |
| 497 '("\\.mpe?g$" "mpeg_play") | 517 '("\\.mpe?g$" "mpeg_play") |
| 498 '("\\.fli$" "xflick") | 518 '("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\)$" "xanim") |
| 499 '("\\.flc$" "xanim") | |
| 500 '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" | 519 '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" |
| 501 "gnus-uu-archive")) | 520 "gnus-uu-archive")) |
| 502 | 521 |
| 503 "Default actions to be taken when the user asks to view a file. | 522 "Default actions to be taken when the user asks to view a file. |
| 504 To change the behaviour, you can either edit this variable or set | 523 To change the behaviour, you can either edit this variable or set |
| 584 "A list that can be set to override the default archive unpacking commands. | 603 "A list that can be set to override the default archive unpacking commands. |
| 585 To use, for instance, 'untar' to unpack tar files and 'zip -x' to | 604 To use, for instance, 'untar' to unpack tar files and 'zip -x' to |
| 586 unpack zip files, say the following: | 605 unpack zip files, say the following: |
| 587 (setq gnus-uu-user-archive-rules | 606 (setq gnus-uu-user-archive-rules |
| 588 (list '(\"\\\\.tar$\" \"untar\") | 607 (list '(\"\\\\.tar$\" \"untar\") |
| 589 '(\"\\\\.zip$\" \"zip -x\")))" | 608 '(\"\\\\.zip$\" \"zip -x\")))") |
| 590 ) | 609 |
| 610 (defvar gnus-uu-ignore-files-by-name nil | |
| 611 "A regular expression saying what files should not be viewed based on name. | |
| 612 If, for instance, you want gnus-uu to ignore all .au and .wav files, | |
| 613 you could say something like | |
| 614 | |
| 615 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") | |
| 616 | |
| 617 Note that this variable can be used in conjunction with the | |
| 618 `gnus-uu-ignore-files-by-type' variable.") | |
| 619 | |
| 620 (defvar gnus-uu-ignore-files-by-type nil | |
| 621 "A regular expression saying what files that shouldn't be viewed, based on MIME file type. | |
| 622 If, for instance, you want gnus-uu to ignore all audio files and all mpegs, | |
| 623 you could say something like | |
| 624 | |
| 625 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") | |
| 626 | |
| 627 Note that this variable can be used in conjunction with the | |
| 628 `gnus-uu-ignore-files-by-name' variable.") | |
| 591 | 629 |
| 592 ;; Pseudo-MIME support | 630 ;; Pseudo-MIME support |
| 593 | 631 |
| 594 (defconst gnus-uu-ext-to-mime-list | 632 (defconst gnus-uu-ext-to-mime-list |
| 595 (list '("\\.gif$" "image/gif") | 633 (list '("\\.gif$" "image/gif") |
| 601 '("\\.ppm$" "image/ppm") | 639 '("\\.ppm$" "image/ppm") |
| 602 '("\\.xbm$" "image/xbm") | 640 '("\\.xbm$" "image/xbm") |
| 603 '("\\.pcx$" "image/pcx") | 641 '("\\.pcx$" "image/pcx") |
| 604 '("\\.tga$" "image/tga") | 642 '("\\.tga$" "image/tga") |
| 605 '("\\.ps$" "image/postscript") | 643 '("\\.ps$" "image/postscript") |
| 606 '("\\.fli$" "video/xflick") | 644 '("\\.fli$" "video/fli") |
| 607 '("\\.wav$" "audio/wav") | 645 '("\\.wav$" "audio/wav") |
| 608 '("\\.aiff$" "audio/aiff") | 646 '("\\.aiff$" "audio/aiff") |
| 609 '("\\.hcom$" "audio/hcom") | 647 '("\\.hcom$" "audio/hcom") |
| 610 '("\\.voc$" "audio/voc") | 648 '("\\.voc$" "audio/voc") |
| 611 '("\\.smp$" "audio/smp") | 649 '("\\.smp$" "audio/smp") |
| 612 '("\\.mod$" "audio/mod") | 650 '("\\.mod$" "audio/mod") |
| 613 '("\\.dvi$" "image/dvi") | 651 '("\\.dvi$" "image/dvi") |
| 614 '("\\.mpe?g$" "video/mpeg") | 652 '("\\.mpe?g$" "video/mpeg") |
| 615 '("\\.au$" "audio/basic") | 653 '("\\.au$" "audio/basic") |
| 616 '("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") | 654 '("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") |
| 655 '("\\.\\(c\\|h\\)$" "text/source") | |
| 617 '("read.*me" "text/plain") | 656 '("read.*me" "text/plain") |
| 618 '("\\.html$" "text/html") | 657 '("\\.html$" "text/html") |
| 658 '("\\.bat$" "text/bat") | |
| 659 '("\\.[1-6]$" "text/man") | |
| 660 '("\\.flc$" "video/flc") | |
| 661 '("\\.rle$" "video/rle") | |
| 662 '("\\.pfx$" "video/pfx") | |
| 663 '("\\.avi$" "video/avi") | |
| 664 '("\\.sme$" "video/sme") | |
| 665 '("\\.rpza$" "video/prza") | |
| 666 '("\\.dl$" "video/dl") | |
| 667 '("\\.qt$" "video/qt") | |
| 668 '("\\.rsrc$" "video/rsrc") | |
| 619 '("\\..*$" "unknown/unknown"))) | 669 '("\\..*$" "unknown/unknown"))) |
| 620 | 670 |
| 621 ;; Various variables users may set | 671 ;; Various variables users may set |
| 622 | 672 |
| 623 (defvar gnus-uu-tmp-dir "/tmp/" | 673 (defvar gnus-uu-tmp-dir "/tmp/" |
| 703 (defvar gnus-uu-shar-file-name nil) | 753 (defvar gnus-uu-shar-file-name nil) |
| 704 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") | 754 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") |
| 705 (defvar gnus-uu-shar-directory nil) | 755 (defvar gnus-uu-shar-directory nil) |
| 706 | 756 |
| 707 (defvar gnus-uu-file-name nil) | 757 (defvar gnus-uu-file-name nil) |
| 758 (defvar gnus-uu-list-of-files-decoded nil) | |
| 708 (defconst gnus-uu-uudecode-process nil) | 759 (defconst gnus-uu-uudecode-process nil) |
| 709 | 760 |
| 710 (defvar gnus-uu-interactive-file-list nil) | 761 (defvar gnus-uu-interactive-file-list nil) |
| 711 (defvar gnus-uu-marked-article-list nil) | 762 (defvar gnus-uu-marked-article-list nil) |
| 712 (defvar gnus-uu-generated-file-list nil) | 763 (defvar gnus-uu-generated-file-list nil) |
| 714 | 765 |
| 715 (defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*") | 766 (defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*") |
| 716 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*") | 767 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*") |
| 717 (defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*") | 768 (defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*") |
| 718 | 769 |
| 719 (defconst gnus-uu-error-during-unarching nil) | 770 (defconst gnus-uu-highest-article-number 1) |
| 720 | 771 |
| 721 ;; Interactive functions | 772 ;; Interactive functions |
| 722 | 773 |
| 723 ;; UUdecode and view | 774 ;; UUdecode and view |
| 724 | 775 |
| 999 ;; "All articles" commands | 1050 ;; "All articles" commands |
| 1000 | 1051 |
| 1001 (defconst gnus-uu-rest-of-articles nil) | 1052 (defconst gnus-uu-rest-of-articles nil) |
| 1002 (defvar gnus-uu-current-save-dir nil) | 1053 (defvar gnus-uu-current-save-dir nil) |
| 1003 | 1054 |
| 1004 (defun gnus-uu-decode-and-view-all-articles (&optional unread) | 1055 (defun gnus-uu-decode-and-view-all-articles (arg &optional unread) |
| 1005 "Try to decode all articles and view the result." | 1056 "Try to decode all articles and view the result. |
| 1006 (interactive) | 1057 ARG delimits the number of files to be decoded." |
| 1058 (interactive "p") | |
| 1007 (if (not (setq gnus-uu-marked-article-list | 1059 (if (not (setq gnus-uu-marked-article-list |
| 1008 (nreverse (gnus-uu-get-list-of-articles | 1060 (nreverse (gnus-uu-get-list-of-articles |
| 1009 "^." nil unread t)))) | 1061 "^." nil unread t)))) |
| 1010 (error "No%s articles to be decoded" (if unread " unread" ""))) | 1062 (error "No%s articles to be decoded" (if unread " unread" ""))) |
| 1011 (gnus-uu-decode-and-view-or-save t t)) | 1063 (gnus-uu-decode-and-view-or-save t t nil (if (> arg 1) arg nil))) |
| 1012 | 1064 |
| 1013 (defun gnus-uu-decode-and-view-all-unread-articles (&optional unread) | 1065 (defun gnus-uu-decode-and-view-all-unread-articles (arg) |
| 1014 "Try to decode all unread articles and view the result." | 1066 "Try to decode all unread articles and view the result. |
| 1015 (interactive) | 1067 ARG delimits the number of files to be decoded." |
| 1016 (gnus-uu-decode-and-view-all-articles t)) | 1068 (interactive "p") |
| 1017 | 1069 (gnus-uu-decode-and-view-all-articles arg t)) |
| 1018 (defun gnus-uu-decode-and-save-all-unread-articles () | 1070 |
| 1071 (defun gnus-uu-decode-and-save-all-unread-articles (arg) | |
| 1019 "Try to decode all unread articles and saves the result. | 1072 "Try to decode all unread articles and saves the result. |
| 1020 This function reads all unread articles in the current group and sees | 1073 This function reads all unread articles in the current group and sees |
| 1021 whether it can uudecode the articles. The user will be prompted for an | 1074 whether it can uudecode the articles. The user will be prompted for an |
| 1022 directory to put the resulting (if any) files." | 1075 directory to put the resulting (if any) files. |
| 1023 (interactive) | 1076 ARG delimits the number of files to be decoded." |
| 1024 (gnus-uu-decode-and-save-articles t t)) | 1077 (interactive "p") |
| 1025 | 1078 (gnus-uu-decode-and-save-articles arg t t)) |
| 1026 (defun gnus-uu-decode-and-save-all-articles () | 1079 |
| 1080 (defun gnus-uu-decode-and-save-all-articles (arg) | |
| 1027 "Try to decode all articles and saves the result. | 1081 "Try to decode all articles and saves the result. |
| 1028 Does the same as `gnus-uu-decode-and-save-all-unread-articles', except | 1082 Does the same as `gnus-uu-decode-and-save-all-unread-articles', except |
| 1029 that it grabs all articles visible, unread or not." | 1083 that it grabs all articles visible, unread or not. |
| 1030 (interactive) | 1084 ARG delimits the number of files to be decoded." |
| 1031 (gnus-uu-decode-and-save-articles nil t)) | 1085 (interactive "p") |
| 1032 | 1086 (gnus-uu-decode-and-save-articles arg nil t)) |
| 1033 (defun gnus-uu-decode-and-save-articles (&optional unread unmark) | 1087 |
| 1034 (let ((gnus-uu-unmark-articles-not-decoded t) | 1088 (defun gnus-uu-decode-and-save-articles (arg &optional unread unmark) |
| 1035 dir) | 1089 (let (dir) |
| 1036 (if (not (setq gnus-uu-marked-article-list | 1090 (if (not (setq gnus-uu-marked-article-list |
| 1037 (nreverse (gnus-uu-get-list-of-articles | 1091 (nreverse (gnus-uu-get-list-of-articles |
| 1038 "^." nil unread t)))) | 1092 "^." nil unread t)))) |
| 1039 (error "No%s articles to be decoded." (if unread " unread" "")) | 1093 (error "No%s articles to be decoded." (if unread " unread" "")) |
| 1040 (setq dir (gnus-uu-read-directory "Where do you want the files? ")) | 1094 (setq dir (gnus-uu-read-directory "Where do you want the files? ")) |
| 1041 (gnus-uu-decode-and-view-or-save nil t dir) | 1095 (gnus-uu-decode-and-view-or-save nil t dir (if (> arg 1) arg nil)) |
| 1042 (message "Saved.")))) | 1096 (message "Saved.")))) |
| 1043 | 1097 |
| 1044 | 1098 |
| 1045 ;; Work functions | 1099 ;; Work functions |
| 1046 | 1100 |
| 1047 ; All the interactive uudecode/view/save/marked functions are interfaces | 1101 ; All the interactive uudecode/view/save/marked functions are interfaces |
| 1048 ; to this function, which does the rest. | 1102 ; to this function, which does the rest. |
| 1049 (defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir) | 1103 (defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir limit) |
| 1050 (gnus-uu-initialize) | 1104 (gnus-uu-initialize) |
| 1051 (let (decoded) | 1105 (let (decoded) |
| 1052 (save-excursion | 1106 (save-excursion |
| 1053 (if (gnus-uu-decode-and-strip nil marked) | 1107 (if (gnus-uu-decode-and-strip nil marked limit) |
| 1054 (progn | 1108 (progn |
| 1055 (setq decoded t) | 1109 (setq decoded t) |
| 1056 (if view | 1110 (if view |
| 1057 (gnus-uu-view-directory gnus-uu-work-dir | 1111 (gnus-uu-view-directory gnus-uu-work-dir |
| 1058 gnus-uu-use-interactive-view) | 1112 gnus-uu-use-interactive-view) |
| 1059 (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir) | 1113 (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir) |
| 1060 (gnus-uu-check-for-generated-files))))) | 1114 (gnus-uu-check-for-generated-files))))) |
| 1061 | 1115 |
| 1062 (gnus-uu-summary-next-subject) | 1116 (gnus-uu-summary-next-subject) |
| 1063 | 1117 |
| 1064 (if gnus-uu-error-during-unarching | 1118 (if (and gnus-uu-use-interactive-view view decoded) |
| 1065 (gnus-uu-clean-up) | 1119 (gnus-uu-do-interactive)) |
| 1066 (if (and gnus-uu-use-interactive-view view decoded) | |
| 1067 (gnus-uu-do-interactive))) | |
| 1068 | 1120 |
| 1069 (if (or (not view) (not gnus-uu-use-interactive-view) (not decoded)) | 1121 (if (or (not view) (not gnus-uu-use-interactive-view) (not decoded)) |
| 1070 (gnus-uu-clean-up)))) | 1122 (gnus-uu-clean-up)))) |
| 1071 | 1123 |
| 1072 ; Unshars and views/saves marked/unmarked articles. | 1124 ; Unshars and views/saves marked/unmarked articles. |
| 1342 ; right away, but sometime later. If the user is offered to save the | 1394 ; right away, but sometime later. If the user is offered to save the |
| 1343 ; file, it'll be moved to wherever the user wants it. | 1395 ; file, it'll be moved to wherever the user wants it. |
| 1344 | 1396 |
| 1345 ; `gnus-uu-view-file' returns t if viewing is successful. | 1397 ; `gnus-uu-view-file' returns t if viewing is successful. |
| 1346 | 1398 |
| 1347 (defun gnus-uu-view-file (file-name &optional dont-ask) | 1399 (defun gnus-uu-view-file (file &optional silent) |
| 1348 (let (action did-view | 1400 (let (action did-view) |
| 1349 (didnt-want t) | 1401 (cond |
| 1350 (do-view t)) | 1402 ((not (setq action (gnus-uu-get-action file))) |
| 1351 | 1403 (if (and (not silent) (not gnus-uu-use-interactive-view)) |
| 1352 (setq action (gnus-uu-get-action file-name)) | |
| 1353 | |
| 1354 ; Do interactive view if that is wanted and it is not an archive | |
| 1355 (if (and gnus-uu-use-interactive-view | |
| 1356 (not (string= (or action "") "gnus-uu-archive"))) | |
| 1357 (gnus-uu-enter-interactive-file (or action "") file-name) | |
| 1358 | |
| 1359 (if action | |
| 1360 (progn | 1404 (progn |
| 1361 | 1405 (message "Couldn't find any rule for file '%s'" file) |
| 1362 (if gnus-uu-ask-before-view | 1406 (sleep-for 2) |
| 1363 (setq didnt-want | 1407 (gnus-uu-ask-to-save-file file)))) |
| 1364 (or (not (setq do-view | 1408 |
| 1365 (y-or-n-p | 1409 ((and gnus-uu-use-interactive-view |
| 1366 (format "Do you want to view %s? " | 1410 (not (string= (or action "") "gnus-uu-archive"))) |
| 1367 file-name)))) | 1411 (gnus-uu-enter-interactive-file (or action "") file)) |
| 1368 didnt-want))) | 1412 |
| 1369 | 1413 (gnus-uu-ask-before-view |
| 1370 (if do-view | 1414 (if (y-or-n-p (format "Do you want to view %s? " file)) |
| 1371 (setq did-view | 1415 (setq did-view (gnus-uu-call-file-action file action))) |
| 1372 (if gnus-uu-asynchronous | 1416 (message "")) |
| 1373 (gnus-uu-call-asynchronous file-name action) | 1417 |
| 1374 (gnus-uu-call-synchronous file-name action))))) | 1418 ((setq did-view (gnus-uu-call-file-action file action))) |
| 1375 | 1419 |
| 1376 (if (and (not dont-ask) (not gnus-uu-use-interactive-view)) | 1420 ((not silent) |
| 1377 (progn | 1421 (gnus-uu-ask-to-save-file file))) |
| 1378 (if (and | 1422 |
| 1379 didnt-want | 1423 (if (and (file-exists-p file) |
| 1380 (or (not action) | 1424 (not gnus-uu-use-interactive-view) |
| 1381 (and (string= action "gnus-uu-archive") | 1425 (or |
| 1382 (not did-view)))) | 1426 (not (and gnus-uu-asynchronous did-view)) |
| 1383 (progn | 1427 (string= (or action "") "gnus-uu-archive"))) |
| 1384 (message | 1428 (delete-file file)) |
| 1385 (format "Could find no rule for %s" file-name)) | 1429 |
| 1386 (sit-for 2))) | 1430 did-view)) |
| 1387 (and (or (not did-view) gnus-uu-view-and-save) | 1431 |
| 1388 (y-or-n-p | 1432 (defun gnus-uu-call-file-action (file action) |
| 1389 (format "Do you want to save the file %s? " | 1433 (prog1 |
| 1390 file-name)) | 1434 (if gnus-uu-asynchronous |
| 1391 (gnus-uu-save-file file-name))))) | 1435 (gnus-uu-call-asynchronous file action) |
| 1392 | 1436 (gnus-uu-call-synchronous file action)) |
| 1393 (if (and (file-exists-p file-name) | 1437 (if gnus-uu-view-and-save |
| 1394 (not gnus-uu-use-interactive-view) | 1438 (gnus-uu-ask-to-save-file file)))) |
| 1395 (or | 1439 |
| 1396 (not (and gnus-uu-asynchronous did-view)) | 1440 (defun gnus-uu-ask-to-save-file (file) |
| 1397 (string= action "gnus-uu-archive"))) | 1441 (if (y-or-n-p (format "Do you want to save the file %s? " file)) |
| 1398 (delete-file file-name))) | 1442 (gnus-uu-save-file file)) |
| 1399 | 1443 (message "")) |
| 1400 did-view)) | |
| 1401 | 1444 |
| 1402 (defun gnus-uu-get-action (file-name) | 1445 (defun gnus-uu-get-action (file-name) |
| 1403 (let (action) | 1446 (let (action) |
| 1404 (setq action | 1447 (setq action |
| 1405 (gnus-uu-choose-action | 1448 (gnus-uu-choose-action |
| 1477 ; articles to grab, grabs them, strips the result and decodes. If any | 1520 ; articles to grab, grabs them, strips the result and decodes. If any |
| 1478 ; of these operations fail, it returns nil, t otherwise. If shar is | 1521 ; of these operations fail, it returns nil, t otherwise. If shar is |
| 1479 ; t, it will pass this on to `gnus-uu-grab-articles', which will | 1522 ; t, it will pass this on to `gnus-uu-grab-articles', which will |
| 1480 ; (probably) unshar the articles. If use-marked is non-nil, it won't | 1523 ; (probably) unshar the articles. If use-marked is non-nil, it won't |
| 1481 ; try to find articles, but use the marked list. | 1524 ; try to find articles, but use the marked list. |
| 1482 (defun gnus-uu-decode-and-strip (&optional shar use-marked) | 1525 (defun gnus-uu-decode-and-strip (&optional shar use-marked limit) |
| 1483 (let (list-of-articles) | 1526 (let (list-of-articles) |
| 1484 (save-excursion | 1527 (save-excursion |
| 1485 | 1528 |
| 1486 (if use-marked | 1529 (if use-marked |
| 1487 (if (not gnus-uu-marked-article-list) | 1530 (if (not gnus-uu-marked-article-list) |
| 1488 (message "No articles marked") | 1531 (message "No articles marked") |
| 1489 (setq list-of-articles (reverse gnus-uu-marked-article-list)) | 1532 (setq list-of-articles (reverse gnus-uu-marked-article-list)) |
| 1490 (gnus-uu-unmark-all-articles)) | 1533 (setq gnus-uu-marked-article-list nil)) |
| 1491 (setq list-of-articles (gnus-uu-get-list-of-articles))) | 1534 (setq list-of-articles (gnus-uu-get-list-of-articles))) |
| 1492 | 1535 |
| 1493 (and list-of-articles | 1536 (and list-of-articles |
| 1494 (gnus-uu-grab-articles | 1537 (gnus-uu-grab-articles |
| 1495 list-of-articles | 1538 list-of-articles |
| 1496 (if shar 'gnus-uu-unshar-article 'gnus-uu-uustrip-article-as) | 1539 (if shar 'gnus-uu-unshar-article 'gnus-uu-uustrip-article-as) |
| 1497 t))))) | 1540 t limit))))) |
| 1498 | 1541 |
| 1499 ; Takes a string and puts a \ in front of every special character; | 1542 ; Takes a string and puts a \ in front of every special character; |
| 1500 ; ignores any leading "version numbers" thingies that they use in the | 1543 ; ignores any leading "version numbers" thingies that they use in the |
| 1501 ; comp.binaries groups, and either replaces anything that looks like | 1544 ; comp.binaries groups, and either replaces anything that looks like |
| 1502 ; "2/3" with "[0-9]+/[0-9]+" or, if it can't find something like that, | 1545 ; "2/3" with "[0-9]+/[0-9]+" or, if it can't find something like that, |
| 1699 ; each article grabbed. The result of the function is appended on to | 1742 ; each article grabbed. The result of the function is appended on to |
| 1700 ; `gnus-uu-result-buffer'. | 1743 ; `gnus-uu-result-buffer'. |
| 1701 ; | 1744 ; |
| 1702 ; This function returns a list of files decoded if the grabbing and | 1745 ; This function returns a list of files decoded if the grabbing and |
| 1703 ; the process-function has been successful and nil otherwise. | 1746 ; the process-function has been successful and nil otherwise. |
| 1704 (defun gnus-uu-grab-articles (list-of-articles process-function &optional sloppy) | 1747 (defun gnus-uu-grab-articles (list-of-articles process-function &optional sloppy limit) |
| 1705 (let ((result-buffer (get-buffer-create gnus-uu-result-buffer)) | 1748 (let ((result-buffer (get-buffer-create gnus-uu-result-buffer)) |
| 1706 (state 'first) | 1749 (state 'first) |
| 1707 (wrong-type t) | 1750 (wrong-type t) |
| 1708 has-been-begin has-been-end | 1751 has-been-begin has-been-end |
| 1709 article result-file result-files process-state) | 1752 article result-file result-files process-state) |
| 1719 (not (memq 'end process-state)))) | 1762 (not (memq 'end process-state)))) |
| 1720 | 1763 |
| 1721 (setq article (car list-of-articles)) | 1764 (setq article (car list-of-articles)) |
| 1722 (setq list-of-articles (cdr list-of-articles)) | 1765 (setq list-of-articles (cdr list-of-articles)) |
| 1723 (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) | 1766 (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) |
| 1767 | |
| 1768 (if (> article gnus-uu-highest-article-number) | |
| 1769 (setq gnus-uu-highest-article-number article)) | |
| 1724 | 1770 |
| 1725 (if (eq list-of-articles ()) | 1771 (if (eq list-of-articles ()) |
| 1726 (if (eq state 'first) | 1772 (if (eq state 'first) |
| 1727 (setq state 'first-and-last) | 1773 (setq state 'first-and-last) |
| 1728 (setq state 'last))) | 1774 (setq state 'last))) |
| 1751 (if (memq 'end process-state) | 1797 (if (memq 'end process-state) |
| 1752 (progn | 1798 (progn |
| 1753 (setq gnus-uu-has-been-grabbed nil) | 1799 (setq gnus-uu-has-been-grabbed nil) |
| 1754 (setq result-files (cons result-file result-files)) | 1800 (setq result-files (cons result-file result-files)) |
| 1755 (setq has-been-end t) | 1801 (setq has-been-end t) |
| 1756 (setq has-been-begin nil))) | 1802 (setq has-been-begin nil) |
| 1803 (if (and limit (= (length result-files) limit)) | |
| 1804 (progn | |
| 1805 (setq list-of-articles nil) | |
| 1806 (setq gnus-uu-marked-article-list nil))))) | |
| 1807 | |
| 1808 (if (and (or (eq state 'last) (eq state 'first-and-last)) | |
| 1809 (not (memq 'end process-state))) | |
| 1810 (if (and result-file (file-exists-p result-file)) | |
| 1811 (delete-file result-file))) | |
| 1812 | |
| 1813 (setq result-file nil) | |
| 1757 | 1814 |
| 1758 (if (not (memq 'wrong-type process-state)) | 1815 (if (not (memq 'wrong-type process-state)) |
| 1759 (setq wrong-type nil) | 1816 (setq wrong-type nil) |
| 1760 (if gnus-uu-unmark-articles-not-decoded | 1817 (if gnus-uu-unmark-articles-not-decoded |
| 1761 (gnus-summary-mark-as-unread article t))) | 1818 (gnus-summary-mark-as-unread article t))) |
| 1782 (memq 'end process-state))) | 1839 (memq 'end process-state))) |
| 1783 (progn | 1840 (progn |
| 1784 (message "End of articles reached before end of file") | 1841 (message "End of articles reached before end of file") |
| 1785 (setq result-files nil)) | 1842 (setq result-files nil)) |
| 1786 (gnus-uu-unmark-list-of-grabbed))))) | 1843 (gnus-uu-unmark-list-of-grabbed))))) |
| 1844 (setq gnus-uu-list-of-files-decoded result-files) | |
| 1787 result-files)) | 1845 result-files)) |
| 1788 | 1846 |
| 1789 (defun gnus-uu-uudecode-sentinel (process event) | 1847 (defun gnus-uu-uudecode-sentinel (process event) |
| 1790 (delete-process (get-process process))) | 1848 (delete-process (get-process process))) |
| 1791 | 1849 |
| 1821 (setq name-end (match-end 1)) | 1879 (setq name-end (match-end 1)) |
| 1822 | 1880 |
| 1823 ; Replace any slashes and spaces in file names before decoding | 1881 ; Replace any slashes and spaces in file names before decoding |
| 1824 (goto-char (setq name-beg (match-beginning 1))) | 1882 (goto-char (setq name-beg (match-beginning 1))) |
| 1825 (while (re-search-forward "/" name-end t) | 1883 (while (re-search-forward "/" name-end t) |
| 1826 (replace-match "-")) | 1884 (replace-match ",")) |
| 1827 (goto-char name-beg) | 1885 (goto-char name-beg) |
| 1828 (while (re-search-forward " " name-end t) | 1886 (while (re-search-forward " " name-end t) |
| 1829 (replace-match "_")) | 1887 (replace-match "_")) |
| 1830 | 1888 |
| 1831 (setq gnus-uu-file-name (buffer-substring name-beg name-end)) | 1889 (setq gnus-uu-file-name (buffer-substring name-beg name-end)) |
| 1879 (error | 1937 (error |
| 1880 (progn | 1938 (progn |
| 1881 (message "gnus-uu: Couldn't uudecode") | 1939 (message "gnus-uu: Couldn't uudecode") |
| 1882 (sleep-for 2) | 1940 (sleep-for 2) |
| 1883 (setq state (list 'wrong-type)) | 1941 (setq state (list 'wrong-type)) |
| 1884 (delete-process gnus-uu-uudecode-process))))) | 1942 (delete-process gnus-uu-uudecode-process)))) |
| 1943 (if (memq 'end state) | |
| 1944 (accept-process-output gnus-uu-uudecode-process))) | |
| 1885 (setq state (list 'wrong-type)))) | 1945 (setq state (list 'wrong-type)))) |
| 1886 (if (not gnus-uu-uudecode-process) | 1946 (if (not gnus-uu-uudecode-process) |
| 1887 (setq state (list 'wrong-type))))) | 1947 (setq state (list 'wrong-type))))) |
| 1888 | 1948 |
| 1889 (if (memq 'begin state) | 1949 (if (memq 'begin state) |
| 1927 (substring subject (string-match "[0-9]" subject 1) end)))) | 1987 (substring subject (string-match "[0-9]" subject 1) end)))) |
| 1928 | 1988 |
| 1929 ; `gnus-uu-choose-action' chooses what action to perform given the name | 1989 ; `gnus-uu-choose-action' chooses what action to perform given the name |
| 1930 ; and `gnus-uu-file-action-list'. Returns either nil if no action is | 1990 ; and `gnus-uu-file-action-list'. Returns either nil if no action is |
| 1931 ; found, or the name of the command to run if such a rule is found. | 1991 ; found, or the name of the command to run if such a rule is found. |
| 1932 (defun gnus-uu-choose-action (file-name file-action-list) | 1992 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) |
| 1933 (let ((action-list (copy-sequence file-action-list)) | 1993 (let ((action-list (copy-sequence file-action-list)) |
| 1934 rule action) | 1994 rule action) |
| 1935 (while (not (or (eq action-list ()) action)) | 1995 (and |
| 1936 (setq rule (car action-list)) | 1996 (or no-ignore |
| 1937 (setq action-list (cdr action-list)) | 1997 (and (not |
| 1938 (if (string-match (car rule) file-name) | 1998 (and gnus-uu-ignore-files-by-name |
| 1939 (setq action (car (cdr rule))))) | 1999 (string-match gnus-uu-ignore-files-by-name file-name))) |
| 2000 (not | |
| 2001 (and gnus-uu-ignore-files-by-type | |
| 2002 (string-match gnus-uu-ignore-files-by-type | |
| 2003 (or (gnus-uu-choose-action | |
| 2004 file-name gnus-uu-ext-to-mime-list t) | |
| 2005 "")))))) | |
| 2006 (while (not (or (eq action-list ()) action)) | |
| 2007 (setq rule (car action-list)) | |
| 2008 (setq action-list (cdr action-list)) | |
| 2009 (if (string-match (car rule) file-name) | |
| 2010 (setq action (car (cdr rule)))))) | |
| 1940 action)) | 2011 action)) |
| 1941 | 2012 |
| 1942 (defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing) | 2013 (defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing) |
| 1943 (let (dir file-name command files file) | 2014 (let (dir file-name command files file) |
| 1944 (setq files (directory-files from-dir t)) | 2015 (setq files (directory-files from-dir t)) |
| 2030 | 2101 |
| 2031 (if (= 0 (call-process "sh" nil | 2102 (if (= 0 (call-process "sh" nil |
| 2032 (get-buffer-create gnus-uu-output-buffer-name) | 2103 (get-buffer-create gnus-uu-output-buffer-name) |
| 2033 nil "-c" command)) | 2104 nil "-c" command)) |
| 2034 (message "") | 2105 (message "") |
| 2035 (message "Error during unpacking of archive") | 2106 (if (not gnus-uu-use-interactive-view) |
| 2036 (sleep-for 2) | 2107 (progn |
| 2108 (message "Error during unpacking of archive") | |
| 2109 (sleep-for 2))) | |
| 2037 (setq did-unpack nil)) | 2110 (setq did-unpack nil)) |
| 2038 | 2111 |
| 2039 (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) | 2112 (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) |
| 2040 (rename-file (concat file-path "~") file-path t)) | 2113 (rename-file (concat file-path "~") file-path t)) |
| 2041 | 2114 |
| 2054 files (if not-top (list ".") | 2127 files (if not-top (list ".") |
| 2055 (if first () ignore-files))) | 2128 (if first () ignore-files))) |
| 2056 (setq first nil) | 2129 (setq first nil) |
| 2057 (gnus-uu-add-file | 2130 (gnus-uu-add-file |
| 2058 (setq files (directory-files dir t "[^/][^\\.][^\\.]?$")))) | 2131 (setq files (directory-files dir t "[^/][^\\.][^\\.]?$")))) |
| 2132 | |
| 2133 (gnus-uu-add-file (directory-files dir t "[^/][^\\.][^\\.]?$")) | |
| 2059 | 2134 |
| 2060 (while files | 2135 (while files |
| 2061 (setq file (car files)) | 2136 (setq file (car files)) |
| 2062 (setq files (cdr files)) | 2137 (setq files (cdr files)) |
| 2063 (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive")) | 2138 (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive")) |
| 2067 (setq did-view (or (gnus-uu-view-directory file | 2142 (setq did-view (or (gnus-uu-view-directory file |
| 2068 dont-delete-files | 2143 dont-delete-files |
| 2069 t) | 2144 t) |
| 2070 did-view)) | 2145 did-view)) |
| 2071 (setq did-view (or (gnus-uu-view-file file t) did-view))))) | 2146 (setq did-view (or (gnus-uu-view-file file t) did-view))))) |
| 2072 (if (and (not dont-delete-files) (file-exists-p file)) | 2147 (if (and (not dont-delete-files) (not gnus-uu-asynchronous) |
| 2148 (file-exists-p file)) | |
| 2073 (delete-file file))) | 2149 (delete-file file))) |
| 2074 | 2150 |
| 2075 (if (not dont-delete-files) (delete-directory dir)) | 2151 (if (and (not gnus-uu-asynchronous) (not dont-delete-files)) |
| 2152 (if (string-match "/$" dir) | |
| 2153 (delete-directory (substring dir 0 (match-beginning 0))) | |
| 2154 (delete-directory dir))) | |
| 2076 did-view)) | 2155 did-view)) |
| 2077 | 2156 |
| 2078 (defun gnus-uu-unpack-archives (files &optional ignore) | 2157 (defun gnus-uu-unpack-archives (files &optional ignore) |
| 2079 (let (path did-unpack) | 2158 (let (path did-unpack) |
| 2080 (while files | 2159 (while files |
| 2083 (if (not (gnus-uu-string-in-list path ignore)) | 2162 (if (not (gnus-uu-string-in-list path ignore)) |
| 2084 (if (string= (or (gnus-uu-get-action | 2163 (if (string= (or (gnus-uu-get-action |
| 2085 (gnus-uu-name-from-path path)) "") | 2164 (gnus-uu-name-from-path path)) "") |
| 2086 "gnus-uu-archive") | 2165 "gnus-uu-archive") |
| 2087 (progn | 2166 (progn |
| 2088 (setq did-unpack t) | 2167 (if (and (not (setq did-unpack (gnus-uu-treat-archive path))) |
| 2089 (setq gnus-uu-error-during-unarching | 2168 gnus-uu-use-interactive-view) |
| 2090 (not (gnus-uu-treat-archive path))) | 2169 (gnus-uu-enter-interactive-file |
| 2170 "# error during unpacking of" path)) | |
| 2091 (if ignore (delete-file path)))))) | 2171 (if ignore (delete-file path)))))) |
| 2092 did-unpack)) | 2172 did-unpack)) |
| 2093 | 2173 |
| 2094 | 2174 |
| 2095 ;; Manual marking | 2175 ;; Manual marking |
| 2190 (setq file (car files)) | 2270 (setq file (car files)) |
| 2191 (setq files (cdr files)) | 2271 (setq files (cdr files)) |
| 2192 (if (not (string-match "/\\.\\.?$" file)) | 2272 (if (not (string-match "/\\.\\.?$" file)) |
| 2193 (setq out (cons file out)))) | 2273 (setq out (cons file out)))) |
| 2194 (setq out (reverse out)) | 2274 (setq out (reverse out)) |
| 2195 (message "dir-files %s er %s" dir out)(sleep-for 2) | |
| 2196 out)) | 2275 out)) |
| 2197 | 2276 |
| 2198 (defun gnus-uu-check-correct-stripped-uucode (start end) | 2277 (defun gnus-uu-check-correct-stripped-uucode (start end) |
| 2199 (let (found beg length short) | 2278 (let (found beg length short) |
| 2200 (if (not gnus-uu-correct-stripped-uucode) | 2279 (if (not gnus-uu-correct-stripped-uucode) |
| 2226 (if (not (= length (- (point) beg))) | 2305 (if (not (= length (- (point) beg))) |
| 2227 (insert (make-string (- length (- (point) beg)) ? )))) | 2306 (insert (make-string (- length (- (point) beg)) ? )))) |
| 2228 (forward-line 1)))))) | 2307 (forward-line 1)))))) |
| 2229 | 2308 |
| 2230 (defun gnus-uu-initialize () | 2309 (defun gnus-uu-initialize () |
| 2310 (setq gnus-uu-highest-article-number 1) | |
| 2231 (gnus-uu-check-for-generated-files) | 2311 (gnus-uu-check-for-generated-files) |
| 2232 (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir)) | 2312 (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir)) |
| 2233 (if (string-match "[^/]$" gnus-uu-tmp-dir) | 2313 (if (string-match "[^/]$" gnus-uu-tmp-dir) |
| 2234 (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/"))) | 2314 (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/"))) |
| 2235 (if (not (file-directory-p gnus-uu-tmp-dir)) | 2315 (if (not (file-directory-p gnus-uu-tmp-dir)) |
| 2240 (concat gnus-uu-tmp-dir (make-temp-name "gnus"))) | 2320 (concat gnus-uu-tmp-dir (make-temp-name "gnus"))) |
| 2241 (gnus-uu-add-file gnus-uu-work-dir) | 2321 (gnus-uu-add-file gnus-uu-work-dir) |
| 2242 (if (not (file-directory-p gnus-uu-work-dir)) | 2322 (if (not (file-directory-p gnus-uu-work-dir)) |
| 2243 (make-directory gnus-uu-work-dir)) | 2323 (make-directory gnus-uu-work-dir)) |
| 2244 (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")) | 2324 (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")) |
| 2245 (setq gnus-uu-error-during-unarching nil) | |
| 2246 (setq gnus-uu-interactive-file-list nil)) | 2325 (setq gnus-uu-interactive-file-list nil)) |
| 2247 | 2326 |
| 2248 ; Kills the temporary uu buffers, kills any processes, etc. | 2327 ; Kills the temporary uu buffers, kills any processes, etc. |
| 2249 (defun gnus-uu-clean-up () | 2328 (defun gnus-uu-clean-up () |
| 2250 (let (buf pst) | 2329 (let (buf pst) |
| 2275 (setq dirs (nreverse dirs)) | 2354 (setq dirs (nreverse dirs)) |
| 2276 (while dirs | 2355 (while dirs |
| 2277 (setq file (car dirs)) | 2356 (setq file (car dirs)) |
| 2278 (setq dirs (cdr dirs)) | 2357 (setq dirs (cdr dirs)) |
| 2279 (if (file-directory-p file) | 2358 (if (file-directory-p file) |
| 2280 (delete-directory file))))) | 2359 (if (string-match "/$" file) |
| 2360 (delete-directory (substring file 0 (match-beginning 0))) | |
| 2361 (delete-directory file)))))) | |
| 2281 | 2362 |
| 2282 ; Add a file (or a list of files) to be checked (and deleted if it/they | 2363 ; Add a file (or a list of files) to be checked (and deleted if it/they |
| 2283 ; still exists upon exiting the newsgroup). | 2364 ; still exists upon exiting the newsgroup). |
| 2284 (defun gnus-uu-add-file (file) | 2365 (defun gnus-uu-add-file (file) |
| 2285 (if (stringp file) | 2366 (if (stringp file) |
| 2294 (let (opi) | 2375 (let (opi) |
| 2295 (if (not (gnus-summary-search-forward t)) | 2376 (if (not (gnus-summary-search-forward t)) |
| 2296 (progn | 2377 (progn |
| 2297 (goto-char 1) | 2378 (goto-char 1) |
| 2298 (sit-for 0) | 2379 (sit-for 0) |
| 2299 (goto-char (point-max)) | 2380 (gnus-summary-goto-subject gnus-uu-highest-article-number))) |
| 2300 (forward-line -1) | |
| 2301 (beginning-of-line) | |
| 2302 (search-forward ":" nil t))) | |
| 2303 | 2381 |
| 2304 ; You may well find all this a bit puzzling - so do I, but I seem | 2382 ; You may well find all this a bit puzzling - so do I, but I seem |
| 2305 ; to have to do something like this to move to the next unread article, | 2383 ; to have to do something like this to move to the next unread article, |
| 2306 ; as `sit-for' seems to do some rather strange things here. Might | 2384 ; as `sit-for' seems to do some rather strange things here. Might |
| 2307 ; be a bug in my head, probably. | 2385 ; be a bug in my head, probably. |
| 2336 | 2414 |
| 2337 ;; Interactive exec mode | 2415 ;; Interactive exec mode |
| 2338 | 2416 |
| 2339 (defvar gnus-uu-output-window nil) | 2417 (defvar gnus-uu-output-window nil) |
| 2340 (defvar gnus-uu-mode-hook nil) | 2418 (defvar gnus-uu-mode-hook nil) |
| 2419 | |
| 2341 (defvar gnus-uu-mode-map nil) | 2420 (defvar gnus-uu-mode-map nil) |
| 2342 | |
| 2343 (defun gnus-uu-do-interactive () | |
| 2344 (let (int-buffer out-buf) | |
| 2345 (set-buffer | |
| 2346 (setq int-buffer (get-buffer gnus-uu-interactive-buffer-name))) | |
| 2347 (switch-to-buffer-other-window int-buffer) | |
| 2348 (pop-to-buffer int-buffer) | |
| 2349 (setq gnus-uu-output-window | |
| 2350 (split-window nil (- (window-height) gnus-uu-output-window-height))) | |
| 2351 (set-window-buffer gnus-uu-output-window | |
| 2352 (setq out-buf | |
| 2353 (get-buffer-create gnus-uu-output-buffer-name))) | |
| 2354 (save-excursion (set-buffer out-buf) (erase-buffer)) | |
| 2355 (goto-char 1) | |
| 2356 (forward-line 3) | |
| 2357 (run-hooks 'gnus-uu-mode-hook))) | |
| 2358 | |
| 2359 (defun gnus-uu-enter-interactive-file (action file) | |
| 2360 (let (command) | |
| 2361 (save-excursion | |
| 2362 (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) | |
| 2363 (if (not gnus-uu-interactive-file-list) | |
| 2364 (progn | |
| 2365 (erase-buffer) | |
| 2366 (gnus-uu-mode) | |
| 2367 (insert | |
| 2368 "# Press return to execute a command. | |
| 2369 # Press `C-c C-c' to exit interactive view. | |
| 2370 | |
| 2371 "))) | |
| 2372 (setq gnus-uu-interactive-file-list | |
| 2373 (cons file gnus-uu-interactive-file-list)) | |
| 2374 (setq command (gnus-uu-command action file)) | |
| 2375 (insert (format "%s\n" command))))) | |
| 2376 | |
| 2377 (defun gnus-uu-interactive-execute () | |
| 2378 "Executes the command on the current line in interactive mode." | |
| 2379 (interactive) | |
| 2380 (let (beg out-buf command) | |
| 2381 (beginning-of-line) | |
| 2382 (setq beg (point)) | |
| 2383 (end-of-line) | |
| 2384 (setq command (buffer-substring beg (point))) | |
| 2385 (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) | |
| 2386 (save-excursion | |
| 2387 (set-buffer out-buf) | |
| 2388 (erase-buffer) | |
| 2389 (insert (format "$ %s \n\n" command))) | |
| 2390 (message "Executing...") | |
| 2391 (if gnus-uu-asynchronous | |
| 2392 (start-process "gnus-uu-view" out-buf "sh" "-c" command) | |
| 2393 (call-process "sh" nil out-buf nil "-c" command) | |
| 2394 (message "")) | |
| 2395 (forward-line 1) | |
| 2396 (beginning-of-line))) | |
| 2397 | |
| 2398 (defun gnus-uu-interactive-end () | |
| 2399 "This function exits interactive view mode and returns to summary mode." | |
| 2400 (interactive) | |
| 2401 (let (buf) | |
| 2402 (delete-window gnus-uu-output-window) | |
| 2403 (gnus-uu-clean-up) | |
| 2404 (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files)) | |
| 2405 (setq buf (get-buffer gnus-uu-interactive-buffer-name)) | |
| 2406 (if gnus-article-buffer (switch-to-buffer gnus-article-buffer)) | |
| 2407 (if buf (kill-buffer buf)) | |
| 2408 (pop-to-buffer gnus-summary-buffer))) | |
| 2409 | |
| 2410 (if gnus-uu-mode-map | 2421 (if gnus-uu-mode-map |
| 2411 () | 2422 () |
| 2412 (setq gnus-uu-mode-map (make-sparse-keymap)) | 2423 (setq gnus-uu-mode-map (make-sparse-keymap)) |
| 2413 (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) | 2424 (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) |
| 2414 (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) | 2425 (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) |
| 2417 (define-key gnus-uu-mode-map "\C-cs" | 2428 (define-key gnus-uu-mode-map "\C-cs" |
| 2418 'gnus-uu-interactive-save-current-file) | 2429 'gnus-uu-interactive-save-current-file) |
| 2419 (define-key gnus-uu-mode-map "\C-c\C-s" | 2430 (define-key gnus-uu-mode-map "\C-c\C-s" |
| 2420 'gnus-uu-interactive-save-current-file-silent) | 2431 'gnus-uu-interactive-save-current-file-silent) |
| 2421 (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files) | 2432 (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files) |
| 2422 (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)) | 2433 (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file) |
| 2434 (define-key gnus-uu-mode-map "\C-c\C-r" 'gnus-uu-interactive-rescan-directory) | |
| 2435 (define-key gnus-uu-mode-map "\C-cr" 'gnus-uu-interactive-scan-directory) | |
| 2436 ) | |
| 2437 | |
| 2438 (defun gnus-uu-interactive-set-up-windows () | |
| 2439 (let (int-buf out-buf) | |
| 2440 (set-buffer | |
| 2441 (setq int-buf (get-buffer-create gnus-uu-interactive-buffer-name))) | |
| 2442 (if (not (get-buffer-window int-buf)) | |
| 2443 (switch-to-buffer-other-window int-buf)) | |
| 2444 (pop-to-buffer int-buf) | |
| 2445 (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) | |
| 2446 (if (not (get-buffer-window out-buf)) | |
| 2447 (progn | |
| 2448 (setq gnus-uu-output-window | |
| 2449 (split-window nil (- (window-height) | |
| 2450 gnus-uu-output-window-height))) | |
| 2451 (set-window-buffer gnus-uu-output-window out-buf))))) | |
| 2452 | |
| 2453 (defun gnus-uu-do-interactive (&optional dont-do-windows) | |
| 2454 (if (not gnus-uu-interactive-file-list) | |
| 2455 (gnus-uu-enter-interactive-file "#" "")) | |
| 2456 (if (not dont-do-windows) (gnus-uu-interactive-set-up-windows)) | |
| 2457 (save-excursion | |
| 2458 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
| 2459 (erase-buffer)) | |
| 2460 (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) | |
| 2461 (goto-char 1) | |
| 2462 (forward-line 3) | |
| 2463 (run-hooks 'gnus-uu-mode-hook)) | |
| 2464 | |
| 2465 (defun gnus-uu-enter-interactive-file (action file) | |
| 2466 (let (command) | |
| 2467 (save-excursion | |
| 2468 (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) | |
| 2469 (if (not gnus-uu-interactive-file-list) | |
| 2470 (progn | |
| 2471 (erase-buffer) | |
| 2472 (gnus-uu-mode) | |
| 2473 (insert | |
| 2474 "# Press return to execute a command. | |
| 2475 # Press `C-c C-c' to exit interactive view. | |
| 2476 | |
| 2477 "))) | |
| 2478 (setq gnus-uu-interactive-file-list | |
| 2479 (cons file gnus-uu-interactive-file-list)) | |
| 2480 ; (if (string-match (concat "^" gnus-uu-work-dir) file) | |
| 2481 ; (setq file (substring file (match-end 0)))) | |
| 2482 (setq command (gnus-uu-command action file)) | |
| 2483 (goto-char (point-max)) | |
| 2484 (insert (format "%s\n" command))))) | |
| 2485 | |
| 2486 (defun gnus-uu-interactive-execute () | |
| 2487 "Executes the command on the current line in interactive mode." | |
| 2488 (interactive) | |
| 2489 (let (beg out-buf command) | |
| 2490 (beginning-of-line) | |
| 2491 (setq beg (point)) | |
| 2492 (end-of-line) | |
| 2493 (setq command (buffer-substring beg (point))) | |
| 2494 (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) | |
| 2495 (save-excursion | |
| 2496 (set-buffer out-buf) | |
| 2497 (erase-buffer) | |
| 2498 (insert (format "$ %s \n\n" command))) | |
| 2499 (setq command (format "cd %s ; %s" gnus-uu-work-dir command)) | |
| 2500 (message "Executing...") | |
| 2501 (if gnus-uu-asynchronous | |
| 2502 (start-process "gnus-uu-view" out-buf "sh" "-c" command) | |
| 2503 (call-process "sh" nil out-buf nil "-c" command) | |
| 2504 (message "")) | |
| 2505 (end-of-line) | |
| 2506 (if (= (forward-line 1) 1) | |
| 2507 (progn | |
| 2508 (end-of-line) | |
| 2509 (insert "\n"))) | |
| 2510 (beginning-of-line))) | |
| 2511 | |
| 2512 (defun gnus-uu-interactive-end () | |
| 2513 "This function exits interactive view mode and returns to summary mode." | |
| 2514 (interactive) | |
| 2515 (let (buf) | |
| 2516 (delete-window gnus-uu-output-window) | |
| 2517 (gnus-uu-clean-up) | |
| 2518 (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files)) | |
| 2519 (setq buf (get-buffer gnus-uu-interactive-buffer-name)) | |
| 2520 (if gnus-article-buffer (switch-to-buffer gnus-article-buffer)) | |
| 2521 (if buf (kill-buffer buf)) | |
| 2522 (pop-to-buffer gnus-summary-buffer))) | |
| 2523 | |
| 2524 | |
| 2525 (defun gnus-uu-interactive-scan-directory (dir) | |
| 2526 "Read any directory and view the files. | |
| 2527 When used in interactive mode, the files and commands will be displayed, | |
| 2528 as usual, in the interactive mode buffer." | |
| 2529 (interactive "DDirectory: ") | |
| 2530 (setq gnus-uu-interactive-file-list nil) | |
| 2531 (gnus-uu-view-directory dir gnus-uu-use-interactive-view) | |
| 2532 (gnus-uu-do-interactive t)) | |
| 2533 | |
| 2534 (defun gnus-uu-interactive-rescan-directory () | |
| 2535 "Reread the directory and view the files. | |
| 2536 When used in interactive mode, the files and commands will be displayed, | |
| 2537 as usual, in the interactive mode buffer." | |
| 2538 (interactive) | |
| 2539 (gnus-uu-interactive-scan-directory gnus-uu-work-dir)) | |
| 2423 | 2540 |
| 2424 (defun gnus-uu-interactive-save-original-file () | 2541 (defun gnus-uu-interactive-save-original-file () |
| 2425 "Saves the file from whence the file on the current line came from." | 2542 "Saves the file from whence the file on the current line came from." |
| 2426 (interactive) | 2543 (interactive) |
| 2427 (let (file) | 2544 (let ((files gnus-uu-list-of-files-decoded) |
| 2428 (if (file-exists-p | 2545 (filestr "") |
| 2429 (setq file (concat gnus-uu-work-dir | 2546 file did dir) |
| 2430 (or gnus-uu-file-name gnus-uu-shar-file-name)))) | 2547 (while files |
| 2431 (progn | 2548 (setq file (car files)) |
| 2432 (gnus-uu-save-file file) | 2549 (setq files (cdr files)) |
| 2433 (message "Saved file %s" | 2550 (if (file-exists-p file) |
| 2434 (or gnus-uu-file-name gnus-uu-shar-file-name))) | 2551 (progn |
| 2435 (message "Already saved.")))) | 2552 (if (not did) |
| 2553 (progn | |
| 2554 (setq dir (gnus-uu-read-directory | |
| 2555 (format "Where do you want the file%s? " | |
| 2556 (if (> (length files) 1) "s" "")))) | |
| 2557 (setq did t))) | |
| 2558 (setq filestr (concat filestr (gnus-uu-name-from-path file) " ")) | |
| 2559 (gnus-uu-save-file file dir t))) | |
| 2560 (if did | |
| 2561 (message "Saved %s" filestr) | |
| 2562 (message "Already saved."))))) | |
| 2436 | 2563 |
| 2437 (defun gnus-uu-interactive-save-current-file-silent () | 2564 (defun gnus-uu-interactive-save-current-file-silent () |
| 2438 "Saves the file referred to on the current line in the current directory." | 2565 "Saves the file referred to on the current line in the current directory." |
| 2439 (interactive) | 2566 (interactive) |
| 2440 (gnus-uu-interactive-save-current-file t)) | 2567 (gnus-uu-interactive-save-current-file t)) |
| 2473 (defun gnus-uu-mode () | 2600 (defun gnus-uu-mode () |
| 2474 "Major mode for editing view commands in gnus-uu. | 2601 "Major mode for editing view commands in gnus-uu. |
| 2475 | 2602 |
| 2476 Commands: | 2603 Commands: |
| 2477 \\<gnus-uu-mode-map>Return, C-c C-v, C-c C-x Execute the current command | 2604 \\<gnus-uu-mode-map>Return, C-c C-v, C-c C-x Execute the current command |
| 2478 \\[gnus-uu-interactive-end] End interactive mode | 2605 \\[gnus-uu-interactive-end]\tEnd interactive mode |
| 2479 \\[gnus-uu-interactive-save-current-file] Save the current file | 2606 \\[gnus-uu-interactive-save-current-file]\tSave the current file |
| 2480 \\[gnus-uu-interactive-save-current-file-silent] Save the current file without asking | 2607 \\[gnus-uu-interactive-save-current-file-silent]\tSave the current file without asking |
| 2481 where to put it | 2608 \twhere to put it |
| 2482 \\[gnus-uu-interactive-save-all-files] Save all files | 2609 \\[gnus-uu-interactive-save-all-files]\tSave all files |
| 2483 \\[gnus-uu-interactive-save-original-file] Save the original file: If the files | 2610 \\[gnus-uu-interactive-save-original-file]\tSave the original file: If the files |
| 2484 originated in an archive, the archive | 2611 \toriginated in an archive, the archive |
| 2485 file is saved. | 2612 \tfile is saved. |
| 2613 \\[gnus-uu-interactive-rescan-directory]\tRescan the directory | |
| 2614 \\[gnus-uu-interactive-scan-directory]\tScan any directory | |
| 2486 " | 2615 " |
| 2487 (interactive) | 2616 (interactive) |
| 2488 (kill-all-local-variables) | 2617 (kill-all-local-variables) |
| 2489 (use-local-map gnus-uu-mode-map) | 2618 (use-local-map gnus-uu-mode-map) |
| 2490 (setq mode-name "gnus-uu") | 2619 (setq mode-name "gnus-uu") |
| 2891 (set-buffer uubuf) | 3020 (set-buffer uubuf) |
| 2892 (goto-char beg) | 3021 (goto-char beg) |
| 2893 (if (= i parts) | 3022 (if (= i parts) |
| 2894 (goto-char (point-max)) | 3023 (goto-char (point-max)) |
| 2895 (forward-line gnus-uu-post-length)) | 3024 (forward-line gnus-uu-post-length)) |
| 3025 (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) | |
| 3026 (forward-line -4)) | |
| 2896 (setq end (point))) | 3027 (setq end (point))) |
| 2897 (insert-buffer-substring uubuf beg end) | 3028 (insert-buffer-substring uubuf beg end) |
| 2898 (insert beg-line) | 3029 (insert beg-line) |
| 2899 (insert "\n") | 3030 (insert "\n") |
| 2900 (setq beg end) | 3031 (setq beg end) |
| 2922 (and (fboundp 'bury-buffer) (bury-buffer)))))) | 3053 (and (fboundp 'bury-buffer) (bury-buffer)))))) |
| 2923 | 3054 |
| 2924 (provide 'gnus-uu) | 3055 (provide 'gnus-uu) |
| 2925 | 3056 |
| 2926 ;; gnus-uu.el ends here | 3057 ;; gnus-uu.el ends here |
| 2927 |