X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f919f65ca97361b637aae6a20f7b4d803d6b29cb..22cc6690e717501adc7dcbb19ec910a4009e92ca:/lisp/gnus-uu.el diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 3266493331..d632e0f33b 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,1258 +1,866 @@ -;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus -;; -;; Author: Lars Ingebrigtsen -;; Created: 2 Oct 1993 -;; Version: gnus-uu.el v 1.3.6 1994/04/07 -;; Keyword: gnus -;; -;; For gnus 4.*. -;; -;; All gnus-uu commands start with `C-c C-v'. -;; -;; Typing `C-c C-v C-v' (gnus-uu-decode-and-view) in the summary -;; buffer will try to find all articles in the same series, uudecode -;; them and view the resulting file(s). -;; -;; gnus-uu guesses what articles are in the series according to the -;; following simple rule: The subjects must be identical, except for -;; the last two numbers of the line. -;; -;; For example: If you choose a subject called "cat.gif (2/3)" gnus-uu -;; will find all the articles that matches "^cat.gif -;; ([0-9]+/[0-9]+).*$". Subjects that are nonstandard, like "cat.gif -;; (2/3) Part 6 of a series", will not be properly recognized by 'C-c -;; C-v C-v', and you have to mark the articles manually with '#'. -;; -;; Typing `C-c C-v v' (gnus-uu-decode-and-save) will do the same as -;; `C-c C-v C-v', except that it will not display the resulting file, but -;; save it instead. -;; -;; Typing `C-c C-v s' (gnus-uu-shar-and-save) does the same as `C-c -;; C-v v', and `C-c C-v C-s' (gnus-uu-shar-and-view) does the same as -;; `C-c C-v C-v', except that they unshar files instead, i. e. run -;; them through /bin/sh. Most shar files can be viewed and/or saved -;; with the normal uudecode commands, which is much safer, as no -;; foreign code is run. -;; -;; `#' (gnus-uu-mark-article) marks an article for later -;; decoding/unsharing/saving/viewing. The files will be decoded in the -;; sequence they were marked. To decode the files after you've marked -;; the articles you are interested in, type the corresponding key -;; strokes as the normal decoding commands, but put a `M-' in the last -;; keystroke. For instance, to perform a standard uudecode and view, -;; you would type `C-c C-v C-v'. To perform a marked uudecode and -;; view, say `C-v C-v M-C-v'. All the other view and save commands are -;; handled the same way; marked uudecode and save is then `C-c C-v -;; M-v'. -;; -;; `M-#' (gnus-uu-unmark-article) will remove the mark from a -;; previosly marked article. -;; -;; `C-c C-v C-u' (gnus-uu-unmark-all-articles) will remove the mark from -;; all marked articles. -;; -;; `C-c C-v C-r' (gnus-uu-mark-by-regexp) will prompt for a regular -;; expression and mark (forward) all articles matching that regular -;; expression. -;; -;; There's an additional way to reach the decoding functions to make -;; future expansions easier: `C-c C-v C-m' -;; (gnus-uu-multi-decode-and-view) and the corresponding save, marked -;; view and marked save keystrokes, `C-c C-v m', `C-c C-v M-C-m' and -;; `C-c C-v M-m' respectively. You will be prompted for decoding -;; method, like uudecode, shar, binhex or plain save. Note that -;; methods like binhex and save doesn't have view modes; even if you -;; issue a view command (`C-c C-v C-m' and "binhex"), gnus-uu will -;; just save the resulting binhex file. -;; -;; `C-c C-v C-b' (gnus-uu-decode-and-show-in-buffer) will decode the -;; current article and display the results in an emacs buffer. This -;; might be useful if there's jsut some text in the current article -;; that has been uuencoded by some perverse poster. -;; -;; `C-c C-v a' (gnus-uu-decode-and-save-all-articles) looks at all the -;; articles in the current newsgroup and tries to uudecode everything -;; it can find. The user will be prompted for a directory where the -;; resulting files (if any) will be stored. `C-c C-v M-a' only looks -;; at unread article. `C-c C-v w' does the same as `C-c C-v a', but -;; also marks as read all articles it has peeked through, even if they -;; weren't uuencoded articles. `C-c C-v M-w' is, as you might have -;; guessed, similar to `C-c C-v M-a'. -;; -;; `C-c C-v C-l' (gnus-uu-edit-begin-line) lets you edit the begin -;; line of the current buffer. Useful to change an incorrect suffix or -;; an incorrect begin line. -;; -;; -;; When using the view commands, `C-c C-v C-v' for instance, gnus-uu -;; will (normally, see below) try to view the file according to the -;; rules given in gnus-uu-default-view-rules and -;; gnus-uu-user-view-rules. If it recognises the file, it will display -;; it immediately. If the file is some sort of archive, gnus-uu will -;; attempt to unpack the archive and see if any of the files in the -;; archive can be viewed. For instance, if you have a gzipped tar file -;; "pics.tar.gz" containing the files "pic1.jpg" and "pic2.gif", -;; gnus-uu will uncompress and detar the main file, and then view the -;; two pictures. This unpacking process is recursive, so if the -;; archive contains archives of archives, it'll all be unpacked. -;; -;; If the view command doesn't recognise the file type, or can't view -;; it because you don't have the viewer, or can't view *any* of the -;; files in the archive, the user will be asked if she wishes to have -;; the file saved somewhere. Note that if the decoded file is an -;; archive, and gnus-uu manages to view some of the files in the -;; archive, it won't tell the user that there were some files that -;; were unviewable. See "Interactive view" for a different approach. -;; -;; -;; Note that gnus-uu adds a function to `gnus-exit-group-hook' to -;; clear the list of marked articles and check for any generated files -;; that might have escaped deletion if the user typed `C-g'. -;; -;; -;; `C-c C-v C-a' (gnus-uu-toggle-asynchronous) toggles the -;; gnus-uu-asynchronous variable. See below for explanation. -;; -;; `C-c C-v C-q' (gnus-uu-toggle-query) toggles the -;; gnus-uu-ask-before-view variable. See below for explanation. -;; -;; `C-c C-v C-p' (gnus-uu-toggle-always-ask) toggles the -;; gnus-uu-view-and-save variable. See below for explanation. -;; -;; `C-c C-v C-k' (gnus-uu-toggle-kill-carriage-return) toggles the -;; gnus-uu-kill-carriage-return variable. See below for explanation. -;; -;; `C-c C-v C-i' (gnus-uu-toggle-interactive-view) toggles interactive -;; mode. If it is turned on, gnus-uu won't view files immediately but -;; give you a buffer with the default commands and files and lets you -;; edit the commands and execute them at leisure. -;; -;; `C-c C-v C-t' (gnus-uu-toggle-any-variable) is an interface to the -;; five toggle commands listed above. -;; -;; gnus-uu-toggle-correct-stripped-articles toggles whether to check -;; and correct uuencoded articles that may have had trailing spaces -;; stripped by mailers. -;; -;; -;; Customization -;; -;; To load this file when starting gnus, put sumething like the -;; following in your .emacs file: -;; -;; (setq gnus-group-mode-hook -;; '(lambda () (load "gnus-uu"))) -;; -;; To make gnus-uu use, for instance, "xli" to view JPEGs and GIFs, -;; put this in your .emacs file: -;; -;; (setq gnus-uu-user-view-rules -;; (list -;; '("jpg$\\|gif$" "xli") -;; )) -;; -;; This variable is a list where each list item is a list containing -;; two strings. The first string is a regular expression. If the file -;; name is matched by this expression, the command given in the -;; second string is executed on this file. If the command contains -;; "%s", the file will be inserted there in the command string. Eg. -;; "giftoppm %s | xv -" will result in the file name being inserted at -;; the "%s". -;; -;; If you don't want to display certain file types, like if you -;; haven't got sound capabilities, you could put something like -;; -;; (setq gnus-uu-user-view-rules -;; (list -;; '("au$\\|voc$\\|wav$" nil) -;; )) -;; -;; in your .emacs file. -;; -;; There's a similar variable called 'gnus-uu-user-archive-rules' -;; which gives a list of unarcers to use when looking inside archives -;; for files to display. -;; -;; If you don't want gnus-uu to look inside archives for files to -;; display, say -;; -;; (setq gnus-uu-do-not-unpack-archives t) -;; -;; -;; If you want gnus-uu to ask you if you want to save a file after -;; viewing, say -;; -;; (setq gnus-uu-view-and-save t) -;; -;; -;; If you don't want to wait for the viewing command to finish before -;; returning to emacs, say -;; -;; (setq gnus-uu-asynchronous t) -;; -;; -;; This can be useful if you're viewing long .mod files, for instance, -;; which often takes several minutes. Note, however, that since -;; gnus-uu doesn't ask, and if you are viewing an archive with lots of -;; viewable files, you'll get them all up more or less at once, which -;; can be confusing, to say the least. To get gnus-uu to ask you -;; before viewing a file, say -;; -;; (setq gnus-uu-ask-before-view t) -;; -;; You can set this variable even if you're not using asynchronous -;; viewing, of course. -;; -;; If the articles has been posted by some numbscull with a PC (isn't -;; that a bit redundant, though?) and there's lots of carriage returns -;; everywhere, say -;; -;; (setq gnus-uu-kill-carriage-return t) -;; -;; If you want gnus-uu to ignore the default file rules when viewing, -;; for instance if there's several file types that you can't view, set -;; `gnus-uu-ignore-default-view-rules' to `t'. There's a similar -;; variable to disable the default unarchive rule list, -;; `gnus-uu-ignore-default-archive-rules'. -;; -;; If you want a more interactive approach to file viewing, say -;; -;; (setq gnus-uu-use-interactive-view t) -;; -;; If this variable is set, whenever you type `C-c C-v C-v' (or any of -;; the other view commands), gnus-uu will present you with a buffer -;; with the default actions and file names after decoding. You can -;; edit the command lines and execute them in a convenient fashion. -;; The output from the commands will be displayed in a small window at -;; the bottom of the emacs window. End interactive mode by typing `C-c -;; C-c' in the view window. -;; -;; If you want gnus-uu to unmark articles that you have asked to -;; decode, but can't be decoded (if, for instance, the articles aren't -;; uuencoded files or the posting is incomplete), say -;; -;; (setq gnus-uu-unmark-articles-not-decoded t) -;; -;; -;; History -;; -;; v1.0: First version released Oct 2 1992. -;; -;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'. -;; Changed (setq gnus-exit-group-hook) to (add-hook). Removed -;; checking for "Re:" for finding parts. -;; -;; v2.2: Fixed handling of currupted archives. Changed uudecoding to -;; an asynchronous process to avoid loading tons of data into emacs -;; buffers. No longer reads articles emacs already have aboard. Fixed -;; a firmer support for shar files. Made regexp searches for files -;; more convenient. Added `C-c C-l' for editing uucode begin -;; lines. Added multi-system decoder entry point. Added interactive -;; view mode. Added function for decoding and saving all uuencoded -;; articles in the current newsgroup. -;; -;; v2.3: After suggestions I have changed all the gnus-uu key bindings -;; to avoid hogging all the user keys (C-c LETTER). Also added -;; (provide) and fixed some saving stuff. First posted version to -;; gnu.emacs.sources. -;; -;; v2.4: Fixed some more in the save-all category. Automatic fixing of -;; uucode "begin" lines: names on the form of "dir/file" are -;; translated into "dir-file". Added a function for fixing stripped -;; uucode articles. Added binhex save. -;; -;; -;; Keymap overview: -;; -;; All commands start with `C-c C-v'. The difference is in the third -;; keystroke. All view commands are `C-LETTER'. All save commands are -;; just `LETTER'. All marked commands are the same as the unmarked -;; commands, except that they have `M-' before in the last keystroke. -;; -;; `C-c C-v C-v' gnus-uu-decode-and-view -;; `C-c C-v v' gnus-uu-decode-and-save -;; `C-c C-v C-s' gnus-uu-shar-and-view -;; `C-c C-v s' gnus-uu-shar-and-save -;; `C-c C-v C-m' gnus-uu-multi-decode-and-view -;; `C-c C-v m' gnus-uu-multi-decode-and-save -;; -;; `C-c C-v C-b' gnus-uu-decode-and-show-in-buffer -;; `C-c C-v C-l' gnus-uu-edit-begin-line -;; `C-c C-v M-a' gnus-uu-decode-and-save-all-unread-articles -;; `C-c C-v a' gnus-uu-decode-and-save-all-articles -;; `C-c C-v M-w' gnus-uu-decode-and-save-all-unread-articles-and-mark -;; `C-c C-v w' gnus-uu-decode-and-save-all-articles-and-mark -;; -;; `#' gnus-uu-mark-article -;; `M-#' gnus-uu-unmark-article -;; `C-c C-v C-u' gnus-uu-unmark-all-articles -;; `C-c C-v C-r' gnus-uu-mark-by-regexp -;; `C-c C-v M-C-v' gnus-uu-marked-decode-and-view -;; `C-c C-v M-v' gnus-uu-marked-decode-and-save -;; `C-c C-v M-C-s' gnus-uu-marked-shar-and-view -;; `C-c C-v M-s' gnus-uu-marked-shar-and-save -;; `C-c C-v M-C-m' gnus-uu-marked-multi-decode-and-view -;; `C-c C-v M-m' gnus-uu-marked-multi-decode-and-save -;; -;; `C-c C-v C-a' gnus-uu-toggle-asynchronous -;; `C-c C-v C-q' gnus-uu-toggle-query -;; `C-c C-v C-p' gnus-uu-toggle-always-ask -;; `C-c C-v C-k' gnus-uu-toggle-kill-carriage-return -;; `C-c C-v C-i' gnus-uu-toggle-interactive-view -;; `C-c C-v C-t' gnus-uu-toggle-any-variable - -(require 'gnus) +;;; gnus-uu.el --- extract (uu)encoded files in Gnus +;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc. -;; Binding of keys to the gnus-uu functions. - -(defvar gnus-uu-ctl-map nil) -(define-prefix-command 'gnus-uu-ctl-map) -(define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map) - -(define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view) -(define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save) -(define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view) -(define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save) -(define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view) -(define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save) +;; Author: Lars Magne Ingebrigtsen +;; Created: 2 Oct 1993 +;; Version: v3.0 +;; Keyword: news -(define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer) +;; This file is part of GNU Emacs. -(define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article) -(define-key gnus-summary-mode-map "\M-#" 'gnus-uu-unmark-article) -(define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-unmark-all-articles) -(define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp) +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. -(define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view) -(define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save) -(define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view) -(define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save) -(define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view) -(define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save) +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. -(define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-toggle-asynchronous) -(define-key gnus-uu-ctl-map "\C-q" 'gnus-uu-toggle-query) -(define-key gnus-uu-ctl-map "\C-p" 'gnus-uu-toggle-always-ask) -(define-key gnus-uu-ctl-map "\C-k" 'gnus-uu-toggle-kill-carriage-return) -(define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view) -(define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable) +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -(define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line) +;;; Commentary: -(define-key gnus-uu-ctl-map "\M-a" 'gnus-uu-decode-and-save-all-unread-articles) -(define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-articles) -(define-key gnus-uu-ctl-map "\M-w" 'gnus-uu-decode-and-save-all-unread-articles-and-mark) -(define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles-and-mark) +;;; Code: -;(load "rnewspost") -;(define-key news-reply-mode-map "\C-c\C-v" 'gnus-uu-uuencode-and-post) +(require 'gnus) +(require 'gnus-msg) ;; Default viewing action rules -(defconst gnus-uu-default-view-rules - (list - '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - '("\\.tga$" "tgatoppm %s | xv -") - '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less") - '("\\.fli$" "xflick") - '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" +(defvar gnus-uu-default-view-rules + '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") + ("\\.pas$" "cat %s | sed s/\r//g") + ("\\.[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 -") + ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") - '("\\.au$" "cat %s > /dev/audio") - '("\\.mod$" "str32") - '("\\.ps$" "ghostview") - '("\\.dvi$" "xdvi") - '("\\.1$" "xterm -e man -l") - '("\\.html$" "xmosaic") - '("\\.mpe?g$" "mpeg_play") - '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\)$" + ("\\.au$" "cat %s > /dev/audio") + ("\\.mod$" "str32") + ("\\.ps$" "ghostview") + ("\\.dvi$" "xdvi") + ("\\.html$" "xmosaic") + ("\\.mpe?g$" "mpeg_play") + ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") + ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) - - - "This constant is a list that gives the default actions to be taken -when the user asks to view a file. To change the behaviour, you can -either edit this constant or set 'gnus-uu-user-view-rules' to -something useful. To add a default \"end\" rule, edit the -'gnus-uu-user-view-rules-end' variable. + "*Default actions to be taken when the user asks to view a file. +To change the behaviour, you can either edit this variable or set +`gnus-uu-user-view-rules' to something useful. For example: To make gnus-uu use 'xli' to display JPEG and GIF files, put the -following in your .emacs file +following in your .emacs file: - (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\"))) + (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) -Both these variables are lists of lists of strings, where the first -string is a regular expression. If the file name matches this regular -expression, the command in the second string is fed the file. +Both these variables are lists of lists with two string elements. The +first string is a regular expression. If the file name matches this +regular expression, the command in the second string is executed with +the file as an argument. If the command string contains \"%s\", the file name will be inserted at that point in the command string. If there's no \"%s\" in the -command string, the file name will be appended to the command before -executing. ") +command string, the file name will be appended to the command string +before executing. + +There are several user variables to tailor the behaviour of gnus-uu to +your needs. First we have `gnus-uu-user-view-rules', which is the +variable gnus-uu first consults when trying to decide how to view a +file. If this variable contains no matches, gnus-uu examines the +default rule variable provided in this package. If gnus-uu finds no +match here, it uses `gnus-uu-user-view-rules-end' to try to make a +match.") (defvar gnus-uu-user-view-rules nil - "User variable. See explanation of the 'gnus-uu-default-view-rules' for + "*Variable detailing what actions are to be taken to view a file. +See the documentation on the `gnus-uu-default-view-rules' variable for details.") -(defvar gnus-uu-user-view-rules-end nil - "The user may use this variable to provide default viewing rules.") - -(defvar gnus-uu-user-interactive-view-rules nil - "If this variable is set and interactive mode is to be used, this -variable will be used instead of gnus-uu-user-view-rules.") - -(defvar gnus-uu-user-interactive-view-rules-end nil - "If this variable is set and interactive mode is to be used, this -variable will be used instead of gnus-uu-user-view-rules-end.") - -(defconst gnus-uu-default-interactive-view-rules-begin - (list - '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/ //g") - '("\\.pas$" "cat %s | sed s/ //g") - )) - +(defvar gnus-uu-user-view-rules-end + '(("" "file")) + "*Variable saying what actions are to be taken if no rule matched the file name. +See the documentation on the `gnus-uu-default-view-rules' variable for +details.") ;; Default unpacking commands -(defconst gnus-uu-default-archive-rules - (list '("\\.tar$" "tar xf") - '("\\.zip$" "unzip") - '("\\.ar$" "ar x") - '("\\.arj$" "unarj x") - '("\\.zoo$" "zoo -e") - '("\\.lzh$" "lha x") - '("\\.Z$" "uncompress") - '("\\.gz$" "gunzip") - '("\\.arc$" "arc -x")) - "*") -(defvar gnus-uu-user-archive-rules nil) - +(defvar gnus-uu-default-archive-rules + '(("\\.tar$" "tar xf") + ("\\.zip$" "unzip -o") + ("\\.ar$" "ar x") + ("\\.arj$" "unarj x") + ("\\.zoo$" "zoo -e") + ("\\.\\(lzh\\|lha\\)$" "lha x") + ("\\.Z$" "uncompress") + ("\\.gz$" "gunzip") + ("\\.arc$" "arc -x"))) + +(defvar gnus-uu-destructive-archivers + (list "uncompress" "gunzip")) + +(defvar gnus-uu-user-archive-rules nil + "*A list that can be set to override the default archive unpacking commands. +To use, for instance, 'untar' to unpack tar files and 'zip -x' to +unpack zip files, say the following: + (setq gnus-uu-user-archive-rules + '((\"\\\\.tar$\" \"untar\") + (\"\\\\.zip$\" \"zip -x\")))") + +(defvar gnus-uu-ignore-files-by-name nil + "*A regular expression saying what files should not be viewed based on name. +If, for instance, you want gnus-uu to ignore all .au and .wav files, +you could say something like + + (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") + +Note that this variable can be used in conjunction with the +`gnus-uu-ignore-files-by-type' variable.") + +(defvar gnus-uu-ignore-files-by-type nil + "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. +If, for instance, you want gnus-uu to ignore all audio files and all mpegs, +you could say something like + + (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") + +Note that this variable can be used in conjunction with the +`gnus-uu-ignore-files-by-name' variable.") + +;; Pseudo-MIME support + +(defconst gnus-uu-ext-to-mime-list + '(("\\.gif$" "image/gif") + ("\\.jpe?g$" "image/jpeg") + ("\\.tiff?$" "image/tiff") + ("\\.xwd$" "image/xwd") + ("\\.pbm$" "image/pbm") + ("\\.pgm$" "image/pgm") + ("\\.ppm$" "image/ppm") + ("\\.xbm$" "image/xbm") + ("\\.pcx$" "image/pcx") + ("\\.tga$" "image/tga") + ("\\.ps$" "image/postscript") + ("\\.fli$" "video/fli") + ("\\.wav$" "audio/wav") + ("\\.aiff$" "audio/aiff") + ("\\.hcom$" "audio/hcom") + ("\\.voc$" "audio/voc") + ("\\.smp$" "audio/smp") + ("\\.mod$" "audio/mod") + ("\\.dvi$" "image/dvi") + ("\\.mpe?g$" "video/mpeg") + ("\\.au$" "audio/basic") + ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") + ("\\.\\(c\\|h\\)$" "text/source") + ("read.*me" "text/plain") + ("\\.html$" "text/html") + ("\\.bat$" "text/bat") + ("\\.[1-6]$" "text/man") + ("\\.flc$" "video/flc") + ("\\.rle$" "video/rle") + ("\\.pfx$" "video/pfx") + ("\\.avi$" "video/avi") + ("\\.sme$" "video/sme") + ("\\.rpza$" "video/prza") + ("\\.dl$" "video/dl") + ("\\.qt$" "video/qt") + ("\\.rsrc$" "video/rsrc") + ("\\..*$" "unknown/unknown"))) ;; Various variables users may set (defvar gnus-uu-tmp-dir "/tmp/" - "Variable saying where gnus-uu is to do its work. Default is \"/tmp/\".") + "*Variable saying where gnus-uu is to do its work. +Default is \"/tmp/\".") (defvar gnus-uu-do-not-unpack-archives nil - "Set this variable if you don't want gnus-uu to look inside -archives for files to display. Default is `nil'.") - -(defvar gnus-uu-do-not-unpack-archives nil - "Set this variable if you don't want gnus-uu to look inside -archives for files to display. Default is `nil'.") + "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. +Default is nil.") (defvar gnus-uu-view-and-save nil - "Set this variable if you want to be asked if you want to save the -file after viewing. If this variable is nil, which is the default, -gnus-uu won't offer to save a file if viewing is successful. Default -is `nil'.") - -(defvar gnus-uu-asynchronous nil - "Set this variable to `t' if you don't want gnus-uu to wait until -the viewing command has ended before returning control to emacs. -Default is `nil'.") - -(defvar gnus-uu-ask-before-view nil - "Set this variable to `t' if you want gnus-uu to ask you before -viewing every file. Useful when `gnus-uu-asynchronous' is set. Default -is `nil'.") + "*Non-nil means that the user will always be asked to save a file after viewing it. +If the variable is nil, the user will only be asked to save if the +viewing is unsuccessful. Default is nil.") (defvar gnus-uu-ignore-default-view-rules nil - "Set this variable if you want gnus-uu to ignore the default viewing -rules and just use the rules given in gnus-uu-user-view-rules. Default -is `nil'.") + "*Non-nil means that gnus-uu will ignore the default viewing rules. +Only the user viewing rules will be consulted. Default is nil.") -(defvar gnus-uu-ignore-default-archive-rules nil - "Set this variable if you want gnus-uu to ignore the default archive -unpacking commands and just use the rules given in -gnus-uu-user-archive-rules. Default is `nil'.") +(defvar gnus-uu-ignore-default-archive-rules nil + "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. +Only the user unpacking commands will be consulted. Default is nil.") (defvar gnus-uu-kill-carriage-return t - "Set this variable if you want to remove all carriage returns from -the mail articles. Default is `t'.") + "*Non-nil means that gnus-uu will strip all carriage returns from articles. +Default is t.") -(defvar gnus-uu-unmark-articles-not-decoded nil - "If this variable is set, artciles that are unsuccessfully decoded -are marked as unread. Default is `nil'.") +(defvar gnus-uu-view-with-metamail nil + "*Non-nil means that files will be viewed with metamail. +The gnus-uu viewing functions will be ignored and gnus-uu will try +to guess at a content-type based on file name suffixes. Default +it nil.") -(defvar gnus-uu-output-window-height 20 - "This variable says how hight the output buffer window is to be when -using interactive view mode. Change it at your convenience. Default is 20.") +(defvar gnus-uu-unmark-articles-not-decoded nil + "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. +Default is nil.") (defvar gnus-uu-correct-stripped-uucode nil - "If this variable is set, gnus-uu will try to correct uuencoded files that -have had trailing spaces stripped by nosy mail saoftware. Default is `nil'.") + "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. +Default is nil.") -(defvar gnus-uu-use-interactive-view nil - "If this variable is set, gnus-uu will create a special buffer where -the user may choose interactively which files to view and how. Default -is `nil'.") +(defvar gnus-uu-save-in-digest nil + "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. +If this variable is nil, gnus-uu will just save everything in a +file without any embellishments. The digesting almost conforms to RFC1153 - +no easy way to specify any meaningful volume and issue numbers were found, +so I simply dropped them.") +(defvar gnus-uu-digest-headers + '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" + "^Summary:" "^References:") + "*List of regexps to match headers included in digested messages. +The headers will be included in the sequence they are matched.") -;; Internal variables +(defvar gnus-uu-save-separate-articles nil + "*Non-nil means that gnus-uu will save articles in separate files.") -(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$" - "*") -(defconst gnus-uu-end-string "^end[ \t]*$") -(defconst gnus-uu-body-line -"^M.............................................................?$" "*") -(defconst gnus-uu-shar-begin-string "^#! */bin/sh" "*") +;; Internal variables -(defvar gnus-uu-shar-file-name nil "*") -(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)" "*") -(defvar gnus-uu-shar-directory nil) +(defvar gnus-uu-saved-article-name nil) -(defvar gnus-uu-file-name nil) -(defconst gnus-uu-uudecode-process nil) +(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst gnus-uu-end-string "^end[ \t]*$") -(defvar gnus-uu-interactive-file-list nil) -(defvar gnus-uu-marked-article-list nil) -(defvar gnus-uu-generated-file-list nil) +(defconst gnus-uu-body-line "^M") +(let ((i 61)) + (while (> (setq i (1- i)) 0) + (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) + (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) -(defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*") -(defconst gnus-uu-output-buffer-name "*Gnus UU Output*") -(defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*") +;"^M.............................................................?$" +(defconst gnus-uu-shar-begin-string "^#! */bin/sh") -;; Interactive functions +(defvar gnus-uu-shar-file-name nil) +(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") -;; UUdecode and view +(defconst gnus-uu-postscript-begin-string "^%!PS-") +(defconst gnus-uu-postscript-end-string "^%%EOF$") -(defun gnus-uu-decode-and-view () - "UUdecodes and 'views' (if possible) the resulting file. -'Viewing' can be any action at all, as defined in the -'gnus-uu-file-action-list' variable. Running 'xv' on gifs and -'play' on au files are popular actions. If the file can't be viewed, -the user is asked if she would like to save the file instead." - (interactive) - (gnus-uu-decode-and-view-or-save t nil)) +(defvar gnus-uu-file-name nil) +(defconst gnus-uu-uudecode-process nil) +(defvar gnus-uu-binhex-article-name nil) -(defun gnus-uu-decode-and-save () - "uudecodes and saves the resulting file." - (interactive) - (gnus-uu-decode-and-view-or-save nil nil)) +(defvar gnus-uu-generated-file-list nil) +(defvar gnus-uu-work-dir nil) + +(defconst gnus-uu-output-buffer-name " *Gnus UU Output*") + +(defvar gnus-uu-default-dir default-directory) + +;; Keymaps + +(defvar gnus-uu-extract-map nil) +(defvar gnus-uu-extract-view-map nil) +(defvar gnus-uu-mark-map nil) + +(define-prefix-command 'gnus-uu-mark-map) +(define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) +(define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable) +(define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable) +(define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable) +(define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series) +(define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region) +(define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp) +(define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread) +(define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all) +(define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse) + +(define-prefix-command 'gnus-uu-extract-map) +(define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) +;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any) +;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime) +(define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu) +(define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save) +(define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar) +(define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save) +(define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save) +(define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save) +(define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex) +(define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex) +(define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript) +(define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save) + +(define-prefix-command 'gnus-uu-extract-view-map) +(define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map) +(define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view) +(define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) +(define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view) +(define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) +(define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view) +(define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view) +(define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view) +(define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view) +(define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view) +(define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) + + + +;; Commands. + +(defun gnus-uu-decode-uu (n) + "Uudecodes the current article." + (interactive "P") + (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) + +(defun gnus-uu-decode-uu-and-save (n dir) + "Decodes and saves the resulting file." + (interactive + (list current-prefix-arg + (file-name-as-directory + (read-file-name "Uudecode and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t)))) + (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir)) + +(defun gnus-uu-decode-unshar (n) + "Unshars the current article." + (interactive "P") + (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan)) + +(defun gnus-uu-decode-unshar-and-save (n dir) + "Unshars and saves the current article." + (interactive + (list current-prefix-arg + (file-name-as-directory + (read-file-name "Unshar and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t)))) + (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan)) + +(defun gnus-uu-decode-save (n file) + "Saves the current article." + (interactive + (list current-prefix-arg + (read-file-name + (if gnus-uu-save-separate-articles + "Save articles is dir: " + "Save articles in file: ") + gnus-uu-default-dir + gnus-uu-default-dir))) + (setq gnus-uu-saved-article-name file) + (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t) + (setq gnus-uu-generated-file-list + (delete file gnus-uu-generated-file-list))) + +(defun gnus-uu-decode-binhex (n dir) + "Unbinhexes the current article." + (interactive + (list current-prefix-arg + (file-name-as-directory + (read-file-name "Unbinhex and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir)))) + (setq gnus-uu-binhex-article-name + (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) + +(defun gnus-uu-decode-uu-view (n) + "Uudecodes and views the current article." + (interactive "P") + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-uu n))) + +(defun gnus-uu-decode-uu-and-save-view (n dir) + "Decodes, views and saves the resulting file." + (interactive + (list current-prefix-arg + (read-file-name "Uudecode, view and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t))) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-uu-and-save n dir))) + +(defun gnus-uu-decode-unshar-view (n) + "Unshars and views the current article." + (interactive "P") + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-unshar n))) + +(defun gnus-uu-decode-unshar-and-save-view (n dir) + "Unshars and saves the current article." + (interactive + (list current-prefix-arg + (read-file-name "Unshar, view and save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t))) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-unshar-and-save n dir))) + +(defun gnus-uu-decode-save-view (n file) + "Saves and views the current article." + (interactive + (list current-prefix-arg + (read-file-name (if gnus-uu-save-separate-articles + "Save articles is dir: " + "Save articles in file: ") + gnus-uu-default-dir gnus-uu-default-dir))) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-save n file))) + +(defun gnus-uu-decode-binhex-view (n file) + "Unbinhexes and views the current article." + (interactive + (list current-prefix-arg + (read-file-name "Unbinhex, view and save in dir: " + gnus-uu-default-dir gnus-uu-default-dir))) + (setq gnus-uu-binhex-article-name + (make-temp-name (concat gnus-uu-work-dir "binhex"))) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-binhex n file))) + + +;; Digest and forward articles + +(defun gnus-uu-digest-mail-forward (n &optional post) + "Digests and forwards all articles in this series." + (interactive "P") + (let ((gnus-uu-save-in-digest t) + (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) + buf) + (gnus-uu-decode-save n file) + (gnus-uu-add-file file) + (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) + (gnus-add-current-to-buffer-list) + (erase-buffer) + (delete-other-windows) + (insert-file file) + (goto-char (point-min)) + (and (re-search-forward "^Subject: ") + (progn + (delete-region (point) (gnus-point-at-eol)) + (insert "Digested Articles"))) + (goto-char (point-min)) + (and (re-search-forward "^From: ") + (progn + (delete-region (point) (gnus-point-at-eol)) + (insert "Various"))) + (if post + (gnus-forward-using-post) + (funcall gnus-mail-forward-method)) + (delete-file file) + (kill-buffer buf))) + +(defun gnus-uu-digest-post-forward (n) + "Digest and forward to a newsgroup." + (interactive "P") + (gnus-uu-digest-mail-forward n t)) + +;; Process marking. + +(defun gnus-uu-mark-by-regexp (regexp) + "Ask for a regular expression and set the process mark on all articles that match." + (interactive (list (read-from-minibuffer "Mark (regexp): "))) + (gnus-set-global-variables) + (let ((articles (gnus-uu-find-articles-matching regexp))) + (while articles + (gnus-summary-set-process-mark (car articles)) + (setq articles (cdr articles))) + (message "")) + (gnus-summary-position-cursor)) -(defun gnus-uu-marked-decode-and-view () - "The marked equivalent to gnus-uu-decode-and-view." +(defun gnus-uu-mark-series () + "Mark the current series with the process mark." (interactive) - (gnus-uu-decode-and-view-or-save t t)) + (gnus-set-global-variables) + (let ((articles (gnus-uu-find-articles-matching))) + (while articles + (gnus-summary-set-process-mark (car articles)) + (setq articles (cdr articles))) + (message "")) + (gnus-summary-position-cursor)) -(defun gnus-uu-marked-decode-and-save () - "The marked equivalent to gnus-uu-decode-and-save." - (interactive) - (gnus-uu-decode-and-view-or-save nil t)) +(defun gnus-uu-mark-region (beg end) + "Marks all articles between point and mark." + (interactive "r") + (gnus-set-global-variables) + (save-excursion + (goto-char beg) + (while (< (point) end) + (gnus-summary-set-process-mark (gnus-summary-article-number)) + (forward-line 1))) + (gnus-summary-position-cursor)) - -;; Unshar and view - -(defun gnus-uu-shar-and-view () - "Does the same as gnus-uu-decode-and-view for shar files." +(defun gnus-uu-mark-thread () + "Marks all articles downwards in this thread." (interactive) - (gnus-uu-unshar-and-view-or-save t nil)) - -(defun gnus-uu-shar-and-save () - "Does the same as gnus-uu-decode-and-save for shar files." + (gnus-set-global-variables) + (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-summary-position-cursor)) + +(defun gnus-uu-mark-sparse () + "Mark all series that have some articles marked." (interactive) - (gnus-uu-unshar-and-view-or-save nil nil)) - -(defun gnus-uu-marked-shar-and-view () - "The marked equivalent to gnus-uu-shar-and-view." - (interactive) - (gnus-uu-unshar-and-view-or-save t t)) - -(defun gnus-uu-marked-shar-and-save () - "The marked equivalent to gnus-uu-shar-and-save." + (gnus-set-global-variables) + (let ((marked (nreverse gnus-newsgroup-processable)) + subject articles total headers) + (or marked (error "No articles marked with the process mark")) + (setq gnus-newsgroup-processable nil) + (save-excursion + (while marked + (and (setq headers (gnus-get-header-by-number (car marked))) + (setq subject (mail-header-subject headers) + articles (gnus-uu-find-articles-matching + (gnus-uu-reginize-string subject)) + total (nconc total articles))) + (while articles + (gnus-summary-set-process-mark (car articles)) + (setcdr marked (delq (car articles) (cdr marked))) + (setq articles (cdr articles))) + (setq marked (cdr marked))) + (setq gnus-newsgroup-processable (nreverse total))) + (gnus-summary-position-cursor))) + +(defun gnus-uu-mark-all () + "Mark all articles in \"series\" order." (interactive) - (gnus-uu-unshar-and-view-or-save nil t)) - - -;; Decode and show in buffer + (gnus-set-global-variables) + (setq gnus-newsgroup-processable nil) + (save-excursion + (goto-char (point-min)) + (let (number) + (while (and (not (eobp)) + (setq number (gnus-summary-article-number))) + (if (not (memq number gnus-newsgroup-processable)) + (save-excursion (gnus-uu-mark-series))) + (forward-line 1)))) + (gnus-summary-position-cursor)) + +;; All PostScript functions written by Erik Selberg . + +(defun gnus-uu-decode-postscript (n) + "Gets postscript of the current article." + (interactive "P") + (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) + +(defun gnus-uu-decode-postscript-view (n) + "Gets and views the current article." + (interactive "P") + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-postscript n))) + +(defun gnus-uu-decode-postscript-and-save (n dir) + "Extracts postscript and saves the current article." + (interactive + (list current-prefix-arg + (file-name-as-directory + (read-file-name "Save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t)))) + (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir)) + + +(defun gnus-uu-decode-postscript-and-save-view (n dir) + "Decodes, views and saves the resulting file." + (interactive + (list current-prefix-arg + (read-file-name "Where do you want to save the file(s)? " + gnus-uu-default-dir + gnus-uu-default-dir t))) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) + (gnus-uu-decode-postscript-and-save n dir))) + + +;; Internal functions. + +(defun gnus-uu-decode-with-method (method n &optional save not-insert scan) + (gnus-uu-initialize scan) + (if save (setq gnus-uu-default-dir save)) + (let ((articles (gnus-uu-get-list-of-articles n)) + files) + (setq files (gnus-uu-grab-articles articles method t)) + (let ((gnus-current-article (car articles))) + (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) + (and save (gnus-uu-save-files files save)) + (setq files (gnus-uu-unpack-files files)) + (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files)) + (setq files (nreverse (gnus-uu-get-actions files))) + (or not-insert (gnus-summary-insert-pseudos files save)))) + +;; Return a list of files in dir. +(defun gnus-uu-scan-directory (dir) + (let ((files (directory-files dir t)) + dirs out) + (while files + (cond ((string-match "/\\.\\.?$" (car files))) + ((file-directory-p (car files)) + (setq dirs (cons (car files) dirs))) + (t (setq out (cons (list (cons 'name (car files)) + (cons 'article gnus-current-article)) + out)))) + (setq files (cdr files))) + (apply 'nconc out (mapcar (lambda (d) (gnus-uu-scan-directory d)) + dirs)))) -(defun gnus-uu-decode-and-show-in-buffer () - "uudecodes the current article and displays the result in a buffer." - (interactive) - (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name)) - list-of-articles file-name) - (save-excursion +(defun gnus-uu-save-files (files dir) + (let ((len (length files)) + to-file file) + (while files (and - (setq list-of-articles (list gnus-current-article)) - (gnus-uu-grab-articles list-of-articles 'gnus-uu-uustrip-article-as) - (setq file-name (gnus-uu-decode gnus-uu-tmp-dir)) + (setq file (cdr (assq 'name (car files)))) + (file-exists-p file) (progn - (save-excursion - (set-buffer uu-buffer) - (erase-buffer) - (insert-file-contents file-name)) - (set-window-buffer (get-buffer-window gnus-article-buffer) - uu-buffer) - (message (format "Showing file %s in buffer" file-name)) - (delete-file file-name)))))) - - -;; Toggle commands - -(defun gnus-uu-toggle-asynchronous () - "This function toggles asynchronous viewing." - (interactive) - (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous)) - (message "gnus-uu will now view files asynchronously") - (message "gnus-uu will now view files synchronously"))) - -(defun gnus-uu-toggle-query () - "This function toggles whether to ask before viewing or not." - (interactive) - (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view)) - (message "gnus-uu will now ask before viewing") - (message "gnus-uu will now view without asking first"))) - -(defun gnus-uu-toggle-always-ask () - "This function toggles whether to ask saving a file even after successful -viewing." - (interactive) - (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save)) - (message "gnus-uu will now ask to save the file after viewing") - (message "gnus-uu will now not ask to save after successful viewing"))) - -(defun gnus-uu-toggle-interactive-view () - "This function toggles whether to use interactive view." - (interactive) - (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view)) - (message "gnus-uu will now use interactive view") - (message "gnus-uu will now use non-interactive view"))) - -(defun gnus-uu-toggle-unmark-undecoded () - "This function toggles whether to unmark articles not decoded." - (interactive) - (if (setq gnus-uu-unmark-articles-not-decoded - (not gnus-uu-unmark-articles-not-decoded)) - (message "gnus-uu will now unmark articles not decoded") - (message "gnus-uu will now not unmark articles not decoded"))) - -(defun gnus-uu-toggle-kill-carriage-return () - "This function toggles the stripping of carriage returns from the articles." - (interactive) - (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return)) - (message "gnus-uu will now strip carriage returns") - (message "gnus-uu won't strip carriage returns"))) + (setq to-file (if (file-directory-p dir) + (concat dir (file-name-nondirectory file)) + dir)) + (and (or (not (file-exists-p to-file)) + (gnus-y-or-n-p (format "%s exists; overwrite? " + to-file))) + (copy-file file to-file t t)))) + (setq files (cdr files))) + (message "Saved %d file%s" len (if (> len 1) "s" "")))) -(defun gnus-uu-toggle-correct-stripped-uucode () - "This function toggles whether to correct stripped uucode." - (interactive) - (if (setq gnus-uu-correct-stripped-uucode - (not gnus-uu-correct-stripped-uucode)) - (message "gnus-uu will now correct stripped uucode") - (message "gnus-uu won't check and correct stripped uucode"))) +;; Functions for saving and possibly digesting articles without +;; any decoding. -(defun gnus-uu-toggle-any-variable () - "This function ask what variable the user wants to toggle." - (interactive) - (let (rep) - (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteractive, (u)nmark, (c)orrect") - (setq rep (read-char)) - (if (= rep ?a) - (gnus-uu-toggle-asynchronous)) - (if (= rep ?q) - (gnus-uu-toggle-query)) - (if (= rep ?p) - (gnus-uu-toggle-always-ask)) - (if (= rep ?k) - (gnus-uu-toggle-kill-carriage-return)) - (if (= rep ?u) - (gnus-uu-toggle-unmark-undecoded)) - (if (= rep ?c) - (gnus-uu-toggle-correct-stripped-uucode)) - (if (= rep ?i) - (gnus-uu-toggle-interactive-view)))) - - -;; Edit line - -(defun gnus-uu-edit-begin-line () - "Edit the begin line of the current article." - (interactive) - (let ((buffer-read-only nil) - begin b) +;; Function called by gnus-uu-grab-articles to treat each article. +(defun gnus-uu-save-article (buffer in-state) + (cond + (gnus-uu-save-separate-articles (save-excursion - (set-buffer gnus-article-buffer) - (goto-line 1) - (if (not (re-search-forward "begin " nil t)) - (progn (message "No begin line in the current article") (sit-for 2)) - (beginning-of-line) - (setq b (point)) - (end-of-line) - (setq begin (buffer-substring b (point))) - (setq begin (read-string "" begin)) - (setq buffer-read-only nil) - (delete-region b (point)) - (insert-string begin))))) - -;; Multi functions - -(defun gnus-uu-multi-decode-and-view () - "This function lets the user decide what method to use for decoding. -Other than that, it's equivalent to the other decode-and-view functions." - (interactive) - (gnus-uu-multi-decode-and-view-or-save t nil)) - -(defun gnus-uu-multi-decode-and-save () - "This function lets the user decide what method to use for decoding. -Other than that, it's equivalent to the other decode-and-save functions." - (interactive) - (gnus-uu-multi-decode-and-view-or-save nil nil)) - -(defun gnus-uu-marked-multi-decode-and-view () - "This function lets the user decide what method to use for decoding. -Other than that, it's equivalent to the other marked decode-and-view -functions." - (interactive) - (gnus-uu-multi-decode-and-view-or-save t t)) - -(defun gnus-uu-marked-multi-decode-and-save () - "This function lets the user decide what method to use for decoding. -Other than that, it's equivalent to the other marked decode-and-save -functions." - (interactive) - (gnus-uu-multi-decode-and-view-or-save t t)) - -(defun gnus-uu-multi-decode-and-view-or-save (view marked) - (let (decode-type) - (message "(u)udecode, (s)har, s(a)ve, (b)inhex: ") - (setq decode-type (read-char)) - (if (= decode-type ? ) (setq decode-type ?u)) - (if (= decode-type ?u) - (gnus-uu-decode-and-view-or-save view marked) - (if (= decode-type ?s) - (gnus-uu-unshar-and-view-or-save view marked) - (if (= decode-type ?b) - (gnus-uu-binhex-and-save view marked) - (if (= decode-type ?a) - (gnus-uu-save-articles view marked) - (message (format "Unknown decode method '%c'." decode-type)) - (sit-for 2))))))) - - -;; uuencode and post - -(defun gnus-uu-news-inews () - "Send a news message using inews." - (interactive) - (let* (newsgroups subject - (case-fold-search nil)) + (set-buffer buffer) + (write-region 1 (point-max) (concat gnus-uu-saved-article-name + gnus-current-article)) + (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name + 'begin 'end)) + ((eq in-state 'last) (list 'end)) + (t (list 'middle))))) + ((not gnus-uu-save-in-digest) (save-excursion - (save-restriction - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n")) - (narrow-to-region (point-min) (point)) - (setq newsgroups (mail-fetch-field "newsgroups") - subject (mail-fetch-field "subject"))) - (widen) - (goto-char (point-min)) -; (run-hooks 'news-inews-hook) - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n")) - (replace-match "\n\n") - (goto-char (point-max)) - ;; require a newline at the end for inews to append .signature to - (or (= (preceding-char) ?\n) - (insert ?\n)) - (message "Posting to USENET...") - (call-process-region (point-min) (point-max) - news-inews-program nil 0 nil - "-h") ; take all header lines! - ;@@ setting of subject and newsgroups still needed? - ;"-t" subject - ;"-n" newsgroups - (message "Posting to USENET... done") - (goto-char (point-min)) ;restore internal header separator - (search-forward "\n\n") - (replace-match (concat "\n" mail-header-separator "\n"))))) - -(autoload 'news-inews "rnewspost") - -(defun gnus-uu-post-buffer (&optional first) - (append-to-file 1 (point-max) "/tmp/gnusuutull") -; (if first -; (news-inews) -; (gnus-uu-news-inews)) - (message "posted")) - -(defconst gnus-uu-uuencode-post-length 20) - -(defun gnus-uu-uuencode-and-post () - (interactive) - (let (file uubuf sendbuf short-file length parts header i end beg - beg-line minlen) - (setq file (read-file-name - "What file do you want to uuencode and post? " "~/Unrd.jpg")) - (if (not (file-exists-p file)) - (message "%s: No such file" file) - (save-excursion - (setq uubuf (get-buffer-create "*uuencode buffer*")) - (setq sendbuf (get-buffer-create "*uuencode send buffer*")) - (set-buffer uubuf) - (erase-buffer) - (if (string-match "^~/" file) - (setq file (concat "$HOME" (substring file 1)))) - (if (string-match "/[^/]*$" file) - (setq short-file (substring file (1+ (match-beginning 0)))) - (setq short-file file)) - (call-process "sh" nil uubuf nil "-c" - (format "uuencode %s %s" file short-file)) - (goto-char 1) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - (setq length (count-lines 1 (point-max))) - (setq parts (/ length gnus-uu-uuencode-post-length)) - (if (not (< (% length gnus-uu-uuencode-post-length) 4)) - (setq parts (1+ parts))) - (message "Det er %d parts" parts)) - (goto-char 1) - (search-forward mail-header-separator nil t) - (beginning-of-line) - (forward-line 1) - (setq header (buffer-substring 1 (point))) - (goto-char 1) - (if (re-search-forward "^Subject: " nil t) - (progn - (end-of-line) - (insert (format " (0/%d)" parts)))) - (gnus-uu-post-buffer t) + (set-buffer buffer) + (write-region 1 (point-max) gnus-uu-saved-article-name t) + (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name + 'begin 'end)) + ((eq in-state 'last) (list 'end)) + (t (list 'middle))))) + (t + (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) + beg subj headers headline sorthead body end-string state) + (if (or (eq in-state 'first) + (eq in-state 'first-and-last)) + (progn + (setq state (list 'begin)) + (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) + (erase-buffer)) + (save-excursion + (set-buffer (get-buffer-create "*gnus-uu-pre*")) + (erase-buffer) + (insert (format + "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" + (current-time-string) name name)))) + (if (not (eq in-state 'end)) + (setq state (list 'middle)))) (save-excursion - (set-buffer sendbuf) - (setq i 1) - (setq beg 1) - (while (not (> i parts)) - (set-buffer sendbuf) - (erase-buffer) - (insert header) - (insert "\n") - (setq minlen (/ (- 62 (length (format " (%d/%d) " i parts))) 2)) - (setq beg-line (format "[ cut here %s (%d/%d) %s gnus-uu ]\n" - (make-string (- minlen 11) ?-) i parts - (make-string (- minlen 10) ?-))) - (insert beg-line) - (goto-char 1) - (if (re-search-forward "^Subject: " nil t) - (progn - (end-of-line) - (insert (format " (%d/%d)" i parts)))) - (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) - (goto-char beg) - (if (= i parts) - (goto-char (point-max)) - (forward-line gnus-uu-uuencode-post-length)) - (setq end (point))) - (insert-buffer-substring uubuf beg end) - (insert beg-line) - (setq beg end) - (setq i (1+ i)) - (gnus-uu-post-buffer))) - ))) - - - -;; Decode and all files - -(defconst gnus-uu-rest-of-articles nil) -(defconst gnus-uu-do-sloppy-uudecode nil) -(defvar gnus-uu-current-save-dir nil "*") - -(defun gnus-uu-decode-and-save-all-unread-articles () - "This function reads all unread articles in the current group and -sees whether it can uudecode the articles. The user will be prompted -for an directory to put the resulting (if any) files." - (interactive) - (gnus-uu-decode-and-save-articles t t)) - -(defun gnus-uu-decode-and-save-all-articles () - "Does the same as gnus-uu-decode-and-save-all-unread-articles, except -that it grabs all articles visible, unread or not." - (interactive) - (gnus-uu-decode-and-save-articles nil t)) - -(defun gnus-uu-decode-and-save-all-unread-articles-and-mark () - "Does the same as gnus-uu-decode-and-save-all-unread-articles, except that -it marks everything as read, even if it couldn't decode the articles." - (interactive) - (gnus-uu-decode-and-save-articles t nil)) - -(defun gnus-uu-decode-and-save-all-articles-and-mark () - "Does the same as gnus-uu-decode-and-save-all-articles, except that -it marks everything as read, even if it couldn't decode the articles." - (interactive) - (gnus-uu-decode-and-save-articles nil nil)) - -(defun gnus-uu-decode-and-save-articles (&optional unread unmark) - (let ((gnus-uu-unmark-articles-not-decoded unmark) - (filest "") - where dir did unmark saved-list) - (setq gnus-uu-do-sloppy-uudecode t) - (setq dir (gnus-uu-read-directory "Where do you want the files? ")) - (message "Grabbing...") - (setq gnus-uu-rest-of-articles - (gnus-uu-get-list-of-articles "^." nil unread)) - (setq gnus-uu-file-name nil) - (while (and gnus-uu-rest-of-articles - (gnus-uu-grab-articles gnus-uu-rest-of-articles - 'gnus-uu-uustrip-article-as)) - (if gnus-uu-file-name - (progn - (setq saved-list (cons gnus-uu-file-name saved-list)) - (rename-file (concat gnus-uu-tmp-dir gnus-uu-file-name) - (concat dir gnus-uu-file-name) t) - (setq did t) - (setq gnus-uu-file-name nil)))) - (if (not did) - () - (while saved-list - (setq filest (concat filest " " (car saved-list))) - (setq saved-list (cdr saved-list))) - (message "Saved%s" filest))) - (setq gnus-uu-do-sloppy-uudecode nil)) - - -;; Work functions - -(defun gnus-uu-decode-and-view-or-save (view marked) - (gnus-uu-initialize) - (let (file decoded) - (save-excursion - (if (gnus-uu-decode-and-strip nil marked) - (progn - (setq decoded t) - (setq file (concat gnus-uu-tmp-dir gnus-uu-file-name)) - (if view - (gnus-uu-view-file file) - (gnus-uu-save-file file))))) - - (gnus-uu-summary-next-subject) - - (if (and gnus-uu-use-interactive-view view decoded) - (gnus-uu-do-interactive)) - - (if (or (not gnus-uu-use-interactive-view) (not decoded)) - (gnus-uu-clean-up)))) - - -(defun gnus-uu-unshar-and-view-or-save (view marked) - "Unshars and views/saves marked/unmarked articles." - (gnus-uu-initialize) - (let (tar-file files decoded) - (save-excursion - (setq gnus-uu-shar-directory - (make-temp-name (concat gnus-uu-tmp-dir "gnusuush"))) - (make-directory gnus-uu-shar-directory) - (gnus-uu-add-file gnus-uu-shar-directory) - (if (gnus-uu-decode-and-strip t marked) - (progn - (setq decoded t) - (setq files (directory-files gnus-uu-shar-directory t)) - (setq gnus-uu-generated-file-list - (append files gnus-uu-generated-file-list)) - (if (> (length files) 3) - (progn - (setq tar-file - (concat - (make-temp-name (concat gnus-uu-tmp-dir "gnusuuar")) - ".tar")) - (gnus-uu-add-file tar-file) - (call-process "sh" nil - (get-buffer-create gnus-uu-output-buffer-name) - nil "-c" - (format "cd %s ; tar cf %s * ; cd .. ; rm -r %s" - gnus-uu-shar-directory - tar-file - gnus-uu-shar-directory)) - (if view - (gnus-uu-view-file tar-file) - (gnus-uu-save-file tar-file))) - (if view - (gnus-uu-view-file (elt files 2)) - (gnus-uu-save-file (elt files 2))))))) - - (gnus-uu-summary-next-subject) - - (if (and gnus-uu-use-interactive-view view decoded) - (gnus-uu-do-interactive)) - - (if (or (not gnus-uu-use-interactive-view) (not decoded)) - (gnus-uu-clean-up)))) - - -(defconst gnus-uu-saved-article-name nil) -(defun gnus-uu-save-articles (view marked) - (let (list-of-articles) - (save-excursion - (if (not marked) - (setq list-of-articles (gnus-uu-get-list-of-articles)) - (setq list-of-articles (reverse gnus-uu-marked-article-list)) - (setq gnus-uu-marked-article-list nil)) - (if (not list-of-articles) + (set-buffer (get-buffer "*gnus-uu-body*")) + (goto-char (setq beg (point-max))) + (save-excursion + (save-restriction + (set-buffer buffer) + (let (buffer-read-only) + (set-text-properties (point-min) (point-max) nil) + ;; These two are necessary for XEmacs 19.12 fascism. + (put-text-property (point-min) (point-max) 'invisible nil) + (put-text-property (point-min) (point-max) 'intangible nil)) + (goto-char (point-min)) + (re-search-forward "\n\n") + (setq body (buffer-substring (1- (point)) (point-max))) + (narrow-to-region 1 (point)) + (if (not (setq headers gnus-uu-digest-headers)) + (setq sorthead (buffer-substring (point-min) (point-max))) + (while headers + (setq headline (car headers)) + (setq headers (cdr headers)) + (goto-char (point-min)) + (if (re-search-forward headline nil t) + (setq sorthead + (concat sorthead + (buffer-substring + (match-beginning 0) + (or (and (re-search-forward "^[^ \t]" nil t) + (1- (point))) + (progn (forward-line 1) (point))))))))) + (widen))) + (insert sorthead)(goto-char (point-max)) + (insert body)(goto-char (point-max)) + (insert (concat "\n" (make-string 30 ?-) "\n\n")) + (goto-char beg) + (if (re-search-forward "^Subject: \\(.*\\)$" nil t) + (progn + (setq subj (buffer-substring (match-beginning 1) (match-end 1))) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format " %s\n" subj)))))) + (if (or (eq in-state 'last) + (eq in-state 'first-and-last)) (progn - (message "No list of articles") - (sit-for 2)) - (setq gnus-uu-saved-article-name - (concat gnus-uu-tmp-dir - (read-file-name "Enter file name: " gnus-newsgroup-name - gnus-newsgroup-name))) - (gnus-uu-add-file gnus-uu-saved-article-name) - (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article) - (gnus-uu-save-file gnus-uu-saved-article-name)) - )))) - - -(defun gnus-uu-save-article (buffer in-state) - (save-excursion - (set-buffer buffer) - (call-process-region - 1 (point-max) "sh" nil (get-buffer-create gnus-uu-output-buffer-name) - nil "-c" (concat "cat >> " gnus-uu-saved-article-name))) - 'ok) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format "\n\n%s\n\n" (make-string 70 ?-))) + (write-region 1 (point-max) gnus-uu-saved-article-name)) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-body*")) + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (write-region 1 (point-max) gnus-uu-saved-article-name t)) + (kill-buffer (get-buffer "*gnus-uu-pre*")) + (kill-buffer (get-buffer "*gnus-uu-body*")) + (setq state (cons 'end state)))) + (if (memq 'begin state) + (cons gnus-uu-saved-article-name state) + state))))) + +;; Binhex treatment - not very advanced. - -;; Binhex (defconst gnus-uu-binhex-body-line - "^................................................................$") + "^[^:]...............................................................$") (defconst gnus-uu-binhex-begin-line "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") -(defvar gnus-uu-binhex-article-name nil) - - -(defun gnus-uu-binhex-and-save (view marked) - (let (list-of-articles) - (save-excursion - (if (not marked) - (setq list-of-articles (gnus-uu-get-list-of-articles)) - (setq list-of-articles (reverse gnus-uu-marked-article-list)) - (setq gnus-uu-marked-article-list nil)) -' (setq gn-dummy-l list-of-articles) - (if (not list-of-articles) - (progn - (message "No list of articles") - (sit-for 2)) - (setq gnus-uu-binhex-article-name - (concat gnus-uu-tmp-dir - (read-file-name "Enter binhex file name: " - gnus-newsgroup-name - gnus-newsgroup-name))) - (gnus-uu-add-file gnus-uu-binhex-article-name) - (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article) - (gnus-uu-save-file gnus-uu-binhex-article-name)) - )))) - (defun gnus-uu-binhex-article (buffer in-state) - (let ((state 'ok) - start-char) + (let (state start-char) (save-excursion (set-buffer buffer) - (goto-char 1) - (if (not (re-search-forward (concat gnus-uu-binhex-begin-line "\\|" - gnus-uu-binhex-body-line) nil t)) - (setq state 'wrong-type) + (widen) + (goto-char (point-min)) + (if (not (re-search-forward gnus-uu-binhex-begin-line nil t)) + (if (not (re-search-forward gnus-uu-binhex-body-line nil t)) + (setq state (list 'wrong-type)))) + + (if (memq 'wrong-type state) + () (beginning-of-line) (setq start-char (point)) (if (looking-at gnus-uu-binhex-begin-line) - (setq state 'begin) - (setq state 'middle)) + (progn + (setq state (list 'begin)) + (write-region 1 1 gnus-uu-binhex-article-name)) + (setq state (list 'middle))) (goto-char (point-max)) (re-search-backward (concat gnus-uu-binhex-body-line "\\|" gnus-uu-binhex-end-line) nil t) (if (looking-at gnus-uu-binhex-end-line) - (if (eq state 'begin) - (setq state 'begin-and-end) - (setq state 'end))) + (setq state (if (memq 'begin state) + (cons 'end state) + (list 'end)))) (beginning-of-line) (forward-line 1) - (append-to-file start-char (point) gnus-uu-binhex-article-name))) - state)) - + (if (file-exists-p gnus-uu-binhex-article-name) + (append-to-file start-char (point) gnus-uu-binhex-article-name)))) + (if (memq 'begin state) + (cons gnus-uu-binhex-article-name state) + state))) -;; Internal view commands +;; PostScript -(defun gnus-uu-view-file (file-name &optional dont-ask) - "This function takes two parameters. The first is name of the file to be -viewed. gnus-uu-view-file will look for an action associated with the file -type of the file. If it finds an appropriate action, the file will be -attempted displayed. +(defun gnus-uu-decode-postscript-article (process-buffer in-state) + (let ((state (list 'ok)) + start-char end-char file-name) + (save-excursion + (set-buffer process-buffer) + (goto-char (point-min)) + (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) + (setq state (list 'wrong-type)) + (beginning-of-line) + (setq start-char (point)) + (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) + (setq state (list 'wrong-type)) + (setq end-char (point)) + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (insert-buffer-substring process-buffer start-char end-char) + (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps")) + (write-region (point-min) (point-max) file-name) + (setq state (list file-name'begin 'end)) + + )) + ) + state)) + -The second parameter specifies if the user is to be asked whether to -save the file if viewing is unsuccessful. `t' means 'do not ask.' +;; Find actions. -Note that the file given will be deleted by this function, one way or -another. If `gnus-uu-asynchronous' is set, it won't be deleted right -away, but sometime later. If the user is offered to save the file, it'll -be moved to wherever the user wants it. +(defun gnus-uu-get-actions (files) + (let ((ofiles files) + action name) + (while files + (setq name (cdr (assq 'name (car files)))) + (and + (setq action (gnus-uu-get-action name)) + (setcar files (nconc (list (if (string= action "gnus-uu-archive") + (cons 'action "file") + (cons 'action action)) + (cons 'execute (if (string-match "%" action) + (format action name) + (concat action " " name)))) + (car files)))) + (setq files (cdr files))) + ofiles)) -gnus-uu-view-file returns `t' if viewing is successful." - (let (action did-view - (didnt-want t) - (do-view t)) +(defun gnus-uu-get-action (file-name) + (let (action) (setq action - (gnus-uu-choose-action + (gnus-uu-choose-action file-name (append - (if (and gnus-uu-use-interactive-view - gnus-uu-user-interactive-view-rules) - gnus-uu-user-interactive-view-rules - gnus-uu-user-view-rules) - (if (or gnus-uu-ignore-default-view-rules - (not gnus-uu-use-interactive-view)) - () - gnus-uu-default-interactive-view-rules-begin) + gnus-uu-user-view-rules (if gnus-uu-ignore-default-view-rules nil gnus-uu-default-view-rules) - (if (and gnus-uu-use-interactive-view - gnus-uu-user-interactive-view-rules-end) - gnus-uu-user-interactive-view-rules-end - gnus-uu-user-view-rules-end)))) - - (if (and gnus-uu-use-interactive-view - (not (string= (or action "") "gnus-uu-archive"))) - (gnus-uu-enter-interactive-file (or action "") file-name) - - (if action - (if (string= action "gnus-uu-archive") - (setq did-view (gnus-uu-treat-archive file-name)) - - (if gnus-uu-ask-before-view - (setq didnt-want - (or (not - (setq do-view - (y-or-n-p - (format "Do you want to view %s? " - file-name)))) - didnt-want))) - - (if do-view - (setq did-view - (if gnus-uu-asynchronous - (gnus-uu-call-asynchronous file-name action) - (gnus-uu-call-synchronous file-name action)))))) - - (if (and (not dont-ask) (not gnus-uu-use-interactive-view)) - (progn - (if (and - didnt-want - (or (not action) - (and (string= action "gnus-uu-archive") (not did-view)))) - (progn - (message (format "Could find no rule for %s" file-name)) - (sit-for 2))) - (and (or (not did-view) gnus-uu-view-and-save) - (y-or-n-p - (format "Do you want to save the file %s? " file-name)) - (gnus-uu-save-file file-name)))) - - (if (and (file-exists-p file-name) - (not gnus-uu-use-interactive-view) - (or - (not (and gnus-uu-asynchronous did-view)) - (string= action "gnus-uu-archive"))) - (delete-file file-name))) - - did-view)) - - -(defun gnus-uu-call-synchronous (file-name action) - "Takes two parameters: The name of the file to be displayed and -the command to display it with. Returns `t' on success and `nil' if -the file couldn't be displayed." - (let (did-view command) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer) - (if (string-match "%s" action) - (setq command (format action (concat "'" file-name "'"))) - (setq command (concat action " " (concat "'" file-name "'")))) - (message (format "Viewing with '%s'" command)) - (if (not (= 0 (call-process "sh" nil t nil "-c" command))) - (progn - (goto-char 1) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (message (concat "Error: " (buffer-substring 1 (point-max)))) - (sit-for 2)) - (message "") - (setq did-view t))) - did-view)) - - -(defun gnus-uu-call-asynchronous (file-name action) - "Takes two parameters: The name of the file to be displayed and -the command to display it with. Since the view command is executed -asynchronously, it's kinda hard to decide whether the command succeded -or not, so this function always returns `t'. It also adds \"; rm -f -file-name\" to the end of the execution string, so the file will be -removed after viewing has ended." - (let (command file tmp-file start) - (while (string-match "/" file-name start) - (setq start (1+ (match-beginning 0)))) - (setq file (substring file-name start)) - (setq tmp-file (concat gnus-uu-tmp-dir file)) - (if (string= tmp-file file-name) - () - (rename-file file-name tmp-file t) - (setq file-name tmp-file)) - - (if (string-match "%s" action) - (setq command (format action file-name)) - (setq command (concat action " " file-name))) - (setq command (format "%s ; rm -f %s" command file-name)) - (message (format "Viewing with %s" command)) - (start-process "gnus-uu-view" - nil "sh" "-c" command) - t)) - - -(defun gnus-uu-decode-and-strip (&optional shar use-marked) - "This function does all the main work. It finds out what articles -to grab, grabs them, strips the result and decodes. If any of -these operations fail, it returns `nil', `t' otherwise. -If shar is `t', it will pass this on to gnus-uu-grab-articles -who will (probably) unshar the articles. If use-marked -is non-nil, it won't try to find articles, but use the marked list." - (let (list-of-articles) - (save-excursion + gnus-uu-user-view-rules-end))) + (if (and (not (string= (or action "") "gnus-uu-archive")) + gnus-uu-view-with-metamail) + (if (setq action + (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) + (setq action (format "metamail -d -b -c \"%s\"" action)))) + action)) - (if use-marked - (progn (if (eq gnus-uu-marked-article-list ()) - (message "No articles marked") - (setq list-of-articles (reverse gnus-uu-marked-article-list)) - (gnus-uu-unmark-all-articles))) - (setq list-of-articles (gnus-uu-get-list-of-articles))) - - (and list-of-articles - (gnus-uu-grab-articles list-of-articles - (if shar - 'gnus-uu-unshar-article - 'gnus-uu-uustrip-article-as)))))) +;; Functions for treating subjects and collecting series. (defun gnus-uu-reginize-string (string) - "Takes a string and puts a \\ in front of every special character; -ignores any leading \"version numbers\" -thingies that they use in the comp.binaries groups, and either replaces -anything that looks like \"2/3\" with \"[0-9]+/[0-9]+\" or, if it can't find -something like that, replaces the last two numbers with \"[0-9]+\". This, -in my experience, should get most postings of a series." + ;; Takes a string and puts a \ in front of every special character; + ;; ignores any leading "version numbers" thingies that they use in + ;; the comp.binaries groups, and either replaces anything that looks + ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something + ;; like that, replaces the last two numbers with "[0-9]+". This, in + ;; my experience, should get most postings of a series. (let ((count 2) - (vernum "v[0-9][0-9][a-z][0-9]+:") - reg beg) + (vernum "v[0-9]+[a-z][0-9]+:") + beg) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (buffer-disable-undo (current-buffer)) (erase-buffer) (insert (regexp-quote string)) (setq beg 1) (setq case-fold-search nil) - (goto-char 1) + (goto-char (point-min)) (if (looking-at vernum) (progn (replace-match vernum t t) @@ -1282,839 +890,1000 @@ in my experience, should get most postings of a series." (buffer-substring 1 (point-max))))) - -(defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread) - "Finds all articles that matches the regular expression given. -Returns the resulting list." - (let (beg end reg-subject list-of-subjects list-of-numbers art-num) +(defun gnus-uu-get-list-of-articles (n) + ;; If N is non-nil, the article numbers of the N next articles + ;; will be returned. + ;; If any articles have been marked as processable, they will be + ;; returned. + ;; Failing that, articles that have subjects that are part of the + ;; same "series" as the current will be returned. + (let (articles) + (cond + (n + (let ((backward (< n 0)) + (n (abs n))) + (save-excursion + (while (and (> n 0) + (setq articles (cons (gnus-summary-article-number) + articles)) + (gnus-summary-search-forward nil nil backward)) + (setq n (1- n)))) + (nreverse articles))) + (gnus-newsgroup-processable + (reverse gnus-newsgroup-processable)) + (t + (gnus-uu-find-articles-matching))))) + +(defun gnus-uu-string< (l1 l2) + (string< (car l1) (car l2))) + +(defun gnus-uu-find-articles-matching + (&optional subject only-unread do-not-translate) + ;; Finds all articles that matches the regexp SUBJECT. If it is + ;; nil, the current article name will be used. If ONLY-UNREAD is + ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is + ;; non-nil, article names are not equalized before sorting. + (let ((subject (or subject + (gnus-uu-reginize-string (gnus-summary-subject-string)))) + list-of-subjects) (save-excursion - -; If the subject is not given, this function looks at the current subject -; and takes that. - - (if subject - (setq reg-subject subject) - (end-of-line) - (setq end (point)) - (beginning-of-line) - (if (not (re-search-forward "\\] " end t)) - (progn (message "No valid subject chosen") (sit-for 2)) - (setq subject (buffer-substring (point) end)) - (setq reg-subject - (concat "\\[.*\\] " (gnus-uu-reginize-string subject))))) - -; (message reg-subject)(sleep-for 2) - - (if reg-subject - (progn - -; Collect all subjects matching reg-subject. - - (let ((case-fold-search t)) - (setq case-fold-search t) - (goto-char 1) - (while (re-search-forward reg-subject nil t) - (beginning-of-line) - (setq beg (point)) - (if (or (not only-unread) (looking-at " \\|-")) - (progn - (end-of-line) - (setq list-of-subjects (cons - (buffer-substring beg (point)) - list-of-subjects))) - (end-of-line)))) - -; Expand all numbers in all the subjects: (hi9 -> hi0009, etc). - - (setq list-of-subjects (gnus-uu-expand-numbers list-of-subjects)) - -; Sort the subjects. - - (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<)) - -; Get the article numbers from the sorted list of subjects. - - (while list-of-subjects - (setq art-num (gnus-uu-article-number (car list-of-subjects))) - (if mark-articles (gnus-summary-mark-as-read art-num ?#)) - (setq list-of-numbers (cons art-num list-of-numbers)) - (setq list-of-subjects (cdr list-of-subjects))) - - (setq list-of-numbers (nreverse list-of-numbers)) - - (if (not list-of-numbers) - (progn - (message (concat "No subjects matched " subject)) - (sit-for 2))))) - - list-of-numbers))) - - -(defun gnus-uu-expand-numbers (string-list) - "Takes a list of strings and \"expands\" all numbers in all the strings. -That is, this function makes all numbers equal length by prepending lots -of zeroes before each number. This is to ease later sorting to find out -what sequence the articles are supposed to be decoded in. Returns the list -of expanded strings." - (let (string out-list pos num) + (if (not subject) + () + ;; Collect all subjects matching subject. + (let ((case-fold-search t) + subj mark) + (goto-char (point-min)) + (while (not (eobp)) + (and (setq subj (gnus-summary-subject-string)) + (string-match subject subj) + (or (not only-unread) + (= (setq mark (gnus-summary-article-mark)) + gnus-unread-mark) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark)) + (setq list-of-subjects + (cons (cons subj (gnus-summary-article-number)) + list-of-subjects))) + (forward-line 1))) + + ;; Expand numbers, sort, and return the list of article + ;; numbers. + (mapcar (lambda (sub) (cdr sub)) + (sort (gnus-uu-expand-numbers + list-of-subjects + (not do-not-translate)) + 'gnus-uu-string<)))))) + +(defun gnus-uu-expand-numbers (string-list &optional translate) + ;; Takes a list of strings and "expands" all numbers in all the + ;; strings. That is, this function makes all numbers equal length by + ;; prepending lots of zeroes before each number. This is to ease later + ;; sorting to find out what sequence the articles are supposed to be + ;; decoded in. Returns the list of expanded strings. + (let ((out-list string-list) + string) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (buffer-disable-undo (current-buffer)) (while string-list (erase-buffer) - (setq string (car string-list)) - (setq string-list (cdr string-list)) - (insert string) - (goto-char 1) + (insert (car (car string-list))) + ;; Translate multiple spaces to one space. + (goto-char (point-min)) (while (re-search-forward "[ \t]+" nil t) (replace-match " ")) - (goto-char 1) - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t)) - - (goto-char 1) - (if (not (search-forward "] " nil t)) - () - (while (re-search-forward "[0-9]+" nil t) - (replace-match - (format "%06d" - (string-to-int (buffer-substring - (match-beginning 0) (match-end 0)))))) - (setq string (buffer-substring 1 (point-max))) - (setq out-list (cons string out-list))))) + ;; Translate all characters to "a". + (goto-char (point-min)) + (if translate + (while (re-search-forward "[A-Za-z]" nil t) + (replace-match "a" t t))) + ;; Expand numbers. + (goto-char (point-min)) + (while (re-search-forward "[0-9]+" nil t) + (replace-match + (format "%06d" + (string-to-int (buffer-substring + (match-beginning 0) (match-end 0)))))) + (setq string (buffer-substring 1 (point-max))) + (setcar (car string-list) string) + (setq string-list (cdr string-list)))) out-list)) -(defun gnus-uu-string< (string1 string2) - "Used in a sort for finding out what string is bigger, but ignoring -everything before the subject part." - (string< (substring string1 (string-match "\\] " string1)) - (substring string2 (string-match "\\] " string2)))) - - -;; gnus-uu-grab-article +;; `gnus-uu-grab-articles' is the general multi-article treatment +;; function. It takes a list of articles to be grabbed and a function +;; to apply to each article. ;; -;; This is the general multi-article treatment function. -;; It takes a list of articles to be grabbed and a function -;; to apply to each article. It puts the result in -;; gnus-uu-result-buffer. +;; The function to be called should take two parameters. The first +;; parameter is the article buffer. The function should leave the +;; result, if any, in this buffer. Most treatment functions will just +;; generate files... ;; -;; The function to be called should take two parameters. -;; The first is the buffer that has the article that should -;; be treated. The function should leave the result in this -;; buffer as well. This result is then appended on to the -;; gnus-uu-result-buffer. -;; The second parameter is the state of the list of articles, -;; and can have three values: 'start, 'middle and 'end. -;; The function can have several return values. -;; 'error if there was an error while treating. -;; 'end if the last article has been sighted. -;; 'begin-and-end if the article is both the beginning and -;; the end. All these three return values results in -;; gnus-uu-grab-articles stopping traversing of the list -;; of articles. -;; 'middle if the article is a "middle" article. -;; 'ok if everything is ok. +;; The second parameter is the state of the list of articles, and can +;; have four values: `first', `middle', `last' and `first-and-last'. +;; +;; The function should return a list. The list may contain the +;; following symbols: +;; `error' if an error occurred +;; `begin' if the beginning of an encoded file has been received +;; If the list returned contains a `begin', the first element of +;; the list *must* be a string with the file name of the decoded +;; file. +;; `end' if the the end of an encoded file has been received +;; `middle' if the article was a body part of an encoded file +;; `wrong-type' if the article was not a part of an encoded file +;; `ok', which can be used everything is ok (defvar gnus-uu-has-been-grabbed nil) (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) (let (art) - (if (or (not gnus-uu-has-been-grabbed) - (not gnus-uu-unmark-articles-not-decoded)) + (if (not (and gnus-uu-has-been-grabbed + gnus-uu-unmark-articles-not-decoded)) () (if dont-unmark-last-article (progn (setq art (car gnus-uu-has-been-grabbed)) (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) (while gnus-uu-has-been-grabbed - (gnus-summary-mark-as-unread (car gnus-uu-has-been-grabbed) t) + (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) (if dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art))) - ))) - - -(defun gnus-uu-grab-articles (list-of-articles process-function) - "This function takes a list of articles and a function to apply -to each article grabbed. The result of the function is appended -on to gnus-uu-result-buffer. + (setq gnus-uu-has-been-grabbed (list art)))))) -This function returns `t' if the grabbing and the process-function -has been successful and `nil' otherwise." - (let ((result-buffer (get-buffer-create gnus-uu-result-buffer)) - (state 'first) - (process-state 'ok) - (result t) - (wrong-type t) - (has-been-begin nil) - (article nil)) +;; This function takes a list of articles and a function to apply to +;; each article grabbed. +;; +;; This function returns a list of files decoded if the grabbing and +;; the process-function has been successful and nil otherwise. +(defun gnus-uu-grab-articles + (articles process-function &optional sloppy limit no-errors) + (let ((state 'first) + has-been-begin article result-file result-files process-state + article-buffer) + + (if (not (gnus-server-opened gnus-current-select-method)) + (progn + (gnus-start-news-server) + (gnus-request-group gnus-newsgroup-name))) - (save-excursion - (set-buffer result-buffer) - (erase-buffer)) (setq gnus-uu-has-been-grabbed nil) - (while (and list-of-articles - (not (eq process-state 'end)) - (not (eq process-state 'begin-and-end)) - (not (eq process-state 'error))) - (setq article (car list-of-articles)) - (setq list-of-articles (cdr list-of-articles)) - (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) - - (if (eq list-of-articles ()) (setq state 'last)) - (message (format "Getting article %d" article)) - (if (not (= (or gnus-current-article 0) article)) - (gnus-summary-display-article article)) - (gnus-summary-mark-as-read article) + (while (and articles + (not (memq 'error process-state)) + (or sloppy + (not (memq 'end process-state)))) - (save-excursion - (set-buffer gnus-article-buffer) - (widen)) + (setq article (car articles)) + (setq articles (cdr articles)) + (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) - (setq process-state (funcall process-function gnus-article-buffer state)) + (if (eq articles ()) + (if (eq state 'first) + (setq state 'first-and-last) + (setq state 'last))) - (if (or (eq process-state 'begin) (eq process-state 'begin-and-end) - (eq process-state 'ok)) - (setq has-been-begin t)) + (message "Getting article %d, %s" article (gnus-uu-part-number article)) - (if (not (eq process-state 'wrong-type)) - (setq wrong-type nil) + (if (not (= (or gnus-current-article 0) article)) + (let ((nntp-async-number nil)) + (gnus-request-article article gnus-newsgroup-name + nntp-server-buffer) + (setq gnus-last-article gnus-current-article) + (setq gnus-current-article article) + (setq gnus-article-current (cons gnus-newsgroup-name article)) + (if (stringp nntp-server-buffer) + (setq article-buffer nntp-server-buffer) + (setq article-buffer (buffer-name nntp-server-buffer)))) + (gnus-summary-stop-page-breaking) + (setq article-buffer gnus-article-buffer)) + + (buffer-disable-undo article-buffer) + ;; Mark article as read. + (and (memq article gnus-newsgroup-processable) + (gnus-summary-remove-process-mark article)) + (run-hooks 'gnus-mark-article-hook) + + (setq process-state (funcall process-function article-buffer state)) + + (if (or (memq 'begin process-state) + (and (or (eq state 'first) (eq state 'first-and-last)) + (memq 'ok process-state))) + (progn + (if has-been-begin + (if (and result-file (file-exists-p result-file)) + (delete-file result-file))) + (if (memq 'begin process-state) + (setq result-file (car process-state))) + (setq has-been-begin t))) + + (if (memq 'end process-state) + (progn + (setq gnus-uu-has-been-grabbed nil) + (setq result-files (cons (list (cons 'name result-file) + (cons 'article article)) + result-files)) + (setq has-been-begin nil) + (and limit (= (length result-files) limit) + (setq articles nil)))) + + (if (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state))) + (if (and result-file (file-exists-p result-file)) + (delete-file result-file))) + + (if (not (memq 'wrong-type process-state)) + () (if gnus-uu-unmark-articles-not-decoded - (gnus-summary-mark-as-unread article t))) - - (if gnus-uu-do-sloppy-uudecode - (setq wrong-type nil)) + (gnus-summary-tick-article article t))) (if (and (not has-been-begin) - (not gnus-uu-do-sloppy-uudecode) - (or (eq process-state 'end) - (eq process-state 'middle))) + (not sloppy) + (or (memq 'end process-state) + (memq 'middle process-state))) (progn - (setq process-state 'error) + (setq process-state (list 'error)) (message "No begin part at the beginning") - (sit-for 2)) + (sleep-for 2)) (setq state 'middle))) - (if (and (not has-been-begin) (not gnus-uu-do-sloppy-uudecode)) - (progn - (setq result nil) - (message "Wrong type file") - (sit-for 2)) - (if (eq process-state 'error) - (setq result nil) - (if (not (or (eq process-state 'ok) - (eq process-state 'end) - (eq process-state 'begin-and-end))) - (progn - (if (not gnus-uu-do-sloppy-uudecode) - (progn - (message "End of articles reached before end of file") - (sit-for 2))) - (gnus-uu-unmark-list-of-grabbed) - (setq result nil))))) - (setq gnus-uu-rest-of-articles list-of-articles) - result)) + ;; Make sure the last article is put in the article buffer & fix + ;; windows etc. + (if (not (string= article-buffer gnus-article-buffer)) + (save-excursion + (set-buffer (get-buffer-create gnus-article-buffer)) + (let ((buffer-read-only nil)) + (widen) + (erase-buffer) + (insert-buffer-substring article-buffer) + (gnus-set-mode-line 'article) + (goto-char (point-min))))) + + (gnus-set-mode-line 'summary) + + (if result-files + () + (if (not has-been-begin) + (if (not no-errors) (message "Wrong type file")) + (if (memq 'error process-state) + (setq result-files nil) + (if (not (or (memq 'ok process-state) + (memq 'end process-state))) + (progn + (if (not no-errors) + (message "End of articles reached before end of file")) + (setq result-files nil)) + (gnus-uu-unmark-list-of-grabbed))))) + result-files)) + +(defun gnus-uu-part-number (article) + (let ((subject (mail-header-subject (gnus-get-header-by-number article)))) + (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" + subject) + (substring subject (match-beginning 0) (match-end 0)) + ""))) (defun gnus-uu-uudecode-sentinel (process event) -; (message "Process '%s' has received event '%s'" process event) -; (sit-for 2) (delete-process (get-process process))) - -(defun gnus-uu-uustrip-article-as (process-buffer in-state) - (let ((state 'ok) +(defun gnus-uu-uustrip-article (process-buffer in-state) + ;; Uudecodes a file asynchronously. + (let ((state (list 'ok)) (process-connection-type nil) - start-char pst name-beg name-end buf-state) + start-char pst name-beg name-end) (save-excursion (set-buffer process-buffer) - (setq buf-state buffer-read-only) - (setq buffer-read-only nil) + (let ((case-fold-search nil) + (buffer-read-only nil)) - (goto-char 1) + (goto-char (point-min)) - (if gnus-uu-kill-carriage-return - (progn - (while (search-forward " " nil t) - (delete-backward-char 1)) - (goto-char 1))) + (if gnus-uu-kill-carriage-return + (progn + (while (search-forward "\r" nil t) + (delete-backward-char 1)) + (goto-char (point-min)))) - (if (not (re-search-forward - (concat gnus-uu-begin-string "\\|" gnus-uu-body-line) nil t)) - (setq state 'wrong-type) + (if (not (re-search-forward gnus-uu-begin-string nil t)) + (if (not (re-search-forward gnus-uu-body-line nil t)) + (setq state (list 'wrong-type)))) - (beginning-of-line) - (setq start-char (point)) - - (if (looking-at gnus-uu-begin-string) - (progn - (setq name-end (match-end 1)) - (goto-char (setq name-beg (match-beginning 1))) - (while (re-search-forward "/" name-end t) - (replace-match "-")) - (setq gnus-uu-file-name (buffer-substring name-beg name-end)) - (setq pst (process-status - (or gnus-uu-uudecode-process "nevair"))) - (if (or (eq pst 'stop) (eq pst 'run)) - (progn - (delete-process gnus-uu-uudecode-process) - (gnus-uu-unmark-list-of-grabbed t))) - (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) - "sh" "-c" - (format "cd %s ; uudecode" gnus-uu-tmp-dir))) - (set-process-sentinel - gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) - (setq state 'begin) - (gnus-uu-add-file (concat gnus-uu-tmp-dir gnus-uu-file-name))) - (setq state 'middle)) + (if (memq 'wrong-type state) + () + (beginning-of-line) + (setq start-char (point)) + + (if (looking-at gnus-uu-begin-string) + (progn + (setq name-end (match-end 1) + name-beg (match-beginning 1)) + ;; Remove any non gnus-uu-body-line right after start. + (forward-line 1) + (or (looking-at gnus-uu-body-line) + (gnus-delete-line)) + + ; Replace any slashes and spaces in file names before decoding + (goto-char name-beg) + (while (re-search-forward "/" name-end t) + (replace-match ",")) + (goto-char name-beg) + (while (re-search-forward " " name-end t) + (replace-match "_")) + (goto-char name-beg) + (if (re-search-forward "_*$" name-end t) + (replace-match "")) + + (setq gnus-uu-file-name (buffer-substring name-beg name-end)) + (and gnus-uu-uudecode-process + (setq pst (process-status + (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'stop) (eq pst 'run)) + (progn + (delete-process gnus-uu-uudecode-process) + (gnus-uu-unmark-list-of-grabbed t)))) + (if (get-process "*uudecode*") + (delete-process "*uudecode*")) + (setq gnus-uu-uudecode-process + (start-process + "*uudecode*" + (get-buffer-create gnus-uu-output-buffer-name) + "sh" "-c" + (format "cd %s ; uudecode" gnus-uu-work-dir))) + (set-process-sentinel + gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) + (setq state (list 'begin)) + (gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name))) + (setq state (list 'middle))) - (goto-char (point-max)) - (re-search-backward - (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) - (if (looking-at gnus-uu-end-string) - (if (eq state 'begin) - (setq state 'begin-and-end) - (setq state 'end))) - (forward-line 1) - - (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) - (if (or (eq pst 'run) (eq pst 'stop)) - (progn - (gnus-uu-check-correct-stripped-uucode start-char (point)) - (condition-case err - (process-send-region gnus-uu-uudecode-process start-char - (point)) - (error - (progn - (setq state 'wrong-type) - (delete-process gnus-uu-uudecode-process))))) - (setq state 'wrong-type))) - (setq buffer-read-only buf-state)) - state)) + (goto-char (point-max)) + (re-search-backward + (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) + (beginning-of-line) + (if (looking-at gnus-uu-end-string) + (setq state (cons 'end state))) + (forward-line 1) + + (and gnus-uu-uudecode-process + (setq pst (process-status + (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'run) (eq pst 'stop)) + (progn + (if gnus-uu-correct-stripped-uucode + (progn + (gnus-uu-check-correct-stripped-uucode + start-char (point)) + (goto-char (point-max)) + (re-search-backward + (concat gnus-uu-body-line "\\|" + gnus-uu-end-string) + nil t) + (forward-line 1))) + + (condition-case nil + (process-send-region gnus-uu-uudecode-process + start-char (point)) + (error + (progn + (delete-process gnus-uu-uudecode-process) + (message "gnus-uu: Couldn't uudecode") + ; (sleep-for 2) + (setq state (list 'wrong-type))))) + + (if (memq 'end state) + (accept-process-output gnus-uu-uudecode-process))) + (setq state (list 'wrong-type)))) + (if (not gnus-uu-uudecode-process) + (setq state (list 'wrong-type))))) + + (if (memq 'begin state) + (cons (concat gnus-uu-work-dir gnus-uu-file-name) state) + state)))) + +;; This function is used by `gnus-uu-grab-articles' to treat +;; a shared article. (defun gnus-uu-unshar-article (process-buffer in-state) - "This function is used by gnus-uu-grab-articles to treat -a shared article." - (let ((state 'ok) + (let ((state (list 'ok)) start-char) (save-excursion - (set-buffer process-buffer) - (goto-char 1) - (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) - (setq state 'wrong-type) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) "sh" nil - (get-buffer-create gnus-uu-output-buffer-name) nil - "-c" (concat "cd " gnus-uu-shar-directory " ; sh")))) + (set-buffer process-buffer) + (goto-char (point-min)) + (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) + (setq state (list 'wrong-type)) + (beginning-of-line) + (setq start-char (point)) + (call-process-region + start-char (point-max) "sh" nil + (get-buffer-create gnus-uu-output-buffer-name) nil + "-c" (concat "cd " gnus-uu-work-dir " ; sh")))) state)) - +;; Returns the name of what the shar file is going to unpack. (defun gnus-uu-find-name-in-shar () - "Returns the name of what the shar file is going to unpack." (let ((oldpoint (point)) res) - (goto-char 1) + (goto-char (point-min)) (if (re-search-forward gnus-uu-shar-name-marker nil t) (setq res (buffer-substring (match-beginning 1) (match-end 1)))) (goto-char oldpoint) res)) - -(defun gnus-uu-article-number (subject) - "Returns the article number of the given subject." - (let (end) - (string-match "[0-9]+[^0-9]" subject 1) - (setq end (match-end 0)) - (string-to-int - (substring subject (string-match "[0-9]" subject 1) end)))) - - -(defun gnus-uu-decode (directory) - "UUdecodes everything in the buffer and returns the name of the resulting -file." - (let ((command (concat "cd " directory " ; uudecode")) - file-name) - (save-excursion - (message "Uudecoding...") - (set-buffer (get-buffer-create gnus-uu-result-buffer)) - (setq file-name (concat gnus-uu-tmp-dir gnus-uu-file-name)) - (gnus-uu-add-file file-name) - (call-process-region 1 (point-max) "sh" nil t nil "-c" command) - file-name))) - - -(defun gnus-uu-choose-action (file-name file-action-list) - "Chooses what action to perform given the name and gnus-uu-file-action-list. -Returns either nil if no action is found, or the name of the command -to run if such a rule is found." +;; `gnus-uu-choose-action' chooses what action to perform given the name +;; and `gnus-uu-file-action-list'. Returns either nil if no action is +;; found, or the name of the command to run if such a rule is found. +(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) (let ((action-list (copy-sequence file-action-list)) + (case-fold-search t) rule action) - (while (not (or (eq action-list ()) action)) - (setq rule (car action-list)) - (setq action-list (cdr action-list)) - (if (string-match (car rule) file-name) - (setq action (car (cdr rule))))) + (and + (or no-ignore + (and (not + (and gnus-uu-ignore-files-by-name + (string-match gnus-uu-ignore-files-by-name file-name))) + (not + (and gnus-uu-ignore-files-by-type + (string-match gnus-uu-ignore-files-by-type + (or (gnus-uu-choose-action + file-name gnus-uu-ext-to-mime-list t) + "")))))) + (while (not (or (eq action-list ()) action)) + (setq rule (car action-list)) + (setq action-list (cdr action-list)) + (if (string-match (car rule) file-name) + (setq action (car (cdr rule)))))) action)) - -(defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing) - "Moves the file from the tmp directory to where the user wants it." - (let (dir file-name command) - (string-match "/[^/]*$" from-file-name) - (setq file-name (substring from-file-name (1+ (match-beginning 0)))) - (if default-dir - (setq dir default-dir) - (setq dir (gnus-uu-read-directory "Where do you want the file? "))) - (if (and (not ignore-existing) (file-exists-p (concat dir file-name))) - (progn - (message (concat "There already is a file called " file-name)) - (sit-for 2) - (setq file-name - (read-file-name "Give a new name: " dir (concat dir file-name) - nil file-name))) - (setq file-name (concat dir file-name))) - (rename-file from-file-name file-name t))) - - -(defun gnus-uu-read-directory (prompt &optional default) - (let (dir ok create) - (while (not ok) - (setq ok t) - (setq dir (if default default - (read-file-name prompt gnus-uu-current-save-dir - gnus-uu-current-save-dir))) - (while (string-match "/$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - (if (file-exists-p dir) - (if (not (file-directory-p dir)) - (progn - (setq ok nil) - (message "%s is a file" dir) - (sit-for 2))) - (setq create ?o) - (while (not (or (= create ?y) (= create ?n))) - (message "%s: No such directory. Do you want to create it? (y/n)" - dir) - (setq create (read-char))) - (if (= create ?y) (make-directory dir)))) - (setq gnus-uu-current-save-dir (concat dir "/")))) - - -(defun gnus-uu-treat-archive (file-name) - "Unpacks an archive and views all the files in it. Returns `t' if -viewing one or more files is successful." - (let ((arc-dir (make-temp-name - (concat gnus-uu-tmp-dir "gnusuu"))) - action command files file did-view short-file-name - error-during-unarching) +(defun gnus-uu-treat-archive (file-path) + ;; Unpacks an archive. Returns t if unpacking is successful. + (let ((did-unpack t) + action command dir) (setq action (gnus-uu-choose-action - file-name (append gnus-uu-user-archive-rules + file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules nil gnus-uu-default-archive-rules)))) - (if (not action) - (progn (message (format "No unpackers for the file %s" file-name)) - (sit-for 2)) - (string-match "/[^/]*$" file-name) - (setq short-file-name (substring file-name (1+ (match-beginning 0)))) - (setq command (format "%s %s %s ; cd %s ; %s %s " - (if (or (string= action "uncompress") - (string= action "gunzip")) - "cp" - "mv") - file-name arc-dir - arc-dir - action short-file-name)) - - (make-directory arc-dir) - (gnus-uu-add-file arc-dir) - - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - - (message (format "Unpacking with %s..." action)) - - (if (= 0 (call-process "sh" nil - (get-buffer-create gnus-uu-output-buffer-name) - nil "-c" command)) - (message "") - (message "Error during unpacking of archive") - (sit-for 2) - (sit-for 2) - (setq error-during-unarching t)) - - (if (not (or (string= action "uncompress") - (string= action "gunzip"))) - (call-process "sh" nil (get-buffer gnus-uu-output-buffer-name) - nil "-c" (format "mv %s/%s %s" - arc-dir short-file-name - gnus-uu-tmp-dir))) - (gnus-uu-add-file (concat gnus-uu-tmp-dir short-file-name)) - - (setq did-view - (or (gnus-uu-show-directory arc-dir gnus-uu-use-interactive-view) - did-view)) - (if (and (not gnus-uu-use-interactive-view) - (file-directory-p arc-dir)) - (delete-directory arc-dir))) + (if (not action) (error "No unpackers for the file %s" file-path)) - did-view)) + (string-match "/[^/]*$" file-path) + (setq dir (substring file-path 0 (match-beginning 0))) + (if (member action gnus-uu-destructive-archivers) + (copy-file file-path (concat file-path "~") t)) -(defun gnus-uu-show-directory (dir &optional dont-delete-files) - "Tries to view all the files in the given directory. Returns `t' if -viewing one or more files is successful." - (let (files file did-view) - (setq files (directory-files dir t)) - (setq gnus-uu-generated-file-list - (append files gnus-uu-generated-file-list)) - (while files - (setq file (car files)) - (setq files (cdr files)) - (if (and (not (string-match "/\\.$" file)) - (not (string-match "/\\.\\.$" file))) - (progn - (set-file-modes file 448) - (if (file-directory-p file) - (setq did-view (or (gnus-uu-show-directory file - dont-delete-files) - did-view)) - (setq did-view (or (gnus-uu-view-file file t) did-view)) - (if (and (not dont-delete-files) (file-exists-p file)) - (delete-file file)))))) - (if (not dont-delete-files) (delete-directory dir)) - did-view)) + (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (erase-buffer)) -;; Manual marking + (message "Unpacking: %s..." (gnus-uu-command action file-path)) -(defun gnus-uu-enter-mark-in-list () - (let (article beg) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq article (gnus-uu-article-number - (buffer-substring beg (point)))) - (message (format "Adding article %d to list" article)) - (setq gnus-uu-marked-article-list - (cons article gnus-uu-marked-article-list)))) - -(defun gnus-uu-mark-article () - "Marks the current article to be decoded later." - (interactive) - (gnus-uu-enter-mark-in-list) - (gnus-summary-mark-as-read nil ?#) - (gnus-summary-next-subject 1 nil)) - -(defun gnus-uu-unmark-article () - "Unmarks the current article." - (interactive) - (let ((in (copy-sequence gnus-uu-marked-article-list)) - out article beg found - (old-point (point))) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq article (gnus-uu-article-number (buffer-substring beg (point)))) - (message (format "Removing article %d" article)) - (while in - (if (not (= (car in) article)) - (setq out (cons (car in) out)) - (setq found t) - (message (format "Removing article %d" article))) - (setq in (cdr in))) - (if (not found) (message "Not a marked article.")) - (setq gnus-uu-marked-article-list (reverse out)) - (gnus-summary-mark-as-unread nil t) - (gnus-summary-next-subject 1 nil))) - + (if (= 0 (call-process "sh" nil + (get-buffer-create gnus-uu-output-buffer-name) + nil "-c" command)) + (message "") + (message "Error during unpacking of archive") + (setq did-unpack nil)) + + (if (member action gnus-uu-destructive-archivers) + (rename-file (concat file-path "~") file-path t)) + + did-unpack)) + +(defun gnus-uu-dir-files (dir) + (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) + files file) + (while dirs + (if (file-directory-p (setq file (car dirs))) + (setq files (append files (gnus-uu-dir-files file))) + (setq files (cons file files))) + (setq dirs (cdr dirs))) + files)) + +(defun gnus-uu-unpack-files (files &optional ignore) + ;; Go through FILES and look for files to unpack. + (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) + (ofiles files) + file did-unpack file-entry) + (gnus-uu-add-file totfiles) + (while files + (setq file (cdr (setq file-entry (assq 'name (car files))))) + (if (and (not (member file ignore)) + (equal (gnus-uu-get-action (file-name-nondirectory file)) + "gnus-uu-archive")) + (progn + (setq did-unpack (cons file did-unpack)) + (or (gnus-uu-treat-archive file) + (message "Error during unpacking of %s" file)) + (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) + (nfiles newfiles)) + (gnus-uu-add-file newfiles) + (while nfiles + (or (member (car nfiles) totfiles) + (setq ofiles (cons (list (cons 'name (car nfiles)) + (cons 'original file)) + ofiles))) + (setq nfiles (cdr nfiles))) + (setq totfiles newfiles)))) + (setq files (cdr files))) + (if did-unpack + (gnus-uu-unpack-files ofiles (append did-unpack ignore)) + ofiles))) -(defun gnus-uu-unmark-all-articles () - "Removes the mark from all articles marked for decoding." - (interactive) - (let ((articles (copy-sequence gnus-uu-marked-article-list))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-summary-mark-as-unread nil t) - (setq articles (cdr articles))) - (setq gnus-uu-marked-article-list ()))) +(defun gnus-uu-ls-r (dir) + (let* ((files (gnus-uu-directory-files dir t)) + (ofiles files)) + (while files + (if (file-directory-p (car files)) + (progn + (setq ofiles (delete (car files) ofiles)) + (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))) + (setq files (cdr files))) + ofiles)) -(defun gnus-uu-mark-by-regexp () - "Asks for a regular expression and marks all articles that match for later decoding." - (interactive) - (let (exp) - (setq exp (read-from-minibuffer "Enter regular expression: ")) - (setq gnus-uu-marked-article-list - (reverse (gnus-uu-get-list-of-articles exp t))) - (message ""))) - +;; Various stuff -;; Various +(defun gnus-uu-directory-files (dir &optional full) + (let (files out file) + (setq files (directory-files dir full)) + (while files + (setq file (car files)) + (setq files (cdr files)) + (or (string-match "/\\.\\.?$" file) + (setq out (cons file out)))) + (setq out (nreverse out)) + out)) (defun gnus-uu-check-correct-stripped-uucode (start end) - (let (found beg length short) + (let (found beg length) (if (not gnus-uu-correct-stripped-uucode) () (goto-char start) - (while (< (point) end) - (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) - () - (if (not found) - (progn - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg)))) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (if (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg))) ? ))) - (forward-line 1))))) - -(defun gnus-uu-initialize () - (if (not gnus-uu-use-interactive-view) - () - (save-excursion - (setq gnus-uu-interactive-file-list nil) - (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) - (erase-buffer) - (gnus-uu-mode) - (insert - "# Press return to execute a command. -# Press `C-c C-c' to exit interactive view. - -")))) - + (if (re-search-forward " \\|`" end t) + (progn + (goto-char start) + (while (not (eobp)) + (progn + (if (looking-at "\n") (replace-match "")) + (forward-line 1)))) + + (while (not (eobp)) + (if (looking-at (concat gnus-uu-begin-string "\\|" + gnus-uu-end-string)) + () + (if (not found) + (progn + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (setq length (- (point) beg)))) + (setq found t) + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (if (not (= length (- (point) beg))) + (insert (make-string (- length (- (point) beg)) ? )))) + (forward-line 1)))))) + +(defvar gnus-uu-tmp-alist nil) + +(defun gnus-uu-initialize (&optional scan) + (let (entry) + (if (and (not scan) + (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) + (if (file-exists-p (cdr entry)) + (setq gnus-uu-work-dir (cdr entry)) + (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) + nil))) + t + (setq gnus-uu-tmp-dir (file-name-as-directory + (expand-file-name gnus-uu-tmp-dir))) + (if (not (file-directory-p gnus-uu-tmp-dir)) + (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) + (if (not (file-writable-p gnus-uu-tmp-dir)) + (error "Temp directory %s can't be written to" + gnus-uu-tmp-dir))) + + (setq gnus-uu-work-dir + (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) + (gnus-uu-add-file gnus-uu-work-dir) + (if (not (file-directory-p gnus-uu-work-dir)) + (gnus-make-directory gnus-uu-work-dir)) + (set-file-modes gnus-uu-work-dir 448) + (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) + (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir) + gnus-uu-tmp-alist))))) + + +;; Kills the temporary uu buffers, kills any processes, etc. (defun gnus-uu-clean-up () - "Kills the temporary uu buffers." (let (buf pst) - (setq gnus-uu-do-sloppy-uudecode nil) - (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) - (if (or (eq pst 'stop) (eq pst 'run)) - (delete-process gnus-uu-uudecode-process)) - (and (not gnus-uu-asynchronous) - (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)) - (and (setq buf (get-buffer gnus-uu-result-buffer)) + (and gnus-uu-uudecode-process + (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'stop) (eq pst 'run)) + (delete-process gnus-uu-uudecode-process))) + (and (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) - +;; `gnus-uu-check-for-generated-files' deletes any generated files that +;; hasn't been deleted, if, for instance, the user terminated decoding +;; with `C-g'. (defun gnus-uu-check-for-generated-files () - "Deletes any generated files that hasn't been deleted, if, for -instance, the user terminated decoding with `C-g'." - (let (file) + (let (file dirs) (while gnus-uu-generated-file-list (setq file (car gnus-uu-generated-file-list)) (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list)) (if (not (string-match "/\\.[\\.]?$" file)) (progn (if (file-directory-p file) - (delete-directory file) + (setq dirs (cons file dirs)) (if (file-exists-p file) - (delete-file file)))))))) - - + (delete-file file)))))) + (setq dirs (nreverse dirs)) + (while dirs + (setq file (car dirs)) + (setq dirs (cdr dirs)) + (if (file-directory-p file) + (if (string-match "/$" file) + (delete-directory (substring file 0 (match-beginning 0))) + (delete-directory file)))))) + +;; Add a file (or a list of files) to be checked (and deleted if it/they +;; still exists upon exiting the newsgroup). (defun gnus-uu-add-file (file) - (setq gnus-uu-generated-file-list - (cons file gnus-uu-generated-file-list))) - -(defun gnus-uu-summary-next-subject () - (if (not (gnus-summary-search-forward t)) + (if (stringp file) + (setq gnus-uu-generated-file-list + (cons file gnus-uu-generated-file-list)) + (setq gnus-uu-generated-file-list + (append file gnus-uu-generated-file-list)))) + +;; Inputs an action and a file and returns a full command, putting +;; quotes round the file name and escaping any quotes in the file name. +(defun gnus-uu-command (action file) + (let ((ofile "")) + (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file) (progn - (goto-char 1) - (sit-for 0) - (goto-char (point-max)) - (forward-line -1) - (beginning-of-line) - (search-forward ":" nil t))) - (sit-for 0) - (gnus-summary-recenter)) + (setq ofile + (concat ofile (substring file 0 (match-beginning 0)) "\\" + (substring file (match-beginning 0) (match-end 0)))) + (setq file (substring file (1+ (match-beginning 0)))))) + (setq ofile (concat "\"" ofile file "\"")) + (if (string-match "%s" action) + (format action ofile) + (concat action " " ofile)))) ;; Initializing -(add-hook 'gnus-exit-group-hook - '(lambda () - (gnus-uu-clean-up) - (setq gnus-uu-marked-article-list nil) - (gnus-uu-check-for-generated-files))) - - -;; Interactive exec mode - -(defvar gnus-uu-output-window nil) -(defvar gnus-uu-mode-hook nil) -(defvar gnus-uu-mode-map nil) - -(defun gnus-uu-do-interactive () - (let (int-buffer out-buf) - (set-buffer - (setq int-buffer (get-buffer gnus-uu-interactive-buffer-name))) - (switch-to-buffer-other-window int-buffer) - (pop-to-buffer int-buffer) - (setq gnus-uu-output-window - (split-window nil (- (window-height) gnus-uu-output-window-height))) - (set-window-buffer gnus-uu-output-window - (setq out-buf - (get-buffer-create gnus-uu-output-buffer-name))) - (save-excursion (set-buffer out-buf) (erase-buffer)) - (goto-char 1) - (forward-line 3) - (run-hooks 'gnus-uu-mode-hook))) - - -(defun gnus-uu-enter-interactive-file (action file) - (let (command) - (save-excursion - (setq gnus-uu-interactive-file-list - (cons file gnus-uu-interactive-file-list)) - (set-buffer (get-buffer gnus-uu-interactive-buffer-name)) - (if (string-match "%s" action) - (setq command (format action (concat "'" file "'"))) - (setq command (concat action " " (concat "'" file "'")))) +(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) +(add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files) + + + +;;; +;;; uuencoded posting +;;; + +(require 'sendmail) +(require 'rnews) + +;; Any function that is to be used as and encoding method will take two +;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" +;; and "spiral.jpg", respectively.) The function should return nil if +;; the encoding wasn't successful. +(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode + "Function used for encoding binary files. +There are three functions supplied with gnus-uu for encoding files: +`gnus-uu-post-encode-uuencode', which does straight uuencoding; +`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME +headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with +uuencode and adds MIME headers.") + +(defvar gnus-uu-post-include-before-composing nil + "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. +If this variable is t, you can either include an encoded file with +\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.") + +(defvar gnus-uu-post-length 990 + "Maximum length of an article. +The encoded file will be split into how many articles it takes to +post the entire file.") + +(defvar gnus-uu-post-threaded nil + "Non-nil means that gnus-uu will post the encoded file in a thread. +This may not be smart, as no other decoder I have seen are able to +follow threads when collecting uuencoded articles. (Well, I have seen +one package that does that - gnus-uu, but somehow, I don't think that +counts...) Default is nil.") + +(defvar gnus-uu-post-separate-description t + "Non-nil means that the description will be posted in a separate article. +The first article will typically be numbered (0/x). If this variable +is nil, the description the user enters will be included at the +beginning of the first article, which will be numbered (1/x). Default +is t.") + +(defvar gnus-uu-post-binary-separator "--binary follows this line--") +(defvar gnus-uu-post-message-id nil) +(defvar gnus-uu-post-inserted-file-name nil) +(defvar gnus-uu-winconf-post-news nil) + +(defun gnus-uu-post-news () + "Compose an article and post an encoded file." + (interactive) + (setq gnus-uu-post-inserted-file-name nil) + (setq gnus-uu-winconf-post-news (current-window-configuration)) - (insert (format "%s\n" command))))) + (gnus-summary-post-news) + (use-local-map (copy-keymap (current-local-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) + (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) + + (if gnus-uu-post-include-before-composing + (save-excursion (setq gnus-uu-post-inserted-file-name + (gnus-uu-post-insert-binary))))) -(defun gnus-uu-interactive-execute () +(defun gnus-uu-post-insert-binary-in-article () + "Inserts an encoded file in the buffer. +The user will be asked for a file name." (interactive) - (let (beg out-buf command) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq command (buffer-substring beg (point))) - (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) - (save-excursion - (set-buffer out-buf) - (erase-buffer) - (insert (format "$ %s \n\n" command))) - (message "Executing...") - (if gnus-uu-asynchronous - (start-process "gnus-uu-view" out-buf "sh" "-c" command) - (call-process "sh" nil out-buf nil "-c" command) - (message "")) - (forward-line 1) - (beginning-of-line))) + (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) + (error "Not in post-news buffer")) + (save-excursion + (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) + +;; Encodes with uuencode and substitutes all spaces with backticks. +(defun gnus-uu-post-encode-uuencode (path file-name) + (if (gnus-uu-post-encode-file "uuencode" path file-name) + (progn + (goto-char (point-min)) + (forward-line 1) + (while (re-search-forward " " nil t) + (replace-match "`")) + t))) +;; Encodes with uuencode and adds MIME headers. +(defun gnus-uu-post-encode-mime-uuencode (path file-name) + (if (gnus-uu-post-encode-uuencode path file-name) + (progn + (gnus-uu-post-make-mime file-name "x-uue") + t))) -(defun gnus-uu-interactive-end () - "This function ends interactive view mode and returns to summary mode." - (interactive) - (let (buf) - (delete-window gnus-uu-output-window) - (gnus-uu-clean-up) - (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files)) - (setq buf (get-buffer gnus-uu-interactive-buffer-name)) - (if gnus-article-buffer (switch-to-buffer gnus-article-buffer)) - (if buf (kill-buffer buf)) - (pop-to-buffer gnus-summary-buffer))) - - -(if gnus-uu-mode-map - () - (setq gnus-uu-mode-map (make-sparse-keymap)) - (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) - (define-key gnus-uu-mode-map "\C-cs" - 'gnus-uu-interactive-save-current-file) - (define-key gnus-uu-mode-map "\C-c\C-s" - 'gnus-uu-interactive-save-current-file-silent) - (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files) - (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)) - - -(defun gnus-uu-interactive-save-original-file () +;; Encodes with base64 and adds MIME headers +(defun gnus-uu-post-encode-mime (path file-name) + (if (gnus-uu-post-encode-file "mmencode" path file-name) + (progn + (gnus-uu-post-make-mime file-name "base64") + t))) + +;; Adds MIME headers. +(defun gnus-uu-post-make-mime (file-name encoding) + (goto-char (point-min)) + (insert (format "Content-Type: %s; name=\"%s\"\n" + (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) + file-name)) + (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) + (save-restriction + (set-buffer gnus-post-news-buffer) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line -1) + (narrow-to-region 1 (point)) + (or (mail-fetch-field "mime-version") + (progn + (widen) + (insert "MIME-Version: 1.0\n"))) + (widen))) + +;; Encodes a file PATH with COMMAND, leaving the result in the +;; current buffer. +(defun gnus-uu-post-encode-file (command path file-name) + (= 0 (call-process "sh" nil t nil "-c" + (format "%s %s %s" command path file-name)))) + +(defun gnus-uu-post-news-inews () + "Posts the composed news article and encoded file. +If no file has been included, the user will be asked for a file." (interactive) - (let (file) - (if (file-exists-p - (setq file (concat gnus-uu-tmp-dir - (or gnus-uu-file-name gnus-uu-shar-file-name)))) - (gnus-uu-save-file file) - (message "Already saved.")))) + (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) + (error "Not in post news buffer")) + + (let (file-name) + + (if gnus-uu-post-inserted-file-name + (setq file-name gnus-uu-post-inserted-file-name) + (setq file-name (gnus-uu-post-insert-binary))) + + (if gnus-uu-post-threaded + (let ((gnus-required-headers + (if (memq 'Message-ID gnus-required-headers) + gnus-required-headers + (cons 'Message-ID gnus-required-headers))) + gnus-inews-article-hook) + + (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) + gnus-inews-article-hook + (list gnus-inews-article-hook))) + (setq gnus-inews-article-hook + (cons + '(lambda () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) + (setq gnus-uu-post-message-id + (buffer-substring + (match-beginning 1) (match-end 1))) + (setq gnus-uu-post-message-id nil)))) + gnus-inews-article-hook)) + (gnus-uu-post-encoded file-name t)) + (gnus-uu-post-encoded file-name nil))) + (setq gnus-uu-post-inserted-file-name nil) + (and gnus-uu-winconf-post-news + (set-window-configuration gnus-uu-winconf-post-news))) + +;; Asks for a file to encode, encodes it and inserts the result in +;; the current buffer. Returns the file name the user gave. +(defun gnus-uu-post-insert-binary () + (let ((uuencode-buffer-name "*uuencode buffer*") + file-path uubuf file-name) + + (setq file-path (read-file-name + "What file do you want to encode? ")) + (if (not (file-exists-p file-path)) + (error "%s: No such file" file-path)) + + (goto-char (point-max)) + (insert (format "\n%s\n" gnus-uu-post-binary-separator)) + + (if (string-match "^~/" file-path) + (setq file-path (concat "$HOME" (substring file-path 1)))) + (if (string-match "/[^/]*$" file-path) + (setq file-name (substring file-path (1+ (match-beginning 0)))) + (setq file-name file-path)) + + (unwind-protect + (if (save-excursion + (set-buffer (setq uubuf + (get-buffer-create uuencode-buffer-name))) + (erase-buffer) + (funcall gnus-uu-post-encode-method file-path file-name)) + (insert-buffer uubuf) + (error "Encoding unsuccessful")) + (kill-buffer uubuf)) + file-name)) + +;; Posts the article and all of the encoded file. +(defun gnus-uu-post-encoded (file-name &optional threaded) + (let ((send-buffer-name "*uuencode send buffer*") + (encoded-buffer-name "*encoded buffer*") + (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") + (separator (concat mail-header-separator "\n\n")) + uubuf length parts header i end beg + beg-line minlen buf post-buf whole-len beg-binary end-binary) + + (setq post-buf (current-buffer)) + + (goto-char (point-min)) + (if (not (re-search-forward + (if gnus-uu-post-separate-description + (concat "^" (regexp-quote gnus-uu-post-binary-separator) + "$") + (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) + (error "Internal error: No binary/header separator")) + (beginning-of-line) + (forward-line 1) + (setq beg-binary (point)) + (setq end-binary (point-max)) + (save-excursion + (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) + (erase-buffer) + (insert-buffer-substring post-buf beg-binary end-binary) + (goto-char (point-min)) + (setq length (count-lines 1 (point-max))) + (setq parts (/ length gnus-uu-post-length)) + (if (not (< (% length gnus-uu-post-length) 4)) + (setq parts (1+ parts)))) + + (if gnus-uu-post-separate-description + (forward-line -1)) + (kill-region (point) (point-max)) + + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") nil t) + (beginning-of-line) + (setq header (buffer-substring 1 (point))) -(defun gnus-uu-interactive-save-current-file-silent () - "hei" - (interactive) - (gnus-uu-interactive-save-current-file t)) + (goto-char (point-min)) + (if (not gnus-uu-post-separate-description) + () + (if (and (not threaded) (re-search-forward "^Subject: " nil t)) + (progn + (end-of-line) + (insert (format " (0/%d)" parts)))) + (gnus-inews-news)) -(defun gnus-uu-interactive-save-current-file (&optional dont-ask silent) - "Saves the file referred to on the current line." - (interactive) - (let (files beg line file) - (setq files (copy-sequence gnus-uu-interactive-file-list)) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq line (buffer-substring beg (point))) - (while (and files - (not (string-match - (concat "" (regexp-quote (setq file (car files))) "") - line))) - (setq files (cdr files))) - (beginning-of-line) - (forward-line 1) - (if (not files) - (if (not silent) - (progn (message "Could not find file") (sit-for 2))) - (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent) - (delete-region beg (point))))) + (save-excursion + (setq i 1) + (setq beg 1) + (while (not (> i parts)) + (set-buffer (get-buffer-create send-buffer-name)) + (erase-buffer) + (insert header) + (if (and threaded gnus-uu-post-message-id) + (insert (format "References: %s\n" gnus-uu-post-message-id))) + (insert separator) + (setq whole-len + (- 62 (length (format top-string "" file-name i parts "")))) + (if (> 1 (setq minlen (/ whole-len 2))) + (setq minlen 1)) + (setq + beg-line + (format top-string + (make-string minlen ?-) + file-name i parts + (make-string + (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) + + (goto-char (point-min)) + (if (not (re-search-forward "^Subject: " nil t)) + () + (if (not threaded) + (progn + (end-of-line) + (insert (format " (%d/%d)" i parts))) + (if (or (and (= i 2) gnus-uu-post-separate-description) + (and (= i 1) (not gnus-uu-post-separate-description))) + (replace-match "Subject: Re: ")))) + + (goto-char (point-max)) + (save-excursion + (set-buffer uubuf) + (goto-char beg) + (if (= i parts) + (goto-char (point-max)) + (forward-line gnus-uu-post-length)) + (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) + (forward-line -4)) + (setq end (point))) + (insert-buffer-substring uubuf beg end) + (insert beg-line) + (insert "\n") + (setq beg end) + (setq i (1+ i)) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") nil t) + (beginning-of-line) + (forward-line 2) + (if (re-search-forward + (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") + nil t) + (progn + (replace-match "") + (forward-line 1))) + (insert beg-line) + (insert "\n") + (gnus-inews-news))) + (and (setq buf (get-buffer send-buffer-name)) + (kill-buffer buf)) + (and (setq buf (get-buffer encoded-buffer-name)) + (kill-buffer buf)) -(defun gnus-uu-interactive-save-all-files () - "Saves all files referred to on the current line." - (interactive) - (let (dir) - (goto-char 1) - (setq dir (gnus-uu-read-directory "Where do you want the files? ")) - (while (not (eobp)) - (gnus-uu-interactive-save-current-file t t)))) - -(defun gnus-uu-mode () - "Major mode for editing view commands in gnus-uu. - - -Commands: -Return, C-c C-v, C-c C-x Execute the current command -C-c C-c End interactive mode -C-c s Save the current file -C-c C-s Save the current file without asking - where to put it -C-c C-a Save all files -C-c C-o Save the original file: If the files - originated in an archive, the archive - file is saved. -" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-uu-mode-map) - (setq mode-name "gnus-uu") - (setq major-mode 'gnus-uu-mode) -) - - (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) - (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) - (define-key gnus-uu-mode-map "\C-cs" - 'gnus-uu-interactive-save-current-file) - (define-key gnus-uu-mode-map "\C-c\C-s" - 'gnus-uu-interactive-save-current-file-silent) - (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files) - (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file) + (if (not gnus-uu-post-separate-description) + (progn + (set-buffer-modified-p nil) + (and (fboundp 'bury-buffer) (bury-buffer)))))) (provide 'gnus-uu) +;; gnus-uu.el ends here