X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/842a884bb6a0e586f6b7bfc70c75e4add54d523b..16f45d1b8d556362a0668f192e4453f126946b1c:/lisp/gnus-uu.el diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 0a7983a903..bd23e9edeb 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,12 +1,9 @@ -;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus +;;; gnus-uu.el --- extract (uu)encoded files in Gnus +;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc. -;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. - -;; Author: Lars Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 -;; Version: v2.8 -;; Last Modified: 1994/06/01 -;; Keywords: news +;; Keyword: news ;; This file is part of GNU Emacs. @@ -21,514 +18,48 @@ ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: -;; All gnus-uu commands start with `C-c C-v'. -;; -;; Short user manual for this package: -;; -;; Type `C-c C-v C-v' to decode and view all articles of the current -;; series. The defaults should be reasonable for most systems. -;; -;; Type `C-c C-v C-i' to toggle interactive mode. When using -;; interactive mode, gnus-uu will which display a buffer that will let -;; you see the suggested commands to be executed. -;; -;; To post an uuencoded file, type `C-c C-v p', which will enter you -;; into a buffer analogous to the one you will get when typing `a'. Do -;; an `M-x describe-mode' in this buffer to get a description of what -;; this buffer lets you do. -;; -;; Read the documentation of the `gnus-uu' dummy function for a more -;; complete description of what this package does and how you can -;; customize it to fit your needs. -;; -;; -;; -;; 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. -;; -;; v2.5: First version copyrighted by FSF. Changed lots of -;; documentation strings. -;; -;; v2.5.1: Added uuencode/posting code to post binary files. -;; -;; v2.6: Thread support. gnus-uu is now able to decode uuencoded files -;; posted in threads. gnus-uu can also post in threads. I don't know -;; if this ability is of much use - I've never seen anyone post -;; uuencoded files in threads. -;; -;; v2.7: gnus-uu is now able to decode (and view/save) multiple -;; encoded files in one big gulp. Also added pseudo-mime support -;; (users can use metamail to view files), posting uuencoded/mime -;; files and various other bits and pieces. -;; -;; v2.7.1: New functions for decoding/saving threads bound to `C-c -;; C-v C-j'. Handy to save entire threads, not very useful for -;; decoding, as nobody posts encoded files in threads... -;; -;; v2.7.2: New functions for digesting and forwarding articles added -;; on the suggestion of Per Abrahamsen. Also added a function for -;; marking threads. -;; -;; v2.8: Fixed saving original files in interactive mode. Fixed ask -;; before/save after view. Fixed setting up interactive buffers. Added -;; scanning and rescanning from interactive mode. Added the -;; `gnus-uu-ignore-file-by-name' and `...-by-type' variables to allow -;; users to sift files they don't want to view. At the suggestion of -;; boris@cs.rochester.edu, `C-c C-v C-h' has been undefined to allow -;; users to view list of binding beginning with `C-c C-v'. Fixed -;; viewing with `gnus-uu-asynchronous' set. The -;; "decode-and-save/view-all-articles" functions now accepts the -;; numeric prefix to delimit the maximum number of files to be -;; decoded. - ;;; Code: (require 'gnus) -(require 'gnuspost) - -;; 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) - -(define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer) - -(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) -(define-key gnus-uu-ctl-map "r" 'gnus-uu-mark-by-regexp) -(define-key gnus-uu-ctl-map "t" 'gnus-uu-mark-thread) - -(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) - -(define-key gnus-uu-ctl-map "f" 'gnus-uu-digest-and-forward) -(define-key gnus-uu-ctl-map "\M-f" 'gnus-uu-marked-digest-and-forward) - -(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) - -(define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line) - -(define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles) -(define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles) -(define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles) -(define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles) - -(define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view) -(define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save) - -(define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news) - -;; Dummy function gnus-uu - -(defun gnus-uu () - "gnus-uu is a package for uudecoding and viewing articles. - - -Keymap overview: - -By default, all gnus-uu keystrokes begin with `C-c C-v'. - -There four decoding commands categories: -All commands for viewing are `C-c C-v C-LETTER'. -All commands for saving are `C-c C-v LETTER'. -All commands for marked viewing are `C-c C-v C-M-LETTER'. -All commands for marked saving are `C-c C-v M-LETTER'. - -\\\\[gnus-uu-decode-and-view]\tDecode and view articles -\\[gnus-uu-decode-and-save]\tDecode and save articles -\\[gnus-uu-shar-and-view]\tUnshar and view articles -\\[gnus-uu-shar-and-save]\tUnshar and save articles -\\[gnus-uu-multi-decode-and-view]\tChoose a decoding method, decode and view articles -\\[gnus-uu-multi-decode-and-save]\tChoose a decoding method, decode and save articles - -\\[gnus-uu-threaded-multi-decode-and-view]\tDecode a thread and view -\\[gnus-uu-threaded-multi-decode-and-save]\tDecode a thread and save - -\\[gnus-uu-decode-and-show-in-buffer]\tDecode the current article and view the result in a buffer -\\[gnus-uu-edit-begin-line]\tEdit the 'begin' line of an uuencoded article - -\\[gnus-uu-decode-and-save-all-unread-articles]\tDecode and save all unread articles -\\[gnus-uu-decode-and-save-all-articles]\tDecode and save all articles -\\[gnus-uu-decode-and-view-all-unread-articles]\tDecode and view all unread articles -\\[gnus-uu-decode-and-view-all-articles]\tDecode and view all articles - -\\[gnus-uu-digest-and-forward]\tDigest and forward a series of articles -\\[gnus-uu-marked-digest-and-forward]\tDigest and forward all marked articles - -\\[gnus-uu-mark-article]\tMark the current article for decoding -\\[gnus-uu-unmark-article]\tUnmark the current article -\\[gnus-uu-unmark-all-articles]\tUnmark all articles -\\[gnus-uu-mark-by-regexp]\tMark articles for decoding by regexp -\\[gnus-uu-mark-thread]\tMark articles in this thread -\\[gnus-uu-marked-decode-and-view]\tDecode and view marked articles -\\[gnus-uu-marked-decode-and-save]\tDecode and save marked articles -\\[gnus-uu-marked-shar-and-view]\tUnshar and view marked articles -\\[gnus-uu-marked-shar-and-save]\tUnshar and save marked articles -\\[gnus-uu-marked-multi-decode-and-view]\tChoose decoding method, decode and view marked articles -\\[gnus-uu-marked-multi-decode-and-save]\tChoose decoding method, decode and save marked articles - -\\[gnus-uu-toggle-asynchronous]\tToggle asynchronous viewing mode -\\[gnus-uu-toggle-query]\tToggle whether to ask before viewing a file -\\[gnus-uu-toggle-always-ask]\tToggle whether to ask to save a file after viewing -\\[gnus-uu-toggle-kill-carriage-return]\tToggle whether to strip trailing carriage returns -\\[gnus-uu-toggle-interactive-view]\tToggle whether to use interactive viewing mode -\\[gnus-uu-toggle-correct-stripped-articles]\tToggle whether to 'correct' articles -\\[gnus-uu-toggle-view-with-metamail]\tToggle whether to use metamail for viewing -\\[gnus-uu-toggle-any-variable]\tToggle any of the things above - -\\[gnus-uu-post-news]\tPost an uuencoded article - -Function description: - -`gnus-uu-decode-and-view' 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 simplish rule: The subjects must be (nearly) identical, -except for the last two numbers of the line. (Spaces are largely -ignored, however.) - -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 any of the automatic viewing -commands, and you have to mark the articles manually with '#'. - -`gnus-uu-decode-and-save' will do the same as -`gnus-uu-decode-and-view', except that it will not display the -resulting file, but save it instead. - -`gnus-uu-shar-and-view' and `gnus-uu-shar-and-save' are the \"shar\" -equivalents to the uudecode functions. Instead of feeding the articles -to uudecode, they are run 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. - -Instead of having windows popping up automatically, it can be handy to -view files interactivly, especially when viewing archives. Use -`gnus-uu-toggle-interactive-mode' to toggle interactive mode. - -`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'. - -`gnus-uu-unmark-article' will remove the mark from a previosly marked -article. - -`gnus-uu-unmark-all-articles' will remove the mark from all marked -articles. - -`gnus-uu-mark-by-regexp' will prompt for a regular expression and mark -all articles matching that regular expression. - -`gnus-uu-mark-thread' will mark all articles downward in the current -thread. - -There's an additional way to reach the decoding functions to make -future expansions easier: `gnus-uu-multi-decode-and-view' and the -corresponding save, marked view and marked save functions. You will be -prompted for a 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. - -`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. - -`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 -saved. `gnus-uu-decode-and-save-unread-articles' does only checks -unread articles. - -`gnus-uu-decode-and-view-all-articles' does the same as the function -above, only viewing files instead of saving them. - -`gnus-uu-edit-begin-line' lets you edit the begin line of an uuencoded -file in the current article. Useful to change a corrupted begin line. - - -When using the view commands, `gnus-uu-decode-and-view' 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 recognizes 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. Try -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' during viewing. - - -`gnus-uu-toggle-asynchronous' toggles the `gnus-uu-asynchronous' -variable. - -`gnus-uu-toggle-query' toggles the `gnus-uu-ask-before-view' -variable. - -`gnus-uu-toggle-always-ask' toggles the `gnus-uu-view-and-save' -variable. - -`gnus-uu-toggle-kill-carriage-return' toggles the -`gnus-uu-kill-carriage-return' variable. - -`gnus-uu-toggle-interactive-view' toggles interactive mode. If it is -turned on, gnus-uu won't view files immediately, but will give you a -buffer with the default commands and files and let you edit the -commands and execute them at leisure. - -`gnus-uu-toggle-correct-stripped-articles' toggles whether to check -and correct uuencoded articles that may have had trailing spaces -stripped by mailers. - -`gnus-uu-toggle-view-with-metamail' toggles whether to skip the -gnus-uu viewing methods and just guess at an content-type based on the -file name suffix and feed it to metamail. - -`gnus-uu-toggle-any-variable' is an interface to the toggle commands -listed above. - - -Customization - - Rule Variables - - gnus-uu uses \"rule\" variables to decide how to view a file. All - these variables are of the form - - (list '(regexp1 command2) - '(regexp2 command2) - ...) - - `gnus-uu-user-view-rules' - This variable is consulted first when viewing files. If you wish - to use, for instance, sox to convert an .au sound file, you could - say something like: - - (setq gnus-uu-user-view-rules - (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) - - `gnus-uu-user-view-rules-end' - This variable is consulted if gnus-uu couldn't make any matches - from the user and default view rules. - - `gnus-uu-user-interactive-view-rules' - This is the variable used instead of `gnus-uu-user-view-rules' - when in interactive mode. - - `gnus-uu-user-interactive-view-rules-end' - This variable is used instead of `gnus-uu-user-view-rules-end' - when in interactive mode. - - `gnus-uu-user-archive-rules` - This variable can be used to say what comamnds should be used to - unpack archives. - - - Other Variables - - `gnus-uu-ignore-files-by-name' - Files with name matching this regular expression won't be viewed. - - `gnus-uu-ignore-files-by-type' - Files with a MIME type matching this variable won't be viewed. - Note that gnus-uu tries to guess what type the file is based on - the name. gnus-uu is not a MIME package, so this is slightly - kludgy. - - `gnus-uu-tmp-dir' - Where gnus-uu does its work. - - `gnus-uu-do-not-unpack-archives' - Non-nil means that gnus-uu won't peek inside archives looking for - files to dispay. - - `gnus-uu-view-and-save' - Non-nil means that the user will always be asked to save a file - after viewing it. - - `gnus-uu-asynchronous' - Non-nil means that files will be viewed asynchronously. 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, set the `gnus-uu-ask-before-view' - variable. - - `gnus-uu-ask-before-view' - Non-nil means that gnus-uu will ask you before viewing each file - - `gnus-uu-ignore-default-view-rules' - Non-nil means that gnus-uu will ignore the default viewing rules. - - `gnus-uu-ignore-default-archive-rules' - Non-nil means that gnus-uu will ignore the default archive - unpacking commands. - - `gnus-uu-kill-carriage-return' - Non-nil means that gnus-uu will strip all carriage returns from - articles. - - `gnus-uu-unmark-articles-not-decoded' - Non-nil means that gnus-uu will mark articles that were - unsuccessfully decoded as unread. - - `gnus-uu-output-window-height' - This variable says how tall the output buffer window is to be - when using interactive view mode. - - `gnus-uu-correct-stripped-uucode' - Non-nil means that gnus-uu will *try* to fix uuencoded files that - have had traling spaces deleted. - - `gnus-uu-use-interactive-view' - Non-nil means that gnus-uu will use interactive viewing mode. - - `gnus-uu-view-with-metamail' - Non-nil means that gnus-uu will ignore the viewing commands - defined by the rule variables and just fudge a MIME content type - based on the file name. The result will be fed to metamail for - viewing. - - `gnus-uu-save-in-digest' - 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. - - `gnus-uu-post-include-before-composing' - 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. - - `gnus-uu-post-length' - Maximum length of an article. The encoded file will be split - into how many articles it takes to post the entire file. - - `gnus-uu-post-threaded' - 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. - - `gnus-uu-post-separate-description' - 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. -" - (interactive) - ) +(require 'gnus-msg) +(eval-when-compile (require 'cl)) ;; Default viewing action rules (defvar 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") - '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" + '(("\\.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-6]$" "xterm -e man -l") - '("\\.html$" "xmosaic") - '("\\.mpe?g$" "mpeg_play") - '("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\)$" "xanim") - '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" + ("\\.au$" "cat %s > /dev/audio") + ("\\.midi?$" "playmidi -f") + ("\\.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")) - - "Default actions to be taken when the user asks to view a file. + "*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 with two string elements. The first string is a regular expression. If the file name matches this @@ -544,71 +75,47 @@ 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 vaiable provided in this package. If gnus-uu finds no +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. - -Unless, of course, you are using the interactive view mode. Then -`gnus-uu-user-interactive-view-rules' and -`gnus-uu-user-interactive-view-rules-end' will be used instead.") +match.") (defvar gnus-uu-user-view-rules nil - "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 - "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.") - -(defvar gnus-uu-user-interactive-view-rules nil - "Variable detailing what actions are to be taken to view a file when using interactive mode. + "*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-interactive-view-rules-end nil - "Variable saying what actions are to be taken if no rule matched the file name when using interactive mode. +(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.") -(defvar gnus-uu-default-interactive-view-rules-begin - (list - '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - '("\\.pas$" "cat %s | sed s/\r//g") - )) - -(defvar gnus-uu-default-interactive-view-rules-end - (list - '(".*" "file"))) - ;; Default unpacking commands (defvar gnus-uu-default-archive-rules - (list '("\\.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")) - ) + '(("\\.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. + "*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 - (list '(\"\\\\.tar$\" \"untar\") - '(\"\\\\.zip$\" \"zip -x\")))") + '((\"\\\\.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. + "*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 @@ -618,7 +125,7 @@ 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. + "*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 @@ -630,113 +137,106 @@ Note that this variable can be used in conjunction with the ;; Pseudo-MIME support (defconst gnus-uu-ext-to-mime-list - (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"))) + '(("\\.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. + "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\".") (defvar gnus-uu-do-not-unpack-archives nil - "Non-nil means that gnus-uu won't peek inside archives looking for files to dispay. + "*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 - "Non-nil means that the user will always be asked to save a file after viewing it. -If the variable is nil, the suer will only be asked to save if the -viewing is unsuccessful. Default is nil.") - -(defvar gnus-uu-asynchronous nil - "Non-nil means that files will be viewed asynchronously. -Default is nil.") - -(defvar gnus-uu-ask-before-view nil - "Non-nil means that gnus-uu will ask you before viewing each file. -Especially useful when `gnus-uu-asynchronous' is set. Default is -nil.") - (defvar gnus-uu-ignore-default-view-rules nil - "Non-nil means that gnus-uu will ignore the default viewing rules. + "*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-grabbed-file-functions nil + "*Functions run on each file after successful decoding. +They will be called with the name of the file as the argument. +Likely functions you can use in this list are `gnus-uu-grab-view' +and `gnus-uu-grab-move'.") + (defvar gnus-uu-ignore-default-archive-rules nil - "Non-nil means that gnus-uu will ignore the default archive unpacking commands. + "*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 - "Non-nil means that gnus-uu will strip all carriage returns from articles. + "*Non-nil means that gnus-uu will strip all carriage returns from articles. Default is t.") (defvar gnus-uu-view-with-metamail nil - "Non-nil means that files will be viewed with metamail. + "*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-unmark-articles-not-decoded nil - "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. + "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil.") -(defvar gnus-uu-output-window-height 20 - "This variable says how tall the output buffer window is to be when using interactive view mode. -Change it at your convenience. Default is 20.") - (defvar gnus-uu-correct-stripped-uucode nil - "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had traling spaces deleted. + "*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 - "Non-nil means that gnus-uu will use interactive viewing mode. -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. + "*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.") + +(defvar gnus-uu-save-separate-articles nil + "*Non-nil means that gnus-uu will save articles in separate files.") ;; Internal variables +(defvar gnus-uu-saved-article-name nil) + (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") (defconst gnus-uu-end-string "^end[ \t]*$") @@ -752,467 +252,490 @@ so I simply dropped them.") (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) + +(defconst gnus-uu-postscript-begin-string "^%!PS-") +(defconst gnus-uu-postscript-end-string "^%%EOF$") (defvar gnus-uu-file-name nil) -(defvar gnus-uu-list-of-files-decoded nil) (defconst gnus-uu-uudecode-process nil) +(defvar gnus-uu-binhex-article-name nil) -(defvar gnus-uu-interactive-file-list nil) -(defvar gnus-uu-marked-article-list nil) -(defvar gnus-uu-generated-file-list nil) (defvar gnus-uu-work-dir nil) -(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*") - -(defconst gnus-uu-highest-article-number 1) - -;; Interactive functions - -;; UUdecode and view - -(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 'cat ->/dev/audio' 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)) - -(defun gnus-uu-decode-and-save () - "Decodes and saves the resulting file." - (interactive) - (gnus-uu-decode-and-view-or-save nil nil)) - -(defun gnus-uu-marked-decode-and-view () - "Decodes and views articles marked. -The marked equivalent to `gnus-uu-decode-and-view'." - (interactive) - (gnus-uu-decode-and-view-or-save t t)) - -(defun gnus-uu-marked-decode-and-save () - "Decodes and saves articles marked. -The marked equivalent to `gnus-uu-decode-and-save'." - (interactive) - (gnus-uu-decode-and-view-or-save nil t)) - - -;; Unshar and view - -(defun gnus-uu-shar-and-view () - "Unshars and views articles. -The shar equivalent of `gnus-uu-decode-and-view'." - (interactive) - (gnus-uu-unshar-and-view-or-save t nil)) - -(defun gnus-uu-shar-and-save () - "Unshars and saves files. -The shar equivalent to `gnus-uu-decode-and-save'." - (interactive) - (gnus-uu-unshar-and-view-or-save nil nil)) - -(defun gnus-uu-marked-shar-and-view () - "Unshars and views articles marked. -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 () - "Unshars and saves articles marked. -The marked equivalent to `gnus-uu-shar-and-save'." - (interactive) - (gnus-uu-unshar-and-view-or-save nil t)) - -;; Threaded decode - -(defun gnus-uu-threaded-decode-and-view () +(defconst gnus-uu-output-buffer-name " *Gnus UU Output*") + +(defvar gnus-uu-default-dir gnus-article-save-directory) +(defvar gnus-uu-digest-from-subject nil) + +;; Keymaps + +(gnus-define-keys + (gnus-uu-mark-map "P" gnus-summary-mark-map) + "p" gnus-summary-mark-as-processable + "u" gnus-summary-unmark-as-processable + "U" gnus-summary-unmark-all-processable + "v" gnus-uu-mark-over + "s" gnus-uu-mark-series + "r" gnus-uu-mark-region + "R" gnus-uu-mark-by-regexp + "t" gnus-uu-mark-thread + "T" gnus-uu-unmark-thread + "a" gnus-uu-mark-all + "b" gnus-uu-mark-buffer + "S" gnus-uu-mark-sparse) + +(gnus-define-keys + (gnus-uu-extract-map "X" gnus-summary-mode-map) + ;;"x" gnus-uu-extract-any + ;;"m" gnus-uu-extract-mime + "u" gnus-uu-decode-uu + "U" gnus-uu-decode-uu-and-save + "s" gnus-uu-decode-unshar + "S" gnus-uu-decode-unshar-and-save + "o" gnus-uu-decode-save + "O" gnus-uu-decode-save + "b" gnus-uu-decode-binhex + "B" gnus-uu-decode-binhex + "p" gnus-uu-decode-postscript + "P" gnus-uu-decode-postscript-and-save) + +(gnus-define-keys + (gnus-uu-extract-view-map "v" gnus-uu-extract-map) + "u" gnus-uu-decode-uu-view + "U" gnus-uu-decode-uu-and-save-view + "s" gnus-uu-decode-unshar-view + "S" gnus-uu-decode-unshar-and-save-view + "o" gnus-uu-decode-save-view + "O" gnus-uu-decode-save-view + "b" gnus-uu-decode-binhex-view + "B" gnus-uu-decode-binhex-view + "p" gnus-uu-decode-postscript-view + "P" gnus-uu-decode-postscript-and-save-view) + + +;; Commands. + +(defun gnus-uu-decode-uu (&optional 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) - (gnus-uu-threaded-decode-and-view-or-save t)) + (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 nil nil t)) + +(defun gnus-uu-decode-unshar (&optional n) + "Unshars the current article." + (interactive "P") + (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) + +(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 t)) + +(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)) + +(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 (&optional 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 (&optional 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))) -(defun gnus-uu-threaded-decode-and-save () - "Decodes and saves the resulting file." - (interactive) - (gnus-uu-threaded-decode-and-view-or-save nil)) -(defun gnus-uu-threaded-multi-decode-and-view () - "Decodes and saves the resulting file." - (interactive) - (gnus-uu-threaded-multi-decode-and-view-or-save t)) - -(defun gnus-uu-threaded-multi-decode-and-save () - "Decodes and saves the resulting file." - (interactive) - (gnus-uu-threaded-multi-decode-and-view-or-save nil)) - -(defun gnus-uu-threaded-decode-and-view-or-save (&optional view) - (gnus-uu-unmark-all-articles) - (gnus-uu-mark-thread) - (gnus-uu-decode-and-view-or-save view t)) - -(defun gnus-uu-threaded-multi-decode-and-view-or-save (view) - (let (type) - (message "Decode type: [u]udecode, (s)har, s(a)ve, (b)inhex: ") - (setq type (read-char)) - (if (not (or (= type ?u) (= type ?s) (= type ?b) (= type ?a))) - (error "No such decoding method '%c'" type)) - - (gnus-uu-unmark-all-articles) - (gnus-uu-mark-thread) - - (if (= type ?\r) (setq type ?u)) - (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view t)) - ((= type ?s) (gnus-uu-unshar-and-view-or-save view t)) - ((= type ?b) (gnus-uu-binhex-and-save view t)) - ((= type ?a) (gnus-uu-save-articles view t))))) - - -;; 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 always ask to save a file after 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"))) +;; Digest and forward articles -(defun gnus-uu-toggle-kill-carriage-return () - "This function toggles the stripping of carriage returns from the articles." +(defun gnus-uu-digest-mail-forward (&optional n 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 subject from) + (setq gnus-uu-digest-from-subject nil) + (gnus-uu-decode-save n 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) + (let ((fs gnus-uu-digest-from-subject)) + (if (not fs) + () + (setq from (caar fs) + subject (gnus-simplify-subject-fuzzy (cdar fs)) + fs (cdr fs)) + (while (and fs (or from subject)) + (and from + (or (string= from (caar fs)) + (setq from nil))) + (and subject + (or (string= (gnus-simplify-subject-fuzzy (cdar fs)) + subject) + (setq subject nil))) + (setq fs (cdr fs)))) + (or subject (setq subject "Digested Articles")) + (or from (setq from "Various"))) + (goto-char (point-min)) + (and (re-search-forward "^Subject: ") + (progn + (delete-region (point) (gnus-point-at-eol)) + (insert subject))) + (goto-char (point-min)) + (and (re-search-forward "^From: ") + (progn + (delete-region (point) (gnus-point-at-eol)) + (insert from))) + (message-forward post) + (delete-file file) + (kill-buffer buf) + (setq gnus-uu-digest-from-subject nil))) + +(defun gnus-uu-digest-post-forward (&optional n) + "Digest and forward to a newsgroup." + (interactive "P") + (gnus-uu-digest-mail-forward n t)) + +;; Process marking. + +(defun gnus-uu-mark-by-regexp (regexp &optional unmark) + "Ask for a regular expression and set the process mark on all articles that match." + (interactive (list (read-from-minibuffer "Mark (regexp): "))) + (gnus-set-global-variables) + (let ((articles (gnus-uu-find-articles-matching regexp))) + (while articles + (if unmark + (gnus-summary-remove-process-mark (pop articles)) + (gnus-summary-set-process-mark (pop articles)))) + (message "")) + (gnus-summary-position-point)) + +(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) + "Ask for a regular expression and remove the process mark on all articles that match." + (interactive (list (read-from-minibuffer "Mark (regexp): "))) + (gnus-uu-mark-by-regexp regexp t)) + +(defun gnus-uu-mark-series () + "Mark the current series with the process mark." (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"))) - -(defun gnus-uu-toggle-view-with-metamail () - "This function toggles whether to view files with metamail." + (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-point)) + +(defun gnus-uu-mark-region (beg end &optional unmark) + "Set the process mark on all articles between point and mark." + (interactive "r") + (gnus-set-global-variables) + (save-excursion + (goto-char beg) + (while (< (point) end) + (if unmark + (gnus-summary-remove-process-mark (gnus-summary-article-number)) + (gnus-summary-set-process-mark (gnus-summary-article-number))) + (forward-line 1))) + (gnus-summary-position-point)) + +(defun gnus-uu-unmark-region (beg end) + "Remove the process mark from all articles between point and mark." + (interactive "r") + (gnus-uu-mark-region beg end t)) + +(defun gnus-uu-mark-buffer () + "Set the process mark on all articles in the buffer." (interactive) - (if (setq gnus-uu-view-with-metamail (not gnus-uu-view-with-metamail)) - (message "gnus-uu will now view with metamail") - (message "gnus-uu will now view with the gnus-uu viewing functions"))) - -(defun gnus-uu-toggle-correct-stripped-uucode () - "This function toggles whether to correct stripped uucode." + (gnus-uu-mark-region (point-min) (point-max))) + +(defun gnus-uu-unmark-buffer () + "Remove the process mark on all articles in the buffer." (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"))) - -(defun gnus-uu-toggle-any-variable () - "This function ask what variable the user wants to toggle." + (gnus-uu-mark-region (point-min) (point-max) t)) + +(defun gnus-uu-mark-thread () + "Marks all articles downwards in this thread." (interactive) - (let (rep) - (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteract, (u)nmark, (c)orrect, (m)eta") - (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 ?m) - (gnus-uu-toggle-view-with-metamail)) - (if (= rep ?i) - (gnus-uu-toggle-interactive-view)))) - - -;; Misc interactive functions - -(defun gnus-uu-decode-and-show-in-buffer () - "Uudecodes the current article and displays the result in a buffer. -Might be useful if someone has, for instance, some text uuencoded in -their sigs. (Stranger things have happened.)" + (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-point)) + +(defun gnus-uu-unmark-thread () + "Unmarks all articles downwards in this thread." (interactive) - (gnus-uu-initialize) - (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name)) - file-name) + (gnus-set-global-variables) + (let ((level (gnus-summary-thread-level))) + (while (and (gnus-summary-remove-process-mark + (gnus-summary-article-number)) + (zerop (gnus-summary-next-subject 1)) + (> (gnus-summary-thread-level) level)))) + (gnus-summary-position-point)) + +(defun gnus-uu-mark-over (&optional score) + "Mark all articles with a score over SCORE (the prefix.)" + (interactive "P") + (let ((score (gnus-score-default score)) + (data gnus-newsgroup-data)) (save-excursion - (and - (gnus-summary-select-article) - (gnus-uu-grab-articles (list gnus-current-article) - 'gnus-uu-uustrip-article-as) - (setq file-name (concat gnus-uu-work-dir gnus-uu-file-name)) - (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 "Showing file %s in buffer" file-name) - (delete-file file-name)))))) - -(defun gnus-uu-edit-begin-line () - "Edit the begin line of the current article." + (while data + (when (> (or (cdr (assq (gnus-data-number (caar data)) + gnus-newsgroup-scored)) + gnus-summary-default-score 0) + score) + (gnus-summary-set-process-mark (caar data))) + (setq data (cdr data)))) + (gnus-summary-position-point))) + +(defun gnus-uu-mark-sparse () + "Mark all series that have some articles marked." (interactive) - (let ((buffer-read-only nil) - begin b) + (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 - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (goto-line 1) - (if (not (re-search-forward "begin " nil t)) - (error "No begin line in the current article") - (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 () - "Choose a method of decoding and then 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 () - "Choose a method of decoding and then 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." + (while marked + (and (vectorp (setq headers + (gnus-summary-article-header (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-point))) + +(defun gnus-uu-mark-all () + "Mark all articles in \"series\" order." (interactive) - (gnus-uu-multi-decode-and-view-or-save nil nil)) - -(defun gnus-uu-marked-multi-decode-and-view () - "Choose a method of decoding and then decode and view the marked articles. -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 () - "Choose a method of decoding and then decode and save the marked articles. -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 (type) - (message "[u]udecode, (s)har, s(a)ve, (b)inhex: ") - (setq type (read-char)) - (if (= type ?\r) (setq type ?u)) - (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view marked)) - ((= type ?s) (gnus-uu-unshar-and-view-or-save view marked)) - ((= type ?b) (gnus-uu-binhex-and-save view marked)) - ((= type ?a) (gnus-uu-save-articles view marked)) - (t (error "Unknown decode method '%c'." type))))) - - -;; "All articles" commands - -(defconst gnus-uu-rest-of-articles nil) -(defvar gnus-uu-current-save-dir nil) - -(defun gnus-uu-decode-and-view-all-articles (arg &optional unread) - "Try to decode all articles and view the result. -ARG delimits the number of files to be decoded." - (interactive "p") - (if (not (setq gnus-uu-marked-article-list - (nreverse (gnus-uu-get-list-of-articles - "^." nil unread t)))) - (error "No%s articles to be decoded" (if unread " unread" ""))) - (gnus-uu-decode-and-view-or-save t t nil (if (> arg 1) arg nil))) - -(defun gnus-uu-decode-and-view-all-unread-articles (arg) - "Try to decode all unread articles and view the result. -ARG delimits the number of files to be decoded." - (interactive "p") - (gnus-uu-decode-and-view-all-articles arg t)) - -(defun gnus-uu-decode-and-save-all-unread-articles (arg) - "Try to decode all unread articles and saves the result. -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. -ARG delimits the number of files to be decoded." - (interactive "p") - (gnus-uu-decode-and-save-articles arg t t)) - -(defun gnus-uu-decode-and-save-all-articles (arg) - "Try to decode all articles and saves the result. -Does the same as `gnus-uu-decode-and-save-all-unread-articles', except -that it grabs all articles visible, unread or not. -ARG delimits the number of files to be decoded." - (interactive "p") - (gnus-uu-decode-and-save-articles arg nil t)) - -(defun gnus-uu-decode-and-save-articles (arg &optional unread unmark) - (let (dir) - (if (not (setq gnus-uu-marked-article-list - (nreverse (gnus-uu-get-list-of-articles - "^." nil unread t)))) - (error "No%s articles to be decoded." (if unread " unread" "")) - (setq dir (gnus-uu-read-directory "Where do you want the files? ")) - (gnus-uu-decode-and-view-or-save nil t dir (if (> arg 1) arg nil)) - (message "Saved.")))) - - -;; Work functions - -; All the interactive uudecode/view/save/marked functions are interfaces -; to this function, which does the rest. -(defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir limit) - (gnus-uu-initialize) - (let (decoded) - (save-excursion - (if (gnus-uu-decode-and-strip nil marked limit) - (progn - (setq decoded t) - (if view - (gnus-uu-view-directory gnus-uu-work-dir - gnus-uu-use-interactive-view) - (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir) - (gnus-uu-check-for-generated-files))))) - - (gnus-uu-summary-next-subject) - - (if (and gnus-uu-use-interactive-view view decoded) - (gnus-uu-do-interactive)) - - (if (or (not view) (not gnus-uu-use-interactive-view) (not decoded)) - (gnus-uu-clean-up)))) - -; Unshars and views/saves marked/unmarked articles. -(defun gnus-uu-unshar-and-view-or-save (view marked) - (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)))) - + (gnus-set-global-variables) + (setq gnus-newsgroup-processable nil) + (save-excursion + (let ((data gnus-newsgroup-data) + number) + (while data + (when (and (not (memq (setq number (gnus-data-number (car data))) + gnus-newsgroup-processable)) + (vectorp (gnus-data-header (car data)))) + (gnus-summary-goto-subject number) + (gnus-uu-mark-series)) + (setq data (cdr data))))) + (gnus-summary-position-point)) + +;; All PostScript functions written by Erik Selberg . + +(defun gnus-uu-decode-postscript (&optional 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 (&optional 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 nil nil t)) + +(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 cdir) + (gnus-uu-initialize scan) + (if save (setq gnus-uu-default-dir save)) + ;; Create the directory we save to. + (when (and scan cdir save + (not (file-exists-p save))) + (make-directory save t)) + (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)) + (if (eq gnus-uu-do-not-unpack-archives nil) + (setq files (gnus-uu-unpack-files files))) + (setq files (nreverse (gnus-uu-get-actions files))) + (or not-insert (not gnus-insert-pseudo-articles) + (gnus-summary-insert-pseudos files save)))) + +(defun gnus-uu-scan-directory (dir &optional rec) + "Return a list of all files under DIR." + (let ((files (directory-files dir t)) + out file) + (while (setq file (pop files)) + (unless (member (file-name-nondirectory file) '("." "..")) + (push (list (cons 'name file) + (cons 'article gnus-current-article)) + out) + (when (file-directory-p file) + (setq out (nconc (gnus-uu-scan-directory file t) out))))) + (if rec + out + (nreverse out)))) + +(defun gnus-uu-save-files (files dir) + "Save FILES in DIR." + (let ((len (length files)) + (reg (concat "^" (regexp-quote gnus-uu-work-dir))) + to-file file fromdir) + (while (setq file (cdr (assq 'name (pop files)))) + (when (file-exists-p file) + (string-match reg file) + (setq fromdir (substring file (match-end 0))) + (if (file-directory-p file) + (unless (file-exists-p (concat dir fromdir)) + (make-directory (concat dir fromdir) t)) + (setq to-file (concat dir fromdir)) + (when (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))))) + (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) ;; Functions for saving and possibly digesting articles without ;; any decoding. -(defconst gnus-uu-saved-article-name nil) - -; VIEW isn't used, but is here anyway, to provide similar interface to -; the other related functions. If MARKED is non-nil, the list of -; marked articles is used. If NO-SAVE is non-nil, the articles aren't -; actually saved in a permanent location, but the collecting is done -; and a temporary file with the result is returned. -(defun gnus-uu-save-articles (view marked &optional no-save) - (let (list-of-articles) - (save-excursion - (gnus-uu-initialize) - (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) - (error "No list of articles")) - - (setq gnus-uu-saved-article-name - (concat gnus-uu-work-dir - (if no-save - gnus-newsgroup-name - (read-file-name "Enter file name: " gnus-newsgroup-name - gnus-newsgroup-name)))) - (gnus-uu-add-file gnus-uu-saved-article-name) - (if (and (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article t) - (not no-save)) - (gnus-uu-save-file gnus-uu-saved-article-name) - gnus-uu-saved-article-name)))) - -; Function called by gnus-uu-grab-articles to treat each article. +;; Function called by gnus-uu-grab-articles to treat each article. (defun gnus-uu-save-article (buffer in-state) - (if (not gnus-uu-save-in-digest) - (save-excursion - (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)))) - (let (beg subj name headers headline sorthead body end-string state) - (string-match "/\\([^/]*\\)$" gnus-uu-saved-article-name) - (setq name (substring gnus-uu-saved-article-name (match-beginning 1) - (match-end 1))) + (cond + (gnus-uu-save-separate-articles + (save-excursion + (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 + (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 ((header (gnus-summary-article-header))) + (setq gnus-uu-digest-from-subject + (cons (cons (mail-header-from header) + (mail-header-subject header)) + gnus-uu-digest-from-subject))) + (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) + (delim (concat "^" (make-string 30 ?-) "$")) + beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) (progn @@ -1233,24 +756,38 @@ ARG delimits the number of files to be decoded." (save-excursion (save-restriction (set-buffer buffer) - (goto-char 1) + (let (buffer-read-only) + (gnus-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") + ;; Quote all 30-dash lines. + (save-excursion + (while (re-search-forward delim nil t) + (beginning-of-line) + (delete-char 1) + (insert " "))) (setq body (buffer-substring (1- (point)) (point-max))) - (narrow-to-region 1 (point)) - (setq headers (list "Date:" "From:" "To:" "Cc:" "Subject:" - "Message-ID:" "Keywords:" "Summary:")) - (while headers - (setq headline (car headers)) - (setq headers (cdr headers)) - (goto-char 1) - (if (re-search-forward (concat "^" headline ".*$") nil t) + (narrow-to-region (point-min) (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)) + (while (re-search-forward headline nil t) (setq sorthead - (concat sorthead (buffer-substring - (match-beginning 0) - (match-end 0)) "\n")))) + (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 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) @@ -1279,36 +816,7 @@ ARG delimits the number of files to be decoded." (setq state (cons 'end state)))) (if (memq 'begin state) (cons gnus-uu-saved-article-name state) - state)))) - - -;; Digest and forward articles - -(autoload 'gnus-mail-forward-using-mail "gnusmail" - "Forward the current message to another user." t) -(autoload 'gnus-mail-forward-using-mhe "gnusmail" - "Forward the current message to another user." t) - -(defun gnus-uu-digest-and-forward (&optional marked) - "Digests and forwards all articles in this series." - (interactive) - (let ((gnus-uu-save-in-digest t) - file buf) - (setq file (gnus-uu-save-articles nil marked t)) - (switch-to-buffer (setq buf (get-buffer-create "*gnus-uu-forward*"))) - (erase-buffer) - (delete-other-windows) - (erase-buffer) - (insert-file file) - (goto-char 1) - (bury-buffer buf) - (funcall gnus-mail-forward-method))) - -(defun gnus-uu-marked-digest-and-forward (&optional marked) - "Digests and forwards all marked articles." - (interactive) - (gnus-uu-digest-and-forward t)) - + state))))) ;; Binhex treatment - not very advanced. @@ -1318,38 +826,13 @@ ARG delimits the number of files to be decoded." "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") -(defvar gnus-uu-binhex-article-name nil) - -; This just concatenates and strips stuff from binhexed articles. -; No actual unbinhexing takes place. VIEW is ignored. -(defun gnus-uu-binhex-and-save (view marked) - (gnus-uu-initialize) - (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) - (error "No list of articles")) - - (setq gnus-uu-binhex-article-name - (concat gnus-uu-work-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 t) - (gnus-uu-save-file gnus-uu-binhex-article-name)))) - (gnus-uu-check-for-generated-files) - (gnus-uu-summary-next-subject)) (defun gnus-uu-binhex-article (buffer in-state) (let (state start-char) (save-excursion (set-buffer buffer) (widen) - (goto-char 1) + (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)))) @@ -1377,70 +860,48 @@ ARG delimits the number of files to be decoded." (if (memq 'begin state) (cons gnus-uu-binhex-article-name state) state))) + +;; PostScript + +(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)) -;; Internal view commands - -; 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. -; -; 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." -; -; 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. - -; `gnus-uu-view-file' returns t if viewing is successful. - -(defun gnus-uu-view-file (file &optional silent) - (let (action did-view) - (cond - ((not (setq action (gnus-uu-get-action file))) - (if (and (not silent) (not gnus-uu-use-interactive-view)) - (progn - (message "Couldn't find any rule for file '%s'" file) - (sleep-for 2) - (gnus-uu-ask-to-save-file file)))) - - ((and gnus-uu-use-interactive-view - (not (string= (or action "") "gnus-uu-archive"))) - (gnus-uu-enter-interactive-file (or action "") file)) - - (gnus-uu-ask-before-view - (if (y-or-n-p (format "Do you want to view %s? " file)) - (setq did-view (gnus-uu-call-file-action file action))) - (message "")) - - ((setq did-view (gnus-uu-call-file-action file action))) - - ((not silent) - (gnus-uu-ask-to-save-file file))) - - (if (and (file-exists-p file) - (not gnus-uu-use-interactive-view) - (or - (not (and gnus-uu-asynchronous did-view)) - (string= (or action "") "gnus-uu-archive"))) - (delete-file file)) - - did-view)) - -(defun gnus-uu-call-file-action (file action) - (prog1 - (if gnus-uu-asynchronous - (gnus-uu-call-asynchronous file action) - (gnus-uu-call-synchronous file action)) - (if gnus-uu-view-and-save - (gnus-uu-ask-to-save-file file)))) - -(defun gnus-uu-ask-to-save-file (file) - (if (y-or-n-p (format "Do you want to save the file %s? " file)) - (gnus-uu-save-file file)) - (message "")) +;; Find actions. + +(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 (gnus-uu-command + action name))) + (car files)))) + (setq files (cdr files))) + ofiles)) (defun gnus-uu-get-action (file-name) (let (action) @@ -1448,23 +909,11 @@ ARG delimits the number of files to be decoded." (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 gnus-uu-use-interactive-view - (append gnus-uu-user-interactive-view-rules-end - (if gnus-uu-ignore-default-view-rules - () - gnus-uu-default-interactive-view-rules-end)) - gnus-uu-user-view-rules-end)))) + gnus-uu-user-view-rules-end))) (if (and (not (string= (or action "") "gnus-uu-archive")) gnus-uu-view-with-metamail) (if (setq action @@ -1472,91 +921,28 @@ ARG delimits the number of files to be decoded." (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) -; `gnus-uu-call-synchronous' 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. -(defun gnus-uu-call-synchronous (file-name action) - (let (did-view command) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer) - (setq command (gnus-uu-command action file-name)) - (message "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)) - -; `gnus-uu-call-asyncronous' 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. -(defun gnus-uu-call-asynchronous (file-name action) - (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-work-dir file)) - (if (string= tmp-file file-name) - () - (rename-file file-name tmp-file t) - (setq file-name tmp-file)) - - (setq command (gnus-uu-command action file-name)) - (setq command (format "%s ; rm -f %s" command file-name)) - (message "Viewing with %s" command) - (start-process "gnus-uu-view" nil "sh" "-c" command) - t)) - -; `gnus-uu-decode-and-strip' 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', which will -; (probably) unshar the articles. If use-marked is non-nil, it won't -; try to find articles, but use the marked list. -(defun gnus-uu-decode-and-strip (&optional shar use-marked limit) - (let (list-of-articles) - (save-excursion - (if use-marked - (if (not gnus-uu-marked-article-list) - (message "No articles marked") - (setq list-of-articles (reverse gnus-uu-marked-article-list)) - (setq gnus-uu-marked-article-list nil)) - (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) - t limit))))) - -; 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." +;; 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. (let ((count 2) (vernum "v[0-9]+[a-z][0-9]+:") - reg beg) + 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) @@ -1586,139 +972,130 @@ ARG delimits the number of files to be decoded." (buffer-substring 1 (point-max))))) -; Finds all articles that matches the regular expression given. -; Returns the resulting list. SUBJECT is the regular expression to be -; matched. If it is nil, the current article name will be used. If -; MARK-ARTICLES is non-nil, articles found are marked. If ONLY-UNREAD -; is non-nil, only unread articles are chose. If DO-NOT-TRANSLATE is -; non-nil, article names are not equialized before sorting. -(defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread do-not-translate) - (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-article-subject)))) + 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)) - (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 - (not do-not-translate))) - -; 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)))) - - list-of-numbers))) + (if (not subject) + () + ;; Collect all subjects matching subject. + (let ((case-fold-search t) + (data gnus-newsgroup-data) + subj mark d) + (while data + (setq d (pop data)) + (and (not (gnus-data-pseudo-p d)) + (or (not only-unread) + (= (setq mark (gnus-data-mark d)) + gnus-unread-mark) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark)) + (setq subj (mail-header-subject (gnus-data-header d))) + (string-match subject subj) + (setq list-of-subjects + (cons (cons subj (gnus-data-number d)) + list-of-subjects))))) + + ;; 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<)))))) -; 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. (defun gnus-uu-expand-numbers (string-list &optional translate) - (let (string out-list pos num) + ;; 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 (caar string-list)) + ;; Translate multiple spaces to one space. + (goto-char (point-min)) (while (re-search-forward "[ \t]+" nil t) (replace-match " ")) - (goto-char 1) + ;; 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))) - - (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))))) + ;; 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)) -; Used in a sort for finding out what string is bigger, but ignoring -; everything before the subject part. -(defun gnus-uu-string< (string1 string2) - (string< (substring string1 (string-match "\\] " string1)) - (substring string2 (string-match "\\] " string2)))) - - -;; gnus-uu-grab-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. This result is then appended on to -; the `gnus-uu-result-buffer'. Most treatment functions will just -; generate files... -; -; 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 + +;; `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. +;; +;; 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 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) @@ -1732,265 +1109,298 @@ ARG delimits the number of files to be decoded." (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)))))) - -; 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'. -; -; 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 (list-of-articles process-function &optional sloppy limit) - (let ((result-buffer (get-buffer-create gnus-uu-result-buffer)) - (state 'first) - (wrong-type t) - has-been-begin has-been-end - article result-file result-files process-state) - - (save-excursion - (set-buffer result-buffer) - (erase-buffer)) - (setq gnus-uu-has-been-grabbed nil) - - (while (and list-of-articles +;; 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 + gnus-summary-display-article-function + gnus-article-display-hook gnus-article-prepare-hook + article-series files) + + (while (and articles (not (memq 'error process-state)) (or sloppy (not (memq 'end process-state)))) - (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 (> article gnus-uu-highest-article-number) - (setq gnus-uu-highest-article-number article)) - - (if (eq list-of-articles ()) - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) - - (message "Getting article %d" article) - (if (not (= (or gnus-current-article 0) article)) - (gnus-summary-display-article article)) - (gnus-summary-mark-as-read article) - - (save-excursion (set-buffer gnus-article-buffer) (widen)) - - (setq process-state (funcall process-function gnus-article-buffer state)) - -; (message "process-state er %s" process-state)(sleep-for 3) - - (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 (file-exists-p result-file) (delete-file result-file))) - (setq result-file (car process-state)) - (setq has-been-begin t) - (setq has-been-end nil))) - - (if (memq 'end process-state) - (progn - (setq gnus-uu-has-been-grabbed nil) - (setq result-files (cons result-file result-files)) - (setq has-been-end t) - (setq has-been-begin nil) - (if (and limit (= (length result-files) limit)) - (progn - (setq list-of-articles nil) - (setq gnus-uu-marked-article-list 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))) - - (setq result-file nil) + (setq article (pop articles)) + (push article article-series) - (if (not (memq 'wrong-type process-state)) - (setq wrong-type nil) - (if gnus-uu-unmark-articles-not-decoded - (gnus-summary-mark-as-unread article t))) - - (if sloppy (setq wrong-type nil)) + (unless articles + (if (eq state 'first) + (setq state 'first-and-last) + (setq state 'last))) + (let ((part (gnus-uu-part-number article))) + (gnus-message 6 "Getting article %d%s..." + article (if (string= part "") "" (concat ", " part)))) + (gnus-summary-display-article article) + + ;; Push the article to the processing function. + (save-excursion + (set-buffer gnus-original-article-buffer) + (let ((buffer-read-only nil)) + (save-excursion + (set-buffer gnus-summary-buffer) + (setq process-state + (funcall process-function + gnus-original-article-buffer state))))) + + (gnus-summary-remove-process-mark article) + + ;; If this is the beginning of a decoded file, we push it + ;; on to a list. + (when (or (memq 'begin process-state) + (and (or (eq state 'first) + (eq state 'first-and-last)) + (memq 'ok process-state))) + (if has-been-begin + ;; If there is a `result-file' here, that means that the + ;; file was unsuccessfully decoded, so we delete it. + (when (and result-file + (file-exists-p result-file)) + (delete-file result-file))) + (when (memq 'begin process-state) + (setq result-file (car process-state))) + (setq has-been-begin t)) + + ;; Check whether we have decoded one complete file. + (when (memq 'end process-state) + (setq article-series nil) + (setq has-been-begin nil) + (if (stringp result-file) + (setq files (list result-file)) + (setq files result-file)) + (setq result-file (car files)) + (while files + (push (list (cons 'name (pop files)) + (cons 'article article)) + result-files)) + ;; Allow user-defined functions to be run on this file. + (when gnus-uu-grabbed-file-functions + (let ((funcs gnus-uu-grabbed-file-functions)) + (unless (listp funcs) + (setq funcs (list funcs))) + (while funcs + (funcall (pop funcs) result-file)))) + ;; Check whether we have decoded enough articles. + (and limit (= (length result-files) limit) + (setq articles nil))) + + ;; If this is the last article to be decoded, and + ;; we still haven't reached the end, then we delete + ;; the partially decoded file. + (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state)) + result-file + (file-exists-p result-file) + (delete-file result-file)) + + ;; If this was a file of the wrong sort, then + (when (and (or (memq 'wrong-type process-state) + (memq 'error process-state)) + gnus-uu-unmark-articles-not-decoded) + (gnus-summary-tick-article article t)) + + ;; Set the new series state. (if (and (not has-been-begin) (not sloppy) (or (memq 'end process-state) (memq 'middle process-state))) (progn (setq process-state (list 'error)) - (message "No begin part at the beginning") + (gnus-message 2 "No begin part at the beginning") (sleep-for 2)) (setq state 'middle))) + ;; When there are no result-files, then something must be wrong. (if result-files - () - (if (not has-been-begin) - (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 - (message "End of articles reached before end of file") - (setq result-files nil)) - (gnus-uu-unmark-list-of-grabbed))))) - (setq gnus-uu-list-of-files-decoded result-files) + (message "") + (cond + ((not has-been-begin) + (gnus-message 2 "Wrong type file")) + ((memq 'error process-state) + (gnus-message 2 "An error occurred during decoding")) + ((not (or (memq 'ok process-state) + (memq 'end process-state))) + (gnus-message 2 "End of articles reached before end of file"))) + ;; Make unsuccessfully decoded articles unread. + (when gnus-uu-unmark-articles-not-decoded + (while article-series + (gnus-summary-tick-article (pop article-series) t)))) + result-files)) +(defun gnus-uu-grab-view (file) + "View FILE using the gnus-uu methods." + (let ((action (gnus-uu-get-action file))) + (gnus-execute-command + (if (string-match "%" action) + (format action file) + (concat action " " file)) + (eq gnus-view-pseudos 'not-confirm)))) + +(defun gnus-uu-grab-move (file) + "Move FILE to somewhere." + (when gnus-uu-default-dir + (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) + (file-name-nondirectory file)))) + (rename-file file to-file) + (unless (file-exists-p file) + (make-symbolic-link to-file file))))) + +(defun gnus-uu-part-number (article) + (let* ((header (gnus-summary-article-header article)) + (subject (and header (mail-header-subject header)))) + (if (and subject + (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) + (match-string 0 subject) + ""))) + (defun gnus-uu-uudecode-sentinel (process event) (delete-process (get-process process))) -; Uudecodes a file asynchronously. -(defun gnus-uu-uustrip-article-as (process-buffer in-state) - (let ((state (list 'ok)) - (process-connection-type nil) - start-char pst name-beg name-end) - (save-excursion - (set-buffer process-buffer) - (let ((case-fold-search nil) - (buffer-read-only nil)) - - (goto-char 1) +(defun gnus-uu-uustrip-article (process-buffer in-state) + ;; Uudecodes a file asynchronously. + (save-excursion + (set-buffer process-buffer) + (let ((state (list 'wrong-type)) + process-connection-type case-fold-search buffer-read-only + files start-char) + (goto-char (point-min)) + + ;; Deal with ^M at the end of the lines. + (when gnus-uu-kill-carriage-return + (save-excursion + (while (search-forward "\r" nil t) + (delete-backward-char 1)))) - (if gnus-uu-kill-carriage-return - (progn - (while (search-forward "\r" nil t) - (delete-backward-char 1)) - (goto-char 1))) - - (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)))) - - (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)) - - ; Replace any slashes and spaces in file names before decoding - (goto-char (setq name-beg (match-beginning 1))) - (while (re-search-forward "/" name-end t) - (replace-match ",")) - (goto-char name-beg) - (while (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)))) - (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)) + (while (or (re-search-forward gnus-uu-begin-string nil t) + (re-search-forward gnus-uu-body-line nil t)) + (setq state (list 'ok)) + ;; Ok, we are at the first uucoded line. + (beginning-of-line) + (setq start-char (point)) - (re-search-backward - (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) - (beginning-of-line) + (if (not (looking-at gnus-uu-begin-string)) + (setq state (list 'middle)) + ;; This is the beginning of an uuencoded article. + ;; We replace certain characters that could make things messy. + (setq gnus-uu-file-name + (let ((nnheader-file-name-translation-alist + '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + (nnheader-translate-file-chars (match-string 1)))) - (if (looking-at gnus-uu-end-string) - (setq state (cons 'end state))) + ;; Remove any non gnus-uu-body-line right after start. (forward-line 1) + (while (and (not (eobp)) + (not (looking-at gnus-uu-body-line))) + (gnus-delete-line)) + + ;; If a process is running, we kill it. + (when (and gnus-uu-uudecode-process + (memq (process-status gnus-uu-uudecode-process) + '(run stop))) + (delete-process gnus-uu-uudecode-process) + (gnus-uu-unmark-list-of-grabbed t)) + + ;; Start a new uudecoding process. + (setq gnus-uu-uudecode-process + (start-process + "*uudecode*" + (get-buffer-create gnus-uu-output-buffer-name) + shell-file-name shell-command-switch + (format "cd %s ; uudecode" gnus-uu-work-dir))) + (set-process-sentinel + gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) + (setq state (list 'begin)) + (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) + + ;; We look for the end of the thing to be decoded. + (if (re-search-forward gnus-uu-end-string nil t) + (setq state (cons 'end state)) + (goto-char (point-max)) + (re-search-backward gnus-uu-body-line nil t)) + + (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 err - (process-send-region gnus-uu-uudecode-process - start-char (point)) - (error - (progn - (message "gnus-uu: Couldn't uudecode") - (sleep-for 2) - (setq state (list 'wrong-type)) - (delete-process gnus-uu-uudecode-process)))) - (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))))) + (when gnus-uu-uudecode-process + (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) + ;; Try to correct mishandled uucode. + (when gnus-uu-correct-stripped-uucode + (gnus-uu-check-correct-stripped-uucode start-char (point))) + + ;; Send the text to the process. + (condition-case nil + (process-send-region + gnus-uu-uudecode-process start-char (point)) + (error + (progn + (delete-process gnus-uu-uudecode-process) + (gnus-message 2 "gnus-uu: Couldn't uudecode") + (setq state (list 'wrong-type))))) + + (if (memq 'end state) + (progn + ;; Send an EOF, just in case. + (condition-case () + (process-send-eof gnus-uu-uudecode-process) + (error nil)) + (while (memq (process-status gnus-uu-uudecode-process) + '(open run)) + (accept-process-output gnus-uu-uudecode-process 1))) + (when (or (not gnus-uu-uudecode-process) + (not (memq (process-status gnus-uu-uudecode-process) + '(run stop)))) + (setq state (list 'wrong-type))))))) (if (memq 'begin state) - (cons (concat gnus-uu-work-dir gnus-uu-file-name) state) + (cons (if (= (length files) 1) (car files) files) state) state)))) -; This function is used by `gnus-uu-grab-articles' to treat -; a shared article. +;; This function is used by `gnus-uu-grab-articles' to treat +;; a shared article. (defun gnus-uu-unshar-article (process-buffer in-state) (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 (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-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) shell-file-name nil + (get-buffer-create gnus-uu-output-buffer-name) nil + shell-command-switch (concat "cd " gnus-uu-work-dir " ; sh")))) state)) -; Returns the name of what the shar file is going to unpack. +;; Returns the name of what the shar file is going to unpack. (defun gnus-uu-find-name-in-shar () (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)) -; Returns the article number of the given subject. -(defun gnus-uu-article-number (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)))) - -; `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. +;; `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) (and (or no-ignore @@ -2007,75 +1417,13 @@ ARG delimits the number of files to be decoded." (setq rule (car action-list)) (setq action-list (cdr action-list)) (if (string-match (car rule) file-name) - (setq action (car (cdr rule)))))) + (setq action (cadr rule))))) action)) -(defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing) - (let (dir file-name command files file) - (setq files (directory-files from-dir t)) - (if default-dir - (setq dir default-dir) - (setq dir (gnus-uu-read-directory - (concat "Where do you want the file" - (if (< 3 (length files)) "s" "") "? ")))) - - (while files - (setq file (car files)) - (setq files (cdr files)) - (string-match "/[^/]*$" file) - (setq file-name (substring file (1+ (match-beginning 0)))) - (if (string-match "^\\.\\.?$" file-name) - () - (if (and (not ignore-existing) (file-exists-p (concat dir file-name))) - (setq file-name - (read-file-name "File exists. Enter a new name: " dir - (concat dir file-name) nil file-name)) - (setq file-name (concat dir file-name))) - (rename-file file file-name t))))) - -; Moves the file from the tmp directory to where the user wants it. -(defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing) - (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))) - (setq file-name - (read-file-name "File exist. Enter 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 "/")))) - -; Unpacks an archive and views all the files in it. Returns t if -; viewing one or more files is successful. (defun gnus-uu-treat-archive (file-path) + ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) - action command files file file-name dir) + action command dir) (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules @@ -2085,10 +1433,9 @@ ARG delimits the number of files to be decoded." (if (not action) (error "No unpackers for the file %s" file-path)) (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) (setq dir (substring file-path 0 (match-beginning 0))) - (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) + (if (member action gnus-uu-destructive-archivers) (copy-file file-path (concat file-path "~") t)) (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) @@ -2097,302 +1444,159 @@ ARG delimits the number of files to be decoded." (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (erase-buffer)) - (message "Unpacking: %s..." (gnus-uu-command action file-path)) + (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - (if (= 0 (call-process "sh" nil + (if (= 0 (call-process shell-file-name nil (get-buffer-create gnus-uu-output-buffer-name) - nil "-c" command)) + nil shell-command-switch command)) (message "") - (if (not gnus-uu-use-interactive-view) - (progn - (message "Error during unpacking of archive") - (sleep-for 2))) + (gnus-message 2 "Error during unpacking of archive") (setq did-unpack nil)) - (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) + (if (member action gnus-uu-destructive-archivers) (rename-file (concat file-path "~") file-path t)) did-unpack)) -; Tries to view all the files in the given directory. Returns t if -; viewing one or more files is successful. -(defun gnus-uu-view-directory (dir &optional dont-delete-files not-top) - (let ((first t) - files file did-view ignore-files) - (setq files (directory-files dir t "[^/][^\\.][^\\.]?$")) - (gnus-uu-add-file files) - (setq ignore-files files) - - (while (gnus-uu-unpack-archives - files (if not-top (list ".") - (if first () ignore-files))) - (setq first nil) - (gnus-uu-add-file - (setq files (directory-files dir t "[^/][^\\.][^\\.]?$")))) - - (gnus-uu-add-file (directory-files dir t "[^/][^\\.][^\\.]?$")) - +(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) (while files - (setq file (car files)) - (setq files (cdr files)) - (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive")) + (setq file (cdr (assq 'name (car files)))) + (if (and (not (member file ignore)) + (equal (gnus-uu-get-action (file-name-nondirectory file)) + "gnus-uu-archive")) (progn - (set-file-modes file 448) - (if (file-directory-p file) - (setq did-view (or (gnus-uu-view-directory file - dont-delete-files - t) - did-view)) - (setq did-view (or (gnus-uu-view-file file t) did-view))))) - (if (and (not dont-delete-files) (not gnus-uu-asynchronous) - (file-exists-p file)) - (delete-file file))) - - (if (and (not gnus-uu-asynchronous) (not dont-delete-files)) - (if (string-match "/$" dir) - (delete-directory (substring dir 0 (match-beginning 0))) - (delete-directory dir))) - did-view)) - -(defun gnus-uu-unpack-archives (files &optional ignore) - (let (path did-unpack) - (while files - (setq path (car files)) - (setq files (cdr files)) - (if (not (gnus-uu-string-in-list path ignore)) - (if (string= (or (gnus-uu-get-action - (gnus-uu-name-from-path path)) "") - "gnus-uu-archive") - (progn - (if (and (not (setq did-unpack (gnus-uu-treat-archive path))) - gnus-uu-use-interactive-view) - (gnus-uu-enter-interactive-file - "# error during unpacking of" path)) - (if ignore (delete-file path)))))) - did-unpack)) - - -;; Manual marking - -(defun gnus-uu-enter-mark-in-list () - (let (article beg) - (save-excursion - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq article (gnus-uu-article-number - (buffer-substring beg (point)))) - (message "Adding article %d to list" article) - (setq gnus-uu-marked-article-list - (cons article gnus-uu-marked-article-list))))) - -(defun gnus-uu-mark-article (&optional dont-move) - "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 "Removing article %d" article) - (while in - (if (not (= (car in) article)) - (setq out (cons (car in) out)) - (setq found t) - (message "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))) - -(defun gnus-uu-unmark-all-articles () - "Removes the mark from all articles marked for decoding." - (interactive) - (while gnus-uu-marked-article-list - (gnus-summary-goto-subject (car gnus-uu-marked-article-list)) - (gnus-summary-mark-as-unread nil t) - (setq gnus-uu-marked-article-list (cdr gnus-uu-marked-article-list)))) - -(defun gnus-uu-mark-by-regexp () - "Asks for a regular expression and marks all articles that match." - (interactive) - (let (exp) - (setq exp (read-from-minibuffer "Mark (regexp): ")) - (setq gnus-uu-marked-article-list - (append gnus-uu-marked-article-list - (reverse (gnus-uu-get-list-of-articles exp t)))) - (message ""))) - -(defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." - (interactive) - (beginning-of-line) - (let (level) - (if (not (search-forward ":" nil t)) - () - (setq level (current-column)) - (gnus-uu-enter-mark-in-list) - (gnus-summary-mark-as-read nil ?#) - (gnus-summary-search-forward) - (while (< level (current-column)) - (gnus-uu-enter-mark-in-list) - (gnus-summary-mark-as-read nil ?#) - (gnus-summary-search-forward)) - (gnus-summary-search-backward)))) + (setq did-unpack (cons file did-unpack)) + (or (gnus-uu-treat-archive file) + (gnus-message 2 "Error during unpacking of %s" file)) + (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) + (nfiles 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-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)) ;; Various stuff -(defun gnus-uu-string-in-list (string list) - (while (and list - (not (string= (car list) string)) - (setq list (cdr list)))) - list) - -(defun gnus-uu-name-from-path (path) - (string-match "/[^/]*$" path) - (substring path (1+ (match-beginning 0)))) - -(defun gnus-uu-directory-files (dir) +(defun gnus-uu-directory-files (dir &optional full) (let (files out file) - (setq files (directory-files dir t)) + (setq files (directory-files dir full)) (while files (setq file (car files)) (setq files (cdr files)) - (if (not (string-match "/\\.\\.?$" file)) + (or (member (file-name-nondirectory file) '("." "..")) (setq out (cons file out)))) - (setq out (reverse out)) + (setq out (nreverse out)) out)) (defun gnus-uu-check-correct-stripped-uucode (start end) - (let (found beg length short) - (if (not gnus-uu-correct-stripped-uucode) - () - (goto-char start) + (save-excursion + (let (found beg length) + (if (not gnus-uu-correct-stripped-uucode) + () + (goto-char start) - (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) + (if (re-search-forward " \\|`" end t) + (progn + (goto-char start) + (while (not (eobp)) (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)))))) - -(defun gnus-uu-initialize () - (setq gnus-uu-highest-article-number 1) - (gnus-uu-check-for-generated-files) - (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir)) - (if (string-match "[^/]$" gnus-uu-tmp-dir) - (setq gnus-uu-tmp-dir (concat 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 - (concat gnus-uu-tmp-dir (make-temp-name "gnus"))) - (gnus-uu-add-file gnus-uu-work-dir) - (if (not (file-directory-p gnus-uu-work-dir)) - (make-directory gnus-uu-work-dir)) - (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")) - (setq gnus-uu-interactive-file-list nil)) - -; Kills the temporary uu buffers, kills any processes, etc. + (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"))) + (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 () (let (buf pst) (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 (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)) + (memq (process-status (or gnus-uu-uudecode-process "nevair")) + '(stop 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 () - (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) - (setq dirs (cons file dirs)) - (if (file-exists-p 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) - (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)))) - -; Go to the next unread subject. If there is no further unread -; subjects, go to the last subject in the buffer. -(defun gnus-uu-summary-next-subject () - (let (opi) - (if (not (gnus-summary-search-forward t)) - (progn - (goto-char 1) - (sit-for 0) - (gnus-summary-goto-subject gnus-uu-highest-article-number))) - - ; You may well find all this a bit puzzling - so do I, but I seem - ; to have to do something like this to move to the next unread article, - ; as `sit-for' seems to do some rather strange things here. Might - ; be a bug in my head, probably. - (setq opi (point)) - (sit-for 0) - (goto-char opi) - (gnus-summary-recenter))) - -; Inputs an action and a file and returns a full command, putting -; ticks round the file name and escaping any ticks in the file name. +;; 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) + (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file) (progn (setq ofile (concat ofile (substring file 0 (match-beginning 0)) "\\" @@ -2403,244 +1607,39 @@ ARG delimits the number of files to be decoded." (format action ofile) (concat action " " ofile)))) +(defun gnus-uu-delete-work-dir (&optional dir) + "Delete recursively all files and directories under `gnus-uu-work-dir'." + (if dir + (gnus-message 7 "Deleting directory %s..." dir) + (setq dir gnus-uu-work-dir)) + (when (and dir + (file-exists-p dir)) + (let ((files (directory-files dir t nil t)) + file) + (while (setq file (pop files)) + (unless (member (file-name-nondirectory file) '("." "..")) + (if (file-directory-p file) + (gnus-uu-delete-work-dir file) + (gnus-message 9 "Deleting file %s..." file) + (delete-file file)))) + (delete-directory dir))) + (gnus-message 7 "")) ;; 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) -(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) - (define-key gnus-uu-mode-map "\C-c\C-r" 'gnus-uu-interactive-rescan-directory) - (define-key gnus-uu-mode-map "\C-cr" 'gnus-uu-interactive-scan-directory) - ) - -(defun gnus-uu-interactive-set-up-windows () - (let (int-buf out-buf) - (set-buffer - (setq int-buf (get-buffer-create gnus-uu-interactive-buffer-name))) - (if (not (get-buffer-window int-buf)) - (switch-to-buffer-other-window int-buf)) - (pop-to-buffer int-buf) - (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) - (if (not (get-buffer-window out-buf)) - (progn - (setq gnus-uu-output-window - (split-window nil (- (window-height) - gnus-uu-output-window-height))) - (set-window-buffer gnus-uu-output-window out-buf))))) - -(defun gnus-uu-do-interactive (&optional dont-do-windows) - (if (not gnus-uu-interactive-file-list) - (gnus-uu-enter-interactive-file "#" "")) - (if (not dont-do-windows) (gnus-uu-interactive-set-up-windows)) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) - (goto-char 1) - (forward-line 3) - (run-hooks 'gnus-uu-mode-hook)) - -(defun gnus-uu-enter-interactive-file (action file) - (let (command) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) - (if (not gnus-uu-interactive-file-list) - (progn - (erase-buffer) - (gnus-uu-mode) - (insert - "# Press return to execute a command. -# Press `C-c C-c' to exit interactive view. - -"))) - (setq gnus-uu-interactive-file-list - (cons file gnus-uu-interactive-file-list)) -; (if (string-match (concat "^" gnus-uu-work-dir) file) -; (setq file (substring file (match-end 0)))) - (setq command (gnus-uu-command action file)) - (goto-char (point-max)) - (insert (format "%s\n" command))))) - -(defun gnus-uu-interactive-execute () - "Executes the command on the current line in interactive mode." - (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))) - (setq command (format "cd %s ; %s" gnus-uu-work-dir 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 "")) - (end-of-line) - (if (= (forward-line 1) 1) - (progn - (end-of-line) - (insert "\n"))) - (beginning-of-line))) -(defun gnus-uu-interactive-end () - "This function exits 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))) - - -(defun gnus-uu-interactive-scan-directory (dir) - "Read any directory and view the files. -When used in interactive mode, the files and commands will be displayed, -as usual, in the interactive mode buffer." - (interactive "DDirectory: ") - (setq gnus-uu-interactive-file-list nil) - (gnus-uu-view-directory dir gnus-uu-use-interactive-view) - (gnus-uu-do-interactive t)) - -(defun gnus-uu-interactive-rescan-directory () - "Reread the directory and view the files. -When used in interactive mode, the files and commands will be displayed, -as usual, in the interactive mode buffer." - (interactive) - (gnus-uu-interactive-scan-directory gnus-uu-work-dir)) +(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) +(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) -(defun gnus-uu-interactive-save-original-file () - "Saves the file from whence the file on the current line came from." - (interactive) - (let ((files gnus-uu-list-of-files-decoded) - (filestr "") - file did dir) - (while files - (setq file (car files)) - (setq files (cdr files)) - (if (file-exists-p file) - (progn - (if (not did) - (progn - (setq dir (gnus-uu-read-directory - (format "Where do you want the file%s? " - (if (> (length files) 1) "s" "")))) - (setq did t))) - (setq filestr (concat filestr (gnus-uu-name-from-path file) " ")) - (gnus-uu-save-file file dir t))) - (if did - (message "Saved %s" filestr) - (message "Already saved."))))) - -(defun gnus-uu-interactive-save-current-file-silent () - "Saves the file referred to on the current line in the current directory." - (interactive) - (gnus-uu-interactive-save-current-file t)) + -(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))))) - -(defun gnus-uu-interactive-save-all-files () - "Saves all files referred to in the interactive buffer." - (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 -\\[gnus-uu-interactive-end]\tEnd interactive mode -\\[gnus-uu-interactive-save-current-file]\tSave the current file -\\[gnus-uu-interactive-save-current-file-silent]\tSave the current file without asking -\twhere to put it -\\[gnus-uu-interactive-save-all-files]\tSave all files -\\[gnus-uu-interactive-save-original-file]\tSave the original file: If the files -\toriginated in an archive, the archive -\tfile is saved. -\\[gnus-uu-interactive-rescan-directory]\tRescan the directory -\\[gnus-uu-interactive-scan-directory]\tScan any directory -" - (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) - - -;; Major mode for posting encoded articles. - -(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. +;;; +;;; uuencoded posting +;;; + +;; 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: @@ -2652,7 +1651,7 @@ 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.") +\\[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. @@ -2673,180 +1672,71 @@ 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.") -(defconst gnus-uu-post-binary-separator "--binary follows this line--") +(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) -; The following map and mode was taken from rnewspost.el and edited -; somewhat. -(defvar gnus-uu-post-reply-mode-map () "Mode map used by gnus-uu-post-reply.") -(or gnus-uu-post-reply-mode-map - (progn - (setq gnus-uu-post-reply-mode-map (make-keymap)) - (define-key gnus-uu-post-reply-mode-map "\C-c?" 'describe-mode) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-d" - 'news-reply-distribution) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-k" - 'news-reply-keywords) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-n" - 'news-reply-newsgroups) - - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-f" - 'news-reply-followup-to) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-s" 'mail-subject) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-a" - 'gnus-uu-post-reply-summary) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-r" - 'news-caesar-buffer-body) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-w" 'news-reply-signature) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-y" - 'news-reply-yank-original) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-q" - 'mail-fill-yanked-message) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-c" - 'gnus-uu-post-news-inews) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-s" - 'gnus-uu-post-news-inews) - (define-key gnus-uu-post-reply-mode-map "\C-c\C-i" - 'gnus-uu-post-insert-binary-in-article) - )) - -; This mode was taken from rnewspost.el and modified slightly. -(defun gnus-uu-post-reply-mode () - "Major mode for editing binary news to be posted on USENET. -First-time posters are asked to please read the articles in newsgroup: - news.announce.newusers . - -Like news-reply-mode, which is like Text Mode, but with these -additional commands: - -\\\\[gnus-uu-post-news-inews] post the message. -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: - C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: - C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: -C-c C-y news-reply-yank-original (insert current message, in NEWS). -C-c C-q mail-fill-yanked-message (fill what was yanked). -C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). -\\[gnus-uu-post-insert-binary-in-article] encode and include a file in this article. - -This mode is almost identical to news-reply-mode, but has some -additional commands for treating encoded binary articles. In -particular, \\[gnus-uu-post-news-inews] will ask for a file to include, if -one hasn't been included already. It will post, first, the message -composed, and then it will post as many additional articles it takes -to post the entire encoded files. - - Relevant Variables - - `gnus-uu-post-encode-method' - 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. - - `gnus-uu-post-include-before-composing' - 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 `C-c C-i' or have one included for you when you - post the article. - - `gnus-uu-post-length' - Maximum length of an article. The encoded file will be split into how - many articles it takes to post the entire file. - - `gnus-uu-post-separate-description' - 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. - - `gnus-uu-post-threaded' - 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. -" - (interactive) - ;; require... - (or (fboundp 'mail-setup) (load "sendmail")) - (kill-all-local-variables) - (make-local-variable 'mail-reply-buffer) - (setq mail-reply-buffer nil) - (set-syntax-table text-mode-syntax-table) - (use-local-map gnus-uu-post-reply-mode-map) - (setq local-abbrev-table text-mode-abbrev-table) - (setq major-mode 'gnus-uu-post-reply-mode) - (setq mode-name "Gnus UU News") - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^" mail-header-separator "$\\|" - paragraph-start)) - (setq paragraph-separate (concat "^" mail-header-separator "$\\|" - paragraph-separate)) - (run-hooks 'text-mode-hook 'gnus-uu-post-reply-mode-hook)) - (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)) - (let (news-reply-mode) - (fset 'news-reply-mode 'gnus-uu-post-reply-mode) - (gnus-summary-post-news) - (if gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary)))))) + + (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-post-insert-binary-in-article () "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) - (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. +;; 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 1) + (goto-char (point-min)) (forward-line 1) (while (re-search-forward " " nil t) (replace-match "`")) t))) -; Encodes with uuencode and adds MIME headers. +;; 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))) -; Encodes with base64 and adds MIME headers +;; 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. +;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) - (goto-char 1) + (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 1) - (re-search-forward mail-header-separator) - (beginning-of-line) + (set-buffer gnus-message-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") @@ -2855,18 +1745,16 @@ The user will be asked for a file name." (insert "MIME-Version: 1.0\n"))) (widen))) -; Encodes a file PATH with COMMAND, leaving the result in the -; current buffer. +;; 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" + (= 0 (call-process shell-file-name nil t nil shell-command-switch (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) - (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) - (error "Not in post news buffer")) (let (file-name) @@ -2875,11 +1763,11 @@ If no file has been included, the user will be asked for a file." (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 elem) + (let ((message-required-news-headers + (if (memq 'Message-ID message-required-news-headers) + message-required-news-headers + (cons 'Message-ID message-required-news-headers))) + gnus-inews-article-hook) (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) gnus-inews-article-hook @@ -2888,7 +1776,7 @@ If no file has been included, the user will be asked for a file." (cons '(lambda () (save-excursion - (goto-char 1) + (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) (setq gnus-uu-post-message-id (buffer-substring @@ -2901,11 +1789,11 @@ If no file has been included, the user will be asked for a file." (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. +;; 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 post-buf uubuf file-name) + file-path uubuf file-name) (setq file-path (read-file-name "What file do you want to encode? ")) @@ -2927,27 +1815,28 @@ If no file has been included, the user will be asked for a file." (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer uubuf) + (insert-buffer-substring uubuf) (error "Encoding unsuccessful")) (kill-buffer uubuf)) file-name)) -; Posts the article and all of the encoded file. +;; 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")) - file uubuf length parts header i end beg + 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 1) + (goto-char (point-min)) (if (not (re-search-forward (if gnus-uu-post-separate-description - gnus-uu-post-binary-separator - mail-header-separator) nil t)) + (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) @@ -2958,7 +1847,7 @@ If no file has been included, the user will be asked for a file." (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) - (goto-char 1) + (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)) @@ -2968,19 +1857,20 @@ If no file has been included, the user will be asked for a file." (forward-line -1)) (kill-region (point) (point-max)) - (goto-char 1) - (search-forward mail-header-separator nil t) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (setq header (buffer-substring 1 (point))) - (goto-char 1) + (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)) + (message-send)) (save-excursion (setq i 1) @@ -3004,7 +1894,7 @@ If no file has been included, the user will be asked for a file." (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) - (goto-char 1) + (goto-char (point-min)) (if (not (re-search-forward "^Subject: " nil t)) () (if (not threaded) @@ -3030,17 +1920,21 @@ If no file has been included, the user will be asked for a file." (insert "\n") (setq beg end) (setq i (1+ i)) - (goto-char 1) - (re-search-forward mail-header-separator nil t) + (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 gnus-uu-post-binary-separator nil t) + (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))) + (let (message-sent-message-via) + (message-send)))) (and (setq buf (get-buffer send-buffer-name)) (kill-buffer buf))