summaryrefslogtreecommitdiff
path: root/lisp/gnus/gnus-uu.el
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen <larsi@gnus.org>1997-04-16 22:13:18 +0000
committerLars Magne Ingebrigtsen <larsi@gnus.org>1997-04-16 22:13:18 +0000
commiteec82323c2e3610907cf66ece372b1920318d460 (patch)
tree32644b3629fd9785a93992838f4101441187bdfd /lisp/gnus/gnus-uu.el
parentefac8cf18990be73c8e67fa8edb9af9028cf0878 (diff)
downloademacs-eec82323c2e3610907cf66ece372b1920318d460.tar.gz
Initial revision
Diffstat (limited to 'lisp/gnus/gnus-uu.el')
-rw-r--r--lisp/gnus/gnus-uu.el2063
1 files changed, 2063 insertions, 0 deletions
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
new file mode 100644
index 00000000000..9b33e4f0eed
--- /dev/null
+++ b/lisp/gnus/gnus-uu.el
@@ -0,0 +1,2063 @@
+;;; gnus-uu.el --- extract (uu)encoded files in Gnus
+;; Copyright (C) 1985,86,87,93,94,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Created: 2 Oct 1993
+;; Keyword: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-art)
+(require 'message)
+(require 'gnus-msg)
+
+(defgroup gnus-extract nil
+ "Extracting encoded files."
+ :prefix "gnus-uu-"
+ :group 'gnus)
+
+(defgroup gnus-extract-view nil
+ "Viewwing extracted files."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-archive nil
+ "Extracting encoded archives."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-post nil
+ "Extracting encoded archives."
+ :prefix "gnus-uu-post"
+ :group 'gnus-extract)
+
+;; Default viewing action rules
+
+(defcustom gnus-uu-default-view-rules
+ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
+ ("\\.pas$" "cat %s | sed s/\r//g")
+ ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
+ ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
+ ("\\.tga$" "tgatoppm %s | xv -")
+ ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
+ "sox -v .5 %s -t .au -u - > /dev/audio")
+ ("\\.au$" "cat %s > /dev/audio")
+ ("\\.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.
+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:
+
+ (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
+regular expression, the command in the second string is executed with
+the file as an argument.
+
+If the command string contains \"%s\", the file name will be inserted
+at that point in the command string. If there's no \"%s\" in the
+command string, the file name will be appended to the command string
+before executing.
+
+There are several user variables to tailor the behaviour of gnus-uu to
+your needs. First we have `gnus-uu-user-view-rules', which is the
+variable gnus-uu first consults when trying to decide how to view a
+file. If this variable contains no matches, gnus-uu examines the
+default rule variable provided in this package. If gnus-uu finds no
+match here, it uses `gnus-uu-user-view-rules-end' to try to make a
+match."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules nil
+ "What actions are to be taken to view a file.
+See the documentation on the `gnus-uu-default-view-rules' variable for
+details."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules-end
+ '(("" "file"))
+ "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."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+;; Default unpacking commands
+
+(defcustom gnus-uu-default-archive-rules
+ '(("\\.tar$" "tar xf")
+ ("\\.zip$" "unzip -o")
+ ("\\.ar$" "ar x")
+ ("\\.arj$" "unarj x")
+ ("\\.zoo$" "zoo -e")
+ ("\\.\\(lzh\\|lha\\)$" "lha x")
+ ("\\.Z$" "uncompress")
+ ("\\.gz$" "gunzip")
+ ("\\.arc$" "arc -x"))
+ "See `gnus-uu-user-archive-rules'."
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defvar gnus-uu-destructive-archivers
+ (list "uncompress" "gunzip"))
+
+(defcustom gnus-uu-user-archive-rules nil
+ "A list that can be set to override the default archive unpacking commands.
+To use, for instance, 'untar' to unpack tar files and 'zip -x' to
+unpack zip files, say the following:
+ (setq gnus-uu-user-archive-rules
+ '((\"\\\\.tar$\" \"untar\")
+ (\"\\\\.zip$\" \"zip -x\")))"
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-ignore-files-by-name nil
+ "*A regular expression saying what files should not be viewed based on name.
+If, for instance, you want gnus-uu to ignore all .au and .wav files,
+you could say something like
+
+ (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
+
+Note that this variable can be used in conjunction with the
+`gnus-uu-ignore-files-by-type' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
+
+(defcustom gnus-uu-ignore-files-by-type nil
+ "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
+If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
+you could say something like
+
+ (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
+
+Note that this variable can be used in conjunction with the
+`gnus-uu-ignore-files-by-name' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
+
+;; Pseudo-MIME support
+
+(defconst gnus-uu-ext-to-mime-list
+ '(("\\.gif$" "image/gif")
+ ("\\.jpe?g$" "image/jpeg")
+ ("\\.tiff?$" "image/tiff")
+ ("\\.xwd$" "image/xwd")
+ ("\\.pbm$" "image/pbm")
+ ("\\.pgm$" "image/pgm")
+ ("\\.ppm$" "image/ppm")
+ ("\\.xbm$" "image/xbm")
+ ("\\.pcx$" "image/pcx")
+ ("\\.tga$" "image/tga")
+ ("\\.ps$" "image/postscript")
+ ("\\.fli$" "video/fli")
+ ("\\.wav$" "audio/wav")
+ ("\\.aiff$" "audio/aiff")
+ ("\\.hcom$" "audio/hcom")
+ ("\\.voc$" "audio/voc")
+ ("\\.smp$" "audio/smp")
+ ("\\.mod$" "audio/mod")
+ ("\\.dvi$" "image/dvi")
+ ("\\.mpe?g$" "video/mpeg")
+ ("\\.au$" "audio/basic")
+ ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
+ ("\\.\\(c\\|h\\)$" "text/source")
+ ("read.*me" "text/plain")
+ ("\\.html$" "text/html")
+ ("\\.bat$" "text/bat")
+ ("\\.[1-6]$" "text/man")
+ ("\\.flc$" "video/flc")
+ ("\\.rle$" "video/rle")
+ ("\\.pfx$" "video/pfx")
+ ("\\.avi$" "video/avi")
+ ("\\.sme$" "video/sme")
+ ("\\.rpza$" "video/prza")
+ ("\\.dl$" "video/dl")
+ ("\\.qt$" "video/qt")
+ ("\\.rsrc$" "video/rsrc")
+ ("\\..*$" "unknown/unknown")))
+
+;; Various variables users may set
+
+(defcustom gnus-uu-tmp-dir "/tmp/"
+ "*Variable saying where gnus-uu is to do its work.
+Default is \"/tmp/\"."
+ :group 'gnus-extract
+ :type 'directory)
+
+(defcustom gnus-uu-do-not-unpack-archives nil
+ "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
+Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
+
+(defcustom gnus-uu-ignore-default-view-rules nil
+ "*Non-nil means that gnus-uu will ignore the default viewing rules.
+Only the user viewing rules will be consulted. Default is nil."
+ :group 'gnus-extract-view
+ :type 'boolean)
+
+(defcustom 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'."
+ :group 'gnus-extract
+ :options '(gnus-uu-grab-view gnus-uu-grab-move)
+ :type 'hook)
+
+(defcustom gnus-uu-ignore-default-archive-rules nil
+ "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
+Only the user unpacking commands will be consulted. Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
+
+(defcustom gnus-uu-kill-carriage-return t
+ "*Non-nil means that gnus-uu will strip all carriage returns from articles.
+Default is t."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-view-with-metamail nil
+ "*Non-nil means that files will be viewed with metamail.
+The gnus-uu viewing functions will be ignored and gnus-uu will try
+to guess at a content-type based on file name suffixes. Default
+it nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-unmark-articles-not-decoded nil
+ "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-correct-stripped-uucode nil
+ "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-save-in-digest nil
+ "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
+If this variable is nil, gnus-uu will just save everything in a
+file without any embellishments. The digesting almost conforms to RFC1153 -
+no easy way to specify any meaningful volume and issue numbers were found,
+so I simply dropped them."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom 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."
+ :group 'gnus-extract
+ :type '(repeat regexp))
+
+(defcustom gnus-uu-save-separate-articles nil
+ "*Non-nil means that gnus-uu will save articles in separate files."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-be-dangerous 'ask
+ "*Specifies what to do if unusual situations arise during decoding.
+If nil, be as conservative as possible. If t, ignore things that
+didn't work, and overwrite existing files. Otherwise, ask each time."
+ :group 'gnus-extract
+ :type '(choice (const :tag "conservative" nil)
+ (const :tag "ask" ask)
+ (const :tag "liberal" t)))
+
+;; 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]*$")
+
+(defconst gnus-uu-body-line "^M")
+(let ((i 61))
+ (while (> (setq i (1- i)) 0)
+ (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
+ (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
+
+;"^M.............................................................?$"
+
+(defconst gnus-uu-shar-begin-string "^#! */bin/sh")
+
+(defvar gnus-uu-shar-file-name nil)
+(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+
+(defconst gnus-uu-postscript-begin-string "^%!PS-")
+(defconst gnus-uu-postscript-end-string "^%%EOF$")
+
+(defvar gnus-uu-file-name nil)
+(defconst gnus-uu-uudecode-process nil)
+(defvar gnus-uu-binhex-article-name nil)
+
+(defvar gnus-uu-work-dir nil)
+
+(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
+ "k" gnus-summary-kill-process-mark
+ "y" gnus-summary-yank-process-mark
+ "w" gnus-summary-save-process-mark
+ "i" gnus-uu-invert-processable)
+
+(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
+ (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)))
+
+
+;; Digest and forward 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 (nnheader-concat gnus-uu-tmp-dir "forward")))
+ buf subject from newsgroups)
+ (gnus-setup-message 'forward
+ (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)
+ (insert-file file)
+ (let ((fs gnus-uu-digest-from-subject))
+ (when fs
+ (setq from (caar fs)
+ subject (gnus-simplify-subject-fuzzy (cdar fs))
+ fs (cdr fs))
+ (while (and fs (or from subject))
+ (when from
+ (unless (string= from (caar fs))
+ (setq from nil)))
+ (when subject
+ (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
+ subject)
+ (setq subject nil)))
+ (setq fs (cdr fs))))
+ (unless subject
+ (setq subject "Digested Articles"))
+ (unless from
+ (setq from
+ (if (gnus-news-group-p gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "Various"))))
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: ")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert subject))
+ (goto-char (point-min))
+ (when (re-search-forward "^From: ")
+ (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)
+ (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)
+ (gnus-uu-mark-region (point-min) (point-max)))
+
+(defun gnus-uu-unmark-buffer ()
+ "Remove the process mark on all articles in the buffer."
+ (interactive)
+ (gnus-uu-mark-region (point-min) (point-max) t))
+
+(defun gnus-uu-mark-thread ()
+ "Marks all articles downwards in this thread."
+ (interactive)
+ (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-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-invert-processable ()
+ "Invert the list of process-marked articles."
+ (let ((data gnus-newsgroup-data)
+ d number)
+ (save-excursion
+ (while data
+ (if (memq (setq number (gnus-data-number (pop data)))
+ gnus-newsgroup-processable)
+ (gnus-summary-remove-process-mark number)
+ (gnus-summary-set-process-mark number)))))
+ (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
+ (while data
+ (when (> (or (cdr (assq (gnus-data-number (car 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)
+ (gnus-set-global-variables)
+ (let ((marked (nreverse gnus-newsgroup-processable))
+ subject articles total headers)
+ (unless marked
+ (error "No articles marked with the process mark"))
+ (setq gnus-newsgroup-processable nil)
+ (save-excursion
+ (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-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 <speed@cs.washington.edu>.
+
+(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)
+ (when 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)))
+ (when scan
+ (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
+ (when save
+ (gnus-uu-save-files files save))
+ (when (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)
+ (gnus-make-directory (concat dir fromdir))
+ (setq to-file (concat dir fromdir))
+ (when (or (not (file-exists-p to-file))
+ (eq gnus-uu-be-dangerous t)
+ (and gnus-uu-be-dangerous
+ (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.
+
+;; Function called by gnus-uu-grab-articles to treat each article.
+(defun gnus-uu-save-article (buffer in-state)
+ (cond
+ (gnus-uu-save-separate-articles
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-write-buffer
+ (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 (point-min) (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)))
+ (push (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
+ (setq state (list 'begin))
+ (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
+ (erase-buffer))
+ (save-excursion
+ (set-buffer (get-buffer-create "*gnus-uu-pre*"))
+ (erase-buffer)
+ (insert (format
+ "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
+ (current-time-string) name name))))
+ (when (not (eq in-state 'end))
+ (setq state (list 'middle))))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-body*"))
+ (goto-char (setq beg (point-max)))
+ (save-excursion
+ (save-restriction
+ (set-buffer buffer)
+ (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 (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)
+ (or (and (re-search-forward "^[^ \t]" nil t)
+ (1- (point)))
+ (progn (forward-line 1) (point)))))))))
+ (widen)))
+ (insert sorthead) (goto-char (point-max))
+ (insert body) (goto-char (point-max))
+ (insert (concat "\n" (make-string 30 ?-) "\n\n"))
+ (goto-char beg)
+ (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
+ (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-pre*"))
+ (insert (format " %s\n" subj)))))
+ (when (or (eq in-state 'last)
+ (eq in-state 'first-and-last))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-pre*"))
+ (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
+ (gnus-write-buffer gnus-uu-saved-article-name))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-body*"))
+ (goto-char (point-max))
+ (insert
+ (concat (setq end-string (format "End of %s Digest" name))
+ "\n"))
+ (insert (concat (make-string (length end-string) ?*) "\n"))
+ (write-region
+ (point-min) (point-max) gnus-uu-saved-article-name t))
+ (kill-buffer (get-buffer "*gnus-uu-pre*"))
+ (kill-buffer (get-buffer "*gnus-uu-body*"))
+ (push 'end state))
+ (if (memq 'begin state)
+ (cons gnus-uu-saved-article-name state)
+ state)))))
+
+;; Binhex treatment - not very advanced.
+
+(defconst gnus-uu-binhex-body-line
+ "^[^:]...............................................................$")
+(defconst gnus-uu-binhex-begin-line
+ "^:...............................................................$")
+(defconst gnus-uu-binhex-end-line
+ ":$")
+
+(defun gnus-uu-binhex-article (buffer in-state)
+ (let (state start-char)
+ (save-excursion
+ (set-buffer buffer)
+ (widen)
+ (goto-char (point-min))
+ (when (not (re-search-forward gnus-uu-binhex-begin-line nil t))
+ (when (not (re-search-forward gnus-uu-binhex-body-line nil t))
+ (setq state (list 'wrong-type))))
+
+ (if (memq 'wrong-type state)
+ ()
+ (beginning-of-line)
+ (setq start-char (point))
+ (if (looking-at gnus-uu-binhex-begin-line)
+ (progn
+ (setq state (list 'begin))
+ (write-region 1 1 gnus-uu-binhex-article-name))
+ (setq state (list 'middle)))
+ (goto-char (point-max))
+ (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
+ gnus-uu-binhex-end-line)
+ nil t)
+ (when (looking-at gnus-uu-binhex-end-line)
+ (setq state (if (memq 'begin state)
+ (cons 'end state)
+ (list 'end))))
+ (beginning-of-line)
+ (forward-line 1)
+ (when (file-exists-p gnus-uu-binhex-article-name)
+ (append-to-file start-char (point) gnus-uu-binhex-article-name))))
+ (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))
+
+
+;; 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)
+ (setq action
+ (gnus-uu-choose-action
+ file-name
+ (append
+ gnus-uu-user-view-rules
+ (if gnus-uu-ignore-default-view-rules
+ nil
+ gnus-uu-default-view-rules)
+ gnus-uu-user-view-rules-end)))
+ (when (and (not (string= (or action "") "gnus-uu-archive"))
+ gnus-uu-view-with-metamail)
+ (when (setq action
+ (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
+ (setq action (format "metamail -d -b -c \"%s\"" action))))
+ action))
+
+
+;; 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]+:")
+ 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 (point-min))
+ (when (looking-at vernum)
+ (replace-match vernum t t)
+ (setq beg (length vernum)))
+
+ (goto-char beg)
+ (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
+ (replace-match " [0-9]+/[0-9]+")
+
+ (goto-char beg)
+ (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
+ (replace-match "[0-9]+ of [0-9]+")
+
+ (end-of-line)
+ (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
+ nil t)
+ (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
+
+ (goto-char beg)
+ (while (re-search-forward "[ \t]+" nil t)
+ (replace-match "[ \t]*" t t))
+
+ (buffer-substring 1 (point-max)))))
+
+(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
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (save-excursion
+ (while (and (> n 0)
+ (push (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 (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)
+ (push (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<))))))
+
+(defun gnus-uu-expand-numbers (string-list &optional translate)
+ ;; Takes a list of strings and "expands" all numbers in all the
+ ;; strings. That is, this function makes all numbers equal length by
+ ;; prepending lots of zeroes before each number. This is to ease later
+ ;; sorting to find out what sequence the articles are supposed to be
+ ;; decoded in. Returns the list of expanded strings.
+ (let ((out-list string-list)
+ string)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (buffer-disable-undo (current-buffer))
+ (while string-list
+ (erase-buffer)
+ (insert (caar string-list))
+ ;; Translate multiple spaces to one space.
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]+" nil t)
+ (replace-match " "))
+ ;; Translate all characters to "a".
+ (goto-char (point-min))
+ (when translate
+ (while (re-search-forward "[A-Za-z]" nil t)
+ (replace-match "a" t t)))
+ ;; Expand numbers.
+ (goto-char (point-min))
+ (while (re-search-forward "[0-9]+" nil t)
+ (replace-match
+ (format "%06d"
+ (string-to-int (buffer-substring
+ (match-beginning 0) (match-end 0))))))
+ (setq string (buffer-substring 1 (point-max)))
+ (setcar (car string-list) string)
+ (setq string-list (cdr string-list))))
+ out-list))
+
+
+;; `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 end of an encoded file has been received
+;; `middle' if the article was a body part of an encoded file
+;; `wrong-type' if the article was not a part of an encoded file
+;; `ok', which can be used everything is ok
+
+(defvar gnus-uu-has-been-grabbed nil)
+
+(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
+ (let (art)
+ (if (not (and gnus-uu-has-been-grabbed
+ gnus-uu-unmark-articles-not-decoded))
+ ()
+ (when dont-unmark-last-article
+ (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-tick-article (car gnus-uu-has-been-grabbed) t)
+ (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
+ (when 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.
+;;
+;; 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 (pop articles))
+ (push article article-series)
+
+ (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)))
+ (when 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)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p
+ (format "Delete unsuccessfully decoded file %s"
+ 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))))
+ (setq result-file nil)
+ ;; 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)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p (format "Delete incomplete file %s? " 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))
+ (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
+ (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)))
+
+(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))))
+
+ (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))
+
+ (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))))
+ (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
+
+ ;; 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.
+ (let ((cdir default-directory))
+ (unwind-protect
+ (progn
+ (cd gnus-uu-work-dir)
+ (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 %s uudecode" gnus-uu-work-dir
+ gnus-shell-command-separator))))
+ (cd cdir)))
+ (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)
+ (push 'end state)
+ (goto-char (point-max))
+ (re-search-backward gnus-uu-body-line nil t))
+
+ (forward-line 1)
+
+ (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.
+ (ignore-errors
+ (process-send-eof gnus-uu-uudecode-process))
+ (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 (if (= (length files) 1) (car files) files) state)
+ state))))
+
+;; This function is used by `gnus-uu-grab-articles' to treat
+;; a shared article.
+(defun gnus-uu-unshar-article (process-buffer in-state)
+ (let ((state (list 'ok))
+ start-char)
+ (save-excursion
+ (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 " "
+ gnus-shell-command-separator " sh"))))
+ state))
+
+;; 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 (point-min))
+ (when (re-search-forward gnus-uu-shar-name-marker nil t)
+ (setq res (buffer-substring (match-beginning 1) (match-end 1))))
+ (goto-char oldpoint)
+ res))
+
+;; `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
+ (unless no-ignore
+ (and (not
+ (and gnus-uu-ignore-files-by-name
+ (string-match gnus-uu-ignore-files-by-name file-name)))
+ (not
+ (and gnus-uu-ignore-files-by-type
+ (string-match gnus-uu-ignore-files-by-type
+ (or (gnus-uu-choose-action
+ file-name gnus-uu-ext-to-mime-list t)
+ ""))))))
+ (while (not (or (eq action-list ()) action))
+ (setq rule (car action-list))
+ (setq action-list (cdr action-list))
+ (when (string-match (car rule) file-name)
+ (setq action (cadr rule)))))
+ action))
+
+(defun gnus-uu-treat-archive (file-path)
+ ;; Unpacks an archive. Returns t if unpacking is successful.
+ (let ((did-unpack t)
+ action command dir)
+ (setq action (gnus-uu-choose-action
+ file-path (append gnus-uu-user-archive-rules
+ (if gnus-uu-ignore-default-archive-rules
+ nil
+ gnus-uu-default-archive-rules))))
+
+ (when (not action)
+ (error "No unpackers for the file %s" file-path))
+
+ (string-match "/[^/]*$" file-path)
+ (setq dir (substring file-path 0 (match-beginning 0)))
+
+ (when (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)))
+
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (erase-buffer))
+
+ (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
+
+ (if (= 0 (call-process shell-file-name nil
+ (get-buffer-create gnus-uu-output-buffer-name)
+ nil shell-command-switch command))
+ (message "")
+ (gnus-message 2 "Error during unpacking of archive")
+ (setq did-unpack nil))
+
+ (when (member action gnus-uu-destructive-archivers)
+ (rename-file (concat file-path "~") file-path t))
+
+ did-unpack))
+
+(defun gnus-uu-dir-files (dir)
+ (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$"))
+ files file)
+ (while dirs
+ (if (file-directory-p (setq file (car dirs)))
+ (setq files (append files (gnus-uu-dir-files file)))
+ (push 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 (cdr (assq 'name (car files))))
+ (when (and (not (member file ignore))
+ (equal (gnus-uu-get-action (file-name-nondirectory file))
+ "gnus-uu-archive"))
+ (push file did-unpack)
+ (unless (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
+ (unless (member (car nfiles) totfiles)
+ (push (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
+ (when (file-directory-p (car files))
+ (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-directory-files (dir &optional full)
+ (let (files out file)
+ (setq files (directory-files dir full))
+ (while files
+ (setq file (car files))
+ (setq files (cdr files))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (push file out)))
+ (setq out (nreverse out))
+ out))
+
+(defun gnus-uu-check-correct-stripped-uucode (start end)
+ (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
+ (when (looking-at "\n")
+ (replace-match ""))
+ (forward-line 1))))
+
+ (while (not (eobp))
+ (if (looking-at (concat gnus-uu-begin-string "\\|"
+ gnus-uu-end-string))
+ ()
+ (when (not found)
+ (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)
+ (when (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)
+ (when (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)
+ (when (not (file-writable-p gnus-uu-tmp-dir))
+ (error "Temp directory %s can't be written to"
+ gnus-uu-tmp-dir)))
+
+ (setq gnus-uu-work-dir
+ (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
+ (gnus-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))
+ (push (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)
+ (and gnus-uu-uudecode-process
+ (memq (process-status (or gnus-uu-uudecode-process "nevair"))
+ '(stop run))
+ (delete-process gnus-uu-uudecode-process))
+ (when (setq buf (get-buffer gnus-uu-output-buffer-name))
+ (kill-buffer buf))))
+
+(defun gnus-quote-arg-for-sh-or-csh (arg)
+ (let ((pos 0) new-pos accum)
+ ;; *** bug: we don't handle newline characters properly
+ (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
+ (push (substring arg pos new-pos) accum)
+ (push "\\" accum)
+ (push (list (aref arg new-pos)) accum)
+ (setq pos (1+ new-pos)))
+ (if (= pos 0)
+ arg
+ (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
+;; Inputs an action and a filename and returns a full command, making sure
+;; that the filename will be treated as a single argument when the shell
+;; executes the command.
+(defun gnus-uu-command (action file)
+ (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file)))
+ (if (string-match "%s" action)
+ (format action quoted-file)
+ (concat action " " quoted-file))))
+
+(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 'gnus-uu-clean-up)
+(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
+
+
+
+;;;
+;;; 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.
+(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
+ "Function used for encoding binary files.
+There are three functions supplied with gnus-uu for encoding files:
+`gnus-uu-post-encode-uuencode', which does straight uuencoding;
+`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
+headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
+uuencode and adds MIME headers."
+ :group 'gnus-extract-post
+ :type '(radio (function-item gnus-uu-post-encode-uuencode)
+ (function-item gnus-uu-post-encode-mime)
+ (function-item gnus-uu-post-encode-mime-uuencode)
+ (function :tag "Other")))
+
+(defcustom 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."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defcustom gnus-uu-post-length 990
+ "Maximum length of an article.
+The encoded file will be split into how many articles it takes to
+post the entire file."
+ :group 'gnus-extract-post
+ :type 'integer)
+
+(defcustom gnus-uu-post-threaded nil
+ "Non-nil means that gnus-uu will post the encoded file in a thread.
+This may not be smart, as no other decoder I have seen are able to
+follow threads when collecting uuencoded articles. (Well, I have seen
+one package that does that - gnus-uu, but somehow, I don't think that
+counts...) Default is nil."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defcustom gnus-uu-post-separate-description t
+ "Non-nil means that the description will be posted in a separate article.
+The first article will typically be numbered (0/x). If this variable
+is nil, the description the user enters will be included at the
+beginning of the first article, which will be numbered (1/x). Default
+is t."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defvar gnus-uu-post-binary-separator "--binary follows this line--")
+(defvar gnus-uu-post-message-id nil)
+(defvar gnus-uu-post-inserted-file-name nil)
+(defvar gnus-uu-winconf-post-news nil)
+
+(defun gnus-uu-post-news ()
+ "Compose an article and post an encoded file."
+ (interactive)
+ (setq gnus-uu-post-inserted-file-name nil)
+ (setq gnus-uu-winconf-post-news (current-window-configuration))
+
+ (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)
+
+ (when 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)
+ (save-excursion
+ (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
+
+;; Encodes with uuencode and substitutes all spaces with backticks.
+(defun gnus-uu-post-encode-uuencode (path file-name)
+ (when (gnus-uu-post-encode-file "uuencode" path file-name)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (re-search-forward " " nil t)
+ (replace-match "`"))
+ t))
+
+;; Encodes with uuencode and adds MIME headers.
+(defun gnus-uu-post-encode-mime-uuencode (path file-name)
+ (when (gnus-uu-post-encode-uuencode path file-name)
+ (gnus-uu-post-make-mime file-name "x-uue")
+ t))
+
+;; Encodes with base64 and adds MIME headers
+(defun gnus-uu-post-encode-mime (path file-name)
+ (when (gnus-uu-post-encode-file "mmencode" path file-name)
+ (gnus-uu-post-make-mime file-name "base64")
+ t))
+
+;; Adds MIME headers.
+(defun gnus-uu-post-make-mime (file-name encoding)
+ (goto-char (point-min))
+ (insert (format "Content-Type: %s; name=\"%s\"\n"
+ (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
+ file-name))
+ (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
+ (save-restriction
+ (set-buffer gnus-message-buffer)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line -1)
+ (narrow-to-region 1 (point))
+ (unless (mail-fetch-field "mime-version")
+ (widen)
+ (insert "MIME-Version: 1.0\n"))
+ (widen)))
+
+;; Encodes a file PATH with COMMAND, leaving the result in the
+;; current buffer.
+(defun gnus-uu-post-encode-file (command path file-name)
+ (= 0 (call-process 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)
+
+ (let (file-name)
+
+ (if gnus-uu-post-inserted-file-name
+ (setq file-name gnus-uu-post-inserted-file-name)
+ (setq file-name (gnus-uu-post-insert-binary)))
+
+ (if gnus-uu-post-threaded
+ (let ((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
+ (list gnus-inews-article-hook)))
+ (push
+ '(lambda ()
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
+ (setq gnus-uu-post-message-id
+ (buffer-substring
+ (match-beginning 1) (match-end 1)))
+ (setq gnus-uu-post-message-id nil))))
+ gnus-inews-article-hook)
+ (gnus-uu-post-encoded file-name t))
+ (gnus-uu-post-encoded file-name nil)))
+ (setq gnus-uu-post-inserted-file-name nil)
+ (when gnus-uu-winconf-post-news
+ (set-window-configuration gnus-uu-winconf-post-news)))
+
+;; Asks for a file to encode, encodes it and inserts the result in
+;; the current buffer. Returns the file name the user gave.
+(defun gnus-uu-post-insert-binary ()
+ (let ((uuencode-buffer-name "*uuencode buffer*")
+ file-path uubuf file-name)
+
+ (setq file-path (read-file-name
+ "What file do you want to encode? "))
+ (when (not (file-exists-p file-path))
+ (error "%s: No such file" file-path))
+
+ (goto-char (point-max))
+ (insert (format "\n%s\n" gnus-uu-post-binary-separator))
+
+ (when (string-match "^~/" file-path)
+ (setq file-path (concat "$HOME" (substring file-path 1))))
+ (if (string-match "/[^/]*$" file-path)
+ (setq file-name (substring file-path (1+ (match-beginning 0))))
+ (setq file-name file-path))
+
+ (unwind-protect
+ (if (save-excursion
+ (set-buffer (setq uubuf
+ (get-buffer-create uuencode-buffer-name)))
+ (erase-buffer)
+ (funcall gnus-uu-post-encode-method file-path file-name))
+ (insert-buffer-substring uubuf)
+ (error "Encoding unsuccessful"))
+ (kill-buffer uubuf))
+ file-name))
+
+;; Posts the article and all of the encoded file.
+(defun gnus-uu-post-encoded (file-name &optional threaded)
+ (let ((send-buffer-name "*uuencode send buffer*")
+ (encoded-buffer-name "*encoded buffer*")
+ (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
+ (separator (concat mail-header-separator "\n\n"))
+ uubuf length parts header i end beg
+ beg-line minlen buf post-buf whole-len beg-binary end-binary)
+
+ (setq post-buf (current-buffer))
+
+ (goto-char (point-min))
+ (when (not (re-search-forward
+ (if gnus-uu-post-separate-description
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator)
+ "$")
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ nil t))
+ (error "Internal error: No binary/header separator"))
+ (beginning-of-line)
+ (forward-line 1)
+ (setq beg-binary (point))
+ (setq end-binary (point-max))
+
+ (save-excursion
+ (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
+ (erase-buffer)
+ (insert-buffer-substring post-buf beg-binary end-binary)
+ (goto-char (point-min))
+ (setq length (count-lines 1 (point-max)))
+ (setq parts (/ length gnus-uu-post-length))
+ (when (not (< (% length gnus-uu-post-length) 4))
+ (setq parts (1+ parts))))
+
+ (when gnus-uu-post-separate-description
+ (forward-line -1))
+ (kill-region (point) (point-max))
+
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (beginning-of-line)
+ (setq header (buffer-substring 1 (point)))
+
+ (goto-char (point-min))
+ (if (not gnus-uu-post-separate-description)
+ ()
+ (when (and (not threaded) (re-search-forward "^Subject: " nil t))
+ (end-of-line)
+ (insert (format " (0/%d)" parts)))
+ (message-send))
+
+ (save-excursion
+ (setq i 1)
+ (setq beg 1)
+ (while (not (> i parts))
+ (set-buffer (get-buffer-create send-buffer-name))
+ (erase-buffer)
+ (insert header)
+ (when (and threaded gnus-uu-post-message-id)
+ (insert (format "References: %s\n" gnus-uu-post-message-id)))
+ (insert separator)
+ (setq whole-len
+ (- 62 (length (format top-string "" file-name i parts ""))))
+ (when (> 1 (setq minlen (/ whole-len 2)))
+ (setq minlen 1))
+ (setq
+ beg-line
+ (format top-string
+ (make-string minlen ?-)
+ file-name i parts
+ (make-string
+ (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
+
+ (goto-char (point-min))
+ (if (not (re-search-forward "^Subject: " nil t))
+ ()
+ (if (not threaded)
+ (progn
+ (end-of-line)
+ (insert (format " (%d/%d)" i parts)))
+ (when (or (and (= i 2) gnus-uu-post-separate-description)
+ (and (= i 1) (not gnus-uu-post-separate-description)))
+ (replace-match "Subject: Re: "))))
+
+ (goto-char (point-max))
+ (save-excursion
+ (set-buffer uubuf)
+ (goto-char beg)
+ (if (= i parts)
+ (goto-char (point-max))
+ (forward-line gnus-uu-post-length))
+ (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
+ (forward-line -4))
+ (setq end (point)))
+ (insert-buffer-substring uubuf beg end)
+ (insert beg-line)
+ (insert "\n")
+ (setq beg end)
+ (setq i (1+ i))
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (beginning-of-line)
+ (forward-line 2)
+ (when (re-search-forward
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
+ nil t)
+ (replace-match "")
+ (forward-line 1))
+ (insert beg-line)
+ (insert "\n")
+ (let (message-sent-message-via)
+ (message-send))))
+
+ (when (setq buf (get-buffer send-buffer-name))
+ (kill-buffer buf))
+ (when (setq buf (get-buffer encoded-buffer-name))
+ (kill-buffer buf))
+
+ (when (not gnus-uu-post-separate-description)
+ (set-buffer-modified-p nil)
+ (when (fboundp 'bury-buffer)
+ (bury-buffer)))))
+
+(provide 'gnus-uu)
+
+;; gnus-uu.el ends here